Initial commit

1 files changed, 138 insertions, 0 deletions

diff --git a/src/Cron.hs b/src/Cron.hs
new file mode 100644
index 0000000..3cadac9
--- /dev/null
+++ b/src/Cron.hs
@@ -0,0 +1,138 @@
+module Cron (parse, toProse) where
+
+import Common (asOrdinal, leftPad, listToProse, showDayOfWeek, showMonth, (?:))
+import qualified Cron.Expr as E
+import qualified Cron.Schedule as S
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Intro
+
+parse :: String -> Either String S.Schedule
+parse s = case words s of
+  [mn, h, dom, m, dow] -> S.fromParts mn h dom m dow
+  xs ->
+    Left
+      $ "Invalid cron "
+      ++ s
+      ++ ": not enough qualifiers, expecting 5 but only got "
+      ++ (show . length) xs
+
+toProse :: S.Schedule -> String
+toProse s =
+  mconcat
+    [ proseTime s.minute s.hour
+    , ", "
+    , proseDate s.dayOfMonth s.month s.dayOfWeek
+    ]
+
+proseDate :: E.Expr -> E.Expr -> E.Expr -> String
+proseDate dom mt dow = case (dom, mt, dow) of
+  (E.Every, E.Every, E.Every) -> "daily"
+  (E.Every, _, E.Every) -> "daily " ++ proseMonth mt
+  (E.Every, E.Every, E.Multi ns) -> "every " ++ listToProse (dayOfWeek <$> ns)
+  (E.Every, E.Every, E.Range _ _) -> proseDayOfWeek dow
+  (E.Every, _, E.Multi ns) -> "every " ++ listToProse (dayOfWeek <$> ns) ++ " " ++ proseMonth mt
+  (_, _, _) -> mconcat [proseDayOfMonth dom, " ", proseMonth mt, " ", proseDayOfWeek dow]
+ where
+  dayOfWeek m = showDayOfWeek m ?: "?"
+
+proseDayOfWeek :: E.Expr -> String
+proseDayOfWeek = \case
+  E.Every -> ""
+  E.Multi ns -> "on " ++ listToProse (dayOfWeek <$> ns)
+  E.Range n m -> mconcat ["from ", dayOfWeek n, " to ", dayOfWeek m]
+  E.Step E.StepLEvery 1 -> ""
+  E.Step E.StepLEvery n -> mconcat ["every ", show n, " days of the week"]
+  E.Step (E.StepLRange n m) j ->
+    mconcat
+      [ "every "
+      , show j
+      , " days of the week from "
+      , dayOfWeek n
+      , " to "
+      , dayOfWeek m
+      ]
+ where
+  dayOfWeek m = showDayOfWeek m ?: "?"
+
+proseMonth :: E.Expr -> String
+proseMonth = \case
+  E.Every -> "of every month"
+  E.Multi ns -> "of " ++ listToProse (month <$> ns)
+  E.Range n m -> mconcat ["from ", month n, " to ", month m]
+  E.Step E.StepLEvery 1 -> "of every month"
+  E.Step E.StepLEvery n -> mconcat ["of every ", show n, " months"]
+  E.Step (E.StepLRange n m) j ->
+    mconcat
+      [ "of every "
+      , show j
+      , " months from "
+      , month n
+      , " to "
+      , month m
+      ]
+ where
+  month m = showMonth m ?: "?"
+
+proseDayOfMonth :: E.Expr -> String
+proseDayOfMonth = \case
+  E.Every -> "daily"
+  E.Multi ns -> "on the " ++ listToProse (asOrdinal <$> ns)
+  E.Range n m -> mconcat ["daily from the ", asOrdinal n, " to the ", asOrdinal m]
+  E.Step E.StepLEvery 1 -> "daily"
+  E.Step E.StepLEvery n -> mconcat ["every ", show n, " days"]
+  E.Step (E.StepLRange n m) j ->
+    mconcat
+      [ "every "
+      , show j
+      , " days from the "
+      , asOrdinal n
+      , " to the "
+      , asOrdinal m
+      ]
+
+proseTime :: E.Expr -> E.Expr -> String
+proseTime mn h = case (mn, h) of
+  (E.Multi (0 :| []), E.Every) -> "At the top of every hour"
+  (E.Multi (0 :| []), E.Step E.StepLEvery 1) -> "At the top of every hour"
+  (E.Multi (n :| []), E.Multi (m :| [])) -> mconcat ["At ", leftPad 2 '0' $ show m, ":", leftPad 2 '0' $ show n]
+  (E.Multi (0 :| []), E.Multi ns) -> mconcat ["At the top of the ", listToProse (asOrdinal <$> ns), " hours"]
+  (_, E.Every) -> mconcat [proseMinute mn, " of every hour"]
+  (_, E.Step E.StepLEvery 1) -> mconcat [proseMinute mn, " of every hour"]
+  (_, _) -> mconcat [proseMinute mn, " ", proseHour h]
+
+proseHour :: E.Expr -> String
+proseHour = \case
+  E.Every -> "every hour"
+  E.Multi (n :| []) -> mconcat ["at hour ", leftPad 2 '0' $ show n]
+  E.Multi ns -> "at hours " ++ listToProse (show <$> ns)
+  E.Range n m -> mconcat ["every hour from ", leftPad 2 '0' $ show n, " to ", leftPad 2 '0' $ show m]
+  E.Step E.StepLEvery 1 -> "every hour"
+  E.Step E.StepLEvery n -> mconcat ["every ", show n, " hours"]
+  E.Step (E.StepLRange n m) j ->
+    mconcat
+      [ "every "
+      , show j
+      , " hours from "
+      , show n
+      , " to "
+      , show m
+      ]
+
+proseMinute :: E.Expr -> String
+proseMinute = \case
+  E.Every -> "Every minute"
+  E.Multi (n :| []) -> mconcat ["At minute ", leftPad 2 '0' $ show n]
+  E.Multi ns -> "At minutes " ++ listToProse (show <$> ns)
+  E.Range n m -> mconcat ["Every minute from ", leftPad 2 '0' $ show n, " to ", leftPad 2 '0' $ show m]
+  E.Step E.StepLEvery 1 -> "Every minute"
+  E.Step E.StepLEvery n -> mconcat ["every ", show n, " minutes"]
+  E.Step (E.StepLRange n m) j ->
+    mconcat
+      [ "every "
+      , show j
+      , " minutes from the "
+      , asOrdinal n
+      , " minute to the "
+      , asOrdinal m
+      , " minute"
+      ]