# PM

Plain source file: PM.hs (2005-02-11)

PM is imported by: CmdLineParser3, CmdLineParser4.

```module PM(PM,tokenP,manyP,runPM) where
import Pretty

```

## An implementation of fairly conventional monadic parsing combinators

This is fairly simple. There is a complication in the error to case get descent error messages.

On success, a parser function returns the result and the remaining input. On error, the parser function returns the list of acceptable tokens at the high water mark, and the remaining input.

```newtype PM res =
PM {unPM ::[String] -> Either ([String],[String]) (res,[String])}

runPM p args =
case unPM p args of
Right (r,[]) -> r
Right (_,args) -> fail \$ "Unrecognized arguments: "++unwords args
Left (args,errs) ->
fail \$ ('\n':) \$ render \$
text "Expected one of:"<+>fsep (map text errs)
\$\$ (if null args then empty else text "Found: "<+>fsep (map text args))
\$\$ text ""

instance Functor PM where fmap = liftM

instance Monad PM where
fail s = PM \$ \ args->Left (args,[s])
return x = PM \$ \args->Right (x,args)
PM p1>>=xp2 = PM \$ \ args->case p1 args of
Left err -> Left err
Right (x,args') -> unPM (xp2 x) args'

instance MonadPlus PM where
mzero = fail "no parse" -- Hmm. Error message should say what was expected
mplus (PM p1) (PM p2) =
PM \$ \ args -> case (p1 args,p2 args) of
(Right res,_) -> Right res
(r1@(Left (a1,errs1)),r2@(Left (a2,errs2))) ->
case compare (length a1) (length a2) of
LT -> r1
EQ -> Left (a1,errs1++errs2)
GT -> r2
(_,r2) -> r2

get = PM \$ \ args -> Right (args,args)
set args = PM \$ \ _ -> Right ((),args)

tokenP check errmsg =
do args <- get
case args of
a:as -> maybe (fail errmsg)
(\a->set as>>return a)
(check a)
[] -> fail errmsg

manyP p = ((:) `fmap` p `ap` manyP p) `mplus` return []
```

Index

(HTML for this module was generated on 2005-02-11. About the conversion tool.)