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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
module Cron.Parser (parse) where
import Common (fromDigits)
import Control.Applicative (Alternative, empty, liftA2, many, some, (*>), (<$), (<|>))
import Control.Arrow (first, (>>>))
import qualified Cron.Expr as E
import Data.List.NonEmpty (NonEmpty ((:|)))
import Intro
import Text.Read (readMaybe)
type Token = Char
newtype Parser a = Parser {runParser :: [Token] -> Maybe (a, [Token])}
instance Functor Parser where
fmap f (Parser p) = Parser (p >>> fmap (first f))
instance Applicative Parser where
pure a = Parser (\input -> Just (a, input))
Parser pF <*> Parser pA = Parser $ \input -> do
(f, rest) <- pF input
(a, s) <- pA rest
pure (f a, s)
instance Alternative Parser where
empty = Parser (const Nothing)
Parser pA <|> Parser pB = Parser $ \input -> case (pA input, pB input) of
(Nothing, expr) -> expr
(expr, _) -> expr
match :: (Token -> Bool) -> Parser Token
match p = Parser $ \case
t : ts | p t -> Just (t, ts)
_ -> Nothing
token :: Token -> Parser Token
token = (==) >>> match
read :: (Token -> Maybe a) -> Parser a
read f = Parser $ \case
t : ts -> case f t of
Just x -> Just (x, ts)
_ -> Nothing
_ -> Nothing
sepBy1 :: Parser a -> Parser b -> Parser (NonEmpty a)
sepBy1 p s = liftA2 (:|) p (many (s *> p))
pair :: Parser a -> Parser b -> Parser c -> Parser (a, b)
pair p1 p2 s = liftA2 (,) p1 (s *> p2)
digit :: Parser Int
digit = read $ \case
x | x `elem` ['0' .. '9'] -> readMaybe [x] :: Maybe Int
_ -> Nothing
number :: Parser Int
number = fromDigits <$> some digit
--
-- Cron Exprs
--
cRange :: Parser E.Expr
cRange = uncurry E.Range <$> pair number number (token '-')
cStepL :: Parser E.StepLExpr
cStepL =
(E.StepLEvery <$ token '*')
<|> (uncurry E.StepLRange <$> pair number number (token '-'))
cStep :: Parser E.Expr
cStep = uncurry E.Step <$> pair cStepL number (token '/')
cMulti :: Parser E.Expr
cMulti = E.Multi <$> sepBy1 number (token ',')
cEvery :: Parser E.Expr
cEvery = E.Every <$ token '*'
cExpr :: Parser E.Expr
cExpr = cStep <|> cEvery <|> cRange <|> cMulti
parse :: [Token] -> Either String E.Expr
parse xs = case runParser cExpr xs of
Nothing -> Left "Invalid cron expression"
Just (expr, []) -> Right expr
Just (_, rest) -> Left ("Invalid cron expression. Couldn't parse `" ++ rest ++ "`")
|
