scc 0.7 → 0.7.1
raw patch · 5 files changed
+63/−58 lines, 5 filesdep ~incremental-parser
Dependency ranges changed: incremental-parser
Files
- Control/Concurrent/SCC/Combinators.hs +6/−4
- Control/Concurrent/SCC/Streams.hs +13/−13
- Control/Concurrent/SCC/XML.hs +27/−25
- Makefile +12/−11
- scc.cabal +5/−5
Control/Concurrent/SCC/Combinators.hs view
@@ -807,18 +807,20 @@ (transduce t source) (\source-> let true' = mapSink fromContent true false' = mapSink fromContent false- topLevel = pourUntil isMarkup source false'+ topLevel = pourWhile isContent source false'+ >> get source >>= maybe (return ()) (\x-> handleMarkup x >> topLevel) handleMarkup (Markup p@Point{}) = put edge p >> return True handleMarkup (Markup s@Start{}) = put edge s >> handleRegion >> return True handleMarkup (Markup e@End{}) = put edge e >> return False- handleRegion = pourUntil isMarkup source true'+ handleRegion = pourWhile isContent source true'+ >> get source >>= maybe (return ()) (\x -> handleMarkup x >>= flip when handleRegion) in topLevel) >> return ()- where isMarkup Markup{} = True- isMarkup Content{} = False+ where isContent Markup{} = False+ isContent Content{} = True fromContent (Content x) = x splittersToPairMarker :: forall m x b1 b2. Monad m => PairBinder m -> Splitter m x b1 -> Splitter m x b2 ->
Control/Concurrent/SCC/Streams.hs view
@@ -115,8 +115,8 @@ -- keep being called until it returns @False@ or the current chunk gets completely consumed. If the current chunk is -- empty on call, a new one is obtained from the source. The intervening 'Coroutine' computations suspend all the way -- to the 'pipe' function invocation that created the source.- foldChunk :: forall d y. (AncestorFunctor a d, MonoidNull y) => - Parser [x] y -> Coroutine d m (y, Maybe (Parser [x] y))+ foldChunk :: forall d p y. (AncestorFunctor a d, MonoidNull y) => + Parser p [x] y -> Coroutine d m (y, Maybe (Parser p [x] y)) } -- | A disconnected sink that ignores all values 'put' into it.@@ -134,8 +134,8 @@ -- | Converts a 'Source' on the ancestor functor /a/ into a source on the descendant functor /d/. liftSource :: forall m a d x. (Monad m, AncestorFunctor a d) => Source m a x -> Source m d x liftSource s = Source {foldChunk= liftAncestor . (foldChunk s - :: forall y. MonoidNull y => - Parser [x] y -> Coroutine d m (y, Maybe (Parser [x] y)))}+ :: forall p y. MonoidNull y => + Parser p [x] y -> Coroutine d m (y, Maybe (Parser p [x] y)))} -- | The 'pipe' function splits the computation into two concurrent parts, /producer/ and /consumer/. The /producer/ is -- given a 'Sink' to put values into, and /consumer/ a 'Source' to get those values from. Once producer and consumer@@ -160,9 +160,9 @@ where sink = Sink {putChunk= \xs-> if null xs then return [] else (liftAncestor (mapSuspension RightF (request xs) :: Coroutine a1 m [x]))} source = Source {foldChunk= fc}- fc :: forall d y. (AncestorFunctor a2 d, MonoidNull y) => - Parser [x] y -> Coroutine d m (y, Maybe (Parser [x] y))- fc t = liftAncestor (mapSuspension RightF (requestParse t) :: Coroutine a2 m (y, Maybe (Parser [x] y)))+ fc :: forall d p y. (AncestorFunctor a2 d, MonoidNull y) => + Parser p [x] y -> Coroutine d m (y, Maybe (Parser p [x] y))+ fc t = liftAncestor (mapSuspension RightF (requestParse t) :: Coroutine a2 m (y, Maybe (Parser p [x] y))) -- | Function 'get' tries to get a value from the given 'Source' argument. The intervening 'Coroutine' computations -- suspend all the way to the 'pipe' function invocation that created the source. The function returns 'Nothing' if@@ -188,7 +188,7 @@ getWith consumer source = get source >>= maybe (return ()) consumer -- | Consumes values from the /source/ as long as the /parser/ accepts them.-getTicked :: forall m a d x. (Monad m, AncestorFunctor a d) => Parser [x] [x] -> Source m a x -> Coroutine d m [x]+getTicked :: forall m p a d x. (Monad m, AncestorFunctor a d) => Parser p [x] [x] -> Source m a x -> Coroutine d m [x] getTicked parser source = loop return parser where loop cont p = foldChunk source p >>= proceed cont proceed cont (chunk, Nothing) = cont chunk@@ -204,7 +204,7 @@ getUntil :: forall m a d x. (Monad m, AncestorFunctor a d) => (x -> Bool) -> Source m a x -> Coroutine d m ([x], Maybe x) getUntil f source = loop id- where loop cont = foldChunk source (takeWhile (not . f . head) + where loop cont = foldChunk source (takeWhile (not . f . head) `andThen` lookAhead (fmap (First . Just . head) anyToken <<|> return (First Nothing))) >>= extract cont@@ -218,15 +218,15 @@ where loop = getChunk source >>= nullOrElse (return ()) ((>> loop) . putChunk sink) -- | Like 'pour', copies data from the /source/ to the /sink/, but only as long as it satisfies the predicate.-pourTicked :: forall m a1 a2 d x . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d)- => Parser [x] [x] -> Source m a1 x -> Sink m a2 x -> Coroutine d m ()+pourTicked :: forall m p a1 a2 d x . (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d)+ => Parser p [x] [x] -> Source m a1 x -> Sink m a2 x -> Coroutine d m () pourTicked parser source sink = loop parser where loop p = foldChunk source p >>= \(chunk, p')-> unless (null chunk) (putChunk sink chunk >> maybe (return ()) loop p') -- | Parses the input data using the given parser and copies the results to output.-pourParsed :: forall m a1 a2 d x y. (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d)- => Parser [x] [y] -> Source m a1 x -> Sink m a2 y -> Coroutine d m ()+pourParsed :: forall m p a1 a2 d x y. (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d)+ => Parser p [x] [y] -> Source m a1 x -> Sink m a2 y -> Coroutine d m () pourParsed parser source sink = loop parser where loop p = foldChunk source p >>= \(chunk, p')-> unless (null chunk) (putChunk sink chunk >> maybe (return ()) loop p')
Control/Concurrent/SCC/XML.hs view
@@ -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@@ -42,8 +42,10 @@ import Numeric (readDec, readHex) import Data.Functor.Contravariant.Ticker (andThen, tickOne, tickWhile)-import Text.ParserCombinators.Incremental (Parser, anyToken, satisfy, many0, takeWhile, takeWhile1, string,- option, skip, lookAhead, notFollowedBy, mapIncremental, (><), (<<|>))+import Text.ParserCombinators.Incremental (Parser, more, feed, anyToken, satisfy, concatMany, takeWhile, takeWhile1, string,+ moptional, skip, lookAhead, notFollowedBy, mapIncremental, (><))+import qualified Text.ParserCombinators.Incremental.LeftBiasedLocal as LeftBiasedLocal (Parser)+import Text.ParserCombinators.Incremental.LeftBiasedLocal (leftmost) import Control.Monad.Coroutine (Coroutine, sequentialBinder) import Control.Concurrent.SCC.Streams@@ -83,11 +85,11 @@ _ -> XMLStream (l ++ r) XMLStream l `mappend` XMLStream r = XMLStream (l ++ r) -xmlParser :: Parser String XMLStream-xmlParser = many0 (xmlContent <|> xmlMarkup)+xmlParser :: LeftBiasedLocal.Parser String XMLStream+xmlParser = concatMany (xmlContent <|> xmlMarkup) where xmlContent = mapContent $ takeWhile1 (\x-> x /= "<" && x /= "&") xmlMarkup = (string "<" >> ((startTag <|> endTag <|> processingInstruction <|> declaration)- <<|> return (XMLStream [Markup $ Point errorUnescapedContentLT,+ <|> return (XMLStream [Markup $ Point errorUnescapedContentLT, Content (singleton '<')]))) <|> entityReference "&"@@ -96,30 +98,30 @@ >< return (XMLStream [Markup (End ElementName)]) >< whiteSpace >< attributes- >< option (string "/" >> return (XMLStream [Markup (Point EmptyTag), Content (singleton '/')]))+ >< moptional (string "/" >> return (XMLStream [Markup (Point EmptyTag), Content (singleton '/')])) >< whiteSpace >< (string ">" >> return (XMLStream [Content (singleton '>'), Markup (End StartTag)])- <<|> return (XMLStream [Markup $ Point unterminatedStartTag, Markup $ End StartTag]))+ <|> return (XMLStream [Markup $ Point unterminatedStartTag, Markup $ End StartTag])) entityReference s = string s >> (return (XMLStream [Markup (Start EntityReference), Content (pack s), Markup (Start EntityName)]) >< name >< (string ";" >> return (XMLStream [Markup (End EntityName), Content (singleton ';'), Markup (End EntityReference)]))- <<|> return (XMLStream [Markup $ Point $ errorBadEntityReference, Content (pack s)]))- attributes = many0 (attribute >< whiteSpace)+ <|> return (XMLStream [Markup $ Point $ errorBadEntityReference, Content (pack s)]))+ attributes = concatMany (attribute >< whiteSpace) attribute = return (XMLStream [Markup (Start AttributeName)]) >< name >< return (XMLStream [Markup (End AttributeName)]) >< (mapContent (string "=")- <<|> (fmap (\x-> XMLStream [Markup $ Point $ errorBadAttribute x]) anyToken- >< whiteSpace >< option (mapContent $ string "=")))+ <|> (fmap (\x-> XMLStream [Markup $ Point $ errorBadAttribute x]) anyToken+ >< whiteSpace >< moptional (mapContent $ string "="))) >< ((string "\"" <|> string "\'") >>= \quote-> return (XMLStream [Content $ pack quote, Markup (Start AttributeValue)]) >< mapContent (takeWhile (/= quote)) >< return (XMLStream [Markup (End AttributeValue), Content $ pack quote]) >< skip (string quote)- <<|> (anyToken >>= \q-> return (XMLStream [Markup $ Point $ errorBadQuoteCharacter q,+ <|> (anyToken >>= \q-> return (XMLStream [Markup $ Point $ errorBadQuoteCharacter q, Content $ pack quote]))) endTag = (string "/" >> return (XMLStream [Markup (Start EndTag), Content (pack "</"), Markup (Start ElementName)]))@@ -127,7 +129,7 @@ >< return (XMLStream [Markup (End ElementName)]) >< whiteSpace >< (string ">" >> return (XMLStream [Content (singleton '>'), Markup (End EndTag)])- <<|> return (XMLStream [Markup $ Point unterminatedEndTag, Markup (End EndTag)]))+ <|> return (XMLStream [Markup $ Point unterminatedEndTag, Markup (End EndTag)])) processingInstruction = (string "?" >> return (XMLStream [Markup (Start ProcessingInstruction), Content (pack "<?"), Markup (Start ProcessingInstructionText)]))@@ -135,16 +137,16 @@ >< (string "?>" >> return (XMLStream [Markup (End ProcessingInstructionText), Content (pack "?>"), Markup (End ProcessingInstruction)])- <<|> return (XMLStream [Markup $ Point unterminatedProcessingInstruction]))+ <|> return (XMLStream [Markup $ Point unterminatedProcessingInstruction])) declaration = string "!" >> ((comment <|> cdataMarkedSection <|> doctypeDeclaration)- <<|> return (XMLStream [Markup $ Point $ errorBadDeclarationType, Content (pack "<")]))+ <|> return (XMLStream [Markup $ Point $ errorBadDeclarationType, Content (pack "<")])) comment = (string "--" >> return (XMLStream [Markup (Start Comment), Content (pack "<!--"), Markup (Start CommentText)])) >< upto "-->" >< (string "-->" >> return (XMLStream [Markup (End CommentText), Content (pack "-->"), Markup (End Comment)])- <<|> return (XMLStream [Markup $ Point unterminatedComment]))+ <|> return (XMLStream [Markup $ Point unterminatedComment])) cdataMarkedSection = (string "[CDATA[" >> return (XMLStream [Markup (Start StartMarkedSectionCDATA), Content (pack "<![CDATA["), Markup (End StartMarkedSectionCDATA)]))@@ -152,22 +154,22 @@ >< (string "]]>" >> return (XMLStream [Markup (Start EndMarkedSection), Content (pack "]]>"), Markup (End EndMarkedSection)])- <<|> return (XMLStream [Markup $ Point unterminatedMarkedSection]))+ <|> return (XMLStream [Markup $ Point unterminatedMarkedSection])) doctypeDeclaration = (string "DOCTYPE" >> return (XMLStream [Markup (Start DoctypeDeclaration), Content (pack "<!DOCTYPE")])) >< whiteSpace >< (name >< whiteSpace- >< option ((mapContent (string "SYSTEM")+ >< moptional ((mapContent (string "SYSTEM") <|> mapContent (string "PUBLIC") >< whiteSpace >< literal) >< whiteSpace >< literal >< whiteSpace)- >< option (mapContent (string "[") >< whiteSpace- >< many0 ((markupDeclaration <|> comment <|> processingInstruction+ >< moptional (mapContent (string "[") >< whiteSpace+ >< concatMany ((markupDeclaration <|> comment <|> processingInstruction <|> entityReference "%") >< whiteSpace) >< mapContent (string "]") >< whiteSpace) >< mapContent (string ">")- <<|> return (XMLStream [Markup (Point errorMalformedDoctypeDeclaration)]))+ <|> return (XMLStream [Markup (Point errorMalformedDoctypeDeclaration)])) >< return (XMLStream [Markup (End DoctypeDeclaration)]) literal = (string "\"" <|> string "\'") >>= \quote-> return (XMLStream [Content $ pack quote])@@ -175,13 +177,13 @@ >< return (XMLStream [Content $ pack quote]) >< skip (string quote) markupDeclaration= mapContent (string "<!")- >< (many0 (mapContent (takeWhile1 (\x-> x /= ">" && x /= "\"" && x /= "\'")) <|> literal)+ >< (concatMany (mapContent (takeWhile1 (\x-> x /= ">" && x /= "\"" && x /= "\'")) <|> literal) >< mapContent (string ">")- <<|> return (XMLStream [Markup $ Point unterminatedMarkupDeclaration]))+ <|> return (XMLStream [Markup $ Point unterminatedMarkupDeclaration])) name = mapContent (takeWhile1 (isNameChar . head)) mapContent = mapIncremental (XMLStream . (:[]) . Content . pack) whiteSpace = mapContent (takeWhile (isSpace . head))- upto end@(lead:_) = mapContent (many0 (takeWhile1 (/= [lead]) <<|> notFollowedBy (string end) >< anyToken))+ upto end@(lead:_) = mapContent (concatMany (takeWhile1 (/= [lead]) <|> notFollowedBy (string end) >< anyToken)) errorBadQuoteCharacter q = ErrorToken ("Invalid quote character " ++ show q) errorBadAttribute x = ErrorToken ("Invalid character " ++ show x ++ " following attribute name")
Makefile view
@@ -2,6 +2,7 @@ TestExecutables=$(addprefix test/, scc parallel benchmark-coroutine incremental-parser \ enumerator iteratee enumerator-scc) IterativeParserFiles=Text/ParserCombinators/Incremental.hs \+ Control/Applicative/Monoid.hs \ $(addprefix Data/Monoid/, Cancellative.hs Factorial.hs Null.hs) CoroutineLibraryFiles=$(IterativeParserFiles) Data/Functor/Contravariant/Ticker.hs \ $(addprefix Control/Monad/, \@@ -17,34 +18,34 @@ DocumentationFiles=$(SCCCommonFiles) Control/Monad/Coroutine/Enumerator.hs Control/Monad/Coroutine/Iteratee.hs \ Control/Concurrent/SCC/Combinators/Parallel.hs Control/Concurrent/SCC/Combinators/Sequential.hs \ Control/Concurrent/SCC/Parallel.hs Control/Concurrent/SCC/Sequential.hs-OptimizingOptions=-O -threaded -hidir obj -odir obj-ProfilingOptions=-prof -auto-all -hidir prof -odir prof+OptimizingOptions=-O -threaded -fcontext-stack=30 -rtsopts -hidir obj -odir obj+ProfilingOptions=-prof -auto-all -rtsopts -hidir prof -odir prof all: $(Executables) doc/index.html docs: doc/index.html -test/scc: Test/TestSCC.hs $(AllLibraryFiles) | obj+test/scc: Test/TestSCC.hs $(AllLibraryFiles) | obj test ghc --make $< -o $@ $(OptimizingOptions) -test/benchmark-coroutine: Test/BenchmarkCoroutine.hs $(CoroutineLibraryFiles) | obj+test/benchmark-coroutine: Test/BenchmarkCoroutine.hs $(CoroutineLibraryFiles) | obj test ghc --make $< -o $@ $(OptimizingOptions) -eventlog -test/incremental-parser: Test/TestIncrementalParser.hs Text/ParserCombinators/Incremental.hs | obj+test/incremental-parser: Test/TestIncrementalParser.hs Text/ParserCombinators/Incremental.hs | obj test ghc --make $< -o $@ $(OptimizingOptions) -eventlog -test/enumerator: Test/TestEnumerator.hs $(CoroutineLibraryFiles) Control/Monad/Coroutine/Enumerator.hs | obj+test/enumerator: Test/TestEnumerator.hs $(CoroutineLibraryFiles) Control/Monad/Coroutine/Enumerator.hs | obj test ghc --make $< -o $@ $(OptimizingOptions) -eventlog -test/iteratee: Test/TestIteratee.hs $(CoroutineLibraryFiles) Control/Monad/Coroutine/Iteratee.hs | obj+test/iteratee: Test/TestIteratee.hs $(CoroutineLibraryFiles) Control/Monad/Coroutine/Iteratee.hs | obj test ghc --make $< -o $@ $(OptimizingOptions) -eventlog test/enumerator-scc: Test/TestEnumeratorSCC.hs $(SCCCommonFiles) \ Control/Monad/Coroutine/Enumerator.hs \- Control/Concurrent/SCC/Combinators/Sequential.hs Control/Concurrent/SCC/Sequential.hs | obj+ Control/Concurrent/SCC/Combinators/Sequential.hs Control/Concurrent/SCC/Sequential.hs | obj test ghc --make $< -o $@ $(OptimizingOptions) -eventlog -test/parallel: Test/TestParallel.hs Control/Monad/Parallel.hs | obj+test/parallel: Test/TestParallel.hs Control/Monad/Parallel.hs | obj test ghc --make $< -o $@ $(OptimizingOptions) -eventlog shsh: Shell.hs $(AllLibraryFiles) | obj@@ -53,7 +54,7 @@ shsh-prof: Shell.hs $(AllLibraryFiles) | prof ghc --make $< -o $@ $(ProfilingOptions) -doc/index.html: $(DocumentationFiles)+doc/index.html: $(DocumentationFiles) | doc haddock -hU -o doc \ -i http://www.haskell.org/ghc/docs/latest/html/libraries/base,base.haddock \ -i $(lastword $(wildcard ~/.cabal/share/doc/enumerator-*/html/)),$(lastword $(wildcard ~/.cabal/share/doc/enumerator-*/html/enumerator.haddock)) \@@ -62,7 +63,7 @@ -i $(lastword $(wildcard ~/.cabal/share/doc/text-*/html/)),$(lastword $(wildcard ~/.cabal/share/doc/text-*/html/text.haddock)) \ $^ -obj prof:+obj prof test doc: mkdir -p $@ clean:
scc.cabal view
@@ -1,5 +1,5 @@ Name: scc-Version: 0.7+Version: 0.7.1 Cabal-Version: >= 1.2 Build-Type: Simple Synopsis: Streaming component combinators@@ -34,7 +34,7 @@ Other-Modules: Control.Concurrent.SCC.Streams, Control.Concurrent.SCC.Types, Control.Concurrent.SCC.Coercions, Control.Concurrent.SCC.Combinators, Control.Concurrent.SCC.Primitives, Control.Concurrent.SCC.XML, Control.Concurrent.Configuration, Control.Concurrent.SCC.Configurable- Build-Depends: base < 5, containers, transformers >= 0.2 && < 0.3, incremental-parser >= 0.1 && < 0.2,+ Build-Depends: base < 5, containers, transformers >= 0.2 && < 0.3, incremental-parser >= 0.2 && < 0.3, monad-parallel, monad-coroutine >= 0.7 && < 0.8, bytestring < 1.0, text < 1.0, process, readline, parsec >= 3.0 && < 4.0 GHC-options: -threaded@@ -45,10 +45,10 @@ Control.Concurrent.SCC.Combinators, Control.Concurrent.SCC.Primitives, Control.Concurrent.SCC.XML, Control.Concurrent.Configuration, Control.Concurrent.SCC.Configurable- Build-Depends: base < 5, containers, transformers >= 0.2 && < 0.3, incremental-parser < 0.2,+ Build-Depends: base < 5, containers, transformers >= 0.2 && < 0.3, incremental-parser >= 0.2 && < 0.3, monad-parallel, monad-coroutine >= 0.7 && < 0.8, bytestring < 1.0, text < 1.0, QuickCheck >= 2 && < 3- GHC-options: -threaded+ GHC-options: -threaded -fcontext-stack=30 if !flag(test) buildable: False @@ -59,6 +59,6 @@ Control.Concurrent.SCC.Combinators.Parallel, Control.Concurrent.SCC.Combinators.Sequential, Control.Concurrent.SCC.Combinators, Control.Concurrent.SCC.Primitives, Control.Concurrent.SCC.XML - Build-Depends: base < 5, containers, transformers >= 0.2 && < 0.3, incremental-parser >= 0.1 && < 0.2,+ Build-Depends: base < 5, containers, transformers >= 0.2 && < 0.3, incremental-parser >= 0.2 && < 0.3, monad-parallel, monad-coroutine >= 0.7 && < 0.8, bytestring < 1.0, text < 1.0 GHC-prof-options: -auto-all