diff --git a/src/Text/ParserCombinators/UU.hs b/src/Text/ParserCombinators/UU.hs --- a/src/Text/ParserCombinators/UU.hs +++ b/src/Text/ParserCombinators/UU.hs @@ -12,17 +12,17 @@ -- -- * what kind of error messages you can get if you write erroneous parsers -- --- * how to use the permutation parsers +-- * how to use the permutation/merging parsers -- +-- * to see the parsers in action load the module "Text.ParserCombinators.UU.Examples" in @ghci@ and type @main@ or @demo_merge@, while looking at the corresponding code +-- 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.Perms) where +) 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 + diff --git a/src/Text/ParserCombinators/UU/CHANGELOG.hs b/src/Text/ParserCombinators/UU/CHANGELOG.hs --- a/src/Text/ParserCombinators/UU/CHANGELOG.hs +++ b/src/Text/ParserCombinators/UU/CHANGELOG.hs @@ -1,16 +1,25 @@ -- | This module just contains the CHANGELOG -- --- Version 2.5.2 +-- Version 2.5.3 +-- +-- * fixed a bug in the implementation; some functions were too strict, due to introduction of nice abstractions!! +-- +-- * added a generalisation of @`pMerged`@ and @`pPerms`@ to the module "Text.ParserCombinators.UU.Derived"; the old modules have been marked as deprecated +-- * removed the old module Text.ParserCombinators.UU.Parsing, which was already marged as deprecated +-- +-- Version 2.5.2 -- --- * Fixed bug in abstrcat interpretaion of seqentail composition with pure in left-hand side operand (reported by Dominique Devriese) +-- * fixed a bug in sequential composition with a pure as left hand side -- +-- * added an experimental @pMerge@, which combines the featurs of @pPerms@ and @pMerged@ +-- -- Version 2.5.1.1 -- -- * Now with the correct Changelog -- -- Version 2.5.1 -- --- * added the Permutation parsers from the old uulib +-- * added the permutation parsers from the old uulib -- -- * extended the abstract interpretation so more soundness checks can be done statically -- diff --git a/src/Text/ParserCombinators/UU/Core.hs b/src/Text/ParserCombinators/UU/Core.hs --- a/src/Text/ParserCombinators/UU/Core.hs +++ b/src/Text/ParserCombinators/UU/Core.hs @@ -110,44 +110,54 @@ getOneP (P _ (Just _) Zero _ ) = error "The element is a special parser which cannot be combined" getOneP (P _ Nothing l _ ) = Nothing -getOneP (P _ onep l _ ) = Just(mkParser onep l Nothing) +getOneP (P _ onep l ep ) = Just( P (mkParser onep Nothing) onep l Nothing) getZeroP (P _ _ l Nothing) = Nothing -getZeroP (P _ _ l pe) = Just (mkParser Nothing l pe) +getZeroP (P _ _ l pe) = Just (P (mkParser Nothing pe) Nothing l pe) -- TODO check for erroneaoius parsers, such as -mkParser np@Nothing l ne@Nothing = P empty np l ne -mkParser np@(Just nt) l ne@Nothing = P nt np l ne -mkParser np@Nothing l ne@(Just a) = P (pure a) np l ne -mkParser np@(Just nt) l ne@(Just a) = P (nt <|> pure a) np l ne +mkParser np@Nothing ne@Nothing = empty +mkParser np@(Just nt) ne@Nothing = nt +mkParser np@Nothing ne@(Just a) = (pure a) +mkParser np@(Just nt) ne@(Just a) = (nt <|> pure a) +combine Nothing Nothing _ _ _ _ = Nothing +combine (Just p) Nothing aq _ op1 op2 = Just (p `op1` aq ) +combine (Just p) (Just v) aq (Just _) op1 op2 = Just (p `op1` aq <|> v `op2` aq) +combine (Just p) (Just v) aq Nothing op1 op2 = Just (p `op1` aq ) -- rhs contribution is just from empty alt +combine Nothing (Just v) aq (Just _) _ op2 = Just ( v `op2` aq) +combine Nothing (Just v) aq Nothing _ op2 = Nothing -- rhs contribution is just from empty alt + -- ** Parsers are functors: @`fmap`@ instance Functor (P state) where fmap f (P ap np l me) = let nnp = fmap (fmap f) np nep = f <$> me - in mkParser nnp l nep + in P (mkParser nnp nep) nnp l nep f <$ (P ap np l me) = let nnp = fmap (f <$) np nep = f <$ me - in mkParser nnp l nep + in P (mkParser nnp nep) nnp l nep -- ** Parsers are Applicative: @`<*>`@, @`<*`@, @`*>`@ and @`pure`@ instance Applicative (P state) where - P ap np pl pe <*> ~(P aq nq ql qe) = let nnp = combine np pe aq (<*>) (<$>) - in mkParser nnp (nat_add pl ql) (pe <*> qe) - P ap np pl pe <* ~(P aq nq ql qe) = let nnp = combine np pe aq (<*) (<$) - in mkParser nnp (nat_add pl ql) (pe <* qe) - P ap np pl pe *> ~(P aq nq ql qe) = let nnp = combine np pe aq (*>) (flip const) - in mkParser nnp (nat_add pl ql) (pe *> qe) + P ap np pl pe <*> ~(P aq nq ql qe) = let newnp = combine np pe aq nq (<*>) (<$>) + newep = pe <*> qe + newlp = nat_add pl ql + in P (mkParser newnp newep) newnp newlp newep + P ap np pl pe <* ~(P aq nq ql qe) = let newnp = combine np pe aq nq (<*) (<$) + newep = pe <* qe + newlp = nat_add pl ql + in P (mkParser newnp newep) newnp newlp newep + P ap np pl pe *> ~(P aq nq ql qe) = let newnp = combine np pe aq nq (*>) (flip const) + newep = qe + newlp = nat_add pl ql + in P (mkParser newnp newep) newnp newlp newep pure a = P (pure a) Nothing Zero (Just a) -combine Nothing Nothing _ _ _ = Nothing -combine (Just p) Nothing aq op1 op2 = Just (p `op1` aq ) -combine (Just p) (Just v) aq op1 op2 = Just (p `op1` aq <|> v `op2` aq) -combine Nothing (Just v) aq _ op2 = Just ( v `op2` aq) + -- ** Parsers are Alternative: @`<|>`@ and @`empty`@ instance Alternative (P state) where P ap np pl pe <|> P aq nq ql qe - = let (rl, b) = nat_min pl ql + = let (rl, b) = nat_min pl ql 0 Nothing `alt` q = q p `alt` Nothing = p Just p `alt` Just q = Just (p <|>q) @@ -156,7 +166,7 @@ (Nothing, _ ) -> qe (_ , Nothing) -> pe (_ , _ ) -> error "ambiguous parser because two sides of choice can be empty") - in mkParser nnp rl nep + in P (mkParser nnp nep) nnp rl nep empty = P empty empty Infinite Nothing -- ** An alternative for the Alternative, which is greedy: @`<<|>`@ @@ -165,7 +175,7 @@ instance ExtAlternative (P st) where P ap np pl pe <<|> P aq nq ql qe - = let (rl, b) = nat_min pl ql + = let (rl, b) = nat_min pl ql 0 bestx = if b then flip best else best in P (choose bestx ap aq ) (maybe np (\nqq -> maybe nq (\npp -> return( choose bestx npp nqq)) np) nq) @@ -244,7 +254,7 @@ ( \ k inp -> replaceExpected ( pr k inp))) replaceExpected (Fail _ c) = (Fail [label] c) replaceExpected others = others - in mkParser nnp pl pe + in P (mkParser nnp pe) nnp pl pe @@ -256,7 +266,7 @@ 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 mkParser nnp pl pe + 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 @@ -271,7 +281,7 @@ ( \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 mkParser nnp pl nep + in P (mkParser nnp nep) nnp pl nep -- ** Parse errors can be retreived from the state: @`pErrors`@ @@ -286,7 +296,7 @@ ( \ 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 mkParser nnp Zero nep + in P (mkParser nnp nep) nnp Zero nep -- ** The current position can be retreived from the state: @`pPos`@ @@ -301,7 +311,7 @@ ( \ 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 mkParser nnp Zero nep + in P (mkParser nnp nep) nnp Zero nep -- ** Starting and finalising the parsing process: @`pEnd`@ and @`parse`@ @@ -324,7 +334,7 @@ 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 mkParser nnp Zero nep + in P (mkParser nnp nep) nnp Zero nep -- The function @`parse`@ shows the prototypical way of running a parser on a some specific input @@ -345,7 +355,7 @@ in pf (\st2' -> k (back st2')) st2) (\ k st1 -> let (st2, back) = split st1 in pr (\st2' -> k (back st2')) st2)) np - in mkParser nnp pl pe + 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. @@ -387,8 +397,8 @@ -- ! @`eval`@ removes the progress information from a sequence of steps, and constructs the value contained in it. eval :: Steps a -> a -eval (Step _ l) = eval l -eval (Micro _ l) = eval l +eval (Step n l) = trace' ("Step " ++ show n ++ "\n") (eval l) +eval (Micro _ l) = eval l eval (Fail ss ls ) = trace' ("expecting: " ++ show ss) (eval (getCheapest 3 (map ($ss) ls))) eval (Apply f l ) = f (eval l) eval (End_f _ _ ) = error "dangling End_f constructor" @@ -496,8 +506,7 @@ must_be_non_empty :: [Char] -> P t t1 -> t2 -> t2 must_be_non_empty msg p@(P _ _ Zero _) _ - = error ("The combinator " ++ msg ++ "\n" ++ - " requires that it's argument cannot recognise the empty string\n") + = error ("The combinator " ++ msg ++ " requires that it's argument cannot recognise the empty string\n") must_be_non_empty _ _ q = q -- | This function is similar to the above, but can be used in situations where we recognise a sequence of elements separated by other elements. This does not @@ -505,8 +514,7 @@ must_be_non_empties :: [Char] -> P t1 t -> P t3 t2 -> t4 -> t4 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") + = error ("The combinator " ++ msg ++ " requires that not both arguments can recognise the empty string\n") must_be_non_empties msg _ _ q = q @@ -519,11 +527,12 @@ | Infinite deriving Show -nat_min Zero _ = trace' "Left Zero in nat_min\n" (Zero, True) -nat_min Infinite r = trace' "Left Infinite in nat_min\n" (r, False) -nat_min l Infinite = trace' "Right Zero in nat_min\n" (l, True) -nat_min _ Zero = trace' "Right Zero in nat_min\n" (Zero, False) -nat_min (Succ ll) (Succ rr) = trace' "Succs in nat_min\n" (let (v, b) = ll `nat_min` rr in (Succ v, b)) +nat_min Zero _ _ = trace' "Left Zero in nat_min\n" (Zero, True) +nat_min Infinite r _ = trace' "Left Infinite in nat_min\n" (r, False) +nat_min l Infinite _ = trace' "Right Zero in nat_min\n" (l, True) +nat_min _ Zero _ = trace' "Right Zero in nat_min\n" (Zero, False) +nat_min (Succ ll) (Succ rr) n = if n >1000 then error "problem with comparing lengths" + else trace' "Succs in nat_min\n" (let (v, b) = nat_min ll rr (n+1) in (Succ v, b)) nat_add Infinite _ = trace' "Infinite in add\n" Infinite nat_add Zero r = trace' "Zero in add\n" r @@ -532,7 +541,7 @@ -- get_length (P _ _ l _) = l -trace' v m = m +trace' m v = {- trace m -} v diff --git a/src/Text/ParserCombinators/UU/Derived.hs b/src/Text/ParserCombinators/UU/Derived.hs --- a/src/Text/ParserCombinators/UU/Derived.hs +++ b/src/Text/ParserCombinators/UU/Derived.hs @@ -50,7 +50,7 @@ pPacked l r x = l *> x <* r -- ======================================================================================= --- ===== Iterating ps =============================================================== +-- ===== Iterating ps ==================================================================== -- ======================================================================================= pFoldr :: (a -> a1 -> a1, a1) -> P st a -> P st a1 pFoldr_ng :: (a -> a1 -> a1, a1) -> P st a -> P st a1 @@ -131,4 +131,64 @@ mzero = pFail mplus = (<|>) +-- ======================================================================================= +-- ===== Merging parsers: see at end of Examples file ==================================== +-- ======================================================================================= + +infixl 3 <||> +data Freq p = One p + | Opt p + | Many p + | Some p + +instance Functor Freq where + fmap f (One p) = One (f p) + fmap f (Opt p) = Opt (f p) + fmap f (Many p) = Many (f p) + fmap f (Some p) = Some (f p) + +canBeEmpty (One p) = False +canBeEmpty (Opt p) = True +canBeEmpty (Many p) = True +canBeEmpty (Some p) = False + +oneAlt (One p, others) = (p, toTree others) +oneAlt (Opt p, others) = (p, toTree others) +oneAlt (Many p, others) = (p, toTree (Many p:others)) +oneAlt (Some p, others) = (p, toTree (Many p:others)) + +data Tree p = Br [(p, Tree p)] Bool + +toTree :: [Freq p] -> Tree p +toTree alts = Br (map oneAlt (split alts id)) (and (map canBeEmpty alts) ) +split [] _ = [] +split (x:xs) f = (x, f xs): split xs (f.(x:)) + +toParser :: Tree (P st (d -> d)) -> d -> P st d +toParser (Br alts b) units = foldr (<|>) (if b then pure units else empty) + [p <*> toParser ps units | (p,ps) <- alts] + + +newtype MergeSpec p = MergeSpec p + +(<||>) :: MergeSpec (c, [Freq (P st (d -> d) )], e -> f -> g) + -> MergeSpec (h, [Freq (P st (i -> i) )], g -> j -> k) + -> MergeSpec ((c,h), [Freq (P st ((d,i) -> (d,i)))], e -> (f,j) -> k) + +MergeSpec (pe, pp, punp) <||> MergeSpec (qe, qp, qunp) + = MergeSpec ( (pe, qe) + , map (fmap (mapFst <$>)) pp ++ map (fmap (mapSnd <$>)) qp + , \f (x, y) -> qunp (punp f x) y + ) + +pMerge :: c -> MergeSpec (d, [Freq (P st (d -> d))], c -> d -> e) -> P st e +sem `pMerge` MergeSpec (units, alts, unp) = unp sem <$> toParser (toTree alts) units + +pMany p = must_be_non_empty "pMany" p (MergeSpec ([] ,[Many ((:) <$> p)], id)) +pOpt p v = must_be_non_empty "pOpt" p (MergeSpec (v ,[Opt (const <$> p)], id)) +pSome p = must_be_non_empty "pSome" p (MergeSpec ([] ,[Some ((:) <$> p)], id)) +pOne p = must_be_non_empty "pOne" p (MergeSpec (undefined,[One (const <$> p)], id)) + +mapFst f (a, b) = (f a, b) +mapSnd f (a, b) = (a, f b) diff --git a/src/Text/ParserCombinators/UU/Examples.hs b/src/Text/ParserCombinators/UU/Examples.hs --- a/src/Text/ParserCombinators/UU/Examples.hs +++ b/src/Text/ParserCombinators/UU/Examples.hs @@ -11,11 +11,9 @@ 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 +import Text.ParserCombinators.UU.Derived +-- 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. run :: Show t => Parser t -> String -> IO () @@ -196,7 +194,7 @@ test11 = run expr "15-3*5" expr :: Parser Int operators = [[('+', (+)), ('-', (-))], [('*' , (*))], [('^', (^))]] -same_prio ops = msum [ op <$ pSym c | (c, op) <- ops] +same_prio ops = foldr (<|>) empty [ op <$ pSym c | (c, op) <- ops] expr = foldr pChainl ( pNatural <|> pParens expr) (map same_prio operators) @@ -263,7 +261,8 @@ test13 = run takes_second_alt "if a then if else c" test14 = run takes_second_alt "ifx a then if else c" --- | For documentation of @`pMerged`@ and @`<||>`@ see the module "Text.ParserCombinators.UU.Merge": +{- +-- | For documentation of @`pMerge`@ and @`<||>`@ see the module "Text.ParserCombinators.UU.Merge": -- -- > run (,,) `pMerged` (list_of pDigit <||> list_of pLower <||> list_of pUpper) "1AabCD2D3d" -- @@ -272,8 +271,10 @@ -- > Result: ("123","abd","ACDD") -- + test15 :: IO () test15 = run ((,,) `pMerged` (list_of pDigit <||> list_of pLower <||> list_of pUpper)) "1AabCD2D3d" +-} -- | The function -- @@ -359,7 +360,20 @@ run (pa <|> pb {- "just a message"-}) "c" run parseBoth "(123;456;789)" run munch "a^=^**^^b" - run (pPerms ((,,) ~$~ pa ~*~ pb ~*~ pc)) "cab" + run ((,,,) `pMerge` (pSome pa <||> pMany pb <||> pOne pc <||> pOpt pNatural 5)) "babc45" + +demo_merge :: IO () +demo_merge = do run ((,) `pMerge` (pSome pa <||> pMany pb)) "abba" + run ((,) `pMerge` (pSome pa <||> pMany pb)) "a" + run ((,) `pMerge` (pSome pa <||> pMany pb)) "" + run ((,) `pMerge` (pMany pb <||> pSome pc)) "bcbc" + run ((,) `pMerge` (pSome pb <||> pMany pc)) "bcbc" + run ((,,,) `pMerge` (pSome pa <||> pMany pb <||> pOne pc <||> pNatural `pOpt` 5)) "babc45" + +-- Text.ParserCombinators.UU.Examples> run (id `pMerge` (pSome (pa `opt` "b"))) "a" +-- +-- > Result: *** Exception: The combinator pSome requires that it's argument cannot recognise the empty string + diff --git a/src/Text/ParserCombinators/UU/Merge.hs b/src/Text/ParserCombinators/UU/Merge.hs deleted file mode 100644 --- a/src/Text/ParserCombinators/UU/Merge.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Text.ParserCombinators.UU.Merge((<||>), pMerged, list_of) where - -import Text.ParserCombinators.UU.Core -import Text.ParserCombinators.UU.Derived -import Text.ParserCombinators.UU.BasicInstances - --- | Often one wants to read a sequence of elements of different types, --- where the actual order doe not matter. For the semantic processing however --- it would be nice to get the elemnts of each type collected together: --- --- > chars_digs = cat3 `pMerged` (list_of pDig <||> list_of pL <||> list_of pU) --- --- parsing \"12abCD1aV\" now returns \"121abaCDV\"; so the sequence of --- recognised elements is stored in three lists, which are then passed --- to @cat3 :: [a] -> [a] -> [a] -> [a]@ which concatenates the lists again - -(<||>) :: (c, P st (d -> d), e -> f -> g) - -> (h, P st (i -> i), g -> j -> k) - -> ((c,h), P st ((d,i) -> (d,i)), e -> (f,j) -> k) - -(pe, pp, punp) <||> (qe, qp, qunp) - =( (pe, qe) - , mapFst <$> pp <|> mapSnd <$> qp - , \f (x, y) -> qunp (punp f x) y - ) - -pMerged :: c -> (d, P st (d -> d), c -> d -> e) -> P st e -sem `pMerged` (units, alts, unp) - = let pres = alts <*> pres `opt` units in unp sem <$> pres - -list_of :: P st c -> ([d], P st ([c] -> [c]),e -> e) -list_of p = ([], (:) <$> p, id) - -mapFst f (a, b) = (f a, b) -mapSnd f (a, b) = (a, f b) - - - diff --git a/src/Text/ParserCombinators/UU/Parsing.hs b/src/Text/ParserCombinators/UU/Parsing.hs deleted file mode 100644 --- a/src/Text/ParserCombinators/UU/Parsing.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Text.ParserCombinators.UU.Parsing {-# DEPRECATED "Use Text.ParserCombinators.UU instead" #-} - ( module Text.ParserCombinators.UU.Core - , module Text.ParserCombinators.UU.BasicInstances - , module Text.ParserCombinators.UU.Derived) where -import Text.ParserCombinators.UU.Core -import Text.ParserCombinators.UU.BasicInstances -import Text.ParserCombinators.UU.Derived diff --git a/src/Text/ParserCombinators/UU/Perms.hs b/src/Text/ParserCombinators/UU/Perms.hs deleted file mode 100644 --- a/src/Text/ParserCombinators/UU/Perms.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# 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 diff --git a/uu-parsinglib.cabal b/uu-parsinglib.cabal --- a/uu-parsinglib.cabal +++ b/uu-parsinglib.cabal @@ -1,5 +1,5 @@ Name: uu-parsinglib -Version: 2.5.2 +Version: 2.5.3 Build-Type: Simple License: MIT Copyright: S Doaitse Swierstra @@ -12,13 +12,14 @@ Synopsis: Online, error-correcting parser combinators; monadic and applicative interfaces Cabal-Version: >=1.4 Description: New version of the Utrecht University parser combinator library, which provides online, error correction, - annotation free, applicative style parser combinators. In addition to this we even provide a monadic interface. - Parsers do analyse themselves to avoid commonly made errors + annotation free, applicative style parser combinators. In addition to this we do provide a monadic interface. + Parsers do analyse themselves to avoid commonly made errors. A recent addition was the combinator @`pMerge`@ and + associates which generalises merging and permuting parsers. . - The module "Text.ParserCombinators.UU.Examples" contains a ready-made main function, - which can be called to see the error correction at work. It contains extensive haddock documentation; + The module "Text.ParserCombinators.UU.Examples" contains a ready-made @main@ function, + which can be called to see e.g. the error correction at work. It contains haddock documentation; try all the small tests for yourself to see the correction process at work, and to get a - feeling for how to use the various combinators. + feeling for how to use the various combinators. . The file "Text.ParserCombinators.UU.Changelog" contains a log of the most recent changes and additions . @@ -36,8 +37,5 @@ Text.ParserCombinators.UU.Core Text.ParserCombinators.UU.BasicInstances Text.ParserCombinators.UU.Derived - Text.ParserCombinators.UU.Merge - Text.ParserCombinators.UU.Perms Text.ParserCombinators.UU.Examples - Text.ParserCombinators.UU.Parsing