parsec3 (empty) → 1.0.0.0

raw patch · 16 files changed

+2924/−0 lines, 16 filesdep +basedep +bytestringdep +mtlsetup-changed

Dependencies added: base, bytestring, mtl, syb

Files

• LICENSE +21/−0
• Setup.hs +6/−0
• Text/Parsec.hs +36/−0
• Text/Parsec/ByteString.hs +46/−0
• Text/Parsec/ByteString/Lazy.hs +45/−0
• Text/Parsec/Char.hs +135/−0
• Text/Parsec/Combinator.hs +286/−0
• Text/Parsec/Error.hs +197/−0
• Text/Parsec/Expr.hs +166/−0
• Text/Parsec/Language.hs +150/−0
• Text/Parsec/Perm.hs +181/−0
• Text/Parsec/Pos.hs +125/−0
• Text/Parsec/Prim.hs +725/−0
• Text/Parsec/String.hs +45/−0
• Text/Parsec/Token.hs +722/−0
• parsec3.cabal +38/−0

@@ -0,0 +1,21 @@+Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+* Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the+  documentation and/or other materials provided with the distribution.++This software is provided by the copyright holders "as is" and any express or+implied warranties, including, but not limited to, the implied warranties of+merchantability and fitness for a particular purpose are disclaimed. In no+event shall the copyright holders be liable for any direct, indirect,+incidental, special, exemplary, or consequential damages (including, but not+limited to, procurement of substitute goods or services; loss of use, data,+or profits; or business interruption) however caused and on any theory of+liability, whether in contract, strict liability, or tort (including+negligence or otherwise) arising in any way out of the use of this software,+even if advised of the possibility of such damage.

@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain

@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+-- +-----------------------------------------------------------------------------++module Text.Parsec+    ( module Text.Parsec.Prim+    , module Text.Parsec.Char+    , module Text.Parsec.Combinator+    , module Text.Parsec.String+    , module Text.Parsec.ByteString+    , module Text.Parsec.ByteString.Lazy+    , ParseError+    , errorPos+    , SourcePos+    , SourceName, Line, Column+    , sourceName, sourceLine, sourceColumn+    , incSourceLine, incSourceColumn+    , setSourceLine, setSourceColumn, setSourceName+    ) where++import Text.Parsec.Pos+import Text.Parsec.Error+import Text.Parsec.Prim+import Text.Parsec.Char+import Text.Parsec.Combinator+import Text.Parsec.String           hiding ( Parser, GenParser, parseFromFile )+import Text.Parsec.ByteString       hiding ( Parser, GenParser, parseFromFile )+import Text.Parsec.ByteString.Lazy  hiding ( Parser, GenParser, parseFromFile )

@@ -0,0 +1,46 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.ByteString+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+-- +-- Make strict ByteStrings an instance of 'Stream' with 'Char' token type.+--+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.Parsec.ByteString+    ( Parser, GenParser, parseFromFile+    ) where++import Text.Parsec.Error+import Text.Parsec.Prim++import qualified Data.ByteString.Char8 as C++instance (Monad m) => Stream C.ByteString m Char where+    uncons = return . C.uncons++type Parser = Parsec C.ByteString ()+type GenParser t st = Parsec C.ByteString st++-- | @parseFromFile p filePath@ runs a strict bytestring parser @p@ on the+-- input read from @filePath@ using 'ByteString.Char8.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }++parseFromFile :: Parser a -> String -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- C.readFile fname+         return (runP p () fname input)

@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.ByteString.Lazy+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Make lazy ByteStrings an instance of 'Stream' with 'Char' token type.+--+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.Parsec.ByteString.Lazy+    ( Parser, GenParser, parseFromFile+    ) where++import Text.Parsec.Error+import Text.Parsec.Prim++import qualified Data.ByteString.Lazy.Char8 as C++instance (Monad m) => Stream C.ByteString m Char where+    uncons = return . C.uncons++type Parser = Parsec C.ByteString ()+type GenParser t st = Parsec C.ByteString st++-- | @parseFromFile p filePath@ runs a lazy bytestring parser @p@ on the+-- input read from @filePath@ using 'ByteString.Lazy.Char8.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }+parseFromFile :: Parser a -> String -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- C.readFile fname+         return (runP p () fname input)

@@ -0,0 +1,135 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Char+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+-- +-- Commonly used character parsers.+-- +-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}++module Text.Parsec.Char where++import Data.Char+import Text.Parsec.Pos+import Text.Parsec.Prim++-- | @oneOf cs@ succeeds if the current character is in the supplied+-- list of characters @cs@. Returns the parsed character. See also+-- 'satisfy'.+-- +-- >   vowel  = oneOf "aeiou"++oneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char+oneOf cs            = satisfy (\c -> elem c cs)++-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current+-- character /not/ in the supplied list of characters @cs@. Returns the+-- parsed character.+--+-- >  consonant = noneOf "aeiou"++noneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char+noneOf cs           = satisfy (\c -> not (elem c cs))++-- | Skips /zero/ or more white space characters. See also 'skipMany'.++spaces :: (Stream s m Char) => ParsecT s u m ()+spaces              = skipMany space        <?> "white space"++-- | Parses a white space character (any character which satisfies 'isSpace')+-- Returns the parsed character. ++space :: (Stream s m Char) => ParsecT s u m Char+space               = satisfy isSpace       <?> "space"++-- | Parses a newline character (\'\\n\'). Returns a newline character. ++newline :: (Stream s m Char) => ParsecT s u m Char+newline             = char '\n'             <?> "new-line"++-- | Parses a tab character (\'\\t\'). Returns a tab character. ++tab :: (Stream s m Char) => ParsecT s u m Char+tab                 = char '\t'             <?> "tab"++-- | Parses an upper case letter (a character between \'A\' and \'Z\').+-- Returns the parsed character. ++upper :: (Stream s m Char) => ParsecT s u m Char+upper               = satisfy isUpper       <?> "uppercase letter"++-- | Parses a lower case character (a character between \'a\' and \'z\').+-- Returns the parsed character. ++lower :: (Stream s m Char) => ParsecT s u m Char+lower               = satisfy isLower       <?> "lowercase letter"++-- | Parses a letter or digit (a character between \'0\' and \'9\').+-- Returns the parsed character. ++alphaNum :: (Stream s m Char => ParsecT s u m Char)+alphaNum            = satisfy isAlphaNum    <?> "letter or digit"++-- | Parses a letter (an upper case or lower case character). Returns the+-- parsed character. ++letter :: (Stream s m Char) => ParsecT s u m Char+letter              = satisfy isAlpha       <?> "letter"++-- | Parses a digit. Returns the parsed character. ++digit :: (Stream s m Char) => ParsecT s u m Char+digit               = satisfy isDigit       <?> "digit"++-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and+-- \'f\' or \'A\' and \'F\'). Returns the parsed character. ++hexDigit :: (Stream s m Char) => ParsecT s u m Char+hexDigit            = satisfy isHexDigit    <?> "hexadecimal digit"++-- | Parses an octal digit (a character between \'0\' and \'7\'). Returns+-- the parsed character. ++octDigit :: (Stream s m Char) => ParsecT s u m Char+octDigit            = satisfy isOctDigit    <?> "octal digit"++-- | @char c@ parses a single character @c@. Returns the parsed+-- character (i.e. @c@).+--+-- >  semiColon  = char ';'++char :: (Stream s m Char) => Char -> ParsecT s u m Char+char c              = satisfy (==c)  <?> show [c]++-- | This parser succeeds for any character. Returns the parsed character. ++anyChar :: (Stream s m Char) => ParsecT s u m Char+anyChar             = satisfy (const True)++-- | The parser @satisfy f@ succeeds for any character for which the+-- supplied function @f@ returns 'True'. Returns the character that is+-- actually parsed.++-- >  digit     = satisfy isDigit+-- >  oneOf cs  = satisfy (\c -> c `elem` cs)++satisfy :: (Stream s m Char) => (Char -> Bool) -> ParsecT s u m Char+satisfy f           = tokenPrim (\c -> show [c])+                                (\pos c _cs -> updatePosChar pos c)+                                (\c -> if f c then Just c else Nothing)++-- | @string s@ parses a sequence of characters given by @s@. Returns+-- the parsed string (i.e. @s@).+--+-- >  divOrMod    =   string "div" +-- >              <|> string "mod"++string :: (Stream s m Char) => String -> ParsecT s u m String+string s            = tokens show updatePosString s

@@ -0,0 +1,286 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Combinator+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+-- +-- Commonly used generic combinators+-- +-----------------------------------------------------------------------------++module Text.Parsec.Combinator+    ( choice+    , count+    , between+    , option, optionMaybe, optional+    , skipMany1+    , many1+    , sepBy, sepBy1+    , endBy, endBy1+    , sepEndBy, sepEndBy1+    , chainl, chainl1+    , chainr, chainr1+    , eof, notFollowedBy+    -- tricky combinators+    , manyTill, lookAhead, anyToken+    ) where++import Control.Monad+import Text.Parsec.Prim++-- | @choice ps@ tries to apply the parsers in the list @ps@ in order,+-- until one of them succeeds. Returns the value of the succeeding+-- parser.++choice :: (Stream s m t) => [ParsecT s u m a] -> ParsecT s u m a+choice ps           = foldr (<|>) mzero ps++-- | @option x p@ tries to apply parser @p@. If @p@ fails without+-- consuming input, it returns the value @x@, otherwise the value+-- returned by @p@.+--+-- >  priority  = option 0 (do{ d <- digit+-- >                          ; return (digitToInt d) +-- >                          })++option :: (Stream s m t) => a -> ParsecT s u m a -> ParsecT s u m a+option x p          = p <|> return x++-- | @option p@ tries to apply parser @p@.  If @p@ fails without+-- consuming input, it return 'Nothing', otherwise it returns+-- 'Just' the value returned by @p@.++optionMaybe :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (Maybe a)+optionMaybe p       = option Nothing (liftM Just p)++-- | @optional p@ tries to apply parser @p@.  It will parse @p@ or nothing.+-- It only fails if @p@ fails after consuming input. It discards the result+-- of @p@.++optional :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()+optional p          = do{ p; return ()} <|> return ()++-- | @between open close p@ parses @open@, followed by @p@ and @close@.+-- Returns the value returned by @p@.+--+-- >  braces  = between (symbol "{") (symbol "}")++between :: (Stream s m t) => ParsecT s u m open -> ParsecT s u m close+            -> ParsecT s u m a -> ParsecT s u m a+between open close p+                    = do{ open; x <- p; close; return x }++-- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping+-- its result. ++skipMany1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()+skipMany1 p         = do{ p; skipMany p }+{-+skipMany p          = scan+                    where+                      scan  = do{ p; scan } <|> return ()+-}++-- | @many p@ applies the parser @p@ /one/ or more times. Returns a+-- list of the returned values of @p@.+--+-- >  word  = many1 letter++many1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]+many1 p             = do{ x <- p; xs <- many p; return (x:xs) }+{-+many p              = scan id+                    where+                      scan f    = do{ x <- p+                                    ; scan (\tail -> f (x:tail))+                                    }+                                <|> return (f [])+-}+++-- | @sepBy p sep@ parses /zero/ or more occurrences of @p@, separated+-- by @sep@. Returns a list of values returned by @p@.+--+-- >  commaSep p  = p `sepBy` (symbol ",")++sepBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+sepBy p sep         = sepBy1 p sep <|> return []++-- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated+-- by @sep@. Returns a list of values returned by @p@. ++sepBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+sepBy1 p sep        = do{ x <- p+                        ; xs <- many (sep >> p)+                        ; return (x:xs)+                        }+++-- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@,+-- separated and optionally ended by @sep@. Returns a list of values+-- returned by @p@. ++sepEndBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+sepEndBy1 p sep     = do{ x <- p+                        ; do{ sep+                            ; xs <- sepEndBy p sep+                            ; return (x:xs)+                            }+                          <|> return [x]+                        }++-- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@,+-- separated and optionally ended by @sep@, ie. haskell style+-- statements. Returns a list of values returned by @p@.+--+-- >  haskellStatements  = haskellStatement `sepEndBy` semi++sepEndBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+sepEndBy p sep      = sepEndBy1 p sep <|> return []+++-- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, seperated+-- and ended by @sep@. Returns a list of values returned by @p@. ++endBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+endBy1 p sep        = many1 (do{ x <- p; sep; return x })++-- | @endBy p sep@ parses /zero/ or more occurrences of @p@, seperated+-- and ended by @sep@. Returns a list of values returned by @p@.+--+-- >   cStatements  = cStatement `endBy` semi++endBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+endBy p sep         = many (do{ x <- p; sep; return x })++-- | @count n p@ parses @n@ occurrences of @p@. If @n@ is smaller or+-- equal to zero, the parser equals to @return []@. Returns a list of+-- @n@ values returned by @p@. ++count :: (Stream s m t) => Int -> ParsecT s u m a -> ParsecT s u m [a]+count n p           | n <= 0    = return []+                    | otherwise = sequence (replicate n p)++-- | @chainr p op x@ parser /zero/ or more occurrences of @p@,+-- separated by @op@ Returns a value obtained by a /right/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. If there are no occurrences of @p@, the value @x@ is+-- returned.++chainr :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a+chainr p op x       = chainr1 p op <|> return x++-- | @chainl p op x@ parser /zero/ or more occurrences of @p@,+-- separated by @op@. Returns a value obtained by a /left/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. If there are zero occurrences of @p@, the value @x@ is+-- returned.++chainl :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a+chainl p op x       = chainl1 p op <|> return x++-- | @chainl1 p op x@ parser /one/ or more occurrences of @p@,+-- separated by @op@ Returns a value obtained by a /left/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. . This parser can for example be used to eliminate left+-- recursion which typically occurs in expression grammars.+--+-- >  expr    = term   `chainl1` addop+-- >  term    = factor `chainl1` mulop+-- >  factor  = parens expr <|> integer+-- >+-- >  mulop   =   do{ symbol "*"; return (*)   }+-- >          <|> do{ symbol "/"; return (div) }+-- >+-- >  addop   =   do{ symbol "+"; return (+) }+-- >          <|> do{ symbol "-"; return (-) }++chainl1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a+chainl1 p op        = do{ x <- p; rest x }+                    where+                      rest x    = do{ f <- op+                                    ; y <- p+                                    ; rest (f x y)+                                    }+                                <|> return x++-- | @chainr1 p op x@ parser /one/ or more occurrences of |p|,+-- separated by @op@ Returns a value obtained by a /right/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@.++chainr1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a+chainr1 p op        = scan+                    where+                      scan      = do{ x <- p; rest x }++                      rest x    = do{ f <- op+                                    ; y <- scan+                                    ; return (f x y)+                                    }+                                <|> return x++-----------------------------------------------------------+-- Tricky combinators+-----------------------------------------------------------+-- | The parser @anyToken@ accepts any kind of token. It is for example+-- used to implement 'eof'. Returns the accepted token. ++anyToken :: (Stream s m t, Show t) => ParsecT s u m t+anyToken            = tokenPrim show (\pos _tok _toks -> pos) Just++-- | This parser only succeeds at the end of the input. This is not a+-- primitive parser but it is defined using 'notFollowedBy'.+--+-- >  eof  = notFollowedBy anyToken <?> "end of input"++eof :: (Stream s m t, Show t) => ParsecT s u m ()+eof                 = notFollowedBy anyToken <?> "end of input"++-- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser+-- does not consume any input. This parser can be used to implement the+-- \'longest match\' rule. For example, when recognizing keywords (for+-- example @let@), we want to make sure that a keyword is not followed+-- by a legal identifier character, in which case the keyword is+-- actually an identifier (for example @lets@). We can program this+-- behaviour as follows:+--+-- >  keywordLet  = try (do{ string "let"+-- >                       ; notFollowedBy alphaNum+-- >                       })++notFollowedBy :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()+notFollowedBy p     = try (do{ c <- try p; unexpected (show c) }+                           <|> return ()+                          )++-- | @manyTill p end@ applies parser @p@ /zero/ or more times until+-- parser @end@ succeeds. Returns the list of values returned by @p@.+-- This parser can be used to scan comments:+--+-- >  simpleComment   = do{ string "<!--"+-- >                      ; manyTill anyChar (try (string "-->"))+-- >                      }+--+--    Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and+--    therefore the use of the 'try' combinator.++manyTill :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]+manyTill p end      = scan+                    where+                      scan  = do{ end; return [] }+                            <|>+                              do{ x <- p; xs <- scan; return (x:xs) }++-- | @lookAhead p@ parses @p@ without consuming any input.++lookAhead :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a+lookAhead p         = do{ state <- getParserState+                        ; x <- p+                        ; setParserState state+                        ; return x+                        }

@@ -0,0 +1,197 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Error+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+-- +-- Parse errors+-- +-----------------------------------------------------------------------------++module Text.Parsec.Error+    ( Message ( SysUnExpect, UnExpect, Expect, Message )+    , messageString+    , ParseError, errorPos, errorMessages, errorIsUnknown+    , showErrorMessages+    , newErrorMessage, newErrorUnknown+    , addErrorMessage, setErrorPos, setErrorMessage+    , mergeError+    ) where++import Data.List ( nub, sort )++import Text.Parsec.Pos++-- | This abstract data type represents parse error messages. There are+-- four kinds of messages:+--+-- >  data Message = SysUnExpect String+-- >               | UnExpect String+-- >               | Expect String+-- >               | Message String+-- +-- The fine distinction between different kinds of parse errors allows+-- the system to generate quite good error messages for the user. It+-- also allows error messages that are formatted in different+-- languages. Each kind of message is generated by different combinators:+--+--     * A 'SysUnExpect' message is automatically generated by the+--       'Text.Parsec.Combinator.satisfy' combinator. The argument is the+--       unexpected input.+--+--     * A 'UnExpect' message is generated by the 'Text.Parsec.Prim.unexpected'+--       combinator. The argument describes the+--       unexpected item.+--+--     * A 'Expect' message is generated by the 'Text.Parsec.Prim.<?>'+--       combinator. The argument describes the expected item.+--+--     * A 'Message' message is generated by the 'fail'+--       combinator. The argument is some general parser message. ++data Message = SysUnExpect !String -- @ library generated unexpect+             | UnExpect    !String -- @ unexpected something+             | Expect      !String -- @ expecting something+             | Message     !String -- @ raw message++instance Enum Message where+    fromEnum (SysUnExpect _) = 0+    fromEnum (UnExpect    _) = 1+    fromEnum (Expect      _) = 2+    fromEnum (Message     _) = 3+    toEnum _ = error "toEnum is undefined for Message"++-- < Return 'True' only when 'compare' would return 'EQ'.++instance Eq Message where++    m1 == m2 = fromEnum m1 == fromEnum m2++-- < Compares two error messages without looking at their content. Only+-- the constructors are compared where:+-- +-- > 'SysUnExpect' < 'UnExpect' < 'Expect' < 'Message'++instance Ord Message where+    compare msg1 msg2 = compare (fromEnum msg1) (fromEnum msg2)++-- | Extract the message string from an error message ++messageString :: Message -> String+messageString (SysUnExpect s) = s+messageString (UnExpect    s) = s+messageString (Expect      s) = s+messageString (Message     s) = s++-- | The abstract data type @ParseError@ represents parse errors. It+-- provides the source position ('SourcePos') of the error+-- and a list of error messages ('Message'). A @ParseError@+-- can be returned by the function 'Text.Parsec.Prim.parse'. @ParseError@ is an+-- instance of the 'Show' class. ++data ParseError = ParseError !SourcePos [Message]++-- | Extracts the source position from the parse error++errorPos :: ParseError -> SourcePos+errorPos (ParseError pos _msgs)+    = pos++-- | Extracts the list of error messages from the parse error++errorMessages :: ParseError -> [Message]+errorMessages (ParseError _pos msgs)+    = sort msgs++errorIsUnknown :: ParseError -> Bool+errorIsUnknown (ParseError _pos msgs)+    = null msgs++-- < Create parse errors++newErrorUnknown :: SourcePos -> ParseError+newErrorUnknown pos+    = ParseError pos []++newErrorMessage :: Message -> SourcePos -> ParseError+newErrorMessage msg pos+    = ParseError pos [msg]++addErrorMessage :: Message -> ParseError -> ParseError+addErrorMessage msg (ParseError pos msgs)+    = ParseError pos (msg:msgs)++setErrorPos :: SourcePos -> ParseError -> ParseError+setErrorPos pos (ParseError _ msgs)+    = ParseError pos msgs++setErrorMessage :: Message -> ParseError -> ParseError+setErrorMessage msg (ParseError pos msgs)+    = ParseError pos (msg : filter (msg /=) msgs)++mergeError :: ParseError -> ParseError -> ParseError+mergeError (ParseError pos msgs1) (ParseError _ msgs2)+    = ParseError pos (msgs1 ++ msgs2)++instance Show ParseError where+    show err+        = show (errorPos err) ++ ":" +++          showErrorMessages "or" "unknown parse error"+                            "expecting" "unexpected" "end of input"+                           (errorMessages err)++-- Language independent show function++--  TODO+-- < The standard function for showing error messages. Formats a list of+--    error messages in English. This function is used in the |Show|+--    instance of |ParseError <#ParseError>|. The resulting string will be+--    formatted like:+--+--    |unexpected /{The first UnExpect or a SysUnExpect message}/;+--    expecting /{comma separated list of Expect messages}/;+--    /{comma separated list of Message messages}/++showErrorMessages ::+    String -> String -> String -> String -> String -> [Message] -> String+showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs+    | null msgs = msgUnknown+    | otherwise = concat $ map ("\n"++) $ clean $+                 [showSysUnExpect,showUnExpect,showExpect,showMessages]+    where+      (sysUnExpect,msgs1) = span ((SysUnExpect "") ==) msgs+      (unExpect,msgs2)    = span ((UnExpect    "") ==) msgs1+      (expect,messages)   = span ((Expect      "") ==) msgs2++      showExpect      = showMany msgExpecting expect+      showUnExpect    = showMany msgUnExpected unExpect+      showSysUnExpect | not (null unExpect) ||+                        null sysUnExpect = ""+                      | null firstMsg    = msgUnExpected ++ " " ++ msgEndOfInput+                      | otherwise        = msgUnExpected ++ " " ++ firstMsg+          where+              firstMsg  = messageString (head sysUnExpect)++      showMessages      = showMany "" messages++      -- helpers+      showMany pre msgs = case clean (map messageString msgs) of+                            [] -> ""+                            ms | null pre  -> commasOr ms+                               | otherwise -> pre ++ " " ++ commasOr ms++      commasOr []       = ""+      commasOr [m]      = m+      commasOr ms       = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms++      commaSep          = seperate ", " . clean++      seperate   _ []     = ""+      seperate   _ [m]    = m+      seperate sep (m:ms) = m ++ sep ++ seperate sep ms++      clean             = nub . filter (not . null)

@@ -0,0 +1,166 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Expr+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable+-- +-- A helper module to parse \"expressions\".+-- Builds a parser given a table of operators and associativities.+-- +-----------------------------------------------------------------------------++module Text.Parsec.Expr+    ( Assoc(..), Operator(..), OperatorTable+    , buildExpressionParser+    ) where++import Text.Parsec.Prim+import Text.Parsec.Combinator++-----------------------------------------------------------+-- Assoc and OperatorTable+-----------------------------------------------------------++-- |  This data type specifies the associativity of operators: left, right+-- or none.++data Assoc                = AssocNone+                          | AssocLeft+                          | AssocRight++-- | This data type specifies operators that work on values of type @a@.+-- An operator is either binary infix or unary prefix or postfix. A+-- binary operator has also an associated associativity.++data Operator s u m a   = Infix (ParsecT s u m (a -> a -> a)) Assoc+                        | Prefix (ParsecT s u m (a -> a))+                        | Postfix (ParsecT s u m (a -> a))++-- | An @OperatorTable s u m a@ is a list of @Operator s u m a@+-- lists. The list is ordered in descending+-- precedence. All operators in one list have the same precedence (but+-- may have a different associativity).++type OperatorTable s u m a = [[Operator s u m a]]++-----------------------------------------------------------+-- Convert an OperatorTable and basic term parser into+-- a full fledged expression parser+-----------------------------------------------------------++-- | @buildExpressionParser table term@ builds an expression parser for+-- terms @term@ with operators from @table@, taking the associativity+-- and precedence specified in @table@ into account. Prefix and postfix+-- operators of the same precedence can only occur once (i.e. @--2@ is+-- not allowed if @-@ is prefix negate). Prefix and postfix operators+-- of the same precedence associate to the left (i.e. if @++@ is+-- postfix increment, than @-2++@ equals @-1@, not @-3@).+--+-- The @buildExpressionParser@ takes care of all the complexity+-- involved in building expression parser. Here is an example of an+-- expression parser that handles prefix signs, postfix increment and+-- basic arithmetic.+--+-- >  expr    = buildExpressionParser table term+-- >          <?> "expression"+-- >+-- >  term    =  parens expr +-- >          <|> natural+-- >          <?> "simple expression"+-- >+-- >  table   = [ [prefix "-" negate, prefix "+" id ]+-- >            , [postfix "++" (+1)]+-- >            , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ]+-- >            , [binary "+" (+) AssocLeft, binary "-" (-)   AssocLeft ]+-- >            ]+-- >          +-- >  binary  name fun assoc = Infix (do{ reservedOp name; return fun }) assoc+-- >  prefix  name fun       = Prefix (do{ reservedOp name; return fun })+-- >  postfix name fun       = Postfix (do{ reservedOp name; return fun })++buildExpressionParser :: (Stream s m t)+                      => OperatorTable s u m a+                      -> ParsecT s u m a+                      -> ParsecT s u m a+buildExpressionParser operators simpleExpr+    = foldl (makeParser) simpleExpr operators+    where+      makeParser term ops+        = let (rassoc,lassoc,nassoc+               ,prefix,postfix)      = foldr splitOp ([],[],[],[],[]) ops++              rassocOp   = choice rassoc+              lassocOp   = choice lassoc+              nassocOp   = choice nassoc+              prefixOp   = choice prefix  <?> ""+              postfixOp  = choice postfix <?> ""++              ambigious assoc op= try $+                                  do{ op; fail ("ambiguous use of a " ++ assoc+                                                 ++ " associative operator")+                                    }++              ambigiousRight    = ambigious "right" rassocOp+              ambigiousLeft     = ambigious "left" lassocOp+              ambigiousNon      = ambigious "non" nassocOp++              termP      = do{ pre  <- prefixP+                             ; x    <- term+                             ; post <- postfixP+                             ; return (post (pre x))+                             }++              postfixP   = postfixOp <|> return id++              prefixP    = prefixOp <|> return id++              rassocP x  = do{ f <- rassocOp+                             ; y  <- do{ z <- termP; rassocP1 z }+                             ; return (f x y)+                             }+                           <|> ambigiousLeft+                           <|> ambigiousNon+                           -- <|> return x++              rassocP1 x = rassocP x  <|> return x++              lassocP x  = do{ f <- lassocOp+                             ; y <- termP+                             ; lassocP1 (f x y)+                             }+                           <|> ambigiousRight+                           <|> ambigiousNon+                           -- <|> return x++              lassocP1 x = lassocP x <|> return x++              nassocP x  = do{ f <- nassocOp+                             ; y <- termP+                             ;    ambigiousRight+                              <|> ambigiousLeft+                              <|> ambigiousNon+                              <|> return (f x y)+                             }+                           -- <|> return x++           in  do{ x <- termP+                 ; rassocP x <|> lassocP  x <|> nassocP x <|> return x+                   <?> "operator"+                 }+++      splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix)+        = case assoc of+            AssocNone  -> (rassoc,lassoc,op:nassoc,prefix,postfix)+            AssocLeft  -> (rassoc,op:lassoc,nassoc,prefix,postfix)+            AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix)++      splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix)+        = (rassoc,lassoc,nassoc,op:prefix,postfix)++      splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix)+        = (rassoc,lassoc,nassoc,prefix,op:postfix)

@@ -0,0 +1,150 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Language+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable (uses non-portable module Text.Parsec.Token)+--+-- A helper module that defines some language definitions that can be used+-- to instantiate a token parser (see "Text.Parsec.Token").+-- +-----------------------------------------------------------------------------++module Text.Parsec.Language+    ( haskellDef, haskell+    , mondrianDef, mondrian+    , emptyDef+    , haskellStyle+    , javaStyle+    , LanguageDef+    , GenLanguageDef+    ) where++import Text.Parsec+import Text.Parsec.Token++-----------------------------------------------------------+-- Styles: haskellStyle, javaStyle+-----------------------------------------------------------++-- | This is a minimal token definition for Haskell style languages. It+-- defines the style of comments, valid identifiers and case+-- sensitivity. It does not define any reserved words or operators.++haskellStyle :: LanguageDef st+haskellStyle = emptyDef+                { commentStart   = "{-"+                , commentEnd     = "-}"+                , commentLine    = "--"+                , nestedComments = True+                , identStart     = letter+                , identLetter	 = alphaNum <|> oneOf "_'"+                , opStart	 = opLetter haskellStyle+                , opLetter	 = oneOf ":!#$%&*+./<=>?@\\^|-~"+                , reservedOpNames= []+                , reservedNames  = []+                , caseSensitive  = True+                }++-- | This is a minimal token definition for Java style languages. It+-- defines the style of comments, valid identifiers and case+-- sensitivity. It does not define any reserved words or operators.++javaStyle  :: LanguageDef st+javaStyle   = emptyDef+		{ commentStart	 = "/*"+		, commentEnd	 = "*/"+		, commentLine	 = "//"+		, nestedComments = True+		, identStart	 = letter+		, identLetter	 = alphaNum <|> oneOf "_'"+		, reservedNames  = []+		, reservedOpNames= []+                , caseSensitive  = False+		}++-----------------------------------------------------------+-- minimal language definition+--------------------------------------------------------++-- TODO: This seems wrong+-- < This is the most minimal token definition. It is recommended to use+-- this definition as the basis for other definitions. @emptyDef@ has+-- no reserved names or operators, is case sensitive and doesn't accept+-- comments, identifiers or operators.++emptyDef   :: LanguageDef st+emptyDef    = LanguageDef+               { commentStart   = ""+               , commentEnd     = ""+               , commentLine    = ""+               , nestedComments = True+               , identStart     = letter <|> char '_'+               , identLetter    = alphaNum <|> oneOf "_'"+               , opStart        = opLetter emptyDef+               , opLetter       = oneOf ":!#$%&*+./<=>?@\\^|-~"+               , reservedOpNames= []+               , reservedNames  = []+               , caseSensitive  = True+               }++++-----------------------------------------------------------+-- Haskell+-----------------------------------------------------------++-- | A lexer for the haskell language.++haskell :: TokenParser st+haskell      = makeTokenParser haskellDef++-- | The language definition for the Haskell language.++haskellDef  :: LanguageDef st+haskellDef   = haskell98Def+	        { identLetter	 = identLetter haskell98Def <|> char '#'+	        , reservedNames	 = reservedNames haskell98Def +++    				   ["foreign","import","export","primitive"+    				   ,"_ccall_","_casm_"+    				   ,"forall"+    				   ]+                }++-- | The language definition for the language Haskell98.++haskell98Def :: LanguageDef st+haskell98Def = haskellStyle+                { reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"]+                , reservedNames  = ["let","in","case","of","if","then","else",+                                    "data","type",+                                    "class","default","deriving","do","import",+                                    "infix","infixl","infixr","instance","module",+                                    "newtype","where",+                                    "primitive"+                                    -- "as","qualified","hiding"+                                   ]+                }+++-----------------------------------------------------------+-- Mondrian+-----------------------------------------------------------++-- | A lexer for the mondrian language.++mondrian :: TokenParser st+mondrian    = makeTokenParser mondrianDef++-- | The language definition for the language Mondrian.++mondrianDef :: LanguageDef st+mondrianDef = javaStyle+		{ reservedNames = [ "case", "class", "default", "extends"+				  , "import", "in", "let", "new", "of", "package"+				  ]+                , caseSensitive  = True+		}

@@ -0,0 +1,181 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Perm+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable (uses existentially quantified data constructors)+-- +-- This module implements permutation parsers. The algorithm used+-- is fairly complex since we push the type system to its limits :-)+-- The algorithm is described in:+-- +-- /Parsing Permutation Phrases,/+-- by Arthur Baars, Andres Loh and Doaitse Swierstra.+-- Published as a functional pearl at the Haskell Workshop 2001.+-- +-----------------------------------------------------------------------------++{-# LANGUAGE ExistentialQuantification #-}++module Text.Parsec.Perm+    ( PermParser+    , StreamPermParser -- abstract++    , permute+    , (<||>), (<$$>)+    , (<|?>), (<$?>)+    ) where++import Text.Parsec++import Control.Monad.Identity++infixl 1 <||>, <|?>+infixl 2 <$$>, <$?>+++{---------------------------------------------------------------+  test -- parse a permutation of+  * an optional string of 'a's+  * a required 'b'+  * an optional 'c'+---------------------------------------------------------------}+{-+test input+  = parse (do{ x <- ptest; eof; return x }) "" input++ptest :: Parser (String,Char,Char)+ptest+  = permute $+    (,,) <$?> ("",many1 (char 'a'))+         <||> char 'b'+         <|?> ('_',char 'c')+-}++{---------------------------------------------------------------+  Building a permutation parser+---------------------------------------------------------------}++-- | The expression @perm \<||> p@ adds parser @p@ to the permutation+-- parser @perm@. The parser @p@ is not allowed to accept empty input -+-- use the optional combinator ('<|?>') instead. Returns a+-- new permutation parser that includes @p@. ++(<||>) :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b+(<||>) perm p     = add perm p++-- | The expression @f \<$$> p@ creates a fresh permutation parser+-- consisting of parser @p@. The the final result of the permutation+-- parser is the function @f@ applied to the return value of @p@. The+-- parser @p@ is not allowed to accept empty input - use the optional+-- combinator ('<$?>') instead.+--+-- If the function @f@ takes more than one parameter, the type variable+-- @b@ is instantiated to a functional type which combines nicely with+-- the adds parser @p@ to the ('<||>') combinator. This+-- results in stylized code where a permutation parser starts with a+-- combining function @f@ followed by the parsers. The function @f@+-- gets its parameters in the order in which the parsers are specified,+-- but actual input can be in any order.++(<$$>) :: (Stream s Identity tok) => (a -> b) -> Parsec s st a -> StreamPermParser s st b+(<$$>) f p        = newperm f <||> p++-- | The expression @perm \<||> (x,p)@ adds parser @p@ to the+-- permutation parser @perm@. The parser @p@ is optional - if it can+-- not be applied, the default value @x@ will be used instead. Returns+-- a new permutation parser that includes the optional parser @p@. ++(<|?>) :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> (a, Parsec s st a) -> StreamPermParser s st b+(<|?>) perm (x,p) = addopt perm x p++-- | The expression @f \<$?> (x,p)@ creates a fresh permutation parser+-- consisting of parser @p@. The the final result of the permutation+-- parser is the function @f@ applied to the return value of @p@. The+-- parser @p@ is optional - if it can not be applied, the default value+-- @x@ will be used instead. ++(<$?>) :: (Stream s Identity tok) => (a -> b) -> (a, Parsec s st a) -> StreamPermParser s st b+(<$?>) f (x,p)    = newperm f <|?> (x,p)++{---------------------------------------------------------------+  The permutation tree+---------------------------------------------------------------}++-- | Provided for backwards compatibility.  The tok type is ignored.++type PermParser tok st a = StreamPermParser String st a++-- | The type @StreamPermParser s st a@ denotes a permutation parser that,+-- when converted by the 'permute' function, parses +-- @s@ streams with user state @st@ and returns a value of+-- type @a@ on success.+--+-- Normally, a permutation parser is first build with special operators+-- like ('<||>') and than transformed into a normal parser+-- using 'permute'.++data StreamPermParser s st a = Perm (Maybe a) [StreamBranch s st a]++-- type Branch st a = StreamBranch String st a++data StreamBranch s st a = forall b. Branch (StreamPermParser s st (b -> a)) (Parsec s st b)++-- | The parser @permute perm@ parses a permutation of parser described+-- by @perm@. For example, suppose we want to parse a permutation of:+-- an optional string of @a@'s, the character @b@ and an optional @c@.+-- This can be described by:+--+-- >  test  = permute (tuple <$?> ("",many1 (char 'a'))+-- >                         <||> char 'b' +-- >                         <|?> ('_',char 'c'))+-- >        where+-- >          tuple a b c  = (a,b,c)++-- transform a permutation tree into a normal parser+permute :: (Stream s Identity tok) => StreamPermParser s st a -> Parsec s st a+permute (Perm def xs)+  = choice (map branch xs ++ empty)+  where+    empty+      = case def of+          Nothing -> []+          Just x  -> [return x]++    branch (Branch perm p)+      = do{ x <- p+          ; f <- permute perm+          ; return (f x)+          }++-- build permutation trees+newperm :: (Stream s Identity tok) => (a -> b) -> StreamPermParser s st (a -> b)+newperm f+  = Perm (Just f) []++add :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b+add perm@(Perm _mf fs) p+  = Perm Nothing (first:map insert fs)+  where+    first   = Branch perm p+    insert (Branch perm' p')+            = Branch (add (mapPerms flip perm') p) p'++addopt :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> a -> Parsec s st a -> StreamPermParser s st b+addopt perm@(Perm mf fs) x p+  = Perm (fmap ($ x) mf) (first:map insert fs)+  where+    first   = Branch perm p+    insert (Branch perm' p')+            = Branch (addopt (mapPerms flip perm') x p) p'+++mapPerms :: (Stream s Identity tok) => (a -> b) -> StreamPermParser s st a -> StreamPermParser s st b+mapPerms f (Perm x xs)+  = Perm (fmap f x) (map mapBranch xs)+  where+    mapBranch (Branch perm p)+      = Branch (mapPerms (f.) perm) p

@@ -0,0 +1,125 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Pos+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+-- +-- Textual source positions.+-- +-----------------------------------------------------------------------------++module Text.Parsec.Pos+    ( SourceName, Line, Column+    , SourcePos+    , sourceLine, sourceColumn, sourceName+    , incSourceLine, incSourceColumn+    , setSourceLine, setSourceColumn, setSourceName+    , newPos, initialPos+    , updatePosChar, updatePosString+    ) where++import Data.Generics++-- < Source positions: a file name, a line and a column+-- upper left is (1,1)++type SourceName = String+type Line       = Int+type Column     = Int++-- | The abstract data type @SourcePos@ represents source positions. It+-- contains the name of the source (i.e. file name), a line number and+-- a column number. @SourcePos@ is an instance of the 'Show', 'Eq' and+-- 'Ord' class. ++data SourcePos  = SourcePos SourceName !Line !Column+    deriving ( Eq, Ord, Data, Typeable)++-- | Create a new 'SourcePos' with the given source name,+-- line number and column number.++newPos :: SourceName -> Line -> Column -> SourcePos+newPos name line column+    = SourcePos name line column++-- | Create a new 'SourcePos' with the given source name,+-- and line number and column number set to 1, the upper left.++initialPos :: SourceName -> SourcePos+initialPos name+    = newPos name 1 1++-- | Extracts the name of the source from a source position. ++sourceName :: SourcePos -> SourceName+sourceName (SourcePos name _line _column) = name++-- | Extracts the line number from a source position. ++sourceLine :: SourcePos -> Line+sourceLine (SourcePos _name line _column) = line++-- | Extracts the column number from a source position. ++sourceColumn :: SourcePos -> Column+sourceColumn (SourcePos _name _line column) = column++-- | Increments the line number of a source position. ++incSourceLine :: SourcePos -> Line -> SourcePos+incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column++-- | Increments the column number of a source position. ++incSourceColumn :: SourcePos -> Column -> SourcePos+incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n)++-- | Set the name of the source.++setSourceName :: SourcePos -> SourceName -> SourcePos+setSourceName (SourcePos _name line column) n = SourcePos n line column++-- | Set the line number of a source position. ++setSourceLine :: SourcePos -> Line -> SourcePos+setSourceLine (SourcePos name _line column) n = SourcePos name n column++-- | Set the column number of a source position. ++setSourceColumn :: SourcePos -> Column -> SourcePos+setSourceColumn (SourcePos name line _column) n = SourcePos name line n++-- | The expression @updatePosString pos s@ updates the source position+-- @pos@ by calling 'updatePosChar' on every character in @s@, ie.+-- @foldl updatePosChar pos string@. ++updatePosString :: SourcePos -> String -> SourcePos+updatePosString pos string+    = foldl updatePosChar pos string++-- | Update a source position given a character. If the character is a+-- newline (\'\\n\') or carriage return (\'\\r\') the line number is+-- incremented by 1. If the character is a tab (\'\t\') the column+-- number is incremented to the nearest 8'th column, ie. @column + 8 -+-- ((column-1) \`mod\` 8)@. In all other cases, the column is+-- incremented by 1. ++updatePosChar   :: SourcePos -> Char -> SourcePos+updatePosChar (SourcePos name line column) c+    = case c of+        '\n' -> SourcePos name (line+1) 1+        '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8))+        _    -> SourcePos name line (column + 1)++instance Show SourcePos where+  show (SourcePos name line column)+    | null name = showLineColumn+    | otherwise = "\"" ++ name ++ "\" " ++ showLineColumn+    where+      showLineColumn    = "(line " ++ show line +++                          ", column " ++ show column +++                          ")"

@@ -0,0 +1,725 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Prim+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+-- +-- The primitive parser combinators.+-- +-----------------------------------------------------------------------------   ++{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts,+             UndecidableInstances #-}++module Text.Parsec.Prim+    ( unknownError+    , sysUnExpectError+    , unexpected+    , ParsecT+    , runParsecT+    , mkPT+    , Parsec+    , Consumed(..)+    , Reply(..)+    , State(..)+    , parsecMap+    , parserReturn+    , parserBind+    , mergeErrorReply+    , parserFail+    , parserZero+    , parserPlus+    , (<?>)+    , (<|>)+    , label+    , labels+    , Stream(..)+    , tokens+    , try+    , token+    , tokenPrim+    , tokenPrimEx+    , many+    , skipMany+    , manyAccum+    , runPT+    , runP+    , runParserT+    , runParser+    , parse+    , parseTest+    , getPosition+    , getInput+    , setPosition+    , setInput+    , getParserState+    , setParserState+    , updateParserState+    , getState+    , putState+    , modifyState+    , setState+    , updateState+    ) where++import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) )+import Control.Monad()+import Control.Monad.Trans+import Control.Monad.Identity++import Control.Monad.Reader.Class+import Control.Monad.State.Class+import Control.Monad.Cont.Class+import Control.Monad.Error.Class++import Text.Parsec.Pos+import Text.Parsec.Error++unknownError :: State s u -> ParseError+unknownError state        = newErrorUnknown (statePos state)++sysUnExpectError :: String -> SourcePos -> Reply s u a+sysUnExpectError msg pos  = Error (newErrorMessage (SysUnExpect msg) pos)++-- | The parser @unexpected msg@ always fails with an unexpected error+-- message @msg@ without consuming any input.+--+-- The parsers 'fail', ('<?>') and @unexpected@ are the three parsers+-- used to generate error messages. Of these, only ('<?>') is commonly+-- used. For an example of the use of @unexpected@, see the definition+-- of 'Text.Parsec.Combinator.notFollowedBy'.++unexpected :: (Stream s m t) => String -> ParsecT s u m a+unexpected msg+    = ParsecT $ \s _ _ _ eerr ->+      eerr $ newErrorMessage (UnExpect msg) (statePos s)++-- | ParserT monad transformer and Parser type++-- | @ParsecT s u m a@ is a parser with stream type @s@, user state type @u@,+-- underlying monad @m@ and return type @a@.  Parsec is strict in the user state.+-- If this is undesirable, simply used a data type like @data Box a = Box a@ and+-- the state type @Box YourStateType@ to add a level of indirection.++newtype ParsecT s u m a+    = ParsecT {unParser :: forall b .+                 State s u+              -> (a -> State s u -> ParseError -> m b) -- consumed ok+              -> (ParseError -> m b)                   -- consumed err+              -> (a -> State s u -> ParseError -> m b) -- empty ok+              -> (ParseError -> m b)                   -- empty err+              -> m b+             }++-- | Low-level unpacking of the ParsecT type. To run your parser, please look to+-- runPT, runP, runParserT, runParser and other such functions.+runParsecT :: Monad m => ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))+runParsecT p s = unParser p s cok cerr eok eerr+    where cok a s' err = return . Consumed . return $ Ok a s' err+          cerr err = return . Consumed . return $ Error err+          eok a s' err = return . Empty . return $ Ok a s' err+          eerr err = return . Empty . return $ Error err++-- | Low-level creation of the ParsecT type. You really shouldn't have to do this.+mkPT :: Monad m => (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a+mkPT k = ParsecT $ \s cok cerr eok eerr -> do+           cons <- k s+           case cons of+             Consumed mrep -> do+                       rep <- mrep+                       case rep of+                         Ok x s' err -> cok x s' err+                         Error err -> cerr err+             Empty mrep -> do+                       rep <- mrep+                       case rep of+                         Ok x s' err -> eok x s' err+                         Error err -> eerr err++type Parsec s u = ParsecT s u Identity++data Consumed a  = Consumed a+                 | Empty !a++data Reply s u a = Ok a !(State s u) ParseError+                 | Error ParseError++data State s u = State {+      stateInput :: s,+      statePos   :: !SourcePos,+      stateUser  :: !u+    }++instance Functor Consumed where+    fmap f (Consumed x) = Consumed (f x)+    fmap f (Empty x)    = Empty (f x)++instance Functor (Reply s u) where+    fmap f (Ok x s e) = Ok (f x) s e+    fmap _ (Error e) = Error e -- XXX++instance Functor (ParsecT s u m) where+    fmap f p = parsecMap f p++parsecMap :: (a -> b) -> ParsecT s u m a -> ParsecT s u m b+parsecMap f p+    = ParsecT $ \s cok cerr eok eerr ->+      unParser p s (cok . f) cerr (eok . f) eerr++instance Applicative.Applicative (ParsecT s u m) where+    pure = return+    (<*>) = ap -- TODO: Can this be optimized?++instance Applicative.Alternative (ParsecT s u m) where+    empty = mzero+    (<|>) = mplus++instance Monad (ParsecT s u m) where+    return x = parserReturn x+    p >>= f  = parserBind p f+    fail msg = parserFail msg++instance (MonadIO m) => MonadIO (ParsecT s u m) where+    liftIO = lift . liftIO++instance (MonadReader r m) => MonadReader r (ParsecT s u m) where+    ask = lift ask+    local f p = mkPT $ \s -> local f (runParsecT p s)++-- I'm presuming the user might want a separate, non-backtracking+-- state aside from the Parsec user state.+instance (MonadState s m) => MonadState s (ParsecT s' u m) where+    get = lift get+    put = lift . put++instance (MonadCont m) => MonadCont (ParsecT s u m) where+    callCC f = mkPT $ \s ->+          callCC $ \c ->+          runParsecT (f (\a -> mkPT $ \s' -> c (pack s' a))) s++     where pack s a= Empty $ return (Ok a s (unknownError s))++instance (MonadError e m) => MonadError e (ParsecT s u m) where+    throwError = lift . throwError+    p `catchError` h = mkPT $ \s ->+        runParsecT p s `catchError` \e ->+            runParsecT (h e) s++parserReturn :: a -> ParsecT s u m a+parserReturn x+    = ParsecT $ \s _ _ eok _ ->+      eok x s (unknownError s)++parserBind :: ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b+{-# INLINE parserBind #-}+parserBind m k+  = ParsecT $ \s cok cerr eok eerr ->+    let+        -- consumed-okay case for m+        mcok x s err =+            let+                 -- if (k x) consumes, those go straigt up+                 pcok = cok+                 pcerr = cerr+                                               +                 -- if (k x) doesn't consume input, but is okay,+                 -- we still return in the consumed continuation+                 peok = cok++                 -- if (k x) doesn't consume input, but errors,+                 -- we return the error in the 'consumed-error'+                 -- continuation+                 peerr err' = cerr (mergeError err err')+            in  unParser (k x) s pcok pcerr peok peerr                      ++        -- empty-ok case for m+        meok x s err =+            let+                -- in these cases, (k x) can return as empty+                pcok = cok+                peok = eok+                pcerr = cerr+                peerr err' = eerr (mergeError err err') +            in  unParser (k x) s pcok pcerr peok peerr+        -- consumed-error case for m+        mcerr = cerr++        -- empty-error case for m+        meerr = eerr++    in unParser m s mcok mcerr meok meerr+++mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a+mergeErrorReply err1 reply -- XXX where to put it?+    = case reply of+        Ok x state err2 -> Ok x state (mergeError err1 err2)+        Error err2      -> Error (mergeError err1 err2)++parserFail :: String -> ParsecT s u m a+parserFail msg+    = ParsecT $ \s _ _ _ eerr ->+      eerr $ newErrorMessage (Message msg) (statePos s)++instance MonadPlus (ParsecT s u m) where+    mzero = parserZero+    mplus p1 p2 = parserPlus p1 p2++-- | @parserZero@ always fails without consuming any input. @parserZero@ is defined+-- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member +-- of the 'Control.Applicative.Applicative' class.++parserZero :: ParsecT s u m a+parserZero+    = ParsecT $ \s _ _ _ eerr ->+      eerr $ unknownError s++parserPlus :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a+{-# INLINE parserPlus #-}+parserPlus m n+    = ParsecT $ \s cok cerr eok eerr ->+      let+          meerr err =+              let+                  neok y s' err' = eok y s' (mergeError err err')+                  neerr err' = eerr $ mergeError err err'+              in unParser n s cok cerr neok neerr+      in unParser m s cok cerr eok meerr++instance MonadTrans (ParsecT s u) where+    lift amb = ParsecT $ \s _ _ eok _ -> do+               a <- amb+               eok a s $ unknownError s++infix  0 <?>+infixr 1 <|>++-- | The parser @p <?> msg@ behaves as parser @p@, but whenever the+-- parser @p@ fails /without consuming any input/, it replaces expect+-- error messages with the expect error message @msg@.+--+-- This is normally used at the end of a set alternatives where we want+-- to return an error message in terms of a higher level construct+-- rather than returning all possible characters. For example, if the+-- @expr@ parser from the 'try' example would fail, the error+-- message is: '...: expecting expression'. Without the @(\<?>)@+-- combinator, the message would be like '...: expecting \"let\" or+-- letter', which is less friendly.++(<?>) :: (ParsecT s u m a) -> String -> (ParsecT s u m a)+p <?> msg = label p msg++-- | This combinator implements choice. The parser @p \<|> q@ first+-- applies @p@. If it succeeds, the value of @p@ is returned. If @p@+-- fails /without consuming any input/, parser @q@ is tried. This+-- combinator is defined equal to the 'mplus' member of the 'MonadPlus'+-- class and the ('Control.Applicative.<|>') member of 'Control.Applicative.Alternative'.+--+-- The parser is called /predictive/ since @q@ is only tried when+-- parser @p@ didn't consume any input (i.e.. the look ahead is 1).+-- This non-backtracking behaviour allows for both an efficient+-- implementation of the parser combinators and the generation of good+-- error messages.++(<|>) :: (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)+p1 <|> p2 = mplus p1 p2++label :: ParsecT s u m a -> String -> ParsecT s u m a+label p msg+  = labels p [msg]++labels :: ParsecT s u m a -> [String] -> ParsecT s u m a+labels p msgs =+    ParsecT $ \s cok cerr eok eerr ->+    let eok' x s' error = eok x s' $ if errorIsUnknown error+                  then error+                  else setExpectErrors error msgs+        eerr' err = eerr $ setExpectErrors err msgs++    in unParser p s cok cerr eok' eerr'++ where+   setExpectErrors err []         = setErrorMessage (Expect "") err+   setExpectErrors err [msg]      = setErrorMessage (Expect msg) err+   setExpectErrors err (msg:msgs)+       = foldr (\msg' err' -> addErrorMessage (Expect msg') err')+         (setErrorMessage (Expect msg) err) msgs++-- TODO: There should be a stronger statement that can be made about this++-- | An instance of @Stream@ has stream type @s@, underlying monad @m@ and token type @t@ determined by the stream+-- +-- Some rough guidelines for a \"correct\" instance of Stream:+--+--    * unfoldM uncons gives the [t] corresponding to the stream+--+--    * A @Stream@ instance is responsible for maintaining the \"position within the stream\" in the stream state @s@.  This is trivial unless you are using the monad in a non-trivial way.++class (Monad m) => Stream s m t | s -> t where+    uncons :: s -> m (Maybe (t,s))++tokens :: (Stream s m t, Eq t)+       => ([t] -> String)      -- Pretty print a list of tokens+       -> (SourcePos -> [t] -> SourcePos)+       -> [t]                  -- List of tokens to parse+       -> ParsecT s u m [t]+{-# INLINE tokens #-}+tokens _ _ []+    = ParsecT $ \s _ _ eok _ ->+      eok [] s $ unknownError s+tokens showTokens nextposs tts@(tok:toks)+    = ParsecT $ \(State input pos u) cok cerr eok eerr -> +    let+        errEof = (setErrorMessage (Expect (showTokens tts))+                  (newErrorMessage (SysUnExpect "") pos))++        errExpect x = (setErrorMessage (Expect (showTokens tts))+                       (newErrorMessage (SysUnExpect (showTokens [x])) pos))++        walk []     rs = ok rs+        walk (t:ts) rs = do+          sr <- uncons rs+          case sr of+            Nothing                 -> cerr $ errEof+            Just (x,xs) | t == x    -> walk ts xs+                        | otherwise -> cerr $ errExpect x++        ok rs = let pos' = nextposs pos tts+                    s' = State rs pos' u+                in cok tts s' (newErrorUnknown pos')+    in do+        sr <- uncons input+        case sr of+            Nothing         -> eerr $ errEof+            Just (x,xs)+                | tok == x  -> walk toks xs+                | otherwise -> eerr $ errExpect x+        +-- | The parser @try p@ behaves like parser @p@, except that it+-- pretends that it hasn't consumed any input when an error occurs.+--+-- This combinator is used whenever arbitrary look ahead is needed.+-- Since it pretends that it hasn't consumed any input when @p@ fails,+-- the ('<|>') combinator will try its second alternative even when the+-- first parser failed while consuming input.+--+-- The @try@ combinator can for example be used to distinguish+-- identifiers and reserved words. Both reserved words and identifiers+-- are a sequence of letters. Whenever we expect a certain reserved+-- word where we can also expect an identifier we have to use the @try@+-- combinator. Suppose we write:+--+-- >  expr        = letExpr <|> identifier <?> "expression"+-- >+-- >  letExpr     = do{ string "let"; ... }+-- >  identifier  = many1 letter+--+-- If the user writes \"lexical\", the parser fails with: @unexpected+-- \'x\', expecting \'t\' in \"let\"@. Indeed, since the ('<|>') combinator+-- only tries alternatives when the first alternative hasn't consumed+-- input, the @identifier@ parser is never tried (because the prefix+-- \"le\" of the @string \"let\"@ parser is already consumed). The+-- right behaviour can be obtained by adding the @try@ combinator:+--+-- >  expr        = letExpr <|> identifier <?> "expression"+-- >+-- >  letExpr     = do{ try (string "let"); ... }+-- >  identifier  = many1 letter++try :: ParsecT s u m a -> ParsecT s u m a+try p =+    ParsecT $ \s@(State _ pos _) cok _ eok eerr ->+    let pcerr parseError = eerr $ setErrorPos pos parseError +    in unParser p s cok pcerr eok eerr++-- | The parser @token showTok posFromTok testTok@ accepts a token @t@+-- with result @x@ when the function @testTok t@ returns @'Just' x@. The+-- source position of the @t@ should be returned by @posFromTok t@ and+-- the token can be shown using @showTok t@.+--+-- This combinator is expressed in terms of 'tokenPrim'.+-- It is used to accept user defined token streams. For example,+-- suppose that we have a stream of basic tokens tupled with source+-- positions. We can than define a parser that accepts single tokens as:+--+-- >  mytoken x+-- >    = token showTok posFromTok testTok+-- >    where+-- >      showTok (pos,t)     = show t+-- >      posFromTok (pos,t)  = pos+-- >      testTok (pos,t)     = if x == t then Just t else Nothing++token :: (Stream s Identity t)+      => (t -> String)            -- ^ Token pretty-printing function.+      -> (t -> SourcePos)         -- ^ Computes the position of a token.+      -> (t -> Maybe a)           -- ^ Matching function for the token to parse.+      -> Parsec s u a+token showToken tokpos test = tokenPrim showToken nextpos test+    where+        nextpos _ tok ts = case runIdentity (uncons ts) of+                             Nothing -> tokpos tok+                             Just (tok',_) -> tokpos tok'++-- | The parser @token showTok nextPos testTok@ accepts a token @t@+-- with result @x@ when the function @testTok t@ returns @'Just' x@. The+-- token can be shown using @showTok t@. The position of the /next/+-- token should be returned when @nextPos@ is called with the current+-- source position @pos@, the current token @t@ and the rest of the+-- tokens @toks@, @nextPos pos t toks@.+--+-- This is the most primitive combinator for accepting tokens. For+-- example, the 'Text.Parsec.Char.char' parser could be implemented as:+--+-- >  char c+-- >    = tokenPrim showChar nextPos testChar+-- >    where+-- >      showChar x        = "'" ++ x ++ "'"+-- >      testChar x        = if x == c then Just x else Nothing+-- >      nextPos pos x xs  = updatePosChar pos x++tokenPrim :: (Stream s m t)+          => (t -> String)                      -- ^ Token pretty-printing function.+          -> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function.+          -> (t -> Maybe a)                     -- ^ Matching function for the token to parse.+          -> ParsecT s u m a+{-# INLINE tokenPrim #-}+tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test++tokenPrimEx :: (Stream s m t)+            => (t -> String)      +            -> (SourcePos -> t -> s -> SourcePos)+            -> Maybe (SourcePos -> t -> s -> u -> u)+            -> (t -> Maybe a)     +            -> ParsecT s u m a+{-# INLINE tokenPrimEx #-}+tokenPrimEx showToken nextpos Nothing test+  = ParsecT $ \(State input pos user) cok cerr eok eerr -> do+      r <- uncons input+      case r of+        Nothing -> eerr $ unexpectError "" pos+        Just (c,cs)+         -> case test c of+              Just x -> let newpos = nextpos pos c cs+                            newstate = State cs newpos user+                        in seq newpos $ seq newstate $+                           cok x newstate (newErrorUnknown newpos)+              Nothing -> eerr $ unexpectError (showToken c) pos+tokenPrimEx showToken nextpos (Just nextState) test+  = ParsecT $ \(State input pos user) cok cerr eok eerr -> do+      r <- uncons input+      case r of+        Nothing -> eerr $ unexpectError "" pos+        Just (c,cs)+         -> case test c of+              Just x -> let newpos = nextpos pos c cs+                            newUser = nextState pos c cs user+                            newstate = State cs newpos newUser+                        in seq newpos $ seq newstate $+                           cok x newstate $ newErrorUnknown newpos+              Nothing -> eerr $ unexpectError (showToken c) pos++unexpectError msg pos = newErrorMessage (SysUnExpect msg) pos+++-- | @many p@ applies the parser @p@ /zero/ or more times. Returns a+--    list of the returned values of @p@.+--+-- >  identifier  = do{ c  <- letter+-- >                  ; cs <- many (alphaNum <|> char '_')+-- >                  ; return (c:cs)+-- >                  }++many :: ParsecT s u m a -> ParsecT s u m [a]+many p+  = do xs <- manyAccum (:) p+       return (reverse xs)++-- | @skipMany p@ applies the parser @p@ /zero/ or more times, skipping+-- its result.+--+-- >  spaces  = skipMany space++skipMany :: ParsecT s u m a -> ParsecT s u m ()+skipMany p+  = do manyAccum (\_ _ -> []) p+       return ()++manyAccum :: (a -> [a] -> [a])+          -> ParsecT s u m a+          -> ParsecT s u m [a]+manyAccum acc p =+    ParsecT $ \s cok cerr eok eerr ->+    let walk xs x s' err =+            unParser p s'+              (seq xs $ walk $ acc x xs)  -- consumed-ok+              cerr                        -- consumed-err+              manyErr                     -- empty-ok+              (\e -> cok (acc x xs) s' e) -- empty-err+    in unParser p s (walk []) cerr manyErr (\e -> eok [] s e)++manyErr = error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."+++-- < Running a parser: monadic (runPT) and pure (runP)++runPT :: (Stream s m t)+      => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)+runPT p u name s+    = do res <- runParsecT p (State s (initialPos name) u)+         r <- parserReply res+         case r of+           Ok x _ _  -> return (Right x)+           Error err -> return (Left err)+    where+        parserReply res+            = case res of+                Consumed r -> r+                Empty    r -> r++runP :: (Stream s Identity t)+     => Parsec s u a -> u -> SourceName -> s -> Either ParseError a+runP p u name s = runIdentity $ runPT p u name s++-- | The most general way to run a parser. @runParserT p state filePath+-- input@ runs parser @p@ on the input list of tokens @input@,+-- obtained from source @filePath@ with the initial user state @st@.+-- The @filePath@ is only used in error messages and may be the empty+-- string. Returns a computation in the underlying monad @m@ that return either a 'ParseError' ('Left') or a+-- value of type @a@ ('Right').++runParserT :: (Stream s m t)+           => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)+runParserT = runPT++-- | The most general way to run a parser over the Identity monad. @runParser p state filePath+-- input@ runs parser @p@ on the input list of tokens @input@,+-- obtained from source @filePath@ with the initial user state @st@.+-- The @filePath@ is only used in error messages and may be the empty+-- string. Returns either a 'ParseError' ('Left') or a+-- value of type @a@ ('Right').+--+-- >  parseFromFile p fname+-- >    = do{ input <- readFile fname+-- >        ; return (runParser p () fname input)+-- >        }++runParser :: (Stream s Identity t)+          => Parsec s u a -> u -> SourceName -> s -> Either ParseError a+runParser = runP++-- | @parse p filePath input@ runs a parser @p@ over Identity without user+-- state. The @filePath@ is only used in error messages and may be the+-- empty string. Returns either a 'ParseError' ('Left')+-- or a value of type @a@ ('Right').+--+-- >  main    = case (parse numbers "" "11, 2, 43") of+-- >             Left err  -> print err+-- >             Right xs  -> print (sum xs)+-- >+-- >  numbers = commaSep integer++parse :: (Stream s Identity t)+      => Parsec s () a -> SourceName -> s -> Either ParseError a+parse p = runP p ()++-- | The expression @parseTest p input@ applies a parser @p@ against+-- input @input@ and prints the result to stdout. Used for testing+-- parsers.++parseTest :: (Stream s Identity t, Show a)+          => Parsec s () a -> s -> IO ()+parseTest p input+    = case parse p "" input of+        Left err -> do putStr "parse error at "+                       print err+        Right x  -> print x++-- < Parser state combinators++-- | Returns the current source position. See also 'SourcePos'.++getPosition :: (Monad m) => ParsecT s u m SourcePos+getPosition = do state <- getParserState+                 return (statePos state)++-- | Returns the current input ++getInput :: (Monad m) => ParsecT s u m s+getInput = do state <- getParserState+              return (stateInput state)++-- | @setPosition pos@ sets the current source position to @pos@. ++setPosition :: (Monad m) => SourcePos -> ParsecT s u m ()+setPosition pos+    = do updateParserState (\(State input _ user) -> State input pos user)+         return ()++-- | @setInput input@ continues parsing with @input@. The 'getInput' and+-- @setInput@ functions can for example be used to deal with #include+-- files. ++setInput :: (Monad m) => s -> ParsecT s u m ()+setInput input+    = do updateParserState (\(State _ pos user) -> State input pos user)+         return ()++-- | Returns the full parser state as a 'State' record.++getParserState :: (Monad m) => ParsecT s u m (State s u)+getParserState = updateParserState id++-- | @setParserState st@ set the full parser state to @st@. ++setParserState :: (Monad m) => State s u -> ParsecT s u m (State s u)+setParserState st = updateParserState (const st)++-- | @updateParserState f@ applies function @f@ to the parser state.++updateParserState :: (State s u -> State s u) -> ParsecT s u m (State s u)+updateParserState f =+    ParsecT $ \s _ _ eok _ ->+    let s' = f s +    in eok s' s' $ unknownError s' ++-- < User state combinators++-- | Returns the current user state. ++getState :: (Monad m) => ParsecT s u m u+getState = stateUser `liftM` getParserState++-- | @putState st@ set the user state to @st@. ++putState :: (Monad m) => u -> ParsecT s u m ()+putState u = do updateParserState $ \s -> s { stateUser = u }+                return ()++-- | @updateState f@ applies function @f@ to the user state. Suppose+-- that we want to count identifiers in a source, we could use the user+-- state as:+--+-- >  expr  = do{ x <- identifier+-- >            ; updateState (+1)+-- >            ; return (Id x)+-- >            }++modifyState :: (Monad m) => (u -> u) -> ParsecT s u m ()+modifyState f = do updateParserState $ \s -> s { stateUser = f (stateUser s) }+                   return ()++-- XXX Compat++-- | An alias for putState for backwards compatibility.++setState :: (Monad m) => u -> ParsecT s u m ()+setState = putState++-- | An alias for modifyState for backwards compatibility.++updateState :: (Monad m) => (u -> u) -> ParsecT s u m ()+updateState = modifyState

@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.String+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+-- +-- Make Strings an instance of 'Stream' with 'Char' token type.+--+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.Parsec.String+    ( Parser, GenParser, parseFromFile+    ) where++import Text.Parsec.Error+import Text.Parsec.Prim++instance (Monad m) => Stream [tok] m tok where+    uncons []     = return $ Nothing+    uncons (t:ts) = return $ Just (t,ts)+    {-# INLINE uncons #-}++type Parser = Parsec String ()+type GenParser tok st = Parsec [tok] st++-- | @parseFromFile p filePath@ runs a string parser @p@ on the+-- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }+parseFromFile :: Parser a -> String -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- readFile fname+         return (runP p () fname input)

@@ -0,0 +1,722 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Token+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+-- +-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable (uses local universal quantification: PolymorphicComponents)+-- +-- A helper module to parse lexical elements (tokens). See 'makeTokenParser'+-- for a description of how to use it.+-- +-----------------------------------------------------------------------------++{-# LANGUAGE PolymorphicComponents #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Text.Parsec.Token+    ( LanguageDef+    , GenLanguageDef (..)+    , TokenParser+    , GenTokenParser (..)+    , makeTokenParser+    ) where++import Data.Char ( isAlpha, toLower, toUpper, isSpace, digitToInt )+import Data.List ( nub, sort )+import Control.Monad.Identity+import Text.Parsec.Prim+import Text.Parsec.Char+import Text.Parsec.Combinator++-----------------------------------------------------------+-- Language Definition+-----------------------------------------------------------++type LanguageDef st = GenLanguageDef String st Identity++-- | The @GenLanguageDef@ type is a record that contains all parameterizable+-- features of the 'Text.Parsec.Token' module. The module 'Text.Parsec.Language'+-- contains some default definitions.++data GenLanguageDef s u m+    = LanguageDef { +    +    -- | Describes the start of a block comment. Use the empty string if the+    -- language doesn't support block comments. For example \"\/*\". ++    commentStart   :: String,++    -- | Describes the end of a block comment. Use the empty string if the+    -- language doesn't support block comments. For example \"*\/\". ++    commentEnd     :: String,++    -- | Describes the start of a line comment. Use the empty string if the+    -- language doesn't support line comments. For example \"\/\/\". ++    commentLine    :: String,++    -- | Set to 'True' if the language supports nested block comments. ++    nestedComments :: Bool,++    -- | This parser should accept any start characters of identifiers. For+    -- example @letter \<|> char \"_\"@. ++    identStart     :: ParsecT s u m Char,++    -- | This parser should accept any legal tail characters of identifiers.+    -- For example @alphaNum \<|> char \"_\"@. ++    identLetter    :: ParsecT s u m Char,++    -- | This parser should accept any start characters of operators. For+    -- example @oneOf \":!#$%&*+.\/\<=>?\@\\\\^|-~\"@ ++    opStart        :: ParsecT s u m Char,++    -- | This parser should accept any legal tail characters of operators.+    -- Note that this parser should even be defined if the language doesn't+    -- support user-defined operators, or otherwise the 'reservedOp'+    -- parser won't work correctly. ++    opLetter       :: ParsecT s u m Char,++    -- | The list of reserved identifiers. ++    reservedNames  :: [String],++    -- | The list of reserved operators. ++    reservedOpNames:: [String],++    -- | Set to 'True' if the language is case sensitive. ++    caseSensitive  :: Bool++    }++-----------------------------------------------------------+-- A first class module: TokenParser+-----------------------------------------------------------++type TokenParser st = GenTokenParser String st Identity++-- | The type of the record that holds lexical parsers that work on+-- @s@ streams with state @u@ over a monad @m@.++data GenTokenParser s u m+    = TokenParser {++        -- | This lexeme parser parses a legal identifier. Returns the identifier+        -- string. This parser will fail on identifiers that are reserved+        -- words. Legal identifier (start) characters and reserved words are+        -- defined in the 'LanguageDef' that is passed to+        -- 'makeTokenParser'. An @identifier@ is treated as+        -- a single token using 'try'.++        identifier       :: ParsecT s u m String,+        +        -- | The lexeme parser @reserved name@ parses @symbol +        -- name@, but it also checks that the @name@ is not a prefix of a+        -- valid identifier. A @reserved@ word is treated as a single token+        -- using 'try'. ++        reserved         :: String -> ParsecT s u m (),++        -- | This lexeme parser parses a legal operator. Returns the name of the+        -- operator. This parser will fail on any operators that are reserved+        -- operators. Legal operator (start) characters and reserved operators+        -- are defined in the 'LanguageDef' that is passed to+        -- 'makeTokenParser'. An @operator@ is treated as a+        -- single token using 'try'. ++        operator         :: ParsecT s u m String,++        -- |The lexeme parser @reservedOp name@ parses @symbol+        -- name@, but it also checks that the @name@ is not a prefix of a+        -- valid operator. A @reservedOp@ is treated as a single token using+        -- 'try'. ++        reservedOp       :: String -> ParsecT s u m (),+++        -- | This lexeme parser parses a single literal character. Returns the+        -- literal character value. This parsers deals correctly with escape+        -- sequences. The literal character is parsed according to the grammar+        -- rules defined in the Haskell report (which matches most programming+        -- languages quite closely). ++        charLiteral      :: ParsecT s u m Char,++        -- | This lexeme parser parses a literal string. Returns the literal+        -- string value. This parsers deals correctly with escape sequences and+        -- gaps. The literal string is parsed according to the grammar rules+        -- defined in the Haskell report (which matches most programming+        -- languages quite closely). ++        stringLiteral    :: ParsecT s u m String,++        -- | This lexeme parser parses a natural number (a positive whole+        -- number). Returns the value of the number. The number can be+        -- specified in 'decimal', 'hexadecimal' or+        -- 'octal'. The number is parsed according to the grammar+        -- rules in the Haskell report. ++        natural          :: ParsecT s u m Integer,++        -- | This lexeme parser parses an integer (a whole number). This parser+        -- is like 'natural' except that it can be prefixed with+        -- sign (i.e. \'-\' or \'+\'). Returns the value of the number. The+        -- number can be specified in 'decimal', 'hexadecimal'+        -- or 'octal'. The number is parsed according+        -- to the grammar rules in the Haskell report. +        +        integer          :: ParsecT s u m Integer,++        -- | This lexeme parser parses a floating point value. Returns the value+        -- of the number. The number is parsed according to the grammar rules+        -- defined in the Haskell report. ++        float            :: ParsecT s u m Double,++        -- | This lexeme parser parses either 'natural' or a 'float'.+        -- Returns the value of the number. This parsers deals with+        -- any overlap in the grammar rules for naturals and floats. The number+        -- is parsed according to the grammar rules defined in the Haskell report. ++        naturalOrFloat   :: ParsecT s u m (Either Integer Double),++        -- | Parses a positive whole number in the decimal system. Returns the+        -- value of the number. ++        decimal          :: ParsecT s u m Integer,++        -- | Parses a positive whole number in the hexadecimal system. The number+        -- should be prefixed with \"0x\" or \"0X\". Returns the value of the+        -- number. ++        hexadecimal      :: ParsecT s u m Integer,++        -- | Parses a positive whole number in the octal system. The number+        -- should be prefixed with \"0o\" or \"0O\". Returns the value of the+        -- number. ++        octal            :: ParsecT s u m Integer,++        -- | Lexeme parser @symbol s@ parses 'string' @s@ and skips+        -- trailing white space. ++        symbol           :: String -> ParsecT s u m String,++        -- | @lexeme p@ first applies parser @p@ and than the 'whiteSpace'+        -- parser, returning the value of @p@. Every lexical+        -- token (lexeme) is defined using @lexeme@, this way every parse+        -- starts at a point without white space. Parsers that use @lexeme@ are+        -- called /lexeme/ parsers in this document.+        -- +        -- The only point where the 'whiteSpace' parser should be+        -- called explicitly is the start of the main parser in order to skip+        -- any leading white space.+        --+        -- >    mainParser  = do{ whiteSpace+        -- >                     ; ds <- many (lexeme digit)+        -- >                     ; eof+        -- >                     ; return (sum ds)+        -- >                     }++        lexeme           :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Parses any white space. White space consists of /zero/ or more+        -- occurrences of a 'space', a line comment or a block (multi+        -- line) comment. Block comments may be nested. How comments are+        -- started and ended is defined in the 'LanguageDef'+        -- that is passed to 'makeTokenParser'. ++        whiteSpace       :: ParsecT s u m (),++        -- | Lexeme parser @parens p@ parses @p@ enclosed in parenthesis,+        -- returning the value of @p@.++        parens           :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Lexeme parser @braces p@ parses @p@ enclosed in braces (\'{\' and+        -- \'}\'), returning the value of @p@. ++        braces           :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Lexeme parser @angles p@ parses @p@ enclosed in angle brackets (\'\<\'+        -- and \'>\'), returning the value of @p@. ++        angles           :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Lexeme parser @brackets p@ parses @p@ enclosed in brackets (\'[\'+        -- and \']\'), returning the value of @p@. ++        brackets         :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | DEPRECATED: Use 'brackets'.++        squares          :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Lexeme parser |semi| parses the character \';\' and skips any+        -- trailing white space. Returns the string \";\". ++        semi             :: ParsecT s u m String,++        -- | Lexeme parser @comma@ parses the character \',\' and skips any+        -- trailing white space. Returns the string \",\". ++        comma            :: ParsecT s u m String,++        -- | Lexeme parser @colon@ parses the character \':\' and skips any+        -- trailing white space. Returns the string \":\". ++        colon            :: ParsecT s u m String,++        -- | Lexeme parser @dot@ parses the character \'.\' and skips any+        -- trailing white space. Returns the string \".\". ++        dot              :: ParsecT s u m String,++        -- | Lexeme parser @semiSep p@ parses /zero/ or more occurrences of @p@+        -- separated by 'semi'. Returns a list of values returned by+        -- @p@.++        semiSep          :: forall a . ParsecT s u m a -> ParsecT s u m [a],++        -- | Lexeme parser @semiSep1 p@ parses /one/ or more occurrences of @p@+        -- separated by 'semi'. Returns a list of values returned by @p@. ++        semiSep1         :: forall a . ParsecT s u m a -> ParsecT s u m [a],++        -- | Lexeme parser @commaSep p@ parses /zero/ or more occurrences of+        -- @p@ separated by 'comma'. Returns a list of values returned+        -- by @p@. ++        commaSep         :: forall a . ParsecT s u m a -> ParsecT s u m [a],++        -- | Lexeme parser @commaSep1 p@ parses /one/ or more occurrences of+        -- @p@ separated by 'comma'. Returns a list of values returned+        -- by @p@. ++        commaSep1        :: forall a . ParsecT s u m a -> ParsecT s u m [a]+    }++-----------------------------------------------------------+-- Given a LanguageDef, create a token parser.+-----------------------------------------------------------++-- | The expression @makeTokenParser language@ creates a 'GenTokenParser'+-- record that contains lexical parsers that are+-- defined using the definitions in the @language@ record.+--+-- The use of this function is quite stylized - one imports the+-- appropiate language definition and selects the lexical parsers that+-- are needed from the resulting 'GenTokenParser'.+--+-- >  module Main where+-- >+-- >  import Text.Parsec+-- >  import qualified Text.Parsec.Token as P+-- >  import Text.Parsec.Language (haskellDef)+-- >+-- >  -- The parser+-- >  ...+-- >+-- >  expr  =   parens expr+-- >        <|> identifier+-- >        <|> ...+-- >       +-- >+-- >  -- The lexer+-- >  lexer       = P.makeTokenParser haskellDef    +-- >      +-- >  parens      = P.parens lexer+-- >  braces      = P.braces lexer+-- >  identifier  = P.identifier lexer+-- >  reserved    = P.reserved lexer+-- >  ...++makeTokenParser :: (Stream s m Char)+                => GenLanguageDef s u m -> GenTokenParser s u m+makeTokenParser languageDef+    = TokenParser{ identifier = identifier+                 , reserved = reserved+                 , operator = operator+                 , reservedOp = reservedOp++                 , charLiteral = charLiteral+                 , stringLiteral = stringLiteral+                 , natural = natural+                 , integer = integer+                 , float = float+                 , naturalOrFloat = naturalOrFloat+                 , decimal = decimal+                 , hexadecimal = hexadecimal+                 , octal = octal++                 , symbol = symbol+                 , lexeme = lexeme+                 , whiteSpace = whiteSpace++                 , parens = parens+                 , braces = braces+                 , angles = angles+                 , brackets = brackets+                 , squares = brackets+                 , semi = semi+                 , comma = comma+                 , colon = colon+                 , dot = dot+                 , semiSep = semiSep+                 , semiSep1 = semiSep1+                 , commaSep = commaSep+                 , commaSep1 = commaSep1+                 }+    where++    -----------------------------------------------------------+    -- Bracketing+    -----------------------------------------------------------+    parens p        = between (symbol "(") (symbol ")") p+    braces p        = between (symbol "{") (symbol "}") p+    angles p        = between (symbol "<") (symbol ">") p+    brackets p      = between (symbol "[") (symbol "]") p++    semi            = symbol ";"+    comma           = symbol ","+    dot             = symbol "."+    colon           = symbol ":"++    commaSep p      = sepBy p comma+    semiSep p       = sepBy p semi++    commaSep1 p     = sepBy1 p comma+    semiSep1 p      = sepBy1 p semi+++    -----------------------------------------------------------+    -- Chars & Strings+    -----------------------------------------------------------+    charLiteral     = lexeme (between (char '\'')+                                      (char '\'' <?> "end of character")+                                      characterChar )+                    <?> "character"++    characterChar   = charLetter <|> charEscape+                    <?> "literal character"++    charEscape      = do{ char '\\'; escapeCode }+    charLetter      = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))++++    stringLiteral   = lexeme (+                      do{ str <- between (char '"')+                                         (char '"' <?> "end of string")+                                         (many stringChar)+                        ; return (foldr (maybe id (:)) "" str)+                        }+                      <?> "literal string")++    stringChar      =   do{ c <- stringLetter; return (Just c) }+                    <|> stringEscape+                    <?> "string character"++    stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))++    stringEscape    = do{ char '\\'+                        ;     do{ escapeGap  ; return Nothing }+                          <|> do{ escapeEmpty; return Nothing }+                          <|> do{ esc <- escapeCode; return (Just esc) }+                        }++    escapeEmpty     = char '&'+    escapeGap       = do{ many1 space+                        ; char '\\' <?> "end of string gap"+                        }++++    -- escape codes+    escapeCode      = charEsc <|> charNum <|> charAscii <|> charControl+                    <?> "escape code"++    charControl     = do{ char '^'+                        ; code <- upper+                        ; return (toEnum (fromEnum code - fromEnum 'A'))+                        }++    charNum         = do{ code <- decimal+                                  <|> do{ char 'o'; number 8 octDigit }+                                  <|> do{ char 'x'; number 16 hexDigit }+                        ; return (toEnum (fromInteger code))+                        }++    charEsc         = choice (map parseEsc escMap)+                    where+                      parseEsc (c,code)     = do{ char c; return code }++    charAscii       = choice (map parseAscii asciiMap)+                    where+                      parseAscii (asc,code) = try (do{ string asc; return code })+++    -- escape code tables+    escMap          = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'")+    asciiMap        = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2)++    ascii2codes     = ["BS","HT","LF","VT","FF","CR","SO","SI","EM",+                       "FS","GS","RS","US","SP"]+    ascii3codes     = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL",+                       "DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB",+                       "CAN","SUB","ESC","DEL"]++    ascii2          = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI',+                       '\EM','\FS','\GS','\RS','\US','\SP']+    ascii3          = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK',+                       '\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK',+                       '\SYN','\ETB','\CAN','\SUB','\ESC','\DEL']+++    -----------------------------------------------------------+    -- Numbers+    -----------------------------------------------------------+    naturalOrFloat  = lexeme (natFloat) <?> "number"++    float           = lexeme floating   <?> "float"+    integer         = lexeme int        <?> "integer"+    natural         = lexeme nat        <?> "natural"+++    -- floats+    floating        = do{ n <- decimal+                        ; fractExponent n+                        }+++    natFloat        = do{ char '0'+                        ; zeroNumFloat+                        }+                      <|> decimalFloat++    zeroNumFloat    =  do{ n <- hexadecimal <|> octal+                         ; return (Left n)+                         }+                    <|> decimalFloat+                    <|> fractFloat 0+                    <|> return (Left 0)++    decimalFloat    = do{ n <- decimal+                        ; option (Left n)+                                 (fractFloat n)+                        }++    fractFloat n    = do{ f <- fractExponent n+                        ; return (Right f)+                        }++    fractExponent n = do{ fract <- fraction+                        ; expo  <- option 1.0 exponent'+                        ; return ((fromInteger n + fract)*expo)+                        }+                    <|>+                      do{ expo <- exponent'+                        ; return ((fromInteger n)*expo)+                        }++    fraction        = do{ char '.'+                        ; digits <- many1 digit <?> "fraction"+                        ; return (foldr op 0.0 digits)+                        }+                      <?> "fraction"+                    where+                      op d f    = (f + fromIntegral (digitToInt d))/10.0++    exponent'       = do{ oneOf "eE"+                        ; f <- sign+                        ; e <- decimal <?> "exponent"+                        ; return (power (f e))+                        }+                      <?> "exponent"+                    where+                       power e  | e < 0      = 1.0/power(-e)+                                | otherwise  = fromInteger (10^e)+++    -- integers and naturals+    int             = do{ f <- lexeme sign+                        ; n <- nat+                        ; return (f n)+                        }++    sign            =   (char '-' >> return negate)+                    <|> (char '+' >> return id)+                    <|> return id++    nat             = zeroNumber <|> decimal++    zeroNumber      = do{ char '0'+                        ; hexadecimal <|> octal <|> decimal <|> return 0+                        }+                      <?> ""++    decimal         = number 10 digit+    hexadecimal     = do{ oneOf "xX"; number 16 hexDigit }+    octal           = do{ oneOf "oO"; number 8 octDigit  }++    number base baseDigit+        = do{ digits <- many1 baseDigit+            ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits+            ; seq n (return n)+            }++    -----------------------------------------------------------+    -- Operators & reserved ops+    -----------------------------------------------------------+    reservedOp name =+        lexeme $ try $+        do{ string name+          ; notFollowedBy (opLetter languageDef) <?> ("end of " ++ show name)+          }++    operator =+        lexeme $ try $+        do{ name <- oper+          ; if (isReservedOp name)+             then unexpected ("reserved operator " ++ show name)+             else return name+          }++    oper =+        do{ c <- (opStart languageDef)+          ; cs <- many (opLetter languageDef)+          ; return (c:cs)+          }+        <?> "operator"++    isReservedOp name =+        isReserved (sort (reservedOpNames languageDef)) name+++    -----------------------------------------------------------+    -- Identifiers & Reserved words+    -----------------------------------------------------------+    reserved name =+        lexeme $ try $+        do{ caseString name+          ; notFollowedBy (identLetter languageDef) <?> ("end of " ++ show name)+          }++    caseString name+        | caseSensitive languageDef  = string name+        | otherwise               = do{ walk name; return name }+        where+          walk []     = return ()+          walk (c:cs) = do{ caseChar c <?> msg; walk cs }++          caseChar c  | isAlpha c  = char (toLower c) <|> char (toUpper c)+                      | otherwise  = char c++          msg         = show name+++    identifier =+        lexeme $ try $+        do{ name <- ident+          ; if (isReservedName name)+             then unexpected ("reserved word " ++ show name)+             else return name+          }+++    ident+        = do{ c <- identStart languageDef+            ; cs <- many (identLetter languageDef)+            ; return (c:cs)+            }+        <?> "identifier"++    isReservedName name+        = isReserved theReservedNames caseName+        where+          caseName      | caseSensitive languageDef  = name+                        | otherwise               = map toLower name+++    isReserved names name+        = scan names+        where+          scan []       = False+          scan (r:rs)   = case (compare r name) of+                            LT  -> scan rs+                            EQ  -> True+                            GT  -> False++    theReservedNames+        | caseSensitive languageDef  = sortedNames+        | otherwise               = map (map toLower) sortedNames+        where+          sortedNames   = sort (reservedNames languageDef)++++    -----------------------------------------------------------+    -- White space & symbols+    -----------------------------------------------------------+    symbol name+        = lexeme (string name)++    lexeme p+        = do{ x <- p; whiteSpace; return x  }+++    --whiteSpace+    whiteSpace+        | noLine && noMulti  = skipMany (simpleSpace <?> "")+        | noLine             = skipMany (simpleSpace <|> multiLineComment <?> "")+        | noMulti            = skipMany (simpleSpace <|> oneLineComment <?> "")+        | otherwise          = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")+        where+          noLine  = null (commentLine languageDef)+          noMulti = null (commentStart languageDef)+++    simpleSpace =+        skipMany1 (satisfy isSpace)++    oneLineComment =+        do{ try (string (commentLine languageDef))+          ; skipMany (satisfy (/= '\n'))+          ; return ()+          }++    multiLineComment =+        do { try (string (commentStart languageDef))+           ; inComment+           }++    inComment+        | nestedComments languageDef  = inCommentMulti+        | otherwise                = inCommentSingle++    inCommentMulti+        =   do{ try (string (commentEnd languageDef)) ; return () }+        <|> do{ multiLineComment                     ; inCommentMulti }+        <|> do{ skipMany1 (noneOf startEnd)          ; inCommentMulti }+        <|> do{ oneOf startEnd                       ; inCommentMulti }+        <?> "end of comment"+        where+          startEnd   = nub (commentEnd languageDef ++ commentStart languageDef)++    inCommentSingle+        =   do{ try (string (commentEnd languageDef)); return () }+        <|> do{ skipMany1 (noneOf startEnd)         ; inCommentSingle }+        <|> do{ oneOf startEnd                      ; inCommentSingle }+        <?> "end of comment"+        where+          startEnd   = nub (commentEnd languageDef ++ commentStart languageDef)

@@ -0,0 +1,38 @@+name:           parsec3+version:        1.0.0.0+cabal-version: >= 1.2.3+license:        BSD3+license-file:   LICENSE+author:         Daan Leijen <daan@microsoft.com>, Paolo Martini <paolo@nemail.it>+maintainer:     Christian Maeder <Christian.Maeder@dfki.de>+homepage:       http://www.cs.uu.nl/~daan/parsec.html+category:       Parsing+synopsis:       Monadic parser combinators+build-type: Simple+description:+        Parsec is designed from scratch as an industrial-strength parser+        library.  It is simple, safe, well documented (on the package+        homepage), has extensive libraries and good error messages,+        and is also fast.  It is defined as a monad transformer that can be+        stacked on arbitrary monads, and it is also parametric in the+        input stream type.+        .+        This package comes without the compatibility layer for parsec2.+library+    exposed-modules:+        Text.Parsec,+        Text.Parsec.String,+        Text.Parsec.ByteString,+        Text.Parsec.ByteString.Lazy,+        Text.Parsec.Pos,+        Text.Parsec.Error,+        Text.Parsec.Prim,+        Text.Parsec.Char,+        Text.Parsec.Combinator,+        Text.Parsec.Token,+        Text.Parsec.Expr,+        Text.Parsec.Language,+        Text.Parsec.Perm+    build-depends: base >= 4 && < 5, syb, mtl, bytestring+    extensions: DeriveDataTypeable, PolymorphicComponents, FlexibleInstances,+        MultiParamTypeClasses, FlexibleContexts