All
-
- A LIBRARY OF MONADIC PARSER COMBINATORS
-
- 29th July 1996
-
- Graham Hutton Erik Meijer
- University of Nottingham University of Utrecht
Stability
Stable
Maintainer
Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
Description
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.
-
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 a State Transformer 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.
-
Synopsis
newtypeParser 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.
-
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 e a -> s -> [Either e t] -> Either e [(a, s, [Either e t])]
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.
-
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)
-
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.
-
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.
-
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.
-
'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.
-
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.
-
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.)
-
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).
-
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.
-
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.
-
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.
-
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.
-
'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.
-
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.
-
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.
-
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.
-
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.
-
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.
-
'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.
-
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.
-
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.
-
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).
-
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.
-
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.
-
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.
-
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.
-
'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.
-
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.
-
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.
-
-----------------------------------------------------------------------------
--- |
--- 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/HaXml/src/Text/ParserCombinators/HuttonMeijerWallace.html b/docs/HaXml/src/Text/ParserCombinators/HuttonMeijerWallace.html
deleted file mode 100644
--- a/docs/HaXml/src/Text/ParserCombinators/HuttonMeijerWallace.html
+++ /dev/null
@@ -1,298 +0,0 @@
-
{-----------------------------------------------------------------------------
-
- 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 a State Transformer 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)])
-
-------------------------------------------------------------------------------
-
module Text.ParserCombinators.Poly
- ( -- * A Parser datatype parameterised on arbitrary token type
- 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
- , 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 had 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
-
--- | '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))
-
-------------------------------------------------------------------------
-
module Text.ParserCombinators.PolyLazy
- ( -- * A Parser datatype parameterised on arbitrary token type.
- -- Parsers do not return explicit failure. An exception is
- -- raised instead. This allows partial results to be returned
- -- before a full parse is complete.
- 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
- , 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
-
--- | 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] -> (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 }
-
--- | @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
-
--- | '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 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))
-
-------------------------------------------------------------------------
-
module Text.ParserCombinators.PolyState
- ( -- * A Parser datatype parameterised on arbitrary token type and state type
- 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
- , 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
-
--- | '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))
-
-------------------------------------------------------------------------
-
module Text.ParserCombinators.PolyStateLazy
- ( -- * A Parser datatype parameterised on arbitrary token type and state type.
- -- Parsers do not return explicit failure. An exception is raised
- -- instead. This allows partial results to be returned before a
- -- full parse is complete.
- 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
- , 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
-
--- | 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
-
--- | '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))
-
-------------------------------------------------------------------------
-
module Text.ParserCombinators.TextParser
- ( -- * The Parse class is a replacement for the Read class. It is a
- -- specialisation of the (poly) Parser monad for String input.
- 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 too
- , module Text.ParserCombinators.Poly
- ) where
-
-import Char (isSpace)
-import List (intersperse)
-import Text.ParserCombinators.Poly
-
-------------------------------------------------------------------------
-
--- | 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@.
-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 a 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.
-field :: Parse a => String -> TextParser a
-field name = do { isWord name; commit $ do { isWord "="; parse } }
-
--- | Parse one of a bunch of alternative constructors.
-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).
-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 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
-
-------------------------------------------------------------------------
-
diff --git a/docs/HaXml/src/Text/XML/HaXml/SAX.html b/docs/HaXml/src/Text/XML/HaXml/SAX.html
--- a/docs/HaXml/src/Text/XML/HaXml/SAX.html
+++ b/docs/HaXml/src/Text/XML/HaXml/SAX.html
@@ -14,7 +14,7 @@
import Text.XML.HaXml.Types
import Text.XML.HaXml.Parse
import Text.XML.HaXml.Lex
-import Text.ParserCombinators.PolyState
+import Text.ParserCombinators.Poly.NoLeak.State
data SaxElement
= SaxDocTypeDecl DocTypeDecl
diff --git a/docs/HaXml/src/Text/XML/HaXml/TypeMapping.html b/docs/HaXml/src/Text/XML/HaXml/TypeMapping.html
--- a/docs/HaXml/src/Text/XML/HaXml/TypeMapping.html
+++ b/docs/HaXml/src/Text/XML/HaXml/TypeMapping.html
@@ -60,158 +60,150 @@
-- variables occurring in the (second) list of real component types.
-- If there are fieldnames, they are contained in the final list, and
-- correspond one-to-one with the component types.
--- The Synonym alternative is for where the type-mapping from Haskell to
--- XML is user-defined rather than automatic. There, one might wish to
--- rename an existing XML type, without the addition of a constructor\/tag.
-data Constr = Constr String [HType] [HType] -- (Maybe [String])
- | Synonym HType
-deriving (Eq,Show)
-
--- | Project the n'th constructor from an HType and convert it to a string
--- suitable for an XML tagname.
-showConstr :: Int -> HType -> String
-showConstr n (Defined __ cs) = flatConstr (cs!!n) ""
-showConstr n _ = error "no constructors for builtin types"
-
-------------------------------------------------------------------------
--- Some instances
-instance HTypeable Bool where
- toHType _ = Prim "Bool" "bool"
-instance HTypeable Int where
- toHType _ = Prim "Int" "int"
-instance HTypeable Integer where
- toHType _ = Prim "Integer" "integer"
-instance HTypeable Float where
- toHType _ = Prim "Float" "float"
-instance HTypeable Double where
- toHType _ = Prim "Double" "double"
-instance HTypeable Char where
- toHType _ = Prim "Char" "char"
-
-instance HTypeable () where
- toHType _ = Prim "unit" "unit"
-instance (HTypeable a, HTypeable b) => HTypeable (a,b) where
- toHType p = Tuple [toHType a, toHType b]
-where (a,b) = p
-instance (HTypeable a, HTypeable b, HTypeable c) => HTypeable (a,b,c) where
- toHType p = Tuple [toHType a, toHType b, toHType c]
-where (a,b,c) = p
-instance (HTypeable a) => HTypeable (Maybe a) where
- toHType m = Maybe (toHType x) where (Just x) = m
-instance (HTypeable a, HTypeable b) => HTypeable (Either a b) where
- toHType m = Defined "Either" [hx, hy]
- [ Constr "Left" [hx] [hx] {-Nothing-}
- , Constr "Right" [hy] [hy] {-Nothing-}]
-where (Left x) = m
- (Right y) = m
- hx = toHType x
- hy = toHType y
-
-instance HTypeable a => HTypeable [a] where
- toHType xs = case toHType x of (Prim "Char" _) -> String
-_ -> List (toHType x)
-where (x:_) = xs
-
-------------------------------------------------------------------------
-
--- | 'toDTD' converts a concrete representation of the Haskell type of
--- a value (obtained by the method 'toHType') into a real DocTypeDecl.
--- It ensures that PERefs are defined before they are used, and that no
--- element or attribute-list is declared more than once.
-toDTD :: HType -> DocTypeDecl
-toDTD ht =
- DTD (toplevel ht) Nothing (macrosFirst (reverse (h2d True [] [] [ht])))
-where
- macrosFirst :: [MarkupDecl] -> [MarkupDecl]
- macrosFirst decls = concat [p, p'] where (p, p') = partition f decls
- f (Entity _) = True
- f _ = False
- toplevel ht@(Defined ___) = showHType ht "-XML"
- toplevel ht@_ = showHType ht ""
- c0 = False
- h2d :: Bool -> [HType] -> [Constr] -> [HType] -> [MarkupDecl]
- -- toplevel? history history remainingwork result
- h2d c history chist [] = []
- h2d c history chist (ht:hts) =
-if ht `elem` history then h2d c0 history chist hts
-else
-case ht of
- Maybe ht0 -> declelem ht: h2d c0 (ht:history) chist (ht0:hts)
- List ht0 -> declelem ht: h2d c0 (ht:history) chist (ht0:hts)
- Tuple hts0 -> (c ? (declelem ht:))
- (h2d c0 history chist (hts0++hts))
- Prim s t -> declprim ht ++ h2d c0 (ht:history) chist hts
- String -> declstring: h2d c0 (ht:history) chist hts
- Defined s _ cs ->
-let hts0 = concatMap grab cs in
- (c ? (decltopelem ht:)) (declmacro ht chist)
- ++ h2d c0 (ht:history) (cs++chist) (hts0++hts)
- declelem ht =
- Element (ElementDecl (showHType ht "") (ContentSpec (outerHtExpr ht)))
- decltopelem ht = -- hack to avoid peref at toplevel
- Element (ElementDecl (showHType ht "-XML") (ContentSpec (innerHtExpr ht None)))
- declmacro ht@(Defined __ cs) chist =
- Entity (EntityPEDecl (PEDecl (showHType ht "") (PEDefEntityValue ev))):
- concatMap (declConstr chist) cs
-where ev = EntityValue [EVString (render (PP.cp (outerHtExpr ht)))]
- declConstr chist c@(Constr s fv hts)
- | c `notElem` chist =
- [Element (ElementDecl (flatConstr c "") (ContentSpec (constrHtExpr c)))]
- | otherwise = []
- declConstr _ (Synonym ht) = []
- declprim (Prim s t) =
- [ Element (ElementDecl t EMPTY)
- , AttList (AttListDecl t [AttDef "value" StringType REQUIRED])]
- declstring =
- Element (ElementDecl "string" (Mixed PCDATA))
- grab (Constr __ hts) = hts
- grab (Synonym ht) = [ht]
-
-(?) :: Bool -> (a->a) -> (a->a)
-b ? f | b = f
- | not b = id
-
--- Flatten an HType to a String suitable for an XML tagname.
-showHType :: HType -> ShowS
-showHType (Maybe ht) = showString "maybe-" . showHType ht
-showHType (List ht) = showString "list-" . showHType ht
-showHType (Tuple hts) = showString "tuple" . shows (length hts)
- . showChar '-'
- . foldr1 (.) (intersperse (showChar '-')
- (map showHType hts))
-showHType (Prim s t) = showString t
-showHType String = showString "string"
-showHType (Defined s fv _)
- = showString s . ((length fv > 0) ? (showChar '-'))
- . foldr (.) id (intersperse (showChar '-')
- (map showHType fv))
-
-flatConstr :: Constr -> ShowS
-flatConstr (Constr s fv _)
- = showString s . ((length fv > 0) ? (showChar '-'))
- . foldr (.) id (intersperse (showChar '-') (map showHType fv))
-flatConstr (Synonym ht) = id
+data Constr = Constr String [HType] [HType] -- (Maybe [String])
+deriving (Eq,Show)
+
+-- | Project the n'th constructor from an HType and convert it to a string
+-- suitable for an XML tagname.
+showConstr :: Int -> HType -> String
+showConstr n (Defined __ cs) = flatConstr (cs!!n) ""
+showConstr n _ = error "no constructors for builtin types"
+
+------------------------------------------------------------------------
+-- Some instances
+instance HTypeable Bool where
+ toHType _ = Prim "Bool" "bool"
+instance HTypeable Int where
+ toHType _ = Prim "Int" "int"
+instance HTypeable Integer where
+ toHType _ = Prim "Integer" "integer"
+instance HTypeable Float where
+ toHType _ = Prim "Float" "float"
+instance HTypeable Double where
+ toHType _ = Prim "Double" "double"
+instance HTypeable Char where
+ toHType _ = Prim "Char" "char"
+
+instance HTypeable () where
+ toHType _ = Prim "unit" "unit"
+instance (HTypeable a, HTypeable b) => HTypeable (a,b) where
+ toHType p = Tuple [toHType a, toHType b]
+where (a,b) = p
+instance (HTypeable a, HTypeable b, HTypeable c) => HTypeable (a,b,c) where
+ toHType p = Tuple [toHType a, toHType b, toHType c]
+where (a,b,c) = p
+instance (HTypeable a) => HTypeable (Maybe a) where
+ toHType m = Maybe (toHType x) where (Just x) = m
+instance (HTypeable a, HTypeable b) => HTypeable (Either a b) where
+ toHType m = Defined "Either" [hx, hy]
+ [ Constr "Left" [hx] [hx] {-Nothing-}
+ , Constr "Right" [hy] [hy] {-Nothing-}]
+where (Left x) = m
+ (Right y) = m
+ hx = toHType x
+ hy = toHType y
+
+instance HTypeable a => HTypeable [a] where
+ toHType xs = case toHType x of (Prim "Char" _) -> String
+_ -> List (toHType x)
+where (x:_) = xs
+
+------------------------------------------------------------------------
+
+-- | 'toDTD' converts a concrete representation of the Haskell type of
+-- a value (obtained by the method 'toHType') into a real DocTypeDecl.
+-- It ensures that PERefs are defined before they are used, and that no
+-- element or attribute-list is declared more than once.
+toDTD :: HType -> DocTypeDecl
+toDTD ht =
+ DTD (toplevel ht) Nothing (macrosFirst (reverse (h2d True [] [] [ht])))
+where
+ macrosFirst :: [MarkupDecl] -> [MarkupDecl]
+ macrosFirst decls = concat [p, p'] where (p, p') = partition f decls
+ f (Entity _) = True
+ f _ = False
+ toplevel ht@(Defined ___) = showHType ht "-XML"
+ toplevel ht@_ = showHType ht ""
+ c0 = False
+ h2d :: Bool -> [HType] -> [Constr] -> [HType] -> [MarkupDecl]
+ -- toplevel? history history remainingwork result
+ h2d c history chist [] = []
+ h2d c history chist (ht:hts) =
+if ht `elem` history then h2d c0 history chist hts
+else
+case ht of
+ Maybe ht0 -> declelem ht: h2d c0 (ht:history) chist (ht0:hts)
+ List ht0 -> declelem ht: h2d c0 (ht:history) chist (ht0:hts)
+ Tuple hts0 -> (c ? (declelem ht:))
+ (h2d c0 history chist (hts0++hts))
+ Prim s t -> declprim ht ++ h2d c0 (ht:history) chist hts
+ String -> declstring: h2d c0 (ht:history) chist hts
+ Defined s _ cs ->
+let hts0 = concatMap grab cs in
+ (c ? (decltopelem ht:)) (declmacro ht chist)
+ ++ h2d c0 (ht:history) (cs++chist) (hts0++hts)
+ declelem ht =
+ Element (ElementDecl (showHType ht "") (ContentSpec (outerHtExpr ht)))
+ decltopelem ht = -- hack to avoid peref at toplevel
+ Element (ElementDecl (showHType ht "-XML") (ContentSpec (innerHtExpr ht None)))
+ declmacro ht@(Defined __ cs) chist =
+ Entity (EntityPEDecl (PEDecl (showHType ht "") (PEDefEntityValue ev))):
+ concatMap (declConstr chist) cs
+where ev = EntityValue [EVString (render (PP.cp (outerHtExpr ht)))]
+ declConstr chist c@(Constr s fv hts)
+ | c `notElem` chist =
+ [Element (ElementDecl (flatConstr c "") (ContentSpec (constrHtExpr c)))]
+ | otherwise = []
+ declprim (Prim s t) =
+ [ Element (ElementDecl t EMPTY)
+ , AttList (AttListDecl t [AttDef "value" StringType REQUIRED])]
+ declstring =
+ Element (ElementDecl "string" (Mixed PCDATA))
+ grab (Constr __ hts) = hts
+
+(?) :: Bool -> (a->a) -> (a->a)
+b ? f | b = f
+ | not b = id
+
+-- Flatten an HType to a String suitable for an XML tagname.
+showHType :: HType -> ShowS
+showHType (Maybe ht) = showString "maybe-" . showHType ht
+showHType (List ht) = showString "list-" . showHType ht
+showHType (Tuple hts) = showString "tuple" . shows (length hts)
+ . showChar '-'
+ . foldr1 (.) (intersperse (showChar '-')
+ (map showHType hts))
+showHType (Prim s t) = showString t
+showHType String = showString "string"
+showHType (Defined s fv _)
+ = showString s . ((length fv > 0) ? (showChar '-'))
+ . foldr (.) id (intersperse (showChar '-')
+ (map showHType fv))
+
+flatConstr :: Constr -> ShowS
+flatConstr (Constr s fv _)
+ = showString s . ((length fv > 0) ? (showChar '-'))
+ . foldr (.) id (intersperse (showChar '-') (map showHType fv))
+
+outerHtExpr :: HType -> CP
+outerHtExpr (Maybe ht) = innerHtExpr ht Query
+outerHtExpr (List ht) = innerHtExpr ht Star
+outerHtExpr (Defined s fv cs) =
+ Choice (map (\c->TagName (flatConstr c "") None) cs) None
+outerHtExpr ht = innerHtExpr ht None
-outerHtExpr :: HType -> CP
-outerHtExpr (Maybe ht) = innerHtExpr ht Query
-outerHtExpr (List ht) = innerHtExpr ht Star
-outerHtExpr (Defined s fv cs) =
- Choice (map (\c->TagName (flatConstr c "") None) cs) None
-outerHtExpr ht = innerHtExpr ht None
-
-innerHtExpr :: HType -> Modifier -> CP
-innerHtExpr (Prim s t) m = TagName t m
-innerHtExpr (Tuple hts) m = Seq (map (\c-> innerHtExpr c None) hts) m
-innerHtExpr ht@(Defined s hts cs) m = -- CPPE (showHType ht "") (outerHtExpr ht)
- TagName ('%': showHType ht ";") m
- -- ***HACK!!!***
-innerHtExpr ht m = TagName (showHType ht "") m
-
-constrHtExpr :: Constr -> CP
-constrHtExpr (Constr s fv []) = TagName "EMPTY" None -- ***HACK!!!***
-constrHtExpr (Constr s fv hts) = innerHtExpr (Tuple hts) None
-constrHtExpr (Synonym ht) = outerHtExpr ht
-
-------------------------------------------------------------------------
+innerHtExpr :: HType -> Modifier -> CP
+innerHtExpr (Prim s t) m = TagName t m
+innerHtExpr (Tuple hts) m = Seq (map (\c-> innerHtExpr c None) hts) m
+innerHtExpr ht@(Defined s hts cs) m = -- CPPE (showHType ht "") (outerHtExpr ht)
+ TagName ('%': showHType ht ";") m
+ -- ***HACK!!!***
+innerHtExpr ht m = TagName (showHType ht "") m
+
+constrHtExpr :: Constr -> CP
+constrHtExpr (Constr s fv []) = TagName "EMPTY" None -- ***HACK!!!***
+constrHtExpr (Constr s fv hts) = innerHtExpr (Tuple hts) None
+
+------------------------------------------------------------------------
Instances