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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
module Parsers where
-- Parsec is for casuals
import Control.Applicative (Alternative(..), liftA2)
import Control.Monad (MonadPlus(..), guard)
import Data.Maybe (catMaybes)
newtype Parser t a =
Parser { parse :: [t] -> Maybe ([t], a) }
instance Semigroup a => Semigroup (Parser t a) where
(<>) = liftA2 (<>)
instance Monoid a => Monoid (Parser t a) where
mempty = pure mempty
instance Functor (Parser t) where
fmap f (Parser p) = Parser $ fmap (fmap f) . p
instance Applicative (Parser t) where
pure = result
p <*> q = Parser $ \ inp -> do
(inp', f) <- parse p inp
parse (f <$> q) inp'
instance Monad (Parser t) where
return = pure
p >>= f = Parser $ \ inp -> do
(inp', x) <- parse p inp
parse (f x) inp'
instance Alternative (Parser t) where
empty = flunk
(<|>) = alt
-----------------------------------------------------------------------------
flunk :: Parser t a
flunk = Parser $ \ _ -> Nothing
result :: a -> Parser t a
result x = Parser $ \ inp -> Just (inp, x)
peek :: Parser t a -> Parser t a
peek p = Parser $ \ inp -> do
(_, x) <- parse p inp
return (inp, x)
anyToken :: Parser t t
anyToken = Parser $ \ inp -> case inp of
t:ts -> Just (ts, t)
_ -> Nothing
eof :: Parser t ()
eof = Parser $ \ inp -> case inp of
[] -> Just ([], ())
_ -> Nothing
infixl 3 `alt`
alt :: Parser t a -> Parser t a -> Parser t a
alt (Parser p) (Parser q) = Parser $ \ inp -> p inp <|> q inp
-----------------------------------------------------------------------------
phrase :: Parser t a -> Parser t a
phrase = (<* eof)
recover :: a -> Parser t a -> Parser t a
recover x p = p <|> pure x
optional :: Parser t a -> Parser t (Maybe a)
optional = recover Nothing . fmap Just
assert :: (a -> Bool) -> Parser t a -> Parser t a
assert f p = do
x <- p
guard $ f x
return x
satisfy :: (t -> Bool) -> Parser t t
satisfy f = assert f anyToken
token :: Eq t => t -> Parser t t
token t = satisfy (==t)
list :: Eq t => [t] -> Parser t [t]
list = traverse token
mult :: Parser t a -> Parser t [a]
mult = many
mult1 :: Parser t a -> Parser t [a]
mult1 = some
exactly :: Int -> Parser t a -> Parser t [a]
exactly i = sequence . replicate i
atLeast :: Int -> Parser t a -> Parser t [a]
atLeast i p = exactly i p <> mult p
atMost :: Int -> Parser t a -> Parser t [a]
atMost i = fmap catMaybes . exactly i . optional
between :: Int -> Int -> Parser t a -> Parser t [a]
between x y p = exactly (min x y) p <> atMost (abs $ x - y) p
stopAt :: Parser t a -> Parser t [t]
stopAt p = go
where
p' = ([] <$ peek p)
go = p' <|> liftA2 (:) anyToken go
stopAfter :: Parser t a -> Parser t ([t], a)
stopAfter p = (,) <$> stopAt p <*> p
stopIf :: Parser t a -> Parser t [t]
stopIf p = stopAt $ () <$ p <|> eof
|
