incremental-parser 0.1 → 0.2

raw patch · 6 files changed

+513/−290 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Applicative/Monoid.hs +45/−0
• Test/TestIncrementalParser.hs +148/−68
• Text/ParserCombinators/Incremental.hs +203/−221
• Text/ParserCombinators/Incremental/LeftBiasedLocal.hs +56/−0
• Text/ParserCombinators/Incremental/Symmetric.hs +56/−0
• incremental-parser.cabal +5/−1

@@ -0,0 +1,45 @@+{- +    Copyright 2011 Mario Blazevic++    This file is part of the Streaming Component Combinators (SCC) project.++    The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public+    License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later+    version.++    SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty+    of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.++    You should have received a copy of the GNU General Public License along with SCC.  If not, see+    <http://www.gnu.org/licenses/>.+-}++-- | This module defines the AlternativeMonoid class++module Control.Applicative.Monoid (+   MonoidApplicative(..), MonoidAlternative(..)+   )+where++import Control.Applicative (Applicative (pure), Alternative ((<|>), some, many), liftA2)+import Data.Monoid (Monoid, mempty, mappend, mconcat)+++class Applicative f => MonoidApplicative f where+   -- | Join operator on parsers of same type, preserving the incremental results.+   infixl 5 ><+   (><) :: Monoid a => f a -> f a -> f a+   (><) = liftA2 mappend++class (Alternative f, MonoidApplicative f) => MonoidAlternative f where+   -- | Like 'optional', but restricted to 'Monoid' results.+   moptional :: Monoid a => f a -> f a+   moptional x = x <|> pure mempty++   -- | Zero or more argument occurrences like 'many', but concatenated.+   concatMany :: Monoid a => f a -> f a+   concatMany = fmap mconcat . many++   -- | One or more argument occurrences like 'some', but concatenated.+   concatSome :: Monoid a => f a -> f a+   concatSome = fmap mconcat . some

@@ -16,12 +16,12 @@  -- | This module contains tests of "Text.ParserCombinators.Incremental" module. -{-# LANGUAGE FlexibleInstances, ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, ScopedTypeVariables, UndecidableInstances #-}  module Main where -import Control.Applicative (Alternative, empty, (*>), (<|>))-import Control.Monad (liftM, liftM2)+import Control.Applicative (Applicative, Alternative, pure, (<*>), (*>), empty, (<|>))+import Control.Monad (MonadPlus, liftM, liftM2, mzero, mplus) import Data.List (find, minimumBy, nub, sort) import Data.Monoid (Monoid(..)) import System.Environment (getArgs)@@ -29,33 +29,96 @@ import Test.QuickCheck (Arbitrary(..), Gen, Property, property, (==>), (.&&.), forAll, oneof, resize, sized, verbose,                         whenFail) import Test.QuickCheck.Checkers (Binop, EqProp(..), TestBatch, isAssoc, leftId, rightId, verboseBatch)-import Test.QuickCheck.Classes (functor, monad, monoid, applicative, monadFunctor, monadApplicative, monadOr)+import Test.QuickCheck.Classes (functor, monad, monoid, applicative, monadFunctor, monadApplicative, monadOr, monadPlus)  import Text.ParserCombinators.Incremental (Parser, feedEof, feed, completeResults,-                                           (><), (<<|>),+                                           (><), (<<|>), (<||>), failure,                                            anyToken, eof, lookAhead, notFollowedBy, satisfy, skip, token, string,                                            showWith)+import Text.ParserCombinators.Incremental.Symmetric (Symmetric)+import Text.ParserCombinators.Incremental.LeftBiasedLocal (LeftBiasedLocal)  main = do args <- getArgs            case args of [] -> mapM_ verboseBatch tests                        _ -> mapM_ (\batch-> maybe (error ("No test batch named " ++ batch)) verboseBatch                                              (find ((batch ==) . fst) tests)) args -parser2 :: Parser [Bool] (String, String)-parser2 = undefined+data Described a = Described String !a -parser3 :: Parser [Bool] (String, String, String)-parser3 = undefined+data TestParser a r = TestParser (Described (Parser a [Bool] r)) +describedParser (TestParser (Described _ p)) = p++instance Show (Described a) where+   show (Described desc _) = desc++instance Show (TestParser a r) where+   show (TestParser d) = show d++instance (Arbitrary r, Monoid r, Show r) => Arbitrary (TestParser a r) where+   arbitrary = fmap TestParser arbitrary++instance Monoid a => Monoid (Described a) where+   mempty = Described "mempty" mempty+   Described d1 p1 `mappend` Described d2 p2 = Described (d1 ++ " `mappend` " ++ d2) (mappend p1 p2)++instance Monoid r => Monoid (TestParser a r) where+   mempty = TestParser mempty+   TestParser d1 `mappend` TestParser d2 = TestParser (d1 `mappend` d2)++instance EqProp a => EqProp (Described a) where+   Described _ x =-= Described _ y = x =-= y++instance (Ord r, Show r, Monoid r, EqProp r) => EqProp (TestParser a r) where+   TestParser d1 =-= TestParser d2 = d1 =-= d2++instance Functor (TestParser a) where+   fmap f (TestParser (Described d p)) = TestParser (Described ("fmap ? " ++ d) (fmap f p))++instance Applicative (TestParser a) where+   pure x = TestParser (Described "pure ?" (pure x))+   TestParser (Described d1 p1) <*> TestParser (Described d2 p2) =+      TestParser (Described (d1 ++ " <*> " ++ d2) (p1 <*> p2))++instance Monad (TestParser a) where+   return x = TestParser (Described "return ?" (return x))+   TestParser (Described d1 p1) >>= f =+      TestParser (Described (d1 ++ " >>= ?") (p1 >>= describedParser . f))+   TestParser (Described d1 p1) >> TestParser (Described d2 p2) =+      TestParser (Described (d1 ++ " >> " ++ d2) (p1 >> p2))++instance Alternative (Parser a [Bool]) => Alternative (TestParser a) where+   empty = TestParser (Described "empty" empty)+   TestParser (Described d1 p1) <|> TestParser (Described d2 p2) =+      TestParser (Described (d1 ++ " <|> " ++ d2) (p1 <|> p2))++instance MonadPlus (Parser a [Bool]) => MonadPlus (TestParser a) where+   mzero = TestParser (Described "mzero" mzero)+   TestParser (Described d1 p1) `mplus` TestParser (Described d2 p2) =+      TestParser (Described (d1 ++ " `mplus` " ++ d2) (mplus p1 p2))++parser2l :: TestParser LeftBiasedLocal (String, String)+parser2l = undefined++parser2s :: TestParser Symmetric (String, String)+parser2s = undefined++parser3l :: TestParser LeftBiasedLocal (String, String, String)+parser3l = undefined++parser3s :: TestParser Symmetric (String, String, String)+parser3s = undefined+ tests :: [TestBatch]-tests = [monoid parser3,-         functor parser3,-         applicative parser3,-         alternative parser2,-         monad parser3,-         monadFunctor parser2,-         monadApplicative parser2,-         monadOr parser2,+tests = [monoid parser3s,+         functor parser3s,+         applicative parser3s,+         alternative parser2s,+         monad parser3s,+         monadFunctor parser2s,+         monadApplicative parser2s,+         monadOr parser2l,+         monadPlus parser2s,          primitives,          lookAheadBatch,          join]@@ -89,12 +152,13 @@  primitives :: TestBatch primitives = ("primitives",-              [("anyToken EOF", feedEof (anyToken :: Parser [Bool] [Bool]) =-= empty),+              [("anyToken EOF", feedEof (anyToken :: Parser a [Bool] [Bool]) =-= failure),                ("anyToken list", property tokenListP),                ("token", property tokenP),                ("token = satisfy . (==)", property tokenSatisfyP),                ("satisfy not", property satisfyNotP),-               ("satisfy or not", property satisfyOrNotP),+               ("satisfy or not Symmetric", property (satisfyOrNotP (undefined :: Symmetric))),+               ("satisfy or not LeftBiasedLocal", property (satisfyOrNotP (undefined :: LeftBiasedLocal))),                ("string", property stringP),                ("feed eof", property feedEofP),                ("feedEof eof", property feedEofEofP)])@@ -102,7 +166,7 @@          tokenP :: Bool -> [Bool] -> Property          tokenSatisfyP :: Bool -> Property          satisfyNotP :: (Bool -> Bool) -> Property-         satisfyOrNotP :: (Bool -> Bool) -> Property+         satisfyOrNotP :: Alternative (Parser a [Bool]) => a -> (Bool -> Bool) -> Property          stringP :: [Bool] -> [Bool] -> Property          feedEofP :: [Bool] -> Property          feedEofEofP :: Bool@@ -111,77 +175,90 @@          tokenP x xs = canonicalResults (feed (x:xs) (token [x])) =-= [([x], xs)]          tokenSatisfyP x = token [x] =-= satisfy (== [x])          satisfyNotP pred = satisfy (pred . head) =-= (notFollowedBy (satisfy (not . pred . head)) >< anyToken)-         satisfyOrNotP pred = (satisfy (pred . head) <|> satisfy (not . pred . head)) =-= anyToken+         satisfyOrNotP (_ :: a) pred = (satisfy (pred . head) <|> satisfy (not . pred . head)) +                                       =-= (anyToken :: Parser a [Bool] [Bool])          stringP xs ys = xs /= [] ==> canonicalResults (feed (xs ++ ys) (string xs)) =-= [(xs, ys)]-         feedEofP x = x /= [] ==> feed x eof =-= (empty :: Parser [Bool] String)-         feedEofEofP = canonicalResults (feedEof eof :: Parser [Bool] String) == [([], [])]+         feedEofP x = x /= [] ==> feed x eof =-= (failure :: Parser a [Bool] String)+         feedEofEofP = canonicalResults (feedEof eof :: Parser a [Bool] String) == [([], [])]  lookAheadBatch :: TestBatch lookAheadBatch = ("lookAhead",                   [("lookAhead", property lookAheadP),                    ("lookAhead p >> p", property lookAheadConsumeP),                    ("notFollowedBy p >< p", property lookAheadNotOrP),-                   ("not not", property lookAheadNotNotP),+                   ("not not Symmetric", property (lookAheadNotNotP (undefined :: Symmetric))),+                   ("not not LeftBiasedLocal", property (lookAheadNotNotP (undefined :: LeftBiasedLocal))),                    ("lookAhead anyToken", property lookAheadTokenP)])-   where lookAheadP :: [Bool] -> Parser [Bool] String -> Bool-         lookAheadConsumeP :: Parser [Bool] String -> Property-         lookAheadNotOrP :: Parser [Bool] String -> Property-         lookAheadNotNotP :: Parser [Bool] String -> Property+   where lookAheadP :: [Bool] -> Described (Parser a [Bool] String) -> Bool+         lookAheadConsumeP :: Described (Parser a [Bool] String) -> Property+         lookAheadNotOrP :: Described (Parser a [Bool] String) -> Property+         lookAheadNotNotP :: Alternative (Parser a [Bool]) => a -> Described (Parser a [Bool] String) -> Property          lookAheadTokenP :: Bool -> [Bool] -> Bool          -         lookAheadP xs p = completeResults (feed xs $ lookAhead p)-                           == map (\(r, _)-> (r, xs)) (completeResults (feed xs p))-         lookAheadConsumeP p = (lookAhead p >> p) =-= p-         lookAheadNotOrP p = (notFollowedBy p >< p) =-= empty-         lookAheadNotNotP p = notFollowedBy (notFollowedBy p :: Parser [Bool] ()) =-= (skip (lookAhead p) :: Parser [Bool] ())+         lookAheadP xs (Described _ p) = completeResults (feed xs $ lookAhead p)+                                         == map (\(r, _)-> (r, xs)) (completeResults (feed xs p))+         lookAheadConsumeP (Described _ p) = (lookAhead p >> p) =-= p+         lookAheadNotOrP (Described _ p) = (notFollowedBy p >< p) =-= failure+         lookAheadNotNotP (_ :: a) (Described _ p) = notFollowedBy (notFollowedBy p :: Parser a [Bool] ()) =-= (skip (lookAhead p) :: Parser a [Bool] ())          lookAheadTokenP x xs = canonicalResults (feed (x:xs) (lookAhead anyToken)) == [([x], x:xs)] -instance (Eq x, Monoid x, Ord x, Show x) => EqProp (Parser [Bool] x) where+instance (Eq x, Monoid x, Ord x, Show x) => EqProp (Parser a [Bool] x) where    p1 =-= p2 = sameResults (feedEof p1) (feedEof p2)                .&&. halveSize (\s-> sized $ \n-> whenFail (print (n, s, p1, p2)) (feed s p1 =-= feed s p2)) arbitrary-      where sameResults p1 p2 = whenFail (print (canonicalResults p1) >> putStrLn "  !=" >> print (canonicalResults p2)-                                          >> putStrLn "  =>" >> print p1 >> putStrLn "  !=" >> print p2)-                                         (canonicalResults p1 == canonicalResults p2) +sameResults p1 p2 = whenFail (print (canonicalResults p1) >> putStrLn "  !=" >> print (canonicalResults p2)+                              >> putStrLn "  =>" >> print p1 >> putStrLn "  !=" >> print p2)+                    (canonicalResults p1 == canonicalResults p2)+ join :: TestBatch join = ("join",         [("empty ><", property leftZeroP),          (">< empty", property rightZeroP),          ("(<|>) ><", property leftDistP),-         (">< (<|>)", property rightDistP),+         (">< (<||>)", property rightDistP),          ("><", property joinP)])-   where leftZeroP :: Parser [Bool] String -> Property-         rightZeroP :: Parser [Bool] String -> Property-         leftDistP :: Parser [Bool] String -> Parser [Bool] String -> Parser [Bool] String -> Property-         rightDistP :: Parser [Bool] String -> Parser [Bool] String -> Parser [Bool] String -> Property-         joinP :: [Bool] -> Parser [Bool] String -> Parser [Bool] String -> Bool+   where leftZeroP :: Described (Parser a [Bool] String) -> Property+         rightZeroP :: Described (Parser a [Bool] String) -> Property+         leftDistP :: Described (Parser a [Bool] String) -> Described (Parser a [Bool] String)+                      -> Described (Parser a [Bool] String) -> Property+         rightDistP :: Described (Parser a [Bool] String) -> Described (Parser a [Bool] String)+                       -> Described (Parser a [Bool] String) -> Property+         joinP :: [Bool] -> Described (Parser a [Bool] String) -> Described (Parser a [Bool] String) -> Property -         leftZeroP k = (empty >< k) =-= empty-         rightZeroP k = (k >< empty) =-= empty-         leftDistP a b k = ((a <|> b) >< k) =-= ((a >< k) <|> (b >< k))-         rightDistP k a b = (k >< (a <|> b)) =-= ((k >< a) <|> (k >< b))-         joinP input a b = canonicalResults (feed input (a >< b))-                           == sort (nub [(r1 ++ r2, rest') -                                        | (r1, rest) <- canonicalResults (feed input a),-                                          (r2, rest') <- completeResults (feed rest b)])+         leftZeroP (Described _ k) = (failure >< k) =-= failure+         rightZeroP (Described _ k) = (k >< failure) =-= failure+         leftDistP (Described _ a) (Described _ b) (Described _ k) = ((a <||> b) >< k) =-= ((a >< k) <||> (b >< k))+         rightDistP (Described _ k) (Described _ a) (Described _ b) = (k >< (a <||> b)) =-= ((k >< a) <||> (k >< b))+         joinP input (Described _ a) (Described _ b)+            = whenFail (print r1 >> putStrLn "  !=" >> print r2 >> putStrLn "  !=" >> print r1a) (r1 == r2)+            where r1 = canonicalResults (feed input (a >< b))+                  r2 = sort (nub [(r2a ++ r2b, rest') +                                 | (r2a, rest) <- r1a,+                                   (r2b, rest') <- completeResults (feed rest b)])+                  r1a = canonicalResults (feed input a)  canonicalResults p = sort $ nub $ completeResults p -instance (Arbitrary r, Monoid r) => Arbitrary (Parser [Bool] r) where+instance forall a r. (Arbitrary r, Monoid r, Show r) => Arbitrary (Described (Parser a [Bool] r)) where    arbitrary = sized $ -               \n-> resize (min 50 n) $-                    oneof [return empty,-                           reduceSize return arbitrary,-                           splitSize (><) (liftM return arbitrary) arbitrary,-                           splitSize (<|>) arbitrary arbitrary,-                           splitSize (<<|>) arbitrary arbitrary,-                           reduceSize (anyToken >>) arbitrary,-                           reduceSize (satisfy head >>) arbitrary,-                           reduceSize (satisfy (not . head) >>) arbitrary,-                           reduceSize lookAhead arbitrary,-                           reduceSize notFollowedBy (arbitrary :: Gen (Parser [Bool] r))]+               \n-> if n == 0+                    then return (Described "empty" failure)+                    else resize (min 50 n) $+                         oneof [return (Described "empty" failure),+                                return (Described "mempty" mempty),+                                sized $ \n-> liftM (\r-> Described ("(return " ++ shows r ")") (return r))+                                                   (resize (pred n) arbitrary),+                                splitSize " >< " (><) (liftM (Described "return ?" . return) arbitrary) arbitrary,+                                splitSize " <||> " (<||>) arbitrary arbitrary,+                                splitSize " <<|> " (<<|>) arbitrary arbitrary,+                                reduceSize "anyToken >> " (anyToken >>) arbitrary,+                                reduceSize "satisfy head >> " (satisfy head >>) arbitrary,+                                reduceSize "satisfy (not . head) >> " (satisfy (not . head) >>) arbitrary,+                                reduceSize "lookAhead " lookAhead arbitrary,+                                reduceSize "notFollowedBy " notFollowedBy (arbitrary+                                                                           :: Gen (Described (Parser a [Bool] r)))] -instance (Monoid r, Show r) => Show (Parser [Bool] r) where+instance (Monoid r, Show r) => Show (Parser a [Bool] r) where    show p = showWith (showBoolFun show) show p  instance Monoid Bool where@@ -191,11 +268,14 @@ showBoolFun :: (r -> String) -> ([Bool] -> r) -> String showBoolFun show f = "\\[b]-> if b then " ++ show (f [True]) ++ " else " ++ show (f [False]) -splitSize :: (a -> b -> c) -> Gen a -> Gen b -> Gen c-splitSize f a b = sized $ \n-> liftM2 f (resize (div n 2) a) (resize (div n 2) b)+splitSize :: String -> (a -> b -> c) -> Gen (Described a) -> Gen (Described b) -> Gen (Described c)+splitSize binOp f a b =+   sized $ \n-> liftM2 (\(Described s1 x) (Described s2 y)-> Described ('(' : s1 ++ binOp ++ s2 ++  ")") (f x y))+                   (resize (div n 2) a)+                   (resize (div n 2) b) -reduceSize :: (a -> b) -> Gen a -> Gen b-reduceSize f a = sized $ \n-> liftM f (resize (if n > 0 then pred n else n) a)+reduceSize :: String -> (a -> b) -> Gen (Described a) -> Gen (Described b)+reduceSize prefix f a = sized $ \n-> liftM (\(Described s x)-> Described ('(' : prefix ++ s ++ ")") (f x)) (resize (if n > 0 then pred n else n) a)  halveSize :: (a -> Property) -> Gen a -> Property halveSize f a = sized $ \n-> if n < 2 then property True else resize (n `div` 2) (a >>= f)

@@ -4,7 +4,7 @@     This file is part of the Streaming Component Combinators (SCC) project.      The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public-    License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later+    License as published by the Free Software Foundation, either version 3 of the License, or (at your moptional) any later     version.      SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty@@ -22,7 +22,7 @@ --  -- Implementation is based on Brzozowski derivatives. -{-# LANGUAGE ScopedTypeVariables, Rank2Types, ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}  module Text.ParserCombinators.Incremental (    -- * The Parser type@@ -30,343 +30,325 @@    -- * Using a Parser    feed, feedEof, results, completeResults, resultPrefix,    -- * Parser primitives-   eof, anyToken, token, satisfy, acceptAll, string, takeWhile, takeWhile1,+   failure, more, eof, anyToken, token, satisfy, acceptAll, string, takeWhile, takeWhile1,    -- * Parser combinators-   count, skip, option, many0, many1, manyTill,-   mapIncremental, (><), (<<|>), lookAhead, notFollowedBy, and, andThen,+   count, skip, moptional, concatMany, concatSome, manyTill,+   mapType, mapIncremental, (<||>), (<<|>), (><), lookAhead, notFollowedBy, and, andThen,    -- * Utilities    showWith    ) where -import Prelude hiding (and, foldl, takeWhile)-import Control.Applicative (Applicative (pure, (<*>), (*>), (<*)), Alternative (empty, (<|>), some, many), -                            optional, liftA2)-import Control.Monad (Functor (fmap), Monad (return, (>>=), (>>)), MonadPlus (mzero, mplus), ap, liftM2)-import Data.Maybe (fromMaybe)+import Prelude hiding (and, takeWhile)+import Control.Applicative (Applicative (pure, (<*>), (*>), (<*)), Alternative ((<|>)))+import Control.Applicative.Monoid(MonoidApplicative(..), MonoidAlternative(..))+import Control.Monad (ap) import Data.Monoid (Monoid, mempty, mappend) import Data.Monoid.Cancellative (LeftCancellativeMonoid (mstripPrefix))-import Data.Monoid.Factorial (FactorialMonoid (splitPrimePrefix, mfoldr), mspan)+import Data.Monoid.Factorial (FactorialMonoid (splitPrimePrefix), mspan) import Data.Monoid.Null (MonoidNull(mnull))-import Data.Foldable (Foldable, foldl, toList)  -- | The central parser type. Its first parameter is the input monoid, the second the output.-data Parser s r = Failure-                | Result s r-                | ResultPart (r -> r) (Parser s r)-                | Choice (Parser s r) (Parser s r)-                | CommitedLeftChoice (Parser s r) (Parser s r)-                | More (s -> Parser s r)-                | forall r'. Apply (Parser s r' -> Parser s r) (Parser s r')-                | forall r'. ApplyInput (s -> Parser s r' -> Parser s r) (Parser s r')+data Parser a s r = Failure+                  | Result s r+                  | ResultPart (r -> r) (Parser a s r)+                  | Choice (Parser a s r) (Parser a s r)+                  | Delay (Parser a s r) (s -> Parser a s r)  -- | Feeds a chunk of the input to the parser.-feed :: Monoid s => s -> Parser s r -> Parser s r+feed :: Monoid s => s -> Parser a s r -> Parser a s r feed _ Failure = Failure feed s (Result t r) = Result (mappend t s) r feed s (ResultPart r p) = resultPart r (feed s p)-feed s (Choice p1 p2) = feed s p1 <|> feed s p2-feed s (CommitedLeftChoice p1 p2) = feed s p1 <<|> feed s p2-feed s p@(More f) = f s-feed s (Apply f p) = f (feed s p)-feed s (ApplyInput f p) = f s (feed s p)+feed s (Choice p1 p2) = feed s p1 <||> feed s p2+feed s (Delay _ f) = f s  -- | Signals the end of the input.-feedEof :: Monoid s => Parser s r -> Parser s r+feedEof :: Monoid s => Parser a s r -> Parser a s r feedEof Failure = Failure feedEof p@Result{} = p feedEof (ResultPart r p) = prepend r (feedEof p)-   where prepend r (Result t r') = Result t (r r')-         prepend r (Choice p1 p2) = prepend r p1 <|> prepend r p2-         prepend r Failure = Failure-feedEof (Choice p1 p2) = feedEof p1 <|> feedEof p2-feedEof (CommitedLeftChoice p1 p2) = feedEof p1 <<|> feedEof p2-feedEof More{} = Failure-feedEof (Apply f p) = feedEof (f $ feedEof p)-feedEof (ApplyInput f p) = feedEof (f mempty $ feedEof p)+feedEof (Choice p1 p2) = feedEof p1 <||> feedEof p2+feedEof (Delay e _) = e  -- | Extracts all available parsing results. The first component of the result pair is a list of complete results -- together with the unconsumed remainder of the input. If the parsing can continue further, the second component of the -- pair provides the partial result prefix together with the parser for the rest of the input.-results :: Monoid r => Parser s r -> ([(r, s)], Maybe (r, Parser s r))+results :: Monoid r => Parser a s r -> ([(r, s)], Maybe (r, Parser a s r)) results Failure = ([], Nothing) results (Result t r) = ([(r, t)], Nothing)-results (ResultPart f p) = (map prepend results', fmap prepend rest)+results (ResultPart f p) = (map applyToFst results', fmap (fmap infallible . applyToFst) rest)    where (results', rest) = results p-         prepend (x, y) = (f x, y)-results (Choice p1@Result{} p2) = (results1 ++ results2, combine rest1 rest2)+         applyToFst (x, y) = (f x, y)+results (Choice p1 p2) | isInfallible p1 = (results1 ++ results2, combine rest1 rest2)    where (results1, rest1) = results p1          (results2, rest2) = results p2-         combine Nothing rest2 = rest2-         combine rest1 Nothing = rest1-         combine (Just (r1, p1)) (Just (r2, p2)) = -            Just (mempty, Choice (ResultPart (mappend r1) p1) (ResultPart (mappend r2) p2))+         combine Nothing rest = rest+         combine rest Nothing = rest+         combine (Just (r1, p1')) (Just (r2, p2')) =+            Just (mempty, Choice (resultPart (mappend r1) p1') (resultPart (mappend r2) p2')) results p = ([], Just (mempty, p))  -- | Like 'results', but returns only the complete results with the corresponding unconsumed inputs.-completeResults :: Parser s r -> [(r, s)]+completeResults :: Parser a s r -> [(r, s)] completeResults (Result t r) = [(r, t)] completeResults (ResultPart f p) = map (\(r, t)-> (f r, t)) (completeResults p)-completeResults (Choice p1@Result{} p2) = completeResults p1 ++ completeResults p2+completeResults (Choice p1 p2) | isInfallible p1 = completeResults p1 ++ completeResults p2 completeResults _ = [] --- | Determines if there are any complete results available.-hasResult :: Parser s r -> Bool-hasResult Result{} = True-hasResult (ResultPart _ p) = hasResult p-hasResult (Choice Result{} _) = True-hasResult (CommitedLeftChoice _ p) = hasResult p-hasResult _ = False- -- | Like 'results', but returns only the partial result prefix.-resultPrefix :: Monoid r => Parser s r -> (r, Parser s r)+resultPrefix :: Monoid r => Parser a s r -> (r, Parser a s r) resultPrefix (Result t r) = (r, Result t mempty)-resultPrefix (ResultPart f p) = (f r, p')-   where (r, p') = resultPrefix p+resultPrefix (ResultPart f p) = (f mempty, infallible p) resultPrefix p = (mempty, p) --- | Behaves like the argument parser, but without consuming any input.-lookAhead :: Monoid s => Parser s r -> Parser s r-lookAhead p = lookAheadInto mempty p---- | Does not consume any input; succeeds (with 'mempty' result) iff the argument parser fails.-notFollowedBy :: (Monoid s, Monoid r) => Parser s r' -> Parser s r-notFollowedBy = lookAheadNotInto mempty--lookAheadInto :: Monoid s => s -> Parser s r -> Parser s r-lookAheadInto t Failure               = Failure-lookAheadInto t (Result _ r)          = Result t r-lookAheadInto t (ResultPart r p)      = resultPart r (lookAheadInto t p)-lookAheadInto t (More f)              = More (\s-> lookAheadInto (mappend t s) (f s))-lookAheadInto t (Choice p1 p2)        = lookAheadInto t p1 <|> lookAheadInto t p2-lookAheadInto t p                     = ApplyInput (\t' p'-> lookAheadInto (mappend t t') p') p--lookAheadNotInto :: (Monoid s, Monoid r) => s -> Parser s r' -> Parser s r-lookAheadNotInto t Failure               = Result t mempty-lookAheadNotInto t (Result _ r)          = Failure-lookAheadNotInto t (Choice (Result _ r) _) = Failure-lookAheadNotInto t (ResultPart r p)      = lookAheadNotInto t p-lookAheadNotInto t p                     = ApplyInput (\t' p'-> lookAheadNotInto (mappend t t') p') p---- | Provides a partial parsing result.-resultPart :: (r -> r) -> Parser s r -> Parser s r-resultPart _ Failure = Failure-resultPart f (Result t r) = Result t (f r)-resultPart f (Choice (Result t r) p) = Choice (Result t (f r)) (resultPart f p)-resultPart f (ResultPart g p) = ResultPart (f . g) p-resultPart f p = ResultPart f p+failure :: Parser a s r+failure = Failure  -- | Usage of 'fmap' destroys the incrementality of parsing results, if you need it use 'mapIncremental' instead.-instance Monoid s => Functor (Parser s) where-   fmap f Failure = Failure+instance Monoid s => Functor (Parser a s) where    fmap f (Result t r) = Result t (f r)-   fmap f (Choice p1 p2) = fmap f p1 <|> fmap f p2-   fmap f (CommitedLeftChoice p1 p2) = fmap f p1 <<|> fmap f p2-   fmap f (More g) = More (fmap f . g)-   fmap f p = Apply (fmap f) p+   fmap f (ResultPart r p) = fmap f (prepend r p)+   fmap f p = apply (fmap f) p --- | The '<*>' combinator requires its both arguments to provide complete parsing results, takeWhile '*>' and '<*' preserve--- the incremental results.-instance Monoid s => Applicative (Parser s) where+-- | The '<*>' combinator requires its both arguments to provide complete parsing results, takeWhile '*>' and '<*'+-- preserve the incremental results.+instance Monoid s => Applicative (Parser a s) where    pure = Result mempty    (<*>) = ap    (*>) = (>>) -   Failure <* _ = Failure    Result t r <* p = feed t p *> pure r-   ResultPart r p1 <* p2 = ResultPart r (p1 <* p2)-   Choice p1a p1b <* p2 = (p1a <* p2) <|> (p1b <* p2)-   More f <* p = More (\x-> f x <* p)-   p1 <* p2 = Apply (<* p2) p1---- | The '<|>' choice combinator is symmetric.-instance Monoid s => Alternative (Parser s) where-   empty = Failure-   -   Failure <|> p = p-   p <|> Failure = p-   More f <|> More g = More (\x-> f x <|> g x)-   p1@Result{} <|> p2 = Choice p1 p2-   Choice p1a@Result{} p1b <|> p2 = Choice p1a (p1b <|> p2)-   p1 <|> p2@Result{} = Choice p2 p1-   p1 <|> Choice p2a@Result{} p2b = Choice p2a (p1 <|> p2b)-   p1 <|> p2 = Choice p1 p2+   ResultPart r p1 <* p2 | isInfallible p2 = resultPart r (p1 <* p2)+   p1 <* p2 = apply (<* p2) p1  -- | Usage of '>>=' destroys the incrementality of its left argument's parsing results, but '>>' is safe to use.-instance Monoid s => Monad (Parser s) where+instance Monoid s => Monad (Parser a s) where    return = Result mempty -   Failure >>= _ = Failure    Result t r >>= f = feed t (f r)-   Choice p1 p2 >>= f = (p1 >>= f) <|> (p2 >>= f)-   More f >>= g = More (\x-> f x >>= g)-   p >>= f = Apply (>>= f) p+   ResultPart r p >>= f = prepend r p >>= f+   p >>= f = apply (>>= f) p -   Failure >> _ = Failure    Result t _ >> p = feed t p-   ResultPart r p1 >> p2 = p1 >> p2-   Choice p1a p1b >> p2 = (p1a >> p2) <|> (p1b >> p2)-   More f >> p = More (\x-> f x >> p)-   p1 >> p2 = Apply (>> p2) p1+   ResultPart _ p1 >> p2 = p1 >> p2+   p1 >> p2 = apply (>> p2) p1 --- | The 'MonadPlus' and the 'Alternative' instance differ: the former's 'mplus' combinator equals the asymmetric '<<|>'--- choice.-instance Monoid s => MonadPlus (Parser s) where-   mzero = Failure-   mplus = (<<|>)+instance Monoid s => MonoidApplicative (Parser a s) where+   _ >< Failure = Failure+   p1 >< p2 | isInfallible p2 = appendIncremental p1 p2+            | otherwise       = append p1 p2 +appendIncremental :: (Monoid s, Monoid r) => Parser a s r -> Parser a s r -> Parser a s r+appendIncremental (Result t r) p = resultPart (mappend r) (feed t p)+appendIncremental (ResultPart r p1) p2 = resultPart r (appendIncremental p1 p2)+appendIncremental p1 p2 = apply (`appendIncremental` p2) p1++append :: (Monoid s, Monoid r) => Parser a s r -> Parser a s r -> Parser a s r+append (Result t r) p2 = prepend (mappend r) (feed t p2)+append (ResultPart r p1) p2 = prepend r (append p1 p2)+append p1 p2 = apply (`append` p2) p1++-- | Zero or more argument occurrences like 'many', but matches the longest possible input sequence.+instance (Alternative (Parser a s), Monoid s) => MonoidAlternative (Parser a s) where+   moptional p = p <|> mempty+   concatMany = fst . manies+   concatSome = snd . manies++manies :: (Alternative (Parser a s), Monoid s, Monoid r) => Parser a s r -> (Parser a s r, Parser a s r)+manies p = (many, some)+   where many = some <|> mempty+         some = appendIncremental p many+ -- | Two parsers can be sequentially joined.-instance (Monoid s, Monoid r) => Monoid (Parser s r) where+instance (Monoid s, Monoid r) => Monoid (Parser a s r) where    mempty = return mempty    mappend = (><) --- instance (Monoid s, Monoid r, Show s, Show r) => Show (Parser s r) where+infixl 3 <||>+infixl 3 <<|>++(<||>) :: Parser a s r -> Parser a s r -> Parser a s r+Delay e1 f1 <||> Delay e2 f2 = Delay (e1 <||> e2) (\s-> f1 s <||> f2 s)+Failure <||> p = p+p <||> Failure = p+p1@Result{} <||> p2 = Choice p1 p2+p1@ResultPart{} <||> p2 = Choice p1 p2+Choice p1a p1b <||> p2 | isInfallible p1a = Choice p1a (p1b <||> p2)+p1 <||> p2@Result{} = Choice p2 p1+p1 <||> p2@ResultPart{} = Choice p2 p1+p1 <||> Choice p2a p2b | isInfallible p2a = Choice p2a (p1 <||> p2b)+p1 <||> p2 = Choice p1 p2++(<<|>) :: Monoid s => Parser a s r -> Parser a s r -> Parser a s r+Failure <<|> p = p+p <<|> _ | isInfallible p = p+p <<|> Failure = p+p1 <<|> p2 = if isInfallible p2 then infallible p' else p'+   where p' = Delay (feedEof p1 <<|> feedEof p2) (\s-> feed s p1 <<|> feed s p2)++-- instance (Monoid s, Monoid r, Show s, Show r) => Show (Parser a s r) where --    show = showWith (show . ($ mempty)) show -showWith :: (Monoid s, Monoid r, Show s) => ((s -> Parser s r) -> String) -> (r -> String) -> Parser s r -> String-showWith sm sr Failure = "Failure"-showWith sm sr (Result t r) = "(Result (" ++ shows t ("++) " ++ sr r ++ ")")-showWith sm sr (ResultPart f p) = "(ResultPart (mappend " ++ sr (f mempty) ++ ") " ++ showWith sm sr p ++ ")"+showWith :: (Monoid s, Monoid r, Show s) => ((s -> Parser a s r) -> String) -> (r -> String) -> Parser a s r -> String+showWith _ _ Failure = "Failure"+showWith _ sr (Result t r) = "(Result " ++ shows t (" " ++ sr r ++ ")")+showWith sm sr (ResultPart f p) =+   "(ResultPart (mappend " ++ sr (f mempty) ++ ") " ++ showWith sm sr p ++ ")" showWith sm sr (Choice p1 p2) = "(Choice " ++ showWith sm sr p1 ++ " " ++ showWith sm sr p2 ++ ")"-showWith sm sr (CommitedLeftChoice p1 p2) = -   "(CommitedLeftChoice " ++ showWith sm sr p1 ++ " " ++ showWith sm sr p2 ++ ")"-showWith sm sr (More f) = "(More $ " ++ sm f ++ ")"-showWith sm sr (Apply f p) = "Apply"-showWith sm sr (ApplyInput f p) = "ApplyInput"+showWith sm sr (Delay e f) = "(Delay " ++ showWith sm sr e ++ " " ++ sm f ++ ")"  -- | Like 'fmap', but capable of mapping partial results, being restricted to 'Monoid' types only.-mapIncremental :: (Monoid s, Monoid a, Monoid b) => (a -> b) -> Parser s a -> Parser s b-mapIncremental f Failure = Failure+mapIncremental :: (Monoid s, Monoid a, Monoid b) => (a -> b) -> Parser p s a -> Parser p s b mapIncremental f (Result t r) = Result t (f r)-mapIncremental f (ResultPart r p) = ResultPart (f (r mempty) `mappend`) (mapIncremental f p)-mapIncremental f (Choice p1 p2) = mapIncremental f p1 <|> mapIncremental f p2-mapIncremental f (CommitedLeftChoice p1 p2) = mapIncremental f p1 <<|> mapIncremental f p2-mapIncremental f (More g) = More (mapIncremental f . g)-mapIncremental f p = Apply (mapIncremental f) p+mapIncremental f (ResultPart r p) = resultPart (mappend $ f (r mempty)) (mapIncremental f p)+mapIncremental f p = apply (mapIncremental f) p --- | Left-weighted choice. The right parser is used only if the left one utterly fails.-infixl 3 <<|>-(<<|>) :: Parser s r -> Parser s r -> Parser s r-Failure <<|> p = p-p <<|> Failure = p-p <<|> _ | hasResult p = p-More f <<|> More g = More (\x-> f x <<|> g x)-p1 <<|> p2 = CommitedLeftChoice p1 p2+-- | Behaves like the argument parser, but without consuming any input.+lookAhead :: Monoid s => Parser a s r -> Parser a s r+lookAhead p = lookAheadInto mempty p+   where lookAheadInto :: Monoid s => s -> Parser a s r -> Parser a s r+         lookAheadInto _ Failure           = Failure+         lookAheadInto t (Result _ r)      = Result t r+         lookAheadInto t (ResultPart r p') = resultPart r (lookAheadInto t p')+         lookAheadInto t (Choice p1 p2)    = lookAheadInto t p1 <||> lookAheadInto t p2+         lookAheadInto t (Delay e f)       = Delay (lookAheadInto t e) (\s-> lookAheadInto (mappend t s) (f s)) --- | Join operator on parsers of same type, preserving the incremental results.-infixl 5 ><-(><) :: (Monoid s, Monoid r) => Parser s r -> Parser s r -> Parser s r-Failure >< _ = Failure-Result t r >< p = resultPart (mappend r) (feed t p)-ResultPart r p1 >< p2 = resultPart r (p1 >< p2)-Choice p1a p1b >< p2 = (p1a >< p2) <|> (p1b >< p2)-More f >< p = More (\x-> f x >< p)-p1 >< p2 = Apply (>< p2) p1+-- | Does not consume any input; succeeds (with 'mempty' result) iff the argument parser fails.+notFollowedBy :: (Monoid s, Monoid r) => Parser a s r' -> Parser a s r+notFollowedBy = lookAheadNotInto mempty+   where lookAheadNotInto :: (Monoid s, Monoid r) => s -> Parser a s r' -> Parser a s r+         lookAheadNotInto t Failure     = Result t mempty+         lookAheadNotInto t (Delay e f) = Delay (lookAheadNotInto t e) (\s-> lookAheadNotInto (mappend t s) (f s))+         lookAheadNotInto t p | isInfallible p = Failure+                              | otherwise = Delay (lookAheadNotInto t $ feedEof p) +                                                  (\s-> lookAheadNotInto (mappend t s) (feed s p)) +-- | Provides a partial parsing result.+resultPart :: (r -> r) -> Parser a s r -> Parser a s r+resultPart _ Failure = Failure+resultPart f (Result t r) = Result t (f r)+resultPart f (ResultPart g p) = ResultPart (f . g) p+resultPart f p = ResultPart f p++infallible :: Parser a s r -> Parser a s r+infallible Failure = error "Internal contradiction"+infallible p | isInfallible p = p+             | otherwise      = ResultPart id p++isInfallible :: Parser a s r -> Bool+isInfallible Result{} = True+isInfallible ResultPart{} = True+isInfallible (Choice p _) = isInfallible p+isInfallible _ = False++prepend :: Monoid s => (r -> r) -> Parser a s r -> Parser a s r+prepend _ Failure = Failure+prepend r1 (Result t r2) = Result t (r1 r2)+prepend r1 (ResultPart r2 p) = ResultPart (r1 . r2) p+prepend r (Choice p1 p2) = Choice (prepend r p1) (prepend r p2)+prepend r (Delay e f) = Delay (feedEof $ prepend r e) (prepend r . f)++apply :: Monoid s => (Parser a s r -> Parser a s r') -> Parser a s r -> Parser a s r'+apply _ Failure = Failure+apply f (Choice p1 p2) = f p1 <||> f p2+apply g (Delay e f) = Delay (feedEof $ g e) (g . f)+apply f p = Delay (feedEof $ f $ feedEof p) (\s-> f $ feed s p)++mapType :: (Parser a s r -> Parser b s r) -> Parser a s r -> Parser b s r+mapType _ Failure = Failure+mapType _ (Result s r) = Result s r+mapType f (ResultPart r p) = ResultPart r (f p)+mapType f (Choice p1 p2) = Choice (f p1) (f p2)+mapType g (Delay e f) = Delay (g e) (g . f)++more :: (s -> Parser a s r) -> Parser a s r+more = Delay Failure+ -- | A parser that fails on any input and succeeds at its end.-eof :: (MonoidNull s, Monoid r) => Parser s r-eof = notFollowedBy nonEmptyInput-   where nonEmptyInput = More $ \s-> if mnull s then nonEmptyInput else return s+eof :: (MonoidNull s, Monoid r) => Parser a s r+eof = Delay mempty (\s-> if mnull s then eof else Failure)  -- | A parser that accepts any single input atom.-anyToken :: FactorialMonoid s => Parser s s-anyToken = More f+anyToken :: FactorialMonoid s => Parser a s s+anyToken = more f    where f s = case splitPrimePrefix s                of Just (first, rest) -> Result rest first                   Nothing -> anyToken  -- | A parser that accepts a specific input atom.-token :: (Eq s, FactorialMonoid s) => s -> Parser s s+token :: (Eq s, FactorialMonoid s) => s -> Parser a s s token x = satisfy (== x)  -- | A parser that accepts an input atom only if it satisfies the given predicate.-satisfy :: FactorialMonoid s => (s -> Bool) -> Parser s s-satisfy pred = p-   where p = More f+satisfy :: FactorialMonoid s => (s -> Bool) -> Parser a s s+satisfy predicate = p+   where p = more f          f s = case splitPrimePrefix s-               of Just (first, rest) -> if pred first then Result rest first else Failure+               of Just (first, rest) -> if predicate first then Result rest first else Failure                   Nothing -> p  -- | A parser that consumes and returns the given prefix of the input.-string :: (LeftCancellativeMonoid s, MonoidNull s) => s -> Parser s s+string :: (LeftCancellativeMonoid s, MonoidNull s) => s -> Parser a s s string x | mnull x = mempty-string x = More (\y-> case (mstripPrefix x y, mstripPrefix y x)+string x = more (\y-> case (mstripPrefix x y, mstripPrefix y x)                       of (Just y', _) -> Result y' x                          (Nothing, Nothing) -> Failure                          (Nothing, Just x') -> string x' >> return x)  -- | A parser accepting the longest sequence of input atoms that match the given predicate; an optimized version of--- 'many0 . satisfy'.-takeWhile :: (FactorialMonoid s, MonoidNull s) => (s -> Bool) -> Parser s s+-- 'concatMany . satisfy'.+takeWhile :: (FactorialMonoid s, MonoidNull s) => (s -> Bool) -> Parser a s s takeWhile = fst . takeWhiles  -- | A parser accepting the longest non-empty sequence of input atoms that match the given predicate; an optimized--- version of 'many1 . satisfy'.-takeWhile1 :: (FactorialMonoid s, MonoidNull s) => (s -> Bool) -> Parser s s+-- version of 'concatSome . satisfy'.+takeWhile1 :: (FactorialMonoid s, MonoidNull s) => (s -> Bool) -> Parser a s s takeWhile1 = snd . takeWhiles -takeWhiles p = (takeWhile, takeWhile1)-   where takeWhile = CommitedLeftChoice takeWhile1 (return mempty)-         takeWhile1 = More f-         f s | mnull s = takeWhile1+takeWhiles :: (FactorialMonoid s, MonoidNull s) => (s -> Bool) -> (Parser a s s, Parser a s s)+takeWhiles p = (while, while1)+   where while = while1 <<|> return mempty+         while1 = more f+         f s | mnull s = while1          f s = let (prefix, suffix) = mspan p s                 in if mnull prefix then Failure-                  else if mnull suffix then resultPart (mappend prefix) takeWhile+                  else if mnull suffix then resultPart (mappend prefix) while                        else Result suffix prefix  -- | Accepts the given number of occurrences of the argument parser.-count :: (Monoid s, Monoid r) => Int -> Parser s r -> Parser s r+count :: (Monoid s, Monoid r) => Int -> Parser a s r -> Parser a s r count n p | n > 0 = p >< count (pred n) p           | otherwise = mempty --- | Like 'optional', but restricted to 'Monoid' results.-option :: (Monoid s, Monoid r) => Parser s r -> Parser s r-option p = p <|> return mempty- -- | Discards the results of the argument parser.-skip :: (Monoid s, Monoid r) => Parser s r' -> Parser s r-skip p = p >> mempty---- | Zero or more argument occurrences like 'many', but matches the longest possible input sequence.-many0 :: (Monoid s, Monoid r) => Parser s r -> Parser s r-many0 = fst . manies---- | One or more argument occurrences like 'some', but matches the longest possible input sequence.-many1 :: (Monoid s, Monoid r) => Parser s r -> Parser s r-many1 = snd . manies--manies p = (many0, many1)-   where many0 = CommitedLeftChoice many1 (return mempty)-         many1 = More (\s-> feed s (p >< many0))+skip :: (Monoid s, Monoid r) => Parser a s r' -> Parser a s r+skip p = p *> mempty  -- | Repeats matching the first argument until the second one succeeds.-manyTill :: (Monoid s, Monoid r) => Parser s r -> Parser s r' -> Parser s r+manyTill :: (Alternative (Parser a s), Monoid s, Monoid r) => Parser a s r -> Parser a s r' -> Parser a s r manyTill next end = t-   where t = skip end <<|> (next >< t)+   where t = skip end <|> mappend next t  -- | A parser that accepts all input.-acceptAll :: Monoid s => Parser s s-acceptAll = CommitedLeftChoice (More $ \s-> resultPart (mappend s) acceptAll) (return mempty)+acceptAll :: Monoid s => Parser a s s+acceptAll = infallible acceptAll'+   where acceptAll' = Delay mempty (\s-> resultPart (mappend s) acceptAll')  -- | Parallel parser conjunction: the combined parser keeps accepting input as long as both arguments do.-and :: (Monoid s, Monoid r1, Monoid r2) => Parser s r1 -> Parser s r2 -> Parser s (r1, r2)+and :: (Monoid s, Monoid r1, Monoid r2) => Parser a s r1 -> Parser a s r2 -> Parser a s (r1, r2) Failure `and` _ = Failure _ `and` Failure = Failure p `and` Result _ r = fmap (\x-> (x, r)) (feedEof p) Result _ r `and` p = fmap (\x-> (r, x)) (feedEof p) ResultPart f p1 `and` p2 = fmap (\(r1, r2)-> (f r1, r2)) (p1 `and` p2) p1 `and` ResultPart f p2 = fmap (\(r1, r2)-> (r1, f r2)) (p1 `and` p2)-Choice p1a p1b `and` p2 = (p1a `and` p2) <|> (p1b `and` p2)-p1 `and` Choice p2a p2b = (p1 `and` p2a) <|> (p1 `and` p2b)-More f `and` p = More (\x-> f x `and` feed x p)-p `and` More f = More (\x-> feed x p `and` f x)-p1 `and` p2 = (feedEof p1 `and` feedEof p2) <|> More (\x-> feed x p1 `and` feed x p2)+Choice p1a p1b `and` p2 = (p1a `and` p2) <||> (p1b `and` p2)+p1 `and` Choice p2a p2b = (p1 `and` p2a) <||> (p1 `and` p2b)+p1 `and` p2 = Delay (feedEof p1 `and` feedEof p2) (\s-> feed s p1 `and` feed s p2) --- | Parser sequence that preserves incremental results, otherwise equivalent to 'liftA2' (,)-andThen :: (Monoid s, Monoid r1, Monoid r2) => Parser s r1 -> Parser s r2 -> Parser s (r1, r2)-Failure `andThen` _ = Failure-Result t r `andThen` p = resultPart (mappend (r, mempty)) (feed t (fmap ((,) mempty) p))-ResultPart f p1 `andThen` p2 = resultPart (\(r1, r2)-> (f r1, r2)) (p1 `andThen` p2)-Choice p1a p1b `andThen` p2 = (p1a `andThen` p2) <|> (p1b `andThen` p2)-More f `andThen` p = More (\x-> f x `andThen` p)-p1 `andThen` p2 = Apply (`andThen` p2) p1+-- | A sequence parser that preserves incremental results, otherwise equivalent to 'Alternative.liftA2' (,)+andThen :: (Monoid s, Monoid r1, Monoid r2) => Parser a s r1 -> Parser a s r2 -> Parser a s (r1, r2)+Result t r `andThen` p | isInfallible p = resultPart (mappend (r, mempty)) (feed t (fmap ((,) mempty) p))+ResultPart f p1 `andThen` p2 | isInfallible p2 = resultPart (\(r1, r2)-> (f r1, r2)) (p1 `andThen` p2)+p1 `andThen` p2 = apply (`andThen` p2) p1

@@ -0,0 +1,56 @@+{- +    Copyright 2010-2011 Mario Blazevic++    This file is part of the Streaming Component Combinators (SCC) project.++    The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public+    License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later+    version.++    SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty+    of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.++    You should have received a copy of the GNU General Public License along with SCC.  If not, see+    <http://www.gnu.org/licenses/>.+-}++-- | This module defines incremental parsers. +-- +-- The exported 'Parser' type can provide partial parsing results from partial input, as long as the output is a+-- 'Monoid'. Construct a parser using the primitives and combinators, supply it with input using functions 'feed' and+-- 'feedEof', and extract the parsed output using 'results'.+-- +-- Implementation is based on Brzozowski derivatives.++{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-}++module Text.ParserCombinators.Incremental.LeftBiasedLocal (+   module Text.ParserCombinators.Incremental,+   Parser, LeftBiasedLocal, leftmost+)+where++import Control.Applicative (Alternative (empty, (<|>)))+import Control.Monad (MonadPlus (mzero, mplus))+import Data.Monoid (Monoid)++import Text.ParserCombinators.Incremental hiding (Parser)+import qualified Text.ParserCombinators.Incremental as Incremental (Parser)++-- | An empty type to specialize 'Parser' for the left-biased 'Alternative' instance.+data LeftBiasedLocal++type Parser s r = Incremental.Parser LeftBiasedLocal s r++-- | Left-biased choice. The right parser is used only if the left one utterly fails.+instance Monoid s => Alternative (Incremental.Parser LeftBiasedLocal s) where+   empty = failure+   p1 <|> p2 = p1 <<|> p2++-- | The 'MonadPlus' instances are the same as the 'Alternative' instances.+instance Monoid s => MonadPlus (Incremental.Parser LeftBiasedLocal s) where+   mzero = failure+   mplus = (<|>)++leftmost :: Parser s r -> Incremental.Parser a s r+leftmost p = mapType leftmost p

@@ -0,0 +1,56 @@+{- +    Copyright 2010-2011 Mario Blazevic++    This file is part of the Streaming Component Combinators (SCC) project.++    The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public+    License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later+    version.++    SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty+    of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.++    You should have received a copy of the GNU General Public License along with SCC.  If not, see+    <http://www.gnu.org/licenses/>.+-}++-- | This module defines incremental parsers. +-- +-- The exported 'Parser' type can provide partial parsing results from partial input, as long as the output is a+-- 'Monoid'. Construct a parser using the primitives and combinators, supply it with input using functions 'feed' and+-- 'feedEof', and extract the parsed output using 'results'.+-- +-- Implementation is based on Brzozowski derivatives.++{-# LANGUAGE EmptyDataDecls, FlexibleInstances #-}++module Text.ParserCombinators.Incremental.Symmetric (+   module Text.ParserCombinators.Incremental,+   Parser, Symmetric, allOf+)+where++import Control.Applicative (Alternative (empty, (<|>)))+import Control.Monad (MonadPlus (mzero, mplus))+import Data.Monoid (Monoid)++import Text.ParserCombinators.Incremental hiding (Parser)+import qualified Text.ParserCombinators.Incremental as Incremental (Parser)++-- | An empty type to specialize 'Parser' for the symmetric 'Alternative' instance.+data Symmetric++type Parser s r = Incremental.Parser Symmetric s r++-- | The symmetric version of the '<|>' choice combinator.+instance Monoid s => Alternative (Incremental.Parser Symmetric s) where+   empty = failure+   p1 <|> p2 = p1 <||> p2++-- | The 'MonadPlus' instances are the same as the 'Alternative' instances.+instance Monoid s => MonadPlus (Incremental.Parser Symmetric s) where+   mzero = failure+   mplus = (<|>)++allOf :: Parser s r -> Incremental.Parser a s r+allOf p = mapType allOf p

@@ -1,5 +1,5 @@ Name:                incremental-parser-Version:             0.1+Version:             0.2 Cabal-Version:       >= 1.2 Build-Type:          Simple Synopsis:            Generic parser library capable of providing partial results from partial input.@@ -26,6 +26,8 @@ Executable test-incremental-parser   Main-is:           Test/TestIncrementalParser.hs   Other-Modules:     Text.ParserCombinators.Incremental,+                     Text.ParserCombinators.Incremental.LeftBiasedLocal, Text.ParserCombinators.Incremental.Symmetric+                     Control.Applicative.Monoid,                      Data.Monoid.Cancellative, Data.Monoid.Factorial, Data.Monoid.Null   Build-Depends:     base < 5, bytestring >= 0.9 && < 1.0, text >= 0.11.0.1 && < 0.12, QuickCheck >= 2 && < 3   if !flag(test)@@ -33,6 +35,8 @@  Library   Exposed-Modules:   Text.ParserCombinators.Incremental,+                     Text.ParserCombinators.Incremental.LeftBiasedLocal, Text.ParserCombinators.Incremental.Symmetric+                     Control.Applicative.Monoid,                      Data.Monoid.Cancellative, Data.Monoid.Factorial, Data.Monoid.Null   Build-Depends:     base < 5, bytestring >= 0.9 && < 1.0, text >= 0.11.0.1 && < 0.12   GHC-prof-options:  -auto-all