SE      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ 1(c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOT The abstract data type  SourcePosx 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 ,  and  class.  Create a new < with the given source name, line number and column number. Create a new Y with the given source name, and line number and column number set to 1, the upper left.8Extracts the name of the source from a source position. 1Extracts the line number from a source position. 3Extracts the column number from a source position. 1Increments the line number of a source position. 3Increments the column number of a source position. Set the name of the source. *Set the line number of a source position. ,Set the column number of a source position. The expression updatePosString pos s updates the source position pos by calling  on every character in s, ie. 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)7. In all other cases, the column is incremented by 1.     1(c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOTThe abstract data type  ParseError< represents parse errors. It provides the source position (.) of the error and a list of error messages (). A  ParseError" can be returned by the function .  ParseError is an instance of the  and  classes.[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 2 message is automatically generated by the 9 combinator. The argument is the unexpected input.A  message is generated by the F combinator. The argument describes the unexpected item.A  message is generated by the = combinator. The argument describes the expected item.A  message is generated by the A combinator. The argument is some general parser message. 1Extract the message string from an error message 1Extracts the source position from the parse error8Extracts the list of error messages from the parse error !"#$%&'() !"#$$ !"# !"#$%&'()(c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOT*+ !"#$*+*+$ !"#*+1(c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe /09:;<=?AOT,An instance of Stream has stream type s, underlying monad m and token type t determined by the stream9Some rough guidelines for a "correct" instance of Stream:8unfoldM uncons gives the [t] corresponding to the streamA Stream^ instance is responsible for maintaining the "position within the stream" in the stream state sG. This is trivial unless you are using the monad in a non-trivial way.:)ParserT monad transformer and Parser typeParsecT 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.= The parser unexpected msg0 always fails with an unexpected error message msg without consuming any input. The parsers , (G) and  unexpectedI are the three parsers used to generate error messages. Of these, only (G2) is commonly used. For an example of the use of  unexpected, see the definition of .>Low-level unpacking of the ParsecT type. To run your parser, please look to runPT, runP, runParserT, runParser and other such functions.?MLow-level creation of the ParsecT type. You really shouldn't have to do this.E parserZero+ always fails without consuming any input.  parserZero is defined equal to the  member of the  class and to the  member of the  class.G The parser  p <?> msg behaves as parser p, but whenever the parser p fails without consuming any inputC, 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 LU example would fail, the error message is: '...: expecting expression'. Without the (<?>)b combinator, the message would be like '...: expecting "let" or letter', which is less friendly.H.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 q4 is tried. This combinator is defined equal to the  member of the  class and the ( ) member of .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.IA synonym for <?>+, but as a function instead of an operator.L The parser try p behaves like parser pR, 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 (Hf) 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: z expr = letExpr <|> identifier <?> "expression" letExpr = do{ string "let"; ... } identifier = many1 letter5If the user writes "lexical", the parser fails with: 'unexpected 'x', expecting 't' in "let". Indeed, since the (H]) combinator only tries alternatives when the first alternative hasn't consumed input, the  identifier8 parser is never tried (because the prefix "le" of the  string "let"Q 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 letterM lookAhead p parses p without consuming any input.If p( fails and consumes some input, so does  lookAhead. Combine with L if this is undesirable.N The parser  token showTok posFromTok testTok accepts a token t with result x when the function  testTok t returns  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 O. 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 NothingO The parser !tokenPrim showTok nextPos testTok accepts a token t with result x when the function  testTok t returns  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.NThis is the most primitive combinator for accepting tokens. For example, the   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 xQmany 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) }R skipMany p applies the parser p zero% or more times, skipping its result.  spaces = skipMany spaceV&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 filePathl is only used in error messages and may be the empty string. Returns a computation in the underlying monad m that return either a  ( ) or a value of type a ( ).W>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 filePathO is only used in error messages and may be the empty string. Returns either a  ( ) or a value of type a ( ). m parseFromFile p fname = do{ input <- readFile fname ; return (runParser p () fname input) }Xparse p filePath input runs a parser p( over Identity without user state. The filePathO is only used in error messages and may be the empty string. Returns either a  ( ) or a value of type a ( ).  main = case (parse numbers "" "11, 2, 43") of Left err -> print err Right xs -> print (sum xs) numbers = commaSep integerYThe expression parseTest p input applies a parser p against input input< and prints the result to stdout. Used for testing parsers.Z.Returns the current source position. See also .[Returns the current input \setPosition pos% sets the current source position to pos. ]setInput input continues parsing with input. The [ and setInputA functions can for example be used to deal with #include files. ^#Returns the full parser state as a . record._setParserState st set the full parser state to st. `updateParserState f applies function f to the parser state.a Returns the current user state. b putState st set the user state to st. c modifyState f applies function fl to the user state. Suppose that we want to count identifiers in a source, we could use the user state as: b expr = do{ x <- identifier ; modifyState (+1) ; return (Id x) }d2An alias for putState for backwards compatibility.e5An alias for modifyState for backwards compatibility.P,-./0123456789:  ;<=>?@ABCDEFGHIJKLMNToken pretty-printing function.!Computes the position of a token.)Matching function for the token to parse.OToken pretty-printing function.#Next position calculating function.)Matching function for the token to parse.P QRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvw:,-./1023546879:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcde:;<=:>?9678345./012@ABCDEFGHIJM,-KLNOPQRSTUVWXYZ[\]^_`abcdeE,-./0123456789:  ;<=>?@ABCDEFGHIJKLMNOP QRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwG0H11(c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOTx choice ps( tries to apply the parsers in the list psT in order, until one of them succeeds. Returns the value of the succeeding parser.y option x p tries to apply parser p. If p6 fails without consuming input, it returns the value x#, otherwise the value returned by p. s priority = option 0 (do{ d <- digit ; return (digitToInt d) })z optionMaybe p tries to apply parser p. If p+ fails without consuming input, it return , otherwise it returns  the value returned by p.{ optional p tries to apply parser p. It will parse p or nothing. It only fails if p9 fails after consuming input. It discards the result of p.|between open close p parses open, followed by p and close!. Returns the value returned by p. , braces = between (symbol "{") (symbol "}")} skipMany1 p applies the parser p one& or more times, skipping its result. ~many1 p applies the parser p one: or more times. Returns a list of the returned values of p.  word = many1 letter 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 ",") sepBy1 p sep parses one or more occurrences of p, separated by sep'. Returns a list of values returned by p. sepEndBy1 p sep parses one or more occurrences of p%, separated and optionally ended by sep(. Returns a list of values returned by p. sepEndBy p sep parses zero or more occurrences of p%, separated and optionally ended by sepF, ie. haskell style statements. Returns a list of values returned by p. 6 haskellStatements = haskellStatement `sepEndBy` semi endBy1 p sep parses one or more occurrences of p, separated and ended by sep'. Returns a list of values returned by p.  endBy p sep parses zero or more occurrences of p, separated and ended by sep'. Returns a list of values returned by p. ( cStatements = cStatement `endBy` semi count n p parses n occurrences of p. If n4 is smaller or equal to zero, the parser equals to  return []. Returns a list of n values returned by p.  chainr p op x parses zero or more occurrences of p, separated by op Returns a value obtained by a right7 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. chainl p op x parses zero or more occurrences of p, separated by op . Returns a value obtained by a left7 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.chainl1 p op x parses one or more occurrences of p, separated by op Returns a value obtained by a left7 associative application of all functions returned by op to the values returned by ps. . 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 (-) }chainr1 p op x parses one+ or more occurrences of |p|, separated by op Returns a value obtained by a right7 associative application of all functions returned by op to the values returned by p. The parser anyTokenA accepts any kind of token. It is for example used to implement . Returns the accepted token. kThis parser only succeeds at the end of the input. This is not a primitive parser but it is defined using . 1 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: l keywordLet = try (do{ string "let" ; notFollowedBy alphaNum })manyTill p end applies parser p zero or more times until parser end2 succeeds. Returns the list of values returned by p,. This parser can be used to scan comments: x simpleComment = do{ string "<!--" ; manyTill anyChar (try (string "-->")) }Note the overlapping parsers anyChar and  string "-->"#, and therefore the use of the L combinator.xyz{|}~Mxyz{|}~x|yz{}~Mxyz{|}~(c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOTMxyz{|}~x|yz{}~M1(c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisional non-portableSafe 09:;<=AOTAn 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).?This data type specifies operators that work on values of type az. An operator is either binary infix or unary prefix or postfix. A binary operator has also an associated associativity.NThis data type specifies the associativity of operators: left, right or none. buildExpressionParser table term( builds an expression parser for terms term with operators from table8, 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 -h 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 })  1(c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOToneOf csJ succeeds if the current character is in the supplied list of characters cs*. Returns the parsed character. See also .  vowel = oneOf "aeiou"As the dual of ,  noneOf cs$ succeeds if the current character not$ in the supplied list of characters cs . Returns the parsed character.  consonant = noneOf "aeiou"Skips zero* or more white space characters. See also R.>Parses a white space character (any character which satisfies !) Returns the parsed character. @Parses a newline character ('\n'). Returns a newline character. pParses a carriage return character ('\r') followed by a newline character ('\n'). Returns a newline character. Parses a CRLF (see  ) or LF (see 3) end-of-line. Returns a newline character ('\n'). endOfLine = newline <|> crlf8Parses a tab character ('\t'). Returns a tab character. ^Parses an upper case letter (a character between 'A' and 'Z'). Returns the parsed character. `Parses a lower case character (a character between 'a' and 'z'). Returns the parsed character. [Parses a letter or digit (a character between '0' and '9'). Returns the parsed character. XParses a letter (an upper case or lower case character). Returns the parsed character. .Parses a digit. Returns the parsed character. tParses a hexadecimal digit (a digit or a letter between 'a' and 'f' or 'A' and 'F'). Returns the parsed character. XParses an octal digit (a character between '0' and '7'). Returns the parsed character. char c parses a single character c&. Returns the parsed character (i.e. c).  semiColon = char ';'FThis parser succeeds for any character. Returns the parsed character.  The parser  satisfy f= succeeds for any character for which the supplied function f returns 1. Returns the character that is actually parsed.string s* parses a sequence of characters given by s#. Returns the parsed string (i.e. s). < divOrMod = string "div" <|> string "mod" 1(c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalInon-portable (uses local universal quantification: PolymorphicComponents)Safe 09:;<=AOT+@The type of the record that holds lexical parsers that work on s streams with state u over a monad m.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  that is passed to . An  identifier% is treated as a single token using L.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 L. 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  that is passed to . An operator% is treated as a single token using L. 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 L. *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). #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). This lexeme parser parses a natural number (a positive whole number). Returns the value of the number. The number can be specified in ,  or N. The number is parsed according to the grammar rules in the Haskell report. LThis lexeme parser parses an integer (a whole number). This parser is like  except that it can be prefixed with sign (i.e. '-' or '+'). Returns the value of the number. The number can be specified in ,  or N. The number is parsed according to the grammar rules in the Haskell report. 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. !This lexeme parser parses either  or a . 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. XParses a positive whole number in the decimal system. Returns the value of the number. Parses a positive whole number in the hexadecimal system. The number should be prefixed with "0x" or "0X". Returns the value of the number. Parses a positive whole number in the octal system. The number should be prefixed with "0o" or "0O". Returns the value of the number. Lexeme parser symbol s parses  s" and skips trailing white space. lexeme p first applies parser p and than the ! parser, returning the value of p1. Every lexical token (lexeme) is defined using lexemeP, 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 o 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) }0Parses any white space. White space consists of zero or more occurrences of a , a line comment or a block (multi line) comment. Block comments may be nested. How comments are started and ended is defined in the  that is passed to . Lexeme parser parens p parses p2 enclosed in parenthesis, returning the value of p.Lexeme parser braces p parses p; enclosed in braces ('{' and '}'), returning the value of p. Lexeme parser angles p parses pC enclosed in angle brackets ('<' and '>'), returning the value of p. Lexeme parser  brackets p parses p= enclosed in brackets ('[' and ']'), returning the value of p. DEPRECATED: Use .kLexeme parser |semi| parses the character ';' and skips any trailing white space. Returns the string ";". Lexeme parser commaW parses the character ',' and skips any trailing white space. Returns the string ",". Lexeme parser colonW parses the character ':' and skips any trailing white space. Returns the string ":". Lexeme parser dotW parses the character '.' and skips any trailing white space. Returns the string ".". Lexeme parser  semiSep p parses zero or more occurrences of p separated by (. Returns a list of values returned by p.Lexeme parser  semiSep1 p parses one or more occurrences of p separated by '. Returns a list of values returned by p. Lexeme parser  commaSep p parses zero or more occurrences of p separated by (. Returns a list of values returned by p. Lexeme parser  commaSep1 p parses one or more occurrences of p separated by (. Returns a list of values returned by p. The GenLanguageDefE type is a record that contains all parameterizable features of the Text.Parsec.Token module. The module Text.Parsec.Language$ contains some default definitions.Describes the start of a block comment. Use the empty string if the language doesn't support block comments. For example "/*". ~Describes the end of a block comment. Use the empty string if the language doesn't support block comments. For example "*/". ~Describes the start of a line comment. Use the empty string if the language doesn't support line comments. For example "//". Set to 1 if the language supports nested block comments. LThis parser should accept any start characters of identifiers. For example letter <|> char '_'. QThis parser should accept any legal tail characters of identifiers. For example alphaNum <|> char '_'. JThis parser should accept any start characters of operators. For example oneOf ":!#$%&*+./<=>?@\\^|-~" 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  parser won't work correctly. "The list of reserved identifiers.  The list of reserved operators. Set to $ if the language is case sensitive. The expression makeTokenParser language creates a V 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 .  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 .../// (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOT// (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOT   (c) Antoine Latter 20111BSD-style (see the file libraries/parsec/LICENSE)aslatter@gmail.com provisionalportableSafe 09:;<=AOT (c) Antoine Latter 20111BSD-style (see the file libraries/parsec/LICENSE)aslatter@gmail.com provisionalportableSafe 09:;<=AOT (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOTparseFromFile p filePath runs a lazy bytestring parser p on the input read from filePath using !". Returns either a  ( ) or a value of type a ( ).  main = do{ result <- parseFromFile numbers "digits.txt" ; case result of Left err -> print err Right xs -> print (sum xs) }(c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOTparseFromFile p filePath! runs a strict bytestring parser p on the input read from filePath using #". Returns either a  ( ) or a value of type a ( ).  main = do{ result <- parseFromFile numbers "digits.txt" ; case result of Left err -> print err Right xs -> print (sum xs) }(c) Paolo Martini 20071BSD-style (see the file libraries/parsec/LICENSE)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOTparseFromFile p filePath runs a string parser p on the input read from filePath using . Returns either a  ( ) or a value of type a ( ).  main = do{ result <- parseFromFile numbers "digits.txt" ; case result of Left err -> print err Right xs -> print (sum xs) }(c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOT(c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOT!./102=GHIJKNOPQRXYZ[\]^_ade!GHXYNKOPIJ=QRadeZ\[]./012^_$(c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOTX ./102=GHIJKMNOPQRXYZ[\]^_adexyz{|}~ (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOT 1(c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 BSD-style (see the LICENSE file)aslatter@gmail.com provisionalportableSafe 09:;<=AOTq ,-./1023546879:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdexyz{|}~^:9NKVWXYZ[abcHGIJL=xQ~R}|yz{M SOPT;<C^_`,->?U678345./012\]de@ABDEF1(c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisional9non-portable (uses non-portable module Text.Parsec.Token)Safe 09:;<=AOTThis 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.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.yThis is the most minimal token definition. It is recommended to use this definition as the basis for other definitions. emptyDefo has no reserved names or operators, is case sensitive and doesn't accept comments, identifiers or operators.!A lexer for the haskell language.1The language definition for the Haskell language.3The language definition for the language Haskell98."A lexer for the mondrian language.2The language definition for the language Mondrian. %(c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOT1(c) Daan Leijen 1999-2001, (c) Paolo Martini 20071BSD-style (see the file libraries/parsec/LICENSE)derek.a.elkins@gmail.com provisional>non-portable (uses existentially quantified data constructors)Safe /09:;<=AOT The type StreamPermParser s st a; denotes a permutation parser that, when converted by the  function, parses s streams with user state st and returns a value of type a on success.LNormally, a permutation parser is first build with special operators like (3) and than transformed into a normal parser using .?Provided for backwards compatibility. The tok type is ignored.The expression  perm <||> p adds parser p to the permutation parser perm . The parser pF is not allowed to accept empty input - use the optional combinator (;) instead. Returns a new permutation parser that includes p. The expression f <$$> p: creates a fresh permutation parser consisting of parser pB. The the final result of the permutation parser is the function f applied to the return value of p. The parser pF is not allowed to accept empty input - use the optional combinator ( ) instead.If the function f3 takes more than one parameter, the type variable bR is instantiated to a functional type which combines nicely with the adds parser p to the (j) combinator. This results in stylized code where a permutation parser starts with a combining function f' followed by the parsers. The function fm gets its parameters in the order in which the parsers are specified, but actual input can be in any order.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. The expression  f <$?> (x,p): creates a fresh permutation parser consisting of parser pB. 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.  The parser  permute perm. parses a permutation of parser described by permQ. 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) 1212&(c) Paolo Martini 2007 BSD-style (see the LICENSE file)derek.a.elkins@gmail.com provisionalportableSafe 09:;<=AOT'()*+,-./0123456789:;<=>?<@ABCDEFGHIJKLMNOPQRSTTUVWXYZ[[\]^_`abcdefghijklmnopqrstuvwxyz{|}~               xm       ';^  "!"#$%&'()*#parsec-3.1.11-74wNPgTwVY85kXBsoLRIEText.Parsec.PosText.Parsec.Error#Text.ParserCombinators.Parsec.Error Text.Parsec"Text.ParserCombinators.Parsec.PrimText.Parsec.CombinatorText.Parsec.PrimText.Parsec.ExprText.Parsec.CharText.Parsec.TokenText.Parsec.Text.LazyText.Parsec.TextText.Parsec.ByteString.LazyText.Parsec.ByteStringText.Parsec.String"Text.ParserCombinators.Parsec.Char"Text.ParserCombinators.Parsec.ExprText.Parsec.LanguageText.Parsec.Permparsesatisfy unexpected notFollowedByControl.Applicativeempty Alternative<|>char(Text.ParserCombinators.Parsec.Combinator#Text.ParserCombinators.Parsec.Token!Text.ParserCombinators.Parsec.PosByteString.Lazy.Char8readFileByteString.Char8Text.ParserCombinators.Parsec&Text.ParserCombinators.Parsec.Language"Text.ParserCombinators.Parsec.Perm SourcePosColumnLine SourceNamenewPos initialPos sourceName sourceLine sourceColumn incSourceLineincSourceColumn setSourceName setSourceLinesetSourceColumnupdatePosString updatePosChar$fShowSourcePos $fEqSourcePos$fOrdSourcePos$fDataSourcePos ParseErrorMessage SysUnExpectUnExpectExpect messageStringerrorPos errorMessageserrorIsUnknownnewErrorUnknownnewErrorMessageaddErrorMessage setErrorPossetErrorMessage mergeErrorshowErrorMessages$fEqParseError$fShowParseError $fOrdMessage $fEqMessage $fEnumMessagemessageCompare messageEqStreamunconsState stateInputstatePos stateUserReplyOkErrorConsumedEmptyParsecParsecT unknownErrorsysUnExpectError runParsecTmkPT parsecMap parserReturn parserBindmergeErrorReply parserFail parserZero parserPluslabellabelstokenstry lookAheadtoken tokenPrim tokenPrimExmanyskipMany manyAccumrunPTrunP runParserT runParser parseTest getPositiongetInput setPositionsetInputgetParserStatesetParserStateupdateParserStategetStateputState modifyStatesetState updateState$fStreamTextmChar$fStreamTextmChar0$fStreamByteStringmChar$fStreamByteStringmChar0$fStream[]mtok$fMonadTransParsecT$fMonadPlusParsecT$fMonadErroreParsecT$fMonadContParsecT$fMonadStatesParsecT$fMonadReaderrParsecT$fMonadIOParsecT$fMonadParsecT$fAlternativeParsecT$fApplicativeParsecT$fFunctorParsecT$fFunctorReply$fFunctorConsumedchoiceoption optionMaybeoptionalbetween skipMany1many1sepBysepBy1 sepEndBy1sepEndByendBy1endBycountchainrchainlchainl1chainr1anyTokeneofmanyTill OperatorTableOperatorInfixPrefixPostfixAssoc AssocNone AssocLeft AssocRightbuildExpressionParseroneOfnoneOfspacesspacenewlinecrlf endOfLinetabupperloweralphaNumletterdigithexDigitoctDigitanyCharstringGenTokenParser TokenParser identifierreservedoperator reservedOp charLiteral stringLiteralnaturalintegerfloatnaturalOrFloatdecimal hexadecimaloctalsymbollexeme whiteSpaceparensbracesanglesbracketssquaressemicommacolondotsemiSepsemiSep1commaSep commaSep1GenLanguageDef LanguageDef commentStart commentEnd commentLinenestedComments identStart identLetteropStartopLetter reservedNamesreservedOpNames caseSensitivemakeTokenParser GenParserParser parseFromFile CharParserpzero haskellStyle javaStyleemptyDefhaskell haskellDefmondrian mondrianDefStreamPermParser PermParser<||><$$><|?><$?>permutebaseGHC.ShowShowghc-prim GHC.ClassesEqOrdGHC.Basefailmzero MonadPlusmplusJust Data.EitherLeftRightunParser unexpectErrormanyErrNothing GHC.UnicodeisSpace GHC.TypesTrue System.IOconvert haskell98Def StreamBranchBranchPermnewpermaddaddoptmapPerms