1{-# LANGUAGE CPP #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4{-|
5This is subset of Parsec.
6
7Parsec 3 provides features which Parsec 2 does not provide:
8
9* Applicative style
10
11* ByteString as input
12
13But Haskell Platform includes Parsec 2, not Parsec 3. Installing
14Parsec 3 to Haskell Platform environment makes it mess. So, this library
15was implemented.
16-}
17
18module Text.Appar.Parser (
19  -- ** Running parser
20    parse
21  -- ** 'Char' parsers
22  , char
23  , anyChar
24  , oneOf
25  , noneOf
26  , alphaNum
27  , digit
28  , hexDigit
29  , space
30  -- ** 'String' parser
31  , string
32  -- ** Parser combinators
33  , try
34  , choice
35  , option
36  , skipMany
37  , skipSome
38  , sepBy1
39  , manyTill
40  -- ** 'Applicative' parser combinators
41  , (<$>)
42  , (<$)
43  , (<*>)
44  , (*>)
45  , (<*)
46  , (<**>)
47  , (<|>)
48  , some
49  , many
50  , pure
51  -- ** Internals
52  , MkParser(..)
53  , Input(..)
54  , satisfy
55  ) where
56
57import Control.Applicative
58import Control.Monad
59import Control.Monad.Fail as Fail
60import Data.Char
61import Text.Appar.Input
62
63----------------------------------------------------------------
64
65data MkParser inp a = P {
66  -- | Getting the internal parser.
67    runParser :: inp -> (Maybe a, inp)
68  }
69
70----------------------------------------------------------------
71
72instance Functor (MkParser inp) where
73    f `fmap` p = return f <*> p
74
75instance Applicative (MkParser inp) where
76    pure a = P $ \bs -> (Just a, bs)
77    (<*>)  = ap
78
79instance Alternative (MkParser inp) where
80    empty = mzero
81    (<|>) = mplus
82
83instance Monad (MkParser inp) where
84    return   = pure
85    p >>= f  = P $ \bs -> case runParser p bs of
86        (Nothing, bs') -> (Nothing, bs')
87        (Just a,  bs') -> runParser (f a) bs'
88    -- fixme: GHC 8.x will remove the fail method
89#if !MIN_VERSION_base(4,13,0)
90    fail = Fail.fail
91#endif
92
93instance MonadFail (MkParser inp) where
94    fail _   = P $ \bs -> (Nothing, bs)
95
96instance MonadPlus (MkParser inp) where
97    mzero       = P $ \bs -> (Nothing, bs)
98    p `mplus` q = P $ \bs -> case runParser p bs of
99        (Nothing, bs') -> runParser q bs'
100        (Just a,  bs') -> (Just a, bs')
101
102----------------------------------------------------------------
103
104{-|
105  Run a parser.
106-}
107parse :: Input inp => MkParser inp a -> inp -> Maybe a
108parse p bs = fst (runParser p bs)
109
110----------------------------------------------------------------
111{-|
112  The parser @satisfy f@ succeeds for any character for which the
113  supplied function @f@ returns 'True'. Returns the character that is
114  actually parsed.
115-}
116satisfy :: Input inp => (Char -> Bool) -> MkParser inp Char
117satisfy predicate = P sat
118  where
119    sat bs
120      | isNil bs    = (Nothing, nil)
121      | predicate b = (Just b,  bs')
122      | otherwise   = (Nothing, bs)
123      where
124        b = car bs
125        bs' = cdr bs
126
127----------------------------------------------------------------
128{-|
129  The parser try p behaves like parser p, except that it pretends
130  that it hasn't consumed any input when an error occurs.
131-}
132try :: MkParser inp a -> MkParser inp a
133try p = P $ \bs -> case runParser p bs of
134        (Nothing, _  ) -> (Nothing, bs)
135        (Just a,  bs') -> (Just a,  bs')
136
137----------------------------------------------------------------
138
139{-|
140  @char c@ parses a single character @c@. Returns the parsed character.
141-}
142char :: Input inp => Char -> MkParser inp Char
143char c = satisfy (c ==)
144
145{-|
146  @string s@ parses a sequence of characters given by @s@. Returns
147  the parsed string
148-}
149string :: Input inp => String -> MkParser inp String
150string []     = pure ""
151string (c:cs) = (:) <$> char c <*> string cs
152
153----------------------------------------------------------------
154
155{-|
156  This parser succeeds for any character. Returns the parsed character.
157-}
158anyChar :: Input inp => MkParser inp Char
159anyChar = satisfy (const True)
160
161{-|
162  @oneOf cs@ succeeds if the current character is in the supplied list of
163  characters @cs@. Returns the parsed character.
164-}
165oneOf :: Input inp => String -> MkParser inp Char
166oneOf cs = satisfy (`elem` cs)
167
168{-|
169  As the dual of 'oneOf', @noneOf cs@ succeeds if the current
170  character /not/ in the supplied list of characters @cs@. Returns the
171  parsed character.
172-}
173noneOf :: Input inp => String -> MkParser inp Char
174noneOf cs = satisfy (`notElem` cs)
175
176{-|
177  Parses a letter or digit (a character between \'0\' and \'9\').
178  Returns the parsed character.
179-}
180alphaNum :: Input inp => MkParser inp Char
181alphaNum = satisfy isAlphaNum
182
183{-|
184  Parses a digit. Returns the parsed character.
185-}
186digit :: Input inp => MkParser inp Char
187digit = satisfy isDigit
188
189{-|
190  Parses a hexadecimal digit (a digit or a letter between \'a\' and
191  \'f\' or \'A\' and \'F\'). Returns the parsed character.
192-}
193hexDigit :: Input inp => MkParser inp Char
194hexDigit = satisfy isHexDigit
195
196{-|
197  Parses a white space character (any character which satisfies 'isSpace')
198   Returns the parsed character.
199-}
200space :: Input inp => MkParser inp Char
201space = satisfy isSpace
202
203----------------------------------------------------------------
204
205{-|
206  @choice ps@ tries to apply the parsers in the list @ps@ in order,
207  until one of them succeeds. Returns the value of the succeeding
208  parser.
209-}
210choice :: [MkParser inp a] -> MkParser inp a
211choice = foldr (<|>) mzero
212
213{-|
214  @option x p@ tries to apply parser @p@. If @p@ fails without
215  consuming input, it returns the value @x@, otherwise the value
216  returned by @p@.
217-}
218option :: a -> MkParser inp a -> MkParser inp a
219option x p = p <|> pure x
220
221{-|
222  @skipMany p@ applies the parser @p@ /zero/ or more times, skipping
223  its result.
224-}
225skipMany :: MkParser inp a -> MkParser inp ()
226skipMany p = () <$ many p
227
228{-|
229  @skipSome p@ applies the parser @p@ /one/ or more times, skipping
230  its result.
231-}
232skipSome :: MkParser inp a -> MkParser inp ()
233skipSome p = () <$ some p
234
235{-|
236  @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated
237  by @sep@. Returns a list of values returned by @p@.
238-}
239sepBy1 :: MkParser inp a -> MkParser inp b -> MkParser inp [a]
240sepBy1 p sep = (:) <$> p <*> many (sep *> p)
241
242{-|
243  @manyTill p end@ applies parser @p@ /zero/ or more times until
244  parser @end@ succeeds. Returns the list of values returned by @p@.
245-}
246manyTill :: MkParser inp a -> MkParser inp b -> MkParser inp [a]
247manyTill p end = scan
248  where
249    scan = [] <$ end <|> (:) <$> p <*> scan
250