uu-parsinglib 2.5.0 → 2.5.1

raw patch · 5 files changed

+319/−149 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Text/ParserCombinators/UU.hs +5/−1
• src/Text/ParserCombinators/UU/Core.hs +214/−136
• src/Text/ParserCombinators/UU/Examples.hs +15/−6
• src/Text/ParserCombinators/UU/Perms.hs +82/−0
• uu-parsinglib.cabal +3/−6

@@ -1,4 +1,4 @@--- | The non-exported module "Text.ParserCombinators.UU.Examples" contains a list of examples of how to use the main functionality of this library: it demonstrates:+-- | The non-exported module "Text.ParserCombinators.UU.Examples" contains a list of examples of how to use the main functionality of this library which demonstrates: -- -- * how to write basic parsers --@@ -12,13 +12,17 @@ -- -- * what kind of error messages you can get if you write erroneous parsers --+-- * how to use the permutation parsers+--  module Text.ParserCombinators.UU ( module Text.ParserCombinators.UU.Core                                  , module Text.ParserCombinators.UU.BasicInstances                                  , module Text.ParserCombinators.UU.Derived+                                 , module Text.ParserCombinators.UU.Merge                                  , module Text.ParserCombinators.UU.Merge) where import Text.ParserCombinators.UU.Core import Text.ParserCombinators.UU.BasicInstances import Text.ParserCombinators.UU.Derived import Text.ParserCombinators.UU.Merge+import Text.ParserCombinators.UU.Perms 

@@ -1,4 +1,3 @@-  {-# LANGUAGE  RankNTypes,                GADTs,               MultiParamTypeClasses,@@ -41,128 +40,193 @@  class loc `IsLocationUpdatedBy` a where     advance::loc -> a -> loc++--  ** An extension to @`Alternative`@ which indicates a biased choice+-- | In order to be able to describe greedy parsers we introduce an extra operator, whch indicates a biased choice+class ExtAlternative p where+  (<<|>) :: p a -> p a -> p a       --- * The type  describing parsers: @`P`@+-- * The  triples containg a  history, a future parser and a recogniser: @`T`@ -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%--- %%%%%%%%%%%%% Parsers     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+-- %%%%%%%%%%%%% Triples     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+-- actual parsers+data T st a  = T  (forall r . (a  -> st -> Steps r)  -> st -> Steps       r  ) --  history parser+                  (forall r . (      st -> Steps r)  -> st -> Steps   (a, r) ) --  future parser+                  (forall r . (      st -> Steps r)  -> st -> Steps       r  ) --  recogniser -data  P   st  a =  P  (forall r . (a  -> st -> Steps r)  -> st -> Steps       r  ) --  history parser-                      (forall r . (      st -> Steps r)  -> st -> Steps   (a, r) ) --  future parser-                      (forall r . (      st -> Steps r)  -> st -> Steps       r  ) --  recogniser-                      Nat                                                          --  minimal length-                      (Maybe a)                                                    --  possibly empty with value     +instance Functor (T st) where+  fmap f (T ph pf pr) = T  ( \  k -> ph ( k .f ))+                           ( \  k ->  pushapply f . pf k) -- pure f <*> pf+                           pr+  f <$ (T _ _ pr)     = T  ( pr . ($f)) +                           ( \ k st -> push f ( pr k st)) +                           pr +-- ** Triples are Applicative:  @`<*>`@,  @`<*`@,  @`*>`@ and  @`pure`@+instance   Applicative (T  state) where+  T ph pf pr  <*> ~(T qh qf qr)  =  T ( \  k -> ph (\ pr -> qh (\ qr -> k (pr qr))))+                                      ((apply .) . (pf .qf))+                                       ( pr . qr)+  T ph pf pr  <*  ~(T _  _  qr)   = T ( ph. (qr.))  (pf. qr)   (pr . qr)+  T _  _  pr  *>  ~(T qh qf qr )  = T ( pr . qh  )  (pr. qf)    (pr . qr)            +  pure a                          = T ($a) ((push a).) id ++instance   Alternative (T  state) where +  T ph pf pr  <|> T qh qf qr  =   T (\  k inp  -> ph k inp `best` qh k inp)+                                    (\  k inp  -> pf k inp `best` qf k inp)+                                    (\  k inp  -> pr k inp `best` qr k inp)+  empty                =  T  ( \  k inp  ->  noAlts) ( \  k inp  ->  noAlts) ( \  k inp  ->  noAlts)++-- instance ExtAlternative (T st) where +-- unfortunatelythis is not possible since we have to make the choice for swapping elsewhere++choose:: (forall a . Steps a -> Steps a -> Steps a) -> T st a -> T st a -> T st a+choose best (T ph pf pr)  (T qh qf qr) = +    T  (\ k st -> let left  = norm (ph k st)+                  in if has_success left then left else left `best` qh k st)+       (\ k st -> let left  = norm (pf k st)+                  in if has_success left then left else left `best` qf k st) +       (\ k st -> let left  = norm (pr k st)+                  in if has_success left then left else left `best` qr k st)+            ++instance ExtAlternative Maybe where+  Nothing <<|> r        = r+  l       <<|> Nothing  = l +  l       <<|> r        = l -- choosing the high priority alternative ? is this the right choice?+++-- * The  descriptor @`P`@ of a parser, including the tupled parser corresponding to this descriptor+-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+-- %%%%%%%%%%%%% Parser Descriptors    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%++data  P   st  a =  P         (T  st a) --  actual parsers+                      (Maybe (T st a)) --  non-empty parsers; Nothing if  they are absent+                      Nat              --  minimal length+                      (Maybe a)        --  possibly empty with value ++getOneP (P _ _  Zero _)    = error "The element is a special parser which cannot be combined"+getOneP (P _ Nothing l _ )    = Nothing+getOneP (P _ onep    l _ )    = Just( P (mkParser onep Nothing) onep    l Nothing)+getZeroP (P _ _ l Nothing) =  Nothing+getZeroP (P _ _ l pe)      =  Just ( P (mkParser Nothing pe)   Nothing l pe)++mkParser Nothing Nothing    = empty+mkParser (Just nt) Nothing  = nt+mkParser Nothing   (Just a) = pure a+mkParser (Just nt) (Just a) = nt <|> pure a+ -- ** Parsers are functors:  @`fmap`@ instance   Functor (P  state) where -  fmap f   (P   ph pf pr l me)   =  P  ( \  k -> ph ( k .f ))-                                       ( \  k ->  pushapply f . pf k) -- pure f <*> pf-                                       (pr) -                                       l-                                       (fmap f me)-  f <$   (P _  _  qr ql qe)   -    = P ( qr . ($f)) (\ k st -> push f (qr k st)) qr  ql  (case qe of Nothing -> Nothing; _ -> Just f)+  fmap f   (P  ap np l me)   =  let nnp =  fmap (fmap     f)  np+                                    nep =  f <$> me                                    +                                in  P  (mkParser nnp nep) nnp  l nep+  f <$     (P  ap np l me)   =  let nnp =  fmap (f <$)        np+                                    nep =  f <$   me                                    +                                in  P  (mkParser nnp nep) nnp  l nep   -- ** Parsers are Applicative:  @`<*>`@,  @`<*`@,  @`*>`@ and  @`pure`@ instance   Applicative (P  state) where-  P ph pf pr pl pe <*> ~(P qh qf qr ql qe)  =  P  ( \  k -> ph (\ pr -> qh (\ qr -> k (pr qr))))-                                                  ((apply .) . (pf .qf))-                                                  ( pr . qr)-                                                  (nat_add pl ql)-                                                  (pe <*> qe)-  P ph pf pr pl pe <*  ~(P _  _  qr ql qe)   = P  ( ph. (qr.))  (pf. qr)   (pr . qr)-                                                  (nat_add pl ql) -                                                  (case qe of Nothing -> Nothing ; _ -> pe)-  P _  _  pr pl pe *>  ~(P qh qf qr ql qe)   = P ( pr . qh  )  (pr. qf)    (pr . qr)           -                                                 (nat_add pl ql) (case pe of Nothing -> Nothing ; _ -> qe) -  pure a                                     =  P  ($a) ((push a).) id Zero (Just a)+  P ap np  pl pe <*> ~(P aq nq  ql qe)  =  let nnp = do {npp <- np ;  return (npp <*> aq)}+                                               nep =  (pe <*> qe)+                                           in  P  (mkParser nnp nep) nnp (nat_add pl ql) nep+  P ap np pl pe  <*  ~(P aq nq  ql qe)   = let nnp = do {npp <- np ;  return (npp <* aq)}+                                               nep =  (pe <* qe)+                                           in  P  (mkParser nnp nep) nnp (nat_add pl ql) nep+  P ap np  pl pe  *>  ~(P aq nq ql qe)   = let nnp = do {npp <- np ;  return (npp *> aq)}+                                               nep =  (pe *> qe)+                                           in  P  (mkParser nnp nep) nnp (nat_add pl ql) nep +  pure a                                 = P (pure a) Nothing Zero (Just a)   -- ** Parsers are Alternative:  @`<|>`@ and  @`empty`@  instance   Alternative (P   state) where -  P ph pf pr pl pe <|> P qh qf qr ql qe +  P ap np  pl pe <|> P aq nq ql qe      =  let (rl, b) = nat_min pl ql-           bestx :: Steps a -> Steps a -> Steps a-           bestx = if b then flip best else best -       in    P (\  k inp  -> ph k inp `bestx` qh k inp)-               (\  k inp  -> pf k inp `bestx` qf k inp)-               (\  k inp  -> pr k inp `bestx` qr k inp)-               rl-               (case (pe, qe)  of+           Nothing `alt` q  = q+           p       `alt` Nothing = p+           Just p  `alt` Just q  = Just (p <|>q)+       in  let nnp =  (if b then (nq `alt` np) else (np `alt` nq))+               nep =   (case (pe, qe)  of                  (Nothing, _      ) -> qe                  (_      , Nothing) -> pe                  (_      , _      ) -> error "ambiguous parser because two sides of choice can be empty")-  empty                =  P  ( \  k inp  ->  noAlts)-                             ( \  k inp  ->  noAlts)-                             ( \  k inp  ->  noAlts)-                             Infinite-                             Nothing+           in  P (mkParser nnp nep) nnp rl nep+  empty  =  P  empty empty  Infinite Nothing  -- ** An alternative for the Alternative, which is greedy:  @`<<|>`@--- | `<<|>` is the greedy version of `<|>`. If its left hand side parser can make some progress that alternative is comitted. Can be used to make parsers faster, and even+-- | `<<|>` is the greedy version of `<|>`. If its left hand side parser can make some progress that alternative is committed. Can be used to make parsers faster, and even --   get a complete Parsec equivalent behaviour, with all its (dis)advantages. use with are! -P ph pf pr pl pe <<|> P qh qf qr ql qe +instance ExtAlternative (P st) where+  P ap np pl pe <<|> P aq nq ql qe      = let (rl, b) = nat_min pl ql           bestx = if b then flip best else best-      in   P ( \ k st  -> let left = norm (ph k st) -                          in if has_success left then left-                             else left `bestx` norm (qh k st))-             ( \ k st  ->  let left = norm (pf k st) -                           in if has_success left then left-                              else left `bestx` norm (qf k st))-             ( \ k st  ->  let left = norm (pr k st) -                           in if has_success left then left-                              else left `bestx` norm (qr k st))+      in   P (choose bestx ap aq )+             (maybe np (\nqq -> maybe nq (\npp -> return( choose bestx npp nqq)) np) nq)              rl-             (case (pe, qe)  of-                 (Nothing, _      ) -> qe-                 (_      , Nothing) -> pe-                 (_      , _      ) -> error "ambiguous parser because two sides of choice can be empty")+             (pe <|> qe)  -- ** Parsers can recognise single tokens:  @`pSym`@ and  @`pSymExt`@--- | Many parsing libraries do not make a distinction between the terminal symbols of the language recognised +--   Many parsing libraries do not make a distinction between the terminal symbols of the language recognised  --   and the tokens actually constructed from the  input.  --   This happens e.g. if we want to recognise an integer or an identifier:  --   we are also interested in which integer occurred in the input, or which identifier. ---   The function `pSymExt` takes as argument a value of some type `symbol', and returns a value of type `token'. The parser will in general depend on some +--   The function `pSymExt` takes as argument a value of some type `symbol', and returns a value of type `token'.+--  The parser will in general depend on some  --   state which is maintained holding the input. The functional dependency fixes the `token` type, based on the `symbol` type and the type of the parser `p`.---   Since `pSymExt' is overloaded both the type and the value of symbol determine how to decompose the input in a `token` and the remaining input.---   `pSymExt`  takes two extra parameters: one describing the minimal numer of tokens recognised, ++-- | Since `pSymExt' is overloaded both the type and the value of symbol determine how to decompose the input in a `token` +--   and the remaining input.+--   `pSymExt` takes two extra parameters: one describing the minimal number of tokens recognised,  --   and the second whether the symbol can recognise the empty string and the value which is to be returned in that case    pSymExt ::   (Provides state symbol token) => Nat -> Maybe token -> symbol -> P state token+pSymExt l e a  = P t (Just t) l e+                 where t = T ( \ k inp -> splitState a k inp)+                             ( \ k inp -> splitState a (\ t inp' -> push t (k inp')) inp)+                             ( \ k inp -> splitState a (\ _ inp' -> k inp') inp) -  -pSymExt l e a  = P ( \ k inp -> splitState a k inp)-                   ( \ k inp -> splitState a (\ t inp' -> push t (k inp')) inp)-                   ( \ k inp -> splitState a (\ _ inp' -> k inp') inp)-                   l-                   e--- | @`pSym`@ covers the most common case of recognsiing a symbol: a single token is removed form the input, and it cannot recognise the empty string+-- | @`pSym`@ covers the most common case of recognsiing a symbol: a single token is removed form the input, +-- and it cannot recognise the empty string pSym    ::   (Provides state symbol token) =>                       symbol -> P state token pSym  s   = pSymExt (Succ Zero) Nothing s   -- ** Parsers are Monads:  @`>>=`@ and  @`return`@+-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+-- %%%%%%%%%%%%% Monads      %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -unParser_h (P  h   _  _  _ _)  =  h-unParser_f (P  _   f  _  _ _)  =  f-unParser_r (P  _   _  r  _ _)  =  r+unParser_h (P (T  h   _  _ ) _ _ _ )  =  h+unParser_f (P (T  _   f  _ ) _ _ _ )  =  f+unParser_r (P (T  _   _  r ) _ _ _ )  =  r           -+-- pas op de P moet aan de buitenkant !! instance  Monad (P st) where-       P  ph pf pr pl pe >>=  a2q = -                P  (  \k -> ph (\ a -> unParser_h (a2q a) k))-                   (  \k -> ph (\ a -> unParser_f (a2q a) k))-                   (  \k -> ph (\ a -> unParser_r (a2q a) k))-                   (nat_add pl (error "cannot compute minimal length of right hand side of monadic parser"))-                   (case pe of+       p@(P  ap np lp ep) >>=  a2q = +          (P newap newnp (nat_add lp (error "cannot compute minimal length of right hand side of monadic parser")) newep)+          where (newep, newnp, newap) = case ep of+                                 Nothing -> (Nothing, t, maybe empty id t) +                                 Just a  -> let  P aq nq lq eq = a2q a +                                            in  ( eq, combine t nq , t `alt` aq)+                Nothing  `alt` q    = q+                Just p   `alt` q    = p <|> q+                t = case np of                     Nothing -> Nothing-                    Just a -> let (P _ _ _ _ a2qv) = a2q a in a2qv)+                    Just (T h _ _  ) -> Just (T  (  \k -> h (\ a -> unParser_h (a2q a) k))+                                                 (  \k -> h (\ a -> unParser_f (a2q a) k))+                                                 (  \k -> h (\ a -> unParser_r (a2q a) k)))+                combine Nothing     Nothing     = Nothing+                combine l@(Just _ ) Nothing     =  l+                combine Nothing     r@(Just _ ) =  r+                combine (Just l)    (Just r)    = Just (l <|> r)        return  = pure  + -- * Additional useful combinators -- ** Controlling the text of error reporting:  @`<?>`@ -- | The parsers build a list of symbols which are expected at a specific point. @@ -171,38 +235,44 @@ --   The @`<?>`@ combinator replaces this list of symbols by it's righ-hand side argument.  (<?>) :: P state a -> String -> P state a-P  ph  pf  pr  pl pe <?> label = P ( \ k inp -> replaceExpected  ( ph k inp))-                                   ( \ k inp -> replaceExpected  ( pf k inp))-                                   ( \ k inp -> replaceExpected  ( pr k inp))-                                   pl-                                   pe-                           where replaceExpected (Fail _ c) = (Fail [label] c)-                                 replaceExpected others     = others+P  _  np  pl pe <?> label +  = let nnp = case np of+              Nothing -> Nothing+              Just ((T ph pf  pr)) -> Just(T ( \ k inp -> replaceExpected  ( ph k inp))+                                             ( \ k inp -> replaceExpected  ( pf k inp))+                                             ( \ k inp -> replaceExpected  ( pr k inp)))+        replaceExpected (Fail _ c) = (Fail [label] c)+        replaceExpected others     = others+    in P (mkParser nnp pe) nnp pl pe    -- ** Parsers can be disambiguated using micro-steps:  @`micro`@ -- | `micro` inserts a `Cost` step into the sequence representing the progress the parser is making; for its use see `Text.ParserCombinators.UU.Examples` -P ph pf pr pl pe `micro` i = P ( \ k st -> ph (\ a st -> Micro i (k a st)) st)-                               ( \ k st -> pf (Micro i .k) st)-                               ( \ k st -> pr (Micro i .k) st)-                               pl-                               pe +P _  np  pl pe `micro` i  +  = let nnp = case np of+              Nothing -> Nothing+              Just ((T ph pf  pr)) -> Just(T ( \ k st -> ph (\ a st -> Micro i (k a st)) st)+                                             ( \ k st -> pf (Micro i .k) st)+                                             ( \ k st -> pr (Micro i .k) st))+    in P (mkParser nnp pe) nnp pl pe  -- ** Dealing with (non-empty) Ambigous parsers: @`amb`@  --   For the precise functionng of the combinators we refer to the technical report mentioned in the README file --   @`amb`@ converts an ambiguous parser into a parser which returns a list of possible recognitions. amb :: P st a -> P st [a]+amb (P _  np  pl pe) + = let  combinevalues  :: Steps [(a,r)] -> Steps ([a],r)+        combinevalues lar  =   Apply (\ lar -> (map fst lar, snd (head lar))) lar+        nnp = case np of+              Nothing -> Nothing+              Just ((T ph pf  pr)) -> Just(T ( \k     ->  removeEnd_h . ph (\ a st' -> End_h ([a], \ as -> k as st') noAlts))+                                             ( \k inp ->  combinevalues . removeEnd_f $ pf (\st -> End_f [k st] noAlts) inp)+                                             ( \k     ->  removeEnd_h . pr (\ st' -> End_h ([undefined], \ _ -> k  st') noAlts)))+        nep = (fmap pure pe)+    in  P (mkParser nnp nep) nnp pl nep -amb (P ph pf pr pl pe) = P ( \k     ->  removeEnd_h . ph (\ a st' -> End_h ([a], \ as -> k as st') noAlts))-                           ( \k inp ->  combinevalues . removeEnd_f $ pf (\st -> End_f [k st] noAlts) inp)-                           ( \k     ->  removeEnd_h . pr (\ st' -> End_h ([undefined], \ _ -> k  st') noAlts))-                           pl-                           (fmap pure pe)-                         where  combinevalues  :: Steps [(a,r)] -> Steps ([a],r)-                                combinevalues lar           =   Apply (\ lar -> (map fst lar, snd (head lar))) lar -        -- ** Parse errors can be retreived from the state: @`pErrors`@ -- | `getErrors` retreives the correcting steps made since the last time the function was called. The result can,  --   using a monad, be used to control how to--    proceed with the parsing process.@@ -211,12 +281,13 @@   getErrors    ::  state   -> ([error], state)  pErrors :: Stores st error => P st [error]-pErrors = P ( \ k inp -> let (errs, inp') = getErrors inp in k    errs    inp' )-            ( \ k inp -> let (errs, inp') = getErrors inp in push errs (k inp'))-            ( \ k inp -> let (errs, inp') = getErrors inp in            k inp' )-            Zero       -- this parser does not consume input-            (Just (error "pErrors cannot occur in lhs of bind"))  -- the errors consumed cannot be determined statically! +pErrors = let nnp = Just (T ( \ k inp -> let (errs, inp') = getErrors inp in k    errs    inp' )+                            ( \ k inp -> let (errs, inp') = getErrors inp in push errs (k inp'))+                            ( \ k inp -> let (errs, inp') = getErrors inp in            k inp' ))+              nep =  (Just (error "pErrors cannot occur in lhs of bind"))  -- the errors consumed cannot be determined statically!+          in P (mkParser nnp nep) nnp Zero nep + -- ** The current position  can be retreived from the state: @`pPos`@ -- | `pPos` retreives the correcting steps made since the last time the function was called. The result can,  --   using a monad, be used to control how to--    proceed with the parsing process.@@ -225,54 +296,55 @@   getPos    ::  state   -> pos  pPos :: HasPosition st pos => P st pos-pPos = P ( \ k inp -> let pos = getPos inp in k    pos    inp )-         ( \ k inp -> let pos = getPos inp in push pos (k inp))-         ( \ k inp -> let pos = getPos inp in           k inp )-         Zero       -- this parser does not consume input-         (Just (error "pPos cannot occur in lhs of bind"))  -- the errors consumed cannot be determined statically! +pPos =  let nnp = Just ( T ( \ k inp -> let pos = getPos inp in k    pos    inp )+                       ( \ k inp -> let pos = getPos inp in push pos (k inp))+                       ( \ k inp -> let pos = getPos inp in           k inp ))+            nep =  Just (error "pPos cannot occur in lhs of bind")  -- the errors consumed cannot be determined statically!+        in P (mkParser nnp nep) nnp Zero nep + -- ** Starting and finalising the parsing process: @`pEnd`@ and @`parse`@ -- | The function `pEnd` should be called at the end of the parsing process. It deletes any unsonsumed input, and reports its preence as an eror.  pEnd    :: (Stores st error, Eof st) => P st [error]-pEnd    = P ( \ k inp ->   let deleterest inp =  case deleteAtEnd inp of-                                                    Nothing -> let (finalerrors, finalstate) = getErrors inp-                                                               in k  finalerrors finalstate-                                                    Just (i, inp') -> Fail []  [const (i,  deleterest inp')]-                           in deleterest inp)-            ( \ k   inp -> let deleterest inp =  case deleteAtEnd inp of-                                                    Nothing -> let (finalerrors, finalstate) = getErrors inp-                                                               in push finalerrors (k finalstate)-                                                    Just (i, inp') -> Fail [] [const ((i, deleterest inp'))]-                           in deleterest inp)-            ( \ k   inp -> let deleterest inp =  case deleteAtEnd inp of-                                                    Nothing -> let (finalerrors, finalstate) = getErrors inp-                                                               in  (k finalstate)-                                                    Just (i, inp') -> Fail [] [const (i, deleterest inp')]-                           in deleterest inp)-            Zero-            (error "Unforeseen use of pEnd function; pEnd should only be used in function running the actual parser")-+pEnd    = let nnp = Just ( T ( \ k inp ->   let deleterest inp =  case deleteAtEnd inp of+                                                  Nothing -> let (finalerrors, finalstate) = getErrors inp+                                                             in k  finalerrors finalstate+                                                  Just (i, inp') -> Fail []  [const (i,  deleterest inp')]+                                            in deleterest inp)+                             ( \ k   inp -> let deleterest inp =  case deleteAtEnd inp of+                                                  Nothing -> let (finalerrors, finalstate) = getErrors inp+                                                             in push finalerrors (k finalstate)+                                                  Just (i, inp') -> Fail [] [const ((i, deleterest inp'))]+                                            in deleterest inp)+                             ( \ k   inp -> let deleterest inp =  case deleteAtEnd inp of+                                                  Nothing -> let (finalerrors, finalstate) = getErrors inp+                                                             in  (k finalstate)+                                                  Just (i, inp') -> Fail [] [const (i, deleterest inp')]+                                            in deleterest inp))+              nep = Nothing --  (error "Unforeseen use of pEnd function; pEnd should only be used in function running the actual parser")+         in P (mkParser nnp nep) nnp Zero nep+             -- The function @`parse`@ shows the prototypical way of running a parser on a some specific input -- By default we use the future parser, since this gives us access to partal result; future parsers are expected to run in less space parse :: (Eof t) => P t a -> t -> a-parse   (P _  pf _ _ _)  = fst . eval . pf  (\ rest   -> if eof rest then succeedAlways        else error "pEnd missing?")-parse_h (P ph _  _ _ _)  = fst . eval . ph  (\ a rest -> if eof rest then push a failAlways else error "pEnd missing?") +parse   (P (T _  pf _) _ _ _)  = fst . eval . pf  (\ rest   -> if eof rest then succeedAlways        else error "pEnd missing?")+parse_h (P (T ph _  _) _ _ _)  = fst . eval . ph  (\ a rest -> if eof rest then push a failAlways else error "pEnd missing?")   -- ** The state may be temporarily change type: @`pSwitch`@ -- | `pSwitch` takes the current state and modifies it to a different type of state to which its argument parser is applied.  --   The second component of the result is a function which  converts the remaining state of this parser back into a valuee of the original type. -pSwitch :: (st1 -> (st2, st2 -> st1)) -> P st2 a -> P st1 a-pSwitch split (P ph pf pr pl pe)    = P (\ k st1 ->  let (st2, back) = split st1+pSwitch :: (st1 -> (st2, st2 -> st1)) -> P st2 a -> P st1 a -- we require let (n,f) = split st in f n to be equal to st+pSwitch split (P _ np pl pe)    +   = let nnp = fmap (\ (T ph pf pr) ->T (\ k st1 ->  let (st2, back) = split st1                                                      in ph (\ a st2' -> k a (back st2')) st2)                                         (\ k st1 ->  let (st2, back) = split st1                                                      in pf (\st2' -> k (back st2')) st2)                                         (\ k st1 ->  let (st2, back) = split st1-                                                     in pr (\st2' -> k (back st2')) st2)-                                        pl-                                        pe +                                                     in pr (\st2' -> k (back st2')) st2)) np+     in P (mkParser nnp pe) nnp pl pe  -- * Maintaining Progress Information -- | The data type @`Steps`@ is the core data type around which the parsers are constructed.@@ -410,12 +482,11 @@ removeEnd_f (End_f(s:ss) r)    =   Apply  (:(map  eval ss)) s                                                   `best`                                           removeEnd_f r+ -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -- %%%%%%%%%%%%% Auxiliary Functions and Types        %%%%%%%%%%%%%%%%%%% -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -trace' v m = m - -- * Auxiliary functions and types -- ** Checking for non-sensical combinations: @`must_be_non_empty`@ and @`must_be_non_empties`@ -- | The function checks wehther its second argument is a parser which can recognise the mety sequence. If so an error message is given@@ -423,7 +494,7 @@ --   the module Text>parserCombinators.UU.Derived  must_be_non_empty :: [Char] -> P t t1 -> t2 -> t2-must_be_non_empty msg p@(P _ _ _ _ (Just _ )) _ +must_be_non_empty msg p@(P _ _ Zero _) _              = error ("The combinator " ++ msg ++ "\n" ++                      "    requires that it's argument cannot recognise the empty string\n") must_be_non_empty _ _  q  = q@@ -432,11 +503,12 @@ --   make sense if both parsers can recognise the empty string. Your grammar is then highly ambiguous.  must_be_non_empties :: [Char] -> P t1 t -> P t3 t2 -> t4 -> t4-must_be_non_empties  msg (P _ _ _ _ (Just _ )) (P _ _ _ _ (Just _ )) _ +must_be_non_empties  msg (P _ _ Zero _) (P _ _ Zero _ ) _              = error ("The combinator " ++ msg ++ "\n" ++                      "    requires that not both arguments can recognise the empty string\n") must_be_non_empties  msg _  _ q = q + -- ** The type @`Nat`@ for describing the minimal number of tokens consumed -- | The data type @`Nat`@ is used to represent the minimal length of a parser. --   Care should be taken in order to not evaluate the right hand side of the binary functions @`nat_min`@ and @`nat-add`@ more than necesssary.@@ -456,7 +528,13 @@ nat_add Zero      r = trace' "Zero in add\n"     r nat_add (Succ l)  r = trace' "Succ in add\n"     (Succ (nat_add l r)) -get_length (P _ _ _ l _) = l+-- get_length (P _ _  l _) = l+++trace' v m = m +++   

@@ -3,12 +3,18 @@               TypeSynonymInstances,               MultiParamTypeClasses  #-} -module Text.ParserCombinators.UU.Examples where+-- | This module contains a lot of examples of the typical use of our parser combinator library. +--   We strongly encourage you to take a look at the source code+--   At the end you find a @`main`@ function which demonsrates the main characteristics. +--   Only the `@run`@ function is exported since it may come in handy elsewhere.++module Text.ParserCombinators.UU.Examples (run) where import Char import Text.ParserCombinators.UU.Core import Text.ParserCombinators.UU.Derived import Text.ParserCombinators.UU.BasicInstances import Text.ParserCombinators.UU.Merge+import Text.ParserCombinators.UU.Perms import Control.Monad  -- | The fuction @`run`@ runs the parser and shows both the result, and the correcting steps which were taken during the parsing process.@@ -28,6 +34,8 @@ pa  = lift <$> pSym 'a' pb  :: Parser String  pb = lift <$> pSym 'b'+pc  :: Parser String +pc = lift <$> pSym 'c' lift a = [a]  -- | We can now run the parser @`pa`@ on input \"a\", which succeeds:@@ -284,7 +292,7 @@ --   munch :: Parser String-munch =  pMunch ( `elem` "^=*") +munch =  pa *> pMunch ( `elem` "^=*") <* pb  -- | The effect of the combinator `manytill` from Parsec can be achieved: --@@ -332,10 +340,10 @@  -- parsing two alternatives and returning both rsults pIntList :: Parser [Int]-pIntList       =  pParens ((pSym ';') `pListSep` (read <$> pList (pSym ('0', '9'))))-parseIntString =  pList ( pSym ('\000', '\254'))+pIntList       =  pParens ((pSym ';') `pListSep` (read <$> pList1 (pSym ('0', '9'))))+parseIntString =  pParens ((pSym ';') `pListSep` (         pList1 (pSym ('0', '9')))) -parseBoth =  amb (Left <$> pIntList <|> Right <$> parseIntString)+parseBoth =  amb (Left <$>  parseIntString <|> Right <$> pIntList)  main :: IO () main = do test1@@ -348,9 +356,10 @@           run paz "ab1z7"           run paz' "m"           run paz' ""-          run (pa <|> pb <?> "just a message") "c"+          run (pa <|> pb {-<?> "just a message"-}) "c"           run parseBoth "(123;456;789)"           run munch "a^=^**^^b"+          run (pPerms ((,,) ~$~ pa ~*~ pb ~*~ pc)) "cab"   

@@ -0,0 +1,82 @@+{-# LANGUAGE ExistentialQuantification,+             ScopedTypeVariables #-}+-- | This module contains the combinators for building permutation phrases as described in. +-- They differ from the version found in Control.Applicative in that elements may recognise the empty string too. +-- In addition we provide a combinator which allows separators between the elements of the permutation.+-- For an example of their use see the end of the @`main`@ function in "Text.ParserCombinators.UU.Examples"+--+-- @+--      \@article{1030338,+--	Address = {New York, NY, USA},+--	Author = {Baars, Arthur I. and L{\"o}h, Andres and Swierstra, S. Doaitse},+--	Date-Modified = {2008-12-01 21:44:00 +0100},+--	Doi = {http://dx.doi.org/10.1017/S0956796804005143},+--	Issn = {0956-7968},+--	Journal = {J. Funct. Program.},+--	Number = {6},+--	Pages = {635--646},+--	Publisher = {Cambridge University Press},+--	Title = {Parsing permutation phrases},+--	Volume = {14},+--	Year = {2004}}+-- @+--++module Text.ParserCombinators.UU.Perms(Perms(), pPerms, pPermsSep, succeedPerms, (~*~), (~$~)) where+import Text.ParserCombinators.UU.Core+import Data.Maybe++-- =======================================================================================+-- ===== PERMUTATIONS ================================================================+-- =======================================================================================++newtype Perms st a = Perms (Maybe (P st a), [Br st a])+data Br st a = forall b. Br (Perms st (b -> a)) (P st b)++instance Functor (Perms st) where+  fmap f (Perms (ma, brs)) = Perms (fmap (f <$>) ma, (map (fmap f) brs))++instance  Functor (Br st) where+  fmap f (Br perm p) = Br (fmap (f.) perm) p ++(~*~) ::  Perms st (a -> b) -> P st a -> Perms st b+perms ~*~ p = perms `add` (getZeroP p, getOneP p)++(~$~) ::  (a -> b) -> P st a -> Perms st b+f     ~$~ p = succeedPerms f ~*~ p++succeedPerms ::  a -> Perms st a+succeedPerms x = Perms (Just (pure x), []) ++add ::  Perms st (a -> b) -> (Maybe (P st a),Maybe (P st a)) -> Perms st b+add b2a@(Perms (eb2a, nb2a)) bp@(eb, nb)+ =  let changing ::  (a -> b) -> Perms st a -> Perms st b+        f `changing` Perms (ep, np) = Perms (fmap (f <$>) ep, [Br ((f.) `changing` pp) p | Br pp p <- np])+    in Perms+      ( do { f <- eb2a+           ; x <- eb+           ; return (f <*>  x)+           }+      ,  (case nb of+          Nothing     -> id+          Just pb     -> (Br b2a  pb:)+        )[ Br ((flip `changing` c) `add`  bp) d |  Br c d <- nb2a]+      )++pPerms ::  Perms st a -> P st a +pPerms (Perms (empty,nonempty))+ = foldl (<|>) (fromMaybe pFail empty) [ (flip ($)) <$> p <*> pPerms pp+                                       | Br pp  p <- nonempty+                                       ]++pPermsSep ::  P st x -> Perms st a -> P st a+pPermsSep (sep :: P st z) perm = p2p (pure ()) perm+ where  p2p :: P st x -> Perms st a -> P st a+        p2p fsep (Perms (mbempty, nonempties)) = +                let empty          = fromMaybe  pFail mbempty+                    pars (Br t p)  = flip ($) <$ fsep <*> p <*> p2p sep t+                in foldr (<|>) empty (map pars nonempties)              +        p2p_sep =  p2p sep ++pFail :: P st a+pFail = empty                  

@@ -1,5 +1,5 @@ Name:                uu-parsinglib-Version:             2.5.0+Version:             2.5.1 Build-Type:          Simple License:             MIT Copyright:           S Doaitse Swierstra @@ -24,10 +24,6 @@                      .                      The file "Text.ParserCombinators.UU.README" contains some references to background information                      .-                     Version 2.4.2 fixes a dependency in the .cabal file and has made the class -                     ExtApplicative obsolete since <$ is now in the class Functor-                     .-                     Version 2.4.3: removed the class Symbol, which enabled us to become more H98-ish Category:            Parsing  Library@@ -40,7 +36,8 @@                      Text.ParserCombinators.UU.Core                        Text.ParserCombinators.UU.BasicInstances                      Text.ParserCombinators.UU.Derived-                     Text.ParserCombinators.UU.Merge +                     Text.ParserCombinators.UU.Merge+                     Text.ParserCombinators.UU.Perms                       Text.ParserCombinators.UU.Examples                      Text.ParserCombinators.UU.Parsing