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