incremental-parser 0.2.3.4 → 0.2.4

raw patch · 6 files changed

+310/−123 lines, 6 filesdep +bytestringdep +criteriondep +deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring, criterion, deepseq, incremental-parser, text

API changes (from Hackage documentation)

Files

• Benchmarks/CSV.hs +139/−0
• Control/Applicative/Monoid.hs +16/−6
• Text/ParserCombinators/Incremental.hs +138/−111
• Text/ParserCombinators/Incremental/LeftBiasedLocal.hs +4/−2
• Text/ParserCombinators/Incremental/Symmetric.hs +4/−2
• incremental-parser.cabal +9/−2

@@ -0,0 +1,139 @@+{-+    Copyright 2010-2015 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/>.+-}++{-# LANGUAGE Haskell2010, BangPatterns, ExistentialQuantification, FlexibleContexts, OverloadedStrings,+  ScopedTypeVariables #-}++module Main (main, parseWhole, parseChunked) where++import Prelude hiding (null, splitAt)+import Control.Applicative (Alternative, (<$>), (<*>), (<*), (*>), (<|>), many, pure)+import Control.Monad (void)+import Data.Foldable (foldl')+import Data.Monoid (Monoid, (<>), mappend, mempty)+import Data.Monoid.Textual (TextualMonoid)+import Data.Monoid.Factorial (FactorialMonoid (splitAt))+import Data.Monoid.Null (MonoidNull (null))+import Text.ParserCombinators.Incremental.LeftBiasedLocal++import Control.DeepSeq (NFData(..))+import Criterion.Main (bench, bgroup, defaultMain, nf)+   +import qualified Data.ByteString as B+import qualified Data.Text.IO as T++import Data.Monoid.Instances.ByteString.UTF8 (ByteStringUTF8(ByteStringUTF8))+import Data.Monoid.Instances.Concat (Concat(extract))++instance NFData ByteStringUTF8 where+  rnf (ByteStringUTF8 b) = rnf b++instance NFData a => NFData (Concat a) where+  rnf s = rnf (extract s)++endOfInput :: MonoidNull s => Parser s ()+endOfInput = eof++char :: TextualMonoid t => Char -> Parser t t+char = satisfyChar . (==)++sepBy1 :: Alternative f => f a -> f s -> f [a]+sepBy1 p q = (:) <$> p <*> many (q *> p)+             +lineEnd :: TextualMonoid t => Parser t ()+lineEnd = void (char '\n') <|> void (string "\r\n")+          <|> void (char '\r')+          <?> "end of line"++unquotedField :: TextualMonoid t => Parser t t+unquotedField = takeCharsWhile (`notElem` (",\n\r\"" :: [Char]))+                <?> "unquoted field"++insideQuotes :: TextualMonoid t => Parser t t+insideQuotes = mappend <$> takeCharsWhile (/= '"')+               <*> concatMany (mappend <$> dquotes <*> insideQuotes)+               <?> "inside of double quotes"++   where dquotes = string "\"\"" >> return "\""+                   <?> "paired double quotes"++quotedField :: TextualMonoid t => Parser t t+quotedField = char '"' *> insideQuotes <* char '"'+              <?> "quoted field"++field :: TextualMonoid t => Parser t t+field = quotedField <|> unquotedField+        <?> "field"++record :: TextualMonoid t => Parser t [t]+record = field `sepBy1` char ','+++-- file1 is not incremental because it's fallible+file1 :: TextualMonoid t => Parser t [[t]]+file1 = (:) <$> record+        +<*> manyTill (lineEnd *> ((:[]) <$> record))+                      (moptional lineEnd *> endOfInput)+        <?> "file"++file2 :: forall t. TextualMonoid t => Parser t [[t]]+file2 = (:) <$> record+        +<*> many ((notFollowedBy (moptional lineEnd *> endOfInput) :: Parser t ())+                  *> lineEnd *> record)+        <?> "file"++parseWhole :: TextualMonoid t => Parser t [[t]] -> t -> [([[t]], t)]+parseWhole p s = completeResults (feedEof $ feed s p)++parseChunked :: TextualMonoid t => Parser t [[t]] -> [t] -> [([[t]], t)]+parseChunked p chunks = completeResults (feedEof $ foldl' (flip feed) p $ chunks)++parseIncremental :: (Monoid r, TextualMonoid t) => Parser t [[t]] -> ([[t]] -> r) -> [t] -> r+parseIncremental p0 process chunks = let (inc, p') = foldl' feedInc (mempty, p0) chunks+                                     in case completeResults (feedEof p')+                                        of [] -> inc+                                           (r,_):_ -> inc <> process r+   where feedInc (!inc, !p) chunk = let !(prefix, p') = resultPrefix (feed chunk p)+                                    in (inc <> process prefix, p')++chunksOf :: FactorialMonoid t => Int -> t -> [t]+chunksOf len t+   | null t = []+   | (h, t') <- splitAt len t = h : chunksOf len t'++chunkSize :: Int+chunkSize = 1024++data Input = forall t. (NFData t, TextualMonoid t) => Input String t++main :: IO ()+main = do+   airportsS <- readFile "Benchmarks/airports.dat"+   airportsT <- T.readFile "Benchmarks/airports.dat"+   airportsB <- B.readFile "Benchmarks/airports.dat"+   let inputs = [Input "UTF8" (ByteStringUTF8 airportsB),+                 Input "Text" airportsT,+                 Input "Concat String" (pure airportsS :: Concat String)]+   defaultMain [+      let chunks = chunksOf chunkSize i+      in nf id chunks `seq` bgroup inputName [+         bgroup parserName [+            bench "whole" $ nf (parseWhole p) i,+            bench "chunked" $ nf (parseChunked p) chunks,+            bench "incremental" $ nf (parseIncremental p id) chunks,+            bench "incremental'" $ nf (parseIncremental p (pure :: a -> Concat a)) chunks]+            | (parserName, p) <- [("manyTill", file1), ("many", file2)]]+         | Input inputName i <- inputs]

@@ -1,5 +1,5 @@-{- -    Copyright 2011 Mario Blazevic+{-+    Copyright 2011-2015 Mario Blazevic      This file is part of the Streaming Component Combinators (SCC) project. @@ -21,15 +21,20 @@    ) where -import Control.Applicative (Applicative (pure), Alternative ((<|>), some, many), liftA2)+import Control.Applicative (Applicative (pure, (<*>)), Alternative ((<|>), some, many), (<$>)) import Data.Monoid (Monoid, mempty, mappend, mconcat)   class Applicative f => MonoidApplicative f where+   -- | A variant of the Applicative's '<*>' operator specialized for endomorphic combinators.+   infixl 4 +<*>+   (+<*>) :: f (a -> a) -> f a -> f a+   (+<*>) = (<*>)+    -- | Lifted and potentially optimized monoid `mappend` operation from the parameter type.    infixl 5 ><    (><) :: Monoid a => f a -> f a -> f a-   (><) = liftA2 mappend+   a >< b = mappend <$> a +<*> b  class (Alternative f, MonoidApplicative f) => MonoidAlternative f where    -- | Like 'optional', but restricted to 'Monoid' results.@@ -38,8 +43,13 @@     -- | Zero or more argument occurrences like 'many', but concatenated.    concatMany :: Monoid a => f a -> f a-   concatMany = fmap mconcat . many+   concatMany x = many'+      where many' = some' <|> pure mempty+            some' = x >< many'     -- | One or more argument occurrences like 'some', but concatenated.    concatSome :: Monoid a => f a -> f a-   concatSome = fmap mconcat . some+   concatSome x = some'+      where many' = some' <|> pure mempty+            some' = x >< many'+   {-# MINIMAL #-}

@@ -1,10 +1,10 @@-{- -    Copyright 2010-2012 Mario Blazevic+{-+    Copyright 2010-2015 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 moptional) any later+    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@@ -30,19 +30,19 @@    -- * Using a Parser    feed, feedEof, inspect, results, completeResults, resultPrefix,    -- * Parser primitives-   failure, more, eof, anyToken, token, satisfy, acceptAll, string, takeWhile, takeWhile1,+   failure, (<?>), more, eof, anyToken, token, satisfy, acceptAll, string, takeWhile, takeWhile1,    -- ** Character primitives    satisfyChar, takeCharsWhile, takeCharsWhile1,    -- * Parser combinators    count, skip, moptional, concatMany, concatSome, manyTill,-   mapType, mapIncremental, (<||>), (<<|>), (><), lookAhead, notFollowedBy, and, andThen,+   mapType, mapIncremental, (+<*>), (<||>), (<<|>), (><), lookAhead, notFollowedBy, and, andThen,    -- * Utilities-   isInfallible, showWith+   isInfallible, showWith, defaultMany, defaultSome    ) where  import Prelude hiding (and, null, span, takeWhile)-import Control.Applicative (Applicative (pure, (<*>), (*>), (<*)), Alternative ((<|>)))+import Control.Applicative (Applicative (pure, (<*>), (*>), (<*)), Alternative ((<|>)), (<$>)) import Control.Applicative.Monoid(MonoidApplicative(..), MonoidAlternative(..)) import Control.Monad (ap) import Data.Maybe (fromMaybe)@@ -53,24 +53,25 @@ import Data.Monoid.Textual (TextualMonoid) import qualified Data.Monoid.Textual as Textual --- | The central parser type. Its first parameter is the input monoid, the second the output.-data Parser a s r = Failure+-- | The central parser type. Its first parameter is the subtype of the parser, the second is the input monoid type, the+-- third the output type.+data Parser t s r = Failure String                   | Result s r-                  | ResultPart (r -> r) (Parser a s r) (s -> Parser a s r)-                  | Delay (Parser a s r) (s -> Parser a s r)-                  | Choice (Parser a s r) (Parser a s r)+                  | ResultPart (r -> r) (Parser t s r) (s -> Parser t s r)+                  | Delay (Parser t s r) (s -> Parser t s r)+                  | Choice (Parser t s r) (Parser t s r)  -- | Feeds a chunk of the input to the parser.-feed :: Monoid s => s -> Parser a s r -> Parser a s r-feed s Failure = s `seq` Failure-feed s (Result t r) = Result (mappend t s) r+feed :: Monoid s => s -> Parser t s r -> Parser t s r+feed s p@Failure{} = s `seq` p+feed s (Result s' r) = Result (mappend s' s) r feed s (ResultPart r _ f) = resultPart r (f s) 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 a s r -> Parser a s r-feedEof Failure = Failure+feedEof :: Monoid s => Parser t s r -> Parser t s r+feedEof p@Failure{} = p feedEof p@Result{} = p feedEof (ResultPart r e _) = prepend r (feedEof e) feedEof (Choice p1 p2) = feedEof p1 <||> feedEof p2@@ -79,13 +80,13 @@ -- | Extracts all available parsing results from a 'Parser'. 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 a s r -> ([(r, s)], Maybe (r, Parser a s r))+results :: Monoid r => Parser t s r -> ([(r, s)], Maybe (r, Parser t s r)) results = fmap (fmap (\(mf, p)-> (fromMaybe id mf mempty, p))) . inspect  -- | Like 'results', but more general: doesn't assume that the result type is a 'Monoid'.-inspect :: Parser a s r -> ([(r, s)], Maybe (Maybe (r -> r), Parser a s r))-inspect Failure = ([], Nothing)-inspect (Result t r) = ([(r, t)], Nothing)+inspect :: Parser t s r -> ([(r, s)], Maybe (Maybe (r -> r), Parser t s r))+inspect Failure{} = ([], Nothing)+inspect (Result s r) = ([(r, s)], Nothing) inspect (ResultPart r e f) = ([], Just (Just r, ResultPart id e f)) inspect (Choice p1 p2) | isInfallible p1 = (results1 ++ results2, combine rest1 rest2)    where (results1, rest1) = inspect p1@@ -97,87 +98,99 @@ inspect p = ([], Just (Nothing, p))  -- | Like 'results', but returns only the complete results with the corresponding unconsumed inputs.-completeResults :: Parser a s r -> [(r, s)]-completeResults (Result t r) = [(r, t)]+completeResults :: Parser t s r -> [(r, s)]+completeResults (Result s r) = [(r, s)] completeResults (ResultPart r e f) = map (\(r', t)-> (r r', t)) (completeResults e) completeResults (Choice p1 p2) | isInfallible p1 = completeResults p1 ++ completeResults p2 completeResults _ = []  -- | Like 'results', but returns only the partial result prefix.-resultPrefix :: Monoid r => Parser a s r -> (r, Parser a s r)-resultPrefix (Result t r) = (r, Result t mempty)+resultPrefix :: Monoid r => Parser t s r -> (r, Parser t s r)+resultPrefix (Result s r) = (r, Result s mempty) resultPrefix (ResultPart r e f) = (r mempty, ResultPart id e f) resultPrefix p = (mempty, p) -failure :: Parser a s r-failure = Failure+failure :: Parser t s r+failure = Failure "failure" +infix  0 <?>++-- | Name a parser for error reporting in case it fails.+(<?>) :: Monoid s => Parser t s r -> String -> Parser t s r+Failure{} <?> msg = Failure msg+p@Result{} <?> _ = p+p@ResultPart{} <?> _ = p+p <?> msg = apply (<?> msg) p+ -- | Usage of 'fmap' destroys the incrementality of parsing results, if you need it use 'mapIncremental' instead.-instance Monoid s => Functor (Parser a s) where-   fmap f (Result t r) = Result t (f r)+instance Monoid s => Functor (Parser t s) where+   fmap f (Result s r) = Result s (f r)    fmap g (ResultPart r e f) = ResultPart id (fmap g $ prepend r $ feedEof e) (fmap g . prepend r . f)    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 a s) where+instance Monoid s => Applicative (Parser t s) where    pure = Result mempty-   (<*>) = ap-   (*>) = (>>)+   Result s r <*> p = r <$> feed s p+   p1 <*> p2 = apply (<*> p2) p1 -   Result t r <* p = feed t p *> pure r+   Result s _ *> p = feed s p+   ResultPart _ e f *> p | isInfallible p = ResultPart id (e *> p) ((*> p) . f)+                         | otherwise = Delay (e *> p) ((*> p) . f)+   p1 *> p2 = apply (*> p2) p1++   Result s r <* p = feed s p *> pure r    ResultPart r e f <* p | isInfallible p = ResultPart r (e <* p) ((<* p) . f)    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 a s) where-   return = Result mempty--   Result t r >>= f = feed t (f r)+instance Monoid s => Monad (Parser t s) where+   return = pure+   Result s r >>= f = feed s (f r)    p >>= f = apply (>>= f) p--   Result t _ >> p = feed t p-   ResultPart _ e f >> p | isInfallible p = ResultPart id (e >> p) ((>> p) . f)-                         | otherwise = Delay (e >> p) ((>> p) . f)-   p1 >> p2 = apply (>> p2) p1+   (>>) = (*>) -instance Monoid s => MonoidApplicative (Parser a s) where+instance Monoid s => MonoidApplicative (Parser t s) where+   -- | The '+<*>' operator is specialized to return incremental parsing results.+   Result s r +<*> p = resultPart r (feed s p)+   p1 +<*> p2 = apply (+<*> p2) p1    -- | Join operator on two parsers of the same type, preserving the incremental results.-   _ >< Failure = Failure+   _ >< p@Failure{} = p    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 :: (Monoid s, Monoid r) => Parser t s r -> Parser t s r -> Parser t s r+appendIncremental (Result s r) p = resultPart (mappend r) (feed s p) appendIncremental (ResultPart r e f) p2 = ResultPart r (appendIncremental e p2) (flip appendIncremental p2 . f) 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 :: (Monoid s, Monoid r) => Parser t s r -> Parser t s r -> Parser t s r+append (Result s r) p2 = prepend (mappend r) (feed s p2) append p1 p2 = apply (`append` p2) p1  -- | Two parsers can be sequentially joined.-instance (Monoid s, Monoid r) => Monoid (Parser a s r) where+instance (Monoid s, Monoid r) => Monoid (Parser t s r) where    mempty = return mempty    mappend = (><) -instance (Alternative (Parser a s), Monoid s) => MonoidAlternative (Parser a s) where+instance (Alternative (Parser t s), Monoid s) => MonoidAlternative (Parser t 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 :: (Alternative (Parser t s), Monoid s, Monoid r) => Parser t s r -> (Parser t s r, Parser t s r) manies p = (many, some)-   where many = some <|> mempty+   where many = resultPart id (some <|> mempty)          some = appendIncremental p many  infixl 3 <||> infixl 3 <<|> -(<||>) :: Parser a s r -> Parser a s r -> Parser a s r+(<||>) :: Parser t s r -> Parser t s r -> Parser t s r Delay e1 f1 <||> Delay e2 f2 = Delay (e1 <||> e2) (\s-> f1 s <||> f2 s)-Failure <||> p = p-p <||> Failure = p+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)@@ -186,20 +199,32 @@ 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+(<<|>) :: Monoid s => Parser t s r -> Parser t s r -> Parser t s r+Failure{} <<|> p = p p <<|> _ | isInfallible p = p-p <<|> Failure = p+p <<|> Failure{} = p p1 <<|> p2 = if isInfallible p2 then ResultPart id e f else Delay e f    where e = feedEof p1 <<|> feedEof p2          f s = feed s p1 <<|> feed s p2 --- instance (Monoid s, Monoid r, Show s, Show r) => Show (Parser a s r) where+defaultMany :: (Monoid s, Alternative (Parser t s)) => Parser t s r -> Parser t s [r]+defaultMany = fst . defaultManySome++defaultSome :: (Monoid s, Alternative (Parser t s)) => Parser t s r -> Parser t s [r]+defaultSome = snd . defaultManySome++defaultManySome :: (Monoid s, Alternative (Parser t s)) => Parser t s r -> (Parser t s [r], Parser t s [r])+defaultManySome p = (many, some)+   where many = resultPart id (some <|> pure [])+         some = (:) <$> p +<*> many+{-# INLINE defaultManySome #-}++-- instance (Monoid s, Monoid r, Show s, Show r) => Show (Parser t s r) where --    show = showWith (show . ($ mempty)) show -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 :: (Monoid s, Monoid r, Show s) => ((s -> Parser t s r) -> String) -> (r -> String) -> Parser t s r -> String+showWith _ _ (Failure s) = "Failure " ++ show s+showWith _ sr (Result s r) = "(Result " ++ shows s (" " ++ sr r ++ ")") showWith sm sr (ResultPart r e f) =    "(ResultPart (mappend " ++ sr (r mempty) ++ ") " ++ showWith sm sr e ++ " " ++ sm f ++ ")" showWith sm sr (Choice p1 p2) = "(Choice " ++ showWith sm sr p1 ++ " " ++ showWith sm sr p2 ++ ")"@@ -207,112 +232,113 @@  -- | Like 'fmap', but capable of mapping partial results, being restricted to 'Monoid' types only. 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 (Result s r) = Result s (f r) mapIncremental g (ResultPart r e f) =     ResultPart (mappend $ g $ r mempty) (mapIncremental g e) (mapIncremental g . f) mapIncremental f p = apply (mapIncremental f) p  -- | Behaves like the argument parser, but without consuming any input.-lookAhead :: Monoid s => Parser a s r -> Parser a s r+lookAhead :: Monoid s => Parser t s r -> Parser t s r lookAhead p = lookAheadInto mempty p-   where lookAheadInto :: Monoid s => s -> Parser a s r -> Parser a s r-         lookAheadInto _ Failure            = Failure+   where lookAheadInto :: Monoid s => s -> Parser t s r -> Parser t s r+         lookAheadInto _ p@Failure{}        = p          lookAheadInto t (Result _ r)       = Result t r          lookAheadInto t (ResultPart r e f) = ResultPart r (lookAheadInto t e) (\s-> lookAheadInto (mappend t s) (f s))          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))  -- | 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 :: (Monoid s, Monoid r) => Parser t s r' -> Parser t 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+   where lookAheadNotInto :: (Monoid s, Monoid r) => s -> Parser t s r' -> Parser t 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+         lookAheadNotInto t p | isInfallible p = Failure "notFollowedBy"                               | otherwise = Delay (lookAheadNotInto t $ feedEof p)                                                    (\s-> lookAheadNotInto (mappend t s) (feed s p))  -- | Provides a partial parsing result.-resultPart :: Monoid s => (r -> r) -> Parser a s r -> Parser a s r-resultPart _ Failure = error "Internal contradiction"-resultPart f (Result t r) = Result t (f r)+resultPart :: Monoid s => (r -> r) -> Parser t s r -> Parser t s r+resultPart _ Failure{} = error "Internal contradiction"+resultPart f (Result s r) = Result s (f r) resultPart r1 (ResultPart r2 e f) = ResultPart (r1 . r2) e f resultPart r p = ResultPart r (feedEof p) (flip feed p) -isInfallible :: Parser a s r -> Bool+isInfallible :: Parser t s r -> Bool isInfallible Result{} = True isInfallible ResultPart{} = True isInfallible (Choice p _) = isInfallible p isInfallible _ = False -prepend :: (r -> r) -> Parser a s r -> Parser a s r-prepend _ Failure = Failure-prepend r1 (Result t r2) = Result t (r1 r2)+prepend :: (r -> r) -> Parser t s r -> Parser t s r+prepend _ p@Failure{} = p+prepend r1 (Result s r2) = Result s (r1 r2) prepend r1 (ResultPart r2 e f) = ResultPart (r1 . r2) e f prepend r (Choice p1 p2) = Choice (prepend r p1) (prepend r p2) prepend r (Delay e f) = Delay (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 :: Monoid s => (Parser t s r -> Parser t s r') -> Parser t s r -> Parser t s r'+apply _ (Failure s) = Failure s apply f (Choice p1 p2) = f p1 <||> f p2 apply g (Delay e f) = Delay (g e) (g . f)+apply g (ResultPart r e f) = Delay (g $ prepend r e) (g . prepend r . f) apply f p = Delay (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 :: (Parser t s r -> Parser b s r) -> Parser t s r -> Parser b s r+mapType _ (Failure s) = Failure s mapType _ (Result s r) = Result s r mapType g (ResultPart r e f) = ResultPart r (g e) (g . f) 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+more :: (s -> Parser t s r) -> Parser t s r+more = Delay (Failure "more")  -- | A parser that fails on any input and succeeds at its end.-eof :: (MonoidNull s, Monoid r) => Parser a s r-eof = Delay mempty (\s-> if null s then eof else Failure)+eof :: (MonoidNull s, Monoid r) => Parser t s r+eof = Delay mempty (\s-> if null s then eof else Failure "eof")  -- | A parser that accepts any single input atom.-anyToken :: FactorialMonoid s => Parser a s s+anyToken :: FactorialMonoid s => Parser t 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 a s s+token :: (Eq s, FactorialMonoid s) => s -> Parser t 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 a s s+satisfy :: FactorialMonoid s => (s -> Bool) -> Parser t s s satisfy predicate = p    where p = more f          f s = case splitPrimePrefix s-               of Just (first, rest) -> if predicate first then Result rest first else Failure+               of Just (first, rest) -> if predicate first then Result rest first else Failure "satisfy"                   Nothing -> p  -- | Specialization of 'satisfy' on 'TextualMonoid' inputs, accepting an input character only if it satisfies the given -- predicate.-satisfyChar :: TextualMonoid s => (Char -> Bool) -> Parser a s s+satisfyChar :: TextualMonoid s => (Char -> Bool) -> Parser t s s satisfyChar predicate = p    where p = more f          f s = case splitPrimePrefix s                of Just (first, rest) -> case Textual.characterPrefix first-                                        of Just c -> if predicate c then Result rest first else Failure-                                           Nothing -> if null rest then p else Failure+                                        of Just c -> if predicate c then Result rest first else Failure "satisfyChar"+                                           Nothing -> if null rest then p else Failure "satisfyChar"                   Nothing -> p  -- | A parser that consumes and returns the given prefix of the input.-string :: (LeftReductiveMonoid s, MonoidNull s) => s -> Parser a s s+string :: (LeftReductiveMonoid s, MonoidNull s) => s -> Parser t s s string x | null x = mempty string x = more (\y-> case (stripPrefix x y, stripPrefix y x)                       of (Just y', _) -> Result y' x-                         (Nothing, Nothing) -> Failure+                         (Nothing, Nothing) -> Failure "string"                          (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 -- 'concatMany . satisfy'.-takeWhile :: (FactorialMonoid s, MonoidNull s) => (s -> Bool) -> Parser a s s+takeWhile :: (FactorialMonoid s, MonoidNull s) => (s -> Bool) -> Parser t s s takeWhile pred = while    where while = ResultPart id (return mempty) f          f s = let (prefix, suffix) = span pred s@@ -321,17 +347,17 @@  -- | A parser accepting the longest non-empty sequence of input atoms that match the given predicate; an optimized -- version of 'concatSome . satisfy'.-takeWhile1 :: (FactorialMonoid s, MonoidNull s) => (s -> Bool) -> Parser a s s+takeWhile1 :: (FactorialMonoid s, MonoidNull s) => (s -> Bool) -> Parser t s s takeWhile1 pred = more f    where f s | null s = takeWhile1 pred              | otherwise = let (prefix, suffix) = span pred s-                           in if null prefix then Failure+                           in if null prefix then Failure "takeWhile1"                               else if null suffix then resultPart (mappend prefix) (takeWhile pred)                                    else Result suffix prefix  -- | Specialization of 'takeWhile' on 'TextualMonoid' inputs, accepting the longest sequence of input characters that -- match the given predicate; an optimized version of 'concatMany . satisfyChar'.-takeCharsWhile :: (TextualMonoid s, MonoidNull s) => (Char -> Bool) -> Parser a s s+takeCharsWhile :: (TextualMonoid s, MonoidNull s) => (Char -> Bool) -> Parser t s s takeCharsWhile pred = while    where while = ResultPart id (return mempty) f          f s = let (prefix, suffix) = Textual.span (const False) pred s@@ -342,13 +368,13 @@  -- | Specialization of 'takeWhile1' on 'TextualMonoid' inputs, accepting the longest non-empty sequence of input atoms -- that match the given predicate; an optimized version of 'concatSome . satisfyChar'.-takeCharsWhile1 :: (TextualMonoid s, MonoidNull s) => (Char -> Bool) -> Parser a s s+takeCharsWhile1 :: (TextualMonoid s, MonoidNull s) => (Char -> Bool) -> Parser t s s takeCharsWhile1 pred = more f    where f s | null s = takeCharsWhile1 pred              | otherwise = let (prefix, suffix) = Textual.span (const False) pred s                                (prefix', suffix') = Textual.span (const True) (const False) suffix                            in if null prefix-                              then if null prefix' then Failure+                              then if null prefix' then Failure "takeCharsWhile1"                                    else prepend (mappend prefix') (f suffix')                               else if null suffix then resultPart (mappend prefix) (takeCharsWhile pred)                                    else if null prefix' then Result suffix prefix@@ -356,28 +382,29 @@                                                         (feed suffix' $ takeCharsWhile pred)  -- | Accepts the given number of occurrences of the argument parser.-count :: (Monoid s, Monoid r) => Int -> Parser a s r -> Parser a s r+count :: (Monoid s, Monoid r) => Int -> Parser t s r -> Parser t s r count n p | n > 0 = p >< count (pred n) p           | otherwise = mempty  -- | Discards the results of the argument parser.-skip :: (Monoid s, Monoid r) => Parser a s r' -> Parser a s r+skip :: (Monoid s, Monoid r) => Parser t s r' -> Parser t s r skip p = p *> mempty  -- | Repeats matching the first argument until the second one succeeds.-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 <|> mappend next t+manyTill :: (Monoid s, Monoid r) => Parser t s r -> Parser t s r' -> Parser t s r+manyTill next end = if isInfallible next then t1 else t2+   where t1 = skip end <<|> appendIncremental next t1+         t2 = skip end <<|> append next t2  -- | A parser that accepts all input.-acceptAll :: Monoid s => Parser a s s+acceptAll :: Monoid s => Parser t s s acceptAll = ResultPart id mempty f    where f s = ResultPart (mappend s) mempty f  -- | Parallel parser conjunction: the combined parser keeps accepting input as long as both arguments do.-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+and :: (Monoid s, Monoid r1, Monoid r2) => Parser t s r1 -> Parser t s r2 -> Parser t s (r1, r2)+Failure s `and` _ = Failure s+_ `and` Failure s = Failure s p `and` Result _ r = fmap (\x-> (x, r)) (feedEof p) Result _ r `and` p = fmap (\x-> (r, x)) (feedEof p) ResultPart r e f `and` p | isInfallible p =@@ -389,7 +416,7 @@ p1 `and` p2 = Delay (feedEof p1 `and` feedEof p2) (\s-> feed s p1 `and` feed s p2)  -- | 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))+andThen :: (Monoid s, Monoid r1, Monoid r2) => Parser t s r1 -> Parser t s r2 -> Parser t s (r1, r2)+Result s r `andThen` p | isInfallible p = resultPart (mappend (r, mempty)) (feed s (mapIncremental ((,) mempty) p)) ResultPart r e f `andThen` p | isInfallible p = ResultPart (\(r1, r2)-> (r r1, r2)) (e `andThen` p) ((`andThen` p) . f) p1 `andThen` p2 = apply (`andThen` p2) p1

@@ -1,5 +1,5 @@ {- -    Copyright 2010-2011 Mario Blazevic+    Copyright 2010-2015 Mario Blazevic      This file is part of the Streaming Component Combinators (SCC) project. @@ -30,7 +30,7 @@ ) where -import Control.Applicative (Alternative (empty, (<|>)))+import Control.Applicative (Alternative (empty, (<|>), many, some)) import Control.Monad (MonadPlus (mzero, mplus)) import Data.Monoid (Monoid) @@ -46,6 +46,8 @@ instance Monoid s => Alternative (Incremental.Parser LeftBiasedLocal s) where    empty = failure    p1 <|> p2 = p1 <<|> p2+   many = defaultMany+   some = defaultSome  -- | The 'MonadPlus' instances are the same as the 'Alternative' instances. instance Monoid s => MonadPlus (Incremental.Parser LeftBiasedLocal s) where

@@ -1,5 +1,5 @@ {- -    Copyright 2010-2011 Mario Blazevic+    Copyright 2010-2015 Mario Blazevic      This file is part of the Streaming Component Combinators (SCC) project. @@ -30,7 +30,7 @@ ) where -import Control.Applicative (Alternative (empty, (<|>)))+import Control.Applicative (Alternative (empty, (<|>)), many, some) import Control.Monad (MonadPlus (mzero, mplus)) import Data.Monoid (Monoid) @@ -46,6 +46,8 @@ instance Monoid s => Alternative (Incremental.Parser Symmetric s) where    empty = failure    p1 <|> p2 = p1 <||> p2+   many = defaultMany+   some = defaultSome  -- | The 'MonadPlus' instances are the same as the 'Alternative' instances. instance Monoid s => MonadPlus (Incremental.Parser Symmetric s) where

@@ -1,5 +1,5 @@ Name:                incremental-parser-Version:             0.2.3.4+Version:             0.2.4 Cabal-Version:       >= 1.10 Build-Type:          Simple Synopsis:            Generic parser library capable of providing partial results from partial input.@@ -26,7 +26,6 @@                      Text.ParserCombinators.Incremental.LeftBiasedLocal, Text.ParserCombinators.Incremental.Symmetric,                      Control.Applicative.Monoid   Build-Depends:     base < 5, monoid-subclasses < 0.5-  GHC-prof-options:  -auto-all   if impl(ghc >= 7.0.0)      default-language: Haskell2010 @@ -41,3 +40,11 @@                      Text.ParserCombinators.Incremental.LeftBiasedLocal, Text.ParserCombinators.Incremental.Symmetric,                      Control.Applicative.Monoid   default-language:  Haskell2010++benchmark CSV+  type: exitcode-stdio-1.0+  hs-source-dirs: Benchmarks+  ghc-options: -O2 -Wall -rtsopts+  main-is: CSV.hs+  Build-Depends:     base < 5, monoid-subclasses < 0.5, incremental-parser,+                     bytestring >= 0.10.4.0, criterion >= 1.0, deepseq >= 1.1, text >= 1.1.1.0