| onFail | | 1 (Function) | Text.ParserCombinators.Poly, Text.Parse | | 2 (Function) | Text.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.NoLeak.Lazy, Text.ParserCombinators.Poly.NoLeak.Plain, Text.ParserCombinators.Poly.NoLeak.State, Text.ParserCombinators.Poly.NoLeak.StateLazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy | | 3 (Function) | Text.ParserCombinators.PolyLazy | | 4 (Function) | Text.ParserCombinators.PolyState | | 5 (Function) | Text.ParserCombinators.PolyStateLazy | , Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy, Text.ParserCombinators.Poly, Text.Parse | oneOf | | 1 (Function) | Text.ParserCombinators.Poly, Text.Parse | | 2 (Function) | Text.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.NoLeak.Lazy, Text.ParserCombinators.Poly.NoLeak.Plain, Text.ParserCombinators.Poly.NoLeak.State, Text.ParserCombinators.Poly.NoLeak.StateLazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy | | 3 (Function) | Text.ParserCombinators.PolyLazy | | 4 (Function) | Text.ParserCombinators.PolyState | | 5 (Function) | Text.ParserCombinators.PolyStateLazy | , Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy, Text.ParserCombinators.Poly, Text.Parse | oneOf' | | 1 (Function) | Text.ParserCombinators.Poly, Text.Parse | | 2 (Function) | Text.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.NoLeak.Lazy, Text.ParserCombinators.Poly.NoLeak.Plain, Text.ParserCombinators.Poly.NoLeak.State, Text.ParserCombinators.Poly.NoLeak.StateLazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy | | 3 (Function) | Text.ParserCombinators.PolyLazy | | 4 (Function) | Text.ParserCombinators.PolyState | | 5 (Function) | Text.ParserCombinators.PolyStateLazy | , Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy, Text.ParserCombinators.Poly, Text.Parse | | optional | | 1 (Function) | Text.ParserCombinators.Poly, Text.Parse | | 2 (Function) | Text.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.NoLeak.Lazy, Text.ParserCombinators.Poly.NoLeak.Plain, Text.ParserCombinators.Poly.NoLeak.State, Text.ParserCombinators.Poly.NoLeak.StateLazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy | | 3 (Function) | Text.ParserCombinators.PolyLazy | | 4 (Function) | Text.ParserCombinators.PolyStateLazy | , Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy, Text.ParserCombinators.Poly, Text.Parse | 3 (Data Constructor) | Text.ParserCombinators.Poly, Text.Parse | | 4 (Data Constructor) | Text.ParserCombinators.Poly.Lazy | | 5 (Data Constructor) | Text.ParserCombinators.Poly.NoLeak.Lazy | | 6 (Data Constructor) | Text.ParserCombinators.Poly.NoLeak.Plain | | 7 (Data Constructor) | Text.ParserCombinators.Poly.NoLeak.State | | 8 (Data Constructor) | Text.ParserCombinators.Poly.NoLeak.StateLazy | | 9 (Data Constructor) | 4 (Data Constructor)Text.ParserCombinators.Poly.Plain | , Text.ParserCombinators.Poly, Text.Parse | 10 (Data Constructor) | 5 (Data Constructor)Text.ParserCombinators.Poly.State | | 11 (Data Constructor) | 6 (Data Constructor)Text.ParserCombinators.Poly.StateLazy | | 12 (Data Constructor) | Text.ParserCombinators.PolyLazy | | 13 (Data Constructor) | Text.ParserCombinators.PolyState | | 14 (Data Constructor) | Text.ParserCombinators.PolyStateLazy | | Parse | | 3 (Type/Class) | Text.ParserCombinators.Poly, Text.Parse | Text.ParserCombinators.Poly.Lazy | 4 (Type/Class) | Text.ParserCombinators.Poly.Lazy | Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly, Text.Parse | 5 (Type/Class) | Text.ParserCombinators.Poly.NoLeak.LazyText.ParserCombinators.Poly.State | | 6 (Type/Class) | Text.ParserCombinators.Poly.NoLeak.PlainText.ParserCombinators.Poly.StateLazy | | 7 (Type/Class) | PolyParse | Text.ParserCombinators.Poly.NoLeak.State | Text.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy, Text.ParserCombinators.Poly, Text.Parse | papply | | 8 (Type/Class) | 1 (Function)Text.ParserCombinators.Poly.NoLeak.StateLazyText.ParserCombinators.HuttonMeijer | | 9 (Type/Class) | 2 (Function)Text.ParserCombinators.Poly.PlainText.ParserCombinators.HuttonMeijerWallace | | 10 (Type/Class) | papply' | Text.ParserCombinators.Poly.StateText.ParserCombinators.HuttonMeijerWallace | | 11 (Type/Class) | parens | Text.ParserCombinators.Poly.StateLazyText.Parse | | 12 (Type/Class) | parse | Text.ParserCombinators.PolyLazyText.Parse | | 13 (Type/Class) | parseByRead | Text.ParserCombinators.PolyStateText.Parse | | 14 (Type/Class) | parseDec | Text.ParserCombinators.PolyStateLazyText.Parse | | PolyParse | parseFloatText.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.NoLeak.Lazy, Text.ParserCombinators.Poly.NoLeak.Plain, Text.ParserCombinators.Poly.NoLeak.State, Text.ParserCombinators.Poly.NoLeak.StateLazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy | Text.Parse | papply | parseHex | Text.Parse | | 1 (Function) | parseInt | Text.ParserCombinators.HuttonMeijerText.Parse | | 2 (Function) | parseList | Text.ParserCombinators.HuttonMeijerWallaceText.Parse | | papply' | parseLitCharText.ParserCombinators.HuttonMeijerWallaceText.Parse | | parse | parseOctText.Parse | | parseByRead | parsePrecText.Parse | | parseList | parseSignedText.Parse | | sat | Text.ParserCombinators.HuttonMeijer | | satisfy | | 1 (Function) | Text.ParserCombinators.Poly, Text.Parse | Success | 2 (Function) | 1 (Data Constructor)Text.ParserCombinators.Poly.Lazy | | 3 (Function) | Text.ParserCombinators.Poly.NoLeak.Lazy | | 4 (Function) | Text.ParserCombinators.Poly.NoLeak.Plain | | 5 (Function) | Text.ParserCombinators.Poly.NoLeak.State | | 6 (Function) | Text.ParserCombinators.Poly.NoLeak.StateLazy | | 7 (Function) | 2 (Data Constructor)Text.ParserCombinators.Poly.Plain | , Text.ParserCombinators.Poly, Text.Parse | 8 (Function) | 3 (Data Constructor)Text.ParserCombinators.Poly.State | | 9 (Function) | 4 (Data Constructor)Text.ParserCombinators.Poly.StateLazy | | 10 (Function) | Text.ParserCombinators.PolyLazy | | 11 (Function) | Text.ParserCombinators.PolyState | | 12 (Function) | sat | Text.ParserCombinators.PolyStateLazyText.ParserCombinators.HuttonMeijer | | sepBy | satisfy | 1 (Function) | Text.ParserCombinators.Poly, Text.Parse | Text.ParserCombinators.Poly.Lazy | 2 (Function) | Text.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.NoLeak.Lazy, Text.ParserCombinators.Poly.NoLeak.Plain, Text.ParserCombinators.Poly.NoLeak.State, Text.ParserCombinators.Poly.NoLeak.StateLazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy | Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly, Text.Parse | 3 (Function) | Text.ParserCombinators.PolyLazyText.ParserCombinators.Poly.State | | 4 (Function) | Text.ParserCombinators.PolyStateText.ParserCombinators.Poly.StateLazy | | 5 (Function) | sepBy | Text.ParserCombinators.PolyStateLazy | Text.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy, Text.ParserCombinators.Poly, Text.Parse | sepBy1 | | 1 (Function) | Text.ParserCombinators.Poly, Text.Parse | | 2 (Function) | Text.ParserCombinators.Poly.Base, Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.NoLeak.Lazy, Text.ParserCombinators.Poly.NoLeak.Plain, Text.ParserCombinators.Poly.NoLeak.State, Text.ParserCombinators.Poly.NoLeak.StateLazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy | | 3 (Function) | Text.ParserCombinators.PolyLazy | | 4 (Function) | Text.ParserCombinators.PolyState | | 5 (Function) | Text.ParserCombinators.PolyStateLazy | , Text.ParserCombinators.Poly.Lazy, Text.ParserCombinators.Poly.Plain, Text.ParserCombinators.Poly.State, Text.ParserCombinators.Poly.StateLazy, Text.ParserCombinators.Poly, Text.Parse | 1 (Function) | Text.ParserCombinators.Poly.NoLeak.State | | 2 (Function) | Text.ParserCombinators.Poly.NoLeak.StateLazy | | 3 (Function) | Text.ParserCombinators.Poly.State | | 4 (Function) | 2 (Function)Text.ParserCombinators.Poly.StateLazy | | 5 (Function) | Text.ParserCombinators.PolyState | | 6 (Function) | Text.ParserCombinators.PolyStateLazy | | stQuery | 1 (Function) | Text.ParserCombinators.Poly.NoLeak.State | | 2 (Function) | Text.ParserCombinators.Poly.NoLeak.StateLazy | | 3 (Function) | Text.ParserCombinators.Poly.State | | 4 (Function) | 2 (Function)Text.ParserCombinators.Poly.StateLazy | | 5 (Function) | Text.ParserCombinators.PolyState | | 6 (Function) | Text.ParserCombinators.PolyStateLazy | | stUpdate | 1 (Function) | Text.ParserCombinators.Poly.NoLeak.State | | 2 (Function) | Text.ParserCombinators.Poly.NoLeak.StateLazy | | 3 (Function) | Text.ParserCombinators.Poly.State | | 4 (Function) | 2 (Function)Text.ParserCombinators.Poly.StateLazy | | 5 (Function) | Text.ParserCombinators.PolyState | | 6 (Function) | Text.ParserCombinators.PolyStateLazy | |
 NoLeak | | | | | Text.ParserCombinators.Poly.Plain |
| | Text.ParserCombinators.PolyLazy | | | | Text.ParserCombinators.PolyState | | | | Text.ParserCombinators.PolyStateLazy | | |
-module Text.Parse
- ( -- * The Parse class is a replacement for the standard Read class.
- -- $parser
- TextParser -- synonym for Parser Char, i.e. string input, no state
- , Parse(..) -- instances: (), (a,b), (a,b,c), Maybe a, Either a, [a],
- -- Int, Integer, Float, Double, Char, Bool
- , parseByRead -- :: Read a => String -> TextParser a
- -- ** Combinators specific to string input, lexed haskell-style
- , word -- :: TextParser String
- , isWord -- :: String -> TextParser ()
- , optionalParens -- :: TextParser a -> TextParser a
- , field -- :: Parse a => String -> TextParser a
- , constructors-- :: [(String,TextParser a)] -> TextParser a
- , enumeration -- :: Show a => String -> [a] -> TextParser a
- -- ** Re-export all the more general combinators from Poly too
- , module Text.ParserCombinators.Poly
- ) where
-
-import Char (isSpace)
-import List (intersperse)
-import Text.ParserCombinators.Poly
-
-------------------------------------------------------------------------
--- $parser
--- The Parse class is a replacement for the standard Read class. It is a
--- specialisation of the (poly) Parser monad for String input.
--- There are instances defined for all Prelude types.
--- For user-defined types, you can write your own instance, or use
--- DrIFT to generate them automatically, e.g. {-! derive : Parse !-}
-
--- | A synonym for Parser Char, i.e. string input (no state)
-type TextParser a = Parser Char a
-
--- | The class @Parse@ is a replacement for @Read@, operating over String input.
--- Essentially, it permits better error messages for why something failed to
--- parse. It is rather important that @parse@ can read back exactly what
--- is generated by the corresponding instance of @show@. To apply a parser
--- to some text, use @runParser@.
-class Parse a where
- parse :: TextParser a
- parseList :: TextParser [a] -- only to distinguish [] and ""
- parseList = do { isWord "[]"; return [] }
- `onFail`
- do { isWord "["; isWord "]"; return [] }
- `onFail`
- bracketSep (isWord "[") (isWord ",") (isWord "]") parse
- `adjustErr` ("Expected a list, but\n"++)
-
--- | If there already exists a Read instance for a type, then we can make
--- a Parser for it, but with only poor error-reporting.
-parseByRead :: Read a => String -> TextParser a
-parseByRead name =
- P (\s-> case reads s of
- [] -> (Left (False,"no parse, expected a "++name), s)
- [(a,s')] -> (Right a, s')
- _ -> (Left (False,"ambiguous parse, expected a "++name), s)
- )
-
--- | One lexical chunk (Haskell-style lexing).
-word :: TextParser String
-word = P (\s-> case lex s of
- [] -> (Left (False,"no input? (impossible)"), s)
- [("",s')] -> (Left (False,"no input?"), s')
- ((x,s'):_) -> (Right x, s') )
-
--- | Ensure that the next input word is the given string. (Note the input
--- is lexed as haskell, so wordbreaks at spaces, symbols, etc.)
-isWord :: String -> TextParser String
-isWord w = do { w' <- word
- ; if w'==w then return w else fail ("expected "++w++" got "++w')
- }
-
--- | Allow true string parens around an item.
-optionalParens :: TextParser a -> TextParser a
-optionalParens p = bracket (isWord "(") (isWord ")") p `onFail` p
-
--- | Deal with named field syntax. The string argument is the field name,
--- and the parser returns the value of the field.
-field :: Parse a => String -> TextParser a
-field name = do { isWord name; commit $ do { isWord "="; parse } }
-
--- | Parse one of a bunch of alternative constructors. In the list argument,
--- the first element of the pair is the constructor name, and
--- the second is the parser for the rest of the value. The first matching
--- parse is returned.
-constructors :: [(String,TextParser a)] -> TextParser a
-constructors cs = oneOf' (map cons cs)
- where cons (name,p) =
- ( name
- , do { isWord name
- ; p `adjustErrBad` (("got constructor, but within "
- ++name++",\n")++)
- }
- )
-
--- | Parse one of the given nullary constructors (an enumeration).
--- The string argument is the name of the type, and the list argument
--- should contain all of the possible enumeration values.
-enumeration :: (Show a) => String -> [a] -> TextParser a
-enumeration typ cs = oneOf (map (\c-> do { isWord (show c); return c }) cs)
- `adjustErr`
- (++("\n expected "++typ++" value ("++e++")"))
- where e = concat (intersperse ", " (map show (init cs)))
- ++ ", or " ++ show (last cs)
-
-------------------------------------------------------------------------
--- Instances for all the Standard Prelude types.
-
--- Basic types
-instance Parse Int where
- parse = parseByRead "Int"
-instance Parse Integer where
- parse = parseByRead "Integer"
-instance Parse Float where
- parse = parseByRead "Float"
-instance Parse Double where
- parse = parseByRead "Double"
-instance Parse Char where
- parse = parseByRead "Char"
- -- parseList = bracket (isWord "\"") (satisfy (=='"'))
- -- (many (satisfy (/='"')))
- -- not totally correct for strings...
- parseList = do { w <- word; if head w == '"' then return (init (tail w))
- else fail "not a string" }
-
-instance Parse Bool where
- parse = enumeration "Bool" [False,True]
-
-instance Parse Ordering where
- parse = enumeration "Ordering" [LT,EQ,GT]
-
--- Structural types
-instance Parse () where
- parse = P p
- where p [] = (Left (False,"no input: expected a ()"), [])
- p ('(':cs) = case dropWhile isSpace cs of
- (')':s) -> (Right (), s)
- _ -> (Left (False,"Expected ) after ("), cs)
- p (c:cs) | isSpace c = p cs
- | otherwise = ( Left (False,"Expected a (), got "++show c)
- , (c:cs))
-
-instance (Parse a, Parse b) => Parse (a,b) where
- parse = do{ isWord "(" `adjustErr` ("Opening a 2-tuple\n"++)
- ; x <- parse `adjustErr` ("In 1st item of a 2-tuple\n"++)
- ; isWord "," `adjustErr` ("Separating a 2-tuple\n"++)
- ; y <- parse `adjustErr` ("In 2nd item of a 2-tuple\n"++)
- ; isWord ")" `adjustErr` ("Closing a 2-tuple\n"++)
- ; return (x,y) }
-
-instance (Parse a, Parse b, Parse c) => Parse (a,b,c) where
- parse = do{ isWord "(" `adjustErr` ("Opening a 3-tuple\n"++)
- ; x <- parse `adjustErr` ("In 1st item of a 3-tuple\n"++)
- ; isWord "," `adjustErr` ("Separating(1) a 3-tuple\n"++)
- ; y <- parse `adjustErr` ("In 2nd item of a 3-tuple\n"++)
- ; isWord "," `adjustErr` ("Separating(2) a 3-tuple\n"++)
- ; z <- parse `adjustErr` ("In 3rd item of a 3-tuple\n"++)
- ; isWord ")" `adjustErr` ("Closing a 3-tuple\n"++)
- ; return (x,y,z) }
-
-instance Parse a => Parse (Maybe a) where
- parse = do { isWord "Nothing"; return Nothing }
- `onFail`
- do { isWord "Just"
- ; fmap Just $ optionalParens parse
- `adjustErrBad` ("but within Just, "++)
- }
- `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2)
-
-instance (Parse a, Parse b) => Parse (Either a b) where
- parse = constructors [ ("Left", do { fmap Left $ optionalParens parse } )
- , ("Right", do { fmap Right $ optionalParens parse } )
- ]
-
-instance Parse a => Parse [a] where
- parse = parseList
-
-------------------------------------------------------------------------
+
+
+src/Text/Parse.hs
+
+
+module Text.Parse
+ ( -- * The Parse class is a replacement for the standard Read class.
+ -- $parser
+ TextParser -- synonym for Parser Char, i.e. string input, no state
+ , Parse(..) -- instances: (), (a,b), (a,b,c), Maybe a, Either a, [a],
+ -- Int, Integer, Float, Double, Char, Bool
+ , parseByRead -- :: Read a => String -> TextParser a
+ -- ** Combinators specific to string input, lexed haskell-style
+ , word -- :: TextParser String
+ , isWord -- :: String -> TextParser ()
+ , optionalParens -- :: TextParser a -> TextParser a
+ , parens -- :: Bool -> TextParser a -> TextParser a
+ , field -- :: Parse a => String -> TextParser a
+ , constructors-- :: [(String,TextParser a)] -> TextParser a
+ , enumeration -- :: Show a => String -> [a] -> TextParser a
+ -- ** Parsers for literal numerics and characters
+ , parseSigned
+ , parseInt
+ , parseDec
+ , parseOct
+ , parseHex
+ , parseFloat
+ , parseLitChar
+ -- ** Re-export all the more general combinators from Poly too
+ , module Text.ParserCombinators.Poly
+ ) where
+
+import Char (isSpace,toLower,isUpper,isDigit,isOctDigit,isHexDigit,digitToInt
+ ,ord,chr)
+import List (intersperse)
+import Ratio
+import Text.ParserCombinators.Poly
+
+------------------------------------------------------------------------
+-- $parser
+-- The Parse class is a replacement for the standard Read class. It is a
+-- specialisation of the (poly) Parser monad for String input.
+-- There are instances defined for all Prelude types.
+-- For user-defined types, you can write your own instance, or use
+-- DrIFT to generate them automatically, e.g. {-! derive : Parse !-}
+
+-- | A synonym for Parser Char, i.e. string input (no state)
+type TextParser a = Parser Char a
+
+-- | The class @Parse@ is a replacement for @Read@, operating over String input.
+-- Essentially, it permits better error messages for why something failed to
+-- parse. It is rather important that @parse@ can read back exactly what
+-- is generated by the corresponding instance of @show@. To apply a parser
+-- to some text, use @runParser@.
+class Parse a where
+ -- | A straightforward parser for an item. (A minimal definition of
+ -- a class instance requires either |parse| or |parsePrec|.)
+ parse :: TextParser a
+ parse = parsePrec 0
+ -- | A straightforward parser for an item, given the precedence of
+ -- any surrounding expression. (Precedence determines whether
+ -- parentheses are mandatory or optional.)
+ parsePrec :: Int -> TextParser a
+ parsePrec _ = parens False parse
+ -- | Parsing a list of items by default accepts the [] and comma syntax,
+ -- except when the list is really a character string using \"\".
+ parseList :: TextParser [a] -- only to distinguish [] and ""
+ parseList = do { isWord "[]"; return [] }
+ `onFail`
+ do { isWord "["; isWord "]"; return [] }
+ `onFail`
+ bracketSep (isWord "[") (isWord ",") (isWord "]") parse
+ `adjustErr` ("Expected a list, but\n"++)
+
+-- | If there already exists a Read instance for a type, then we can make
+-- a Parser for it, but with only poor error-reporting. The string argument
+-- is the expected type or value (for error-reporting only).
+parseByRead :: Read a => String -> TextParser a
+parseByRead name =
+ P (\s-> case reads s of
+ [] -> Failure s ("no parse, expected a "++name)
+ [(a,s')] -> Success s' a
+ _ -> Failure s ("ambiguous parse, expected a "++name)
+ )
+
+-- | One lexical chunk (Haskell-style lexing).
+word :: TextParser String
+word = P (\s-> case lex s of
+ [] -> Failure s ("no input? (impossible)")
+ [("","")] -> Failure "" ("no input?")
+ [("",s')] -> Failure s ("lexing failed?")
+ ((x,s'):_) -> Success s' x
+ )
+
+-- | Ensure that the next input word is the given string. (Note the input
+-- is lexed as haskell, so wordbreaks at spaces, symbols, etc.)
+isWord :: String -> TextParser String
+isWord w = do { w' <- word
+ ; if w'==w then return w else fail ("expected "++w++" got "++w')
+ }
+
+-- | Allow true string parens around an item.
+optionalParens :: TextParser a -> TextParser a
+optionalParens p = bracket (isWord "(") (isWord ")") p `onFail` p
+
+-- | Allow nested parens around an item (one set required when Bool is True).
+parens :: Bool -> TextParser a -> TextParser a
+parens True p = bracket (isWord "(") (isWord ")") (parens False p)
+parens False p = parens True p `onFail` p
+
+-- | Deal with named field syntax. The string argument is the field name,
+-- and the parser returns the value of the field.
+field :: Parse a => String -> TextParser a
+field name = do { isWord name; commit $ do { isWord "="; parse } }
+
+-- | Parse one of a bunch of alternative constructors. In the list argument,
+-- the first element of the pair is the constructor name, and
+-- the second is the parser for the rest of the value. The first matching
+-- parse is returned.
+constructors :: [(String,TextParser a)] -> TextParser a
+constructors cs = oneOf' (map cons cs)
+ where cons (name,p) =
+ ( name
+ , do { isWord name
+ ; p `adjustErrBad` (("got constructor, but within "
+ ++name++",\n")++)
+ }
+ )
+
+{-
+-- | Parse an infix constructor.
+infixConstructor :: (Parse a, Parse b) =>
+ String -> Int -> (a->b->c) -> Int -> TextParser c
+infixConstructor name prec cons = \d->
+ parens (prec<d) (do a <- parsePrec (prec+1)
+ isWord name `adjustErr`
+ (++("expected infix constructor "++name))
+ b <- parsePrec (prec+1)
+ return (cons a b) )
+
+--infixLeftAssoc :: (Parse a, Parse b) =>
+-- String -> Int -> (a->b->a) -> Int -> TextParser a
+--infixLeftAssoc name prec cons = \d->
+-- parens (prec<d) (do a <-
+-}
+
+-- | Parse one of the given nullary constructors (an enumeration).
+-- The string argument is the name of the type, and the list argument
+-- should contain all of the possible enumeration values.
+enumeration :: (Show a) => String -> [a] -> TextParser a
+enumeration typ cs = oneOf (map (\c-> do { isWord (show c); return c }) cs)
+ `adjustErr`
+ (++("\n expected "++typ++" value ("++e++")"))
+ where e = concat (intersperse ", " (map show (init cs)))
+ ++ ", or " ++ show (last cs)
+
+------------------------------------------------------------------------
+-- Instances for all the Standard Prelude types.
+
+-- Numeric types
+parseSigned :: Real a => TextParser a -> TextParser a
+parseSigned p = do '-' <- next; commit (fmap negate p)
+ `onFail`
+ do p
+
+parseInt :: (Integral a) => String ->
+ a -> (Char -> Bool) -> (Char -> Int) ->
+ a -> TextParser a
+parseInt base radix isDigit digitToInt n = go n
+ where go acc = do cs <- many1 (satisfy isDigit)
+ return (foldl1 (\n d-> n*radix+d)
+ (map (fromIntegral.digitToInt) cs))
+ `adjustErr` (++("\nexpected one or more "++base++" digits"))
+parseDec, parseOct, parseHex :: (Integral a) => a -> TextParser a
+parseDec = parseInt "decimal" 10 Char.isDigit Char.digitToInt
+parseOct = parseInt "octal" 8 Char.isOctDigit Char.digitToInt
+parseHex = parseInt "hex" 16 Char.isHexDigit Char.digitToInt
+
+parseFloat :: (RealFrac a) => TextParser a
+parseFloat = do ds <- many1 (satisfy isDigit)
+ frac <- (do '.' <- next
+ many (satisfy isDigit)
+ `adjustErrBad` (++"expected digit after .")
+ `onFail` return [] )
+ exp <- (do 'e' <- fmap toLower next
+ commit (do '+' <- next; parseDec 0
+ `onFail`
+ parseSigned (parseDec 0) ))
+ ( return . fromRational . (* (10^^(exp - length frac)))
+ . (%1) . (\ (Right x)->x) . fst
+ . runParser (parseDec 0) ) (ds++frac)
+ `onFail`
+ do w <- many (satisfy (not.isSpace))
+ case map toLower w of
+ "nan" -> return (0/0)
+ "infinity" -> return (1/0)
+ _ -> fail "expected a floating point number"
+
+parseLitChar :: TextParser Char
+parseLitChar = do '\'' <- next `adjustErr` (++"expected a literal char")
+ c <- next
+ char <- case c of
+ '\\' -> next >>= escape
+ '\'' -> fail "expected a literal char, got ''"
+ _ -> return c
+ '\'' <- next `adjustErrBad` (++"literal char has no final '")
+ return char
+ where
+ escape 'a' = return '\a'
+ escape 'b' = return '\b'
+ escape 'f' = return '\f'
+ escape 'n' = return '\n'
+ escape 'r' = return '\r'
+ escape 't' = return '\t'
+ escape 'v' = return '\v'
+ escape '\\' = return '\\'
+ escape '"' = return '"'
+ escape '\'' = return '\''
+ escape '^' = do ctrl <- next
+ if ctrl >= '@' && ctrl <= '_'
+ then return (chr (ord ctrl - ord '@'))
+ else fail ("literal char ctrl-escape malformed: \\^"
+ ++[ctrl])
+ escape d | isDigit d
+ = fmap chr $ parseDec (Char.digitToInt d)
+ escape 'o' = fmap chr $ parseOct 0
+ escape 'x' = fmap chr $ parseHex 0
+ escape c | isUpper c
+ = mnemonic c
+ escape c = fail ("unrecognised escape sequence in literal char: \\"++[c])
+
+ mnemonic 'A' = do 'C' <- next; 'K' <- next; return '\ACK'
+ `wrap` "'\\ACK'"
+ mnemonic 'B' = do 'E' <- next; 'L' <- next; return '\BEL'
+ `onFail`
+ do 'S' <- next; return '\BS'
+ `wrap` "'\\BEL' or '\\BS'"
+ mnemonic 'C' = do 'R' <- next; return '\CR'
+ `onFail`
+ do 'A' <- next; 'N' <- next; return '\CAN'
+ `wrap` "'\\CR' or '\\CAN'"
+ mnemonic 'D' = do 'E' <- next; 'L' <- next; return '\DEL'
+ `onFail`
+ do 'L' <- next; 'E' <- next; return '\DLE'
+ `onFail`
+ do 'C' <- next; ( do '1' <- next; return '\DC1'
+ `onFail`
+ do '2' <- next; return '\DC2'
+ `onFail`
+ do '3' <- next; return '\DC3'
+ `onFail`
+ do '4' <- next; return '\DC4' )
+ `wrap` "'\\DEL' or '\\DLE' or '\\DC[1..4]'"
+ mnemonic 'E' = do 'T' <- next; 'X' <- next; return '\ETX'
+ `onFail`
+ do 'O' <- next; 'T' <- next; return '\EOT'
+ `onFail`
+ do 'N' <- next; 'Q' <- next; return '\ENQ'
+ `onFail`
+ do 'T' <- next; 'B' <- next; return '\ETB'
+ `onFail`
+ do 'M' <- next; return '\EM'
+ `onFail`
+ do 'S' <- next; 'C' <- next; return '\ESC'
+ `wrap` "one of '\\ETX' '\\EOT' '\\ENQ' '\\ETB' '\\EM' or '\\ESC'"
+ mnemonic 'F' = do 'F' <- next; return '\FF'
+ `onFail`
+ do 'S' <- next; return '\FS'
+ `wrap` "'\\FF' or '\\FS'"
+ mnemonic 'G' = do 'S' <- next; return '\GS'
+ `wrap` "'\\GS'"
+ mnemonic 'H' = do 'T' <- next; return '\HT'
+ `wrap` "'\\HT'"
+ mnemonic 'L' = do 'F' <- next; return '\LF'
+ `wrap` "'\\LF'"
+ mnemonic 'N' = do 'U' <- next; 'L' <- next; return '\NUL'
+ `onFail`
+ do 'A' <- next; 'K' <- next; return '\NAK'
+ `wrap` "'\\NUL' or '\\NAK'"
+ mnemonic 'R' = do 'S' <- next; return '\RS'
+ `wrap` "'\\RS'"
+ mnemonic 'S' = do 'O' <- next; 'H' <- next; return '\SOH'
+ `onFail`
+ do 'O' <- next; return '\SO'
+ `onFail`
+ do 'T' <- next; 'X' <- next; return '\STX'
+ `onFail`
+ do 'I' <- next; return '\SI'
+ `onFail`
+ do 'Y' <- next; 'N' <- next; return '\SYN'
+ `onFail`
+ do 'U' <- next; 'B' <- next; return '\SUB'
+ `onFail`
+ do 'P' <- next; return '\SP'
+ `wrap` "'\\SOH' '\\SO' '\\STX' '\\SI' '\\SYN' '\\SUB' or '\\SP'"
+ mnemonic 'U' = do 'S' <- next; return '\US'
+ `wrap` "'\\US'"
+ mnemonic 'V' = do 'T' <- next; return '\VT'
+ `wrap` "'\\VT'"
+ wrap p s = p `onFail` fail ("expected literal char "++s)
+
+-- Basic types
+instance Parse Int where
+ -- parse = parseByRead "Int" -- convert from Integer, deals with minInt
+ parse = fmap fromInteger $
+ do many (satisfy isSpace); parseSigned (parseDec 0)
+instance Parse Integer where
+ -- parse = parseByRead "Integer"
+ parse = do many (satisfy isSpace); parseSigned (parseDec 0)
+instance Parse Float where
+ -- parse = parseByRead "Float"
+ parse = do many (satisfy isSpace); parseSigned parseFloat
+instance Parse Double where
+ -- parse = parseByRead "Double"
+ parse = do many (satisfy isSpace); parseSigned parseFloat
+instance Parse Char where
+-- parse = parseByRead "Char"
+ parse = do many (satisfy isSpace); parseLitChar
+ -- parse = do { w <- word; if head w == '\'' then readLitChar (tail w)
+ -- else fail "expected a char" }
+ -- parseList = bracket (isWord "\"") (satisfy (=='"'))
+ -- (many (satisfy (/='"')))
+ -- not totally correct for strings...
+ parseList = do { w <- word; if head w == '"' then return (init (tail w))
+ else fail "not a string" }
+
+instance Parse Bool where
+ parse = enumeration "Bool" [False,True]
+
+instance Parse Ordering where
+ parse = enumeration "Ordering" [LT,EQ,GT]
+
+-- Structural types
+instance Parse () where
+ parse = P p
+ where p [] = Failure [] "no input: expected a ()"
+ p ('(':cs) = case dropWhile isSpace cs of
+ (')':s) -> Success s ()
+ _ -> Failure cs "Expected ) after ("
+ p (c:cs) | isSpace c = p cs
+ | otherwise = Failure (c:cs) ("Expected a (), got "++show c)
+
+instance (Parse a, Parse b) => Parse (a,b) where
+ parse = do{ isWord "(" `adjustErr` ("Opening a 2-tuple\n"++)
+ ; x <- parse `adjustErr` ("In 1st item of a 2-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating a 2-tuple\n"++)
+ ; y <- parse `adjustErr` ("In 2nd item of a 2-tuple\n"++)
+ ; isWord ")" `adjustErr` ("Closing a 2-tuple\n"++)
+ ; return (x,y) }
+
+instance (Parse a, Parse b, Parse c) => Parse (a,b,c) where
+ parse = do{ isWord "(" `adjustErr` ("Opening a 3-tuple\n"++)
+ ; x <- parse `adjustErr` ("In 1st item of a 3-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating(1) a 3-tuple\n"++)
+ ; y <- parse `adjustErr` ("In 2nd item of a 3-tuple\n"++)
+ ; isWord "," `adjustErr` ("Separating(2) a 3-tuple\n"++)
+ ; z <- parse `adjustErr` ("In 3rd item of a 3-tuple\n"++)
+ ; isWord ")" `adjustErr` ("Closing a 3-tuple\n"++)
+ ; return (x,y,z) }
+
+instance Parse a => Parse (Maybe a) where
+ parsePrec p =
+ parens False (do { isWord "Nothing"; return Nothing })
+ `onFail`
+ parens (p>9) (do { isWord "Just"
+ ; fmap Just $ parsePrec 10
+ `adjustErrBad` ("but within Just, "++) })
+ `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2)
+
+instance (Parse a, Parse b) => Parse (Either a b) where
+ parsePrec p =
+ parens (p>9) $
+ constructors [ ("Left", do { fmap Left $ parsePrec 10 } )
+ , ("Right", do { fmap Right $ parsePrec 10 } )
+ ]
+
+instance Parse a => Parse [a] where
+ parse = parseList
+
+------------------------------------------------------------------------
+
diff --git a/docs/haddock/src/Text/ParserCombinators/HuttonMeijer.html b/docs/haddock/src/Text/ParserCombinators/HuttonMeijer.html
--- a/docs/haddock/src/Text/ParserCombinators/HuttonMeijer.html
+++ b/docs/haddock/src/Text/ParserCombinators/HuttonMeijer.html
@@ -1,222 +1,228 @@
------------------------------------------------------------------------------
--- |
--- Module : Text.ParserCombinators.HuttonMeijer
--- Copyright : Graham Hutton (University of Nottingham), Erik Meijer (University of Utrecht)
--- Licence : BSD
---
--- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
--- Stability : Stable
--- Portability : All
---
--- A LIBRARY OF MONADIC PARSER COMBINATORS
---
--- 29th July 1996
---
--- Graham Hutton Erik Meijer
--- University of Nottingham University of Utrecht
---
--- This Haskell script defines a library of parser combinators, and is
--- taken from sections 1-6 of our article "Monadic Parser Combinators".
--- Some changes to the library have been made in the move from Gofer
--- to Haskell:
---
--- * Do notation is used in place of monad comprehension notation;
---
--- * The parser datatype is defined using "newtype", to avoid the overhead
--- of tagging and untagging parsers with the P constructor.
------------------------------------------------------------------------------
-
-
-module Text.ParserCombinators.HuttonMeijer
- (Parser(..), item, first, papply, (+++), sat, {-tok,-} many, many1,
- sepby, sepby1, chainl,
- chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,
- letter, alphanum, string, ident, nat, int, spaces, comment, junk,
- skip, token, natural, integer, symbol, identifier) where
-
-import Char
-import Monad
-
-infixr 5 +++
-
-type Token = Char
-
----------------------------------------------------------
--- | The parser monad
-
-newtype Parser a = P ([Token] -> [(a,[Token])])
-
-instance Functor Parser where
- -- map :: (a -> b) -> (Parser a -> Parser b)
- fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp])
-
-instance Monad Parser where
- -- return :: a -> Parser a
- return v = P (\inp -> [(v,inp)])
-
- -- >>= :: Parser a -> (a -> Parser b) -> Parser b
- (P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])
-
- -- fail :: String -> Parser a
- fail _ = P (\_ -> [])
-
-instance MonadPlus Parser where
- -- mzero :: Parser a
- mzero = P (\_ -> [])
-
- -- mplus :: Parser a -> Parser a -> Parser a
- (P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp))
-
--- ------------------------------------------------------------
--- * Other primitive parser combinators
--- ------------------------------------------------------------
-
-item :: Parser Token
-item = P (\inp -> case inp of
- [] -> []
- (x:xs) -> [(x,xs)])
-
-first :: Parser a -> Parser a
-first (P p) = P (\inp -> case p inp of
- [] -> []
- (x:_) -> [x])
-
-papply :: Parser a -> [Token] -> [(a,[Token])]
-papply (P p) inp = p inp
-
--- ------------------------------------------------------------
--- * Derived combinators
--- ------------------------------------------------------------
-
-(+++) :: Parser a -> Parser a -> Parser a
-p +++ q = first (p `mplus` q)
-
-sat :: (Token -> Bool) -> Parser Token
-sat p = do {x <- item; if p x then return x else mzero}
-
---tok :: Token -> Parser Token
---tok t = do {x <- item; if t==snd x then return t else mzero}
-
-many :: Parser a -> Parser [a]
-many p = many1 p +++ return []
---many p = force (many1 p +++ return [])
-
-many1 :: Parser a -> Parser [a]
-many1 p = do {x <- p; xs <- many p; return (x:xs)}
-
-sepby :: Parser a -> Parser b -> Parser [a]
-p `sepby` sep = (p `sepby1` sep) +++ return []
-
-sepby1 :: Parser a -> Parser b -> Parser [a]
-p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
-
-chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
-chainl p op v = (p `chainl1` op) +++ return v
-
-chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
-p `chainl1` op = do {x <- p; rest x}
- where
- rest x = do {f <- op; y <- p; rest (f x y)}
- +++ return x
-
-chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
-chainr p op v = (p `chainr1` op) +++ return v
-
-chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
-p `chainr1` op = do {x <- p; rest x}
- where
- rest x = do {f <- op; y <- p `chainr1` op; return (f x y)}
- +++ return x
-
-ops :: [(Parser a, b)] -> Parser b
-ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
-
-bracket :: Parser a -> Parser b -> Parser c -> Parser b
-bracket open p close = do {open; x <- p; close; return x}
-
--- ------------------------------------------------------------
--- * Useful parsers
--- ------------------------------------------------------------
-
-char :: Char -> Parser Char
-char x = sat (\y -> x == y)
-
-digit :: Parser Char
-digit = sat isDigit
-
-lower :: Parser Char
-lower = sat isLower
-
-upper :: Parser Char
-upper = sat isUpper
-
-letter :: Parser Char
-letter = sat isAlpha
-
-alphanum :: Parser Char
-alphanum = sat isAlphaNum +++ char '_'
-
-string :: String -> Parser String
-string "" = return ""
-string (x:xs) = do {char x; string xs; return (x:xs)}
-
-ident :: Parser String
-ident = do {x <- lower; xs <- many alphanum; return (x:xs)}
-
-nat :: Parser Int
-nat = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op
- where
- m `op` n = 10*m + n
-
-int :: Parser Int
-int = do {char '-'; n <- nat; return (-n)} +++ nat
-
--- ------------------------------------------------------------
--- * Lexical combinators
--- ------------------------------------------------------------
-
-spaces :: Parser ()
-spaces = do {many1 (sat isSpace); return ()}
-
-comment :: Parser ()
---comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()}
---comment = do
--- _ <- string "--"
--- _ <- many (sat (\x -> x /= '\n'))
--- return ()
-comment = do
- bracket (string "/*") (many item) (string "*/")
- return ()
-
-junk :: Parser ()
-junk = do {many (spaces +++ comment); return ()}
-
-skip :: Parser a -> Parser a
-skip p = do {junk; p}
-
-token :: Parser a -> Parser a
-token p = do {v <- p; junk; return v}
-
--- ------------------------------------------------------------
--- * Token parsers
--- ------------------------------------------------------------
-
-natural :: Parser Int
-natural = token nat
-
-integer :: Parser Int
-integer = token int
-
-symbol :: String -> Parser String
-symbol xs = token (string xs)
-
-identifier :: [String] -> Parser String
-identifier ks = token (do {x <- ident;
- if not (elem x ks) then return x
- else return mzero})
-
-------------------------------------------------------------------------------
+
+
+src/Text/ParserCombinators/HuttonMeijer.hs
+
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Text.ParserCombinators.HuttonMeijer
+-- Copyright : Graham Hutton (University of Nottingham), Erik Meijer (University of Utrecht)
+-- Licence : BSD
+--
+-- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
+-- Stability : Stable
+-- Portability : All
+--
+-- A LIBRARY OF MONADIC PARSER COMBINATORS
+--
+-- 29th July 1996
+--
+-- Graham Hutton Erik Meijer
+-- University of Nottingham University of Utrecht
+--
+-- This Haskell script defines a library of parser combinators, and is
+-- taken from sections 1-6 of our article "Monadic Parser Combinators".
+-- Some changes to the library have been made in the move from Gofer
+-- to Haskell:
+--
+-- * Do notation is used in place of monad comprehension notation;
+--
+-- * The parser datatype is defined using "newtype", to avoid the overhead
+-- of tagging and untagging parsers with the P constructor.
+-----------------------------------------------------------------------------
+
+
+module Text.ParserCombinators.HuttonMeijer
+ (Parser(..), item, first, papply, (+++), sat, {-tok,-} many, many1,
+ sepby, sepby1, chainl,
+ chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,
+ letter, alphanum, string, ident, nat, int, spaces, comment, junk,
+ skip, token, natural, integer, symbol, identifier) where
+
+import Char
+import Monad
+
+infixr 5 +++
+
+type Token = Char
+
+---------------------------------------------------------
+-- | The parser monad
+
+newtype Parser a = P ([Token] -> [(a,[Token])])
+
+instance Functor Parser where
+ -- map :: (a -> b) -> (Parser a -> Parser b)
+ fmap f (P p) = P (\inp -> [(f v, out) | (v,out) <- p inp])
+
+instance Monad Parser where
+ -- return :: a -> Parser a
+ return v = P (\inp -> [(v,inp)])
+
+ -- >>= :: Parser a -> (a -> Parser b) -> Parser b
+ (P p) >>= f = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])
+
+ -- fail :: String -> Parser a
+ fail _ = P (\_ -> [])
+
+instance MonadPlus Parser where
+ -- mzero :: Parser a
+ mzero = P (\_ -> [])
+
+ -- mplus :: Parser a -> Parser a -> Parser a
+ (P p) `mplus` (P q) = P (\inp -> (p inp ++ q inp))
+
+-- ------------------------------------------------------------
+-- * Other primitive parser combinators
+-- ------------------------------------------------------------
+
+item :: Parser Token
+item = P (\inp -> case inp of
+ [] -> []
+ (x:xs) -> [(x,xs)])
+
+first :: Parser a -> Parser a
+first (P p) = P (\inp -> case p inp of
+ [] -> []
+ (x:_) -> [x])
+
+papply :: Parser a -> [Token] -> [(a,[Token])]
+papply (P p) inp = p inp
+
+-- ------------------------------------------------------------
+-- * Derived combinators
+-- ------------------------------------------------------------
+
+(+++) :: Parser a -> Parser a -> Parser a
+p +++ q = first (p `mplus` q)
+
+sat :: (Token -> Bool) -> Parser Token
+sat p = do {x <- item; if p x then return x else mzero}
+
+--tok :: Token -> Parser Token
+--tok t = do {x <- item; if t==snd x then return t else mzero}
+
+many :: Parser a -> Parser [a]
+many p = many1 p +++ return []
+--many p = force (many1 p +++ return [])
+
+many1 :: Parser a -> Parser [a]
+many1 p = do {x <- p; xs <- many p; return (x:xs)}
+
+sepby :: Parser a -> Parser b -> Parser [a]
+p `sepby` sep = (p `sepby1` sep) +++ return []
+
+sepby1 :: Parser a -> Parser b -> Parser [a]
+p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
+
+chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainl p op v = (p `chainl1` op) +++ return v
+
+chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+p `chainl1` op = do {x <- p; rest x}
+ where
+ rest x = do {f <- op; y <- p; rest (f x y)}
+ +++ return x
+
+chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainr p op v = (p `chainr1` op) +++ return v
+
+chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+p `chainr1` op = do {x <- p; rest x}
+ where
+ rest x = do {f <- op; y <- p `chainr1` op; return (f x y)}
+ +++ return x
+
+ops :: [(Parser a, b)] -> Parser b
+ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
+
+bracket :: Parser a -> Parser b -> Parser c -> Parser b
+bracket open p close = do {open; x <- p; close; return x}
+
+-- ------------------------------------------------------------
+-- * Useful parsers
+-- ------------------------------------------------------------
+
+char :: Char -> Parser Char
+char x = sat (\y -> x == y)
+
+digit :: Parser Char
+digit = sat isDigit
+
+lower :: Parser Char
+lower = sat isLower
+
+upper :: Parser Char
+upper = sat isUpper
+
+letter :: Parser Char
+letter = sat isAlpha
+
+alphanum :: Parser Char
+alphanum = sat isAlphaNum +++ char '_'
+
+string :: String -> Parser String
+string "" = return ""
+string (x:xs) = do {char x; string xs; return (x:xs)}
+
+ident :: Parser String
+ident = do {x <- lower; xs <- many alphanum; return (x:xs)}
+
+nat :: Parser Int
+nat = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op
+ where
+ m `op` n = 10*m + n
+
+int :: Parser Int
+int = do {char '-'; n <- nat; return (-n)} +++ nat
+
+-- ------------------------------------------------------------
+-- * Lexical combinators
+-- ------------------------------------------------------------
+
+spaces :: Parser ()
+spaces = do {many1 (sat isSpace); return ()}
+
+comment :: Parser ()
+--comment = do {string "--"; many (sat (\x -> x /= '\n')); return ()}
+--comment = do
+-- _ <- string "--"
+-- _ <- many (sat (\x -> x /= '\n'))
+-- return ()
+comment = do
+ bracket (string "/*") (many item) (string "*/")
+ return ()
+
+junk :: Parser ()
+junk = do {many (spaces +++ comment); return ()}
+
+skip :: Parser a -> Parser a
+skip p = do {junk; p}
+
+token :: Parser a -> Parser a
+token p = do {v <- p; junk; return v}
+
+-- ------------------------------------------------------------
+-- * Token parsers
+-- ------------------------------------------------------------
+
+natural :: Parser Int
+natural = token nat
+
+integer :: Parser Int
+integer = token int
+
+symbol :: String -> Parser String
+symbol xs = token (string xs)
+
+identifier :: [String] -> Parser String
+identifier ks = token (do {x <- ident;
+ if not (elem x ks) then return x
+ else return mzero})
+
+------------------------------------------------------------------------------
+
diff --git a/docs/haddock/src/Text/ParserCombinators/HuttonMeijerWallace.html b/docs/haddock/src/Text/ParserCombinators/HuttonMeijerWallace.html
--- a/docs/haddock/src/Text/ParserCombinators/HuttonMeijerWallace.html
+++ b/docs/haddock/src/Text/ParserCombinators/HuttonMeijerWallace.html
@@ -1,301 +1,307 @@
-{-----------------------------------------------------------------------------
-
- A LIBRARY OF MONADIC PARSER COMBINATORS
-
- 29th July 1996
-
- Graham Hutton Erik Meijer
- University of Nottingham University of Utrecht
-
-This Haskell 1.3 script defines a library of parser combinators, and is taken
-from sections 1-6 of our article "Monadic Parser Combinators". Some changes
-to the library have been made in the move from Gofer to Haskell:
-
- * Do notation is used in place of monad comprehension notation;
-
- * The parser datatype is defined using "newtype", to avoid the overhead
- of tagging and untagging parsers with the P constructor.
-
-------------------------------------------------------------------------------
-** Extended to allow a symbol table/state to be threaded through the monad.
-** Extended to allow a parameterised token type, rather than just strings.
-** Extended to allow error-reporting.
-
-(Extensions: 1998-2000 Malcolm.Wallace@cs.york.ac.uk)
-(More extensions: 2004 gk-haskell@ninebynine.org)
-
-------------------------------------------------------------------------------}
-
--- | This library of monadic parser combinators is based on the ones
--- defined by Graham Hutton and Erik Meijer. It has been extended by
--- Malcolm Wallace to use an abstract token type (no longer just a
--- string) as input, and to incorporate state in the monad, useful
--- for symbol tables, macros, and so on. Basic facilities for error
--- reporting have also been added, and later extended by Graham Klyne
--- to return the errors through an @Either@ type, rather than just
--- calling @error@.
-
-module Text.ParserCombinators.HuttonMeijerWallace
- (
- -- * The parser monad
- Parser(..)
- -- * Primitive parser combinators
- , item, eof, papply, papply'
- -- * Derived combinators
- , (+++), {-sat,-} tok, nottok, many, many1
- , sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket
- , toEOF
- -- * Error handling
- , elserror
- -- * State handling
- , stupd, stquery, stget
- -- * Re-parsing
- , reparse
- ) where
-
-import Char
-import Monad
-
-infixr 5 +++
-
---- The parser monad ---------------------------------------------------------
-
-type ParseResult s t e a = Either e [(a,s,[Either e t])]
-
-newtype Parser s t e a = P ( s -> [Either e t] -> ParseResult s t e a )
- -- ^ The parser type is parametrised on the types of the state @s@,
- -- the input tokens @t@, error-type @e@, and the result value @a@.
- -- The state and remaining input are threaded through the monad.
-
-instance Functor (Parser s t e) where
- -- fmap :: (a -> b) -> (Parser s t e a -> Parser s t e b)
- fmap f (P p) = P (\st inp -> case p st inp of
- Right res -> Right [(f v, s, out) | (v,s,out) <- res]
- Left err -> Left err
- )
-
-instance Monad (Parser s t e) where
- -- return :: a -> Parser s t e a
- return v = P (\st inp -> Right [(v,st,inp)])
- -- >>= :: Parser s t e a -> (a -> Parser s t e b) -> Parser s t e b
- (P p) >>= f = P (\st inp -> case p st inp of
- Right res -> foldr joinresults (Right [])
- [ papply' (f v) s out | (v,s,out) <- res ]
- Left err -> Left err
- )
- -- fail :: String -> Parser s t e a
- fail err = P (\st inp -> Right [])
- -- I know it's counterintuitive, but we want no-parse, not an error.
-
-instance MonadPlus (Parser s t e) where
- -- mzero :: Parser s t e a
- mzero = P (\st inp -> Right [])
- -- mplus :: Parser s t e a -> Parser s t e a -> Parser s t e a
- (P p) `mplus` (P q) = P (\st inp -> joinresults (p st inp) (q st inp))
-
--- joinresults ensures that explicitly raised errors are dominant,
--- provided no parse has yet been found. The commented out code is
--- a slightly stricter specification of the real code.
-joinresults :: ParseResult s t e a -> ParseResult s t e a -> ParseResult s t e a
-{-
-joinresults (Left p) (Left q) = Left p
-joinresults (Left p) (Right _) = Left p
-joinresults (Right []) (Left q) = Left q
-joinresults (Right p) (Left q) = Right p
-joinresults (Right p) (Right q) = Right (p++q)
--}
-joinresults (Left p) q = Left p
-joinresults (Right []) q = q
-joinresults (Right p) q = Right (p++ case q of Left _ -> []
- Right r -> r)
-
-
---- Primitive parser combinators ---------------------------------------------
-
--- | Deliver the first remaining token.
-item :: Parser s t e t
-item = P (\st inp -> case inp of
- [] -> Right []
- (Left e: _) -> Left e
- (Right x: xs) -> Right [(x,st,xs)]
- )
-
--- | Fail if end of input is not reached
-eof :: Show p => Parser s (p,t) String ()
-eof = P (\st inp -> case inp of
- [] -> Right [((),st,[])]
- (Left e:_) -> Left e
- (Right (p,_):_) -> Left ("End of input expected at "
- ++show p++"\n but found text")
- )
-
-{-
--- | Ensure the value delivered by the parser is evaluated to WHNF.
-force :: Parser s t e a -> Parser s t e a
-force (P p) = P (\st inp -> let Right xs = p st inp
- h = head xs in
- h `seq` Right (h: tail xs)
- )
--- [[[GK]]] ^^^^^^
--- WHNF = Weak Head Normal Form, meaning that it has no top-level redex.
--- In this case, I think that means that the first element of the list
--- is fully evaluated.
---
--- NOTE: the original form of this function fails if there is no parse
--- result for p st inp (head xs fails if xs is null), so the modified
--- form can assume a Right value only.
---
--- Why is this needed?
--- It's not exported, and the only use of this I see is commented out.
----------------------------------------
--}
-
-
--- | Deliver the first parse result only, eliminating any backtracking.
-first :: Parser s t e a -> Parser s t e a
-first (P p) = P (\st inp -> case p st inp of
- Right (x:xs) -> Right [x]
- otherwise -> otherwise
- )
-
--- | Apply the parser to some real input, given an initial state value.
--- If the parser fails, raise 'error' to halt the program.
--- (This is the original exported behaviour - to allow the caller to
--- deal with the error differently, see @papply'@.)
-papply :: Parser s t String a -> s -> [Either String t]
- -> [(a,s,[Either String t])]
-papply (P p) st inp = either error id (p st inp)
-
--- | Apply the parser to some real input, given an initial state value.
--- If the parser fails, return a diagnostic message to the caller.
-papply' :: Parser s t e a -> s -> [Either e t]
- -> Either e [(a,s,[Either e t])]
-papply' (P p) st inp = p st inp
-
---- Derived combinators ------------------------------------------------------
-
--- | A choice between parsers. Keep only the first success.
-(+++) :: Parser s t e a -> Parser s t e a -> Parser s t e a
-p +++ q = first (p `mplus` q)
-
--- | Deliver the first token if it satisfies a predicate.
-sat :: (t -> Bool) -> Parser s (p,t) e t
-sat p = do {(_,x) <- item; if p x then return x else mzero}
-
--- | Deliver the first token if it equals the argument.
-tok :: Eq t => t -> Parser s (p,t) e t
-tok t = do {(_,x) <- item; if x==t then return t else mzero}
-
--- | Deliver the first token if it does not equal the argument.
-nottok :: Eq t => [t] -> Parser s (p,t) e t
-nottok ts = do {(_,x) <- item; if x `notElem` ts then return x
- else mzero}
-
--- | Deliver zero or more values of @a@.
-many :: Parser s t e a -> Parser s t e [a]
-many p = many1 p +++ return []
---many p = force (many1 p +++ return [])
-
--- | Deliver one or more values of @a@.
-many1 :: Parser s t e a -> Parser s t e [a]
-many1 p = do {x <- p; xs <- many p; return (x:xs)}
-
--- | Deliver zero or more values of @a@ separated by @b@'s.
-sepby :: Parser s t e a -> Parser s t e b -> Parser s t e [a]
-p `sepby` sep = (p `sepby1` sep) +++ return []
-
--- | Deliver one or more values of @a@ separated by @b@'s.
-sepby1 :: Parser s t e a -> Parser s t e b -> Parser s t e [a]
-p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
-
-chainl :: Parser s t e a -> Parser s t e (a->a->a) -> a
- -> Parser s t e a
-chainl p op v = (p `chainl1` op) +++ return v
-
-chainl1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a
-p `chainl1` op = do {x <- p; rest x}
- where
- rest x = do {f <- op; y <- p; rest (f x y)}
- +++ return x
-
-chainr :: Parser s t e a -> Parser s t e (a->a->a) -> a
- -> Parser s t e a
-chainr p op v = (p `chainr1` op) +++ return v
-
-chainr1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a
-p `chainr1` op = do {x <- p; rest x}
- where
- rest x = do { f <- op
- ; y <- p `chainr1` op
- ; return (f x y)
- }
- +++ return x
-
-ops :: [(Parser s t e a, b)] -> Parser s t e b
-ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
-
-bracket :: (Show p,Show t) =>
- Parser s (p,t) e a -> Parser s (p,t) e b ->
- Parser s (p,t) e c -> Parser s (p,t) e b
-bracket open p close = do { open
- ; x <- p
- ; close -- `elserror` "improperly matched construct";
- ; return x
- }
-
--- | Accept a complete parse of the input only, no partial parses.
-toEOF :: Show p =>
- Parser s (p,t) String a -> Parser s (p,t) String a
-toEOF p = do { x <- p; eof; return x }
-
-
---- Error handling -----------------------------------------------------------
-
--- | Return an error using the supplied diagnostic string, and a token type
--- which includes position information.
-parseerror :: (Show p,Show t) => String -> Parser s (p,t) String a
-parseerror err = P (\st inp ->
- case inp of
- [] -> Left "Parse error: unexpected EOF\n"
- (Left e:_) -> Left ("Lexical error: "++e)
- (Right (p,t):_) ->
- Left ("Parse error: in "++show p++"\n "
- ++err++"\n "++"Found "++show t)
- )
-
-
--- | If the parser fails, generate an error message.
-elserror :: (Show p,Show t) => Parser s (p,t) String a -> String
- -> Parser s (p,t) String a
-p `elserror` s = p +++ parseerror s
-
---- State handling -----------------------------------------------------------
-
--- | Update the internal state.
-stupd :: (s->s) -> Parser s t e ()
-stupd f = P (\st inp-> {-let newst = f st in newst `seq`-}
- Right [((), f st, inp)])
-
--- | Query the internal state.
-stquery :: (s->a) -> Parser s t e a
-stquery f = P (\st inp-> Right [(f st, st, inp)])
-
--- | Deliver the entire internal state.
-stget :: Parser s t e s
-stget = P (\st inp-> Right [(st, st, inp)])
-
-
---- Push some tokens back onto the input stream and reparse ------------------
-
--- | This is useful for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [Either e t] -> Parser s t e ()
-reparse ts = P (\st inp-> Right [((), st, ts++inp)])
-
-------------------------------------------------------------------------------
+
+
+src/Text/ParserCombinators/HuttonMeijerWallace.hs
+
+
+{-----------------------------------------------------------------------------
+
+ A LIBRARY OF MONADIC PARSER COMBINATORS
+
+ 29th July 1996
+
+ Graham Hutton Erik Meijer
+ University of Nottingham University of Utrecht
+
+This Haskell 1.3 script defines a library of parser combinators, and is taken
+from sections 1-6 of our article "Monadic Parser Combinators". Some changes
+to the library have been made in the move from Gofer to Haskell:
+
+ * Do notation is used in place of monad comprehension notation;
+
+ * The parser datatype is defined using "newtype", to avoid the overhead
+ of tagging and untagging parsers with the P constructor.
+
+------------------------------------------------------------------------------
+** Extended to allow a symbol table/state to be threaded through the monad.
+** Extended to allow a parameterised token type, rather than just strings.
+** Extended to allow error-reporting.
+
+(Extensions: 1998-2000 Malcolm.Wallace@cs.york.ac.uk)
+(More extensions: 2004 gk-haskell@ninebynine.org)
+
+------------------------------------------------------------------------------}
+
+-- | This library of monadic parser combinators is based on the ones
+-- defined by Graham Hutton and Erik Meijer. It has been extended by
+-- Malcolm Wallace to use an abstract token type (no longer just a
+-- string) as input, and to incorporate state in the monad, useful
+-- for symbol tables, macros, and so on. Basic facilities for error
+-- reporting have also been added, and later extended by Graham Klyne
+-- to return the errors through an @Either@ type, rather than just
+-- calling @error@.
+
+module Text.ParserCombinators.HuttonMeijerWallace
+ (
+ -- * The parser monad
+ Parser(..)
+ -- * Primitive parser combinators
+ , item, eof, papply, papply'
+ -- * Derived combinators
+ , (+++), {-sat,-} tok, nottok, many, many1
+ , sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket
+ , toEOF
+ -- * Error handling
+ , elserror
+ -- * State handling
+ , stupd, stquery, stget
+ -- * Re-parsing
+ , reparse
+ ) where
+
+import Char
+import Monad
+
+infixr 5 +++
+
+--- The parser monad ---------------------------------------------------------
+
+type ParseResult s t e a = Either e [(a,s,[Either e t])]
+
+newtype Parser s t e a = P ( s -> [Either e t] -> ParseResult s t e a )
+ -- ^ The parser type is parametrised on the types of the state @s@,
+ -- the input tokens @t@, error-type @e@, and the result value @a@.
+ -- The state and remaining input are threaded through the monad.
+
+instance Functor (Parser s t e) where
+ -- fmap :: (a -> b) -> (Parser s t e a -> Parser s t e b)
+ fmap f (P p) = P (\st inp -> case p st inp of
+ Right res -> Right [(f v, s, out) | (v,s,out) <- res]
+ Left err -> Left err
+ )
+
+instance Monad (Parser s t e) where
+ -- return :: a -> Parser s t e a
+ return v = P (\st inp -> Right [(v,st,inp)])
+ -- >>= :: Parser s t e a -> (a -> Parser s t e b) -> Parser s t e b
+ (P p) >>= f = P (\st inp -> case p st inp of
+ Right res -> foldr joinresults (Right [])
+ [ papply' (f v) s out | (v,s,out) <- res ]
+ Left err -> Left err
+ )
+ -- fail :: String -> Parser s t e a
+ fail err = P (\st inp -> Right [])
+ -- I know it's counterintuitive, but we want no-parse, not an error.
+
+instance MonadPlus (Parser s t e) where
+ -- mzero :: Parser s t e a
+ mzero = P (\st inp -> Right [])
+ -- mplus :: Parser s t e a -> Parser s t e a -> Parser s t e a
+ (P p) `mplus` (P q) = P (\st inp -> joinresults (p st inp) (q st inp))
+
+-- joinresults ensures that explicitly raised errors are dominant,
+-- provided no parse has yet been found. The commented out code is
+-- a slightly stricter specification of the real code.
+joinresults :: ParseResult s t e a -> ParseResult s t e a -> ParseResult s t e a
+{-
+joinresults (Left p) (Left q) = Left p
+joinresults (Left p) (Right _) = Left p
+joinresults (Right []) (Left q) = Left q
+joinresults (Right p) (Left q) = Right p
+joinresults (Right p) (Right q) = Right (p++q)
+-}
+joinresults (Left p) q = Left p
+joinresults (Right []) q = q
+joinresults (Right p) q = Right (p++ case q of Left _ -> []
+ Right r -> r)
+
+
+--- Primitive parser combinators ---------------------------------------------
+
+-- | Deliver the first remaining token.
+item :: Parser s t e t
+item = P (\st inp -> case inp of
+ [] -> Right []
+ (Left e: _) -> Left e
+ (Right x: xs) -> Right [(x,st,xs)]
+ )
+
+-- | Fail if end of input is not reached
+eof :: Show p => Parser s (p,t) String ()
+eof = P (\st inp -> case inp of
+ [] -> Right [((),st,[])]
+ (Left e:_) -> Left e
+ (Right (p,_):_) -> Left ("End of input expected at "
+ ++show p++"\n but found text")
+ )
+
+{-
+-- | Ensure the value delivered by the parser is evaluated to WHNF.
+force :: Parser s t e a -> Parser s t e a
+force (P p) = P (\st inp -> let Right xs = p st inp
+ h = head xs in
+ h `seq` Right (h: tail xs)
+ )
+-- [[[GK]]] ^^^^^^
+-- WHNF = Weak Head Normal Form, meaning that it has no top-level redex.
+-- In this case, I think that means that the first element of the list
+-- is fully evaluated.
+--
+-- NOTE: the original form of this function fails if there is no parse
+-- result for p st inp (head xs fails if xs is null), so the modified
+-- form can assume a Right value only.
+--
+-- Why is this needed?
+-- It's not exported, and the only use of this I see is commented out.
+---------------------------------------
+-}
+
+
+-- | Deliver the first parse result only, eliminating any backtracking.
+first :: Parser s t e a -> Parser s t e a
+first (P p) = P (\st inp -> case p st inp of
+ Right (x:xs) -> Right [x]
+ otherwise -> otherwise
+ )
+
+-- | Apply the parser to some real input, given an initial state value.
+-- If the parser fails, raise 'error' to halt the program.
+-- (This is the original exported behaviour - to allow the caller to
+-- deal with the error differently, see @papply'@.)
+papply :: Parser s t String a -> s -> [Either String t]
+ -> [(a,s,[Either String t])]
+papply (P p) st inp = either error id (p st inp)
+
+-- | Apply the parser to some real input, given an initial state value.
+-- If the parser fails, return a diagnostic message to the caller.
+papply' :: Parser s t e a -> s -> [Either e t]
+ -> Either e [(a,s,[Either e t])]
+papply' (P p) st inp = p st inp
+
+--- Derived combinators ------------------------------------------------------
+
+-- | A choice between parsers. Keep only the first success.
+(+++) :: Parser s t e a -> Parser s t e a -> Parser s t e a
+p +++ q = first (p `mplus` q)
+
+-- | Deliver the first token if it satisfies a predicate.
+sat :: (t -> Bool) -> Parser s (p,t) e t
+sat p = do {(_,x) <- item; if p x then return x else mzero}
+
+-- | Deliver the first token if it equals the argument.
+tok :: Eq t => t -> Parser s (p,t) e t
+tok t = do {(_,x) <- item; if x==t then return t else mzero}
+
+-- | Deliver the first token if it does not equal the argument.
+nottok :: Eq t => [t] -> Parser s (p,t) e t
+nottok ts = do {(_,x) <- item; if x `notElem` ts then return x
+ else mzero}
+
+-- | Deliver zero or more values of @a@.
+many :: Parser s t e a -> Parser s t e [a]
+many p = many1 p +++ return []
+--many p = force (many1 p +++ return [])
+
+-- | Deliver one or more values of @a@.
+many1 :: Parser s t e a -> Parser s t e [a]
+many1 p = do {x <- p; xs <- many p; return (x:xs)}
+
+-- | Deliver zero or more values of @a@ separated by @b@'s.
+sepby :: Parser s t e a -> Parser s t e b -> Parser s t e [a]
+p `sepby` sep = (p `sepby1` sep) +++ return []
+
+-- | Deliver one or more values of @a@ separated by @b@'s.
+sepby1 :: Parser s t e a -> Parser s t e b -> Parser s t e [a]
+p `sepby1` sep = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}
+
+chainl :: Parser s t e a -> Parser s t e (a->a->a) -> a
+ -> Parser s t e a
+chainl p op v = (p `chainl1` op) +++ return v
+
+chainl1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a
+p `chainl1` op = do {x <- p; rest x}
+ where
+ rest x = do {f <- op; y <- p; rest (f x y)}
+ +++ return x
+
+chainr :: Parser s t e a -> Parser s t e (a->a->a) -> a
+ -> Parser s t e a
+chainr p op v = (p `chainr1` op) +++ return v
+
+chainr1 :: Parser s t e a -> Parser s t e (a->a->a) -> Parser s t e a
+p `chainr1` op = do {x <- p; rest x}
+ where
+ rest x = do { f <- op
+ ; y <- p `chainr1` op
+ ; return (f x y)
+ }
+ +++ return x
+
+ops :: [(Parser s t e a, b)] -> Parser s t e b
+ops xs = foldr1 (+++) [do {p; return op} | (p,op) <- xs]
+
+bracket :: (Show p,Show t) =>
+ Parser s (p,t) e a -> Parser s (p,t) e b ->
+ Parser s (p,t) e c -> Parser s (p,t) e b
+bracket open p close = do { open
+ ; x <- p
+ ; close -- `elserror` "improperly matched construct";
+ ; return x
+ }
+
+-- | Accept a complete parse of the input only, no partial parses.
+toEOF :: Show p =>
+ Parser s (p,t) String a -> Parser s (p,t) String a
+toEOF p = do { x <- p; eof; return x }
+
+
+--- Error handling -----------------------------------------------------------
+
+-- | Return an error using the supplied diagnostic string, and a token type
+-- which includes position information.
+parseerror :: (Show p,Show t) => String -> Parser s (p,t) String a
+parseerror err = P (\st inp ->
+ case inp of
+ [] -> Left "Parse error: unexpected EOF\n"
+ (Left e:_) -> Left ("Lexical error: "++e)
+ (Right (p,t):_) ->
+ Left ("Parse error: in "++show p++"\n "
+ ++err++"\n "++"Found "++show t)
+ )
+
+
+-- | If the parser fails, generate an error message.
+elserror :: (Show p,Show t) => Parser s (p,t) String a -> String
+ -> Parser s (p,t) String a
+p `elserror` s = p +++ parseerror s
+
+--- State handling -----------------------------------------------------------
+
+-- | Update the internal state.
+stupd :: (s->s) -> Parser s t e ()
+stupd f = P (\st inp-> {-let newst = f st in newst `seq`-}
+ Right [((), f st, inp)])
+
+-- | Query the internal state.
+stquery :: (s->a) -> Parser s t e a
+stquery f = P (\st inp-> Right [(f st, st, inp)])
+
+-- | Deliver the entire internal state.
+stget :: Parser s t e s
+stget = P (\st inp-> Right [(st, st, inp)])
+
+
+--- Push some tokens back onto the input stream and reparse ------------------
+
+-- | This is useful for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [Either e t] -> Parser s t e ()
+reparse ts = P (\st inp-> Right [((), st, ts++inp)])
+
+------------------------------------------------------------------------------
+
diff --git a/docs/haddock/src/Text/ParserCombinators/Poly.html b/docs/haddock/src/Text/ParserCombinators/Poly.html
--- a/docs/haddock/src/Text/ParserCombinators/Poly.html
+++ b/docs/haddock/src/Text/ParserCombinators/Poly.html
@@ -1,251 +1,15 @@
-module Text.ParserCombinators.Poly
- ( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
- , failBad -- :: String -> Parser t a
- , commit -- :: Parser t a -> Parser t a
-
- -- * Combinators:
- -- ** Primitives
- , next -- :: Parser t t
- , satisfy -- :: (t->Bool) -> Parser t t
- , apply -- :: Parser t (a->b) -> Parser t a -> Parser t b
- , discard -- :: Parser t a -> Parser t b -> Parser t a
- -- ** Error-handling
- , adjustErr -- :: Parser t a -> (String->String) -> Parser t a
- , adjustErrBad-- :: Parser t a -> (String->String) -> Parser t a
- , indent -- :: Int -> String -> String
- -- ** Choices
- , onFail -- :: Parser t a -> Parser t a -> Parser t a
- , oneOf -- :: Show t => [Parser t a] -> Parser t a
- , oneOf' -- :: [(String,Parser t a)] -> Parser t a
- , optional -- :: Parser t a -> Parser t (Maybe a)
- -- ** Sequences
- , exactly -- :: Int -> Parser t a -> Parser t [a]
- , many -- :: Parser t a -> Parser t [a]
- , many1 -- :: Parser t a -> Parser t [a]
- , sepBy -- :: Parser t a -> Parser t sep -> Parser t [a]
- , sepBy1 -- :: Parser t a -> Parser t sep -> Parser t [a]
- , bracketSep -- :: Parser t bra -> Parser t sep -> Parser t ket
- -- -> Parser t a -> Parser t [a]
- , bracket -- :: Parser t bra -> Parser t ket -> Parser t a
- -- -> Parser t a
- , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a]
- -- ** re-parsing
- , reparse -- :: [t] -> Parser t ()
- ) where
-
-
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyState
--- instead)
-newtype Parser t a = P ([t] -> (EitherE String a, [t]))
-
--- A return type like Either, that distinguishes not only between
--- right and wrong answers, but also has gradations of wrongness.
-type EitherE a b = Either (Bool,a) b
-
--- | Apply a parser to an input token sequence.
-runParser :: Parser t a -> [t] -> (Either String a, [t])
-runParser (P p) =
- (\ (e,ts)-> (case e of {Left (_,m)->Left m; Right m->Right m}, ts) )
- . p
-
-instance Functor (Parser t) where
- fmap f (P p) = P (\ts-> case p ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> (Right (f x), ts'))
-instance Monad (Parser t) where
- return x = P (\ts-> (Right x, ts))
- (P f) >>= g = P (\ts-> case f ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> let (P g') = g x in g' ts')
- fail e = P (\ts-> (Left (False,e), ts))
-
--- | When a simple fail is not strong enough, use failBad for emphasis.
--- An emphasised (severe) error can propagate out through choice operators.
-failBad :: String -> Parser t a
-failBad msg = P (\ts-> (Left (True,msg), ts))
-
--- | Commit is a way of raising the severity of any errors found within
--- its argument. Used in the middle of a parser definition, it means that
--- any operations prior to commitment fail softly, but after commitment,
--- they fail hard.
-commit :: Parser t a -> Parser t a
-commit (P p) = P (\ts-> case p ts of
- (Left (_,e), ts') -> (Left (True,e), ts')
- right -> right )
-
-
--- Combinators
-
--- | One token
-next :: Parser t t
-next = P (\ts-> case ts of
- [] -> (Left (False,"Ran out of input (EOF)"), [])
- (t:ts') -> (Right t, ts') )
-
--- | One token satifying a predicate
-satisfy :: (t->Bool) -> Parser t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-
-infixl 3 `apply`
--- | Apply a parsed function to a parsed value
-apply :: Parser t (a->b) -> Parser t a -> Parser t b
-pf `apply` px = do { f <- pf; x <- px; return (f x) }
-
-infixl 3 `discard`
--- | @x `discard` y@ parses both x and y, but discards the result of y
-discard :: Parser t a -> Parser t b -> Parser t a
-px `discard` py = do { x <- px; _ <- py; return x }
-
--- | @p `adjustErr` f@ applies the transformation @f@ to any error message
--- generated in @p@, having no effect if @p@ succeeds.
-adjustErr :: Parser t a -> (String->String) -> Parser t a
-(P p) `adjustErr` f = P (\ts-> case p ts of
- (Left (b,msg), ts') -> (Left (b,(f msg)), ts')
- right -> right )
-
--- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
--- severity of the error.
-adjustErrBad :: Parser t a -> (String->String) -> Parser t a
-p `adjustErrBad` f = commit (p `adjustErr` f)
-
-infixl 6 `onFail` -- not sure about precedence 6?
--- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
--- Can be chained together to give multiple attempts to parse something.
--- (Note that q could itself be a failing parser, e.g. to change the error
--- message from that defined in p to something different.)
--- However, a *severe* failure in p cannot be ignored.
-onFail :: Parser t a -> Parser t a -> Parser t a
-(P p) `onFail` (P q) = P (\ts-> case p ts of
- r@(Left (True,_), _) -> r
- (Left _, _) -> q ts
- right -> right )
-
--- | Parse the first alternative in the list that succeeds.
-oneOf :: [Parser t a] -> Parser t a
-oneOf [] = do { n <- next
- ; fail ("failed to parse any of the possible choices")
- }
---oneOf :: Show t => [Parser t a] -> Parser t a
---oneOf [] = do { n <- next
--- ; fail ("failed to parse any of the possible choices"
--- ++"\n next token is "++show n)
--- }
-oneOf (p:ps) = p `onFail` oneOf ps
-
--- | Parse the first alternative that succeeds, but if none succeed,
--- report only the severe errors, and if none of those, then report
--- all the soft errors.
-oneOf' :: [(String, Parser t a)] -> Parser t a
-oneOf' = accum []
- where accum errs [] =
- case filter isBad errs of
- [] -> fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- [(_,(_,e))] -> failBad e
- es -> failBad ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
- accum errs ((e,P p):ps) =
- P (\ts-> case p ts of
- (Left err,_) -> let (P p) = accum ((e,err):errs) ps
- in p ts
- right -> right )
- showErr (name,(_,err)) = name++":\n"++indent 2 err
- isBad (_,(b,_)) = b
-
--- | Helper for formatting error messages: indents all lines by a fixed amount.
-indent :: Int -> String -> String
-indent n = unlines . map (replicate n ' ' ++) . lines
-
--- | 'optional' indicates whether the parser succeeded through the Maybe type.
-optional :: Parser t a -> Parser t (Maybe a)
-optional p = fmap Just p `onFail` return Nothing
-
--- | 'exactly n p' parses a precise number of items, n, using the parser
--- p, in sequence.
-exactly :: Int -> Parser t a -> Parser t [a]
-exactly 0 p = return []
-exactly n p = do x <- p
- xs <- exactly (n-1) p
- return (x:xs)
-
--- | 'many p' parses a list of elements with individual parser p.
--- Cannot fail, since an empty list is a valid return value.
-many :: Parser t a -> Parser t [a]
-many p = many1 p `onFail` return []
-
--- | Parse a non-empty list of items.
-many1 :: Parser t a -> Parser t [a]
-many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
- ; xs <- many p
- ; return (x:xs)
- }
--- `adjustErr` ("When looking for a non-empty sequence:\n\t"++)
-
--- | Parse a list of items separated by discarded junk.
-sepBy :: Parser t a -> Parser t sep -> Parser t [a]
-sepBy p sep = do sepBy1 p sep `onFail` return []
-
--- | Parse a non-empty list of items separated by discarded junk.
-sepBy1 :: Parser t a -> Parser t sep -> Parser t [a]
-sepBy1 p sep = do { x <- p
- ; xs <- many (do {sep; p})
- ; return (x:xs)
- }
- `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++)
-
--- | Parse a list of items, discarding the start, end, and separator
--- items.
-bracketSep :: Parser t bra -> Parser t sep -> Parser t ket
- -> Parser t a -> Parser t [a]
-bracketSep open sep close p =
- do { open; close; return [] }
- `onFail`
- do { open `adjustErr` ("Missing opening bracket:\n\t"++)
- ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++)
- ; xs <- many (do {sep; p})
- ; close `adjustErrBad` ("When looking for closing bracket:\n\t"++)
- ; return (x:xs)
- }
-
--- | Parse a bracketed item, discarding the brackets.
-bracket :: Parser t bra -> Parser t ket -> Parser t a -> Parser t a
-bracket open close p = do
- do { open `adjustErr` ("Missing opening bracket:\n\t"++)
- ; x <- p
- ; close `adjustErrBad` ("Missing closing bracket:\n\t"++)
- ; return x
- }
-
--- | 'manyFinally e t' parses a possibly-empty sequence of e's,
--- terminated by a t. Any parse failures could be due either to
--- a badly-formed terminator or a badly-formed element, so raise
--- both possible errors.
-manyFinally :: Parser t a -> Parser t z -> Parser t [a]
-manyFinally p t =
- do { xs <- many p
- ; oneOf' [ ("sequence terminator", do { t; return () } )
- , ("item in a sequence", do { p; return () } )
- ]
- ; return xs
- }
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser t ()
-reparse ts = P (\inp-> (Right (), ts++inp))
-
-------------------------------------------------------------------------
+
+
+src/Text/ParserCombinators/Poly.hs
+
+
+module Text.ParserCombinators.Poly
+ ( module Text.ParserCombinators.Poly.Plain
+ ) where
+
+import Text.ParserCombinators.Poly.Plain
+
diff --git a/docs/haddock/src/Text/ParserCombinators/Poly/Base.html b/docs/haddock/src/Text/ParserCombinators/Poly/Base.html
--- a/docs/haddock/src/Text/ParserCombinators/Poly/Base.html
+++ b/docs/haddock/src/Text/ParserCombinators/Poly/Base.html
@@ -1,194 +1,205 @@
-module Text.ParserCombinators.Poly.Base
- ( -- * The PolyParse class
- PolyParse(..) -- class of all monadic two-level-error parsers
-
- -- * Combinators general to all parser types.
- -- ** Simple combinators
- , discard -- :: PolyParse p => p a -> p b -> p a
- -- ** Error-handling
- , failBad -- :: PolyParse p => String -> p a
- , adjustErrBad-- :: PolyParse p => p a -> (String->String) -> p a
- , indent -- :: Int -> String -> String
- -- ** Choices
- , oneOf -- :: PolyParse p => [p a] -> p a
- , optional -- :: PolyParse p => p a -> p (Maybe a)
- -- ** Sequences
- , exactly -- :: PolyParse p => Int -> p a -> p [a]
- , many -- :: PolyParse p => p a -> p [a]
- , many1 -- :: PolyParse p => p a -> p [a]
- , sepBy -- :: PolyParse p => p a -> p sep -> p [a]
- , sepBy1 -- :: PolyParse p => p a -> p sep -> p [a]
- , bracketSep -- :: PolyParse p => p bra -> p sep -> p ket -> p a -> p [a]
- , bracket -- :: PolyParse p => p bra -> p ket -> p a -> p a
- , manyFinally -- :: PolyParse p => p a -> p z -> p [a]
- ) where
-
--- | The @PolyParse@ class is an abstraction over all the current
--- concrete representations of monadic parser combinators in this
--- package. The common feature is two-level error-handling.
--- Some primitives must be implemented specific to each parser type
--- (e.g. depending on whether the parser has a running state, or
--- whether it is lazy). But given those primitives, large numbers of
--- combinators do not depend any further on the internal structure of
--- the particular parser.
---
--- There are two additional basic combinators that we expect to be implemented
--- afresh for every concrete type, but which (for technical reasons)
--- cannot be class methods. They are @next@ and @satisfy@.
-class (Functor p, Monad p) => PolyParse p where
- -- | Commit is a way of raising the severity of any errors found within
- -- its argument. Used in the middle of a parser definition, it means that
- -- any operations prior to commitment fail softly, but after commitment,
- -- they fail hard.
- commit :: p a -> p a
- -- | @p `adjustErr` f@ applies the transformation @f@ to any error message
- -- generated in @p@, having no effect if @p@ succeeds.
- adjustErr :: p a -> (String -> String) -> p a
- -- | @p `onFail` q@ means parse p, unless p fails, in which case
- -- parse q instead.
- -- Can be chained together to give multiple attempts to parse something.
- -- (Note that q could itself be a failing parser, e.g. to change the error
- -- message from that defined in p to something different.)
- -- However, a severe failure in p cannot be ignored.
- onFail :: p a -> p a -> p a
- -- | Parse the first alternative that succeeds, but if none succeed,
- -- report only the severe errors, and if none of those, then report
- -- all the soft errors.
- oneOf' :: [(String, p a)] -> p a
- -- | Apply a parsed function to a parsed value.
- -- Rather like ordinary function application lifted into parsers.
- apply :: p (a->b) -> p a -> p b
- pf `apply` px = do { f <- pf; x <- px; return (f x) }
- -- note: the Poly.Lazy variants override this defn with a lazier one.
-
-infixl 6 `onFail` -- not sure about precedence 6?
-infixl 3 `apply`
-infixl 3 `discard`
-
-{-
--- Combinators we expect most concrete parser types to implement.
--- For technical reasons, they cannot be class members.
-
--- | Yield the next token
-next :: PolyParse p => p t
- -- where t is constrained to be the input token type
-
--- | One token satisfying a predicate.
-satisfy :: PolyParse p => (t->Bool) -> p t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
- -- note: must be re-defined for each implementation because
- -- its type cannot be expressed otherwise.
--}
-
--- | When a simple fail is not strong enough, use failBad for emphasis.
--- An emphasised (severe) error cannot be overridden by choice
--- operators.
-failBad :: PolyParse p => String -> p a
-failBad e = commit (fail e)
-
--- | @x `discard` y@ parses both x and y, but discards the result of y.
--- Rather like @const@ lifted into parsers.
-discard :: PolyParse p => p a -> p b -> p a
-px `discard` py = do { x <- px; return (const x) `apply` py; }
-
--- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
--- severity of the error.
-adjustErrBad :: PolyParse p => p a -> (String->String) -> p a
-p `adjustErrBad` f = commit (p `adjustErr` f)
-
--- | Parse the first alternative in the list that succeeds.
-oneOf :: PolyParse p => [p a] -> p a
-oneOf [] = fail ("failed to parse any of the possible choices")
-oneOf (p:ps) = p `onFail` oneOf ps
---oneOf :: Show t => [Parser t a] -> Parser t a
---oneOf [] = do { n <- next
--- ; fail ("failed to parse any of the possible choices"
--- ++"\n next token is "++show n)
--- }
---oneOf (p:ps) = p `onFail` oneOf ps
-
--- | Helper for formatting error messages: indents all lines by a fixed amount.
-indent :: Int -> String -> String
-indent n = unlines . map (replicate n ' ' ++) . lines
-
--- | 'optional' indicates whether the parser succeeded through the Maybe type.
-optional :: PolyParse p => p a -> p (Maybe a)
-optional p = fmap Just p `onFail` return Nothing
-
--- | 'exactly n p' parses precisely n items, using the parser p, in sequence.
-exactly :: PolyParse p => Int -> p a -> p [a]
-exactly 0 p = return []
-exactly n p = return (:) `apply` (p `adjustErr` (("When expecting exactly "
- ++show n++" more items")++))
- `apply` exactly (n-1) p
-
--- | 'many p' parses a list of elements with individual parser p.
--- Cannot fail, since an empty list is a valid return value.
-many :: PolyParse p => p a -> p [a]
-many p = many1 p `onFail` return []
-
--- | Parse a non-empty list of items.
-many1 :: PolyParse p => p a -> p [a]
-many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
- ; return (x:) `apply` many p
- }
--- `adjustErr` ("When looking for a non-empty sequence:\n\t"++)
-
--- | Parse a list of items separated by discarded junk.
-sepBy :: PolyParse p => p a -> p sep -> p [a]
-sepBy p sep = do sepBy1 p sep `onFail` return []
-
--- | Parse a non-empty list of items separated by discarded junk.
-sepBy1 :: PolyParse p => p a -> p sep -> p [a]
-sepBy1 p sep = do { x <- p
- ; return (x:) `apply` many (do {sep; p})
- }
- `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++)
-
--- | Parse a list of items, discarding the start, end, and separator
--- items.
-bracketSep :: PolyParse p => p bra -> p sep -> p ket -> p a -> p [a]
-bracketSep open sep close p =
- do { open; close; return [] }
- `onFail`
- do { open `adjustErr` ("Missing opening bracket:\n\t"++)
- ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++)
- ; return (x:)
- `apply` manyFinally (do {sep; p})
- (close `adjustErrBad` ("When looking for closing bracket:\n\t"++))
- }
-
--- | Parse a bracketed item, discarding the brackets.
-bracket :: PolyParse p => p bra -> p ket -> p a -> p a
-bracket open close p = do
- do { open `adjustErr` ("Missing opening bracket:\n\t"++)
- ; p `discard` (close `adjustErrBad` ("Missing closing bracket:\n\t"++))
- }
-
--- | 'manyFinally e t' parses a possibly-empty sequence of e's,
--- terminated by a t. The final t is discarded. Any parse failures
--- could be due either to a badly-formed terminator or a badly-formed
--- element, so it raises both possible errors.
-manyFinally :: PolyParse p => p a -> p z -> p [a]
-manyFinally p t =
- (many p `discard` t)
- `onFail`
- oneOf' [ ("sequence terminator", do { t; return [] } )
- , ("item in a sequence", do { p; return [] } )
- ]
-{-
-manyFinally p t =
- do { xs <- many p
- ; oneOf' [ ("sequence terminator", do { t; return () } )
- , ("item in a sequence", do { p; return () } )
- ]
- ; return xs
- }
--}
-------------------------------------------------------------------------
+
+
+src/Text/ParserCombinators/Poly/Base.hs
+
+
+module Text.ParserCombinators.Poly.Base
+ ( -- * The PolyParse class
+ PolyParse(..) -- class of all monadic two-level-error parsers
+
+ -- * Combinators general to all parser types.
+ -- ** Simple combinators
+ , discard -- :: PolyParse p => p a -> p b -> p a
+ -- ** Error-handling
+ , failBad -- :: PolyParse p => String -> p a
+ , adjustErrBad-- :: PolyParse p => p a -> (String->String) -> p a
+ , indent -- :: Int -> String -> String
+ -- ** Choices
+ , oneOf -- :: PolyParse p => [p a] -> p a
+ , optional -- :: PolyParse p => p a -> p (Maybe a)
+ -- ** Sequences
+ , exactly -- :: PolyParse p => Int -> p a -> p [a]
+ , many -- :: PolyParse p => p a -> p [a]
+ , many1 -- :: PolyParse p => p a -> p [a]
+ , sepBy -- :: PolyParse p => p a -> p sep -> p [a]
+ , sepBy1 -- :: PolyParse p => p a -> p sep -> p [a]
+ , bracketSep -- :: PolyParse p => p bra -> p sep -> p ket -> p a -> p [a]
+ , bracket -- :: PolyParse p => p bra -> p ket -> p a -> p a
+ , manyFinally -- :: PolyParse p => p a -> p z -> p [a]
+ ) where
+
+#ifdef __NHC__
+default (Integer,Double,[]) -- hack to avoid bizarre type defaulting error
+instance PolyParse []
+#endif
+
+-- | The @PolyParse@ class is an abstraction over all the current
+-- concrete representations of monadic parser combinators in this
+-- package. The common feature is two-level error-handling.
+-- Some primitives must be implemented specific to each parser type
+-- (e.g. depending on whether the parser has a running state, or
+-- whether it is lazy). But given those primitives, large numbers of
+-- combinators do not depend any further on the internal structure of
+-- the particular parser.
+--
+-- There are two additional basic combinators that we expect to be implemented
+-- afresh for every concrete type, but which (for technical reasons)
+-- cannot be class methods. They are @next@ and @satisfy@.
+class (Functor p, Monad p) => PolyParse p where
+ -- | Commit is a way of raising the severity of any errors found within
+ -- its argument. Used in the middle of a parser definition, it means that
+ -- any operations prior to commitment fail softly, but after commitment,
+ -- they fail hard.
+ commit :: p a -> p a
+ -- | @p `adjustErr` f@ applies the transformation @f@ to any error message
+ -- generated in @p@, having no effect if @p@ succeeds.
+ adjustErr :: p a -> (String -> String) -> p a
+ -- | @p `onFail` q@ means parse p, unless p fails, in which case
+ -- parse q instead.
+ -- Can be chained together to give multiple attempts to parse something.
+ -- (Note that q could itself be a failing parser, e.g. to change the error
+ -- message from that defined in p to something different.)
+ -- However, a severe failure in p cannot be ignored.
+ onFail :: p a -> p a -> p a
+ -- | Parse the first alternative that succeeds, but if none succeed,
+ -- report only the severe errors, and if none of those, then report
+ -- all the soft errors.
+ oneOf' :: [(String, p a)] -> p a
+ -- | Apply a parsed function to a parsed value.
+ -- Rather like ordinary function application lifted into parsers.
+ apply :: p (a->b) -> p a -> p b
+ pf `apply` px = do { f <- pf; x <- px; return (f x) }
+ -- note: the Poly.Lazy variants override this defn with a lazier one.
+
+infixl 6 `onFail` -- not sure about precedence 6?
+infixl 3 `apply`
+infixl 3 `discard`
+
+{-
+-- Combinators we expect most concrete parser types to implement.
+-- For technical reasons, they cannot be class members.
+
+-- | Yield the next token
+next :: PolyParse p => p t
+ -- where t is constrained to be the input token type
+
+-- | One token satisfying a predicate.
+satisfy :: PolyParse p => (t->Bool) -> p t t
+satisfy p = do{ x <- next
+ ; if p x then return x else fail "Parse.satisfy: failed"
+ }
+ -- note: must be re-defined for each implementation because
+ -- its type cannot be expressed otherwise.
+-}
+
+-- | When a simple fail is not strong enough, use failBad for emphasis.
+-- An emphasised (severe) error cannot be overridden by choice
+-- operators.
+failBad :: PolyParse p => String -> p a
+failBad e = commit (fail e)
+
+-- | @x `discard` y@ parses both x and y, but discards the result of y.
+-- Rather like @const@ lifted into parsers.
+discard :: PolyParse p => p a -> p b -> p a
+px `discard` py = do { x <- px; return (const x) `apply` py; }
+
+-- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
+-- severity of the error.
+adjustErrBad :: PolyParse p => p a -> (String->String) -> p a
+p `adjustErrBad` f = commit (p `adjustErr` f)
+
+-- | Parse the first alternative in the list that succeeds.
+oneOf :: PolyParse p => [p a] -> p a
+oneOf [] = fail ("failed to parse any of the possible choices")
+oneOf (p:ps) = p `onFail` oneOf ps
+--oneOf :: Show t => [Parser t a] -> Parser t a
+--oneOf [] = do { n <- next
+-- ; fail ("failed to parse any of the possible choices"
+-- ++"\n next token is "++show n)
+-- }
+--oneOf (p:ps) = p `onFail` oneOf ps
+
+-- | Helper for formatting error messages: indents all lines by a fixed amount.
+indent :: Int -> String -> String
+indent n = unlines . map (replicate n ' ' ++) . lines
+
+-- | 'optional' indicates whether the parser succeeded through the Maybe type.
+optional :: PolyParse p => p a -> p (Maybe a)
+optional p = fmap Just p `onFail` return Nothing
+
+-- | 'exactly n p' parses precisely n items, using the parser p, in sequence.
+exactly :: PolyParse p => Int -> p a -> p [a]
+exactly 0 p = return []
+exactly n p = return (:) `apply` (p `adjustErr` (("When expecting exactly "
+ ++show n++" more items")++))
+ `apply` exactly (n-1) p
+
+-- | 'many p' parses a list of elements with individual parser p.
+-- Cannot fail, since an empty list is a valid return value.
+many :: PolyParse p => p a -> p [a]
+many p = many1 p `onFail` return []
+
+-- | Parse a non-empty list of items.
+many1 :: PolyParse p => p a -> p [a]
+many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
+ ; return (x:) `apply` many p
+ }
+-- `adjustErr` ("When looking for a non-empty sequence:\n\t"++)
+
+-- | Parse a list of items separated by discarded junk.
+sepBy :: PolyParse p => p a -> p sep -> p [a]
+sepBy p sep = do sepBy1 p sep `onFail` return []
+
+-- | Parse a non-empty list of items separated by discarded junk.
+sepBy1 :: PolyParse p => p a -> p sep -> p [a]
+sepBy1 p sep = do { x <- p
+ ; return (x:) `apply` many (do {sep; p})
+ }
+ `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++)
+
+-- | Parse a list of items, discarding the start, end, and separator
+-- items.
+bracketSep :: PolyParse p => p bra -> p sep -> p ket -> p a -> p [a]
+bracketSep open sep close p =
+ do { open; close; return [] }
+ `onFail`
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++)
+ ; return (x:)
+ `apply` manyFinally (do {sep; p})
+ (close `adjustErrBad` ("When looking for closing bracket:\n\t"++))
+ }
+
+-- | Parse a bracketed item, discarding the brackets.
+bracket :: PolyParse p => p bra -> p ket -> p a -> p a
+bracket open close p = do
+ do { open `adjustErr` ("Missing opening bracket:\n\t"++)
+ ; p `discard` (close `adjustErrBad` ("Missing closing bracket:\n\t"++))
+ }
+
+-- | 'manyFinally e t' parses a possibly-empty sequence of e's,
+-- terminated by a t. The final t is discarded. Any parse failures
+-- could be due either to a badly-formed terminator or a badly-formed
+-- element, so it raises both possible errors.
+manyFinally :: PolyParse p => p a -> p z -> p [a]
+manyFinally p t =
+ (many p `discard` t)
+ `onFail`
+ oneOf' [ ("sequence terminator", do { t; return [] } )
+ , ("item in a sequence", do { p; return [] } )
+ ]
+{-
+manyFinally p t =
+ do { xs <- many p
+ ; oneOf' [ ("sequence terminator", do { t; return () } )
+ , ("item in a sequence", do { p; return () } )
+ ]
+ ; return xs
+ }
+-}
+------------------------------------------------------------------------
+
diff --git a/docs/haddock/src/Text/ParserCombinators/Poly/Lazy.html b/docs/haddock/src/Text/ParserCombinators/Poly/Lazy.html
--- a/docs/haddock/src/Text/ParserCombinators/Poly/Lazy.html
+++ b/docs/haddock/src/Text/ParserCombinators/Poly/Lazy.html
@@ -1,140 +1,139 @@
-module Text.ParserCombinators.Poly.Lazy
- ( -- * The Parser datatype.
- -- $parser
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser t a -> [t] -> (a, [t])
- -- ** basic parsers
- , next -- :: Parser t t
- , satisfy -- :: (t->Bool) -> Parser t t
- -- one defn from 'Base' is overridden here, because it depends
- -- on the representation of the Lazy parser monad
- , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a]
- -- ** Re-parsing
- , reparse -- :: [t] -> Parser t ()
- -- * Re-export all more general combinators
- , module Text.ParserCombinators.Poly.Base
- ) where
-
-import Text.ParserCombinators.Poly.Base hiding ( manyFinally )
-
-#if __GLASGOW_HASKELL__
-import Control.Exception hiding (bracket)
-throwE :: String -> a
-throwE msg = throw (ErrorCall msg)
-#else
-throwE :: String -> a
-throwE msg = error msg
-#endif
-
--- $parser
--- When applied, these parsers do not return explicit failure.
--- An exception is
--- raised instead. This allows partial results to be returned
--- before a full parse is complete.
--- One of the key ways to ensure that your parser is properly lazy,
--- is to parse the initial portion of text returning a function, then
--- use the @apply@ combinator to build the final value.
-
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyStateLazy
--- instead.)
-newtype Parser t a = P ([t] -> (Either String a, [t]))
-
--- | Apply a parser to an input token sequence. The parser cannot return
--- an error value explicitly, so errors raise an exception. Thus, results
--- can be partial (lazily constructed, but containing undefined).
-runParser :: Parser t a -> [t] -> (a, [t])
-runParser (P p) =
- (\ (e,ts)-> (case e of {Left m->throwE m; Right x->x}, ts) )
- . p
-
-instance Functor (Parser t) where
- fmap f (P p) = P (\ts-> case p ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> (Right (f x), ts'))
-instance Monad (Parser t) where
- return x = P (\ts-> (Right x, ts))
- (P f) >>= g = P (\ts-> case f ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> let (P g') = g x in g' ts')
- fail e = P (\ts-> (Left e, ts))
-
-
-instance PolyParse (Parser t) where
- commit (P p) = P (\ts-> case p ts of
- (Left e, ts') -> (throwE e, ts')
- right -> right )
- (P p) `onFail` (P q) = P (\ts-> case p ts of
- (Left _, _) -> q ts
- right -> right )
- (P p) `adjustErr` f = P (\ts-> case p ts of
- (Left msg, ts') -> (Left (f msg), ts')
- right -> right )
- oneOf' ps = accum [] ps
- where accum errs [] =
- case errs of
- [] -> failBad ("internal failure in parser (oneOf'):\n"
- ++indent 2 (show (map fst ps)))
- [(_,e)] -> fail e
- es -> fail ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
- accum errs ((e,P p):ps) =
- P (\ts-> case p ts of
- (Left err,_) -> let (P p) = accum ((e,err):errs) ps
- in p ts
- right -> right )
- showErr (name,err) = name++":\n"++indent 2 err
- -- This version of "apply"
- -- is strict in the result of the function parser, but
- -- lazy in the result of the argument parser. (Argument laziness is
- -- the distinctive feature over other implementations.)
- (P pf) `apply` (P px) = P (\ts->
- case pf ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right f, ts') -> let (x',ts'') = px ts'
- x = case x' of { Right x -> x
- ; Left e -> throwE e }
- in (Right (f x), ts'') )
-
--- | Next token
-next = P (\ts-> case ts of
- [] -> (Left "Ran out of input (EOF)", [])
- (t:ts') -> (Right t, ts') )
-
--- | One token satifying a predicate
-satisfy :: (t->Bool) -> Parser t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-
--- | 'manyFinally e t' parses a possibly-empty sequence of e's,
--- terminated by a t. Any parse failures could be due either to
--- a badly-formed terminator or a badly-formed element, so raise
--- both possible errors.
-manyFinally :: Parser t a -> Parser t z -> Parser t [a]
-manyFinally pp@(P p) pt@(P t) = P (\ts ->
- case p ts of
- (Left e, _) ->
- case t ts of
- (Right _, ts') -> (Right [], ts')
- (Left e, ts') -> (Left e, ts')
- (Right x, ts') ->
- let (tail,ts'') = runParser (manyFinally pp pt) ts'
- in (Right (x:tail), ts'') )
-
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser t ()
-reparse ts = P (\inp-> (Right (), ts++inp))
-
-------------------------------------------------------------------------
+
+
+src/Text/ParserCombinators/Poly/Lazy.hs
+
+
+module Text.ParserCombinators.Poly.Lazy
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
+ , Result(..) -- internal to the parser monad
+ , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
+ -- ** basic parsers
+ , next -- :: Parser t t
+ , satisfy -- :: (t->Bool) -> Parser t t
+
+ -- ** re-parsing
+ , reparse -- :: [t] -> Parser t ()
+ -- * Re-export all more general combinators
+ , module Text.ParserCombinators.Poly.Base
+ ) where
+
+
+import Text.ParserCombinators.Poly.Base
+
+#if __GLASGOW_HASKELL__
+import Control.Exception hiding (bracket)
+throwE :: String -> a
+throwE msg = throw (ErrorCall msg)
+#else
+throwE :: String -> a
+throwE msg = error msg
+#endif
+
+
+-- | This @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyState
+-- instead)
+newtype Parser t a = P ([t] -> Result [t] a)
+
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also has gradations of wrongness.
+-- This should only be used for writing very primitive
+-- parsers - really it is an internal detail of the library.
+data Result z a = Success z a
+ | Failure z String
+ | Committed (Result z a) -- still needed
+
+instance Functor (Result z) where
+ fmap f (Success z a) = Success z (f a)
+ fmap f (Failure z e) = Failure z e
+ fmap f (Committed r) = Committed (fmap f r)
+
+-- | Apply a parser to an input token sequence.
+runParser :: Parser t a -> [t] -> (a, [t])
+runParser (P p) = fromResult . p
+ where
+ fromResult :: Result z a -> (a, z)
+ fromResult (Success z a) = (a, z)
+ fromResult (Failure z e) = throwE e
+ fromResult (Committed r) = fromResult r
+
+instance Functor (Parser t) where
+ fmap f (P p) = P (fmap f . p)
+
+instance Monad (Parser t) where
+ return x = P (\ts-> Success ts x)
+ fail e = P (\ts-> Failure ts e)
+ (P f) >>= g = P (continue . f)
+ where
+ continue (Success ts x) = let (P g') = g x in g' ts
+ continue (Committed (Committed r)) = continue (Committed r)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure ts e) = Failure ts e
+
+instance PolyParse (Parser t) where
+ commit (P p) = P (Committed . p)
+ (P p) `adjustErr` f = P (adjust . p)
+ where
+ adjust (Failure z e) = Failure z (f e)
+ adjust (Committed r) = Committed (adjust r)
+ adjust good = good
+
+ (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts)
+ where
+ continue ts (Failure z e) = q ts
+ -- continue _ (Committed r) = r -- no, remain Committed
+ continue _ r = r
+
+ oneOf' = accum []
+ where accum errs [] =
+ fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
+ accum errs ((e,P p):ps) =
+ P (\ts-> case p ts of
+ Failure _ err ->
+ let (P p) = accum ((e,err):errs) ps
+ in p ts
+ r@(Success z a) -> r
+ r@(Committed _) -> r )
+ showErr (name,err) = name++":\n"++indent 2 err
+
+ -- Apply a parsed function to a parsed value. This version
+ -- is strict in the result of the function parser, but
+ -- lazy in the result of the argument parser. (Argument laziness is
+ -- the distinctive feature over other implementations.)
+ (P pf) `apply` px = P (continue . pf)
+ where
+ continue (Success z f) = let (x,z') = runParser px z
+ in Success z' (f x)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure z e) = Failure z e
+
+
+------------------------------------------------------------------------
+next :: Parser t t
+next = P (\ts-> case ts of
+ [] -> Failure [] "Ran out of input (EOF)"
+ (t:ts') -> Success ts' t )
+
+satisfy :: (t->Bool) -> Parser t t
+satisfy pred = do { x <- next
+ ; if pred x then return x else fail "Parse.satisfy: failed"
+ }
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser t ()
+reparse ts = P (\inp-> Success (ts++inp) ())
+
+------------------------------------------------------------------------
+
diff --git a/docs/haddock/src/Text/ParserCombinators/Poly/Plain.html b/docs/haddock/src/Text/ParserCombinators/Poly/Plain.html
--- a/docs/haddock/src/Text/ParserCombinators/Poly/Plain.html
+++ b/docs/haddock/src/Text/ParserCombinators/Poly/Plain.html
@@ -1,96 +1,117 @@
-module Text.ParserCombinators.Poly.Plain
- ( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
- , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
- -- ** basic parsers
- , next -- :: Parser t t
- , satisfy -- :: (t->Bool) -> Parser t t
-
- -- ** re-parsing
- , reparse -- :: [t] -> Parser t ()
- -- * Re-export all more general combinators
- , module Text.ParserCombinators.Poly.Base
- ) where
-
-
-import Text.ParserCombinators.Poly.Base
-
--- | This @Parser@ datatype is a fairly generic parsing monad with error
--- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyState
--- instead)
-newtype Parser t a = P ([t] -> (EitherE String a, [t]))
-
--- A return type like Either, that distinguishes not only between
--- right and wrong answers, but also has gradations of wrongness.
-type EitherE a b = Either (Bool,a) b
-
--- | Apply a parser to an input token sequence.
-runParser :: Parser t a -> [t] -> (Either String a, [t])
-runParser (P p) =
- (\ (e,ts)-> (case e of {Left (_,m)->Left m; Right m->Right m}, ts) )
- . p
-
-instance Functor (Parser t) where
- fmap f (P p) = P (\ts-> case p ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> (Right (f x), ts'))
-instance Monad (Parser t) where
- return x = P (\ts-> (Right x, ts))
- (P f) >>= g = P (\ts-> case f ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> let (P g') = g x in g' ts')
- fail e = P (\ts-> (Left (False,e), ts))
-
-instance PolyParse (Parser t) where
- commit (P p) = P (\ts-> case p ts of
- (Left (_,e), ts') -> (Left (True,e), ts')
- right -> right )
- (P p) `adjustErr` f = P (\ts-> case p ts of
- (Left (b,msg), ts') -> (Left (b,(f msg)), ts')
- right -> right )
- (P p) `onFail` (P q) = P (\ts-> case p ts of
- r@(Left (True,_), _) -> r
- (Left _, _) -> q ts
- right -> right )
- oneOf' = accum []
- where accum errs [] =
- case filter isBad errs of
- [] -> fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- [(_,(_,e))] -> failBad e
- es -> failBad ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
- accum errs ((e,P p):ps) =
- P (\ts-> case p ts of
- (Left err,_) -> let (P p) = accum ((e,err):errs) ps
- in p ts
- right -> right )
- showErr (name,(_,err)) = name++":\n"++indent 2 err
- isBad (_,(b,_)) = b
-
-------------------------------------------------------------------------
-next :: Parser t t
-next = P (\ts-> case ts of
- [] -> (Left (False,"Ran out of input (EOF)"), [])
- (t:ts') -> (Right t, ts') )
-
-satisfy :: (t->Bool) -> Parser t t
-satisfy pred = do { x <- next
- ; if pred x then return x else fail "Parse.satisfy: failed"
- }
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser t ()
-reparse ts = P (\inp-> (Right (), ts++inp))
-
-------------------------------------------------------------------------
+
+
+src/Text/ParserCombinators/Poly/Plain.hs
+
+
+module Text.ParserCombinators.Poly.Plain
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
+ , Result(..) -- internal to the Parser Monad.
+ , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
+ -- ** basic parsers
+ , next -- :: Parser t t
+ , satisfy -- :: (t->Bool) -> Parser t t
+
+ -- ** re-parsing
+ , reparse -- :: [t] -> Parser t ()
+ -- * Re-export all more general combinators
+ , module Text.ParserCombinators.Poly.Base
+ ) where
+
+
+import Text.ParserCombinators.Poly.Base
+
+-- | This @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyState
+-- instead)
+newtype Parser t a = P ([t] -> Result [t] a)
+
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also has commitment, so that a failure
+-- cannot be undone. This should only be used for writing very primitive
+-- parsers - really it is an internal detail of the library.
+data Result z a = Success z a
+ | Failure z String
+ | Committed (Result z a)
+
+instance Functor (Result z) where
+ fmap f (Success z a) = Success z (f a)
+ fmap f (Failure z e) = Failure z e
+ fmap f (Committed r) = Committed (fmap f r)
+
+-- | Apply a parser to an input token sequence.
+runParser :: Parser t a -> [t] -> (Either String a, [t])
+runParser (P p) = resultToEither . p
+ where
+ resultToEither :: Result z a -> (Either String a, z)
+ resultToEither (Success z a) = (Right a, z)
+ resultToEither (Failure z e) = (Left e, z)
+ resultToEither (Committed r) = resultToEither r
+
+instance Functor (Parser t) where
+ fmap f (P p) = P (fmap f . p)
+
+instance Monad (Parser t) where
+ return x = P (\ts-> Success ts x)
+ fail e = P (\ts-> Failure ts e)
+ (P f) >>= g = P (continue . f)
+ where
+ continue (Success ts x) = let (P g') = g x in g' ts
+ continue (Committed (Committed r)) = continue (Committed r)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure ts e) = Failure ts e
+
+instance PolyParse (Parser t) where
+ commit (P p) = P (Committed . p)
+ (P p) `adjustErr` f = P (adjust . p)
+ where
+ adjust (Failure z e) = Failure z (f e)
+ adjust (Committed r) = Committed (adjust r)
+ adjust good = good
+
+ (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts)
+ where
+ continue ts (Failure z e) = q ts
+ -- continue _ (Committed r) = r -- no, remain Committed
+ continue _ r = r
+
+ oneOf' = accum []
+ where accum errs [] =
+ fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
+ accum errs ((e,P p):ps) =
+ P (\ts-> case p ts of
+ Failure _ err ->
+ let (P p) = accum ((e,err):errs) ps
+ in p ts
+ r@(Success z a) -> r
+ r@(Committed _) -> r )
+ showErr (name,err) = name++":\n"++indent 2 err
+
+------------------------------------------------------------------------
+next :: Parser t t
+next = P (\ts-> case ts of
+ [] -> Failure [] "Ran out of input (EOF)"
+ (t:ts') -> Success ts' t )
+
+satisfy :: (t->Bool) -> Parser t t
+satisfy pred = do { x <- next
+ ; if pred x then return x else fail "Parse.satisfy: failed"
+ }
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser t ()
+reparse ts = P (\inp-> Success (ts++inp) ())
+
+------------------------------------------------------------------------
+
diff --git a/docs/haddock/src/Text/ParserCombinators/Poly/State.html b/docs/haddock/src/Text/ParserCombinators/Poly/State.html
--- a/docs/haddock/src/Text/ParserCombinators/Poly/State.html
+++ b/docs/haddock/src/Text/ParserCombinators/Poly/State.html
@@ -1,113 +1,135 @@
-module Text.ParserCombinators.Poly.State
- ( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
- -- ** basic parsers
- , next -- :: Parser s t t
- , satisfy -- :: (t->Bool) -> Parser s t t
- -- ** State-handling
- , stUpdate -- :: (s->s) -> Parser s t ()
- , stQuery -- :: (s->a) -> Parser s t a
- , stGet -- :: Parser s t s
- -- ** Re-parsing
- , reparse -- :: [t] -> Parser s t ()
- -- * Re-export all more general combinators.
- , module Text.ParserCombinators.Poly.Base
- ) where
-
-import Text.ParserCombinators.Poly.Base
-
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting and a running state. It can be used for arbitrary token
--- types, not just String input.
-newtype Parser s t a = P (s -> [t] -> (EitherE String a, s, [t]))
-
--- | A return type like Either, that distinguishes not only between
--- right and wrong answers, but also had gradations of wrongness.
-type EitherE a b = Either (Bool,a) b
-
--- | Apply a parser to an initial state and input token sequence.
-runParser :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
-runParser (P p) s =
- (\ (e,s,ts)-> (case e of Left (_,m)->Left m; Right m->Right m
- ,s,ts))
- . p s
-
-instance Functor (Parser s t) where
- fmap f (P p) = P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> (Right (f x), s', ts'))
-instance Monad (Parser s t) where
- return x = P (\s ts-> (Right x, s, ts))
- (P f) >>= g = P (\s ts-> case f s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> let (P g') = g x
- in g' s' ts')
- fail msg = P (\s ts-> (Left (False,msg), s, ts))
-
-instance PolyParse (Parser s t) where
- commit (P p) = P (\s ts-> case p s ts of
- (Left (_,e), s', ts') -> (Left (True,e), s', ts')
- right -> right )
- (P p) `onFail` (P q) = P (\s ts-> case p s ts of
- r@(Left (True,_), _, _) -> r
- (Left _, _, _) -> q s ts
- right -> right )
- (P p) `adjustErr` f = P (\s ts-> case p s ts of
- (Left (b,msg), s', ts')
- -> (Left (b,(f msg)), s, ts')
- right -> right )
- oneOf' = accum []
- where accum errs [] =
- case filter isBad errs of
- [] -> fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- [(_,(_,e))] -> failBad e
- es -> failBad ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
- accum errs ((e,P p):ps) =
- P (\u ts-> case p u ts of
- (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
- in p u ts
- right -> right )
- showErr (name,(_,err)) = name++":\n"++indent 2 err
- isBad (_,(b,_)) = b
-
-------------------------------------------------------------------------
-next = P (\s ts-> case ts of
- [] -> (Left (False,"Ran out of input (EOF)"), s, [])
- (t:ts') -> (Right t, s, ts') )
-
-satisfy :: (t->Bool) -> Parser s t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-------------------------------------------------------------------------
--- State handling
-
--- | Update the internal state.
-stUpdate :: (s->s) -> Parser s t ()
-stUpdate f = P (\s ts-> (Right (), f s, ts))
-
--- | Query the internal state.
-stQuery :: (s->a) -> Parser s t a
-stQuery f = P (\s ts-> (Right (f s), s, ts))
-
--- | Deliver the entire internal state.
-stGet :: Parser s t s
-stGet = P (\s ts-> (Right s, s, ts))
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser s t ()
-reparse ts = P (\s inp-> (Right (), s, ts++inp))
-
-------------------------------------------------------------------------
+
+
+src/Text/ParserCombinators/Poly/State.hs
+
+
+module Text.ParserCombinators.Poly.State
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
+ , Result(..) -- internal to the parser monad
+ , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
+ -- ** basic parsers
+ , next -- :: Parser s t t
+ , satisfy -- :: (t->Bool) -> Parser s t t
+ -- ** State-handling
+ , stUpdate -- :: (s->s) -> Parser s t ()
+ , stQuery -- :: (s->a) -> Parser s t a
+ , stGet -- :: Parser s t s
+ -- ** re-parsing
+ , reparse -- :: [t] -> Parser s t ()
+ -- * Re-export all more general combinators
+ , module Text.ParserCombinators.Poly.Base
+ ) where
+
+
+import Text.ParserCombinators.Poly.Base
+
+-- | This @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyState
+-- instead)
+newtype Parser s t a = P (s -> [t] -> Result [t] s a)
+
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also has gradations of wrongness.
+-- This should only be used for writing very primitive
+-- parsers - really it is an internal detail of the library.
+data Result z s a = Success z s a
+ | Failure z s String
+ | Committed (Result z s a)
+
+instance Functor (Result z s) where
+ fmap f (Success z s a) = Success z s (f a)
+ fmap f (Failure z s e) = Failure z s e
+ fmap f (Committed r) = Committed (fmap f r)
+
+-- | Apply a parser to an input token sequence.
+runParser :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
+runParser (P p) = \s-> resultToEither . p s
+ where
+ resultToEither :: Result z s a -> (Either String a, s, z)
+ resultToEither (Success z s a) = (Right a, s, z)
+ resultToEither (Failure z s e) = (Left e, s, z)
+ resultToEither (Committed r) = resultToEither r
+
+instance Functor (Parser s t) where
+ fmap f (P p) = P (\s-> fmap f . p s)
+
+instance Monad (Parser s t) where
+ return x = P (\s ts-> Success ts s x)
+ fail e = P (\s ts-> Failure ts s e)
+ (P f) >>= g = P (\s-> continue . f s)
+ where
+ continue (Success ts s x) = let (P g') = g x in g' s ts
+ continue (Committed (Committed r)) = continue (Committed r)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure ts s e) = Failure ts s e
+
+instance PolyParse (Parser s t) where
+ commit (P p) = P (\s-> Committed . p s)
+ (P p) `adjustErr` f = P (\s-> adjust . p s)
+ where
+ adjust (Failure z s e) = Failure z s (f e)
+ adjust (Committed r) = Committed (adjust r)
+ adjust good = good
+
+ (P p) `onFail` (P q) = P (\s ts-> continue s ts $ p s ts)
+ where
+ continue s ts (Failure _ _ _) = q s ts
+ -- continue _ _ (Committed r) = r -- no, remain Committed
+ continue _ _ r = r
+
+ oneOf' = accum []
+ where accum errs [] =
+ fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
+ accum errs ((e,P p):ps) =
+ P (\s ts-> case p s ts of
+ Failure _ _ err ->
+ let (P p) = accum ((e,err):errs) ps
+ in p s ts
+ r@(Success z _ a) -> r
+ r@(Committed _) -> r )
+ showErr (name,err) = name++":\n"++indent 2 err
+
+------------------------------------------------------------------------
+next :: Parser s t t
+next = P (\s ts-> case ts of
+ [] -> Failure [] s "Ran out of input (EOF)"
+ (t:ts') -> Success ts' s t )
+
+satisfy :: (t->Bool) -> Parser s t t
+satisfy pred = do { x <- next
+ ; if pred x then return x else fail "Parse.satisfy: failed"
+ }
+------------------------------------------------------------------------
+-- State handling
+
+-- | Update the internal state.
+stUpdate :: (s->s) -> Parser s t ()
+stUpdate f = P (\s ts-> Success ts (f s) ())
+
+-- | Query the internal state.
+stQuery :: (s->a) -> Parser s t a
+stQuery f = P (\s ts-> Success ts s (f s))
+
+-- | Deliver the entire internal state.
+stGet :: Parser s t s
+stGet = P (\s ts-> Success ts s s)
+
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser s t ()
+reparse ts = P (\s inp-> Success (ts++inp) s ())
+
+------------------------------------------------------------------------
+
diff --git a/docs/haddock/src/Text/ParserCombinators/Poly/StateLazy.html b/docs/haddock/src/Text/ParserCombinators/Poly/StateLazy.html
--- a/docs/haddock/src/Text/ParserCombinators/Poly/StateLazy.html
+++ b/docs/haddock/src/Text/ParserCombinators/Poly/StateLazy.html
@@ -1,144 +1,185 @@
-module Text.ParserCombinators.Poly.StateLazy
- ( -- * The Parser datatype.
- -- $parser
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser s t a -> s -> [t] -> (a, s, [t])
- -- * Combinators:
- -- ** Primitives
- , next -- :: Parser s t t
- , satisfy -- :: (t->Bool) -> Parser s t t
- -- ** State-handling
- , stUpdate -- :: (s->s) -> Parser s t ()
- , stQuery -- :: (s->a) -> Parser s t a
- , stGet -- :: Parser s t s
- -- ** Re-parsing
- , reparse -- :: [t] -> Parser s t ()
- -- * Re-export all more general combinators
- , module Text.ParserCombinators.Poly.Base
- ) where
-
-import Text.ParserCombinators.Poly.Base
-
-#if __GLASGOW_HASKELL__
-import Control.Exception hiding (bracket)
-throwE :: String -> a
-throwE msg = throw (ErrorCall msg)
-#else
-throwE :: String -> a
-throwE msg = error msg
-#endif
-
--- $parser
--- Parsers do not return explicit failure. An exception is raised
--- instead. This allows partial results to be returned before a
--- full parse is complete.
-
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting and a running state. It can be used for arbitrary token
--- types, not just String input.
-newtype Parser s t a = P (s -> [t] -> (Either String a, s, [t]))
-
--- | A return type like Either, that distinguishes not only between
--- right and wrong answers, but also had gradations of wrongness.
--- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!!
-type EitherE a b = Either (Bool,a) b
-
--- | Apply a parser to an initial state and input token sequence.
--- The parser cannot return an error value explicitly, so errors
--- raise an exception. Thus, results can be partial (lazily constructed,
--- but containing undefined).
-runParser :: Parser s t a -> s -> [t] -> (a, s, [t])
-runParser (P p) s =
- (\ (e,s,ts)-> (case e of {Left m->throwE m; Right x->x}, s, ts))
- . p s
-
-instance Functor (Parser s t) where
- fmap f (P p) = P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> (Right (f x), s', ts'))
-instance Monad (Parser s t) where
- return x = P (\s ts-> (Right x, s, ts))
- (P f) >>= g = P (\s ts-> case f s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> let (P g') = g x
- in g' s' ts')
- fail msg = P (\s ts-> (Left msg, s, ts))
-
-instance PolyParse (Parser s t) where
- commit (P p) = P (\s ts-> case p s ts of
- (Left e, s', ts') -> (throwE e, s', ts')
- right -> right )
- (P p) `adjustErr` f =
- P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (Left (f msg), s, ts')
- right -> right )
- (P p) `onFail` (P q) = P (\s ts-> case p s ts of
- (Left _, _, _) -> q s ts
- right -> right )
- oneOf' ps = accum [] ps
- where accum errs [] =
- case errs of
- [] -> failBad ("internal failure in parser (oneOf'):\n"
- ++indent 2 (show (map fst ps)))
- [(_,e)] -> fail e
- es -> fail ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
- accum errs ((e,P p):ps) =
- P (\u ts-> case p u ts of
- (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
- in p u ts
- right -> right )
- showErr (name,err) = name++":\n"++indent 2 err
- (P pf) `apply` (P px) = P (\s ts->
- case pf s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right f, s', ts') -> let (x',s'',ts'') = px s' ts'
- x = case x' of { Right x -> x
- ; Left e -> throwE e }
- in (Right (f x), s'', ts'') )
-
-
--- Combinators
-
--- | Yield one token.
-next :: Parser s t t
-next = P (\s ts-> case ts of
- [] -> (Left "Ran out of input (EOF)", s, [])
- (t:ts') -> (Right t, s, ts') )
-
--- | Yield one token if it satisfies a predicate.
-satisfy :: (t->Bool) -> Parser s t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-
-
-------------------------------------------------------------------------
--- State handling
-
--- | Update the internal state.
-stUpdate :: (s->s) -> Parser s t ()
-stUpdate f = P (\s ts-> (Right (), f s, ts))
-
--- | Query the internal state.
-stQuery :: (s->a) -> Parser s t a
-stQuery f = P (\s ts-> (Right (f s), s, ts))
-
--- | Deliver the entire internal state.
-stGet :: Parser s t s
-stGet = P (\s ts-> (Right s, s, ts))
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser s t ()
-reparse ts = P (\s inp-> (Right (), s, ts++inp))
-
-------------------------------------------------------------------------
+
+
+src/Text/ParserCombinators/Poly/StateLazy.hs
+
+
+module Text.ParserCombinators.Poly.StateLazy
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
+ , Result(..) -- internal to the parser monad
+ , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
+ -- ** basic parsers
+ , next -- :: Parser s t t
+ , satisfy -- :: (t->Bool) -> Parser s t t
+ , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a]
+ -- ** State-handling
+ , stUpdate -- :: (s->s) -> Parser s t ()
+ , stQuery -- :: (s->a) -> Parser s t a
+ , stGet -- :: Parser s t s
+ -- ** re-parsing
+ , reparse -- :: [t] -> Parser s t ()
+ -- * Re-export all more general combinators
+ , module Text.ParserCombinators.Poly.Base
+ ) where
+
+
+import Text.ParserCombinators.Poly.Base hiding (manyFinally)
+
+#if __GLASGOW_HASKELL__
+import Control.Exception hiding (bracket)
+throwE :: String -> a
+throwE msg = throw (ErrorCall msg)
+#else
+throwE :: String -> a
+throwE msg = error msg
+#endif
+
+
+-- | This @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyState
+-- instead)
+newtype Parser s t a = P (s -> [t] -> Result [t] s a)
+
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also has gradations of wrongness.
+-- This should only be used for writing very primitive
+-- parsers - really it is an internal detail of the library.
+data Result z s a = Success z s a
+ | Failure z s String
+ | Committed (Result z s a)
+
+instance Functor (Result z s) where
+ fmap f (Success z s a) = Success z s (f a)
+ fmap f (Failure z s e) = Failure z s e
+ fmap f (Committed r) = Committed (fmap f r)
+
+-- | Apply a parser to an input token sequence.
+runParser :: Parser s t a -> s -> [t] -> (a, s, [t])
+runParser (P p) = \s -> fromResult . p s
+ where
+ fromResult :: Result z s a -> (a, s, z)
+ fromResult (Success z s a) = (a, s, z)
+ fromResult (Failure z s e) = throwE e
+ fromResult (Committed r) = fromResult r
+
+instance Functor (Parser s t) where
+ fmap f (P p) = P (\s -> fmap f . p s)
+
+instance Monad (Parser s t) where
+ return x = P (\s ts-> Success ts s x)
+ fail e = P (\s ts-> Failure ts s e)
+ (P f) >>= g = P (\s-> continue . f s)
+ where
+ continue (Success ts s x) = let (P g') = g x in g' s ts
+ continue (Committed (Committed r)) = continue (Committed r)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure ts s e) = Failure ts s e
+
+instance PolyParse (Parser s t) where
+ commit (P p) = P (\s-> Committed . p s)
+ (P p) `adjustErr` f = P (\s-> adjust . p s)
+ where
+ adjust (Failure z s e) = Failure z s (f e)
+ adjust (Committed r) = Committed (adjust r)
+ adjust good = good
+
+ (P p) `onFail` (P q) = P (\s ts-> continue s ts $ p s ts)
+ where
+ continue s ts (Failure _ _ _) = q s ts
+ -- continue _ _ (Committed r) = r -- no, remain Committed
+ continue _ _ r = r
+
+ oneOf' = accum []
+ where accum errs [] =
+ fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
+ accum errs ((e,P p):ps) =
+ P (\s ts-> case p s ts of
+ Failure _ _ err ->
+ let (P p) = accum ((e,err):errs) ps
+ in p s ts
+ r@(Success z _ a) -> r
+ r@(Committed _) -> r )
+ showErr (name,err) = name++":\n"++indent 2 err
+
+ -- Apply a parsed function to a parsed value. This version
+ -- is strict in the result of the function parser, but
+ -- lazy in the result of the argument parser. (Argument laziness is
+ -- the distinctive feature over other implementations.)
+ (P pf) `apply` px = P (\s-> continue . pf s)
+ where
+ continue (Success z s f) = let (x,s',z') = runParser px s z
+ in Success z' s' (f x)
+ continue (Failure z s e) = Failure z s e
+ continue (Committed r) = Committed (continue r)
+
+manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
+{-
+manyFinally pp@(P p) pt@(P t) = P (\s ts -> item s ts (p s ts))
+ where
+ item _ _ (Success ts s x) = success ts s x
+ item s ts (Failure _ _ e) = terminate (t s ts)
+ item s ts (Committed r) = Committed (within r)
+
+ success ts s x =
+ let (tail,s',ts') = runParser (manyFinally pp pt) s ts
+ in Success ts' s' (x:tail)
+
+ terminate (Success ts s _) = Success ts s []
+ terminate (Failure ts s e) = Failure ts s e
+ terminate (Committed r) = Committed (terminate r)
+
+ within (Success ts s x) = success ts s x
+ within (Failure ts s e) = Failure ts s e
+ within (Committed r) = within r
+-}
+
+manyFinally p z =
+ (do x <- p; return (x:) `apply` manyFinally p z)
+ `onFail`
+ (do z; return [])
+ `onFail`
+ oneOf' [ ("item in sequence", (do p; return []))
+ , ("sequence terminator", (do z; return [])) ]
+
+------------------------------------------------------------------------
+next :: Parser s t t
+next = P (\s ts-> case ts of
+ [] -> Failure [] s "Ran out of input (EOF)"
+ (t:ts') -> Success ts' s t )
+
+satisfy :: (t->Bool) -> Parser s t t
+satisfy pred = do { x <- next
+ ; if pred x then return x else fail "Parse.satisfy: failed"
+ }
+------------------------------------------------------------------------
+-- State handling
+
+-- | Update the internal state.
+stUpdate :: (s->s) -> Parser s t ()
+stUpdate f = P (\s ts-> Success ts (f s) ())
+
+-- | Query the internal state.
+stQuery :: (s->a) -> Parser s t a
+stQuery f = P (\s ts-> Success ts s (f s))
+
+-- | Deliver the entire internal state.
+stGet :: Parser s t s
+stGet = P (\s ts-> Success ts s s)
+
+------------------------------------------------------------------------
+-- | Push some tokens back onto the front of the input stream and reparse.
+-- This is useful e.g. for recursively expanding macros. When the
+-- user-parser recognises a macro use, it can lookup the macro
+-- expansion from the parse state, lex it, and then stuff the
+-- lexed expansion back down into the parser.
+reparse :: [t] -> Parser s t ()
+reparse ts = P (\s inp-> Success (ts++inp) s ())
+
+------------------------------------------------------------------------
+
diff --git a/docs/index.html b/docs/index.html
--- a/docs/index.html
+++ b/docs/index.html
@@ -31,21 +31,26 @@
widely-used parser libraries available elsewhere.
-- Text.ParserCombinators.HuttonMeijer The most venerable of all
- monadic parser combinator libraries, this version dates from 1996.
- Originally distributed with Gofer, then Hugs, as ParseLib. It uses
- the idea of "failure as a list of successes" to give multiple
- possible parses through backtracking. (But in practice, almost
- nobody wants any parse except the first complete one.)
-
- Text.ParserCombinators.HuttonMeijerWallace The
- Hutton/Meijer combinators, extended to take an arbitrary token type
- as input (not just characters), plus a running state (e.g. to
- collect a symbol table, or macros), plus some facilities for
- simple error-reporting.
+
- Text.Parse The Text.Read class from Haskell'98 is widely
+ recognised to have many problems. It is inefficient. If a read
+ fails, there is no indication of why. Worst of all, a read failure
+ crashes your whole program! Text.Parse is a proposed replacement
+ for the Read class. It defines a new class, Parse, with methods
+ that return an explicit notification of errors, through the Either
+ type. It also defines a number of useful helper functions to
+ enable the construction of parsers for textual representations of
+ Haskell data structures, e.g. named fields. Unsurprisingly,
+ Text.Parse is really just a specialisation of the Poly combinators
+ for String input, and the entire Poly API is also re-exported.
+ The DrIFT
+ tool can derive instances of the Parse class for you
+ automatically. (Use the syntax {-! derive : Parse !-})
- Text.ParserCombinators.Poly
+ Currently re-exports Text.ParserCombinators.Poly.Plain.
The name Poly comes from the arbitrary token type. Thus, you can
write your own lexer if you wish, rather than needing to encode
- lexical analysis within the parser itself. This is a fresh
+ lexical analysis within the parser itself.
+
- Text.ParserCombinators.Poly.Plain This is a fresh
set of combinators, improving on the HuttonMeijer variety by
keeping only a single success, not a list of them. This is
more space-efficient, whilst still permitting backtracking.
@@ -56,9 +61,9 @@
already passed a point of commitment. Thus you can give far more
accurate error messages to the user, including multi-layered
locations.
-
- Text.ParserCombinators.PolyState is just like Poly, except it
+
- Text.ParserCombinators.Poly.State is just like Poly, except it
adds an arbitrary running state parameter.
-
- Text.ParserCombinators.PolyLazy is just like Poly, except it
+
- Text.ParserCombinators.Poly.Lazy is just like Poly, except it
does not return explicit failures. Instead, an exception is raised.
Thus, it can return a partial parse result, before a full parse is
complete. The word partial indicates that, having committed to
@@ -69,51 +74,29 @@
space-efficiency - essentially you can stream-process your parsed
data-structure within very small constant space. This is especially
useful for large structures like e.g. XML trees.
-
- Text.ParserCombinators.PolyStateLazy combines PolyState and
- PolyLazy.
+
- Text.ParserCombinators.Poly.StateLazy combines Poly.State and
+ Poly.Lazy.
- Text.ParserCombinators.Poly.Base
- Following on from the basic Poly combinators, it became clear that
- all of the variations share a lot in common, and that many of the
+ All of the Poly variations (Plain, Lazy, State, etc)
+ share a lot in common: many of the
combinators are indeed implemented identically. To reduce code
- duplication in the library, we now provide a class-based interface
+ duplication in the library, we provide a class-based interface
here. The actual implementations for strict, lazy, and so on, are
instances of the class, defined in modules at the same level in the
- hierarchy (e.g. T.P.Poly.Lazy etc).
-
- Text.ParserCombinators.Poly.Plain
- The class instance for ordinary, strict, parsers, with arbitrary
- token type.
-
- Text.ParserCombinators.Poly.Lazy
- The class instance for lazy parsers, with arbitrary token type.
-
- Text.ParserCombinators.Poly.State
- The class instance for strict parsers, with arbitrary token type
- and running state.
-
- Text.ParserCombinators.Poly.StateLazy
- The class instance for lazy parsers, with arbitrary token type
- and running state.
-
- Text.ParserCombinators.Poly.Stream
- The class instance for strict parsers, where input tokens arrive
- in a Stream datatype rather than a list.
-
- Text.ParserCombinators.Poly.NoLeak.Plain
- An experimental implementation of strict parsers, attempting to
- avoid a particular space leak associated with the choice
- combinator.
-
- Text.ParserCombinators.Poly.NoLeak.Lazy
-
- Text.ParserCombinators.Poly.NoLeak.State
-
- Text.ParserCombinators.Poly.NoLeak.StateLazy
-
- Text.Parse The Text.Read class from Haskell'98 is widely
- recognised to have many problems. It is inefficient. If a read
- fails, there is no indication of why. Worst of all, a read failure
- crashes your whole program! Text.Parse is a proposed replacement
- for the Read class. It defines a new class, Parse, with methods
- that return an explicit notification of errors, through the Either
- type. It also defines a number of useful helper functions to
- enable the construction of parsers for textual representations of
- Haskell data structures, e.g. named fields. Unsurprisingly,
- Text.Parse is really just a specialisation of the Poly combinators
- for String input, and the entire Poly API is also re-exported.
- The DrIFT
- tool can derive instances of the Parse class for you
- automatically. (Use the syntax {-! derive : Parse !-})
+ hierarchy (e.g. T.P.Poly.Lazy etc). Every individual variation
+ re-exports these base combinators, so there should be no need to
+ import this module directly.
+
- Text.ParserCombinators.HuttonMeijer The most venerable of all
+ monadic parser combinator libraries, this version dates from 1996.
+ Originally distributed with Gofer, then Hugs, as ParseLib. It uses
+ the idea of "failure as a list of successes" to give multiple
+ possible parses through backtracking. (But in practice, almost
+ nobody wants any parse except the first complete one.)
+
- Text.ParserCombinators.HuttonMeijerWallace The
+ Hutton/Meijer combinators, extended to take an arbitrary token type
+ as input (not just characters), plus a running state (e.g. to
+ collect a symbol table, or macros), plus some facilities for
+ simple error-reporting.
All the Poly* variations share the same basic API, so it is easy
@@ -178,10 +161,10 @@
Current released version:
-polyparse-1.1, release date 2007.10.23
+polyparse-1.2, release date 2009.03.04
By HTTP:
-.tar.gz,
-.zip.
+.tar.gz,
+.zip.
By FTP:
@@ -189,12 +172,17 @@
Older versions:
+polyparse-1.1, release date 2007.10.23
+By HTTP:
+.tar.gz,
+.zip.
+
polyparse-1.0, release date 2007.01.26
By HTTP:
-.tar.gz,
-.zip.
+.tar.gz,
+.zip.
-By FTP:
+All older versions by FTP:
ftp://ftp.cs.york.ac.uk/pub/haskell/polyparse/
@@ -227,6 +215,13 @@
+
+Version 1.2 improves the Text.Parse implementation significantly. Where
+previously all the parsers for builtin basic datatype (Int,Float,Char)
+were just thin wrappers over the H'98 Read instances, now they are all
+proper parsers, therefore they should (a) be faster; (b) give better
+error messages.
+
Version 1.1 much improves the laziness characteristics of the Poly*
combinators. There are also a lot of new implementations of the Poly*
diff --git a/polyparse.cabal b/polyparse.cabal
--- a/polyparse.cabal
+++ b/polyparse.cabal
@@ -1,7 +1,6 @@
name: polyparse
-version: 1.1
-ghc-options: -DVERSION="1.1"
-cc-options: -DVERSION="1.1"
+version: 1.2
+cpp-options: -DVERSION="1.2"
nhc98-options: -K6M
license: LGPL
license-file: COPYRIGHT
@@ -21,19 +20,13 @@
Text.ParserCombinators.HuttonMeijer,
Text.ParserCombinators.HuttonMeijerWallace,
Text.ParserCombinators.Poly,
- Text.ParserCombinators.PolyState,
- Text.ParserCombinators.PolyLazy,
- Text.ParserCombinators.PolyStateLazy,
Text.ParserCombinators.Poly.Base,
Text.ParserCombinators.Poly.Plain,
Text.ParserCombinators.Poly.Lazy,
Text.ParserCombinators.Poly.State,
Text.ParserCombinators.Poly.StateLazy,
- Text.ParserCombinators.Poly.NoLeak.Plain,
- Text.ParserCombinators.Poly.NoLeak.State,
- Text.ParserCombinators.Poly.NoLeak.Lazy,
- Text.ParserCombinators.Poly.NoLeak.StateLazy,
Text.Parse
-hs-source-dir: src
+hs-source-dirs: src
build-depends: base, haskell98
+build-type: Simple
extensions: CPP
diff --git a/src/Makefile b/src/Makefile
--- a/src/Makefile
+++ b/src/Makefile
@@ -1,22 +1,15 @@
SOFTWARE = polyparse
-VERSION = 1.1
+VERSION = 1.2
LIBSRCS = \
Text/ParserCombinators/HuttonMeijer.hs \
Text/ParserCombinators/HuttonMeijerWallace.hs \
Text/ParserCombinators/Poly.hs \
- Text/ParserCombinators/PolyState.hs \
- Text/ParserCombinators/PolyLazy.hs \
- Text/ParserCombinators/PolyStateLazy.hs \
Text/ParserCombinators/Poly/Base.hs \
Text/ParserCombinators/Poly/Plain.hs \
Text/ParserCombinators/Poly/Lazy.hs \
Text/ParserCombinators/Poly/State.hs \
Text/ParserCombinators/Poly/StateLazy.hs \
- Text/ParserCombinators/Poly/NoLeak/Plain.hs \
- Text/ParserCombinators/Poly/NoLeak/Lazy.hs \
- Text/ParserCombinators/Poly/NoLeak/State.hs \
- Text/ParserCombinators/Poly/NoLeak/StateLazy.hs \
Text/Parse.hs \
LIBOBJS = $(patsubst %.hs, %.o, $(LIBSRCS))
diff --git a/src/Text/Parse.hs b/src/Text/Parse.hs
--- a/src/Text/Parse.hs
+++ b/src/Text/Parse.hs
@@ -9,15 +9,26 @@
, word -- :: TextParser String
, isWord -- :: String -> TextParser ()
, optionalParens -- :: TextParser a -> TextParser a
+ , parens -- :: Bool -> TextParser a -> TextParser a
, field -- :: Parse a => String -> TextParser a
, constructors-- :: [(String,TextParser a)] -> TextParser a
, enumeration -- :: Show a => String -> [a] -> TextParser a
+ -- ** Parsers for literal numerics and characters
+ , parseSigned
+ , parseInt
+ , parseDec
+ , parseOct
+ , parseHex
+ , parseFloat
+ , parseLitChar
-- ** Re-export all the more general combinators from Poly too
, module Text.ParserCombinators.Poly
) where
-import Char (isSpace)
+import Char (isSpace,toLower,isUpper,isDigit,isOctDigit,isHexDigit,digitToInt
+ ,ord,chr)
import List (intersperse)
+import Ratio
import Text.ParserCombinators.Poly
------------------------------------------------------------------------
@@ -37,7 +48,17 @@
-- is generated by the corresponding instance of @show@. To apply a parser
-- to some text, use @runParser@.
class Parse a where
+ -- | A straightforward parser for an item. (A minimal definition of
+ -- a class instance requires either |parse| or |parsePrec|.)
parse :: TextParser a
+ parse = parsePrec 0
+ -- | A straightforward parser for an item, given the precedence of
+ -- any surrounding expression. (Precedence determines whether
+ -- parentheses are mandatory or optional.)
+ parsePrec :: Int -> TextParser a
+ parsePrec _ = parens False parse
+ -- | Parsing a list of items by default accepts the [] and comma syntax,
+ -- except when the list is really a character string using \"\".
parseList :: TextParser [a] -- only to distinguish [] and ""
parseList = do { isWord "[]"; return [] }
`onFail`
@@ -47,21 +68,24 @@
`adjustErr` ("Expected a list, but\n"++)
-- | If there already exists a Read instance for a type, then we can make
--- a Parser for it, but with only poor error-reporting.
+-- a Parser for it, but with only poor error-reporting. The string argument
+-- is the expected type or value (for error-reporting only).
parseByRead :: Read a => String -> TextParser a
parseByRead name =
P (\s-> case reads s of
- [] -> (Left (False,"no parse, expected a "++name), s)
- [(a,s')] -> (Right a, s')
- _ -> (Left (False,"ambiguous parse, expected a "++name), s)
+ [] -> Failure s ("no parse, expected a "++name)
+ [(a,s')] -> Success s' a
+ _ -> Failure s ("ambiguous parse, expected a "++name)
)
-- | One lexical chunk (Haskell-style lexing).
word :: TextParser String
word = P (\s-> case lex s of
- [] -> (Left (False,"no input? (impossible)"), s)
- [("",s')] -> (Left (False,"no input?"), s')
- ((x,s'):_) -> (Right x, s') )
+ [] -> Failure s ("no input? (impossible)")
+ [("","")] -> Failure "" ("no input?")
+ [("",s')] -> Failure s ("lexing failed?")
+ ((x,s'):_) -> Success s' x
+ )
-- | Ensure that the next input word is the given string. (Note the input
-- is lexed as haskell, so wordbreaks at spaces, symbols, etc.)
@@ -74,6 +98,11 @@
optionalParens :: TextParser a -> TextParser a
optionalParens p = bracket (isWord "(") (isWord ")") p `onFail` p
+-- | Allow nested parens around an item (one set required when Bool is True).
+parens :: Bool -> TextParser a -> TextParser a
+parens True p = bracket (isWord "(") (isWord ")") (parens False p)
+parens False p = parens True p `onFail` p
+
-- | Deal with named field syntax. The string argument is the field name,
-- and the parser returns the value of the field.
field :: Parse a => String -> TextParser a
@@ -93,6 +122,23 @@
}
)
+{-
+-- | Parse an infix constructor.
+infixConstructor :: (Parse a, Parse b) =>
+ String -> Int -> (a->b->c) -> Int -> TextParser c
+infixConstructor name prec cons = \d->
+ parens (prec
+-- String -> Int -> (a->b->a) -> Int -> TextParser a
+--infixLeftAssoc name prec cons = \d->
+-- parens (prec TextParser a -> TextParser a
+parseSigned p = do '-' <- next; commit (fmap negate p)
+ `onFail`
+ do p
+
+parseInt :: (Integral a) => String ->
+ a -> (Char -> Bool) -> (Char -> Int) ->
+ a -> TextParser a
+parseInt base radix isDigit digitToInt n = go n
+ where go acc = do cs <- many1 (satisfy isDigit)
+ return (foldl1 (\n d-> n*radix+d)
+ (map (fromIntegral.digitToInt) cs))
+ `adjustErr` (++("\nexpected one or more "++base++" digits"))
+parseDec, parseOct, parseHex :: (Integral a) => a -> TextParser a
+parseDec = parseInt "decimal" 10 Char.isDigit Char.digitToInt
+parseOct = parseInt "octal" 8 Char.isOctDigit Char.digitToInt
+parseHex = parseInt "hex" 16 Char.isHexDigit Char.digitToInt
+
+parseFloat :: (RealFrac a) => TextParser a
+parseFloat = do ds <- many1 (satisfy isDigit)
+ frac <- (do '.' <- next
+ many (satisfy isDigit)
+ `adjustErrBad` (++"expected digit after .")
+ `onFail` return [] )
+ exp <- (do 'e' <- fmap toLower next
+ commit (do '+' <- next; parseDec 0
+ `onFail`
+ parseSigned (parseDec 0) ))
+ ( return . fromRational . (* (10^^(exp - length frac)))
+ . (%1) . (\ (Right x)->x) . fst
+ . runParser (parseDec 0) ) (ds++frac)
+ `onFail`
+ do w <- many (satisfy (not.isSpace))
+ case map toLower w of
+ "nan" -> return (0/0)
+ "infinity" -> return (1/0)
+ _ -> fail "expected a floating point number"
+
+parseLitChar :: TextParser Char
+parseLitChar = do '\'' <- next `adjustErr` (++"expected a literal char")
+ c <- next
+ char <- case c of
+ '\\' -> next >>= escape
+ '\'' -> fail "expected a literal char, got ''"
+ _ -> return c
+ '\'' <- next `adjustErrBad` (++"literal char has no final '")
+ return char
+ where
+ escape 'a' = return '\a'
+ escape 'b' = return '\b'
+ escape 'f' = return '\f'
+ escape 'n' = return '\n'
+ escape 'r' = return '\r'
+ escape 't' = return '\t'
+ escape 'v' = return '\v'
+ escape '\\' = return '\\'
+ escape '"' = return '"'
+ escape '\'' = return '\''
+ escape '^' = do ctrl <- next
+ if ctrl >= '@' && ctrl <= '_'
+ then return (chr (ord ctrl - ord '@'))
+ else fail ("literal char ctrl-escape malformed: \\^"
+ ++[ctrl])
+ escape d | isDigit d
+ = fmap chr $ parseDec (Char.digitToInt d)
+ escape 'o' = fmap chr $ parseOct 0
+ escape 'x' = fmap chr $ parseHex 0
+ escape c | isUpper c
+ = mnemonic c
+ escape c = fail ("unrecognised escape sequence in literal char: \\"++[c])
+
+ mnemonic 'A' = do 'C' <- next; 'K' <- next; return '\ACK'
+ `wrap` "'\\ACK'"
+ mnemonic 'B' = do 'E' <- next; 'L' <- next; return '\BEL'
+ `onFail`
+ do 'S' <- next; return '\BS'
+ `wrap` "'\\BEL' or '\\BS'"
+ mnemonic 'C' = do 'R' <- next; return '\CR'
+ `onFail`
+ do 'A' <- next; 'N' <- next; return '\CAN'
+ `wrap` "'\\CR' or '\\CAN'"
+ mnemonic 'D' = do 'E' <- next; 'L' <- next; return '\DEL'
+ `onFail`
+ do 'L' <- next; 'E' <- next; return '\DLE'
+ `onFail`
+ do 'C' <- next; ( do '1' <- next; return '\DC1'
+ `onFail`
+ do '2' <- next; return '\DC2'
+ `onFail`
+ do '3' <- next; return '\DC3'
+ `onFail`
+ do '4' <- next; return '\DC4' )
+ `wrap` "'\\DEL' or '\\DLE' or '\\DC[1..4]'"
+ mnemonic 'E' = do 'T' <- next; 'X' <- next; return '\ETX'
+ `onFail`
+ do 'O' <- next; 'T' <- next; return '\EOT'
+ `onFail`
+ do 'N' <- next; 'Q' <- next; return '\ENQ'
+ `onFail`
+ do 'T' <- next; 'B' <- next; return '\ETB'
+ `onFail`
+ do 'M' <- next; return '\EM'
+ `onFail`
+ do 'S' <- next; 'C' <- next; return '\ESC'
+ `wrap` "one of '\\ETX' '\\EOT' '\\ENQ' '\\ETB' '\\EM' or '\\ESC'"
+ mnemonic 'F' = do 'F' <- next; return '\FF'
+ `onFail`
+ do 'S' <- next; return '\FS'
+ `wrap` "'\\FF' or '\\FS'"
+ mnemonic 'G' = do 'S' <- next; return '\GS'
+ `wrap` "'\\GS'"
+ mnemonic 'H' = do 'T' <- next; return '\HT'
+ `wrap` "'\\HT'"
+ mnemonic 'L' = do 'F' <- next; return '\LF'
+ `wrap` "'\\LF'"
+ mnemonic 'N' = do 'U' <- next; 'L' <- next; return '\NUL'
+ `onFail`
+ do 'A' <- next; 'K' <- next; return '\NAK'
+ `wrap` "'\\NUL' or '\\NAK'"
+ mnemonic 'R' = do 'S' <- next; return '\RS'
+ `wrap` "'\\RS'"
+ mnemonic 'S' = do 'O' <- next; 'H' <- next; return '\SOH'
+ `onFail`
+ do 'O' <- next; return '\SO'
+ `onFail`
+ do 'T' <- next; 'X' <- next; return '\STX'
+ `onFail`
+ do 'I' <- next; return '\SI'
+ `onFail`
+ do 'Y' <- next; 'N' <- next; return '\SYN'
+ `onFail`
+ do 'U' <- next; 'B' <- next; return '\SUB'
+ `onFail`
+ do 'P' <- next; return '\SP'
+ `wrap` "'\\SOH' '\\SO' '\\STX' '\\SI' '\\SYN' '\\SUB' or '\\SP'"
+ mnemonic 'U' = do 'S' <- next; return '\US'
+ `wrap` "'\\US'"
+ mnemonic 'V' = do 'T' <- next; return '\VT'
+ `wrap` "'\\VT'"
+ wrap p s = p `onFail` fail ("expected literal char "++s)
+
-- Basic types
instance Parse Int where
- parse = parseByRead "Int"
+ -- parse = parseByRead "Int" -- convert from Integer, deals with minInt
+ parse = fmap fromInteger $
+ do many (satisfy isSpace); parseSigned (parseDec 0)
instance Parse Integer where
- parse = parseByRead "Integer"
+ -- parse = parseByRead "Integer"
+ parse = do many (satisfy isSpace); parseSigned (parseDec 0)
instance Parse Float where
- parse = parseByRead "Float"
+ -- parse = parseByRead "Float"
+ parse = do many (satisfy isSpace); parseSigned parseFloat
instance Parse Double where
- parse = parseByRead "Double"
+ -- parse = parseByRead "Double"
+ parse = do many (satisfy isSpace); parseSigned parseFloat
instance Parse Char where
- parse = parseByRead "Char"
+-- parse = parseByRead "Char"
+ parse = do many (satisfy isSpace); parseLitChar
+ -- parse = do { w <- word; if head w == '\'' then readLitChar (tail w)
+ -- else fail "expected a char" }
-- parseList = bracket (isWord "\"") (satisfy (=='"'))
-- (many (satisfy (/='"')))
-- not totally correct for strings...
@@ -132,13 +328,12 @@
-- Structural types
instance Parse () where
parse = P p
- where p [] = (Left (False,"no input: expected a ()"), [])
+ where p [] = Failure [] "no input: expected a ()"
p ('(':cs) = case dropWhile isSpace cs of
- (')':s) -> (Right (), s)
- _ -> (Left (False,"Expected ) after ("), cs)
+ (')':s) -> Success s ()
+ _ -> Failure cs "Expected ) after ("
p (c:cs) | isSpace c = p cs
- | otherwise = ( Left (False,"Expected a (), got "++show c)
- , (c:cs))
+ | otherwise = Failure (c:cs) ("Expected a (), got "++show c)
instance (Parse a, Parse b) => Parse (a,b) where
parse = do{ isWord "(" `adjustErr` ("Opening a 2-tuple\n"++)
@@ -159,17 +354,19 @@
; return (x,y,z) }
instance Parse a => Parse (Maybe a) where
- parse = do { isWord "Nothing"; return Nothing }
- `onFail`
- do { isWord "Just"
- ; fmap Just $ optionalParens parse
- `adjustErrBad` ("but within Just, "++)
- }
- `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2)
+ parsePrec p =
+ parens False (do { isWord "Nothing"; return Nothing })
+ `onFail`
+ parens (p>9) (do { isWord "Just"
+ ; fmap Just $ parsePrec 10
+ `adjustErrBad` ("but within Just, "++) })
+ `adjustErr` (("expected a Maybe (Just or Nothing)\n"++).indent 2)
instance (Parse a, Parse b) => Parse (Either a b) where
- parse = constructors [ ("Left", do { fmap Left $ optionalParens parse } )
- , ("Right", do { fmap Right $ optionalParens parse } )
+ parsePrec p =
+ parens (p>9) $
+ constructors [ ("Left", do { fmap Left $ parsePrec 10 } )
+ , ("Right", do { fmap Right $ parsePrec 10 } )
]
instance Parse a => Parse [a] where
diff --git a/src/Text/ParserCombinators/Poly.hs b/src/Text/ParserCombinators/Poly.hs
--- a/src/Text/ParserCombinators/Poly.hs
+++ b/src/Text/ParserCombinators/Poly.hs
@@ -1,247 +1,5 @@
module Text.ParserCombinators.Poly
- ( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
- , failBad -- :: String -> Parser t a
- , commit -- :: Parser t a -> Parser t a
-
- -- * Combinators:
- -- ** Primitives
- , next -- :: Parser t t
- , satisfy -- :: (t->Bool) -> Parser t t
- , apply -- :: Parser t (a->b) -> Parser t a -> Parser t b
- , discard -- :: Parser t a -> Parser t b -> Parser t a
- -- ** Error-handling
- , adjustErr -- :: Parser t a -> (String->String) -> Parser t a
- , adjustErrBad-- :: Parser t a -> (String->String) -> Parser t a
- , indent -- :: Int -> String -> String
- -- ** Choices
- , onFail -- :: Parser t a -> Parser t a -> Parser t a
- , oneOf -- :: Show t => [Parser t a] -> Parser t a
- , oneOf' -- :: [(String,Parser t a)] -> Parser t a
- , optional -- :: Parser t a -> Parser t (Maybe a)
- -- ** Sequences
- , exactly -- :: Int -> Parser t a -> Parser t [a]
- , many -- :: Parser t a -> Parser t [a]
- , many1 -- :: Parser t a -> Parser t [a]
- , sepBy -- :: Parser t a -> Parser t sep -> Parser t [a]
- , sepBy1 -- :: Parser t a -> Parser t sep -> Parser t [a]
- , bracketSep -- :: Parser t bra -> Parser t sep -> Parser t ket
- -- -> Parser t a -> Parser t [a]
- , bracket -- :: Parser t bra -> Parser t ket -> Parser t a
- -- -> Parser t a
- , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a]
- -- ** re-parsing
- , reparse -- :: [t] -> Parser t ()
+ ( module Text.ParserCombinators.Poly.Plain
) where
-
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyState
--- instead)
-newtype Parser t a = P ([t] -> (EitherE String a, [t]))
-
--- A return type like Either, that distinguishes not only between
--- right and wrong answers, but also has gradations of wrongness.
-type EitherE a b = Either (Bool,a) b
-
--- | Apply a parser to an input token sequence.
-runParser :: Parser t a -> [t] -> (Either String a, [t])
-runParser (P p) =
- (\ (e,ts)-> (case e of {Left (_,m)->Left m; Right m->Right m}, ts) )
- . p
-
-instance Functor (Parser t) where
- fmap f (P p) = P (\ts-> case p ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> (Right (f x), ts'))
-instance Monad (Parser t) where
- return x = P (\ts-> (Right x, ts))
- (P f) >>= g = P (\ts-> case f ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> let (P g') = g x in g' ts')
- fail e = P (\ts-> (Left (False,e), ts))
-
--- | When a simple fail is not strong enough, use failBad for emphasis.
--- An emphasised (severe) error can propagate out through choice operators.
-failBad :: String -> Parser t a
-failBad msg = P (\ts-> (Left (True,msg), ts))
-
--- | Commit is a way of raising the severity of any errors found within
--- its argument. Used in the middle of a parser definition, it means that
--- any operations prior to commitment fail softly, but after commitment,
--- they fail hard.
-commit :: Parser t a -> Parser t a
-commit (P p) = P (\ts-> case p ts of
- (Left (_,e), ts') -> (Left (True,e), ts')
- right -> right )
-
-
--- Combinators
-
--- | One token
-next :: Parser t t
-next = P (\ts-> case ts of
- [] -> (Left (False,"Ran out of input (EOF)"), [])
- (t:ts') -> (Right t, ts') )
-
--- | One token satifying a predicate
-satisfy :: (t->Bool) -> Parser t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-
-infixl 3 `apply`
--- | Apply a parsed function to a parsed value
-apply :: Parser t (a->b) -> Parser t a -> Parser t b
-pf `apply` px = do { f <- pf; x <- px; return (f x) }
-
-infixl 3 `discard`
--- | @x `discard` y@ parses both x and y, but discards the result of y
-discard :: Parser t a -> Parser t b -> Parser t a
-px `discard` py = do { x <- px; _ <- py; return x }
-
--- | @p `adjustErr` f@ applies the transformation @f@ to any error message
--- generated in @p@, having no effect if @p@ succeeds.
-adjustErr :: Parser t a -> (String->String) -> Parser t a
-(P p) `adjustErr` f = P (\ts-> case p ts of
- (Left (b,msg), ts') -> (Left (b,(f msg)), ts')
- right -> right )
-
--- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
--- severity of the error.
-adjustErrBad :: Parser t a -> (String->String) -> Parser t a
-p `adjustErrBad` f = commit (p `adjustErr` f)
-
-infixl 6 `onFail` -- not sure about precedence 6?
--- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
--- Can be chained together to give multiple attempts to parse something.
--- (Note that q could itself be a failing parser, e.g. to change the error
--- message from that defined in p to something different.)
--- However, a *severe* failure in p cannot be ignored.
-onFail :: Parser t a -> Parser t a -> Parser t a
-(P p) `onFail` (P q) = P (\ts-> case p ts of
- r@(Left (True,_), _) -> r
- (Left _, _) -> q ts
- right -> right )
-
--- | Parse the first alternative in the list that succeeds.
-oneOf :: [Parser t a] -> Parser t a
-oneOf [] = do { n <- next
- ; fail ("failed to parse any of the possible choices")
- }
---oneOf :: Show t => [Parser t a] -> Parser t a
---oneOf [] = do { n <- next
--- ; fail ("failed to parse any of the possible choices"
--- ++"\n next token is "++show n)
--- }
-oneOf (p:ps) = p `onFail` oneOf ps
-
--- | Parse the first alternative that succeeds, but if none succeed,
--- report only the severe errors, and if none of those, then report
--- all the soft errors.
-oneOf' :: [(String, Parser t a)] -> Parser t a
-oneOf' = accum []
- where accum errs [] =
- case filter isBad errs of
- [] -> fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- [(_,(_,e))] -> failBad e
- es -> failBad ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
- accum errs ((e,P p):ps) =
- P (\ts-> case p ts of
- (Left err,_) -> let (P p) = accum ((e,err):errs) ps
- in p ts
- right -> right )
- showErr (name,(_,err)) = name++":\n"++indent 2 err
- isBad (_,(b,_)) = b
-
--- | Helper for formatting error messages: indents all lines by a fixed amount.
-indent :: Int -> String -> String
-indent n = unlines . map (replicate n ' ' ++) . lines
-
--- | 'optional' indicates whether the parser succeeded through the Maybe type.
-optional :: Parser t a -> Parser t (Maybe a)
-optional p = fmap Just p `onFail` return Nothing
-
--- | 'exactly n p' parses a precise number of items, n, using the parser
--- p, in sequence.
-exactly :: Int -> Parser t a -> Parser t [a]
-exactly 0 p = return []
-exactly n p = do x <- p
- xs <- exactly (n-1) p
- return (x:xs)
-
--- | 'many p' parses a list of elements with individual parser p.
--- Cannot fail, since an empty list is a valid return value.
-many :: Parser t a -> Parser t [a]
-many p = many1 p `onFail` return []
-
--- | Parse a non-empty list of items.
-many1 :: Parser t a -> Parser t [a]
-many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
- ; xs <- many p
- ; return (x:xs)
- }
--- `adjustErr` ("When looking for a non-empty sequence:\n\t"++)
-
--- | Parse a list of items separated by discarded junk.
-sepBy :: Parser t a -> Parser t sep -> Parser t [a]
-sepBy p sep = do sepBy1 p sep `onFail` return []
-
--- | Parse a non-empty list of items separated by discarded junk.
-sepBy1 :: Parser t a -> Parser t sep -> Parser t [a]
-sepBy1 p sep = do { x <- p
- ; xs <- many (do {sep; p})
- ; return (x:xs)
- }
- `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++)
-
--- | Parse a list of items, discarding the start, end, and separator
--- items.
-bracketSep :: Parser t bra -> Parser t sep -> Parser t ket
- -> Parser t a -> Parser t [a]
-bracketSep open sep close p =
- do { open; close; return [] }
- `onFail`
- do { open `adjustErr` ("Missing opening bracket:\n\t"++)
- ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++)
- ; xs <- many (do {sep; p})
- ; close `adjustErrBad` ("When looking for closing bracket:\n\t"++)
- ; return (x:xs)
- }
-
--- | Parse a bracketed item, discarding the brackets.
-bracket :: Parser t bra -> Parser t ket -> Parser t a -> Parser t a
-bracket open close p = do
- do { open `adjustErr` ("Missing opening bracket:\n\t"++)
- ; x <- p
- ; close `adjustErrBad` ("Missing closing bracket:\n\t"++)
- ; return x
- }
-
--- | 'manyFinally e t' parses a possibly-empty sequence of e's,
--- terminated by a t. Any parse failures could be due either to
--- a badly-formed terminator or a badly-formed element, so raise
--- both possible errors.
-manyFinally :: Parser t a -> Parser t z -> Parser t [a]
-manyFinally p t =
- do { xs <- many p
- ; oneOf' [ ("sequence terminator", do { t; return () } )
- , ("item in a sequence", do { p; return () } )
- ]
- ; return xs
- }
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser t ()
-reparse ts = P (\inp-> (Right (), ts++inp))
-
-------------------------------------------------------------------------
+import Text.ParserCombinators.Poly.Plain
diff --git a/src/Text/ParserCombinators/Poly/Base.hs b/src/Text/ParserCombinators/Poly/Base.hs
--- a/src/Text/ParserCombinators/Poly/Base.hs
+++ b/src/Text/ParserCombinators/Poly/Base.hs
@@ -23,6 +23,11 @@
, manyFinally -- :: PolyParse p => p a -> p z -> p [a]
) where
+#ifdef __NHC__
+default (Integer,Double,[]) -- hack to avoid bizarre type defaulting error
+instance PolyParse []
+#endif
+
-- | The @PolyParse@ class is an abstraction over all the current
-- concrete representations of monadic parser combinators in this
-- package. The common feature is two-level error-handling.
diff --git a/src/Text/ParserCombinators/Poly/Lazy.hs b/src/Text/ParserCombinators/Poly/Lazy.hs
--- a/src/Text/ParserCombinators/Poly/Lazy.hs
+++ b/src/Text/ParserCombinators/Poly/Lazy.hs
@@ -1,22 +1,21 @@
module Text.ParserCombinators.Poly.Lazy
- ( -- * The Parser datatype.
- -- $parser
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser t a -> [t] -> (a, [t])
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
+ , Result(..) -- internal to the parser monad
+ , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
-- ** basic parsers
, next -- :: Parser t t
, satisfy -- :: (t->Bool) -> Parser t t
- -- one defn from 'Base' is overridden here, because it depends
- -- on the representation of the Lazy parser monad
- , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a]
- -- ** Re-parsing
+
+ -- ** re-parsing
, reparse -- :: [t] -> Parser t ()
-- * Re-export all more general combinators
, module Text.ParserCombinators.Poly.Base
) where
-import Text.ParserCombinators.Poly.Base hiding ( manyFinally )
+import Text.ParserCombinators.Poly.Base
+
#if __GLASGOW_HASKELL__
import Control.Exception hiding (bracket)
throwE :: String -> a
@@ -26,103 +25,97 @@
throwE msg = error msg
#endif
--- $parser
--- When applied, these parsers do not return explicit failure.
--- An exception is
--- raised instead. This allows partial results to be returned
--- before a full parse is complete.
--- One of the key ways to ensure that your parser is properly lazy,
--- is to parse the initial portion of text returning a function, then
--- use the @apply@ combinator to build the final value.
--- | The @Parser@ datatype is a fairly generic parsing monad with error
+-- | This @Parser@ datatype is a fairly generic parsing monad with error
-- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyStateLazy
--- instead.)
-newtype Parser t a = P ([t] -> (Either String a, [t]))
+-- String input. (If you require a running state, use module PolyState
+-- instead)
+newtype Parser t a = P ([t] -> Result [t] a)
--- | Apply a parser to an input token sequence. The parser cannot return
--- an error value explicitly, so errors raise an exception. Thus, results
--- can be partial (lazily constructed, but containing undefined).
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also has gradations of wrongness.
+-- This should only be used for writing very primitive
+-- parsers - really it is an internal detail of the library.
+data Result z a = Success z a
+ | Failure z String
+ | Committed (Result z a) -- still needed
+
+instance Functor (Result z) where
+ fmap f (Success z a) = Success z (f a)
+ fmap f (Failure z e) = Failure z e
+ fmap f (Committed r) = Committed (fmap f r)
+
+-- | Apply a parser to an input token sequence.
runParser :: Parser t a -> [t] -> (a, [t])
-runParser (P p) =
- (\ (e,ts)-> (case e of {Left m->throwE m; Right x->x}, ts) )
- . p
+runParser (P p) = fromResult . p
+ where
+ fromResult :: Result z a -> (a, z)
+ fromResult (Success z a) = (a, z)
+ fromResult (Failure z e) = throwE e
+ fromResult (Committed r) = fromResult r
instance Functor (Parser t) where
- fmap f (P p) = P (\ts-> case p ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> (Right (f x), ts'))
-instance Monad (Parser t) where
- return x = P (\ts-> (Right x, ts))
- (P f) >>= g = P (\ts-> case f ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> let (P g') = g x in g' ts')
- fail e = P (\ts-> (Left e, ts))
+ fmap f (P p) = P (fmap f . p)
+instance Monad (Parser t) where
+ return x = P (\ts-> Success ts x)
+ fail e = P (\ts-> Failure ts e)
+ (P f) >>= g = P (continue . f)
+ where
+ continue (Success ts x) = let (P g') = g x in g' ts
+ continue (Committed (Committed r)) = continue (Committed r)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure ts e) = Failure ts e
instance PolyParse (Parser t) where
- commit (P p) = P (\ts-> case p ts of
- (Left e, ts') -> (throwE e, ts')
- right -> right )
- (P p) `onFail` (P q) = P (\ts-> case p ts of
- (Left _, _) -> q ts
- right -> right )
- (P p) `adjustErr` f = P (\ts-> case p ts of
- (Left msg, ts') -> (Left (f msg), ts')
- right -> right )
- oneOf' ps = accum [] ps
+ commit (P p) = P (Committed . p)
+ (P p) `adjustErr` f = P (adjust . p)
+ where
+ adjust (Failure z e) = Failure z (f e)
+ adjust (Committed r) = Committed (adjust r)
+ adjust good = good
+
+ (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts)
+ where
+ continue ts (Failure z e) = q ts
+ -- continue _ (Committed r) = r -- no, remain Committed
+ continue _ r = r
+
+ oneOf' = accum []
where accum errs [] =
- case errs of
- [] -> failBad ("internal failure in parser (oneOf'):\n"
- ++indent 2 (show (map fst ps)))
- [(_,e)] -> fail e
- es -> fail ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
+ fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
accum errs ((e,P p):ps) =
P (\ts-> case p ts of
- (Left err,_) -> let (P p) = accum ((e,err):errs) ps
- in p ts
- right -> right )
+ Failure _ err ->
+ let (P p) = accum ((e,err):errs) ps
+ in p ts
+ r@(Success z a) -> r
+ r@(Committed _) -> r )
showErr (name,err) = name++":\n"++indent 2 err
- -- This version of "apply"
+
+ -- Apply a parsed function to a parsed value. This version
-- is strict in the result of the function parser, but
-- lazy in the result of the argument parser. (Argument laziness is
-- the distinctive feature over other implementations.)
- (P pf) `apply` (P px) = P (\ts->
- case pf ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right f, ts') -> let (x',ts'') = px ts'
- x = case x' of { Right x -> x
- ; Left e -> throwE e }
- in (Right (f x), ts'') )
+ (P pf) `apply` px = P (continue . pf)
+ where
+ continue (Success z f) = let (x,z') = runParser px z
+ in Success z' (f x)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure z e) = Failure z e
--- | Next token
+
+------------------------------------------------------------------------
+next :: Parser t t
next = P (\ts-> case ts of
- [] -> (Left "Ran out of input (EOF)", [])
- (t:ts') -> (Right t, ts') )
+ [] -> Failure [] "Ran out of input (EOF)"
+ (t:ts') -> Success ts' t )
--- | One token satifying a predicate
satisfy :: (t->Bool) -> Parser t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-
--- | 'manyFinally e t' parses a possibly-empty sequence of e's,
--- terminated by a t. Any parse failures could be due either to
--- a badly-formed terminator or a badly-formed element, so raise
--- both possible errors.
-manyFinally :: Parser t a -> Parser t z -> Parser t [a]
-manyFinally pp@(P p) pt@(P t) = P (\ts ->
- case p ts of
- (Left e, _) ->
- case t ts of
- (Right _, ts') -> (Right [], ts')
- (Left e, ts') -> (Left e, ts')
- (Right x, ts') ->
- let (tail,ts'') = runParser (manyFinally pp pt) ts'
- in (Right (x:tail), ts'') )
-
+satisfy pred = do { x <- next
+ ; if pred x then return x else fail "Parse.satisfy: failed"
+ }
------------------------------------------------------------------------
-- | Push some tokens back onto the front of the input stream and reparse.
@@ -131,6 +124,6 @@
-- expansion from the parse state, lex it, and then stuff the
-- lexed expansion back down into the parser.
reparse :: [t] -> Parser t ()
-reparse ts = P (\inp-> (Right (), ts++inp))
+reparse ts = P (\inp-> Success (ts++inp) ())
------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/Poly/NoLeak/Lazy.hs b/src/Text/ParserCombinators/Poly/NoLeak/Lazy.hs
deleted file mode 100644
--- a/src/Text/ParserCombinators/Poly/NoLeak/Lazy.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-module Text.ParserCombinators.Poly.NoLeak.Lazy
- ( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
- , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
- -- ** basic parsers
- , next -- :: Parser t t
- , satisfy -- :: (t->Bool) -> Parser t t
-
- -- ** re-parsing
- , reparse -- :: [t] -> Parser t ()
- -- * Re-export all more general combinators
- , module Text.ParserCombinators.Poly.Base
- ) where
-
-
-import Text.ParserCombinators.Poly.Base
-
-#if __GLASGOW_HASKELL__
-import Control.Exception hiding (bracket)
-throwE :: String -> a
-throwE msg = throw (ErrorCall msg)
-#else
-throwE :: String -> a
-throwE msg = error msg
-#endif
-
-
--- | This @Parser@ datatype is a fairly generic parsing monad with error
--- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyState
--- instead)
-newtype Parser t a = P ([t] -> Result [t] a)
-
--- A return type like Either, that distinguishes not only between
--- right and wrong answers, but also has gradations of wrongness.
-data Result z a = Success z a
- | Failure z String
- | Committed (Result z a) -- still needed
-
-instance Functor (Result z) where
- fmap f (Success z a) = Success z (f a)
- fmap f (Failure z e) = Failure z e
- fmap f (Committed r) = Committed (fmap f r)
-
--- | Apply a parser to an input token sequence.
-runParser :: Parser t a -> [t] -> (a, [t])
-runParser (P p) = fromResult . p
- where
- fromResult :: Result z a -> (a, z)
- fromResult (Success z a) = (a, z)
- fromResult (Failure z e) = throwE e
- fromResult (Committed r) = fromResult r
-
-instance Functor (Parser t) where
- fmap f (P p) = P (fmap f . p)
-
-instance Monad (Parser t) where
- return x = P (\ts-> Success ts x)
- fail e = P (\ts-> Failure ts e)
- (P f) >>= g = P (continue . f)
- where
- continue (Success ts x) = let (P g') = g x in g' ts
- continue (Committed (Committed r)) = continue (Committed r)
- continue (Committed r) = Committed (continue r)
- continue (Failure ts e) = Failure ts e
-
-instance PolyParse (Parser t) where
- commit (P p) = P (Committed . p)
- (P p) `adjustErr` f = P (adjust . p)
- where
- adjust (Failure z e) = Failure z (f e)
- adjust (Committed r) = Committed (adjust r)
- adjust good = good
-
- (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts)
- where
- continue ts (Failure z e) = q ts
- -- continue _ (Committed r) = r -- no, remain Committed
- continue _ r = r
-
- oneOf' = accum []
- where accum errs [] =
- fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- accum errs ((e,P p):ps) =
- P (\ts-> case p ts of
- Failure _ err ->
- let (P p) = accum ((e,err):errs) ps
- in p ts
- r@(Success z a) -> r
- r@(Committed _) -> r )
- showErr (name,err) = name++":\n"++indent 2 err
-
- -- Apply a parsed function to a parsed value. This version
- -- is strict in the result of the function parser, but
- -- lazy in the result of the argument parser. (Argument laziness is
- -- the distinctive feature over other implementations.)
- (P pf) `apply` px = P (continue . pf)
- where
- continue (Success z f) = let (x,z') = runParser px z
- in Success z' (f x)
- continue (Committed r) = Committed (continue r)
- continue (Failure z e) = Failure z e
-
-
-------------------------------------------------------------------------
-next :: Parser t t
-next = P (\ts-> case ts of
- [] -> Failure [] "Ran out of input (EOF)"
- (t:ts') -> Success ts' t )
-
-satisfy :: (t->Bool) -> Parser t t
-satisfy pred = do { x <- next
- ; if pred x then return x else fail "Parse.satisfy: failed"
- }
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser t ()
-reparse ts = P (\inp-> Success (ts++inp) ())
-
-------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/Poly/NoLeak/Plain.hs b/src/Text/ParserCombinators/Poly/NoLeak/Plain.hs
deleted file mode 100644
--- a/src/Text/ParserCombinators/Poly/NoLeak/Plain.hs
+++ /dev/null
@@ -1,105 +0,0 @@
-module Text.ParserCombinators.Poly.NoLeak.Plain
- ( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
- , runParser -- :: Parser t a -> [t] -> (Either String a, [t])
- -- ** basic parsers
- , next -- :: Parser t t
- , satisfy -- :: (t->Bool) -> Parser t t
-
- -- ** re-parsing
- , reparse -- :: [t] -> Parser t ()
- -- * Re-export all more general combinators
- , module Text.ParserCombinators.Poly.Base
- ) where
-
-
-import Text.ParserCombinators.Poly.Base
-
--- | This @Parser@ datatype is a fairly generic parsing monad with error
--- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyState
--- instead)
-newtype Parser t a = P ([t] -> Result [t] a)
-
--- A return type like Either, that distinguishes not only between
--- right and wrong answers, but also has commitment, so that a failure
--- cannot be undone.
-data Result z a = Success z a
- | Failure z String
- | Committed (Result z a)
-
-instance Functor (Result z) where
- fmap f (Success z a) = Success z (f a)
- fmap f (Failure z e) = Failure z e
- fmap f (Committed r) = Committed (fmap f r)
-
--- | Apply a parser to an input token sequence.
-runParser :: Parser t a -> [t] -> (Either String a, [t])
-runParser (P p) = resultToEither . p
- where
- resultToEither :: Result z a -> (Either String a, z)
- resultToEither (Success z a) = (Right a, z)
- resultToEither (Failure z e) = (Left e, z)
- resultToEither (Committed r) = resultToEither r
-
-instance Functor (Parser t) where
- fmap f (P p) = P (fmap f . p)
-
-instance Monad (Parser t) where
- return x = P (\ts-> Success ts x)
- fail e = P (\ts-> Failure ts e)
- (P f) >>= g = P (continue . f)
- where
- continue (Success ts x) = let (P g') = g x in g' ts
- continue (Committed (Committed r)) = continue (Committed r)
- continue (Committed r) = Committed (continue r)
- continue (Failure ts e) = Failure ts e
-
-instance PolyParse (Parser t) where
- commit (P p) = P (Committed . p)
- (P p) `adjustErr` f = P (adjust . p)
- where
- adjust (Failure z e) = Failure z (f e)
- adjust (Committed r) = Committed (adjust r)
- adjust good = good
-
- (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts)
- where
- continue ts (Failure z e) = q ts
- -- continue _ (Committed r) = r -- no, remain Committed
- continue _ r = r
-
- oneOf' = accum []
- where accum errs [] =
- fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- accum errs ((e,P p):ps) =
- P (\ts-> case p ts of
- Failure _ err ->
- let (P p) = accum ((e,err):errs) ps
- in p ts
- r@(Success z a) -> r
- r@(Committed _) -> r )
- showErr (name,err) = name++":\n"++indent 2 err
-
-------------------------------------------------------------------------
-next :: Parser t t
-next = P (\ts-> case ts of
- [] -> Failure [] "Ran out of input (EOF)"
- (t:ts') -> Success ts' t )
-
-satisfy :: (t->Bool) -> Parser t t
-satisfy pred = do { x <- next
- ; if pred x then return x else fail "Parse.satisfy: failed"
- }
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser t ()
-reparse ts = P (\inp-> Success (ts++inp) ())
-
-------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/Poly/NoLeak/State.hs b/src/Text/ParserCombinators/Poly/NoLeak/State.hs
deleted file mode 100644
--- a/src/Text/ParserCombinators/Poly/NoLeak/State.hs
+++ /dev/null
@@ -1,122 +0,0 @@
-module Text.ParserCombinators.Poly.NoLeak.State
- ( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
- , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
- -- ** basic parsers
- , next -- :: Parser s t t
- , satisfy -- :: (t->Bool) -> Parser s t t
- -- ** State-handling
- , stUpdate -- :: (s->s) -> Parser s t ()
- , stQuery -- :: (s->a) -> Parser s t a
- , stGet -- :: Parser s t s
- -- ** re-parsing
- , reparse -- :: [t] -> Parser s t ()
- -- * Re-export all more general combinators
- , module Text.ParserCombinators.Poly.Base
- ) where
-
-
-import Text.ParserCombinators.Poly.Base
-
--- | This @Parser@ datatype is a fairly generic parsing monad with error
--- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyState
--- instead)
-newtype Parser s t a = P (s -> [t] -> Result [t] s a)
-
--- A return type like Either, that distinguishes not only between
--- right and wrong answers, but also has gradations of wrongness.
-data Result z s a = Success z s a
- | Failure z s String
- | Committed (Result z s a)
-
-instance Functor (Result z s) where
- fmap f (Success z s a) = Success z s (f a)
- fmap f (Failure z s e) = Failure z s e
- fmap f (Committed r) = Committed (fmap f r)
-
--- | Apply a parser to an input token sequence.
-runParser :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
-runParser (P p) = \s-> resultToEither . p s
- where
- resultToEither :: Result z s a -> (Either String a, s, z)
- resultToEither (Success z s a) = (Right a, s, z)
- resultToEither (Failure z s e) = (Left e, s, z)
- resultToEither (Committed r) = resultToEither r
-
-instance Functor (Parser s t) where
- fmap f (P p) = P (\s-> fmap f . p s)
-
-instance Monad (Parser s t) where
- return x = P (\s ts-> Success ts s x)
- fail e = P (\s ts-> Failure ts s e)
- (P f) >>= g = P (\s-> continue . f s)
- where
- continue (Success ts s x) = let (P g') = g x in g' s ts
- continue (Committed (Committed r)) = continue (Committed r)
- continue (Committed r) = Committed (continue r)
- continue (Failure ts s e) = Failure ts s e
-
-instance PolyParse (Parser s t) where
- commit (P p) = P (\s-> Committed . p s)
- (P p) `adjustErr` f = P (\s-> adjust . p s)
- where
- adjust (Failure z s e) = Failure z s (f e)
- adjust (Committed r) = Committed (adjust r)
- adjust good = good
-
- (P p) `onFail` (P q) = P (\s ts-> continue s ts $ p s ts)
- where
- continue s ts (Failure _ _ _) = q s ts
- -- continue _ _ (Committed r) = r -- no, remain Committed
- continue _ _ r = r
-
- oneOf' = accum []
- where accum errs [] =
- fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- accum errs ((e,P p):ps) =
- P (\s ts-> case p s ts of
- Failure _ _ err ->
- let (P p) = accum ((e,err):errs) ps
- in p s ts
- r@(Success z _ a) -> r
- r@(Committed _) -> r )
- showErr (name,err) = name++":\n"++indent 2 err
-
-------------------------------------------------------------------------
-next :: Parser s t t
-next = P (\s ts-> case ts of
- [] -> Failure [] s "Ran out of input (EOF)"
- (t:ts') -> Success ts' s t )
-
-satisfy :: (t->Bool) -> Parser s t t
-satisfy pred = do { x <- next
- ; if pred x then return x else fail "Parse.satisfy: failed"
- }
-------------------------------------------------------------------------
--- State handling
-
--- | Update the internal state.
-stUpdate :: (s->s) -> Parser s t ()
-stUpdate f = P (\s ts-> Success ts (f s) ())
-
--- | Query the internal state.
-stQuery :: (s->a) -> Parser s t a
-stQuery f = P (\s ts-> Success ts s (f s))
-
--- | Deliver the entire internal state.
-stGet :: Parser s t s
-stGet = P (\s ts-> Success ts s s)
-
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser s t ()
-reparse ts = P (\s inp-> Success (ts++inp) s ())
-
-------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/Poly/NoLeak/StateLazy.hs b/src/Text/ParserCombinators/Poly/NoLeak/StateLazy.hs
deleted file mode 100644
--- a/src/Text/ParserCombinators/Poly/NoLeak/StateLazy.hs
+++ /dev/null
@@ -1,172 +0,0 @@
-module Text.ParserCombinators.Poly.NoLeak.StateLazy
- ( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
- , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
- -- ** basic parsers
- , next -- :: Parser s t t
- , satisfy -- :: (t->Bool) -> Parser s t t
- , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a]
- -- ** State-handling
- , stUpdate -- :: (s->s) -> Parser s t ()
- , stQuery -- :: (s->a) -> Parser s t a
- , stGet -- :: Parser s t s
- -- ** re-parsing
- , reparse -- :: [t] -> Parser s t ()
- -- * Re-export all more general combinators
- , module Text.ParserCombinators.Poly.Base
- ) where
-
-
-import Text.ParserCombinators.Poly.Base hiding (manyFinally)
-
-#if __GLASGOW_HASKELL__
-import Control.Exception hiding (bracket)
-throwE :: String -> a
-throwE msg = throw (ErrorCall msg)
-#else
-throwE :: String -> a
-throwE msg = error msg
-#endif
-
-
--- | This @Parser@ datatype is a fairly generic parsing monad with error
--- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyState
--- instead)
-newtype Parser s t a = P (s -> [t] -> Result [t] s a)
-
--- A return type like Either, that distinguishes not only between
--- right and wrong answers, but also has gradations of wrongness.
-data Result z s a = Success z s a
- | Failure z s String
- | Committed (Result z s a)
-
-instance Functor (Result z s) where
- fmap f (Success z s a) = Success z s (f a)
- fmap f (Failure z s e) = Failure z s e
- fmap f (Committed r) = Committed (fmap f r)
-
--- | Apply a parser to an input token sequence.
-runParser :: Parser s t a -> s -> [t] -> (a, s, [t])
-runParser (P p) = \s -> fromResult . p s
- where
- fromResult :: Result z s a -> (a, s, z)
- fromResult (Success z s a) = (a, s, z)
- fromResult (Failure z s e) = throwE e
- fromResult (Committed r) = fromResult r
-
-instance Functor (Parser s t) where
- fmap f (P p) = P (\s -> fmap f . p s)
-
-instance Monad (Parser s t) where
- return x = P (\s ts-> Success ts s x)
- fail e = P (\s ts-> Failure ts s e)
- (P f) >>= g = P (\s-> continue . f s)
- where
- continue (Success ts s x) = let (P g') = g x in g' s ts
- continue (Committed (Committed r)) = continue (Committed r)
- continue (Committed r) = Committed (continue r)
- continue (Failure ts s e) = Failure ts s e
-
-instance PolyParse (Parser s t) where
- commit (P p) = P (\s-> Committed . p s)
- (P p) `adjustErr` f = P (\s-> adjust . p s)
- where
- adjust (Failure z s e) = Failure z s (f e)
- adjust (Committed r) = Committed (adjust r)
- adjust good = good
-
- (P p) `onFail` (P q) = P (\s ts-> continue s ts $ p s ts)
- where
- continue s ts (Failure _ _ _) = q s ts
- -- continue _ _ (Committed r) = r -- no, remain Committed
- continue _ _ r = r
-
- oneOf' = accum []
- where accum errs [] =
- fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- accum errs ((e,P p):ps) =
- P (\s ts-> case p s ts of
- Failure _ _ err ->
- let (P p) = accum ((e,err):errs) ps
- in p s ts
- r@(Success z _ a) -> r
- r@(Committed _) -> r )
- showErr (name,err) = name++":\n"++indent 2 err
-
- -- Apply a parsed function to a parsed value. This version
- -- is strict in the result of the function parser, but
- -- lazy in the result of the argument parser. (Argument laziness is
- -- the distinctive feature over other implementations.)
- (P pf) `apply` px = P (\s-> continue . pf s)
- where
- continue (Success z s f) = let (x,s',z') = runParser px s z
- in Success z' s' (f x)
- continue (Failure z s e) = Failure z s e
- continue (Committed r) = Committed (continue r)
-
-manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
-{-
-manyFinally pp@(P p) pt@(P t) = P (\s ts -> item s ts (p s ts))
- where
- item _ _ (Success ts s x) = success ts s x
- item s ts (Failure _ _ e) = terminate (t s ts)
- item s ts (Committed r) = Committed (within r)
-
- success ts s x =
- let (tail,s',ts') = runParser (manyFinally pp pt) s ts
- in Success ts' s' (x:tail)
-
- terminate (Success ts s _) = Success ts s []
- terminate (Failure ts s e) = Failure ts s e
- terminate (Committed r) = Committed (terminate r)
-
- within (Success ts s x) = success ts s x
- within (Failure ts s e) = Failure ts s e
- within (Committed r) = within r
--}
-
-manyFinally p z =
- (do x <- p; return (x:) `apply` manyFinally p z)
- `onFail`
- (do z; return [])
- `onFail`
- oneOf' [ ("item in sequence", (do p; return []))
- , ("sequence terminator", (do z; return [])) ]
-
-------------------------------------------------------------------------
-next :: Parser s t t
-next = P (\s ts-> case ts of
- [] -> Failure [] s "Ran out of input (EOF)"
- (t:ts') -> Success ts' s t )
-
-satisfy :: (t->Bool) -> Parser s t t
-satisfy pred = do { x <- next
- ; if pred x then return x else fail "Parse.satisfy: failed"
- }
-------------------------------------------------------------------------
--- State handling
-
--- | Update the internal state.
-stUpdate :: (s->s) -> Parser s t ()
-stUpdate f = P (\s ts-> Success ts (f s) ())
-
--- | Query the internal state.
-stQuery :: (s->a) -> Parser s t a
-stQuery f = P (\s ts-> Success ts s (f s))
-
--- | Deliver the entire internal state.
-stGet :: Parser s t s
-stGet = P (\s ts-> Success ts s s)
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser s t ()
-reparse ts = P (\s inp-> Success (ts++inp) s ())
-
-------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/Poly/Plain.hs b/src/Text/ParserCombinators/Poly/Plain.hs
--- a/src/Text/ParserCombinators/Poly/Plain.hs
+++ b/src/Text/ParserCombinators/Poly/Plain.hs
@@ -1,6 +1,7 @@
module Text.ParserCombinators.Poly.Plain
( -- * The Parser datatype
Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
+ , Result(..) -- internal to the Parser Monad.
, runParser -- :: Parser t a -> [t] -> (Either String a, [t])
-- ** basic parsers
, next -- :: Parser t t
@@ -19,61 +20,75 @@
-- reporting. It can be used for arbitrary token types, not just
-- String input. (If you require a running state, use module PolyState
-- instead)
-newtype Parser t a = P ([t] -> (EitherE String a, [t]))
+newtype Parser t a = P ([t] -> Result [t] a)
--- A return type like Either, that distinguishes not only between
--- right and wrong answers, but also has gradations of wrongness.
-type EitherE a b = Either (Bool,a) b
+-- | A return type like Either, that distinguishes not only between
+-- right and wrong answers, but also has commitment, so that a failure
+-- cannot be undone. This should only be used for writing very primitive
+-- parsers - really it is an internal detail of the library.
+data Result z a = Success z a
+ | Failure z String
+ | Committed (Result z a)
+instance Functor (Result z) where
+ fmap f (Success z a) = Success z (f a)
+ fmap f (Failure z e) = Failure z e
+ fmap f (Committed r) = Committed (fmap f r)
+
-- | Apply a parser to an input token sequence.
runParser :: Parser t a -> [t] -> (Either String a, [t])
-runParser (P p) =
- (\ (e,ts)-> (case e of {Left (_,m)->Left m; Right m->Right m}, ts) )
- . p
+runParser (P p) = resultToEither . p
+ where
+ resultToEither :: Result z a -> (Either String a, z)
+ resultToEither (Success z a) = (Right a, z)
+ resultToEither (Failure z e) = (Left e, z)
+ resultToEither (Committed r) = resultToEither r
instance Functor (Parser t) where
- fmap f (P p) = P (\ts-> case p ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> (Right (f x), ts'))
+ fmap f (P p) = P (fmap f . p)
+
instance Monad (Parser t) where
- return x = P (\ts-> (Right x, ts))
- (P f) >>= g = P (\ts-> case f ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> let (P g') = g x in g' ts')
- fail e = P (\ts-> (Left (False,e), ts))
+ return x = P (\ts-> Success ts x)
+ fail e = P (\ts-> Failure ts e)
+ (P f) >>= g = P (continue . f)
+ where
+ continue (Success ts x) = let (P g') = g x in g' ts
+ continue (Committed (Committed r)) = continue (Committed r)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure ts e) = Failure ts e
instance PolyParse (Parser t) where
- commit (P p) = P (\ts-> case p ts of
- (Left (_,e), ts') -> (Left (True,e), ts')
- right -> right )
- (P p) `adjustErr` f = P (\ts-> case p ts of
- (Left (b,msg), ts') -> (Left (b,(f msg)), ts')
- right -> right )
- (P p) `onFail` (P q) = P (\ts-> case p ts of
- r@(Left (True,_), _) -> r
- (Left _, _) -> q ts
- right -> right )
+ commit (P p) = P (Committed . p)
+ (P p) `adjustErr` f = P (adjust . p)
+ where
+ adjust (Failure z e) = Failure z (f e)
+ adjust (Committed r) = Committed (adjust r)
+ adjust good = good
+
+ (P p) `onFail` (P q) = P (\ts-> continue ts $ p ts)
+ where
+ continue ts (Failure z e) = q ts
+ -- continue _ (Committed r) = r -- no, remain Committed
+ continue _ r = r
+
oneOf' = accum []
where accum errs [] =
- case filter isBad errs of
- [] -> fail ("failed to parse any of the possible choices:\n"
+ fail ("failed to parse any of the possible choices:\n"
++indent 2 (concatMap showErr (reverse errs)))
- [(_,(_,e))] -> failBad e
- es -> failBad ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
accum errs ((e,P p):ps) =
P (\ts-> case p ts of
- (Left err,_) -> let (P p) = accum ((e,err):errs) ps
- in p ts
- right -> right )
- showErr (name,(_,err)) = name++":\n"++indent 2 err
- isBad (_,(b,_)) = b
+ Failure _ err ->
+ let (P p) = accum ((e,err):errs) ps
+ in p ts
+ r@(Success z a) -> r
+ r@(Committed _) -> r )
+ showErr (name,err) = name++":\n"++indent 2 err
------------------------------------------------------------------------
next :: Parser t t
next = P (\ts-> case ts of
- [] -> (Left (False,"Ran out of input (EOF)"), [])
- (t:ts') -> (Right t, ts') )
+ [] -> Failure [] "Ran out of input (EOF)"
+ (t:ts') -> Success ts' t )
satisfy :: (t->Bool) -> Parser t t
satisfy pred = do { x <- next
@@ -87,6 +102,6 @@
-- expansion from the parse state, lex it, and then stuff the
-- lexed expansion back down into the parser.
reparse :: [t] -> Parser t ()
-reparse ts = P (\inp-> (Right (), ts++inp))
+reparse ts = P (\inp-> Success (ts++inp) ())
------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/Poly/State.hs b/src/Text/ParserCombinators/Poly/State.hs
--- a/src/Text/ParserCombinators/Poly/State.hs
+++ b/src/Text/ParserCombinators/Poly/State.hs
@@ -1,102 +1,118 @@
module Text.ParserCombinators.Poly.State
( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad
+ Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
+ , Result(..) -- internal to the parser monad
, runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
-- ** basic parsers
, next -- :: Parser s t t
, satisfy -- :: (t->Bool) -> Parser s t t
-- ** State-handling
- , stUpdate -- :: (s->s) -> Parser s t ()
- , stQuery -- :: (s->a) -> Parser s t a
- , stGet -- :: Parser s t s
- -- ** Re-parsing
+ , stUpdate -- :: (s->s) -> Parser s t ()
+ , stQuery -- :: (s->a) -> Parser s t a
+ , stGet -- :: Parser s t s
+ -- ** re-parsing
, reparse -- :: [t] -> Parser s t ()
- -- * Re-export all more general combinators.
+ -- * Re-export all more general combinators
, module Text.ParserCombinators.Poly.Base
) where
+
import Text.ParserCombinators.Poly.Base
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting and a running state. It can be used for arbitrary token
--- types, not just String input.
-newtype Parser s t a = P (s -> [t] -> (EitherE String a, s, [t]))
+-- | This @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyState
+-- instead)
+newtype Parser s t a = P (s -> [t] -> Result [t] s a)
-- | A return type like Either, that distinguishes not only between
--- right and wrong answers, but also had gradations of wrongness.
-type EitherE a b = Either (Bool,a) b
+-- right and wrong answers, but also has gradations of wrongness.
+-- This should only be used for writing very primitive
+-- parsers - really it is an internal detail of the library.
+data Result z s a = Success z s a
+ | Failure z s String
+ | Committed (Result z s a)
--- | Apply a parser to an initial state and input token sequence.
+instance Functor (Result z s) where
+ fmap f (Success z s a) = Success z s (f a)
+ fmap f (Failure z s e) = Failure z s e
+ fmap f (Committed r) = Committed (fmap f r)
+
+-- | Apply a parser to an input token sequence.
runParser :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
-runParser (P p) s =
- (\ (e,s,ts)-> (case e of Left (_,m)->Left m; Right m->Right m
- ,s,ts))
- . p s
+runParser (P p) = \s-> resultToEither . p s
+ where
+ resultToEither :: Result z s a -> (Either String a, s, z)
+ resultToEither (Success z s a) = (Right a, s, z)
+ resultToEither (Failure z s e) = (Left e, s, z)
+ resultToEither (Committed r) = resultToEither r
instance Functor (Parser s t) where
- fmap f (P p) = P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> (Right (f x), s', ts'))
+ fmap f (P p) = P (\s-> fmap f . p s)
+
instance Monad (Parser s t) where
- return x = P (\s ts-> (Right x, s, ts))
- (P f) >>= g = P (\s ts-> case f s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> let (P g') = g x
- in g' s' ts')
- fail msg = P (\s ts-> (Left (False,msg), s, ts))
+ return x = P (\s ts-> Success ts s x)
+ fail e = P (\s ts-> Failure ts s e)
+ (P f) >>= g = P (\s-> continue . f s)
+ where
+ continue (Success ts s x) = let (P g') = g x in g' s ts
+ continue (Committed (Committed r)) = continue (Committed r)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure ts s e) = Failure ts s e
instance PolyParse (Parser s t) where
- commit (P p) = P (\s ts-> case p s ts of
- (Left (_,e), s', ts') -> (Left (True,e), s', ts')
- right -> right )
- (P p) `onFail` (P q) = P (\s ts-> case p s ts of
- r@(Left (True,_), _, _) -> r
- (Left _, _, _) -> q s ts
- right -> right )
- (P p) `adjustErr` f = P (\s ts-> case p s ts of
- (Left (b,msg), s', ts')
- -> (Left (b,(f msg)), s, ts')
- right -> right )
+ commit (P p) = P (\s-> Committed . p s)
+ (P p) `adjustErr` f = P (\s-> adjust . p s)
+ where
+ adjust (Failure z s e) = Failure z s (f e)
+ adjust (Committed r) = Committed (adjust r)
+ adjust good = good
+
+ (P p) `onFail` (P q) = P (\s ts-> continue s ts $ p s ts)
+ where
+ continue s ts (Failure _ _ _) = q s ts
+ -- continue _ _ (Committed r) = r -- no, remain Committed
+ continue _ _ r = r
+
oneOf' = accum []
where accum errs [] =
- case filter isBad errs of
- [] -> fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- [(_,(_,e))] -> failBad e
- es -> failBad ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
+ fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
accum errs ((e,P p):ps) =
- P (\u ts-> case p u ts of
- (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
- in p u ts
- right -> right )
- showErr (name,(_,err)) = name++":\n"++indent 2 err
- isBad (_,(b,_)) = b
+ P (\s ts-> case p s ts of
+ Failure _ _ err ->
+ let (P p) = accum ((e,err):errs) ps
+ in p s ts
+ r@(Success z _ a) -> r
+ r@(Committed _) -> r )
+ showErr (name,err) = name++":\n"++indent 2 err
------------------------------------------------------------------------
+next :: Parser s t t
next = P (\s ts-> case ts of
- [] -> (Left (False,"Ran out of input (EOF)"), s, [])
- (t:ts') -> (Right t, s, ts') )
+ [] -> Failure [] s "Ran out of input (EOF)"
+ (t:ts') -> Success ts' s t )
satisfy :: (t->Bool) -> Parser s t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
+satisfy pred = do { x <- next
+ ; if pred x then return x else fail "Parse.satisfy: failed"
+ }
------------------------------------------------------------------------
-- State handling
-- | Update the internal state.
stUpdate :: (s->s) -> Parser s t ()
-stUpdate f = P (\s ts-> (Right (), f s, ts))
+stUpdate f = P (\s ts-> Success ts (f s) ())
-- | Query the internal state.
stQuery :: (s->a) -> Parser s t a
-stQuery f = P (\s ts-> (Right (f s), s, ts))
+stQuery f = P (\s ts-> Success ts s (f s))
-- | Deliver the entire internal state.
stGet :: Parser s t s
-stGet = P (\s ts-> (Right s, s, ts))
+stGet = P (\s ts-> Success ts s s)
+
------------------------------------------------------------------------
-- | Push some tokens back onto the front of the input stream and reparse.
-- This is useful e.g. for recursively expanding macros. When the
@@ -104,6 +120,6 @@
-- expansion from the parse state, lex it, and then stuff the
-- lexed expansion back down into the parser.
reparse :: [t] -> Parser s t ()
-reparse ts = P (\s inp-> (Right (), s, ts++inp))
+reparse ts = P (\s inp-> Success (ts++inp) s ())
------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/Poly/StateLazy.hs b/src/Text/ParserCombinators/Poly/StateLazy.hs
--- a/src/Text/ParserCombinators/Poly/StateLazy.hs
+++ b/src/Text/ParserCombinators/Poly/StateLazy.hs
@@ -1,24 +1,25 @@
module Text.ParserCombinators.Poly.StateLazy
- ( -- * The Parser datatype.
- -- $parser
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser s t a -> s -> [t] -> (a, s, [t])
- -- * Combinators:
- -- ** Primitives
+ ( -- * The Parser datatype
+ Parser(P) -- datatype, instance of: Functor, Monad, PolyParse
+ , Result(..) -- internal to the parser monad
+ , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
+ -- ** basic parsers
, next -- :: Parser s t t
, satisfy -- :: (t->Bool) -> Parser s t t
+ , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a]
-- ** State-handling
- , stUpdate -- :: (s->s) -> Parser s t ()
- , stQuery -- :: (s->a) -> Parser s t a
- , stGet -- :: Parser s t s
- -- ** Re-parsing
+ , stUpdate -- :: (s->s) -> Parser s t ()
+ , stQuery -- :: (s->a) -> Parser s t a
+ , stGet -- :: Parser s t s
+ -- ** re-parsing
, reparse -- :: [t] -> Parser s t ()
-- * Re-export all more general combinators
, module Text.ParserCombinators.Poly.Base
) where
-import Text.ParserCombinators.Poly.Base
+import Text.ParserCombinators.Poly.Base hiding (manyFinally)
+
#if __GLASGOW_HASKELL__
import Control.Exception hiding (bracket)
throwE :: String -> a
@@ -28,105 +29,139 @@
throwE msg = error msg
#endif
--- $parser
--- Parsers do not return explicit failure. An exception is raised
--- instead. This allows partial results to be returned before a
--- full parse is complete.
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting and a running state. It can be used for arbitrary token
--- types, not just String input.
-newtype Parser s t a = P (s -> [t] -> (Either String a, s, [t]))
+-- | This @Parser@ datatype is a fairly generic parsing monad with error
+-- reporting. It can be used for arbitrary token types, not just
+-- String input. (If you require a running state, use module PolyState
+-- instead)
+newtype Parser s t a = P (s -> [t] -> Result [t] s a)
-- | A return type like Either, that distinguishes not only between
--- right and wrong answers, but also had gradations of wrongness.
--- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!!
-type EitherE a b = Either (Bool,a) b
+-- right and wrong answers, but also has gradations of wrongness.
+-- This should only be used for writing very primitive
+-- parsers - really it is an internal detail of the library.
+data Result z s a = Success z s a
+ | Failure z s String
+ | Committed (Result z s a)
--- | Apply a parser to an initial state and input token sequence.
--- The parser cannot return an error value explicitly, so errors
--- raise an exception. Thus, results can be partial (lazily constructed,
--- but containing undefined).
+instance Functor (Result z s) where
+ fmap f (Success z s a) = Success z s (f a)
+ fmap f (Failure z s e) = Failure z s e
+ fmap f (Committed r) = Committed (fmap f r)
+
+-- | Apply a parser to an input token sequence.
runParser :: Parser s t a -> s -> [t] -> (a, s, [t])
-runParser (P p) s =
- (\ (e,s,ts)-> (case e of {Left m->throwE m; Right x->x}, s, ts))
- . p s
+runParser (P p) = \s -> fromResult . p s
+ where
+ fromResult :: Result z s a -> (a, s, z)
+ fromResult (Success z s a) = (a, s, z)
+ fromResult (Failure z s e) = throwE e
+ fromResult (Committed r) = fromResult r
instance Functor (Parser s t) where
- fmap f (P p) = P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> (Right (f x), s', ts'))
+ fmap f (P p) = P (\s -> fmap f . p s)
+
instance Monad (Parser s t) where
- return x = P (\s ts-> (Right x, s, ts))
- (P f) >>= g = P (\s ts-> case f s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> let (P g') = g x
- in g' s' ts')
- fail msg = P (\s ts-> (Left msg, s, ts))
+ return x = P (\s ts-> Success ts s x)
+ fail e = P (\s ts-> Failure ts s e)
+ (P f) >>= g = P (\s-> continue . f s)
+ where
+ continue (Success ts s x) = let (P g') = g x in g' s ts
+ continue (Committed (Committed r)) = continue (Committed r)
+ continue (Committed r) = Committed (continue r)
+ continue (Failure ts s e) = Failure ts s e
instance PolyParse (Parser s t) where
- commit (P p) = P (\s ts-> case p s ts of
- (Left e, s', ts') -> (throwE e, s', ts')
- right -> right )
- (P p) `adjustErr` f =
- P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (Left (f msg), s, ts')
- right -> right )
- (P p) `onFail` (P q) = P (\s ts-> case p s ts of
- (Left _, _, _) -> q s ts
- right -> right )
- oneOf' ps = accum [] ps
+ commit (P p) = P (\s-> Committed . p s)
+ (P p) `adjustErr` f = P (\s-> adjust . p s)
+ where
+ adjust (Failure z s e) = Failure z s (f e)
+ adjust (Committed r) = Committed (adjust r)
+ adjust good = good
+
+ (P p) `onFail` (P q) = P (\s ts-> continue s ts $ p s ts)
+ where
+ continue s ts (Failure _ _ _) = q s ts
+ -- continue _ _ (Committed r) = r -- no, remain Committed
+ continue _ _ r = r
+
+ oneOf' = accum []
where accum errs [] =
- case errs of
- [] -> failBad ("internal failure in parser (oneOf'):\n"
- ++indent 2 (show (map fst ps)))
- [(_,e)] -> fail e
- es -> fail ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
+ fail ("failed to parse any of the possible choices:\n"
+ ++indent 2 (concatMap showErr (reverse errs)))
accum errs ((e,P p):ps) =
- P (\u ts-> case p u ts of
- (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
- in p u ts
- right -> right )
+ P (\s ts-> case p s ts of
+ Failure _ _ err ->
+ let (P p) = accum ((e,err):errs) ps
+ in p s ts
+ r@(Success z _ a) -> r
+ r@(Committed _) -> r )
showErr (name,err) = name++":\n"++indent 2 err
- (P pf) `apply` (P px) = P (\s ts->
- case pf s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right f, s', ts') -> let (x',s'',ts'') = px s' ts'
- x = case x' of { Right x -> x
- ; Left e -> throwE e }
- in (Right (f x), s'', ts'') )
+ -- Apply a parsed function to a parsed value. This version
+ -- is strict in the result of the function parser, but
+ -- lazy in the result of the argument parser. (Argument laziness is
+ -- the distinctive feature over other implementations.)
+ (P pf) `apply` px = P (\s-> continue . pf s)
+ where
+ continue (Success z s f) = let (x,s',z') = runParser px s z
+ in Success z' s' (f x)
+ continue (Failure z s e) = Failure z s e
+ continue (Committed r) = Committed (continue r)
--- Combinators
+manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
+{-
+manyFinally pp@(P p) pt@(P t) = P (\s ts -> item s ts (p s ts))
+ where
+ item _ _ (Success ts s x) = success ts s x
+ item s ts (Failure _ _ e) = terminate (t s ts)
+ item s ts (Committed r) = Committed (within r)
--- | Yield one token.
+ success ts s x =
+ let (tail,s',ts') = runParser (manyFinally pp pt) s ts
+ in Success ts' s' (x:tail)
+
+ terminate (Success ts s _) = Success ts s []
+ terminate (Failure ts s e) = Failure ts s e
+ terminate (Committed r) = Committed (terminate r)
+
+ within (Success ts s x) = success ts s x
+ within (Failure ts s e) = Failure ts s e
+ within (Committed r) = within r
+-}
+
+manyFinally p z =
+ (do x <- p; return (x:) `apply` manyFinally p z)
+ `onFail`
+ (do z; return [])
+ `onFail`
+ oneOf' [ ("item in sequence", (do p; return []))
+ , ("sequence terminator", (do z; return [])) ]
+
+------------------------------------------------------------------------
next :: Parser s t t
next = P (\s ts-> case ts of
- [] -> (Left "Ran out of input (EOF)", s, [])
- (t:ts') -> (Right t, s, ts') )
+ [] -> Failure [] s "Ran out of input (EOF)"
+ (t:ts') -> Success ts' s t )
--- | Yield one token if it satisfies a predicate.
satisfy :: (t->Bool) -> Parser s t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-
-
+satisfy pred = do { x <- next
+ ; if pred x then return x else fail "Parse.satisfy: failed"
+ }
------------------------------------------------------------------------
-- State handling
-- | Update the internal state.
stUpdate :: (s->s) -> Parser s t ()
-stUpdate f = P (\s ts-> (Right (), f s, ts))
+stUpdate f = P (\s ts-> Success ts (f s) ())
-- | Query the internal state.
stQuery :: (s->a) -> Parser s t a
-stQuery f = P (\s ts-> (Right (f s), s, ts))
+stQuery f = P (\s ts-> Success ts s (f s))
-- | Deliver the entire internal state.
stGet :: Parser s t s
-stGet = P (\s ts-> (Right s, s, ts))
+stGet = P (\s ts-> Success ts s s)
------------------------------------------------------------------------
-- | Push some tokens back onto the front of the input stream and reparse.
@@ -135,6 +170,6 @@
-- expansion from the parse state, lex it, and then stuff the
-- lexed expansion back down into the parser.
reparse :: [t] -> Parser s t ()
-reparse ts = P (\s inp-> (Right (), s, ts++inp))
+reparse ts = P (\s inp-> Success (ts++inp) s ())
------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/PolyLazy.hs b/src/Text/ParserCombinators/PolyLazy.hs
deleted file mode 100644
--- a/src/Text/ParserCombinators/PolyLazy.hs
+++ /dev/null
@@ -1,275 +0,0 @@
-module Text.ParserCombinators.PolyLazy
- ( -- * The Parser datatype.
- -- $parser
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser t a -> [t] -> (a, [t])
- , failBad -- :: String -> Parser t a
- , commit -- :: Parser t a -> Parser t a
- -- * Combinators:
- -- ** Primitives
- , next -- :: Parser t t
- , satisfy -- :: (t->Bool) -> Parser t t
- , apply -- :: Parser t (a->b) -> Parser t a -> Parser t b
- , discard -- :: Parser t a -> Parser t b -> Parser t a
- -- ** Error-handling
- , adjustErr -- :: Parser t a -> (String->String) -> Parser t a
- , adjustErrBad-- :: Parser t a -> (String->String) -> Parser t a
- , indent -- :: Int -> String -> String
- -- ** Choices
- , onFail -- :: Parser t a -> Parser t a -> Parser t a
- , oneOf -- :: Show t => [Parser t a] -> Parser t a
- , oneOf' -- :: [(String,Parser t a)] -> Parser t a
- , optional -- :: Parser t a -> Parser t (Maybe a)
- -- ** Sequences
- , exactly -- :: Int -> Parser t a -> Parser t [a]
- , many -- :: Parser t a -> Parser t [a]
- , many1 -- :: Parser t a -> Parser t [a]
- , sepBy -- :: Parser t a -> Parser t sep -> Parser t [a]
- , sepBy1 -- :: Parser t a -> Parser t sep -> Parser t [a]
- , bracketSep -- :: Parser t bra -> Parser t sep -> Parser t ket
- -- -> Parser t a -> Parser t [a]
- , bracket -- :: Parser t bra -> Parser t ket -> Parser t a
- -- -> Parser t a
- , manyFinally -- :: Parser t a -> Parser t z -> Parser t [a]
- -- ** Re-parsing
- , reparse -- :: [t] -> Parser t ()
- ) where
-
-#if __GLASGOW_HASKELL__
-import Control.Exception hiding (bracket)
-throwE :: String -> a
-throwE msg = throw (ErrorCall msg)
-#else
-throwE :: String -> a
-throwE msg = error msg
-#endif
-
--- $parser
--- When applied, these parsers do not return explicit failure.
--- An exception is
--- raised instead. This allows partial results to be returned
--- before a full parse is complete.
--- One of the key ways to ensure that your parser is properly lazy,
--- is to parse the initial portion of text returning a function, then
--- use the @apply@ combinator to build the final value.
-
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting. It can be used for arbitrary token types, not just
--- String input. (If you require a running state, use module PolyStateLazy
--- instead.)
-newtype Parser t a = P ([t] -> (Either String a, [t]))
-
--- A return type like Either, that distinguishes not only between
--- right and wrong answers, but also had gradations of wrongness.
--- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!!!
-type EitherE a b = Either (Bool,a) b
-
--- | Apply a parser to an input token sequence. The parser cannot return
--- an error value explicitly, so errors raise an exception. Thus, results
--- can be partial (lazily constructed, but containing undefined).
-runParser :: Parser t a -> [t] -> (a, [t])
-runParser (P p) =
- (\ (e,ts)-> (case e of {Left m->throwE m; Right x->x}, ts) )
- . p
-
-instance Functor (Parser t) where
- fmap f (P p) = P (\ts-> case p ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> (Right (f x), ts'))
-instance Monad (Parser t) where
- return x = P (\ts-> (Right x, ts))
- (P f) >>= g = P (\ts-> case f ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right x, ts') -> let (P g') = g x in g' ts')
- fail e = P (\ts-> (Left e, ts))
-
--- | Simple failure can be corrected, but when a simple fail is not strong
--- enough, use failBad for emphasis. It guarantees parsing will
--- terminate with an exception.
-
-failBad :: String -> Parser t a
-failBad msg = P (\ts-> (throwE msg, ts))
-
--- | Commit is a way of raising the severity of any errors found within
--- its argument. Used in the middle of a parser definition, it means that
--- any operations prior to commitment fail softly, but after commitment,
--- they fail hard.
-commit :: Parser t a -> Parser t a
-commit (P p) = P (\ts-> case p ts of
- (Left e, ts') -> (throwE e, ts')
- right -> right )
-
-
--- Combinators
-
--- | One token
-next :: Parser t t
-next = P (\ts-> case ts of
- [] -> (Left "Ran out of input (EOF)", [])
- (t:ts') -> (Right t, ts') )
-
--- | One token satifying a predicate
-satisfy :: (t->Bool) -> Parser t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-
-infixl 3 `apply`
--- | Apply a parsed function to a parsed value
-apply :: Parser t (a->b) -> Parser t a -> Parser t b
---pf `apply` px = do { f <- pf; x <- px; return (f x) }
--- Needs to be lazier! Must not force the argument value too early.
-(P pf) `apply` (P px) = P (\ts->
- case pf ts of
- (Left msg, ts') -> (Left msg, ts')
- (Right f, ts') -> let (x',ts'') = px ts'
- x = case x' of { Right x -> x; Left e -> throwE e }
- in (Right (f x), ts'') )
-
-infixl 3 `discard`
--- | @x `discard` y@ parses both x and y, but discards the result of y
-discard :: Parser t a -> Parser t b -> Parser t a
---px `discard` py = do { x <- px; _ <- py; return x }
--- Needs to be lazier! Do not force the discarded portion too early.
-px `discard` py = do { x <- px; return (\_-> x) `apply` py }
-
--- | @p `adjustErr` f@ applies the transformation @f@ to any error message
--- generated in @p@, having no effect if @p@ succeeds.
-adjustErr :: Parser t a -> (String->String) -> Parser t a
-(P p) `adjustErr` f = P (\ts-> case p ts of
- (Left msg, ts') -> (Left (f msg), ts')
- right -> right )
-
--- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
--- severity of the error.
-adjustErrBad :: Parser t a -> (String->String) -> Parser t a
-p `adjustErrBad` f = commit (p `adjustErr` f)
-
-infixl 6 `onFail` -- not sure about precedence 6?
--- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
--- Can be chained together to give multiple attempts to parse something.
--- (Note that q could itself be a failing parser, e.g. to change the error
--- message from that defined in p to something different.)
--- However, a *severe* failure in p cannot be ignored.
-onFail :: Parser t a -> Parser t a -> Parser t a
-(P p) `onFail` (P q) = P (\ts-> case p ts of
- (Left _, _) -> q ts
- right -> right )
-
--- | Parse the first alternative in the list that succeeds.
-oneOf :: [Parser t a] -> Parser t a
-oneOf [] = do { n <- next
- ; fail ("failed to parse any of the possible choices")
- }
---oneOf :: Show t => [Parser t a] -> Parser t a
---oneOf [] = do { n <- next
--- ; fail ("failed to parse any of the possible choices"
--- ++"\n next token is "++show n)
--- }
-oneOf (p:ps) = p `onFail` oneOf ps
-
--- | Parse the first alternative that succeeds, but if none succeed,
--- report only the severe errors, and if none of those, then report
--- all the soft errors.
-oneOf' :: [(String, Parser t a)] -> Parser t a
-oneOf' ps = accum [] ps
- where accum errs [] =
- case errs of
- [] -> failBad ("internal failure in parser (oneOf'):\n"
- ++indent 2 (show (map fst ps)))
- [(_,e)] -> fail e
- es -> fail ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
- accum errs ((e,P p):ps) =
- P (\ts-> case p ts of
- (Left err,_) -> let (P p) = accum ((e,err):errs) ps
- in p ts
- right -> right )
- showErr (name,err) = name++":\n"++indent 2 err
-
--- | Helper for formatting error messages: indents all lines by a fixed amount.
-indent :: Int -> String -> String
-indent n = unlines . map (replicate n ' ' ++) . lines
-
--- | 'optional' indicates whether the parser succeeded through the Maybe type.
-optional :: Parser t a -> Parser t (Maybe a)
-optional p = fmap Just p `onFail` return Nothing
-
--- | 'exactly n p' parses a precise number of items, n, using the parser
--- p, in sequence.
-exactly :: Int -> Parser t a -> Parser t [a]
-exactly 0 p = return []
-exactly n p = return (:) `apply` p `apply` exactly (n-1) p
-
--- | 'many p' parses a list of elements with individual parser p.
--- Cannot fail, since an empty list is a valid return value.
-many :: Parser t a -> Parser t [a]
-many p = many1 p `onFail` return []
- where many1 p = do { x <- p
- ; return (x:) `apply` many p
- }
-
--- | Parse a non-empty list of items.
-many1 :: Parser t a -> Parser t [a]
-many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
- ; return (x:) `apply` many p
- }
--- `adjustErr` ("When looking for a non-empty sequence:\n\t"++)
-
--- | Parse a list of items separated by discarded junk.
-sepBy :: Parser t a -> Parser t sep -> Parser t [a]
-sepBy p sep = do sepBy1 p sep `onFail` return []
-
--- | Parse a non-empty list of items separated by discarded junk.
-sepBy1 :: Parser t a -> Parser t sep -> Parser t [a]
-sepBy1 p sep = do { x <- p
- ; return (x:) `apply` many (do {sep; p})
- }
- `adjustErr` ("When looking for a non-empty sequence with separators:\n\t"++)
-
--- | Parse a list of items, discarding the start, end, and separator
--- items.
-bracketSep :: Parser t bra -> Parser t sep -> Parser t ket
- -> Parser t a -> Parser t [a]
-bracketSep open sep close p =
- do { open; close; return [] }
- `onFail`
- do { open `adjustErr` ("Missing opening bracket:\n\t"++)
- ; x <- p `adjustErr` ("After first bracket in a group:\n\t"++)
- ; return (x:) `apply`
- manyFinally (do {sep; p})
- (close `adjustErrBad` ("When looking for closing bracket:\n\t"++))
- }
-
--- | Parse a bracketed item, discarding the brackets.
-bracket :: Parser t bra -> Parser t ket -> Parser t a -> Parser t a
-bracket open close p = do
- do { open `adjustErr` ("Missing opening bracket:\n\t"++)
- ; p `discard` (close `adjustErrBad` ("Missing closing bracket:\n\t"++))
- }
-
--- | 'manyFinally e t' parses a possibly-empty sequence of e's,
--- terminated by a t. Any parse failures could be due either to
--- a badly-formed terminator or a badly-formed element, so raise
--- both possible errors.
-manyFinally :: Parser t a -> Parser t z -> Parser t [a]
-manyFinally pp@(P p) pt@(P t) = P (\ts ->
- case p ts of
- (Left e, _) ->
- case t ts of
- (Right _, ts') -> (Right [], ts')
- (Left e, ts') -> (Left e, ts')
- (Right x, ts') ->
- let (tail,ts'') = runParser (manyFinally pp pt) ts'
- in (Right (x:tail), ts'') )
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser t ()
-reparse ts = P (\inp-> (Right (), ts++inp))
-
-------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/PolyState.hs b/src/Text/ParserCombinators/PolyState.hs
deleted file mode 100644
--- a/src/Text/ParserCombinators/PolyState.hs
+++ /dev/null
@@ -1,257 +0,0 @@
-module Text.ParserCombinators.PolyState
- ( -- * The Parser datatype
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
- , failBad -- :: String -> Parser s t a
- , commit -- :: Parser s t a -> Parser s t a
- -- * Combinators:
- -- ** Primitives
- , next -- :: Parser s t t
- , satisfy -- :: (t->Bool) -> Parser s t t
- , apply -- :: Parser t (a->b) -> Parser s t a -> Parser s t b
- , discard -- :: Parser s t a -> Parser s t b -> Parser s t a
- -- ** Error-handling
- , adjustErr -- :: Parser s t a -> (String->String) -> Parser s t a
- , adjustErrBad-- :: Parser s t a -> (String->String) -> Parser s t a
- , indent -- :: Int -> String -> String
- -- ** Choices
- , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a
- , oneOf -- :: [Parser s t a] -> Parser s t a
- , oneOf' -- :: [(String, Parser s t a)] -> Parser s t a
- -- ** Sequences
- , exactly -- :: Int -> Parser s t a -> Parser s t [a]
- , many -- :: Parser s t a -> Parser s t [a]
- , many1 -- :: Parser s t a -> Parser s t [a]
- , sepBy -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
- , sepBy1 -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
- , bracketSep -- :: Parser s t bra -> Parser s t sep -> Parser s t ket
- -- -> Parser s t a -> Parser s t [a]
- , bracket -- :: Parser s t bra -> Parser s t ket -> Parser s t a
- -- -> Parser s t a
- , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a]
- -- ** State-handling
- , stUpdate -- :: (s->s) -> Parser s t ()
- , stQuery -- :: (s->a) -> Parser s t a
- , stGet -- :: Parser s t s
- -- ** Re-parsing
- , reparse -- :: [t] -> Parser s t ()
- ) where
-
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting and a running state. It can be used for arbitrary token
--- types, not just String input.
-newtype Parser s t a = P (s -> [t] -> (EitherE String a, s, [t]))
-
--- | A return type like Either, that distinguishes not only between
--- right and wrong answers, but also had gradations of wrongness.
-type EitherE a b = Either (Bool,a) b
-
--- | Apply a parser to an initial state and input token sequence.
-runParser :: Parser s t a -> s -> [t] -> (Either String a, s, [t])
-runParser (P p) s =
- (\ (e,s,ts)-> (case e of Left (_,m)->Left m; Right m->Right m
- ,s,ts))
- . p s
-
-instance Functor (Parser s t) where
- fmap f (P p) = P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> (Right (f x), s', ts'))
-instance Monad (Parser s t) where
- return x = P (\s ts-> (Right x, s, ts))
- (P f) >>= g = P (\s ts-> case f s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> let (P g') = g x
- in g' s' ts')
- fail msg = P (\s ts-> (Left (False,msg), s, ts))
-
--- | When a simple fail is not strong enough, use failBad for emphasis.
--- An emphasised (severe) error can propagate out through choice operators.
-failBad :: String -> Parser s t a
-failBad msg = P (\s ts-> (Left (True,msg), s, ts))
-
--- | Commit is a way of raising the severity of any errors found within
--- its argument. Used in the middle of a parser definition, it means that
--- any operations prior to commitment fail softly, but after commitment,
--- they fail hard.
-commit :: Parser s t a -> Parser s t a
-commit (P p) = P (\s ts-> case p s ts of
- (Left (_,e), s', ts') -> (Left (True,e), s', ts')
- right -> right )
-
--- Combinators
-
--- | One token
-next :: Parser s t t
-next = P (\s ts-> case ts of
- [] -> (Left (False,"Ran out of input (EOF)"), s, [])
- (t:ts') -> (Right t, s, ts') )
-
--- | One token satifying a predicate
-satisfy :: (t->Bool) -> Parser s t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-
-infixl 3 `apply`
--- | Apply a parsed function to a parsed value
-apply :: Parser s t (a->b) -> Parser s t a -> Parser s t b
-pf `apply` px = do { f <- pf; x <- px; return (f x) }
-
-infixl 3 `discard`
--- | @x `discard` y@ parses both x and y, but discards the result of y
-discard :: Parser s t a -> Parser s t b -> Parser s t a
-px `discard` py = do { x <- px; _ <- py; return x }
-
--- | @p `adjustErr` f@ applies the transformation @f@ to any error message
--- generated in @p@, having no effect if @p@ succeeds.
-adjustErr :: Parser s t a -> (String->String) -> Parser s t a
-(P p) `adjustErr` f =
- P (\s ts-> case p s ts of
- (Left (b,msg), s', ts') -> (Left (b,(f msg)), s, ts')
- right -> right )
-
--- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
--- severity of the error.
-adjustErrBad :: Parser s t a -> (String->String) -> Parser s t a
--- p `adjustErrBad` f = commit (p `adjustErr` f)
-(P p) `adjustErrBad` f =
- P (\s ts-> case p s ts of
- (Left (_,msg), s', ts') -> (Left (True,(f msg)), s, ts')
- right -> right )
-
-infixl 6 `onFail` -- not sure about precedence 6?
--- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
--- Can be chained together to give multiple attempts to parse something.
--- (Note that q could itself be a failing parser, e.g. to change the error
--- message from that defined in p to something different.)
--- However, a severe failure in p cannot be ignored.
-onFail :: Parser s t a -> Parser s t a -> Parser s t a
-(P p) `onFail` (P q) = P (\s ts-> case p s ts of
- r@(Left (True,_), _, _) -> r
- (Left _, _, _) -> q s ts
- right -> right )
-
--- | Parse the first alternative in the list that succeeds.
-oneOf :: [Parser s t a] -> Parser s t a
-oneOf [] = fail ("Failed to parse any of the possible choices")
-oneOf (p:ps) = p `onFail` oneOf ps
-
--- | Parse the first alternative that succeeds, but if none succeed,
--- report only the severe errors, and if none of those, then report
--- all the soft errors.
-oneOf' :: [(String, Parser s t a)] -> Parser s t a
-oneOf' = accum []
- where accum errs [] =
- case filter isBad errs of
- [] -> fail ("failed to parse any of the possible choices:\n"
- ++indent 2 (concatMap showErr (reverse errs)))
- [(_,(_,e))] -> failBad e
- es -> failBad ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
- accum errs ((e,P p):ps) =
- P (\u ts-> case p u ts of
- (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
- in p u ts
- right -> right )
- showErr (name,(_,err)) = name++":\n"++indent 2 err
- isBad (_,(b,_)) = b
-
--- | Helper for formatting error messages: indents all lines by a fixed amount.
-indent :: Int -> String -> String
-indent n = unlines . map (replicate n ' ' ++) . lines
-
--- | 'exactly n p' parses a precise number of items, n, using the parser
--- p, in sequence.
-exactly :: Int -> Parser s t a -> Parser s t [a]
-exactly 0 p = return []
-exactly n p = do x <- p
- xs <- exactly (n-1) p
- return (x:xs)
-
--- | 'many p' parses a list of elements with individual parser p.
--- Cannot fail, since an empty list is a valid return value.
-many :: Parser s t a -> Parser s t [a]
-many p = many1 p `onFail` return []
-
--- | Parse a non-empty list of items.
-many1 :: Parser s t a -> Parser s t [a]
-many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
- ; xs <- many p
- ; return (x:xs)
- }
--- `adjustErr` ("When looking for a non-empty sequence:\n"++)
-
--- | Parse a list of items separated by discarded junk.
-sepBy :: Parser s t a -> Parser s t sep -> Parser s t [a]
-sepBy p sep = do sepBy1 p sep `onFail` return []
-
--- | Parse a non-empty list of items separated by discarded junk.
-sepBy1 :: Parser s t a -> Parser s t sep -> Parser s t [a]
-sepBy1 p sep = do { x <- p
- ; xs <- many (do {sep; p})
- ; return (x:xs)
- }
- `adjustErr` ("When looking for a non-empty sequence with separators:\n"++)
-
--- | Parse a list of items, discarding the start, end, and separator
--- items.
-bracketSep :: Parser s t bra -> Parser s t sep -> Parser s t ket
- -> Parser s t a -> Parser s t [a]
-bracketSep open sep close p =
- do { open; close; return [] }
- `onFail`
- do { open `adjustErr` ("Missing opening bracket:\n"++)
- ; x <- p `adjustErr` ("After first bracket in a group:\n"++)
- ; xs <- many (do {sep; p})
- ; close `adjustErrBad` ("When looking for closing bracket:\n"++)
- ; return (x:xs)
- }
-
--- | Parse a bracketed item, discarding the brackets.
-bracket :: Parser s t bra -> Parser s t ket -> Parser s t a -> Parser s t a
-bracket open close p = do
- do { open `adjustErr` ("Missing opening bracket:\n"++)
- ; x <- p
- ; close `adjustErrBad` ("Missing closing bracket:\n"++)
- ; return x
- }
-
--- | 'manyFinally e t' parses a possibly-empty sequence of e's,
--- terminated by a t. Any parse failures could be due either to
--- a badly-formed terminator or a badly-formed element, so raise
--- both possible errors.
-manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
-manyFinally p t =
- do { xs <- many p
- ; oneOf' [ ("sequence terminator", do { t; return () } )
- , ("item in a sequence", do { p; return () } )
- ]
- ; return xs
- }
-
-------------------------------------------------------------------------
--- State handling
-
--- | Update the internal state.
-stUpdate :: (s->s) -> Parser s t ()
-stUpdate f = P (\s ts-> (Right (), f s, ts))
-
--- | Query the internal state.
-stQuery :: (s->a) -> Parser s t a
-stQuery f = P (\s ts-> (Right (f s), s, ts))
-
--- | Deliver the entire internal state.
-stGet :: Parser s t s
-stGet = P (\s ts-> (Right s, s, ts))
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser s t ()
-reparse ts = P (\s inp-> (Right (), s, ts++inp))
-
-------------------------------------------------------------------------
diff --git a/src/Text/ParserCombinators/PolyStateLazy.hs b/src/Text/ParserCombinators/PolyStateLazy.hs
deleted file mode 100644
--- a/src/Text/ParserCombinators/PolyStateLazy.hs
+++ /dev/null
@@ -1,290 +0,0 @@
-module Text.ParserCombinators.PolyStateLazy
- ( -- * The Parser datatype.
- -- $parser
- Parser(P) -- datatype, instance of: Functor, Monad
- , runParser -- :: Parser s t a -> s -> [t] -> (a, s, [t])
- , failBad -- :: String -> Parser s t a
- , commit -- :: Parser s t a -> Parser s t a
- -- * Combinators:
- -- ** Primitives
- , next -- :: Parser s t t
- , satisfy -- :: (t->Bool) -> Parser s t t
- , apply -- :: Parser t (a->b) -> Parser s t a -> Parser s t b
- , discard -- :: Parser s t a -> Parser s t b -> Parser s t a
- -- ** Error-handling
- , adjustErr -- :: Parser s t a -> (String->String) -> Parser s t a
- , adjustErrBad-- :: Parser s t a -> (String->String) -> Parser s t a
- , indent -- :: Int -> String -> String
- -- ** Choices
- , onFail -- :: Parser s t a -> Parser s t a -> Parser s t a
- , oneOf -- :: [Parser s t a] -> Parser s t a
- , oneOf' -- :: [(String, Parser s t a)] -> Parser s t a
- , optional -- :: Parser s t a -> Parser s t (Maybe a)
- -- ** Sequences
- , exactly -- :: Int -> Parser s t a -> Parser s t [a]
- , many -- :: Parser s t a -> Parser s t [a]
- , many1 -- :: Parser s t a -> Parser s t [a]
- , sepBy -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
- , sepBy1 -- :: Parser s t a -> Parser s t sep -> Parser s t [a]
- , bracketSep -- :: Parser s t bra -> Parser s t sep -> Parser s t ket
- -- -> Parser s t a -> Parser s t [a]
- , bracket -- :: Parser s t bra -> Parser s t ket -> Parser s t a
- -- -> Parser s t a
- , manyFinally -- :: Parser s t a -> Parser s t z -> Parser s t [a]
- -- ** State-handling
- , stUpdate -- :: (s->s) -> Parser s t ()
- , stQuery -- :: (s->a) -> Parser s t a
- , stGet -- :: Parser s t s
- -- ** Re-parsing
- , reparse -- :: [t] -> Parser s t ()
- ) where
-
-#if __GLASGOW_HASKELL__
-import Control.Exception hiding (bracket)
-throwE :: String -> a
-throwE msg = throw (ErrorCall msg)
-#else
-throwE :: String -> a
-throwE msg = error msg
-#endif
-
--- $parser
--- Parsers do not return explicit failure. An exception is raised
--- instead. This allows partial results to be returned before a
--- full parse is complete.
-
--- | The @Parser@ datatype is a fairly generic parsing monad with error
--- reporting and a running state. It can be used for arbitrary token
--- types, not just String input.
-newtype Parser s t a = P (s -> [t] -> (Either String a, s, [t]))
-
--- | A return type like Either, that distinguishes not only between
--- right and wrong answers, but also had gradations of wrongness.
--- Not used in this library. !!!!!!!!!!!!!!!!!!!!!!!!!!
-type EitherE a b = Either (Bool,a) b
-
--- | Apply a parser to an initial state and input token sequence.
--- The parser cannot return an error value explicitly, so errors
--- raise an exception. Thus, results can be partial (lazily constructed,
--- but containing undefined).
-runParser :: Parser s t a -> s -> [t] -> (a, s, [t])
-runParser (P p) s =
- (\ (e,s,ts)-> (case e of {Left m->throwE m; Right x->x}, s, ts))
- . p s
-
-instance Functor (Parser s t) where
- fmap f (P p) = P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> (Right (f x), s', ts'))
-instance Monad (Parser s t) where
- return x = P (\s ts-> (Right x, s, ts))
- (P f) >>= g = P (\s ts-> case f s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right x, s', ts') -> let (P g') = g x
- in g' s' ts')
- fail msg = P (\s ts-> (Left msg, s, ts))
-
--- | Simple failure can be corrected, but when a simple fail is not strong
--- enough, use failBad for emphasis. It guarantees parsing will terminate
--- with an exception.
-failBad :: String -> Parser s t a
-failBad msg = P (\s ts-> (throwE msg, s, ts))
-
--- | Commit is a way of raising the severity of any errors found within
--- its argument. Used in the middle of a parser definition, it means that
--- any operations prior to commitment fail softly, but after commitment,
--- they fail hard.
-commit :: Parser s t a -> Parser s t a
-commit (P p) = P (\s ts-> case p s ts of
- (Left e, s', ts') -> (throwE e, s', ts')
- right -> right )
-
--- Combinators
-
--- | One token
-next :: Parser s t t
-next = P (\s ts-> case ts of
- [] -> (Left "Ran out of input (EOF)", s, [])
- (t:ts') -> (Right t, s, ts') )
-
--- | One token satifying a predicate
-satisfy :: (t->Bool) -> Parser s t t
-satisfy p = do{ x <- next
- ; if p x then return x else fail "Parse.satisfy: failed"
- }
-
-infixl 3 `apply`
--- | Apply a parsed function to a parsed value
-apply :: Parser s t (a->b) -> Parser s t a -> Parser s t b
---pf `apply` px = do { f <- pf; x <- px; return (f x) }
--- Needs to be lazier! Must not force the argument value too early.
-(P pf) `apply` (P px) = P (\s ts->
- case pf s ts of
- (Left msg, s', ts') -> (Left msg, s', ts')
- (Right f, s', ts') -> let (x',s'',ts'') = px s' ts'
- x = case x' of
- Right x -> x
- Left e -> throwE e
- in (Right (f x), s'', ts''))
-
-infixl 3 `discard`
--- | @x `discard` y@ parses both x and y, but discards the result of y
-discard :: Parser s t a -> Parser s t b -> Parser s t a
-px `discard` py = do { x <- px; _ <- py; return x }
-
--- | @p `adjustErr` f@ applies the transformation @f@ to any error message
--- generated in @p@, having no effect if @p@ succeeds.
-adjustErr :: Parser s t a -> (String->String) -> Parser s t a
-(P p) `adjustErr` f =
- P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (Left (f msg), s, ts')
- right -> right )
-
--- | @adjustErrBad@ is just like @adjustErr@ except it also raises the
--- severity of the error.
-adjustErrBad :: Parser s t a -> (String->String) -> Parser s t a
--- p `adjustErrBad` f = commit (p `adjustErr` f)
-(P p) `adjustErrBad` f =
- P (\s ts-> case p s ts of
- (Left msg, s', ts') -> (throwE (f msg), s, ts')
- right -> right )
-
-infixl 6 `onFail` -- not sure about precedence 6?
--- | @p `onFail` q@ means parse p unless p fails in which case parse q instead.
--- Can be chained together to give multiple attempts to parse something.
--- (Note that q could itself be a failing parser, e.g. to change the error
--- message from that defined in p to something different.)
--- However, a *severe* failure in p cannot be ignored.
-onFail :: Parser s t a -> Parser s t a -> Parser s t a
-(P p) `onFail` (P q) = P (\s ts-> case p s ts of
- (Left _, _, _) -> q s ts
- right -> right )
-
--- | Parse the first alternative in the list that succeeds.
-oneOf :: [Parser s t a] -> Parser s t a
-oneOf [] = fail ("Failed to parse any of the possible choices")
-oneOf (p:ps) = p `onFail` oneOf ps
-
--- | Parse the first alternative that succeeds, but if none succeed,
--- report only the severe errors, and if none of those, then report
--- all the soft errors.
-oneOf' :: [(String, Parser s t a)] -> Parser s t a
-oneOf' ps = accum [] ps
- where accum errs [] =
- case errs of
- [] -> failBad ("internal failure in parser (oneOf'):\n"
- ++indent 2 (show (map fst ps)))
- [(_,e)] -> fail e
- es -> fail ("one of the following failures occurred:\n"
- ++indent 2 (concatMap showErr (reverse es)))
- accum errs ((e,P p):ps) =
- P (\u ts-> case p u ts of
- (Left err,_,_) -> let (P p) = accum ((e,err):errs) ps
- in p u ts
- right -> right )
- showErr (name,err) = name++":\n"++indent 2 err
-
--- | Helper for formatting error messages: indents all lines by a fixed amount.
-indent :: Int -> String -> String
-indent n = unlines . map (replicate n ' ' ++) . lines
-
--- | 'optional' indicates whether the parser succeeded through the Maybe type.
-optional :: Parser s t a -> Parser s t (Maybe a)
-optional p = fmap Just p `onFail` return Nothing
-
--- | 'exactly n p' parses a precise number of items, n, using the parser
--- p, in sequence.
-exactly :: Int -> Parser s t a -> Parser s t [a]
-exactly 0 p = return []
-exactly n p = do x <- p
- xs <- exactly (n-1) p
- return (x:xs)
-
--- | 'many p' parses a list of elements with individual parser p.
--- Cannot fail, since an empty list is a valid return value.
-many :: Parser s t a -> Parser s t [a]
-many p = many1 p `onFail` return []
-
--- | Parse a non-empty list of items.
-many1 :: Parser s t a -> Parser s t [a]
-many1 p = do { x <- p `adjustErr` (("In a sequence:\n"++). indent 2)
- ; xs <- many p
- ; return (x:xs)
- }
--- `adjustErr` ("When looking for a non-empty sequence:\n"++)
-
--- | Parse a list of items separated by discarded junk.
-sepBy :: Parser s t a -> Parser s t sep -> Parser s t [a]
-sepBy p sep = do sepBy1 p sep `onFail` return []
-
--- | Parse a non-empty list of items separated by discarded junk.
-sepBy1 :: Parser s t a -> Parser s t sep -> Parser s t [a]
-sepBy1 p sep = do { x <- p
- ; xs <- many (do {sep; p})
- ; return (x:xs)
- }
- `adjustErr` ("When looking for a non-empty sequence with separators:\n"++)
-
--- | Parse a list of items, discarding the start, end, and separator
--- items.
-bracketSep :: Parser s t bra -> Parser s t sep -> Parser s t ket
- -> Parser s t a -> Parser s t [a]
-bracketSep open sep close p =
- do { open; close; return [] }
- `onFail`
- do { open `adjustErr` ("Missing opening bracket:\n"++)
- ; x <- p `adjustErr` ("After first bracket in a group:\n"++)
- ; xs <- many (do {sep; p})
- ; close `adjustErrBad` ("When looking for closing bracket:\n"++)
- ; return (x:xs)
- }
-
--- | Parse a bracketed item, discarding the brackets.
-bracket :: Parser s t bra -> Parser s t ket -> Parser s t a -> Parser s t a
-bracket open close p = do
- do { open `adjustErr` ("Missing opening bracket:\n"++)
- ; x <- p
- ; close `adjustErrBad` ("Missing closing bracket:\n"++)
- ; return x
- }
-
--- | 'manyFinally e t' parses a possibly-empty sequence of e's,
--- terminated by a t. Any parse failures could be due either to
--- a badly-formed terminator or a badly-formed element, so raise
--- both possible errors.
-manyFinally :: Parser s t a -> Parser s t z -> Parser s t [a]
-manyFinally pp@(P p) pt@(P t) = P (\s ts ->
- case p s ts of
- (Left e, _, _) ->
- case t s ts of
- (Right _, s', ts') -> (Right [], s', ts')
- (Left e, s', ts') -> (Left e, s', ts')
- (Right x, s', ts') ->
- let (tail,s'',ts'') = runParser (manyFinally pp pt) s' ts'
- in (Right (x:tail), s'', ts'') )
-
-------------------------------------------------------------------------
--- State handling
-
--- | Update the internal state.
-stUpdate :: (s->s) -> Parser s t ()
-stUpdate f = P (\s ts-> (Right (), f s, ts))
-
--- | Query the internal state.
-stQuery :: (s->a) -> Parser s t a
-stQuery f = P (\s ts-> (Right (f s), s, ts))
-
--- | Deliver the entire internal state.
-stGet :: Parser s t s
-stGet = P (\s ts-> (Right s, s, ts))
-
-------------------------------------------------------------------------
--- | Push some tokens back onto the front of the input stream and reparse.
--- This is useful e.g. for recursively expanding macros. When the
--- user-parser recognises a macro use, it can lookup the macro
--- expansion from the parse state, lex it, and then stuff the
--- lexed expansion back down into the parser.
-reparse :: [t] -> Parser s t ()
-reparse ts = P (\s inp-> (Right (), s, ts++inp))
-
-------------------------------------------------------------------------
|