3a_asm/Text/Parsec/Prim.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Text.Parsec.Prim
   4 -- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
   5 -- License     :  BSD-style (see the LICENSE file)
   6 --
   7 -- Maintainer  :  derek.a.elkins@gmail.com
   8 -- Stability   :  provisional
   9 -- Portability :  portable
  10 --
  11 -- The primitive parser combinators.
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts,
  16              UndecidableInstances #-}
  17
  18 module Text.Parsec.Prim where
  19
  20 import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) )
  21 import Control.Monad()
  22 import Control.Monad.Trans
  23 import Control.Monad.Identity
  24
  25 import Control.Monad.Reader.Class
  26 import Control.Monad.State.Class
  27 import Control.Monad.Cont.Class
  28 import Control.Monad.Error.Class
  29
  30 import Text.Parsec.Pos
  31 import Text.Parsec.Error
  32
  33 unknownError :: State s u -> ParseError
  34 unknownError state        = newErrorUnknown (statePos state)
  35
  36 sysUnExpectError :: String -> SourcePos -> Reply s u a
  37 sysUnExpectError msg pos  = Error (newErrorMessage (SysUnExpect msg) pos)
  38
  39 -- | The parser @unexpected msg@ always fails with an unexpected error
  40 -- message @msg@ without consuming any input.
  41 --
  42 -- The parsers 'fail', ('<?>') and @unexpected@ are the three parsers
  43 -- used to generate error messages. Of these, only ('<?>') is commonly
  44 -- used. For an example of the use of @unexpected@, see the definition
  45 -- of 'Text.Parsec.Combinator.notFollowedBy'.
  46
  47 unexpected :: (Stream s m t) => String -> ParsecT s u m a
  48 unexpected msg
  49     = ParsecT $ \s -> return $ Empty $ return $
  50                         Error (newErrorMessage (UnExpect msg) (statePos s))
  51
  52 -- | ParserT monad transformer and Parser type
  53
  54 -- | @ParsecT s u m a@ is a parser with stream type @s@, user state type @u@,
  55 -- underlying monad @m@ and return type @a@
  56
  57 data ParsecT s u m a
  58     = ParsecT { runParsecT :: State s u -> m (Consumed (m (Reply s u a))) }
  59
  60 type Parsec s u = ParsecT s u Identity
  61
  62 data Consumed a  = Consumed a
  63                  | Empty !a
  64
  65 data Reply s u a = Ok !a !(State s u) ParseError
  66                  | Error ParseError
  67
  68 data State s u = State {
  69       stateInput :: s,
  70       statePos   :: !SourcePos,
  71       stateUser  :: !u
  72     }
  73
  74 instance Functor Consumed where
  75     fmap f (Consumed x) = Consumed (f x)
  76     fmap f (Empty x)    = Empty (f x)
  77
  78 instance Functor (Reply s u) where
  79     fmap f (Ok x s e) = Ok (f x) s e
  80     fmap _ (Error e) = Error e -- XXX
  81
  82 instance (Monad m) => Functor (ParsecT s u m) where
  83     fmap f p = parsecMap f p
  84
  85 parsecMap :: (Monad m) => (a -> b) -> ParsecT s u m a -> ParsecT s u m b
  86 parsecMap f p
  87     = ParsecT $ \s -> liftM (fmap (liftM (fmap f))) (runParsecT p s)
  88
  89 instance (Monad m) => Applicative.Applicative (ParsecT s u m) where
  90     pure = return
  91     (<*>) = ap -- TODO: Can this be optimized?
  92
  93 instance (Monad m) => Applicative.Alternative (ParsecT s u m) where
  94     empty = mzero
  95     (<|>) = mplus
  96
  97 instance (Monad m) => Monad (ParsecT s u m) where
  98     return x = parserReturn x
  99     p >>= f  = parserBind p f
 100     fail msg = parserFail msg
 101
 102 instance (MonadIO m) => MonadIO (ParsecT s u m) where
 103     liftIO = lift . liftIO
 104
 105 instance (MonadReader r m) => MonadReader r (ParsecT s u m) where
 106     ask = lift ask
 107     local f p = ParsecT $ \s -> local f (runParsecT p s)
 108
 109 -- I'm presuming the user might want a separate, non-backtracking
 110 -- state aside from the Parsec user state.
 111 instance (MonadState s m) => MonadState s (ParsecT s' u m) where
 112     get = lift get
 113     put = lift . put
 114
 115 instance (MonadCont m) => MonadCont (ParsecT s u m) where
 116     callCC f = ParsecT $ \s ->
 117           callCC $ \c ->
 118           runParsecT (f (\a -> ParsecT $ \s' -> c (pack s' a))) s
 119
 120      where pack s a= Empty $ return (Ok a s (unknownError s))
 121
 122 instance (MonadError e m) => MonadError e (ParsecT s u m) where
 123     throwError = lift . throwError
 124     p `catchError` h = ParsecT $ \s ->
 125         runParsecT p s `catchError` \e ->
 126             runParsecT (h e) s
 127
 128 parserReturn :: (Monad m) => a -> ParsecT s u m a
 129 parserReturn x
 130     = ParsecT $ \s -> return $ Empty $ return (Ok x s (unknownError s))
 131
 132 parserBind :: (Monad m)
 133            => ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
 134
 135 parserBind p f
 136     = ParsecT $ \s -> do -- TODO: This was \s@(State _ u _) ???
 137         res1 <- runParsecT p s
 138         case res1 of
 139
 140           Empty mReply1
 141             -> do reply1 <- mReply1
 142                   case reply1 of
 143                     Ok x s' err1 -> do
 144                       res2 <- runParsecT (f x) s'
 145                       case res2 of
 146                         Empty mReply2
 147                           -> do reply2 <- mReply2
 148                                 return $ Empty $
 149                                             return $ mergeErrorReply err1 reply2
 150                         other
 151                           -> do return $ other
 152                     Error err1 -> return $ Empty $ return $ Error err1
 153
 154           Consumed mReply1
 155             -> do reply1 <- mReply1
 156                   return $ Consumed $ -- `early' returning
 157                     case reply1 of
 158                       Ok x s' err1 -> do
 159                         res2 <- runParsecT (f x) s'
 160                         case res2 of
 161                           Empty mReply2
 162                             -> do reply2 <- mReply2
 163                                   return $ mergeErrorReply err1 reply2
 164                           Consumed reply2 -> reply2
 165                       Error err1   -> return $ Error err1
 166
 167
 168 mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a
 169 mergeErrorReply err1 reply -- XXX where to put it?
 170     = case reply of
 171         Ok x state err2 -> Ok x state (mergeError err1 err2)
 172         Error err2      -> Error (mergeError err1 err2)
 173
 174 parserFail :: (Monad m) => String -> ParsecT s u m a
 175 parserFail msg
 176     = ParsecT $ \s -> return $ Empty $ return $
 177         Error (newErrorMessage (Message msg) (statePos s))
 178
 179 instance (Monad m) => MonadPlus (ParsecT s u m) where
 180     mzero = parserZero
 181     mplus p1 p2 = parserPlus p1 p2
 182
 183 -- | @parserZero@ always fails without consuming any input. @parserZero@ is defined
 184 -- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member
 185 -- of the 'Control.Applicative.Applicative' class.
 186
 187 parserZero :: (Monad m) => ParsecT s u m a
 188 parserZero
 189     = ParsecT $ \s -> return $ Empty $ return $ Error (unknownError s)
 190
 191 parserPlus :: (Monad m)
 192            => ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
 193 parserPlus (ParsecT p1) (ParsecT p2)
 194     = ParsecT $ \s -> do
 195         c1 <- p1 s
 196         case c1 of
 197           Empty mReply1
 198             -> do r1 <- mReply1
 199                   case r1 of
 200                     Error err -> do
 201                       c2 <- p2 s
 202                       case c2 of
 203                         Empty mReply2
 204                           -> do reply2 <- mReply2
 205                                 return $ Empty $ return (mergeErrorReply err reply2)
 206                         consumed
 207                           -> return $ consumed
 208                     other -> return $ Empty $ return $ other
 209           other -> return $ other
 210
 211 instance MonadTrans (ParsecT s u) where
 212     lift amb = ParsecT $ \s -> do
 213                  a <- amb
 214                  return $ Empty $ return $ Ok a s (unknownError s)
 215
 216 infix  0 <?>
 217 infixr 1 <|>
 218
 219 -- | The parser @p <?> msg@ behaves as parser @p@, but whenever the
 220 -- parser @p@ fails /without consuming any input/, it replaces expect
 221 -- error messages with the expect error message @msg@.
 222 --
 223 -- This is normally used at the end of a set alternatives where we want
 224 -- to return an error message in terms of a higher level construct
 225 -- rather than returning all possible characters. For example, if the
 226 -- @expr@ parser from the 'try' example would fail, the error
 227 -- message is: '...: expecting expression'. Without the @(\<?>)@
 228 -- combinator, the message would be like '...: expecting \"let\" or
 229 -- letter', which is less friendly.
 230
 231 (<?>) :: (Monad m)
 232       => (ParsecT s u m a) -> String -> (ParsecT s u m a)
 233 p <?> msg = label p msg
 234
 235 -- | This combinator implements choice. The parser @p \<|> q@ first
 236 -- applies @p@. If it succeeds, the value of @p@ is returned. If @p@
 237 -- fails /without consuming any input/, parser @q@ is tried. This
 238 -- combinator is defined equal to the 'mplus' member of the 'MonadPlus'
 239 -- class and the ('Control.Applicative.<|>') member of 'Control.Applicative.Alternative'.
 240 --
 241 -- The parser is called /predictive/ since @q@ is only tried when
 242 -- parser @p@ didn't consume any input (i.e.. the look ahead is 1).
 243 -- This non-backtracking behaviour allows for both an efficient
 244 -- implementation of the parser combinators and the generation of good
 245 -- error messages.
 246
 247 (<|>) :: (Monad m)
 248       => (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)
 249 p1 <|> p2 = mplus p1 p2
 250
 251 label :: (Monad m) => ParsecT s u m a -> String -> ParsecT s u m a
 252 label p msg
 253   = labels p [msg]
 254
 255 labels :: (Monad m) => ParsecT s u m a -> [String] -> ParsecT s u m a
 256 labels p msgs
 257     = ParsecT $ \s -> do
 258         r <- runParsecT p s
 259         case r of
 260           Empty mReply -> do
 261             reply <- mReply
 262             return $ Empty $ case reply of
 263               Error err
 264                 -> return $ Error (setExpectErrors err msgs)
 265               Ok x s' err
 266                 | errorIsUnknown err -> return $ reply
 267                 | otherwise -> return (Ok x s' (setExpectErrors err msgs))
 268           other        -> return $ other
 269     where
 270         setExpectErrors err []         = setErrorMessage (Expect "") err
 271         setExpectErrors err [msg]      = setErrorMessage (Expect msg) err
 272         setExpectErrors err (msg:msgs)
 273             = foldr (\msg' err' -> addErrorMessage (Expect msg') err')
 274                     (setErrorMessage (Expect msg) err) msgs
 275
 276 -- TODO: There should be a stronger statement that can be made about this
 277
 278 -- | An instance of @Stream@ has stream type @s@, underlying monad @m@ and token type @t@ determined by the stream
 279 --
 280 -- Some rough guidelines for a \"correct\" instance of Stream:
 281 --
 282 --    * unfoldM uncons gives the [t] corresponding to the stream
 283 --
 284 --    * 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.
 285
 286 class (Monad m) => Stream s m t | s -> t where
 287     uncons :: s -> m (Maybe (t,s))
 288
 289 tokens :: (Stream s m t, Eq t)
 290        => ([t] -> String)      -- Pretty print a list of tokens
 291        -> (SourcePos -> [t] -> SourcePos)
 292        -> [t]                  -- List of tokens to parse
 293        -> ParsecT s u m [t]
 294 tokens _ _ []
 295     = ParsecT $ \s -> return $ Empty $ return $ Ok [] s (unknownError s)
 296 tokens showTokens nextposs tts@(tok:toks)
 297     = ParsecT $ \(State input pos u) ->
 298     let
 299         errEof = return $ Error (setErrorMessage (Expect (showTokens tts))
 300                                  (newErrorMessage (SysUnExpect "") pos))
 301         errExpect x = return $ Error (setErrorMessage (Expect (showTokens tts))
 302                                  (newErrorMessage (SysUnExpect (showTokens [x])) pos))
 303         walk []     rs = return (ok rs)
 304         walk (t:ts) rs = do
 305           sr <- uncons rs
 306           case sr of
 307             Nothing                 -> errEof
 308             Just (x,xs) | t == x    -> walk ts xs
 309                         | otherwise -> errExpect x
 310         ok rs = let pos' = nextposs pos tts
 311                     s' = State rs pos' u
 312                 in Ok tts s' (newErrorUnknown pos')
 313     in do
 314         sr <- uncons input
 315         return $ case sr of
 316             Nothing         -> Empty    $ errEof
 317             Just (x,xs)
 318                 | tok == x    -> Consumed $ walk toks xs
 319                 | otherwise -> Empty    $ errExpect x
 320
 321 -- | The parser @try p@ behaves like parser @p@, except that it
 322 -- pretends that it hasn't consumed any input when an error occurs.
 323 --
 324 -- This combinator is used whenever arbitrary look ahead is needed.
 325 -- Since it pretends that it hasn't consumed any input when @p@ fails,
 326 -- the ('<|>') combinator will try its second alternative even when the
 327 -- first parser failed while consuming input.
 328 --
 329 -- The @try@ combinator can for example be used to distinguish
 330 -- identifiers and reserved words. Both reserved words and identifiers
 331 -- are a sequence of letters. Whenever we expect a certain reserved
 332 -- word where we can also expect an identifier we have to use the @try@
 333 -- combinator. Suppose we write:
 334 --
 335 -- >  expr        = letExpr <|> identifier <?> "expression"
 336 -- >
 337 -- >  letExpr     = do{ string "let"; ... }
 338 -- >  identifier  = many1 letter
 339 --
 340 -- If the user writes \"lexical\", the parser fails with: @unexpected
 341 -- \'x\', expecting \'t\' in \"let\"@. Indeed, since the ('<|>') combinator
 342 -- only tries alternatives when the first alternative hasn't consumed
 343 -- input, the @identifier@ parser is never tried (because the prefix
 344 -- \"le\" of the @string \"let\"@ parser is already consumed). The
 345 -- right behaviour can be obtained by adding the @try@ combinator:
 346 --
 347 -- >  expr        = letExpr <|> identifier <?> "expression"
 348 -- >
 349 -- >  letExpr     = do{ try (string "let"); ... }
 350 -- >  identifier  = many1 letter
 351
 352 try :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a
 353 try (ParsecT p)
 354     = ParsecT $ \s@(State _ pos _) -> do
 355         res <- p s
 356         case res of
 357           Consumed rep -> do r <- rep
 358                              case r of
 359                                Error err -> return $ Empty $ return $ Error
 360                                                          (setErrorPos pos err)
 361                                ok        -> return $ Consumed $ return $ ok
 362           empty        -> return $ empty
 363
 364 -- | The parser @token showTok posFromTok testTok@ accepts a token @t@
 365 -- with result @x@ when the function @testTok t@ returns @'Just' x@. The
 366 -- source position of the @t@ should be returned by @posFromTok t@ and
 367 -- the token can be shown using @showTok t@.
 368 --
 369 -- This combinator is expressed in terms of 'tokenPrim'.
 370 -- It is used to accept user defined token streams. For example,
 371 -- suppose that we have a stream of basic tokens tupled with source
 372 -- positions. We can than define a parser that accepts single tokens as:
 373 --
 374 -- >  mytoken x
 375 -- >    = token showTok posFromTok testTok
 376 -- >    where
 377 -- >      showTok (pos,t)     = show t
 378 -- >      posFromTok (pos,t)  = pos
 379 -- >      testTok (pos,t)     = if x == t then Just t else Nothing
 380
 381 token :: (Stream s Identity t)
 382       => (t -> String)            -- ^ Token pretty-printing function.
 383       -> (t -> SourcePos)         -- ^ Computes the position of a token.
 384       -> (t -> Maybe a)           -- ^ Matching function for the token to parse.
 385       -> Parsec s u a
 386 token showToken tokpos test = tokenPrim showToken nextpos test
 387     where
 388         nextpos _ tok ts = case runIdentity (uncons ts) of
 389                              Nothing -> tokpos tok
 390                              Just (tok',_) -> tokpos tok'
 391
 392 -- | The parser @token showTok nextPos testTok@ accepts a token @t@
 393 -- with result @x@ when the function @testTok t@ returns @'Just' x@. The
 394 -- token can be shown using @showTok t@. The position of the /next/
 395 -- token should be returned when @nextPos@ is called with the current
 396 -- source position @pos@, the current token @t@ and the rest of the
 397 -- tokens @toks@, @nextPos pos t toks@.
 398 --
 399 -- This is the most primitive combinator for accepting tokens. For
 400 -- example, the 'Text.Parsec.Char.char' parser could be implemented as:
 401 --
 402 -- >  char c
 403 -- >    = tokenPrim showChar nextPos testChar
 404 -- >    where
 405 -- >      showChar x        = "'" ++ x ++ "'"
 406 -- >      testChar x        = if x == c then Just x else Nothing
 407 -- >      nextPos pos x xs  = updatePosChar pos x
 408
 409 tokenPrim :: (Stream s m t)
 410           => (t -> String)                      -- ^ Token pretty-printing function.
 411           -> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function.
 412           -> (t -> Maybe a)                     -- ^ Matching function for the token to parse.
 413           -> ParsecT s u m a
 414 tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test
 415
 416 tokenPrimEx :: (Stream s m t)
 417             => (t -> String)
 418             -> (SourcePos -> t -> s -> SourcePos)
 419             -> Maybe (SourcePos -> t -> s -> u -> u)
 420             -> (t -> Maybe a)
 421             -> ParsecT s u m a
 422 tokenPrimEx showToken nextpos mbNextState test
 423     = case mbNextState of
 424         Nothing
 425           -> ParsecT $ \(State input pos user) -> do
 426               r <- uncons input
 427               case r of
 428                 Nothing -> return $ Empty $ return (sysUnExpectError "" pos)
 429                 Just (c,cs)
 430                   -> case test c of
 431                        Just x  -> let newpos   = nextpos pos c cs
 432                                       newstate = State cs newpos user
 433                                   in seq newpos $ seq newstate $
 434                                      return $ Consumed $ return $
 435                                        (Ok x newstate (newErrorUnknown newpos))
 436                        Nothing -> return $ Empty $ return $
 437                                     (sysUnExpectError (showToken c) pos)
 438         Just nextState
 439           -> ParsecT $ \(State input pos user) -> do
 440               r <- uncons input
 441               case r of
 442                 Nothing -> return $ Empty $ return (sysUnExpectError "" pos)
 443                 Just (c,cs)
 444                   -> case test c of
 445                        Just x  -> let newpos   = nextpos pos c cs
 446                                       newuser  = nextState pos c cs user
 447                                       newstate = State cs newpos newuser
 448                                   in seq newpos $ seq newstate $
 449                                      return $ Consumed $ return $
 450                                        (Ok x newstate (newErrorUnknown newpos))
 451                        Nothing -> return $ Empty $ return $
 452                                     (sysUnExpectError (showToken c) pos)
 453
 454 -- | @many p@ applies the parser @p@ /zero/ or more times. Returns a
 455 --    list of the returned values of @p@.
 456 --
 457 -- >  identifier  = do{ c  <- letter
 458 -- >                  ; cs <- many (alphaNum <|> char '_')
 459 -- >                  ; return (c:cs)
 460 -- >                  }
 461
 462 many :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]
 463 many p
 464   = do xs <- manyAccum (:) p
 465        return (reverse xs)
 466
 467 -- | @skipMany p@ applies the parser @p@ /zero/ or more times, skipping
 468 -- its result.
 469 --
 470 -- >  spaces  = skipMany space
 471
 472 skipMany :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
 473 skipMany p
 474   = do manyAccum (\_ _ -> []) p
 475        return ()
 476
 477 manyAccum :: (Stream s m t)
 478           => (a -> [a] -> [a])
 479           -> ParsecT s u m a
 480           -> ParsecT s u m [a]
 481 manyAccum accum p
 482     = ParsecT $ \s ->
 483         let walk xs state mr
 484               = do r <- mr
 485                    case r of
 486                      Empty mReply
 487                          -> do reply <- mReply
 488                                case reply of
 489                                  Error err -> return $ Ok xs state err
 490                                  _         -> error "Text.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."
 491                      Consumed mReply
 492                          -> do reply <- mReply
 493                                case reply of
 494                                  Error err
 495                                      -> return $ Error err
 496                                  Ok x s' _err
 497                                      -> let ys = accum x xs
 498                                         in seq ys (walk ys s' (runParsecT p s'))
 499         in do r <- runParsecT p s
 500               case r of
 501                 Empty mReply
 502                     -> do reply <- mReply
 503                           case reply of
 504                             Ok _ _ _
 505                                 -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."
 506                             Error err
 507                                 -> return $ Empty $ return (Ok [] s err)
 508                 consumed
 509                     -> return $ Consumed $ walk [] s (return consumed)
 510
 511
 512 -- < Running a parser: monadic (runPT) and pure (runP)
 513
 514 runPT :: (Stream s m t)
 515       => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
 516 runPT p u name s
 517     = do res <- runParsecT p (State s (initialPos name) u)
 518          r <- parserReply res
 519          case r of
 520            Ok x _ _  -> return (Right x)
 521            Error err -> return (Left err)
 522     where
 523         parserReply res
 524             = case res of
 525                 Consumed r -> r
 526                 Empty    r -> r
 527
 528 runP :: (Stream s Identity t)
 529      => Parsec s u a -> u -> SourceName -> s -> Either ParseError a
 530 runP p u name s = runIdentity $ runPT p u name s
 531
 532 -- | The most general way to run a parser. @runParserT p state filePath
 533 -- input@ runs parser @p@ on the input list of tokens @input@,
 534 -- obtained from source @filePath@ with the initial user state @st@.
 535 -- The @filePath@ is only used in error messages and may be the empty
 536 -- string. Returns a computation in the underlying monad @m@ that return either a 'ParseError' ('Left') or a
 537 -- value of type @a@ ('Right').
 538
 539 runParserT :: (Stream s m t)
 540            => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)
 541 runParserT = runPT
 542
 543 -- | The most general way to run a parser over the Identity monad. @runParser p state filePath
 544 -- input@ runs parser @p@ on the input list of tokens @input@,
 545 -- obtained from source @filePath@ with the initial user state @st@.
 546 -- The @filePath@ is only used in error messages and may be the empty
 547 -- string. Returns either a 'ParseError' ('Left') or a
 548 -- value of type @a@ ('Right').
 549 --
 550 -- >  parseFromFile p fname
 551 -- >    = do{ input <- readFile fname
 552 -- >        ; return (runParser p () fname input)
 553 -- >        }
 554
 555 runParser :: (Stream s Identity t)
 556           => Parsec s u a -> u -> SourceName -> s -> Either ParseError a
 557 runParser = runP
 558
 559 -- | @parse p filePath input@ runs a parser @p@ over Identity without user
 560 -- state. The @filePath@ is only used in error messages and may be the
 561 -- empty string. Returns either a 'ParseError' ('Left')
 562 -- or a value of type @a@ ('Right').
 563 --
 564 -- >  main    = case (parse numbers "" "11, 2, 43") of
 565 -- >             Left err  -> print err
 566 -- >             Right xs  -> print (sum xs)
 567 -- >
 568 -- >  numbers = commaSep integer
 569
 570 parse :: (Stream s Identity t)
 571       => Parsec s () a -> SourceName -> s -> Either ParseError a
 572 parse p = runP p ()
 573
 574 -- | The expression @parseTest p input@ applies a parser @p@ against
 575 -- input @input@ and prints the result to stdout. Used for testing
 576 -- parsers.
 577
 578 parseTest :: (Stream s Identity t, Show a)
 579           => Parsec s () a -> s -> IO ()
 580 parseTest p input
 581     = case parse p "" input of
 582         Left err -> do putStr "parse error at "
 583                        print err
 584         Right x  -> print x
 585
 586 -- < Parser state combinators
 587
 588 -- | Returns the current source position. See also 'SourcePos'.
 589
 590 getPosition :: (Monad m) => ParsecT s u m SourcePos
 591 getPosition = do state <- getParserState
 592                  return (statePos state)
 593
 594 -- | Returns the current input
 595
 596 getInput :: (Monad m) => ParsecT s u m s
 597 getInput = do state <- getParserState
 598               return (stateInput state)
 599
 600 -- | @setPosition pos@ sets the current source position to @pos@.
 601
 602 setPosition :: (Monad m) => SourcePos -> ParsecT s u m ()
 603 setPosition pos
 604     = do updateParserState (\(State input _ user) -> State input pos user)
 605          return ()
 606
 607 -- | @setInput input@ continues parsing with @input@. The 'getInput' and
 608 -- @setInput@ functions can for example be used to deal with #include
 609 -- files.
 610
 611 setInput :: (Monad m) => s -> ParsecT s u m ()
 612 setInput input
 613     = do updateParserState (\(State _ pos user) -> State input pos user)
 614          return ()
 615
 616 -- | Returns the full parser state as a 'State' record.
 617
 618 getParserState :: (Monad m) => ParsecT s u m (State s u)
 619 getParserState = updateParserState id
 620
 621 -- | @setParserState st@ set the full parser state to @st@.
 622
 623 setParserState :: (Monad m) => State s u -> ParsecT s u m (State s u)
 624 setParserState st = updateParserState (const st)
 625
 626 -- | @updateParserState f@ applies function @f@ to the parser state.
 627
 628 updateParserState :: (Monad m)
 629                   => (State s u -> State s u) -> ParsecT s u m (State s u)
 630 updateParserState f
 631     = ParsecT $ \s -> let s' = f s
 632                       in return $ Empty $ return (Ok s' s' (unknownError s'))
 633
 634 -- < User state combinators
 635
 636 -- | Returns the current user state.
 637
 638 getState :: (Monad m) => ParsecT s u m u
 639 getState = stateUser `liftM` getParserState
 640
 641 -- | @putState st@ set the user state to @st@.
 642
 643 putState :: (Monad m) => u -> ParsecT s u m ()
 644 putState u = do updateParserState $ \s -> s { stateUser = u }
 645                 return ()
 646
 647 -- | @updateState f@ applies function @f@ to the user state. Suppose
 648 -- that we want to count identifiers in a source, we could use the user
 649 -- state as:
 650 --
 651 -- >  expr  = do{ x <- identifier
 652 -- >            ; updateState (+1)
 653 -- >            ; return (Id x)
 654 -- >            }
 655
 656 modifyState :: (Monad m) => (u -> u) -> ParsecT s u m ()
 657 modifyState f = do updateParserState $ \s -> s { stateUser = f (stateUser s) }
 658                    return ()
 659
 660 -- XXX Compat
 661
 662 -- | An alias for putState for backwards compatibility.
 663
 664 setState :: (Monad m) => u -> ParsecT s u m ()
 665 setState = putState
 666
 667 -- | An alias for modifyState for backwards compatibility.
 668
 669 updateState :: (Monad m) => (u -> u) -> ParsecT s u m ()
 670 updateState = modifyState