aboutsummaryrefslogtreecommitdiff
path: root/src/Cron/Schedule.hs
blob: 2ea56abe9dd9fed27a6ac630454ab3130e260ae7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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)