diff --git a/Control/Concurrent/SCC/Combinators.hs b/Control/Concurrent/SCC/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/SCC/Combinators.hs
@@ -0,0 +1,665 @@
+{-
+ Copyright 2008 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
+ .
+-}
+
+-- | The "Combinators" module defines combinators applicable to 'Transducer' and 'Splitter' components defined in the
+-- "ComponentTypes" module.
+
+{-# LANGUAGE ScopedTypeVariables, Rank2Types #-}
+
+module Control.Concurrent.SCC.Combinators
+ (-- * Consumer and producer combinators
+ (->>), (<<-),
+ -- * Transducer combinators
+ (>->), join,
+ -- * Pseudo-logic splitter combinators
+ -- | Combinators '>&' and '>|' are only /pseudo/-logic. While the laws of double negation and De Morgan's laws hold,
+ -- '>&' and '>|' are in general not commutative, associative, nor idempotent. In the special case when all argument
+ -- splitters are stateless, such as those produced by 'Components.liftStatelessSplitter', these combinators do satisfy
+ -- all laws of Boolean algebra.
+ snot, (>&), (>|),
+ -- ** Zipping logic combinators
+ -- | The '&&' and '||' combinators run the argument splitters in parallel and combine their logical outputs using
+ -- the corresponding logical operation on each output pair, in a manner similar to 'Prelude.zipWith'.
+ (&&), (||),
+ -- * Flow-control combinators
+ -- | The following combinators resemble the common flow-control programming language constructs. Combinators
+ -- 'wherever', 'unless', and 'select' are just the special cases of the combinator 'ifs'.
+ --
+ -- * /transducer/ ``wherever`` /splitter/ = 'ifs' /splitter/ /transducer/ 'Components.asis'
+ --
+ -- * /transducer/ ``unless`` /splitter/ = 'ifs' /splitter/ 'Components.asis' /transducer/
+ --
+ -- * 'select' /splitter/ = 'ifs' /splitter/ 'Components.asis' 'Components.suppress'
+ --
+ ifs, wherever, unless, select,
+ -- ** Recursive
+ while, nestedIn,
+ -- * Section-based combinators
+ -- | All combinators in this section use their 'Splitter' argument to determine the
+ -- structure of the input. Every contiguous portion of the input that gets passed to one or the other sink of the
+ -- splitter is treated as one section in the logical structure of the input stream. What is done with the section
+ -- depends on the combinator, but the sections, and therefore the logical structure of the input stream, are
+ -- determined by the argument splitter alone.
+ foreach, having, havingOnly, followedBy, even,
+ -- ** first and its variants
+ first, uptoFirst, prefix,
+ -- ** last and its variants
+ last, lastAndAfter, suffix,
+ -- ** input ranges
+ between, (...))
+where
+
+import Control.Concurrent.SCC.Foundation
+import Control.Concurrent.SCC.ComponentTypes
+
+import Prelude hiding (even, last, (||), (&&))
+import qualified Prelude
+import Control.Exception (assert)
+import Control.Monad (liftM, when)
+import qualified Control.Monad as Monad
+import Data.Maybe (isJust, isNothing, fromJust)
+import Data.Typeable (Typeable)
+import qualified Data.Foldable as Foldable
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq, (|>), (><), ViewL (EmptyL, (:<)))
+
+import Debug.Trace (trace)
+
+
+infixr ->>
+
+-- | The result of combinator '->>' is a consumer that acts as a composition of the given transducer and consumer
+-- arguments.
+(->>) :: forall x y m r. (Monad m, Typeable x, Typeable y) => Transducer m x y -> Consumer m y r -> Consumer m x r
+Transducer t ->> consumer = consumer'
+ where consumer' source = liftM snd $ pipeD "->>" (t source) consumer
+
+-- | The result of combinator '<<-' is a producer that acts as a composition of the given transducer and producer
+-- arguments.
+(<<-) :: forall x y m r c c1. (Monad m, Typeable x, Typeable y) => Transducer m x y -> Producer m x r -> Producer m y r
+Transducer t <<- producer = producer'
+ where producer' sink = liftM fst $ pipeD "<<-" producer (flip t sink)
+
+
+-- | The '>->' combinator composes its argument transducers. The resulting composition /t1 >-> t2/ passes its input through the
+-- first transducer /t1/, the output of /t1/ is passed to the other transducer /t2/, and its output becomes the output of the
+-- composition.
+(>->) :: forall m x y z. Monad m => Transducer m x y -> Transducer m y z -> Transducer m x z
+Transducer t1 >-> Transducer t2 = Transducer t
+ where t source sink = liftM fst $ pipeD ">->" (t1 source) (flip t2 sink)
+
+-- | The 'join' combinator arranges the two transducer arguments in parallel. The input of the resulting transducer is replicated
+-- to both component transducers in parallel, and the output of the resulting transducer is a concatenation of the two component
+-- transducers' outputs.
+join :: (Monad m, Typeable x) => Transducer m x y -> Transducer m x y -> Transducer m x y
+join (Transducer t1) (Transducer t2) = Transducer t
+ where t source sink = do (((), l), extra) <- pipeD "join 1"
+ (\sink1-> pipeD "join 2" (\sink2-> tee source sink1 sink2) getList)
+ (flip t1 sink)
+ pipeD "join 3" (putList l) (flip t2 sink)
+ return extra
+-- | The 'snot' (streaming not) combinator simply reverses the outputs of the argument splitter.
+-- In other words, data that the argument splitter sends to its /true/ sink goes to the /false/ sink of the result, and vice versa.
+snot :: (Monad m, Typeable x) => Splitter m x -> Splitter m x
+snot splitter = liftSectionSplitter (\source true false-> splitSections splitter source false true)
+
+-- | The '>&' combinator sends the /true/ sink output of its left operand to the input of its right operand for further
+-- splitting. Both operands' /false/ sinks are connected to the /false/ sink of the combined splitter, but any input
+-- value to reach the /true/ sink of the combined component data must be deemed true by both splitters.
+(>&) :: (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+s1 >& s2 = liftSimpleSplitter (\source true false->
+ liftM fst $ pipeD ">&" (\true-> split s1 source true false) (\source-> split s2 source true false))
+
+-- | A '>|' combinator's input value can reach its /false/ sink only by going through both argument splitters' /false/
+-- sinks.
+(>|) :: (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+s1 >| s2 = liftSimpleSplitter (\source true false->
+ liftM fst $ pipeD ">|" (split s1 source true) (\source-> split s2 source true false))
+
+-- | Combinator '&&' is a pairwise logical conjunction of two splitters run in parallel on the same input.
+(&&) :: (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+(&&) = zipSplittersWith (Prelude.&&)
+
+-- | Combinator '||' is a pairwise logical disjunction of two splitters run in parallel on the same input.
+(||) :: (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+(||) = zipSplittersWith (Prelude.||)
+
+-- | The result of the combinator 'ifs' is a transducer that applies one argument transducer to one portion of
+-- the input and the other transducer to the other portion of input, depending on where the splitter argument routes the data.
+ifs :: (Monad m, Typeable x) => Splitter m x -> Transducer m x y -> Transducer m x y -> Transducer m x y
+ifs s (Transducer t1) (Transducer t2) = Transducer t
+ where t source sink = liftM fst3 $ splitConsumer "ifs" s (flip t1 sink) (flip t2 sink) source
+
+wherever :: (Monad m, Typeable x) => Transducer m x x -> Splitter m x -> Transducer m x x
+wherever (Transducer t) s = Transducer wherever'
+ where wherever' source sink = liftM fst3 $ splitConsumer "wherever" s (flip t sink) (flip pour sink) source
+
+unless :: (Monad m, Typeable x) => Transducer m x x -> Splitter m x -> Transducer m x x
+unless (Transducer t) s = Transducer unless'
+ where unless' source sink = liftM fst3 $ splitConsumer "unless" s (flip pour sink) (flip t sink) source
+
+select :: (Monad m, Typeable x) => Splitter m x -> Transducer m x x
+select s = Transducer (\source sink-> liftM fst3 $ splitConsumer "select" s (flip pour sink) consumeAndSuppress source)
+
+-- | The recursive combinator 'while' feeds the true sink of the argument splitter back to itself, modified by the
+-- argument transducer. Data fed to the splitter's false sink is passed on unmodified.
+while :: (Monad m, Typeable x) => Transducer m x x -> Splitter m x -> Transducer m x x
+while t s = Transducer while'
+ where while' source sink = liftM fst3 $ splitConsumer "while" s (t ->> while t s ->> flip pour sink) (flip pour sink) source
+
+-- | The recursive combinator 'nestedIn' combines two splitters into a mutually recursive loop acting as a single splitter.
+-- The true sink of one of the argument splitters and false sink of the other become the true and false sinks of the loop.
+-- The other two sinks are bound to the other splitter's source.
+-- The use of 'nestedIn' makes sense only on hierarchically structured streams. If we gave it some input containing
+-- a flat sequence of values, and assuming both component splitters are deterministic and stateless,
+-- a value would either not loop at all or it would loop forever.
+nestedIn :: (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+nestedIn s1 s2 = s
+ where s = liftSimpleSplitter (\source true false->
+ liftM fst $
+ pipe (\false-> split s1 source true false)
+ (\source-> pipe (\true-> split s2 source true false)
+ (\source-> split (nestedIn s1 s2) source true false)))
+
+-- | The 'foreach' combinator is similar to the combinator 'ifs' in that it combines a splitter and two transducers into
+-- another transducer. However, in this case the transducers are re-instantiated for each consecutive portion of the
+-- input as the splitter chunks it up. Each contiguous portion of the input that the splitter sends to one of its two
+-- sinks gets transducered through the appropriate argument transducer as that transducer's whole input. As soon as the
+-- contiguous portion is finished, the transducer gets terminated.
+foreach :: (Monad m, Typeable x, Typeable y) => Splitter m x -> Transducer m x y -> Transducer m x y -> Transducer m x y
+foreach s t1 t2 = Transducer t
+ where t source sink = liftM fst $
+ pipeD "foreach"
+ (transduce (splitterToMarker s) source)
+ (\source-> groupMarks source (\b chunk-> transduce (if b then t1 else t2) chunk sink))
+
+-- | The 'having' combinator combines two pure splitters into a pure splitter. One splitter is used to chunk the input
+-- into contiguous portions. Its /false/ sink is routed directly to the /false/ sink of the combined splitter. The
+-- second splitter is instantiated and run on each portion of the input that goes to first splitter's /true/ sink. If
+-- the second splitter sends any output at all to its /true/ sink, the whole input portion is passed on to the /true/
+-- sink of the combined splitter, otherwise it goes to its /false/ sink.
+having :: (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+having s1 s2 = liftSectionSplitter s
+ where s source true false = liftM fst $
+ pipeD "having"
+ (transduce (splitterToMarker s1) source)
+ (\source-> groupMarks source (\b chunk-> if b then test chunk else pourMaybe chunk false))
+ where test chunk = pipe (\sink1-> pipe (\sink2-> tee chunk sink1 sink2) getList)
+ (\chunk-> pipe (\sink-> suppressProducer (split s2 chunk sink)) getList)
+ >>= \(((), chunk), (_, truePart))-> let chunk' = if null chunk
+ then [Nothing]
+ else map Just chunk
+ in (if null truePart
+ then putList chunk' false
+ else putList chunk' true)
+ >> return ()
+
+-- | The 'havingOnly' combinator is analogous to the 'having' combinator, but it succeeds and passes each chunk of the
+-- input to its /true/ sink only if the second splitter sends no part of it to its /false/ sink.
+havingOnly :: (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+havingOnly s1 s2 = liftSectionSplitter s
+ where s source true false = liftM fst $
+ pipeD "havingOnly"
+ (transduce (splitterToMarker s1) source)
+ (\source-> groupMarks source (\b chunk-> if b then test chunk else pourMaybe chunk false))
+ where test chunk = pipe (\sink1-> pipe (\sink2-> tee chunk sink1 sink2) getList)
+ (\chunk-> pipe (\sink-> suppressProducer (\suppress-> split s2 chunk suppress sink))
+ getList)
+ >>= \(((), chunk), (_, falsePart))-> let chunk' = if null chunk
+ then [Nothing]
+ else map Just chunk
+ in (if null falsePart
+ then putList chunk' true
+ else putList chunk' false)
+ >> return ()
+
+-- | The result of combinator 'first' behaves the same as the argument splitter up to and including the first portion of
+-- the input which goes into the argument's /true/ sink. All input following the first true portion goes into the
+-- /false/ sink.
+first :: (Monad m, Typeable x) => Splitter m x -> Splitter m x
+first splitter = liftSectionSplitter s
+ where s source true false = liftM (\(x, y)-> y ++ x) $
+ pipeD "first" (transduce (splitterToMarker splitter) source)
+ (\source-> let get1 (x, False) = p false x get1
+ get1 (x, True) = p true x get2
+ get2 (x, True) = p true x get2
+ get2 (x, False) = p false x get3
+ get3 (x, _) = p false x get3
+ p sink x succeed = put sink x
+ >>= cond (get source >>= maybe (return []) succeed)
+ (return $ maybe [] (:[]) x)
+ in get source >>= maybe (return []) get1)
+
+-- | The result of combinator 'uptoFirst' takes all input up to and including the first portion of the input which goes
+-- into the argument's /true/ sink and feeds it to the result splitter's /true/ sink. All the rest of the input goes
+-- into the /false/ sink. The only difference between 'last' and 'lastAndAfter' combinators is in where they direct the
+-- /false/ portion of the input preceding the first /true/ part.
+uptoFirst :: (Monad m, Typeable x) => Splitter m x -> Splitter m x
+uptoFirst splitter = liftSectionSplitter s
+ where s source true false = liftM (\(x, y)-> concatMap (maybe [] (:[])) y ++ x) $
+ pipeD "uptoFirst" (transduce (splitterToMarker splitter) source)
+ (\source-> let get1 q (x, False) = let q' = q |> x
+ in get source
+ >>= maybe
+ (putQueue q' false)
+ (get1 q')
+ get1 q p@(x, True) = do rest <- putQueue q true
+ if null rest then get2 p else return rest
+ get2 (x, True) = p true x get2
+ get2 (x, False) = p false x get3
+ get3 (x, _) = p false x get3
+ p sink x succeed = put sink x
+ >>= cond (get source >>= maybe (return []) succeed)
+ (return [x])
+ in get source >>= maybe (return []) (get1 Seq.empty))
+
+-- | The result of the combinator 'last' is a splitter which directs all input to its /false/ sink, up to the last
+-- portion of the input which goes to its argument's /true/ sink. That portion of the input is the only one that goes to
+-- the resulting component's /true/ sink. The splitter returned by the combinator 'last' has to buffer the previous two
+-- portions of its input, because it cannot know if a true portion of the input is the last one until it sees the end of
+-- the input or another portion succeeding the previous one.
+last :: (Monad m, Typeable x) => Splitter m x -> Splitter m x
+last splitter = liftSectionSplitter s
+ where s source true false = liftM (\(x, y)-> concatMap (maybe [] (:[])) y ++ x) $
+ pipeD "last" (transduce (splitterToMarker splitter) source)
+ (\source-> let get1 (x, False) = put false x
+ >>= cond (get source >>= maybe (return []) get1)
+ (return [x])
+ get1 p@(x, True) = get2 Seq.empty p
+ get2 q (x, True) = let q' = q |> x
+ in get source
+ >>= maybe
+ (putQueue q' true)
+ (get2 q')
+ get2 q p@(x, False) = get3 q Seq.empty p
+ get3 qt qf (x, False) = let qf' = qf |> x
+ in get source
+ >>= maybe
+ (putQueue qt true >> putQueue qf' false)
+ (get3 qt qf')
+ get3 qt qf p@(x, True) = do rest1 <- putQueue qt false
+ rest2 <- putQueue qf false
+ if null rest1 Prelude.&& null rest2
+ then get2 Seq.empty p
+ else return (rest1 ++ rest2)
+ p succeed = get source >>= maybe (return []) succeed
+ in p get1)
+
+-- | The result of the combinator 'lastAndAfter' is a splitter which directs all input to its /false/ sink, up to the
+-- last portion of the input which goes to its argument's /true/ sink. That portion and the remainder of the input is fed
+-- to the resulting component's /true/ sink. The difference between 'last' and 'lastAndAfter' combinators is where they
+-- feed the /false/ portion of the input, if any, remaining after the last /true/ part.
+lastAndAfter :: (Monad m, Typeable x) => Splitter m x -> Splitter m x
+lastAndAfter splitter = liftSectionSplitter s
+ where s source true false = liftM (\(x, y)-> concatMap (maybe [] (:[])) y ++ x) $
+ pipeD "lastAndAfter" (transduce (splitterToMarker splitter) source)
+ (\source-> let get1 (x, False) = put false x >>= cond (p get1) (return [x])
+ get1 p@(x, True) = get2 Seq.empty p
+ get2 q (x, True) = let q' = q |> x
+ in get source
+ >>= maybe
+ (putQueue q' true)
+ (get2 q')
+ get2 q p@(x, False) = get3 q p
+ get3 q (x, False) = let q' = q |> x
+ in get source
+ >>= maybe
+ (putQueue q' true)
+ (get3 q')
+ get3 q p@(x, True) = putQueue q false >>= whenNull (get1 p)
+ p succeed = get source >>= maybe (return []) succeed
+ in p get1)
+
+-- | The 'prefix' combinator feeds its /true/ sink only the prefix of the input that its argument feeds to its /true/ sink.
+-- All the rest of the input is dumped into the /false/ sink of the result.
+prefix :: (Monad m, Typeable x) => Splitter m x -> Splitter m x
+prefix splitter = liftSectionSplitter s
+ where s source true false = liftM (\(x, y)-> y ++ x) $
+ pipeD "prefix" (transduce (splitterToMarker splitter) source)
+ (\source-> let get1 (x, False) = p false x get2
+ get1 (x, True) = p true x get1
+ get2 (x, _) = p false x get2
+ p sink x succeed = put sink x
+ >>= cond (get source >>= maybe (return []) succeed)
+ (return $ maybe [] (:[]) x)
+ in get source >>= maybe (return []) get1)
+
+-- | The 'suffix' combinator feeds its /true/ sink only the suffix of the input that its argument feeds to its /true/ sink.
+-- All the rest of the input is dumped into the /false/ sink of the result.
+suffix :: (Monad m, Typeable x) => Splitter m x -> Splitter m x
+suffix splitter = liftSectionSplitter s
+ where s source true false = liftM (\(x, y)-> concatMap (maybe [] (:[])) y ++ x) $
+ pipeD "suffix" (transduce (splitterToMarker splitter) source)
+ (\source-> let get1 (x, False) = put false x >>= cond (p get1) (return [x])
+ get1 (x, True) = get2 (Seq.singleton x)
+ get2 q = get source
+ >>= maybe (putQueue q true) (get3 q)
+ get3 q (x, True) = get2 (q |> x)
+ get3 q p@(x, False) = putQueue q false >>= whenNull (get1 p)
+ p succeed = get source >>= maybe (return []) succeed
+ in p get1)
+
+-- | The 'even' combinator takes every input section that its argument splitters deems /true/, and feeds even ones into
+-- its /true/ sink. The odd sections and parts of input that are /false/ according to its argument splitter are fed to
+-- 'even' splitter's /false/ sink.
+even :: (Monad m, Typeable x) => Splitter m x -> Splitter m x
+even splitter = liftSectionSplitter s
+ where s source true false = liftM (\(x, y)-> concatMap (maybe [] (:[])) y ++ x) $
+ pipeD "even"
+ (transduce (splitterToMarker splitter) source)
+ (\source-> let get1 (x, False) = put false x
+ >>= cond (get source >>= maybe (return []) get1)
+ (return [x])
+ get1 p@(x, True) = get2 p
+ get2 (x, True) = put false x
+ >>= cond (get source >>= maybe (return []) get2)
+ (return [x])
+ get2 p@(x, False) = get3 p
+ get3 (x, False) = put false x
+ >>= cond (get source >>= maybe (return []) get3)
+ (return [x])
+ get3 p@(x, True) = get4 p
+ get4 (x, True) = put true x
+ >>= cond (get source >>= maybe (return []) get4)
+ (return [x])
+ get4 p@(x, False) = get1 p
+ in get source >>= maybe (return []) get1)
+
+-- | Combinator 'followedBy' treats its argument 'Splitter's as patterns components and returns a 'Splitter' that
+-- matches their concatenation. A section of input is considered /true/ by the result iff its prefix is considered
+-- /true/ by argument /s1/ and the rest of the section is considered /true/ by /s2/. The splitter /s2/ is started anew
+-- after every section split to /true/ sink by /s1/.
+followedBy :: forall m x. (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+followedBy s1 s2 = liftSectionSplitter s
+ where s source true false
+ = liftM (\(x, y)-> concatMap (maybe [] (:[])) y ++ x) $
+ pipeD "followedBy"
+ (transduce (splitterToMarker s1) source)
+ (\source-> let get0 q = case Seq.viewl q
+ of Seq.EmptyL -> get source >>= maybe (return []) get1
+ (x, False) :< rest -> put false x
+ >>= cond (get0 rest)
+ (return $ Foldable.toList $ Seq.viewl $ fmap fst q)
+ (x, True) :< rest -> get2 Seq.empty q
+ get1 (x, False) = put false x
+ >>= cond (get source >>= maybe (return []) get1)
+ (return [x])
+ get1 p@(x, True) = get2 Seq.empty (Seq.singleton p)
+ get2 q q' = case Seq.viewl q'
+ of Seq.EmptyL -> get source
+ >>= maybe (testEnd q) (get2 q . Seq.singleton)
+ (x, True) :< rest -> get2 (q |> x) rest
+ (x, False) :< rest -> do ((q1, q2), n) <- pipeD "followedBy tail"
+ (get3 Seq.empty q') (test q)
+ case n of Nothing -> putQueue q false
+ >>= whenNull (get0 (q1 >< q2))
+ Just n -> do put false Nothing
+ get0 (dropJust n q1 >< q2)
+ get3 q1 q2 sink = canPut sink
+ >>= cond (case Seq.viewl q2
+ of Seq.EmptyL -> get source
+ >>= maybe (return (q1, q2))
+ (\p-> maybe (return True) (put sink) (fst p)
+ >> get3 (q1 |> p) q2 sink)
+ p :< rest -> maybe (return True) (put sink) (fst p)
+ >> get3 (q1 |> p) rest sink)
+ (return (q1, q2))
+ testEnd q = do ((), n) <- pipeD "testEnd" (const $ return ()) (test q)
+ case n of Nothing -> putQueue q false
+ _ -> return []
+ test q source = liftM snd $
+ pipeD "follower"
+ (transduce (splitterToMarker s2) source)
+ (\source-> let get4 (_, False) = return Nothing
+ get4 p@(_, True) = putQueue q true >> get5 0 p
+ get5 n (x, False) = return (Just n)
+ get5 n (Nothing, True) = get6 n
+ get5 n (x, True) = put true x >> get6 (succ n)
+ get6 n = get source
+ >>= maybe
+ (return $ Just n)
+ (get5 n)
+ in get source >>= maybe (return Nothing) get4)
+ dropJust 0 q = q
+ dropJust n q = case Seq.viewl q of (Nothing, _) :< rest -> dropJust n rest
+ (Just _, _) :< rest -> dropJust (pred n) rest
+ in get0 Seq.empty)
+
+-- | Combinator 'between' passes to its /true/ sink all input that follows a section considered true by its first
+-- argument splitter but not a section considered true by its second argument. The section delimiter pairs can nest to
+-- arbitrary depth.
+between :: forall m x. (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+between s1 s2 = liftSectionSplitter s
+ where s source true false = liftM (\(x, y)-> concatMap (maybe [] (:[])) y ++ x) $
+ pipeD "between"
+ (transduce (pairMarkerToMaybePairMarker $ splittersToPairMarker s1 s2) source)
+ (\source-> let next state = get source >>= maybe (return []) state
+ pass sink x state = put sink x >>= cond (next state) (return [x])
+ state0 t@(x, True, False) = state1 t
+ state0 (x, _, _) = pass false x state0
+ state1 t@(x, _, True) = state0 t
+ state1 (x, True, False) = pass false x state1
+ state1 t@(x, False, False) = state2 1 t
+ state2 n (x, False, False) = pass true x (state2 n)
+ state2 n t@(x, _, True) = state4 (pred n) t
+ state2 n t@(x, True, False) = state3 (succ n) t
+ state3 n (x, True, _) = pass true x (state3 n)
+ state3 n t@(x, False, False) = state2 n t
+ state3 n t@(x, False, True) = state4 (pred n) t
+ state4 0 t = state0 t
+ state4 n (x, _, True) = pass true x (state4 n)
+ state4 n t@(x, True, False) = state3 (succ n) t
+ state4 n t@(x, False, False) = state2 n t
+ in next state0)
+
+-- | Combinator '...' is similar to 'between', except it passes to /true/ the delimiting sections as well
+-- as all input between them.
+(...) :: forall m x. (Monad m, Typeable x) => Splitter m x -> Splitter m x -> Splitter m x
+s1 ... s2 = liftSectionSplitter s
+ where s source true false = liftM (\(x, y)-> concatMap (maybe [] (:[])) y ++ x) $
+ pipeD "..."
+ (transduce (pairMarkerToMaybePairMarker $ splittersToPairMarker s1 s2) source)
+ (\source-> let next state = get source >>= maybe (return []) state
+ pass sink x state = put sink x >>= cond (next state) (return [x])
+ state0 (x, False, _) = pass false x state0
+ state0 t@(x, True, _) = state1 1 t
+ state1 0 t = state0 t
+ state1 n (x, True, False) = pass true x (state1 n)
+ state1 n t@(x, False, False) = state2 n t
+ state1 n t@(x, _, True) = state3 (pred n) t
+ state2 n (x, False, False) = pass true x (state2 n)
+ state2 n t@(x, _, True) = state3 (pred n) t
+ state2 n t@(x, True, False) = state1 (succ n) t
+ state3 n (x, _, True) = pass true x (state3 n)
+ state3 n t@(x, True, False) = put false Nothing >> state1 (succ n) t
+ state3 0 t@(x, False, False) = state0 t
+ state3 n t@(x, False, False) = state2 n t
+ in next state0)
+
+-- Helper functions
+
+type Marker m x = Transducer m x (Maybe x, Bool)
+
+splitterToMarker :: forall m x. (Monad m, Typeable x) => Splitter m x -> Marker m x
+splitterToMarker s = Transducer t
+ where t source sink = liftM (\((x, y), z)-> z ++ y ++ x) $
+ pipeD "splitterToMarker true"
+ (\trueSink-> pipeD "splitterToMarker false" (splitSections s source trueSink) (mark False))
+ (mark True)
+ where mark b source = canPut sink
+ >>= cond (get source
+ >>= maybe (return [])
+ (\x-> put sink (x, b) >>= cond (mark b source) (return $ maybe [] (: []) x)))
+ (return [])
+
+
+splittersToPairMarker :: forall m x. (Monad m, Typeable x)
+ => Splitter m x -> Splitter m x -> Transducer m x (Either (x, Bool, Bool) (Either Bool Bool))
+splittersToPairMarker s1 s2 = Transducer t
+ where t source sink = liftM (\((((((((), l1), l2), l3), l4), l5), l6), l7)-> l7 ++ l6 ++ l5 ++ l4 ++ l3 ++ l2 ++ l1) $
+ pipeD "splittersToMarker synchronize"
+ (\sync->
+ pipeD "splittersToMarker true1"
+ (\true1->
+ pipeD "splittersToMarker false1"
+ (\false1->
+ pipeD "splitterssToMarker true2"
+ (\true2->
+ pipeD "splittersToMarker false2"
+ (\false2->
+ pipeD "splittersToMarker sink1"
+ (\sink1->
+ pipeD "splittersToMarker sink2"
+ (\sink2-> tee source sink1 sink2)
+ (\source2-> splitSections s2 source2 true2 false2))
+ (\source1-> splitSections s1 source1 true1 false1))
+ (mark sync False False))
+ (mark sync False True))
+ (mark sync True False))
+ (mark sync True True))
+ (synchronizeMarks Nothing)
+ where synchronizeMarks :: Maybe (Seq (x, Bool), Bool) -> Source c (Maybe x, Bool, Bool) -> Pipe c m [x]
+ synchronizeMarks state source
+ = get source
+-- >>= \t-> trace (show t ++ "@" ++ show state) (return t)
+ >>= maybe
+ (assert (isNothing state) (return []))
+ (\(x, pos, b) ->
+ maybe
+ (put sink (Right $ if pos then Left b else Right b)
+ >> synchronizeMarks state source)
+ (\x-> case state
+ of Nothing -> synchronizeMarks (Just (Seq.singleton (x, b), pos)) source
+ Just (q, pos') -> if pos == pos'
+ then synchronizeMarks (Just (q |> (x, b), pos')) source
+ else case Seq.viewl q
+ of Seq.EmptyL -> synchronizeMarks
+ (Just (Seq.singleton (x, b), pos))
+ source
+ (y, b') :< rest -> put sink (Left $ if pos
+ then (x, b, b')
+ else (x, b', b))
+ >>= cond
+ (synchronizeMarks
+ (if Seq.null rest
+ then Nothing
+ else Just (rest, pos'))
+ source)
+ (returnQueuedList q))
+ x)
+ returnQueuedList q = return $ map fst $ Foldable.toList $ Seq.viewl q
+ mark sink first b source = let mark' = canPut sink
+ >>= cond
+ (get source
+ >>= maybe
+ (return [])
+ (\x-> put sink (x, first, b)
+ >>= cond mark' (return $ maybe [] (: []) x)))
+ (return [])
+ in mark'
+
+pairMarkerToMaybePairMarker :: forall m x. (Monad m, Typeable x)
+ => Transducer m x (Either (x, Bool, Bool) (Either Bool Bool)) -> Transducer m x (Maybe x, Bool, Bool)
+pairMarkerToMaybePairMarker t = Transducer t'
+ where t' source sink = liftM (\(x, y)-> y ++ x) $
+ pipeD "pairMarkerToMaybePairMarker"
+ (transduce t source)
+ (\source-> let next state = get source >>= maybe (return []) state
+ nextState2 l r d = get source
+ >>= maybe (put sink (Nothing, l, r) >> return []) (state2 l r d)
+ state0 (Left (x, l, r)) = put sink (Just x, l, r)
+ >>= cond (next $ state1 l r) (return [x])
+ state0 v@(Right d) = state2 False False d v
+ state1 _ _ (Left (x, l, r)) = put sink (Just x, l, r)
+ >>= cond (next $ state1 l r) (return [x])
+ state1 l r v@(Right d) = state2 l r d v
+ state2 l r Left{} (Right d@(Left l')) = nextState2 l' r d
+ state2 l r Left{} (Right (Right r')) = put sink (Nothing, l, r')
+ >>= cond (next $ state1 l r') (return [])
+ state2 l r Left{} t@(Left (x, l', r')) | l == l' = state1 l r t
+ | otherwise = put sink (Nothing, l, r)
+ >>= cond
+ (state1 l' r' t)
+ (return [])
+ state2 l r Right{} (Right d@(Right r')) = nextState2 l r' d
+ state2 l r Right{} (Right (Left l')) = put sink (Nothing, l', r)
+ >>= cond (next $ state1 l' r) (return [])
+ state2 l r Right{} t@(Left (x, l', r')) | r == r' = state1 l r t
+ | otherwise = put sink (Nothing, l, r)
+ >>= cond
+ (state1 l' r' t)
+ (return [])
+ in next state0)
+
+zipSplittersWith :: (Monad m, Typeable x) => (Bool -> Bool -> Bool) -> Splitter m x -> Splitter m x -> Splitter m x
+zipSplittersWith f s1 s2
+ = liftSectionSplitter (\source true false->
+ liftM (\(x, y)-> y ++ x) $
+ pipeD "&"
+ (transduce (pairMarkerToMaybePairMarker $ splittersToPairMarker s1 s2) source)
+ (\source-> let split = get source >>= maybe (return []) test
+ test (x, b1, b2) = (if f b1 b2 then put true x else put false x)
+ >>= cond split (return $ maybe [] (:[]) x)
+ in split))
+
+groupMarks :: forall c1 c m x y z. (Monad m, Typeable x, Typeable y, Eq y)
+ => Source c1 (Maybe x, y) -> (y -> Consumer m x z) -> Pipe c m ()
+groupMarks source getConsumer = getSuccess source startNew
+ where startNew (mx, y) = do (nextPair, _) <- pipeD "groupMarks" (\sink-> pass sink mx y) (getConsumer y)
+ case nextPair of Just p -> startNew p
+ Nothing -> return ()
+ pass sink Nothing y = next sink y
+ pass sink (Just x) y = put sink x >> next sink y
+ next sink y = get source >>= maybe (return Nothing) (continue sink y)
+ continue sink y (x, y') | y == y' = pass sink x y
+ continue sink y p@(x, y') | y /= y' = return (Just p)
+
+splitConsumer :: forall x m r1 r2 c c1. (Monad m, Typeable x)
+ => String -> Splitter m x -> Consumer m x r1 -> Consumer m x r2 -> Source c1 x -> Pipe c m ([x], r1, r2)
+splitConsumer description s trueConsumer falseConsumer = consumer'
+ where consumer' source = pipeD (description ++ " false")
+ (\false-> pipeD (description ++ " true") (\true-> split s source true false) trueConsumer)
+ falseConsumer
+ >>= \((extra, r1), r2)-> return (extra, r1, r2)
+
+splitConsumerSections :: forall x m r1 r2 c c1. (Monad m, Typeable x)
+ => String -> Splitter m x -> Consumer m (Maybe x) r1 -> Consumer m (Maybe x) r2 -> Source c1 x
+ -> Pipe c m ([x], r1, r2)
+splitConsumerSections description s trueConsumer falseConsumer = consumer'
+ where consumer' source = pipeD (description ++ " false")
+ (\false-> pipeD (description ++ " true") (\true-> splitSections s source true false) trueConsumer)
+ falseConsumer
+ >>= \((extra, r1), r2)-> return (extra, r1, r2)
+
+putQueue :: forall context r m x. (Monad m, Typeable x) => Seq x -> Sink context x -> Pipe r m [x]
+putQueue q sink = putList (Foldable.toList (Seq.viewl q)) sink
+
+getQueue :: forall x c c1 m. (Monad m, Typeable x) => Source c1 x -> Pipe c m (Seq x)
+getQueue source = let getOne q = get source >>= maybe (return q) (\x-> getOne (q |> x))
+ in getOne Seq.empty
+
+pourMaybe :: forall c c1 c2 x m. (Monad m, Typeable x) => Source c1 x -> Sink c2 (Maybe x) -> Pipe c m ()
+pourMaybe source sink = pour0
+ where pour0 = canPut sink >>= flip when (get source >>= maybe (put sink Nothing >> return ()) pass)
+ pour1 = canPut sink >>= flip when (getSuccess source pass)
+ pass x = put sink (Just x) >> pour1
+
+
+suppressProducer :: forall x c m r. (Monad m, Typeable x) => Producer m x r -> Pipe c m r
+suppressProducer producer = liftM fst $ pipeD "suppress" producer consumeAndSuppress
+
+fst3 :: (a, b, c) -> a
+fst3 (a, b, c) = a
diff --git a/Control/Concurrent/SCC/ComponentTypes.hs b/Control/Concurrent/SCC/ComponentTypes.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/SCC/ComponentTypes.hs
@@ -0,0 +1,113 @@
+{-
+ Copyright 2008 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
+ .
+-}
+
+{-# LANGUAGE ScopedTypeVariables, Rank2Types #-}
+
+module Control.Concurrent.SCC.ComponentTypes
+ (-- * Types
+ Splitter(..), Transducer(..),
+ -- * Lifting functions
+ lift121Transducer, liftStatelessTransducer, liftFoldTransducer, liftStatefulTransducer,
+ liftSimpleSplitter, liftSectionSplitter, liftStatelessSplitter)
+where
+
+import Control.Concurrent.SCC.Foundation
+
+import Control.Monad (liftM, when)
+import Data.Maybe (maybe)
+import Data.Typeable (Typeable, cast)
+
+-- | The 'Transducer' type represents computations that transform data and return no result.
+-- A transducer must continue consuming the given source and feeding the sink while there is data.
+newtype Monad m => Transducer m x y = Transducer {transduce :: forall c1 c2 context. Source c1 x -> Sink c2 y -> Pipe context m [x]}
+
+-- | The 'Splitter' type represents computations that distribute data acording to some criteria. A splitter should
+-- distribute only the original input data, and feed it into the sinks in the same order it has been read from the
+-- source. If the two sink arguments of a splitter are the same, the splitter must act as an identity transform.
+data Monad m => Splitter m x = Splitter {split :: forall c1 c2 c3 context.
+ Source c1 x -> Sink c2 x -> Sink c3 x -> Pipe context m [x],
+ splitSections :: forall c1 c2 c3 context.
+ Source c1 x -> Sink c2 (Maybe x) -> Sink c3 (Maybe x)
+ -> Pipe context m [x]}
+
+-- | Function 'lift121Transducer' takes a function that maps one input value to one output value each, and lifts it into
+-- a 'Transducer'.
+lift121Transducer :: (Monad m, Typeable x, Typeable y) => (x -> y) -> Transducer m x y
+lift121Transducer f = Transducer (\source sink-> let t = canPut sink
+ >>= flip when (getSuccess source (\x-> put sink (f x) >> t))
+ in t >> return [])
+
+-- | Function 'liftStatelessTransducer' takes a function that maps one input value into a list of output values, and
+-- lifts it into a 'Transducer'.
+liftStatelessTransducer :: (Monad m, Typeable x, Typeable y) => (x -> [y]) -> Transducer m x y
+liftStatelessTransducer f = Transducer (\source sink-> let t = canPut sink
+ >>= flip when (getSuccess source (\x-> putList (f x) sink >> t))
+ in t >> return [])
+-- | Function 'liftFoldTransducer' creates a stateful transducer that produces only one output value after consuming the
+-- entire input. Similar to 'Data.List.foldl'
+liftFoldTransducer :: (Monad m, Typeable x, Typeable y) => (y -> x -> y) -> y -> Transducer m x y
+liftFoldTransducer f y0 = Transducer (\source sink-> let t y = canPut sink
+ >>= flip when (get source
+ >>= maybe (put sink y >> return ()) (t . f y))
+ in t y0 >> return [])
+
+-- | Function 'liftStatefulTransducer' constructs a 'Transducer' from a state-transition function and the initial
+-- state. The transition function may produce arbitrary output at any transition step.
+liftStatefulTransducer :: (Monad m, Typeable x, Typeable y) => (state -> x -> (state, [y])) -> state -> Transducer m x y
+liftStatefulTransducer f s0 = Transducer (\source sink-> let t s = canPut sink
+ >>= flip when (getSuccess source (\x-> let (s', ys) = f s x
+ in putList ys sink
+ >> t s'))
+ in t s0 >> return [])
+
+-- | Function 'liftStatelessSplitter' takes a function that assigns a Boolean value to each input item and lifts it into
+-- a 'Splitter'
+liftStatelessSplitter :: (Monad m, Typeable x) => (x -> Bool) -> Splitter m x
+liftStatelessSplitter f = liftSimpleSplitter (\source true false-> let s = get source
+ >>= maybe
+ (return [])
+ (\x-> (if f x
+ then put true x
+ else put false x)
+ >>= cond s (return [x]))
+ in s)
+
+-- | Function 'liftSimpleSplitter' lifts a simple, non-sectioning splitter function into a full 'Splitter'
+liftSimpleSplitter :: (Monad m, Typeable x) =>
+ (forall c1 c2 c3 context. Source c1 x -> Sink c2 x -> Sink c3 x -> Pipe context m [x]) -> Splitter m x
+liftSimpleSplitter split = Splitter split splitSections
+ where splitSections source true false
+ = liftM (fst . fst) $
+ pipeD "liftSimpleSplitter true"
+ (\true'-> pipeD "liftSimpleSplitter false"
+ (\false'-> split source true' false')
+ (decorate false))
+ (decorate true)
+ decorate sink source = transduce (lift121Transducer Just) source sink
+
+-- | Function 'liftSectionSplitter' lifts a sectioning splitter function into a full 'Splitter'
+liftSectionSplitter :: (Monad m, Typeable x) =>
+ (forall c1 c2 c3 context. Source c1 x -> Sink c2 (Maybe x) -> Sink c3 (Maybe x) -> Pipe context m [x])
+ -> Splitter m x
+liftSectionSplitter splitSections = Splitter splitValues splitSections
+ where splitValues source true false
+ = liftM (fst . fst) $
+ pipeD "liftSectionSplitter true"
+ (\true'-> pipeD "liftSectionSplitter false" (\false'-> splitSections source true' false') (strip false))
+ (strip true)
+-- strip sink source = transduce (liftStatelessTransducer (maybe [] (:[]))) source sink
+ strip sink source = canPut sink
+ >>= flip when (getSuccess source (\x-> maybe (return False) (put sink) x >> strip sink source))
diff --git a/Control/Concurrent/SCC/Components.hs b/Control/Concurrent/SCC/Components.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/SCC/Components.hs
@@ -0,0 +1,284 @@
+{-
+ Copyright 2008 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
+ .
+-}
+
+-- | Module "Components" defines primitive components of 'Producer', 'Consumer', 'Transducer' and 'Splitter' types,
+-- defined in the "Foundation" and "ComponentTypes" modules.
+
+{-# LANGUAGE ScopedTypeVariables, Rank2Types #-}
+
+module Control.Concurrent.SCC.Components
+ (-- * IO components
+ fromFile, fromHandle, fromStdIn,
+ appendFile, toFile, toHandle, toStdOut, toPrint,
+ -- * Generic transducers
+ asis, suppress, erroneous,
+ prepend, append, substitute,
+ -- * Generic splitters
+ allTrue, allFalse, one, substring, substringMatch,
+ -- * List transducers
+ -- | The following laws hold:
+ --
+ -- * 'group' '>->' 'concatenate' == 'asis'
+ --
+ -- * 'concatenate' == 'concatSeparate' []
+ group, concatenate, concatSeparate,
+ -- * Character stream components
+ lowercase, uppercase, whitespace, letters, digits, line, nonEmptyLine,
+ -- * Oddballs
+ count, toString
+)
+where
+
+import Control.Concurrent.SCC.Foundation
+import Control.Concurrent.SCC.ComponentTypes
+
+import Prelude hiding (appendFile, last)
+import Control.Monad (liftM, when)
+import qualified Control.Monad as Monad
+import Data.Char (isAlpha, isDigit, isPrint, isSpace, toLower, toUpper)
+import Data.List (isPrefixOf, stripPrefix)
+import Data.Maybe (fromJust)
+import qualified Data.Foldable as Foldable
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq, (|>), ViewL (EmptyL, (:<)))
+import Data.Typeable (Typeable)
+import Debug.Trace (trace)
+import System.IO (Handle, IOMode (ReadMode, WriteMode, AppendMode), openFile, hClose,
+ hGetChar, hPutChar, hFlush, hIsEOF, hClose, putChar, isEOF, stdout)
+
+
+-- | Consumer 'toStdOut' copies the given source into the standard output.
+toStdOut :: Consumer IO Char ()
+toStdOut source = getSuccess source (\x-> liftPipe (putChar x) >> toStdOut source)
+
+toPrint :: forall x. (Show x, Typeable x) => Consumer IO x ()
+toPrint source = getSuccess source (\x-> liftPipe (print x) >> toPrint source)
+
+-- | Producer 'fromStdIn' feeds the given sink from the standard input.
+fromStdIn :: Producer IO Char ()
+fromStdIn sink = do readyInput <- liftM not (liftPipe isEOF)
+ readyOutput <- canPut sink
+ when (readyInput && readyOutput) (liftPipe getChar >>= put sink >> fromStdIn sink)
+
+-- | Producer 'fromFile' opens the named file and feeds the given sink from its contents.
+fromFile :: String -> Producer IO Char ()
+fromFile path sink = liftPipe (openFile path ReadMode) >>= flip fromHandle sink
+
+-- | Producer 'fromHandle' feeds the given sink from the open file /handle/.
+fromHandle :: Handle -> Producer IO Char ()
+fromHandle handle sink = producer
+ where producer = do readyInput <- liftM not (liftPipe (hIsEOF handle))
+ readyOutput <- canPut sink
+ when (readyInput && readyOutput) (liftPipe (hGetChar handle) >>= put sink >> producer)
+
+-- | Consumer 'toFile' opens the named file and copies the given source into it.
+toFile :: String -> Consumer IO Char ()
+toFile path source = liftPipe (openFile path WriteMode) >>= flip toHandle source
+
+-- | Consumer 'appendFile' opens the name file and appends the given source to it.
+appendFile :: String -> Consumer IO Char ()
+appendFile path source = liftPipe (openFile path AppendMode) >>= flip toHandle source
+
+-- | Consumer 'toHandle' copies the given source into the open file /handle/.
+toHandle :: Handle -> Consumer IO Char ()
+toHandle handle source = getSuccess source (\x-> liftPipe (hPutChar handle x) >> toHandle handle source)
+
+-- | Transducer 'asis' passes its input through unmodified.
+asis :: (Monad m, Typeable x) => Transducer m x x
+asis = Transducer (\source sink-> pour source sink >> return [])
+
+-- | The 'suppress' transducer suppresses all input it receives. It is equivalent to 'substitute' []
+suppress :: (Monad m, Typeable x, Typeable y) => Transducer m x y
+suppress = liftStatelessTransducer (const [])
+
+-- | The 'erroneous' transducer reports an error if any input reaches it.
+erroneous :: (Monad m, Typeable x) => Transducer m x x
+erroneous = liftStatelessTransducer (\x-> error "Erroneous.")
+
+-- | The 'lowercase' transforms all uppercase letters in the input to lowercase, leaving the rest unchanged.
+lowercase :: Monad m => Transducer m Char Char
+lowercase = lift121Transducer toLower
+
+-- | The 'uppercase' transforms all lowercase letters in the input to uppercase, leaving the rest unchanged.
+uppercase :: Monad m => Transducer m Char Char
+uppercase = lift121Transducer toUpper
+
+-- | Transducer 'prepend' passes its input unmodified, except for prepending contents of the given list parameter before
+-- it.
+prepend :: (Monad m, Typeable x) => [x] -> Transducer m x x
+prepend prefix = Transducer (\source sink-> putList prefix sink >>= whenNull (pour source sink >> return []))
+
+-- | Transducer 'append' passes its input unmodified, except for appending contents of the given list parameter to
+-- its end.
+append :: (Monad m, Typeable x) => [x] -> Transducer m x x
+append suffix = Transducer (\source sink-> do pour source sink
+ putList suffix sink
+ return [])
+
+-- | The 'substitute' transducer replaces its whole input by its parameter.
+substitute :: (Monad m, Typeable x, Typeable y) => [y] -> Transducer m x y
+substitute list = Transducer (\source sink-> consumeAndSuppress source >> putList list sink >> return [])
+
+-- | The 'count' transducer counts all its input values and outputs the final tally.
+count :: (Monad m, Typeable x) => Transducer m x Integer
+count = Transducer (\source sink-> let t count = get source
+ >>= maybe
+ (put sink count >> return [])
+ (\_-> t (succ count))
+ in canPut sink >>= cond (t 0) (return []))
+
+toString :: (Monad m, Show x, Typeable x) => Transducer m x String
+toString = lift121Transducer show
+
+-- | Transducer 'group' collects all its input values into a single list.
+group :: (Monad m, Typeable x) => Transducer m x [x]
+group = Transducer (\source sink-> let group q = get source
+ >>= maybe
+ (let list = Foldable.toList (Seq.viewl q)
+ in put sink list
+ >>= cond
+ (return [])
+ (return list))
+ (\x-> group (q |> x))
+ in group Seq.empty)
+
+-- | Transducer 'concatenate' flattens the input stream of lists of values into the output stream of values.
+concatenate :: (Monad m, Typeable x) => Transducer m [x] x
+concatenate = liftStatelessTransducer id
+
+concatSeparate :: (Monad m, Typeable x) => [x] -> Transducer m [x] x
+concatSeparate separator = Transducer (\source sink-> let t = canPut sink
+ >>= cond
+ (get source
+ >>= maybe
+ (return [])
+ (\xs-> do putList separator sink
+ putList xs sink
+ t))
+ (return [])
+ in get source
+ >>= maybe
+ (return [])
+ (\xs-> putList xs sink >> t))
+
+-- | Splitter 'whitespace' feeds all white-space characters into its /true/ sink, all others into /false/.
+whitespace :: Monad m => Splitter m Char
+whitespace = liftStatelessSplitter isSpace
+
+-- | Splitter 'letters' feeds all alphabetical characters into its /true/ sink, all other characters into /false/.
+letters :: Monad m => Splitter m Char
+letters = liftStatelessSplitter isAlpha
+
+-- | Splitter 'digits' feeds all digits into its /true/ sink, all other characters into /false/.
+digits :: Monad m => Splitter m Char
+digits = liftStatelessSplitter isDigit
+
+-- | Splitter 'nonEmptyLine' feeds line-ends into its /false/ sink, and all other characters into /true/.
+nonEmptyLine :: Monad m => Splitter m Char
+nonEmptyLine = liftStatelessSplitter (\ch-> ch /= '\n' && ch /= '\r')
+
+-- | The sectioning splitter 'line' feeds line-ends into its /false/ sink, and line contents into /true/. A single
+-- line-end can be formed by any of the character sequences \"\\n\", \"\\r\", \"\\r\\n\", or \"\\n\\r\".
+line :: Monad m => Splitter m Char
+line = liftSectionSplitter (\source true false->
+ let split0 = get source >>= maybe (return []) split1
+ split1 x = if x == '\n' || x == '\r'
+ then split2 x
+ else lineChar x
+ split2 x = put false (Just x)
+ >>= cond
+ (get source
+ >>= maybe
+ (return [])
+ (\y-> if x == y
+ then emptyLine x
+ else if y == '\n' || y == '\r'
+ then split3 x
+ else lineChar y))
+ (return [x])
+ split3 x = put false (Just x)
+ >>= cond
+ (get source
+ >>= maybe
+ (return [])
+ (\y-> if y == '\n' || y == '\r'
+ then emptyLine y
+ else lineChar y))
+ (return [x])
+ emptyLine x = put true Nothing >>= cond (split2 x) (return [])
+ lineChar x = put true (Just x) >>= cond split0 (return [x])
+ in split0)
+
+-- | Splitter 'allTrue' feeds its entire input into its /true/ sink.
+allTrue :: (Monad m, Typeable x) => Splitter m x
+allTrue = liftStatelessSplitter (const True)
+
+-- | Splitter 'allFalse' feeds its entire input into its /false/ sink.
+allFalse :: (Monad m, Typeable x) => Splitter m x
+allFalse = liftStatelessSplitter (const False)
+
+-- | Splitter 'one' feeds all input values to its /true/ sink, treating every value as a separate section.
+one :: (Monad m, Typeable x) => Splitter m x
+one = liftSectionSplitter (\source true false-> let split x = put true (Just x)
+ >>= cond (get source
+ >>= maybe
+ (return [])
+ (\x-> put false Nothing >> split x))
+ (return [x])
+ in get source >>= maybe (return []) split)
+
+-- | Splitter 'substring' feeds to its /true/ sink all input parts that match the contents of the given list
+-- argument. If two overlapping parts of the input both match the argument, only the first one wins.
+substring :: (Monad m, Eq x, Typeable x) => [x] -> Splitter m x
+substring = substringPrim False
+
+-- | Splitter 'substringMatch' feeds to its /true/ sink all input parts that match the contents of the given list
+-- argument. If two overlapping parts of the input match the argument, both are considered /true/.
+substringMatch :: (Monad m, Eq x, Typeable x) => [x] -> Splitter m x
+substringMatch = substringPrim True
+
+substringPrim _ [] = liftSectionSplitter (\ source true false ->
+ do put true Nothing
+ rest <- splitSections one source false true
+ put true Nothing
+ return rest)
+substringPrim overlap list
+ = liftSectionSplitter $
+ \ source true false ->
+ let getNext rest q separate = get source
+ >>= maybe
+ (liftM (map fromJust) $
+ putList (map Just $ Foldable.toList (Seq.viewl q)) false)
+ (\x-> do when separate (put false Nothing >> return ())
+ advance rest q x)
+ advance rest@(head:tail) q x = if x == head
+ then if null tail
+ then liftM (map fromJust) (putList (map Just list) true)
+ >>= whenNull (if overlap
+ then fallback True (Seq.drop 1 q)
+ else getNext list Seq.empty True)
+ else getNext tail (q |> x) False
+ else fallback False (q |> x)
+ fallback committed q = case stripPrefix (Foldable.toList (Seq.viewl q)) list
+ of Just rest -> getNext rest q committed
+ Nothing -> let view@(head :< tail) = Seq.viewl q
+ in if committed
+ then fallback committed tail
+ else put false (Just head)
+ >>= cond
+ (fallback committed tail)
+ (return (Foldable.toList view))
+ in getNext list Seq.empty False
diff --git a/Control/Concurrent/SCC/Foundation.hs b/Control/Concurrent/SCC/Foundation.hs
new file mode 100644
--- /dev/null
+++ b/Control/Concurrent/SCC/Foundation.hs
@@ -0,0 +1,249 @@
+{-
+ Copyright 2008 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
+ .
+-}
+
+-- | Module "Foundation" defines the pipe computations and their basic building blocks.
+
+{-# LANGUAGE ScopedTypeVariables, Rank2Types, PatternGuards, ExistentialQuantification #-}
+
+module Control.Concurrent.SCC.Foundation
+ (-- * Types
+ Pipe, Source, Sink, Consumer, Producer,
+ -- * Flow-control functions
+ pipe, pipeD, get, getSuccess, canPut, put,
+ liftPipe, runPipes,
+ -- * Utility functions
+ cond, whenNull, pour, tee, getList, putList, consumeAndSuppress)
+where
+
+import Control.Exception (assert)
+import Control.Monad (liftM, when)
+import Data.Maybe (maybe)
+import Data.Typeable (Typeable, cast)
+
+import Debug.Trace (trace)
+
+-- | 'Pipe' represents the type of monadic computations that can be split into co-routining computations using function
+-- 'pipe'. The /context/ type parameter delimits the scope of the computation.
+newtype Monad m => Pipe context m r = Pipe {proceed :: context -> Int -> Integer -> m (PipeState context m r)}
+data PipeState context m r = Suspend context [Suspension context m r]
+ | Done Integer r
+data Suspension context m r = Suspension {pid :: Int,
+ clock :: Integer,
+ description :: String,
+ continuation :: SuspendedContinuation context m r}
+data SuspendedContinuation context m r = forall x. Typeable x => Get (Maybe x -> Pipe context m r)
+ | forall x. Typeable x => Put x (Bool -> Pipe context m r)
+ | CanPut (Bool -> Pipe context m r)
+
+-- | A 'Source' is the read-only end of a 'Pipe' communication channel.
+data Source context x = Source context Int String
+-- | A 'Sink' is the write-only end of a 'Pipe' communication channel.
+data Sink context x = Sink context Int String
+
+-- | A computation that consumes values from a 'Source' is called 'Consumer'.
+type Consumer m x r = forall c. Source c x -> Pipe c m r
+-- | A computation that produces values and puts them into a 'Sink' is called 'Producer'.
+type Producer m x r = forall c. Sink c x -> Pipe c m r
+
+-- | Function 'liftPipe' lifts a value of the underlying monad type into a 'Pipe' computation.
+liftPipe :: forall context m r. Monad m => m r -> Pipe context m r
+liftPipe mr = Pipe (\context pid clock-> liftM (Done clock) mr)
+
+-- | Function 'runPipes' runs the given computation involving pipes and returns the final result.
+-- The /context/ argument ensures that no suspended computation can escape its scope.
+runPipes :: forall m r. Monad m => (forall context. Pipe context m r) -> m r
+runPipes c = proceed c undefined 1 0 >>= \s-> case s of Done _ r -> return r
+
+instance Monad m => Monad (Pipe context m) where
+ return r = Pipe (\context pid clock-> return (Done clock r))
+ Pipe p >>= f = Pipe (\context pid clock-> p context pid clock >>= apply f context pid)
+ where apply :: forall r1 r2. (r1 -> Pipe context m r2) -> context -> Int -> PipeState context m r1 -> m (PipeState context m r2)
+ apply f context pid (Done clock r) = proceed (f r) context pid (succ clock)
+ apply f _ pid (Suspend context suspensions) = return $ Suspend context (map suspendApplied suspensions)
+ where suspendApplied s@Suspension{description= desc, clock= clock', continuation= Get cont}
+ = s{description= "applied " ++ desc, continuation= Get ((f =<<) . cont)}
+ suspendApplied s@Suspension{description= desc, clock= clock', continuation= Put x cont}
+ = s{description= "applied " ++ desc, continuation= Put x ((f =<<) . cont)}
+ suspendApplied s@Suspension{description= desc, clock= clock', continuation= CanPut cont}
+ = s{description= "applied " ++ desc, continuation= CanPut ((f =<<) . cont)}
+
+instance Show (Suspension context m r) where
+ show Suspension{pid= pid, description = desc, continuation= c} = (case c of Put{} -> "(Put)"
+ CanPut{} -> "(CanPut)"
+ Get{} -> "(Get)")
+ ++ desc ++ " -> " ++ show pid
+
+-- | 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
+-- both complete, 'pipe' returns their paired results.
+pipe :: forall context x m r1 r2. Monad m => Producer m x r1 -> Consumer m x r2 -> Pipe context m (r1, r2)
+pipe = pipeD ""
+
+-- | The 'pipeD' function is same as 'pipe', with an additional description argument.
+pipeD :: forall context x m r1 r2. Monad m => String -> Producer m x r1 -> Consumer m x r2 -> Pipe context m (r1, r2)
+pipeD description producer consumer
+ = Pipe (\context pid clock-> let producerPid = 2*pid
+ consumerPid = 2*pid+1
+ context' = undefined
+ description' = description ++ ':' : show pid
+ in assert (track (indent pid ++ "pipe " ++ description')) $
+ do ps <- proceed (producer (Sink context' producerPid description')) context' producerPid clock
+ cs <- proceed (consumer (Source context' consumerPid description')) context' consumerPid clock
+ reduce context' producerPid ps consumerPid cs)
+
+reduce :: forall c m r1 r2. Monad m => c -> Int -> PipeState c m r1 -> Int -> PipeState c m r2 -> m (PipeState c m (r1, r2))
+reduce context pid1 (Done t1 r1) pid2 (Done t2 r2)
+ = assert (track (indent pid1 ++ "Done " ++ show pid1 ++ " -> " ++ show pid2)) $
+ return (Done (max t1 t2) (r1, r2))
+reduce context pid1 (Suspend c1 ps@(Suspension{pid= pid1', clock= t, continuation= pCont} : _)) pid2 consumer@Done{}
+ | pid1' == pid1, Put _ cont <- pCont
+ = assert (track (indent pid1 ++ "Failed producer put " ++ show ps ++ " from " ++ show pid1)) $
+ proceed (cont False) context pid1 t >>= \p'-> reduce context pid1 p' pid2 consumer
+ | pid1' == pid1, CanPut cont <- pCont
+ = assert (track (indent pid1 ++ "Finish producer " ++ show ps ++ " from " ++ show pid1)) $
+ proceed (cont False) context pid1 t >>= \p'-> reduce context pid1 p' pid2 consumer
+ | pid1' < pid1 = assert (track (indent pid1 ++ "Suspend producer " ++ show ps ++ " from " ++ show pid1)) $
+ return $ Suspend context $ map (delay (\ps'-> reduce context pid1 ps' pid2 consumer)) ps
+ | otherwise = error (show pid1' ++ ">" ++ show pid1 ++ " | producer : " ++ show ps)
+reduce context pid1 producer@Done{} pid2 (Suspend c2 cs@(Suspension{pid= pid2', clock= t, continuation= cCont} : _))
+ | pid2' == pid2, Get cont <- cCont
+ = assert (track (indent pid1 ++ "Finish consumer " ++ show cs ++ " from " ++ show pid2)) $
+ proceed (cont Nothing) context pid2 t >>= reduce context pid1 producer pid2
+ | pid2' < pid2 = assert (track (indent pid1 ++ "Suspend consumer " ++ show cs ++ " from " ++ show pid2)) $
+ return $ Suspend context $ map (delay (reduce context pid1 producer pid2)) cs
+ | otherwise = error (show pid2' ++ ">" ++ show pid2 ++ " | consumer : " ++ show cs)
+reduce context pid1 producer@(Suspend _ ps@(Suspension{pid= pid1', clock=t1, continuation= pc} : _))
+ pid2 consumer@(Suspend _ cs@(Suspension{pid= pid2', clock=t2, continuation= Get cCont} : _))
+ | pid1' == pid1 && pid2' == pid2, CanPut pCont <- pc
+ = assert (track (indent pid1 ++ "CanPut Match at " ++ show pid1 ++ "/" ++ show pid2 ++ " : " ++ show ps ++ " -> " ++ show cs)) $
+ proceed (pCont True) context pid1 t1 >>= \p'-> reduce context pid1 p' pid2 consumer
+ | pid1' == pid1 && pid2' == pid2, Put x pCont <- pc
+ = assert (track (indent pid1 ++ "Match at " ++ show pid1 ++ "/" ++ show pid2 ++ " : " ++ show ps ++ " -> " ++ show cs)) $
+ let t' = max t1 t2
+ in do p' <- assert (track "producer (") $ proceed (pCont True) context pid1 t'
+ c' <- assert (track ") consumer (") $ proceed (cCont (cast x)) context pid2 t'
+ assert (track ") combined ->") reduce context pid1 p' pid2 c'
+reduce context pid1 producer@(Suspend c1 ps) pid2 consumer@(Suspend c2 cs) = assert (track (indent pid1 ++ "Suspend producer & consumer, "
+ ++ show ps ++ " from " ++ show pid1 ++ " & "
+ ++ show cs ++ " from " ++ show pid2)) $
+ keepSuspending ps cs
+ where keepSuspending (Suspension{pid=pid1'} : pTail) cs | pid1' == pid1 = keepSuspending pTail cs
+ keepSuspending ps (Suspension{pid= pid2'} : cTail) | pid2' == pid2 = keepSuspending ps cTail
+ keepSuspending ps cs = assert (track (indent pid1 ++ "Suspend' producer & consumer, "
+ ++ show ps ++ " from " ++ show pid1 ++ " & "
+ ++ show cs ++ " from " ++ show pid2)) $
+ return $ Suspend context $
+ merge (map (\p-> delay (\p'-> reduce context pid1 p' pid2 consumer) p) ps)
+ (map (delay (reduce context pid1 producer pid2)) cs)
+
+merge :: Monad m => [Suspension context m r] -> [Suspension context m r] -> [Suspension context m r]
+merge [] l = l
+merge l [] = l
+merge l1@(h1@Suspension{pid= pid1, clock= c1} : tail1) l2@(h2@Suspension{pid= pid2, clock= c2} : tail2)
+ | pid1 > pid2 = h1 : merge tail1 l2
+ | pid1 < pid2 = h2 : merge l1 tail2
+ | c1 < c2 = h1 : merge tail1 l2
+ | otherwise = h2 : merge l1 tail2
+
+delay :: Monad m => (PipeState context m r1 -> m (PipeState context m r2)) -> Suspension context m r1 -> Suspension context m r2
+delay f = delay' (\p-> Pipe $ \context pid clock-> proceed p context pid clock >>= f)
+
+delay' :: Monad m => (Pipe context m r1 -> Pipe context m r2) -> Suspension context m r1 -> Suspension context m r2
+delay' f s@Suspension{description= desc, continuation= Get cont}
+ = s{description= "delayed " ++ desc, continuation= Get (f . cont)}
+delay' f s@Suspension{description= desc, continuation= Put x cont}
+ = s{description= "delayed " ++ desc, continuation= Put x (f . cont)}
+delay' f s@Suspension{description= desc, continuation= CanPut cont}
+ = s{description= "delayed " ++ desc, continuation= CanPut (f . cont)}
+
+indent 0 = ""
+indent n = ' ' : indent (n `div` 2)
+
+-- | Function 'get' tries to get a value from the given 'Source' argument. The intervening 'Pipe' computations suspend
+-- all the way to the 'pipe' function invocation that created the source. The result of 'get' is 'Nothing' iff the
+-- argument source is empty.
+get :: forall context context' x m r. (Monad m, Typeable x)
+ => Source context' x -> Pipe context m (Maybe x)
+get (Source _ pid desc) = assert (track (indent pid ++ "Get from " ++ desc ++ "@" ++ show pid)) $
+ Pipe (\context pid' clock->
+ assert (track (indent pid ++ "Get<- " ++ desc ++ "@" ++ show pid ++ ":" ++ show clock)) $
+ return $ Suspend context $
+ [Suspension pid clock ("get from " ++ desc ++ "@" ++ show pid ++ ":" ++ show clock) $ Get return])
+
+getSuccess :: forall context context' x m. (Monad m, Typeable x)
+ => Source context' x
+ -> (x -> Pipe context m ()) -- ^ Success continuation
+ -> Pipe context m ()
+getSuccess source succeed = get source >>= maybe (return ()) succeed
+
+-- | Function 'put' tries to put a value into the given sink. The intervening 'Pipe' computations suspend up to the
+-- 'pipe' invocation that has created the argument sink. The result of 'put' indicates whether the operation succeded.
+put :: forall context context' x m r. (Monad m, Typeable x) => Sink context' x -> x -> Pipe context m Bool
+put (Sink _ pid desc) x = assert (track (indent pid ++ "Put into " ++ desc ++ "@" ++ show pid)) $
+ Pipe (\context pid' clock->
+ assert (track (indent pid ++ "Put-> " ++ desc ++ "@" ++ show pid ++ ":" ++ show clock)) $
+ return $ Suspend context $
+ [Suspension pid clock ("put into " ++ desc ++ "@" ++ show pid ++ ":" ++ show clock)
+ (Put x return)])
+
+-- | Function 'canPut' checks if the argument sink accepts values, i.e., whether a 'put' operation would succeed on the
+-- sink.
+canPut :: forall context context' x m r. (Monad m, Typeable x) => Sink context' x -> Pipe context m Bool
+canPut (Sink _ pid desc) = assert (track (indent pid ++ "CanPut into " ++ desc ++ "@" ++ show pid)) $
+ Pipe (\context pid' clock->
+ assert (track (indent pid ++ "CanPut-> " ++ desc ++ "@" ++ show pid ++ ":" ++ show clock)) $
+ return $ Suspend context $
+ [Suspension pid clock ("canPut into " ++ desc ++ "@" ++ show pid ++ ":" ++ show clock)
+ (CanPut return)])
+
+-- | 'pour' copies all data from the /source/ argument into the /sink/ argument, as long as there is anything to copy
+-- and the sink accepts it.
+pour :: forall c c1 c2 x m. (Monad m, Typeable x) => Source c1 x -> Sink c2 x -> Pipe c m ()
+pour source sink = fill'
+ where fill' = canPut sink >>= flip when (getSuccess source (\x-> put sink x >> fill'))
+
+-- | 'tee' is similar to 'pour' except it distributes every input value from the /source/ arguments into both /sink1/
+-- and /sink2/.
+tee :: (Monad m, Typeable x) => Source c1 x -> Sink c2 x -> Sink c3 x -> Pipe c m ()
+tee source sink1 sink2 = distribute
+ where distribute = do c1 <- canPut sink1
+ c2 <- canPut sink2
+ when (c1 && c2) (getSuccess source $ \x-> put sink1 x >> put sink2 x >> distribute)
+
+-- | 'putList' puts entire list into its /sink/ argument, as long as the sink accepts it. The remainder that wasn't
+-- accepted by the sink is the result value.
+putList :: forall x c c1 m. (Monad m, Typeable x) => [x] -> Sink c1 x -> Pipe c m [x]
+putList [] sink = return []
+putList l@(x:rest) sink = put sink x >>= cond (putList rest sink) (return l)
+
+-- | 'getList' returns the list of all values generated by the source.
+getList :: forall x c c1 m. (Monad m, Typeable x) => Source c1 x -> Pipe c m [x]
+getList source = get source >>= maybe (return []) (\x-> liftM (x:) (getList source))
+
+-- | 'consumeAndSuppress' consumes the entire source ignoring the values it generates.
+consumeAndSuppress :: forall x c c1 m. (Monad m, Typeable x) => Source c1 x -> Pipe c m ()
+consumeAndSuppress source = getSuccess source (\x-> consumeAndSuppress source)
+
+-- | A utility function wrapping if-then-else, useful for handling monadic truth values
+cond :: a -> a -> Bool -> a
+cond x y test = if test then x else y
+
+-- | A utility function, useful for handling monadic list values where empty list means success
+whenNull :: forall a m. Monad m => m [a] -> [a] -> m [a]
+whenNull action list = if null list then action else return list
+
+track :: String -> Bool
+track message = True
diff --git a/LICENSE.txt b/LICENSE.txt
new file mode 100644
--- /dev/null
+++ b/LICENSE.txt
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+
+ Copyright (C)
+
+ This program 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.
+
+ This program 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 this program. If not, see .
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ Copyright (C)
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+.
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,23 @@
+SourceFiles=$(addprefix Control/Concurrent/SCC/, Foundation.hs ComponentTypes.hs Components.hs Combinators.hs) Test.hs Shell.hs
+DocumentationFiles=$(shell echo $(SourceFiles) | ./shsh -c 'stdin | select (>! (substring " Shell.hs" >| substring " Test.hs"))')
+
+all: test test-prof shsh shsh-prof docs
+docs: doc/index.html
+
+test: $(SourceFiles)
+ ghc --make Test.hs -main-is Test -O -o test -hidir obj -odir obj
+
+test-prof: $(SourceFiles)
+ ghc --make Test.hs -main-is Test -o test-prof -prof -auto-all -hidir prof -odir prof
+
+shsh: $(SourceFiles)
+ ghc --make Shell.hs -O -o shsh -hidir obj -odir obj
+
+shsh-prof: $(SourceFiles)
+ ghc --make Shell.hs -main-is Shell -o shsh-prof -prof -auto-all -hidir prof -odir prof
+
+doc/index.html: $(DocumentationFiles)
+ haddock -h -o doc $^
+
+clean:
+ rm obj/* prof/* doc/*
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,4 @@
+#! /usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
diff --git a/Shell.hs b/Shell.hs
new file mode 100644
--- /dev/null
+++ b/Shell.hs
@@ -0,0 +1,746 @@
+{-
+ Copyright 2008 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
+ .
+-}
+
+{-# LANGUAGE ScopedTypeVariables, Rank2Types, GADTs, PatternSignatures #-}
+
+module Main where
+
+import Prelude hiding ((&&), (||), appendFile, interact, last)
+import Data.List (intersperse)
+import Data.Maybe (fromJust)
+import Data.Typeable (Typeable)
+import Control.Monad (liftM, when)
+import Text.ParserCombinators.Parsec hiding (between, count)
+import Text.ParserCombinators.Parsec.Language (emptyDef)
+import Text.ParserCombinators.Parsec.Token
+import System.Console.GetOpt
+import System.Console.Readline
+import System.Environment (getArgs)
+import System.IO (hFlush, hPutStrLn, stderr, stdout)
+import System.Process (runCommand, runInteractiveCommand)
+
+import Control.Concurrent.SCC.Foundation
+import Control.Concurrent.SCC.ComponentTypes
+import Control.Concurrent.SCC.Components
+import Control.Concurrent.SCC.Combinators
+
+data VoidExpression where
+ NativeVoidCommand :: String -> VoidExpression
+ VoidPipe :: Typeable x => ProducerExpression x -> ConsumerExpression x -> VoidExpression
+ Exit :: VoidExpression
+
+data ProducerExpression x where
+ PrimitiveProducer :: Typeable x => String -> Producer IO x () -> ProducerExpression x
+ NativeProducerCommand :: String -> ProducerExpression Char
+ VoidSource :: Typeable x => VoidExpression -> ProducerExpression x
+ ProducerPipe :: (Typeable x, Typeable y) => ProducerExpression x -> TransducerExpression x y -> ProducerExpression y
+ FileSource :: String -> ProducerExpression Char
+ StdInSource :: ProducerExpression Char
+ Sequence :: Typeable x => ProducerExpression x -> ProducerExpression x -> ProducerExpression x
+
+data ConsumerExpression x where
+ NativeConsumerCommand :: String -> ConsumerExpression Char
+ VoidSink :: Typeable x => VoidExpression -> ConsumerExpression x
+ ConsumerPipe :: (Typeable x, Typeable y) => TransducerExpression x y -> ConsumerExpression y -> ConsumerExpression x
+ FileSink :: String -> ConsumerExpression Char
+ FileAppendSink :: String -> ConsumerExpression Char
+ SuppressingConsumer :: Typeable x => ConsumerExpression x
+ ErrorSink :: Typeable x => String -> ConsumerExpression x
+ Tee :: Typeable x => ConsumerExpression x -> ConsumerExpression x -> ConsumerExpression x
+
+data TransducerExpression x y where
+ PrimitiveTransducer :: (Typeable x, Typeable y) => String -> Transducer IO x y -> TransducerExpression x y
+ NativeTransducerCommand :: String -> TransducerExpression Char Char
+ TransducerPipe :: (Typeable x, Typeable y, Typeable z)
+ => TransducerExpression x y -> TransducerExpression y z -> TransducerExpression x z
+ TransducerJoin :: (Typeable x, Typeable y) => TransducerExpression x y -> TransducerExpression x y -> TransducerExpression x y
+ Select :: Typeable x => SplitterExpression x -> TransducerExpression x x
+ If :: (Typeable x, Typeable y)
+ => SplitterExpression x -> TransducerExpression x y -> TransducerExpression x y -> TransducerExpression x y
+ While :: Typeable x => SplitterExpression x -> TransducerExpression x x -> TransducerExpression x x
+ ForEach :: (Typeable x, Typeable y)
+ => SplitterExpression x -> TransducerExpression x y -> TransducerExpression x y -> TransducerExpression x y
+
+data SplitterExpression x where
+ PrimitiveSplitter :: Typeable x => String -> Splitter IO x -> SplitterExpression x
+ And :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ Or :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ ZipWithAnd :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ ZipWithOr :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ Not :: Typeable x => SplitterExpression x -> SplitterExpression x
+ FollowedBy :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ Nested :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ Having :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ HavingOnly :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ Between :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ BetweenInclusive :: Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x
+ First :: Typeable x => SplitterExpression x -> SplitterExpression x
+ Last :: Typeable x => SplitterExpression x -> SplitterExpression x
+ Prefix :: Typeable x => SplitterExpression x -> SplitterExpression x
+ Suffix :: Typeable x => SplitterExpression x -> SplitterExpression x
+
+instance Show VoidExpression where
+ show (NativeVoidCommand cmd) = "NativeVoidCommand \"" ++ cmd ++ "\""
+ show (VoidPipe p c) = "(VoidPipe " ++ shows p (" " ++ shows c ")")
+ show (Exit) = "Exit"
+
+instance Show (ProducerExpression x) where
+ show (PrimitiveProducer name p) = name
+ show (NativeProducerCommand cmd) = cmd
+ show (VoidSource v) = "(VoidSource " ++ shows v ")"
+ show (ProducerPipe p t) = "(" ++ shows p (" | " ++ shows t ")")
+ show (FileSource f) = "FileSource \"" ++ f ++ "\""
+ show (Sequence p1 p2) = "(Sequence " ++ shows p1 (" "++ shows p2 ")")
+
+instance Show (ConsumerExpression x) where
+ show (NativeConsumerCommand cmd) = cmd
+ show (VoidSink v) = "(VoidSink " ++ shows v ")"
+ show (ConsumerPipe t c) = "(ConsumerPipe " ++ shows t (" " ++ shows c ")")
+ show (FileSink f) = "> \"" ++ f ++ "\""
+ show (FileAppendSink f) = ">> \"" ++ f ++ "\""
+ show (SuppressingConsumer) = "SuppressingConsumer"
+ show (ErrorSink e) = "ErrorSink \"" ++ e ++ "\""
+ show (Tee c1 c2) = "(" ++ shows c1 (" tee " ++ shows c2 ")")
+
+instance Show (TransducerExpression x y) where
+ show (PrimitiveTransducer name t) = name
+ show (NativeTransducerCommand cmd) = cmd
+ show (TransducerPipe t1 t2) = "(" ++ shows t1 (" | " ++ shows t2 ")")
+ show (TransducerJoin t1 t2) = "(" ++ shows t1 (" >< " ++ shows t2 ")")
+ show (Select s) = "(select " ++ shows s ")"
+ show (If s t1 t2) = "if " ++ shows s (" then " ++ shows t1 (" else " ++ shows t2 " end if"))
+ show (While s t) = "while " ++ shows s (" do " ++ shows t " end while")
+ show (ForEach s t1 t2) = "foreach " ++ shows s (" then " ++ shows t1 (" else " ++ shows t2 " end foreach"))
+
+instance Show (SplitterExpression x) where
+ show (PrimitiveSplitter name s) = name
+ show (And s1 s2) = shows s1 (" >& " ++ show s2)
+ show (Or s1 s2) = shows s1 (" >| " ++ show s2)
+ show (ZipWithAnd s1 s2) = shows s1 (" >& " ++ show s2)
+ show (ZipWithOr s1 s2) = shows s1 (" >| " ++ show s2)
+ show (FollowedBy s1 s2) = shows s1 (", " ++ show s2)
+ show (Not s) = "Not " ++ show s
+ show (Nested s1 s2) = shows s1 (" nested in " ++ show s2)
+ show (Having s1 s2) = shows s1 (" having " ++ show s2)
+ show (HavingOnly s1 s2) = shows s1 (" having-only " ++ show s2)
+ show (Between s1 s2) = shows s1 (" having " ++ show s2)
+ show (BetweenInclusive s1 s2) = shows s1 (" having " ++ show s2)
+ show (First s) = "first " ++ show s
+ show (Last s) = "last " ++ show s
+ show (Prefix s) = "prefix " ++ show s
+ show (Suffix s) = "suffix " ++ show s
+
+data TaggedExpression where
+ TaggedCommand :: VoidExpression -> TaggedExpression
+ TaggedConsumer :: Typeable x => TypeTag x -> ConsumerExpression x -> TaggedExpression
+ TaggedProducer :: Typeable x => TypeTag x -> ProducerExpression x -> TaggedExpression
+ TaggedSplitter :: Typeable x => TypeTag x -> SplitterExpression x -> TaggedExpression
+ TaggedTransducer :: (Typeable x, Typeable y) => TypeTag x -> TypeTag y -> TransducerExpression x y -> TaggedExpression
+ GenericInputExpression :: (forall x. Typeable x => TypeTag x -> TaggedExpression) -> TaggedExpression
+ TypeErrorExpression :: TypeTag x -> TypeTag y -> String -> TaggedExpression
+
+instance Show TaggedExpression where
+ show (TaggedCommand e) = "TaggedCommand " ++ show e
+ show (TaggedConsumer tag e) = "TaggedConsumer " ++ shows e (" :: " ++ show tag)
+ show (TaggedProducer tag e) = "TaggedProducer " ++ shows e (" :: " ++ show tag)
+ show (TaggedSplitter tag e) = "TaggedSplitter " ++ shows e (" :: " ++ show tag)
+ show (TaggedTransducer tag1 tag2 e) = "TaggedSplitter " ++ shows e (" :: " ++ show tag1 ++ " -> " ++ show tag2)
+ show (TypeErrorExpression tag1 tag2 s) = "TypeError " ++ shows s (" :: " ++ show tag1 ++ " -> " ++ show tag2)
+ show GenericInputExpression{} = "Cannot show a generic expression!"
+
+data TypeTag x where
+ AnyTag :: TypeTag ()
+ ShowableTag :: (Typeable x, Show x) => TypeTag x
+ CharTag :: TypeTag Char
+ IntTag :: TypeTag Integer
+ ListTag :: Typeable x => TypeTag x -> TypeTag [x]
+ PairTag :: TypeTag x -> TypeTag y -> TypeTag (x, y)
+
+instance Show (TypeTag x) where
+ show AnyTag = "Any"
+ show CharTag = "Char"
+ show IntTag = "Int"
+ show (ListTag x) = '[' : shows x "]"
+ show (PairTag x y) = "(" ++ shows x (", " ++ shows y ")")
+
+-- we use Weirich's higher-order type-safe cast to avoid deep traversals
+-- one can replace the type_cast with a more simple traversal-based
+-- version.
+
+data CList c a = CList (c [a])
+data CFlip c b a = CFlip (c a b)
+data CL c a d = CL (c (d,a))
+data CR c a d = CR (c (a,d))
+
+typecast :: forall a b c. TypeTag a -> TypeTag b -> c a -> Maybe (c b)
+typecast CharTag CharTag x = Just x
+typecast IntTag IntTag x = Just x
+typecast (ListTag a) (ListTag b) x = fmap (\(CList y)-> y) (typecast a b (CList x))
+typecast (PairTag (ra::TypeTag a0) (rb::TypeTag b0)) (PairTag (ra'::TypeTag a0') (rb'::TypeTag b0')) x =
+ let g = (typecast ra ra' :: (CL c b0) a0 -> Maybe ((CL c b0) a0'))
+ h = (typecast rb rb' :: (CR c a0') b0 -> Maybe ((CR c a0') b0'))
+ in case g (CL x)
+ of Just (CL x') -> case h (CR x')
+ of Just (CR y') -> Just y'
+typecast _ _ _ = Nothing
+
+typecast2 :: forall a a' b b' c. TypeTag a -> TypeTag b -> TypeTag a' -> TypeTag b' -> c a b -> Maybe (c a' b')
+typecast2 a b a' b' x = typecast a a' (CFlip x) >>= \(CFlip x')-> typecast b b' x'
+
+trycast :: forall a b c. Show (c a) => TypeTag a -> TypeTag b -> (c b -> TaggedExpression) -> c a -> TaggedExpression
+trycast a b wrap x = case typecast a b x of Just y -> wrap y
+ Nothing -> TypeErrorExpression a b (show x)
+
+data Flag = Command | Help | Interactive | ScriptFile String | StandardInput
+ deriving Eq
+
+options = [Option "c" ["command"] (NoArg Command) "Execute a single command",
+ Option "h" ["help"] (NoArg Help) "Show help",
+ Option "f" ["file"] (ReqArg ScriptFile "file") "Execute commands from a script file",
+ Option "i" ["interactive"] (NoArg Interactive) "Execute commands interactively",
+ Option "s" ["stdin"] (NoArg StandardInput) "Execute commands from the standard input"]
+
+usageSyntax = "Usage: shsh (-c | -f | -i | -s) "
+
+main = do args <- getArgs
+ case getOpt Permute options args
+ of (_, _, errors) | not (null errors) -> putStr (concat errors)
+ (option, _, []) | Help `elem` option -> showHelp
+ (options, arguments, []) | Command `elem` options -> interpret (concat (intersperse " " arguments)) >> return ()
+ ([ScriptFile name], [], []) -> readFile name >>= interpret >> return ()
+ ([Interactive], [], []) -> interact
+ ([StandardInput], [], []) -> getContents >>= interpret >> return ()
+ _ -> showHelp
+
+showHelp = putStrLn (usageInfo usageSyntax options)
+
+interact = do Just command <- readline "> "
+ addHistory command
+ finish <- interpret command
+ when (not finish) interact
+
+interpret command = case parseExpression command
+ of Left position -> putStrLn ("Error at " ++ show position) >> return False
+ Right (TaggedCommand Exit, "", _) -> return True
+ Right (expression, "", _) -> execute expression >> return False
+ Right (expression, rest, _) -> putStrLn ("Cannot parse " ++ show rest) >> return False
+
+
+execute :: TaggedExpression -> IO ()
+execute (TaggedCommand command) = runPipes (evaluateVoidExpression command)
+execute (TaggedProducer CharTag producer) = liftM fst (runPipes (pipe (evaluateProducerExpression producer) toStdOut))
+ >> hFlush stdout
+execute (TaggedProducer tag _) = hPutStrLn stderr ("Expecting a Char Producer, received a " ++ shows tag " producer.")
+execute (TypeErrorExpression tag1 tag2 e) = hPutStrLn stderr ("Expecting " ++ show tag2 ++ ", received " ++ show tag1
+ ++ " in expression " ++ e)
+
+evaluateConsumerExpression :: Typeable x => ConsumerExpression x -> Consumer IO x ()
+evaluateConsumerExpression (NativeConsumerCommand command) =
+ \source-> do (stdin, _, _, pid) <- liftPipe (runInteractiveCommand command)
+ toHandle stdin source
+evaluateConsumerExpression (ConsumerPipe filter sink) = evaluateTransducerExpression filter ->> evaluateConsumerExpression sink
+evaluateConsumerExpression (FileSink path) = toFile path
+evaluateConsumerExpression (FileAppendSink path) = appendFile path
+evaluateConsumerExpression SuppressingConsumer = consumeAndSuppress
+evaluateConsumerExpression (ErrorSink message) = undefined
+evaluateConsumerExpression (Tee ce1 ce2) = \source-> pipe (\sink1-> pipe (\sink2-> tee source sink1 sink2)
+ (evaluateConsumerExpression ce2)
+ )
+ (evaluateConsumerExpression ce1)
+ >> return ()
+
+evaluateProducerExpression :: Typeable x => ProducerExpression x -> Producer IO x ()
+evaluateProducerExpression (PrimitiveProducer _ producer) = producer
+evaluateProducerExpression (NativeProducerCommand command) =
+ \sink-> do (_, stdout, _, pid) <- liftPipe (runInteractiveCommand command)
+ fromHandle stdout sink
+evaluateProducerExpression (ProducerPipe source filter) = evaluateTransducerExpression filter <<- evaluateProducerExpression source
+evaluateProducerExpression (FileSource path) = fromFile path
+evaluateProducerExpression StdInSource = fromStdIn
+
+evaluateVoidExpression :: VoidExpression -> Pipe c IO ()
+evaluateVoidExpression (NativeVoidCommand command) = liftPipe (runCommand command >> return ())
+evaluateVoidExpression (VoidPipe source sink) =
+ do pipe (evaluateProducerExpression source) (evaluateConsumerExpression sink)
+ return ()
+
+evaluateTransducerExpression :: (Typeable x, Typeable y) => TransducerExpression x y -> Transducer IO x y
+evaluateTransducerExpression (PrimitiveTransducer _ filter) = filter
+evaluateTransducerExpression (NativeTransducerCommand command) = Transducer f
+ where f source sink = do (stdin, stdout, _, pid) <- liftPipe (runInteractiveCommand command)
+ interleavedPour source (toHandle stdin) (fromHandle stdout) sink
+ return []
+
+ interleavedPour :: forall c c1 c2 m x y. (Monad m, Typeable x, Typeable y)
+ => Source c1 x -> Consumer m x () -> Producer m y () -> Sink c2 y -> Pipe c m ()
+ interleavedPour source consumer producer sink = pipe (\sink-> pipe producer (interleave sink)) consumer
+ >> return ()
+ where interleave consumerSink producerSource = interleave1
+ where interleave1 = canPut consumerSink
+ >>= flip when (get source >>= maybe interleaveEnd (\x-> put consumerSink x >> interleave2))
+ interleave2 = canPut sink
+ >>= flip when (getSuccess producerSource (\y-> put sink y >> interleave1))
+ interleaveEnd = canPut sink
+ >>= flip when (getSuccess producerSource (\y-> put sink y >> interleaveEnd))
+
+evaluateTransducerExpression (TransducerPipe f1 f2) = evaluateTransducerExpression f1 >-> evaluateTransducerExpression f2
+evaluateTransducerExpression (TransducerJoin f1 f2) = evaluateTransducerExpression f1 `join` evaluateTransducerExpression f2
+evaluateTransducerExpression (Select splitter) = select (evaluateSplitterExpression splitter)
+evaluateTransducerExpression (If splitter f1 f2) =
+ ifs (evaluateSplitterExpression splitter) (evaluateTransducerExpression f1) (evaluateTransducerExpression f2)
+evaluateTransducerExpression (While splitter filter) =
+ evaluateTransducerExpression filter `while` evaluateSplitterExpression splitter
+evaluateTransducerExpression (ForEach splitter f1 f2) =
+ foreach (evaluateSplitterExpression splitter) (evaluateTransducerExpression f1) (evaluateTransducerExpression f2)
+
+evaluateSplitterExpression :: Typeable x => SplitterExpression x -> Splitter IO x
+evaluateSplitterExpression (PrimitiveSplitter _ splitter) = splitter
+evaluateSplitterExpression (FollowedBy s1 s2) = evaluateSplitterExpression s1 `followedBy` evaluateSplitterExpression s2
+evaluateSplitterExpression (And s1 s2) = evaluateSplitterExpression s1 >& evaluateSplitterExpression s2
+evaluateSplitterExpression (Or s1 s2) = evaluateSplitterExpression s1 >| evaluateSplitterExpression s2
+evaluateSplitterExpression (ZipWithAnd s1 s2) = evaluateSplitterExpression s1 && evaluateSplitterExpression s2
+evaluateSplitterExpression (ZipWithOr s1 s2) = evaluateSplitterExpression s1 || evaluateSplitterExpression s2
+evaluateSplitterExpression (Not splitter) = snot (evaluateSplitterExpression splitter)
+evaluateSplitterExpression (Nested s1 s2) = evaluateSplitterExpression s1 `nestedIn` evaluateSplitterExpression s2
+evaluateSplitterExpression (Having s1 s2) = evaluateSplitterExpression s1 `having` evaluateSplitterExpression s2
+evaluateSplitterExpression (HavingOnly s1 s2) = evaluateSplitterExpression s1 `havingOnly` evaluateSplitterExpression s2
+evaluateSplitterExpression (Between s1 s2) = evaluateSplitterExpression s1 `between` evaluateSplitterExpression s2
+evaluateSplitterExpression (BetweenInclusive s1 s2) = evaluateSplitterExpression s1 ... evaluateSplitterExpression s2
+evaluateSplitterExpression (First splitter) = first (evaluateSplitterExpression splitter)
+evaluateSplitterExpression (Last splitter) = last (evaluateSplitterExpression splitter)
+evaluateSplitterExpression (Prefix splitter) = prefix (evaluateSplitterExpression splitter)
+evaluateSplitterExpression (Suffix splitter) = suffix (evaluateSplitterExpression splitter)
+
+specialize :: Typeable x => TypeTag x -> Parser TaggedExpression -> Parser TaggedExpression
+specialize tag parser = do e <- parser
+ return (case e
+ of GenericInputExpression g -> g tag
+ _ -> e)
+
+combineTransducers :: (forall x y. (Typeable x, Typeable y)
+ => TypeTag x -> TypeTag y -> TransducerExpression x y -> TransducerExpression x y
+ -> TransducerExpression x y)
+ -> TaggedExpression -> TaggedExpression -> TaggedExpression
+combineTransducers combinator e1 e2 =
+ case (e1, e2)
+ of (TaggedTransducer tag1 tag2 t1, TaggedTransducer tag1' tag2' t2) ->
+ case typecast2 tag1' tag2' tag1 tag2 t2
+ of Just t2' -> TaggedTransducer tag1 tag2 (combinator tag1 tag2 t1 t2')
+ Nothing -> TypeErrorExpression tag2' tag2 (show t1)
+ (GenericInputExpression ge, TaggedTransducer tag1 _ _) -> combineTransducers combinator (ge tag1) e2
+ (TaggedTransducer tag1 _ _, GenericInputExpression ge) -> combineTransducers combinator e1 (ge tag1)
+ (GenericInputExpression g1, GenericInputExpression g2)
+ -> GenericInputExpression (\tag-> combineTransducers combinator (g1 tag) (g2 tag))
+ (TypeErrorExpression{}, _) -> e1
+ (_, TypeErrorExpression{}) -> e2
+
+foldPipeline :: [TaggedExpression] -> TaggedExpression
+foldPipeline list = foldl1 combine list
+ where combine :: TaggedExpression -> TaggedExpression -> TaggedExpression
+ combine (TaggedProducer tag p) (TaggedTransducer tag1 tag2 t)
+ = trycast tag tag1 (\p'-> TaggedProducer tag2 (ProducerPipe p' t)) p
+ combine (TaggedTransducer tag1 tag2 t1) (TaggedTransducer tag1' tag2' t2)
+ = trycast tag2 tag1' (\t1'-> TaggedTransducer tag1 tag2' (TransducerPipe t1' t2)) t1
+ combine p@(TaggedProducer tag _) (GenericInputExpression ge) = combine p (ge tag)
+ combine (GenericInputExpression ge) other = GenericInputExpression (\tag-> combine (ge tag) other)
+ combine t@(TaggedTransducer tag1 tag2 _) (GenericInputExpression ge) = combine t (ge tag2)
+ combine e@TypeErrorExpression{} _ = e
+ combine _ e@TypeErrorExpression{} = e
+
+parseExpression :: String -> Either Int (TaggedExpression, [Char], Int)
+parseExpression s = case parse partialExpressionParser "" s of
+ Left error -> Left (sourceLine (errorPos error))
+ Right result -> Right result
+
+lexer = (makeTokenParser emptyDef{commentLine= "#"}){stringLiteral= stringLexemeParser}
+
+partialExpressionParser :: Parser (TaggedExpression, [Char], Int)
+partialExpressionParser = do whiteSpace lexer
+ t <- expressionParser
+ rest <- getInput
+ pos <- getPosition
+ return (t, rest, sourceLine pos - 1)
+
+expressionParser :: Parser TaggedExpression
+expressionParser = do tp@(TaggedProducer tag producer) <- producerPrimaryParser
+ whiteSpace lexer
+ transducers <- many (try (char '|' >> whiteSpace lexer >> transducerPrimaryParser))
+ let tpt = foldPipeline (tp:transducers)
+ whiteSpace lexer
+ option tpt (liftM ((,) tpt) (try (char '|' >> whiteSpace lexer >> specialize tag consumerPrimaryParser))
+ >>= \(TaggedTransducer tag1 tag2 transducer, TaggedConsumer tag' consumer)
+ -> return (trycast tag tag' (\p'-> TaggedCommand (VoidPipe p' consumer)) producer))
+
+producerExpressionParser :: Parser TaggedExpression
+producerExpressionParser = do tp@(TaggedProducer tag producer) <- producerPrimaryParser
+ whiteSpace lexer
+ (try (do char '|'
+ whiteSpace lexer
+ TaggedTransducer tag1 tag2 transducer <- transducerExpressionParser
+ return (trycast tag tag1 (\p'-> TaggedProducer tag2 (ProducerPipe p' transducer)) producer))
+ <|>
+ return tp)
+
+consumerExpressionParser :: Parser TaggedExpression
+consumerExpressionParser = try consumerForkParser
+ <|>
+ do TaggedTransducer tag1 tag2 transducer <- transducerExpressionParser
+ whiteSpace lexer
+ char '|'
+ TaggedConsumer tag' consumer <- consumerForkParser
+ return (trycast tag' tag2 (TaggedConsumer tag1 . ConsumerPipe transducer) consumer)
+
+consumerForkParser :: Parser TaggedExpression
+consumerForkParser = do tc@(TaggedConsumer tag first) <- consumerPrimaryParser
+ whiteSpace lexer
+ (try (do symbol lexer "tee"
+ TaggedConsumer tag' rest <- consumerForkParser
+ return (trycast tag tag' (\first'-> TaggedConsumer tag' (Tee first' rest)) first))
+ <|>
+ return tc)
+
+voidPrimaryParser = try (symbol lexer "exit" >> return Exit)
+ <|> liftM NativeVoidCommand nativeCommand
+
+producerPrimaryParser :: Parser TaggedExpression
+producerPrimaryParser = try (do char '('
+ whiteSpace lexer
+ (try (do command <- nativeCommand
+ whiteSpace lexer
+ char ')'
+ whiteSpace lexer
+ char '>'
+ return (TaggedProducer CharTag (NativeProducerCommand command)))
+ <|>
+ do source <- producerExpressionParser
+ whiteSpace lexer
+ char ')'
+ return source))
+ <|> try (nativeSourceParser "cat")
+-- <|> try (nativeSourceParser "echo")
+ <|> try (do symbol lexer "echo"
+ string <- parameterParser True
+ return (TaggedProducer CharTag $
+ PrimitiveProducer ("echo " ++ string) (\sink-> putList string sink >> return ())))
+ <|> try (symbol lexer "stdin" >> return (TaggedProducer CharTag StdInSource))
+ <|> nativeSourceParser "ls"
+
+nativeSourceParser :: String -> Parser TaggedExpression
+nativeSourceParser command = do symbol lexer command
+ params <- nativeCommand
+ return (TaggedProducer CharTag (NativeProducerCommand (command ++ " " ++ params)))
+
+consumerPrimaryParser :: Parser TaggedExpression
+consumerPrimaryParser = try (do symbol lexer ">>"
+ file <- parameterParser True
+ return (TaggedConsumer CharTag (FileAppendSink file)))
+ <|>
+ try (do symbol lexer ">"
+ symbol lexer "("
+ command <- nativeCommand
+ whiteSpace lexer
+ symbol lexer ")"
+ return (TaggedConsumer CharTag (NativeConsumerCommand command)))
+ <|>
+ try (do symbol lexer ">"
+ file <- parameterParser True
+ return (TaggedConsumer CharTag (FileSink file)))
+ <|>
+ try (do symbol lexer "null"
+ return (GenericInputExpression ((\tag-> TaggedConsumer tag SuppressingConsumer))))
+ <|>
+ do symbol lexer "error"
+ message <- (try (parameterParser True) <|> return "Error sink reached!")
+ return (GenericInputExpression (\tag-> TaggedConsumer tag (ErrorSink message)))
+
+transducerExpressionParser :: Parser TaggedExpression
+transducerExpressionParser = do first <- transducerPrimaryParser
+ (try (do rest <- many1 (try (whiteSpace lexer >> symbol lexer "|" >> transducerPrimaryParser))
+ return (foldPipeline (first:rest)))
+ <|>
+ try (do rest <- many1 (try (whiteSpace lexer >> symbol lexer "><" >> transducerPrimaryParser))
+ return (foldr1 (combineTransducers (const $ const TransducerJoin)) (first:rest)))
+ <|>
+ return first)
+ where tagged :: (forall x y. (Typeable x, Typeable y)
+ => TransducerExpression x y -> TransducerExpression x y -> TransducerExpression x y)
+ -> TaggedExpression -> TaggedExpression -> TaggedExpression
+ tagged combinator (TaggedTransducer tag1 tag2 t1) (TaggedTransducer tag1' tag2' t2)
+ = case typecast2 tag1 tag2 tag1' tag2' t1 of Just t1' -> TaggedTransducer tag1' tag2' (combinator t1' t2)
+ Nothing -> TypeErrorExpression tag1 tag1' (show t1)
+
+splitterExpressionParser :: Parser TaggedExpression
+splitterExpressionParser = do first@(TaggedSplitter tag one) <- splitterPrimaryParser
+ whiteSpace lexer
+ (try (do rest <- many1 (try (symbol lexer ">," >> splitterPrimaryParser))
+ return (foldr1 (tagged FollowedBy) (first:rest)))
+ <|>
+ try (do rest <- many1 (try (symbol lexer ">|" >> splitterPrimaryParser))
+ return (foldr1 (tagged Or) (first:rest)))
+ <|>
+ try (do rest <- many1 (try (symbol lexer ">&" >> splitterPrimaryParser))
+ return (foldr1 (tagged And) (first:rest)))
+ <|>
+ try (do rest <- many1 (try (symbol lexer "||" >> splitterPrimaryParser))
+ return (foldr1 (tagged ZipWithOr) (first:rest)))
+ <|>
+ try (do rest <- many1 (try (symbol lexer "&&" >> splitterPrimaryParser))
+ return (foldr1 (tagged ZipWithAnd) (first:rest)))
+ <|>
+ try (do rest <- many1 (try (symbol lexer "..." >> splitterPrimaryParser))
+ return (foldr1 (tagged BetweenInclusive) (first:rest)))
+ <|>
+ try (do symbol lexer "having"
+ TaggedSplitter tag' other <- splitterPrimaryParser
+ return (trycast tag tag' (\one'-> TaggedSplitter tag' (Having one' other)) one))
+ <|>
+ try (do symbol lexer "having-only"
+ TaggedSplitter tag' other <- splitterPrimaryParser
+ return (trycast tag tag' (\one'-> TaggedSplitter tag' (HavingOnly one' other)) one))
+ <|>
+ return first)
+ where tagged :: (forall x. Typeable x => SplitterExpression x -> SplitterExpression x -> SplitterExpression x)
+ -> TaggedExpression -> TaggedExpression -> TaggedExpression
+ tagged combinator (TaggedSplitter tag1 s1) (TaggedSplitter tag2 s2)
+ = trycast tag1 tag2 (\s1'-> TaggedSplitter tag2 (combinator s1' s2)) s1
+
+transducerPrimaryParser :: Parser TaggedExpression
+transducerPrimaryParser = try (do symbol lexer "("
+ filter <- transducerExpressionParser
+ symbol lexer ")"
+ return filter)
+ <|>
+ try (do symbol lexer "id"
+ return (GenericInputExpression (\tag-> TaggedTransducer tag tag (PrimitiveTransducer "id" asis))))
+ <|>
+ try (do symbol lexer "suppress"
+ return (GenericInputExpression (\tag-> TaggedTransducer tag tag (PrimitiveTransducer "suppress" suppress))))
+ <|>
+ try (do symbol lexer "uppercase"
+ return (TaggedTransducer CharTag CharTag (PrimitiveTransducer "uppercase" uppercase)))
+ <|>
+ try (do symbol lexer "count"
+ return (GenericInputExpression (\tag-> TaggedTransducer tag IntTag (PrimitiveTransducer "count" count))))
+ <|>
+ try (do symbol lexer "show"
+ return (TaggedTransducer IntTag (ListTag CharTag) (PrimitiveTransducer "show" toString)))
+ <|>
+ try (do symbol lexer "concatenate"
+ return (GenericInputExpression $
+ \tag-> case tag
+ of ListTag tag'
+ -> TaggedTransducer tag tag' (PrimitiveTransducer "concatenate" concatenate)
+ _ -> TypeErrorExpression tag (ListTag AnyTag) "concatenate"))
+ <|>
+ try (do symbol lexer "group"
+ return (GenericInputExpression $
+ \tag-> TaggedTransducer tag (ListTag tag) (PrimitiveTransducer "group" group)))
+ <|>
+ try (do symbol lexer "prepend"
+ prefix <- parameterParser True
+ return (TaggedTransducer CharTag CharTag (PrimitiveTransducer ("prepend " ++ prefix) (prepend prefix))))
+ <|>
+ try (do symbol lexer "append"
+ suffix <- parameterParser True
+ return (TaggedTransducer CharTag CharTag (PrimitiveTransducer ("append " ++ suffix) (append suffix))))
+ <|>
+ try (do symbol lexer "substitute"
+ replacement <- parameterParser True
+ return (TaggedTransducer CharTag CharTag
+ (PrimitiveTransducer ("substitute " ++ replacement) (substitute replacement))))
+ <|>
+ try (do symbol lexer "select"
+ TaggedSplitter tag splitter <- splitterPrimaryParser
+ return (TaggedTransducer tag tag (Select splitter)))
+ <|>
+ try (do symbol lexer "if"
+ TaggedSplitter tag splitter <- splitterExpressionParser
+ whiteSpace lexer
+ symbol lexer "then"
+ true <- transducerExpressionParser
+ false <- (try (symbol lexer "else" >> transducerExpressionParser)
+ <|> return (TaggedTransducer tag tag (PrimitiveTransducer "id" asis)))
+ symbol lexer "end"
+ option "" (symbol lexer "if")
+ return (combineBranches (If splitter) tag true false))
+ <|>
+ try (do symbol lexer "while"
+ TaggedSplitter tag splitter <- splitterExpressionParser
+ whiteSpace lexer
+ symbol lexer "do"
+ TaggedTransducer tag' tag'' body <- transducerExpressionParser
+ whiteSpace lexer
+ symbol lexer "end"
+ option "" (symbol lexer "while")
+ return (case (typecast tag tag' splitter, typecast tag'' tag' body)
+ of (Just test, Just body) -> TaggedTransducer tag' tag' (While test body)))
+ <|>
+ try (do symbol lexer "foreach"
+ TaggedSplitter tag splitter <- splitterExpressionParser
+ whiteSpace lexer
+ symbol lexer "then"
+ trueBranch <- transducerExpressionParser
+ whiteSpace lexer
+ falseBranch <- (try (symbol lexer "else" >> transducerExpressionParser)
+ <|> return (TaggedTransducer tag tag (PrimitiveTransducer "id" asis)))
+ whiteSpace lexer
+ symbol lexer "end"
+ option "" (symbol lexer "foreach")
+ return (combineBranches (ForEach splitter) tag trueBranch falseBranch))
+ <|>
+ liftM (TaggedTransducer CharTag CharTag . NativeTransducerCommand) nativeCommand
+
+combineBranches :: forall x. Typeable x
+ => (forall y. Typeable y => TransducerExpression x y -> TransducerExpression x y -> TransducerExpression x y)
+ -> TypeTag x -> TaggedExpression -> TaggedExpression -> TaggedExpression
+combineBranches combinator tag b1 b2 =
+ case (b1, b2)
+ of (TaggedTransducer tag1 tag2 true, TaggedTransducer tag1' tag2' false) ->
+ case (typecast2 tag1 tag2 tag tag2 true, typecast2 tag1' tag2' tag tag2 false)
+ of (Just true', Just false') -> TaggedTransducer tag tag2 (combinator true' false')
+ (Nothing, _) -> TypeErrorExpression tag1 tag (show true)
+ (_, Nothing) -> TypeErrorExpression tag2' tag2 (show true)
+ (GenericInputExpression ge, _) -> combineBranches combinator tag (ge tag) b2
+ (_, GenericInputExpression ge) -> combineBranches combinator tag b1 (ge tag)
+ (TypeErrorExpression{}, _) -> b1
+ (_, TypeErrorExpression{}) -> b2
+
+splitterPrimaryParser :: Parser TaggedExpression
+splitterPrimaryParser = try (do symbol lexer "("
+ splitter <- splitterExpressionParser
+ symbol lexer ")"
+ return splitter)
+ <|>
+ try (do symbol lexer ">!"
+ TaggedSplitter tag splitter <- splitterPrimaryParser
+ return (TaggedSplitter tag (Not splitter)))
+ <|>
+ try (do symbol lexer "prefix"
+ TaggedSplitter tag splitter <- splitterPrimaryParser
+ return (TaggedSplitter tag (Prefix splitter)))
+ <|>
+ try (do symbol lexer "suffix"
+ TaggedSplitter tag splitter <- splitterPrimaryParser
+ return (TaggedSplitter tag (Suffix splitter)))
+ <|>
+ try (do symbol lexer "first"
+ TaggedSplitter tag splitter <- splitterPrimaryParser
+ return (TaggedSplitter tag (First splitter)))
+ <|>
+ try (do symbol lexer "last"
+ TaggedSplitter tag splitter <- splitterPrimaryParser
+ return (TaggedSplitter tag (Last splitter)))
+ <|>
+ try (do symbol lexer "whitespace"
+ return (TaggedSplitter CharTag (PrimitiveSplitter "whitespace" whitespace)))
+ <|>
+ try (do symbol lexer "line"
+ return (TaggedSplitter CharTag (PrimitiveSplitter "line" line)))
+ <|>
+ try (do symbol lexer "letters"
+ return (TaggedSplitter CharTag (PrimitiveSplitter "letters" letters)))
+ <|>
+ try (do symbol lexer "digits"
+ return (TaggedSplitter CharTag (PrimitiveSplitter "digits" digits)))
+ <|>
+ try (do symbol lexer "substring"
+ part <- parameterParser True
+ return (TaggedSplitter CharTag (PrimitiveSplitter ("substring " ++ part) (substring part))))
+ <|>
+ do symbol lexer "nested"
+ TaggedSplitter tag1 core <- splitterExpressionParser
+ whiteSpace lexer
+ symbol lexer "in"
+ TaggedSplitter tag2 shell <- splitterExpressionParser
+ whiteSpace lexer
+ symbol lexer "end"
+ option "" (symbol lexer "nested")
+ return (trycast tag1 tag2 (\core'-> TaggedSplitter tag2 (Nested core' shell)) core)
+ <|>
+ do symbol lexer "between"
+ TaggedSplitter tag1 left <- splitterExpressionParser
+ whiteSpace lexer
+ symbol lexer "and"
+ TaggedSplitter tag2 right <- splitterExpressionParser
+ whiteSpace lexer
+ symbol lexer "end"
+ option "" (symbol lexer "between")
+ return (trycast tag1 tag2 (\left'-> TaggedSplitter tag2 (Between left' right)) left)
+
+nativeCommand :: Parser String
+nativeCommand = do parts <- many (try (lexeme lexer (parameterParser False)))
+ return (concat (intersperse " " parts))
+
+parameterParser :: Bool -> Parser String
+parameterParser normalize = do chars <- many (noneOf " \t\n'\"`\\()[]{}<>|&")
+ (do try (string "\\n")
+ rest <- (parameterParser normalize <|> return "")
+ return (chars ++ '\n' : rest)
+ <|>
+ do try (string "\\t")
+ rest <- (parameterParser normalize <|> return "")
+ return (chars ++ '\t' : rest)
+ <|>
+ do next <- escape
+ rest <- (parameterParser normalize <|> return "")
+ return (chars ++ next : rest)
+ <|>
+ do quote <- oneOf "'\"`"
+ string <- many (noneOf (quote : "\\") <|> escape)
+ char quote
+ rest <- (parameterParser normalize <|> return "")
+ return (chars ++ (if normalize then string else quote : (string ++ [quote])) ++ rest)
+ <|>
+ do try (char '(')
+ whiteSpace lexer
+ inside <- nativeCommand
+ char ')'
+ rest <- (parameterParser normalize <|> return "")
+ return (chars ++ '(' : inside ++ ')' : rest)
+ <|>
+ do try (char '[')
+ whiteSpace lexer
+ inside <- nativeCommand
+ char ']'
+ rest <- parameterParser normalize
+ return (chars ++ '[' : inside ++ ']' : rest)
+ <|>
+ do try (char '{')
+ whiteSpace lexer
+ inside <- nativeCommand
+ char '}'
+ rest <- (parameterParser normalize <|> return "")
+ return (chars ++ '{' : inside ++ '}' : rest)
+ <|>
+ do when (null chars) pzero
+ return chars)
+
+escape :: Parser Char
+escape = do char '\\'
+ escaped <- anyChar
+ return (case escaped of 'n' -> '\n'
+ 'r' -> '\r'
+ 't' -> '\t'
+ _ -> escaped)
+
+stringLexemeParser :: Parser String
+stringLexemeParser = do terminator <- oneOf "'\"`"
+ content <- many (try (noneOf ['\\', terminator]
+ <|> (string "\\t" >> return '\t')
+ <|> (string "\\n" >> return '\n')
+ <|> (char '\\' >> anyChar)))
+ char terminator
+ return (terminator : (content ++ [terminator]))
diff --git a/Test.hs b/Test.hs
new file mode 100644
--- /dev/null
+++ b/Test.hs
@@ -0,0 +1,387 @@
+{-
+ Copyright 2008 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
+ .
+-}
+
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables, PatternSignatures #-}
+
+module Test where
+
+import Control.Concurrent.SCC.Foundation
+import Control.Concurrent.SCC.ComponentTypes
+import Control.Concurrent.SCC.Components
+import Control.Concurrent.SCC.Combinators hiding ((&&), (||))
+import qualified Control.Concurrent.SCC.Combinators as Combinators
+
+import Control.Monad (liftM)
+import Data.Char (ord, isLetter, isSpace, toUpper)
+import Data.Dynamic (Typeable)
+import Data.List (find, stripPrefix, groupBy, intersect, union, intercalate, isInfixOf, isPrefixOf, isSuffixOf, sort)
+import Data.Maybe (fromJust)
+import qualified Data.List as List
+import qualified Data.Foldable as Foldable
+import qualified Data.Sequence as Seq
+import Data.Sequence (Seq, (|>), ViewL (EmptyL, (:<)))
+import Debug.Trace (trace)
+import Prelude hiding (even, last)
+import qualified Prelude
+import Test.QuickCheck (Arbitrary, Property,
+ arbitrary, coarbitrary, label, choose, oneof, sized, quickCheck, trivial, variant, (==>))
+
+
+sublists [] _ = []
+sublists _ [] = []
+sublists sublist input = case stripPrefix sublist input
+ of Just rest -> sublist ++ sublists sublist rest
+ Nothing -> sublists sublist (tail input)
+
+main = mapM_ quickCheck tests
+
+tests = [label "pipe" $ \(input :: [Int])-> runPipes (pipe (putList input) getList) == Just ([], input),
+ label "pour" prop_pour,
+ label "asis" prop_asis,
+ label "suppress" prop_suppress,
+ label "substitute" prop_substitute,
+ label "prepend" prop_prepend,
+ label "append" prop_append,
+ label "allTrue" prop_allTrue,
+ label "allFalse" prop_allFalse,
+ label "substring" prop_substring,
+ label "group" prop_group,
+ label "concatenate" prop_concatenate,
+ label "concatSeparate" prop_concatSeparate,
+ label "uppercase ->>" $ \s-> runPipes (pipe (putList s) (uppercase ->> getList)) == Just ([], map toUpper s),
+ label "uppercase <<-" $ \s-> runPipes (pipe (uppercase <<- putList s) getList) == Just ([], map toUpper s),
+ label "uppercase `join` asis" $ \s-> transducerOutput (uppercase `join` asis) s == map toUpper s ++ s,
+ label "prepend >-> append" $ \s-> transducerOutput (prepend "Hello, " >-> append "!") s == "Hello, "++ s ++ "!",
+ label "whitespace" $ \s-> splitterOutputs whitespace s == (filter isSpace s, filter (not . isSpace) s),
+ label "ifs allTrue asis asis" $ \(s :: [TestEnum])-> transducerOutput (ifs allTrue asis asis) s == s,
+ label "substring" $ \s (c :: TestEnum)-> splitterOutputs (substring [c]) s == (filter (==c) s, filter (/=c) s),
+ label "ifs (substring X) uppercase asis" $
+ \s (LowercaseLetter c)-> transducerOutput (ifs (substring [c]) uppercase asis) s
+ == map (\x-> if x == c then toUpper x else x) s,
+ label "count >-> toString >-> concatenate" $
+ \(s :: [TestEnum])-> transducerOutput (count >-> toString >-> concatenate) s == show (length s),
+ label "foreach whitespace asis (prepend \"[\" >-> append \"]\")" $
+ \s-> transducerOutput (foreach whitespace asis (prepend "[" >-> append "]")) s == mapWords (("[" ++) . (++ "]")) s,
+ label "foreach whitespace asis (count >-> toString >-> concatenate)" $
+ \s-> transducerOutput (foreach whitespace asis (count >-> toString >-> concatenate)) s == mapWords (show . length) s,
+ label "uppercase `wherever` (snot whitespace `having` substring X)" $
+ \s1 s2-> not (null s1) && length s1 < length s2 ==> trivial (not (s1 `isInfixOf` s2)) $
+ transducerOutput (uppercase `wherever` (snot whitespace `having` substring s1)) s2
+ == mapWords (\w-> if s1 `isInfixOf` w then map toUpper w else w) s2,
+ label "(uppercase `wherever` (snot whitespace `havingOnly` letters))" $
+ \s-> transducerOutput (uppercase `wherever` (snot whitespace `havingOnly` letters)) s
+ == mapWords (\w-> if all isLetter w then map toUpper w else w) s,
+
+ label "select $ substring" $ transducerOutput (select $ substring "o, ") "Hello, World!" == "o, ",
+
+ label "(uppercase `wherever` (first letters))"
+ (transducerOutput (uppercase `wherever` (first letters)) "... Hello, World !" == "... HELLO, World !"
+ && transducerOutput (uppercase `wherever` (first letters)) "Hello, World !" == "HELLO, World !"),
+ label "(uppercase `wherever` (prefix letters))"
+ (transducerOutput (wherever uppercase (prefix letters)) "... Hello, World !" == "... Hello, World !"
+ && transducerOutput (uppercase `wherever` (prefix letters)) "Hello, World !" == "HELLO, World !"),
+ label "(uppercase `wherever` (suffix letters))"
+ (transducerOutput (uppercase `wherever` (suffix letters)) "Hello, World!" == "Hello, World!"
+ && transducerOutput (uppercase `wherever` (suffix letters)) "Hello, World" == "Hello, WORLD"),
+ label "(uppercase `wherever` (last letters))"
+ (transducerOutput (uppercase `wherever` (last letters)) "Hello, World!" == "Hello, WORLD!"
+ && transducerOutput (uppercase `wherever` (last letters)) "Hello, World" == "Hello, WORLD"),
+
+ label "(select (prefix letters))" (transducerOutput (select (prefix letters)) "Hello, World!" == "Hello"),
+ label "(foreach letters (count >-> toString >-> concatenate) asis)"
+ (transducerOutput (foreach letters (count >-> toString >-> concatenate) asis) "Hola, Mundo!" == "4, 5!"),
+ label "(foreach (letters `having` prefix (substring \"H\")) uppercase asis)"
+ (transducerOutput (foreach (letters `having` prefix (substring "H")) uppercase asis) "Hello, World! Hola, Mundo!"
+ == "HELLO, World! HOLA, Mundo!"),
+ label "(foreach (letters `having` suffix (substring \"o\")) uppercase asis)"
+ (transducerOutput (foreach (letters `having` suffix (substring "o")) uppercase asis) "Hello, World! Hola, Mundo!"
+ == "HELLO, World! Hola, MUNDO!"),
+
+ label "first one" $ \s-> splitterOutputs (first one) s == if null s then ("", "") else ([head s], tail s),
+ label "last one" $ \s-> splitterOutputs (last one) s == if null s then ("", "") else ([List.last s], init s),
+ label "prefix one" $ \s-> splitterOutputs (prefix one) s == if null s then ("", "") else ([head s], tail s),
+ label "suffix one" $ \s-> splitterOutputs (suffix one) s == if null s then ("", "") else ([List.last s], init s),
+ label "uptoFirst one" $ \s-> splitterOutputs (uptoFirst one) s == if null s then ("", "") else ([head s], tail s),
+ label "lastAndAfter one" $ \s-> splitterOutputs (lastAndAfter one) s == if null s then ("", "")
+ else ([List.last s], init s),
+
+ label "snot" $ prop_snot . splitterFromTrace,
+ label "DeMorgan 1" $ \trace1 trace2-> prop_DeMorgan1 (splitterFromTrace trace1) (splitterFromTrace trace2),
+ label "DeMorgan 2" $ \trace1 trace2-> prop_DeMorgan2 (splitterFromTrace trace1) (splitterFromTrace trace2),
+ label "&&" $ \trace1 trace2-> prop_and (splitterFromTrace trace1) (splitterFromTrace trace2),
+ label "||" $ \trace1 trace2-> prop_or (splitterFromTrace trace1) (splitterFromTrace trace2),
+ label "even" $ prop_even . splitterFromTrace,
+ label "prefix 1" $ prop_prefix_1 . splitterFromTrace,
+ label "prefix 2" $ prop_prefix_2 . splitterFromTrace,
+ label "suffix 1" $ prop_suffix_1 . splitterFromTrace,
+ label "suffix 2" $ prop_suffix_2 . splitterFromTrace,
+ label "first" $ prop_first . splitterFromTrace,
+ label "last" $ prop_last . splitterFromTrace,
+ label "uptoFirst" $ prop_uptoFirst . splitterFromTrace,
+ label "lastAndAfter" $ prop_lastAndAfter . splitterFromTrace,
+ label "followedBy prefix" $ \trace1 trace2 n-> prop_followedBy1 (splitterFromTrace trace1) (splitterFromTrace trace2) n,
+ label "first followedBy" $ \trace1 trace2 n-> prop_followedBy2 (splitterFromTrace trace1) (splitterFromTrace trace2) n,
+ label "substring followedBy substring 1" prop_followedBy3,
+ label "substring followedBy substring 2" prop_followedBy4,
+ label "between..." $ \trace1 trace2 n-> prop_between_first_last (simpleSplitterFromTrace trace1)
+ (simpleSplitterFromTrace trace2) n]
+
+prop_pour :: [Int] -> Bool
+prop_pour input = runPipes (pipeD "input" (putList input) (\source-> pipeD "output" (\sink-> pour source sink) getList))
+ == Just ([], ((), input))
+
+prop_asis :: [Int] -> Bool
+prop_asis input = transducerOutput asis input == input
+
+prop_suppress :: [Int] -> Bool
+prop_suppress input = null (transducerOutput (suppress :: Transducer Maybe Int ()) input)
+
+prop_substitute :: [Int] -> [Maybe Int] -> Bool
+prop_substitute input replacement = transducerOutput (substitute replacement) input == replacement
+
+prop_prepend :: [Int] -> [Int] -> Bool
+prop_prepend input prefix = transducerOutput (prepend prefix) input == prefix ++ input
+
+prop_append :: [Int] -> [Int] -> Bool
+prop_append input suffix = transducerOutput (append suffix) input == input ++ suffix
+
+prop_allTrue :: [Int] -> Bool
+prop_allTrue input = splitterOutputs allTrue input == (input, [])
+
+prop_allFalse :: [Int] -> Bool
+prop_allFalse input = splitterOutputs allFalse input == ([], input)
+
+prop_substring :: [TestEnum] -> [TestEnum] -> Property
+prop_substring input sublist = trivial (not (isInfixOf sublist input)) (fst (splitterOutputs (substring sublist) input)
+ == sublists sublist input)
+
+prop_group :: [Int] -> Bool
+prop_group input = transducerOutput group input == [input]
+
+prop_concatenate :: [[TestEnum]] -> Bool
+prop_concatenate input = transducerOutput concatenate input == concat input
+
+prop_concatSeparate :: [[TestEnum]] -> [TestEnum] -> Bool
+prop_concatSeparate input separator = transducerOutput (concatSeparate separator) input == intercalate separator input
+
+prop_snot :: Splitter Maybe Int -> [Int] -> Bool
+prop_snot splitter input = splitterOutputs (snot splitter) input == swap (splitterOutputs splitter input)
+
+prop_andAssoc :: SplitterTrace -> SplitterTrace -> SplitterTrace -> [Int] -> Bool
+prop_andAssoc st1 st2 st3 input = --trace (show $ (splitterOutputs (s1 >& (s2 >& s3)) input, splitterOutputs ((s1 >& s2) >& s3) input)) $
+ splitterOutputs (s1 >& (s2 >& s3)) input == splitterOutputs ((s1 >& s2) >& s3) input
+ where s1 = splitterFromTrace st1
+ s2 = splitterFromTrace st2
+ s3 = splitterFromTrace st3
+
+prop_orAssoc :: SplitterTrace -> SplitterTrace -> SplitterTrace -> [Int] -> Bool
+prop_orAssoc st1 st2 st3 input = splitterOutputs (s1 >| (s2 >| s3)) input == splitterOutputs ((s1 >| s2) >| s3) input
+ where s1 = splitterFromTrace st1
+ s2 = splitterFromTrace st2
+ s3 = splitterFromTrace st3
+
+prop_DeMorgan1 :: Splitter Maybe Int -> Splitter Maybe Int -> [Int] -> Bool
+prop_DeMorgan1 s1 s2 input = splitterOutputs (snot (s1 >& s2)) input == splitterOutputs (snot s1 >| snot s2) input
+
+prop_DeMorgan2 :: Splitter Maybe Int -> Splitter Maybe Int -> [Int] -> Bool
+prop_DeMorgan2 s1 s2 input = splitterOutputs (snot (s1 >| s2)) input == splitterOutputs (snot s1 >& snot s2) input
+
+prop_and :: Splitter Maybe Int -> Splitter Maybe Int -> Int -> Bool
+prop_and s1 s2 n = fst (splitterOutputs (s1 Combinators.&& s2) l)
+ == fst (splitterOutputs s1 l) `intersect` fst (splitterOutputs s2 l)
+ where l = [1 .. abs n]
+
+prop_or :: Splitter Maybe Int -> Splitter Maybe Int -> Int -> Bool
+prop_or s1 s2 n = fst (splitterOutputs (s1 Combinators.|| s2) l)
+ == sort (fst (splitterOutputs s1 l) `union` fst (splitterOutputs s2 l))
+ where l = [1 .. abs n]
+
+prop_even :: Splitter Maybe TestEnum -> [TestEnum] -> Bool
+prop_even splitter input = let splitOddEven [] = ([], [])
+ splitOddEven (head:tail) = let (evens, odds) = splitOddEven tail in (head:odds, evens)
+ in fst (splitterOutputs (even splitter) input)
+ == concat (snd $ splitOddEven $ transducerOutput (foreach splitter group suppress) input)
+
+prop_prefix_1 :: Splitter Maybe TestEnum -> [TestEnum] -> Bool
+prop_prefix_1 splitter input = let (pfx, rest) = splitterOutputs (prefix splitter) input
+ (true, false) = splitterOutputs splitter input
+ in pfx ++ rest == input && pfx `isPrefixOf` true
+
+prop_prefix_2 :: Splitter Maybe TestEnum -> [TestEnum] -> Bool
+prop_prefix_2 splitter input = let (prefix1, rest1) = splitterOutputs (prefix splitter) input
+ in case splitterOutputChunks splitter input
+ of (prefix2, True):rest2 -> prefix1 == prefix2 && rest1 == concat (map fst rest2)
+ (prefix2, False):rest2 -> prefix1 == [] && rest1 == prefix2 ++ concat (map fst rest2)
+ [] -> prefix1 ++ rest1 == []
+
+prop_suffix_1 :: Splitter Maybe TestEnum -> [TestEnum] -> Bool
+prop_suffix_1 splitter input = let (sfx, rest) = splitterOutputs (suffix splitter) input
+ (true, false) = splitterOutputs splitter input
+ in rest ++ sfx == input && sfx `isSuffixOf` true
+
+prop_suffix_2 :: Splitter Maybe TestEnum -> [TestEnum] -> Bool
+prop_suffix_2 splitter input = let (suffix1, rest1) = splitterOutputs (suffix splitter) input
+ in case reverse (splitterOutputChunks splitter input)
+ of (suffix2, True):rest2 -> suffix1 == suffix2 && rest1 == concat (map fst (reverse rest2))
+ (suffix2, False):rest2 -> suffix1 == [] && rest1 == concat (map fst (reverse rest2)) ++ suffix2
+ [] -> rest1 ++ suffix1 == []
+
+prop_first :: Splitter Maybe TestEnum -> [TestEnum] -> Bool
+prop_first splitter input = let (first1, rest1) = splitterOutputs (first splitter) input
+ in case splitterOutputChunks splitter input
+ of (first2, True):rest2 -> first1 == first2 && rest1 == concat (map fst rest2)
+ (prefix, False):(first2, True):rest2 -> first1 == first2
+ && rest1 == prefix ++ concat (map fst rest2)
+ (prefix, False):[] -> first1 == [] && rest1 == prefix
+ [] -> first1 ++ rest1 == []
+
+prop_last :: Splitter Maybe TestEnum -> [TestEnum] -> Bool
+prop_last splitter input = let (last1, rest1) = splitterOutputs (last splitter) input
+ in -- trace (show (last1, rest1)) $ trace (show (splitterOutputChunks splitter input)) $
+ case reverse (splitterOutputChunks splitter input)
+ of (last2, True):rest2 -> last1 == last2 && rest1 == concat (map fst (reverse rest2))
+ (suffix, False):(last2, True):rest2 -> last1 == last2
+ && rest1 == concat (map fst (reverse rest2)) ++ suffix
+ (suffix, False):[] -> last1 == [] && rest1 == suffix
+ [] -> last1 ++ rest1 == []
+
+prop_uptoFirst :: Splitter Maybe TestEnum -> [TestEnum] -> Bool
+prop_uptoFirst splitter input = let (first1, rest1) = splitterOutputs (uptoFirst splitter) input
+ in case splitterOutputChunks splitter input
+ of (first2, True):rest2 -> first1 == first2 && rest1 == concat (map fst rest2)
+ (prefix, False):(first2, True):rest2 -> first1 == prefix ++ first2
+ && rest1 == concat (map fst rest2)
+ (prefix, False):[] -> first1 == [] && rest1 == prefix
+ [] -> first1 ++ rest1 == []
+
+prop_lastAndAfter :: Splitter Maybe TestEnum -> [TestEnum] -> Bool
+prop_lastAndAfter splitter input = let (last1, rest1) = splitterOutputs (lastAndAfter splitter) input
+ in case reverse (splitterOutputChunks splitter input)
+ of (last2, True):rest2 -> last1 == last2 && rest1 == concat (map fst (reverse rest2))
+ (suffix, False):(last2, True):rest2 -> last1 == last2 ++ suffix
+ && rest1 == concat (map fst (reverse rest2))
+ (suffix, False):[] -> last1 == [] && rest1 == suffix
+ [] -> last1 ++ rest1 == []
+
+prop_followedBy1 :: Splitter Maybe Int -> Splitter Maybe Int -> Int -> Bool
+prop_followedBy1 s1 s2 n = splitterOutputs (s1 `followedBy` s2) l == splitterOutputs (s1 `followedBy` prefix s2) l
+ where l = [1 .. abs n]
+
+prop_followedBy2 :: Splitter Maybe Int -> Splitter Maybe Int -> Int -> Bool
+prop_followedBy2 s1 s2 n = splitterOutputs (first (s1 `followedBy` s2)) l == splitterOutputs (first s1 `followedBy` s2) l
+ where l = [1 .. abs n]
+
+prop_followedBy3 :: [TestEnum] -> [TestEnum] -> [TestEnum] -> Property
+prop_followedBy3 l1 l2 l3 = trivial (not (isInfixOf l1 l3)) (fst (splitterOutputs (substring l1 `followedBy` substring l2) l3)
+ == sublists (l1 ++ l2) l3)
+
+prop_followedBy4 :: [TestEnum] -> [TestEnum] -> [TestEnum] -> Property
+prop_followedBy4 l1 l2 l3 = isInfixOf l1 l3
+ ==> trivial (not (isInfixOf (l1 ++ l2) l3)) (fst (splitterOutputs (substring l1
+ `followedBy` substring l2) l3)
+ == sublists (l1 ++ l2) l3)
+
+prop_between_first_last :: Splitter Maybe Int -> Splitter Maybe Int -> Int -> Bool
+prop_between_first_last s1 s2 n = fst (splitterOutputs (first s1 ... last s2) l)
+ == sort (fst (splitterOutputs (first s1 `between` last s2) l)
+ `union`
+ limits (fst $ splitterOutputs (first s1) l) (fst $ splitterOutputs (last s2) l))
+ where limits [] _ = []
+ limits l1 [] = l1
+ limits l1 l2 | head l1 <= head l2 = l1 `union` l2
+ | head l1 <= Prelude.last l2 = [head l1 .. Prelude.last l2]
+ | otherwise = l1
+ l = [1 .. abs n]
+
+transducerOutput :: (Typeable x, Typeable y) => Transducer Maybe x y -> [x] -> [y]
+transducerOutput t input = case runPipes (pipeD "transducerOutput input"
+ (putList input)
+ (\source-> pipeD "transducerOutput output"
+ (\sink-> transduce t source sink)
+ getList))
+ of Just ([], ([], output)) -> output
+
+splitterOutputs :: Typeable x => Splitter Maybe x -> [x] -> ([x], [x])
+splitterOutputs s input = case runPipes (pipeD "splitterOutputs input"
+ (putList input)
+ (\source-> pipeD "splitterOutputs true"
+ (\true-> pipeD "splitterOutputs false"
+ (split s source true)
+ getList)
+ getList))
+ of Just ([], (([], false), true)) -> (true, false)
+
+splitterOutputChunks :: Typeable x => Splitter Maybe x -> [x] -> [([x], Bool)]
+splitterOutputChunks s input = transducerOutput (foreach s
+ (group >-> lift121Transducer (\chunk-> (chunk, True)))
+ (group >-> lift121Transducer (\chunk-> (chunk, False))))
+ input
+
+simpleSplitterFromTrace :: (Show x, Typeable x) => SimpleSplitterTrace -> Splitter Maybe x
+simpleSplitterFromTrace (init, last) = splitterFromTrace (map (maybe Nothing (Just . (,) True)) init, last)
+
+splitterFromTrace :: (Show x, Typeable x) => SplitterTrace -> Splitter Maybe x
+splitterFromTrace trace1 = liftSectionSplitter $
+ \source true false->
+ let follow trace2@(head:tail) q = get source >>= maybe fail succeed
+ where succeed x = let q' = q |> Just x
+ in case head
+ of Nothing -> follow tail q'
+ Just (False, b) -> (if b then put true else put false) Nothing
+ >>= cond
+ (follow tail q')
+ (return $ Foldable.toList (Seq.viewl q))
+ Just (True, True) -> putList (Foldable.toList (Seq.viewl q')) true
+ >>= whenNull (follow tail Seq.empty)
+ Just (True, False) -> putList (Foldable.toList (Seq.viewl q')) false
+ >>= whenNull (follow tail Seq.empty)
+ fail = if find (maybe False fst) trace2 == Just (Just (True, True))
+ then putList (Foldable.toList (Seq.viewl q)) true
+ else putList (Foldable.toList (Seq.viewl q)) false
+ in liftM (map fromJust) $ follow (cycle (fst trace1 ++ [Just (True, snd trace1)])) Seq.empty
+
+swap :: (x, y) -> (y, x)
+swap (x, y) = (y, x)
+
+mapWords :: (String -> String) -> String -> String
+mapWords f s = concat (map (\w@(c:_)-> if isSpace c then w else f w) (groupBy (\x y-> isSpace x == isSpace y) s))
+
+type SimpleSplitterTrace = ([Maybe Bool], Bool)
+
+type SplitterTrace = ([Maybe (Bool, Bool)], Bool)
+
+data TestEnum = One | Two | Three | Four | Five deriving (Eq, Show, Typeable)
+
+newtype LowercaseLetter = LowercaseLetter Char deriving (Eq, Show, Typeable)
+
+instance Arbitrary TestEnum where
+ arbitrary = oneof (map return [One, Two, Three, Four, Five])
+ coarbitrary enum = variant (case enum of {One -> 0; Two -> 1; Three -> 2; Four -> 3; Five -> 4})
+
+instance Arbitrary Char where
+ arbitrary = choose ('\32', '\128')
+ coarbitrary c = variant ((ord c - 32) `rem` 128)
+
+instance Arbitrary LowercaseLetter where
+ arbitrary = fmap LowercaseLetter (choose ('a', 'z'))
+ coarbitrary (LowercaseLetter c) = variant ((ord c - 65) `rem` 26)
+
+instance Arbitrary (Splitter Maybe Int) where
+ arbitrary = fmap splitterFromTrace arbitrary
+ coarbitrary s gen = sized (\n-> coarbitrary (transducerOutput (ifs s
+ (lift121Transducer $ const True)
+ (lift121Transducer $ const False))
+ [1..n]) gen)
diff --git a/grammar.bnf b/grammar.bnf
new file mode 100644
--- /dev/null
+++ b/grammar.bnf
@@ -0,0 +1,76 @@
+Expression ::=
+ ProducerPrimary {"|" TransducerPrimary} ["|" ConsumerPrimary].
+
+ProducerExpression ::=
+ ProducerPrimary
+ | ProducerPrimary "|" TransducerExpression.
+
+ProducerPrimary ::=
+ "(" NativeCommand ")" ">"
+ | "cat" Parameters
+ | "echo" Parameters
+ | "ls" Parameters
+ | "stdin"
+ | "{" [String {"," String}] "}"
+ | "(" ProducerExpression ")".
+
+ConsumerExpression ::=
+ ConsumerFork
+ | TransducerExpression "|" ConsumerFork.
+
+ConsumerFork ::=
+ ConsumerPrimary {"tee" ConsumerPrimary}.
+
+ConsumerPrimary ::=
+ "(" ConsumerExpression ")"
+ | ">" "(" NativeCommand ")"
+ | "error" [String]
+ | "null"
+ | ">" File
+ | ">>" File.
+
+TransducerExpression ::=
+ TransducerPrimary {"|" TransducerPrimary}
+ | TransducerPrimary {"><" TransducerPrimary}.
+
+TransducerPrimary ::=
+ "(" TransducerExpression ")"
+ | "id"
+ | "suppress"
+ | "count"
+ | "group"
+ | "concatenate"
+ | "uppercase"
+ | "prepend" String
+ | "append" String
+ | "substitute" String
+ | "select" SplitterPrimary
+ | "if" SplitterExpression "then" TransducerExpression ["else" TransducerExpression] "end" ["if"]
+ | "while" SplitterExpression "do" TransducerExpression "end" ["while"]
+ | "foreach" SplitterExpression "then" TransducerExpression ["else" TransducerExpression] "end" ["foreach"]
+ | NativeCommand.
+
+SplitterExpression ::=
+ SplitterPrimary {"&&" SplitterPrimary}
+ | SplitterPrimary {"||" SplitterPrimary}
+ | SplitterPrimary {">&" SplitterPrimary}
+ | SplitterPrimary {">|" SplitterPrimary}
+ | SplitterPrimary {">," SplitterPrimary}
+ | SplitterPrimary "having" SplitterPrimary
+ | SplitterPrimary "having-only" SplitterPrimary
+ | SplitterPrimary "..." SplitterPrimary
+ | "first" SplitterPrimary
+ | "last" SplitterPrimary
+ | "prefix" SplitterPrimary
+ | "suffix" SplitterPrimary.
+
+SplitterPrimary ::=
+ "(" SplitterExpression ")"
+ | ">!" SplitterPrimary
+ | "whitespace"
+ | "line"
+ | "letters"
+ | "digits"
+ | "substring" String
+ | "nested" SplitterExpression "in" SplitterExpression "end" ["nested"]
+ | "between" SplitterExpression "and" SplitterExpression "end" ["between"].
diff --git a/scc.cabal b/scc.cabal
new file mode 100644
--- /dev/null
+++ b/scc.cabal
@@ -0,0 +1,33 @@
+Name: scc
+Version: 0.1
+Cabal-Version: >= 1.2
+Build-Type: Simple
+Synopsis: Streaming component combinators
+Category: Control, Combinators
+Description:
+ SCC is a layered library of Streaming Component Combinators. The lowest layer defines a Pipe monad transformer that
+ enables building of producer-consumer coroutine pairs. The next layer adds streaming component
+ types, a number of primitive streaming components and a set of component combinators. Finally,
+ there is an executable that exposes all functionality in a command-line shell.
+ .
+ The library design is based on paper
+ .
+ Mario Blažević, Streaming component combinators, Extreme Markup Languages, 2006.
+
+License: GPL
+License-file: LICENSE.txt
+Copyright: (c) 2008 Mario Blazevic
+Author: Mario Blazevic
+Maintainer: blamario@yahoo.com
+Extra-source-files: grammar.bnf Makefile LICENSE.txt Test.hs
+
+Executable shsh
+ Main-is: Shell.hs
+ Other-Modules: Control.Concurrent.SCC.Foundation, Control.Concurrent.SCC.ComponentTypes,
+ Control.Concurrent.SCC.Components, Control.Concurrent.SCC.Combinators
+ Build-Depends: base, containers, process, readline, parsec
+
+Library
+ Exposed-Modules: Control.Concurrent.SCC.Foundation, Control.Concurrent.SCC.ComponentTypes,
+ Control.Concurrent.SCC.Components, Control.Concurrent.SCC.Combinators
+ Build-Depends: base, containers