Initial commit

1 files changed, 72 insertions, 0 deletions

diff --git a/src/Cron/Schedule.hs b/src/Cron/Schedule.hs
new file mode 100644
index 0000000..2ea56ab
--- /dev/null
+++ b/src/Cron/Schedule.hs
@@ -0,0 +1,72 @@
+module Cron.Schedule (Schedule (..), fromParts) where
+
+import Common ((?))
+import qualified Cron.Expr as E
+import qualified Cron.Parser as P
+import Intro
+
+data Schedule = Schedule
+  { minute :: E.Expr
+  , hour :: E.Expr
+  , dayOfMonth :: E.Expr
+  , month :: E.Expr
+  , dayOfWeek :: E.Expr
+  }
+  deriving (Show)
+
+fromParts :: String -> String -> String -> String -> String -> Either String Schedule
+fromParts mn h d m wd =
+  Schedule
+    <$> parseMinute mn
+    <*> parseHour h
+    <*> parseDayOfMonth d
+    <*> parseMonth m
+    <*> parseDayOfWeek wd
+
+parseMinute :: String -> Either String E.Expr
+parseMinute s = P.parse s >>= validateMinute
+
+parseHour :: String -> Either String E.Expr
+parseHour s = P.parse s >>= validateHour
+
+parseDayOfMonth :: String -> Either String E.Expr
+parseDayOfMonth s = P.parse s >>= validateDayOfMonth
+
+parseMonth :: String -> Either String E.Expr
+parseMonth s = P.parse s >>= validateMonth
+
+parseDayOfWeek :: String -> Either String E.Expr
+parseDayOfWeek s = P.parse s >>= validateDayOfWeek
+
+validateMinute :: E.Expr -> Either String E.Expr
+validateMinute expr = validateExpr expr >>= flip validateInRange [0 .. 59]
+
+validateHour :: E.Expr -> Either String E.Expr
+validateHour expr = validateExpr expr >>= flip validateInRange [0 .. 23]
+
+validateDayOfMonth :: E.Expr -> Either String E.Expr
+validateDayOfMonth expr = validateExpr expr >>= flip validateInRange [1 .. 31]
+
+validateMonth :: E.Expr -> Either String E.Expr
+validateMonth expr = validateExpr expr >>= flip validateInRange [1 .. 12]
+
+validateDayOfWeek :: E.Expr -> Either String E.Expr
+validateDayOfWeek expr = validateExpr expr >>= flip validateInRange [0 .. 6]
+
+validateExpr :: E.Expr -> Either String E.Expr
+validateExpr expr = validate expr $ \case
+  E.Range n m -> n < m
+  _ -> True
+
+validateInRange :: E.Expr -> [Int] -> Either String E.Expr
+validateInRange expr range = validate expr $ \case
+  E.Multi ns -> all inRange ns
+  E.Range n m -> inRange n && inRange m
+  E.Step _ _ -> True
+  E.Every -> True
+ where
+  inRange :: Int -> Bool
+  inRange = flip elem range
+
+validate :: E.Expr -> (E.Expr -> Bool) -> Either String E.Expr
+validate expr p = p expr ? Right expr $ Left ("Invalid cron expression " ++ E.showExpr expr)