1module Text.ParserCombinators.Poly.Base 2 ( -- * The PolyParse classes 3 Commitment(..) -- class of all two-level-error values 4 , PolyParse -- class of all monadic two-level-error parsers 5 6 -- * Combinators general to all parser types. 7 -- ** Simple combinators 8 , apply -- :: PolyParse p => p (a->b) -> p a -> p b 9 , discard -- :: PolyParse p => p a -> p b -> p a 10 -- ** Error-handling 11 , failBad -- :: PolyParse p => String -> p a 12 , adjustErrBad-- :: PolyParse p => p a -> (String->String) -> p a 13 , indent -- :: Int -> String -> String 14 -- ** Choices 15 , oneOf -- :: PolyParse p => [p a] -> p a 16 -- ** Sequences 17 , exactly -- :: PolyParse p => Int -> p a -> p [a] 18 , upto -- :: PolyParse p => Int -> p a -> p [a] 19 , many1 -- :: PolyParse p => p a -> p [a] 20 , sepBy -- :: PolyParse p => p a -> p sep -> p [a] 21 , sepBy1 -- :: PolyParse p => p a -> p sep -> p [a] 22 , bracketSep -- :: PolyParse p => p bra -> p sep -> p ket -> p a -> p [a] 23 , bracket -- :: PolyParse p => p bra -> p ket -> p a -> p a 24 , manyFinally -- :: PolyParse p => p a -> p z -> p [a] 25 , manyFinally'-- :: PolyParse p => p a -> p z -> p [a] 26 ) where 27 28import Control.Applicative 29import qualified Control.Monad.Fail as Fail 30 31#ifdef __NHC__ 32default (Integer,Double,[]) -- hack to avoid bizarre type defaulting error 33instance Commitment [] 34instance PolyParse [] 35#endif 36 37-- | The @Commitment@ class is an abstraction over all the current 38-- concrete representations of monadic/applicative parser combinators in this 39-- package. The common feature is two-level error-handling. 40-- Some primitives must be implemented specific to each parser type 41-- (e.g. depending on whether the parser has a running state, or 42-- whether it is lazy). But given those primitives, large numbers of 43-- combinators do not depend any further on the internal structure of 44-- the particular parser. 45class Commitment p where 46 -- | Commit is a way of raising the severity of any errors found within 47 -- its argument. Used in the middle of a parser definition, it means that 48 -- any operations prior to commitment fail softly, but after commitment, 49 -- they fail hard. 50 commit :: p a -> p a 51 -- | @p `adjustErr` f@ applies the transformation @f@ to any error message 52 -- generated in @p@, having no effect if @p@ succeeds. 53 adjustErr :: p a -> (String -> String) -> p a 54 -- | Parse the first alternative that succeeds, but if none succeed, 55 -- report only the severe errors, and if none of those, then report 56 -- all the soft errors. 57 oneOf' :: [(String, p a)] -> p a 58 59-- | The @PolyParse@ class is an abstraction gathering all of the common 60-- features that a two-level error-handling parser requires: 61-- the applicative parsing interface, the monadic interface, and commitment. 62-- 63-- There are two additional basic combinators that we expect to be implemented 64-- afresh for every concrete type, but which (for technical reasons) 65-- cannot be class methods. They are @next@ and @satisfy@. 66class (Functor p, Monad p, Fail.MonadFail p, Applicative p, Alternative p, Commitment p) => 67 PolyParse p 68 69infixl 3 `apply` 70infixl 3 `discard` 71 72-- | Apply a parsed function to a parsed value. 73-- Rather like ordinary function application lifted into parsers. 74apply :: PolyParse p => p (a->b) -> p a -> p b 75apply = (<*>) 76 77-- | @x `discard` y@ parses both x and y, but discards the result of y. 78-- Rather like @const@ lifted into parsers. 79discard :: PolyParse p => p a -> p b -> p a 80px `discard` py = do { x <- px; y <- py; y `seq` return x; } 81 82{- 83-- Combinators we expect most concrete parser types to implement. 84-- For technical reasons, they cannot be class members. 85 86-- | Yield the next token 87next :: PolyParse p => p t 88 -- where t is constrained to be the input token type 89 90-- | One token satisfying a predicate. 91satisfy :: PolyParse p => (t->Bool) -> p t t 92satisfy p = do{ x <- next 93 ; if p x then return x else fail "Parse.satisfy: failed" 94 } 95 -- note: must be re-defined for each implementation because 96 -- its type cannot be expressed otherwise. 97-} 98 99-- | When a simple fail is not strong enough, use failBad for emphasis. 100-- An emphasised (severe) error cannot be overridden by choice 101-- operators. 102failBad :: PolyParse p => String -> p a 103failBad e = commit (Fail.fail e) 104 105-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the 106-- severity of the error. 107adjustErrBad :: PolyParse p => p a -> (String->String) -> p a 108p `adjustErrBad` f = commit (p `adjustErr` f) 109 110-- | Parse the first alternative in the list that succeeds. 111oneOf :: PolyParse p => [p a] -> p a 112oneOf [] = Fail.fail ("failed to parse any of the possible choices") 113oneOf (p:ps) = p <|> oneOf ps 114--oneOf :: Show t => [Parser t a] -> Parser t a 115--oneOf [] = do { n <- next 116-- ; fail ("failed to parse any of the possible choices" 117-- ++"\n next token is "++show n) 118-- } 119--oneOf (p:ps) = p `onFail` oneOf ps 120 121-- | Helper for formatting error messages: indents all lines by a fixed amount. 122indent :: Int -> String -> String 123indent n = unlines . map (replicate n ' ' ++) . lines 124 125-- | 'exactly n p' parses precisely n items, using the parser p, in sequence. 126exactly :: PolyParse p => Int -> p a -> p [a] 127exactly 0 p = return [] 128exactly n p = return (:) `apply` (p `adjustErr` (("When expecting exactly " 129 ++show n++" more items")++)) 130 `apply` exactly (n-1) p 131 132-- | 'upto n p' parses n or fewer items, using the parser p, in sequence. 133upto :: PolyParse p => Int -> p a -> p [a] 134upto 0 p = return [] 135upto n p = do x <- p; return (x:) `apply` upto (n-1) p 136 <|> return [] 137 138 139{- is in Control.Applicative 140-- | 'optional' indicates whether the parser succeeded through the Maybe type. 141optional :: PolyParse p => p a -> p (Maybe a) 142optional p = fmap Just p `onFail` return Nothing 143-} 144{- is in Control.Applicative 145-- | 'many p' parses a list of elements with individual parser p. 146-- Cannot fail, since an empty list is a valid return value. 147many :: PolyParse p => p a -> p [a] 148many p = many1 p `onFail` return [] 149-} 150 151-- | Parse a non-empty list of items. 152many1 :: PolyParse p => p a -> p [a] 153many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2) 154 ; return (x:) `apply` many p 155 } 156-- `adjustErr` ("When looking for a non-empty sequence:\n\t"++) 157 158-- | Parse a list of items separated by discarded junk. 159sepBy :: PolyParse p => p a -> p sep -> p [a] 160sepBy p sep = do sepBy1 p sep <|> return [] 161 162-- | Parse a non-empty list of items separated by discarded junk. 163sepBy1 :: PolyParse p => p a -> p sep -> p [a] 164sepBy1 p sep = do { x <- p 165 ; return (x:) `apply` many (do {sep; p}) 166 } 167 `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++) 168 169-- | Parse a list of items, discarding the start, end, and separator 170-- items. 171bracketSep :: PolyParse p => p bra -> p sep -> p ket -> p a -> p [a] 172bracketSep open sep close p = 173 do { open; close; return [] } 174 <|> 175 do { open `adjustErr` ("Missing opening bracket:\n\t"++) 176 ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++) 177 ; return (x:) 178 `apply` manyFinally (do {sep; p}) 179 (close `adjustErrBad` ("When looking for closing bracket:\n\t"++)) 180 } 181 182-- | Parse a bracketed item, discarding the brackets. 183-- If everything matches /except/ the closing bracket, the whole 184-- parse fails soft, which can give less-than-satisfying error messages. 185-- If you want better error messages, try calling with e.g. 186-- @bracket open (commit close) item@ 187bracket :: PolyParse p => p bra -> p ket -> p a -> p a 188bracket open close p = do 189 do { open `adjustErr` ("Missing opening bracket:\n\t"++) 190 ; p `discard` (close `adjustErr` ("Missing closing bracket:\n\t"++)) 191 } 192 193-- | @manyFinally e t@ parses a possibly-empty sequence of @e@'s, 194-- terminated by a @t@. The final @t@ is discarded. Any parse failures 195-- could be due either to a badly-formed terminator or a badly-formed 196-- element, so it raises both possible errors. 197manyFinally :: PolyParse p => p a -> p z -> p [a] 198{- 199-- This implementation is incorrect. If at least one item has been 200-- parsed, but the terminator is missing, then this erroneously succeeds 201-- returning the empty list. 202manyFinally p t = 203 (many p `discard` t) 204 <|> 205 oneOf' [ ("sequence terminator", do { t; return [] } ) 206 , ("item in a sequence", do { p; return [] } ) 207 ] 208-} 209 210manyFinally p t = 211 do { xs <- many p 212 ; oneOf' [ ("sequence terminator", do { t; return () } ) 213 , ("item in a sequence", do { p; return () } ) 214 ] 215 ; return xs 216 } 217 218-- | @manyFinally'@ is like @manyFinally@, except when the terminator 219-- parser overlaps with the element parser. In @manyFinally e t@, 220-- the parser @t@ is tried only when parser @e@ fails, whereas in 221-- @manyFinally' e t@, the parser @t@ is always tried first, then 222-- parser @e@ only if the terminator is not found. For instance, 223-- @manyFinally (accept "01") (accept "0")@ on input @"0101010"@ returns 224-- @["01","01","01"]@, whereas @manyFinally'@ with the same arguments 225-- and input returns @[]@. 226manyFinally' :: (PolyParse p, Show a) => p a -> p z -> p [a] 227manyFinally' p t = fmap reverse $ go [] 228 where 229 go acc = ( do t; return acc ) 230 <|> 231 ( do { x <- p 232 <|> 233 oneOf' [ ( "terminator in a manyFinally' sequence" 234 , do { t; return undefined } 235 ) 236 , ( "item in a manyFinally' sequence", p) 237 ] 238 `adjustErr` (("After successful partial sequence " 239 ++show (reverse acc)++",\n")++) 240 ; go (x: acc) 241 } 242 ) 243 244 245------------------------------------------------------------------------ 246