{-# LANGUAGE ScopedTypeVariables, Rank2Types #-}
{-# OPTIONS_HADDOCK hide #-}
module Control.Concurrent.SCC.Primitives (
fromFile, fromHandle, fromStdIn, fromBinaryHandle,
appendFile, toFile, toHandle, toStdOut, toBinaryHandle,
produceFrom,
suppress, erroneous, consumeInto,
parse, unparse, parseSubstring, OccurenceTag, count, toString,
group, concatenate, concatSeparate,
everything, nothing, marked, markedContent, markedWith, contentMarkedWith, one, substring,
lowercase, uppercase, whitespace, letters, digits, line, nonEmptyLine,
)
where
import Prelude hiding (appendFile, getLine, length, null, putStr, tail)
import Control.Applicative (Alternative ((<|>)))
import Control.Exception (assert)
import Control.Monad (forM_, unless, when)
import Control.Monad.Trans.Class (lift)
import Data.ByteString (ByteString)
import Data.Char (isAlpha, isDigit, isSpace, toLower, toUpper)
import Data.List (delete)
import Data.Monoid (Monoid(mappend, mempty), Sum(Sum))
import qualified Data.ByteString as ByteString
import qualified Data.Foldable as Foldable
import System.IO (Handle, IOMode (ReadMode, WriteMode, AppendMode), openFile, hClose, hIsEOF, hClose, isEOF)
import Data.Text (Text, singleton)
import Data.Text.IO (getLine, hGetLine, hPutStr, putStr)
import Data.Monoid.Null (MonoidNull(null))
import Data.Monoid.Cancellative (LeftReductiveMonoid, stripPrefix)
import Data.Monoid.Factorial (FactorialMonoid(splitPrimePrefix), length)
import Text.ParserCombinators.Incremental (string, takeWhile, (<<|>))
import Control.Concurrent.SCC.Streams
import Control.Concurrent.SCC.Types
import Debug.Trace (trace)
consumeInto :: forall m x. (Monad m, Monoid x) => Consumer m x x
consumeInto :: forall (m :: * -> *) x. (Monad m, Monoid x) => Consumer m x x
consumeInto = (forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x x)
-> Consumer m x x
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r)
-> Consumer m x r
Consumer Source m a x -> Coroutine d m x
forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, Monoid x, AncestorFunctor a d) =>
Source m a x -> Coroutine d m x
getAll
produceFrom :: forall m x. (Monad m, MonoidNull x) => x -> Producer m x ()
produceFrom :: forall (m :: * -> *) x.
(Monad m, MonoidNull x) =>
x -> Producer m x ()
produceFrom x
l = (forall (a :: * -> *) (d :: * -> *). OpenProducer m a d x ())
-> Producer m x ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenProducer m a d x r)
-> Producer m x r
Producer ((Coroutine d m x -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
forall a. a -> Coroutine d m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Coroutine d m x -> Coroutine d m ())
-> (Sink m a x -> Coroutine d m x)
-> Sink m a x
-> Coroutine d m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Sink m a x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll x
l)
toStdOut :: Consumer IO Text ()
toStdOut :: Consumer IO Text ()
toStdOut = (forall (a :: * -> *) (d :: * -> *). OpenConsumer IO a d Text ())
-> Consumer IO Text ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r)
-> Consumer m x r
Consumer ((Text -> Coroutine d IO ())
-> Source IO a Text -> Coroutine d IO ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x r.
(Monad m, Monoid x, AncestorFunctor a d) =>
(x -> Coroutine d m r) -> Source m a x -> Coroutine d m ()
mapMStreamChunks_ (IO () -> Coroutine d IO ()
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Coroutine d IO ())
-> (Text -> IO ()) -> Text -> Coroutine d IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
putStr))
fromStdIn :: Producer IO Text ()
fromStdIn :: Producer IO Text ()
fromStdIn = (forall (a :: * -> *) (d :: * -> *). OpenProducer IO a d Text ())
-> Producer IO Text ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenProducer m a d x r)
-> Producer m x r
Producer (Coroutine d IO Text -> Sink IO a Text -> Coroutine d IO ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
Coroutine d m x -> Sink m a x -> Coroutine d m ()
unmapMStreamChunks_ (IO Text -> Coroutine d IO Text
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Text -> Coroutine d IO Text) -> IO Text -> Coroutine d IO Text
forall a b. (a -> b) -> a -> b
$
IO Bool
isEOF IO Bool -> (Bool -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Text -> IO Text -> Bool -> IO Text
forall a. a -> a -> Bool -> a
cond (Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty) ((Text -> Text) -> IO Text -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Char -> Text
singleton Char
'\n') IO Text
getLine)))
fromFile :: String -> Producer IO Text ()
fromFile :: String -> Producer IO Text ()
fromFile String
path = (forall (a :: * -> *) (d :: * -> *). OpenProducer IO a d Text ())
-> Producer IO Text ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenProducer m a d x r)
-> Producer m x r
Producer ((forall (a :: * -> *) (d :: * -> *). OpenProducer IO a d Text ())
-> Producer IO Text ())
-> (forall (a :: * -> *) (d :: * -> *).
OpenProducer IO a d Text ())
-> Producer IO Text ()
forall a b. (a -> b) -> a -> b
$ \Sink IO a Text
sink-> do Handle
handle <- IO Handle -> Coroutine d IO Handle
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> IOMode -> IO Handle
openFile String
path IOMode
ReadMode)
Producer IO Text ()
-> forall (a :: * -> *) (d :: * -> *). OpenProducer IO a d Text ()
forall (m :: * -> *) x r.
Producer m x r
-> forall (a :: * -> *) (d :: * -> *). OpenProducer m a d x r
produce (Handle -> Producer IO Text ()
fromHandle Handle
handle) Sink IO a Text
sink
IO () -> Coroutine d IO ()
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handle -> IO ()
hClose Handle
handle)
fromHandle :: Handle -> Producer IO Text ()
fromHandle :: Handle -> Producer IO Text ()
fromHandle Handle
handle = (forall (a :: * -> *) (d :: * -> *). OpenProducer IO a d Text ())
-> Producer IO Text ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenProducer m a d x r)
-> Producer m x r
Producer (Coroutine d IO Text -> Sink IO a Text -> Coroutine d IO ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
Coroutine d m x -> Sink m a x -> Coroutine d m ()
unmapMStreamChunks_
(IO Text -> Coroutine d IO Text
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Text -> Coroutine d IO Text) -> IO Text -> Coroutine d IO Text
forall a b. (a -> b) -> a -> b
$
Handle -> IO Bool
hIsEOF Handle
handle
IO Bool -> (Bool -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Text -> IO Text -> Bool -> IO Text
forall a. a -> a -> Bool -> a
cond (Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty) ((Text -> Text) -> IO Text -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Char -> Text
singleton Char
'\n') (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Handle -> IO Text
hGetLine Handle
handle)))
fromBinaryHandle :: Handle -> Int -> Producer IO ByteString ()
fromBinaryHandle :: Handle -> Int -> Producer IO ByteString ()
fromBinaryHandle Handle
handle Int
chunkSize = (forall (a :: * -> *) (d :: * -> *).
OpenProducer IO a d ByteString ())
-> Producer IO ByteString ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenProducer m a d x r)
-> Producer m x r
Producer Sink IO a ByteString -> Coroutine d IO ()
forall (a :: * -> *) (d :: * -> *).
OpenProducer IO a d ByteString ()
forall {a :: * -> *} {d :: * -> *}.
AncestorFunctor a d =>
Sink IO a ByteString -> Coroutine d IO ()
p
where p :: Sink IO a ByteString -> Coroutine d IO ()
p Sink IO a ByteString
sink = IO ByteString -> Coroutine d IO ByteString
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handle -> Int -> IO ByteString
ByteString.hGet Handle
handle Int
chunkSize)
Coroutine d IO ByteString
-> (ByteString -> Coroutine d IO ()) -> Coroutine d IO ()
forall a b.
Coroutine d IO a -> (a -> Coroutine d IO b) -> Coroutine d IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
chunk-> Bool -> Coroutine d IO () -> Coroutine d IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
ByteString.null ByteString
chunk)
(Sink IO a ByteString
-> forall (d :: * -> *).
AncestorFunctor a d =>
ByteString -> Coroutine d IO ByteString
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink IO a ByteString
sink ByteString
chunk
Coroutine d IO ByteString
-> (ByteString -> Coroutine d IO ()) -> Coroutine d IO ()
forall a b.
Coroutine d IO a -> (a -> Coroutine d IO b) -> Coroutine d IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
c-> Bool -> Coroutine d IO () -> Coroutine d IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
ByteString.null ByteString
c) (Sink IO a ByteString -> Coroutine d IO ()
p Sink IO a ByteString
sink))
toFile :: String -> Consumer IO Text ()
toFile :: String -> Consumer IO Text ()
toFile String
path = (forall (a :: * -> *) (d :: * -> *). OpenConsumer IO a d Text ())
-> Consumer IO Text ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r)
-> Consumer m x r
Consumer ((forall (a :: * -> *) (d :: * -> *). OpenConsumer IO a d Text ())
-> Consumer IO Text ())
-> (forall (a :: * -> *) (d :: * -> *).
OpenConsumer IO a d Text ())
-> Consumer IO Text ()
forall a b. (a -> b) -> a -> b
$ \Source IO a Text
source-> do Handle
handle <- IO Handle -> Coroutine d IO Handle
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> IOMode -> IO Handle
openFile String
path IOMode
WriteMode)
Consumer IO Text ()
-> forall (a :: * -> *) (d :: * -> *). OpenConsumer IO a d Text ()
forall (m :: * -> *) x r.
Consumer m x r
-> forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r
consume (Handle -> Consumer IO Text ()
toHandle Handle
handle) Source IO a Text
source
IO () -> Coroutine d IO ()
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handle -> IO ()
hClose Handle
handle)
appendFile :: String -> Consumer IO Text ()
appendFile :: String -> Consumer IO Text ()
appendFile String
path = (forall (a :: * -> *) (d :: * -> *). OpenConsumer IO a d Text ())
-> Consumer IO Text ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r)
-> Consumer m x r
Consumer ((forall (a :: * -> *) (d :: * -> *). OpenConsumer IO a d Text ())
-> Consumer IO Text ())
-> (forall (a :: * -> *) (d :: * -> *).
OpenConsumer IO a d Text ())
-> Consumer IO Text ()
forall a b. (a -> b) -> a -> b
$ \Source IO a Text
source-> do Handle
handle <- IO Handle -> Coroutine d IO Handle
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> IOMode -> IO Handle
openFile String
path IOMode
AppendMode)
Consumer IO Text ()
-> forall (a :: * -> *) (d :: * -> *). OpenConsumer IO a d Text ()
forall (m :: * -> *) x r.
Consumer m x r
-> forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r
consume (Handle -> Consumer IO Text ()
toHandle Handle
handle) Source IO a Text
source
IO () -> Coroutine d IO ()
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handle -> IO ()
hClose Handle
handle)
toHandle :: Handle -> Consumer IO Text ()
toHandle :: Handle -> Consumer IO Text ()
toHandle Handle
handle = (forall (a :: * -> *) (d :: * -> *). OpenConsumer IO a d Text ())
-> Consumer IO Text ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r)
-> Consumer m x r
Consumer ((Text -> Coroutine d IO ())
-> Source IO a Text -> Coroutine d IO ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x r.
(Monad m, Monoid x, AncestorFunctor a d) =>
(x -> Coroutine d m r) -> Source m a x -> Coroutine d m ()
mapMStreamChunks_ (IO () -> Coroutine d IO ()
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Coroutine d IO ())
-> (Text -> IO ()) -> Text -> Coroutine d IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
hPutStr Handle
handle))
toBinaryHandle :: Handle -> Consumer IO ByteString ()
toBinaryHandle :: Handle -> Consumer IO ByteString ()
toBinaryHandle Handle
handle = (forall (a :: * -> *) (d :: * -> *).
OpenConsumer IO a d ByteString ())
-> Consumer IO ByteString ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r)
-> Consumer m x r
Consumer ((ByteString -> Coroutine d IO ())
-> Source IO a ByteString -> Coroutine d IO ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x r.
(Monad m, Monoid x, AncestorFunctor a d) =>
(x -> Coroutine d m r) -> Source m a x -> Coroutine d m ()
mapMStreamChunks_ (IO () -> Coroutine d IO ()
forall (m :: * -> *) a. Monad m => m a -> Coroutine d m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Coroutine d IO ())
-> (ByteString -> IO ()) -> ByteString -> Coroutine d IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ByteString -> IO ()
ByteString.hPut Handle
handle))
unparse :: forall m x b. (Monad m, Monoid x) => Transducer m [Markup b x] x
unparse :: forall (m :: * -> *) x b.
(Monad m, Monoid x) =>
Transducer m [Markup b x] x
unparse = (Markup b x -> x) -> Transducer m [Markup b x] x
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m [x] y
statelessTransducer Markup b x -> x
forall {x} {y}. Monoid x => Markup y x -> x
removeTag
where removeTag :: Markup y x -> x
removeTag (Content x
x) = x
x
removeTag Markup y x
_ = x
forall a. Monoid a => a
mempty
parse :: forall m x y. (Monad m, Monoid x) => Parser m x y
parse :: forall (m :: * -> *) x y. (Monad m, Monoid x) => Parser m x y
parse = (x -> [Markup y x]) -> Transducer m x [Markup y x]
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m x y
statelessChunkTransducer ((Markup y x -> [Markup y x] -> [Markup y x]
forall a. a -> [a] -> [a]
: []) (Markup y x -> [Markup y x])
-> (x -> Markup y x) -> x -> [Markup y x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Markup y x
forall y x. x -> Markup y x
Content)
suppress :: forall m x. Monad m => Consumer m x ()
suppress :: forall (m :: * -> *) x. Monad m => Consumer m x ()
suppress = (forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x ())
-> Consumer m x ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r)
-> Consumer m x r
Consumer (\(Source m a x
src :: Source m a x)-> Source m a x -> Sink m a x -> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, Monoid x, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
Source m a1 x -> Sink m a2 x -> Coroutine d m ()
pour_ Source m a x
src (Sink m a x
forall (m :: * -> *) (a :: * -> *) x.
(Monad m, Monoid x) =>
Sink m a x
nullSink :: Sink m a x))
erroneous :: forall m x. (Monad m, MonoidNull x) => String -> Consumer m x ()
erroneous :: forall (m :: * -> *) x.
(Monad m, MonoidNull x) =>
String -> Consumer m x ()
erroneous String
message = (forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x ())
-> Consumer m x ()
forall (m :: * -> *) x r.
(forall (a :: * -> *) (d :: * -> *). OpenConsumer m a d x r)
-> Consumer m x r
Consumer ((x -> Coroutine d m ()) -> Source m a x -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x r.
(Monad m, Monoid x, AncestorFunctor a d) =>
(x -> Coroutine d m r) -> Source m a x -> Coroutine d m ()
mapMStreamChunks_ (\x
x-> Bool -> Coroutine d m () -> Coroutine d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (x -> Bool
forall m. MonoidNull m => m -> Bool
null x
x) (String -> Coroutine d m ()
forall a. HasCallStack => String -> a
error String
message)))
lowercase :: forall m. Monad m => Transducer m String String
lowercase :: forall (m :: * -> *). Monad m => Transducer m String String
lowercase = (String -> String) -> Transducer m String String
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m x y
statelessChunkTransducer ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower)
uppercase :: forall m. Monad m => Transducer m String String
uppercase :: forall (m :: * -> *). Monad m => Transducer m String String
uppercase = (String -> String) -> Transducer m String String
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m x y
statelessChunkTransducer ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper)
count :: forall m x. (Monad m, FactorialMonoid x) => Transducer m x [Integer]
count :: forall (m :: * -> *) x.
(Monad m, FactorialMonoid x) =>
Transducer m x [Integer]
count = (forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
OpenTransducer m a1 a2 d x [Integer] ())
-> Transducer m x [Integer]
forall (m :: * -> *) x y.
(forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
OpenTransducer m a1 a2 d x y ())
-> Transducer m x y
Transducer (\Source m a1 x
source Sink m a2 [Integer]
sink-> (Integer -> x -> Integer)
-> Integer -> Source m a1 x -> Coroutine d m Integer
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x acc.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
(acc -> x -> acc) -> acc -> Source m a x -> Coroutine d m acc
foldStream (\Integer
n x
_-> Integer -> Integer
forall a. Enum a => a -> a
succ Integer
n) Integer
0 Source m a1 x
source Coroutine d m Integer
-> (Integer -> Coroutine d m ()) -> Coroutine d m ()
forall a b.
Coroutine d m a -> (a -> Coroutine d m b) -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sink m a2 [Integer] -> Integer -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m a2 [Integer]
sink)
toString :: forall m x. (Monad m, Show x) => Transducer m [x] [String]
toString :: forall (m :: * -> *) x.
(Monad m, Show x) =>
Transducer m [x] [String]
toString = ([x] -> [String]) -> Transducer m [x] [String]
forall (m :: * -> *) x y.
(Monad m, FactorialMonoid x, Monoid y) =>
(x -> y) -> Transducer m x y
oneToOneTransducer ((x -> String) -> [x] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map x -> String
forall a. Show a => a -> String
show)
group :: forall m x. (Monad m, Monoid x) => Transducer m x [x]
group :: forall (m :: * -> *) x. (Monad m, Monoid x) => Transducer m x [x]
group = (forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
OpenTransducer m a1 a2 d x [x] ())
-> Transducer m x [x]
forall (m :: * -> *) x y.
(forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
OpenTransducer m a1 a2 d x y ())
-> Transducer m x y
Transducer (\Source m a1 x
source Sink m a2 [x]
sink-> Source m a1 x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, Monoid x, AncestorFunctor a d) =>
Source m a x -> Coroutine d m x
getAll Source m a1 x
source Coroutine d m x -> (x -> Coroutine d m ()) -> Coroutine d m ()
forall a b.
Coroutine d m a -> (a -> Coroutine d m b) -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sink m a2 [x] -> x -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m a2 [x]
sink)
concatenate :: forall m x. (Monad m, Monoid x) => Transducer m [x] x
concatenate :: forall (m :: * -> *) x. (Monad m, Monoid x) => Transducer m [x] x
concatenate = (x -> x) -> Transducer m [x] x
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m [x] y
statelessTransducer x -> x
forall a. a -> a
id
concatSeparate :: forall m x. (Monad m, MonoidNull x) => x -> Transducer m [x] x
concatSeparate :: forall (m :: * -> *) x.
(Monad m, MonoidNull x) =>
x -> Transducer m [x] x
concatSeparate x
separator = (Bool -> x -> (Bool, x)) -> Bool -> Transducer m [x] x
forall (m :: * -> *) y state x.
(Monad m, MonoidNull y) =>
(state -> x -> (state, y)) -> state -> Transducer m [x] y
statefulTransducer (\Bool
seen x
chunk-> (Bool
True, if Bool
seen then x -> x -> x
forall a. Monoid a => a -> a -> a
mappend x
separator x
chunk else x
chunk))
Bool
False
whitespace :: forall m. Monad m => Splitter m String
whitespace :: forall (m :: * -> *). Monad m => Splitter m String
whitespace = (Char -> Bool) -> Splitter m String
forall (m :: * -> *) x. Monad m => (x -> Bool) -> Splitter m [x]
statelessSplitter Char -> Bool
isSpace
letters :: forall m. Monad m => Splitter m String
letters :: forall (m :: * -> *). Monad m => Splitter m String
letters = (Char -> Bool) -> Splitter m String
forall (m :: * -> *) x. Monad m => (x -> Bool) -> Splitter m [x]
statelessSplitter Char -> Bool
isAlpha
digits :: forall m. Monad m => Splitter m String
digits :: forall (m :: * -> *). Monad m => Splitter m String
digits = (Char -> Bool) -> Splitter m String
forall (m :: * -> *) x. Monad m => (x -> Bool) -> Splitter m [x]
statelessSplitter Char -> Bool
isDigit
nonEmptyLine :: forall m. Monad m => Splitter m String
nonEmptyLine :: forall (m :: * -> *). Monad m => Splitter m String
nonEmptyLine = (Char -> Bool) -> Splitter m String
forall (m :: * -> *) x. Monad m => (x -> Bool) -> Splitter m [x]
statelessSplitter (\Char
ch-> Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')
line :: forall m. Monad m => Splitter m String
line :: forall (m :: * -> *). Monad m => Splitter m String
line = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d String ())
-> Splitter m String
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter ((forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
(d :: * -> *).
OpenSplitter m a1 a2 a3 d String ())
-> Splitter m String)
-> (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
(d :: * -> *).
OpenSplitter m a1 a2 a3 d String ())
-> Splitter m String
forall a b. (a -> b) -> a -> b
$ \Source m a1 String
source Sink m a2 String
true Sink m a3 String
false->
let loop :: Coroutine d m ()
loop = Source m a1 String -> Coroutine d m (Maybe Char)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Source m a [x] -> Coroutine d m (Maybe x)
peek Source m a1 String
source Coroutine d m (Maybe Char)
-> (Maybe Char -> Coroutine d m ()) -> Coroutine d m ()
forall a b.
Coroutine d m a -> (a -> Coroutine d m b) -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine d m ()
-> (Char -> Coroutine d m ()) -> Maybe Char -> Coroutine d m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Coroutine d m ()
forall a. a -> Coroutine d m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (( Coroutine d m () -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
loop) (Coroutine d m () -> Coroutine d m ())
-> (Char -> Coroutine d m ()) -> Char -> Coroutine d m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Coroutine d m ()
forall {d :: * -> *}.
(AncestorFunctor a1 d, AncestorFunctor a2 d,
AncestorFunctor a3 d) =>
Char -> Coroutine d m ()
splitLine)
lineChar :: Char -> Bool
lineChar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'
lineEndParser :: Parser t String String
lineEndParser = String -> Parser t String String
forall s t.
(LeftReductive s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string String
"\r\n" Parser t String String
-> Parser t String String -> Parser t String String
forall s t r.
Monoid s =>
Parser t s r -> Parser t s r -> Parser t s r
<<|> String -> Parser t String String
forall s t.
(LeftReductive s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string String
"\n\r" Parser t String String
-> Parser t String String -> Parser t String String
forall s t r.
Monoid s =>
Parser t s r -> Parser t s r -> Parser t s r
<<|> String -> Parser t String String
forall s t.
(LeftReductive s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string String
"\r" Parser t String String
-> Parser t String String -> Parser t String String
forall s t r.
Monoid s =>
Parser t s r -> Parser t s r -> Parser t s r
<<|> String -> Parser t String String
forall s t.
(LeftReductive s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string String
"\n"
splitLine :: Char -> Coroutine d m ()
splitLine Char
c = if Char -> Bool
lineChar Char
c then (String -> Bool)
-> Source m a1 String -> Sink m a2 String -> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a1 d,
AncestorFunctor a2 d) =>
(x -> Bool) -> Source m a1 x -> Sink m a2 x -> Coroutine d m ()
pourWhile (Char -> Bool
lineChar (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. HasCallStack => [a] -> a
head) Source m a1 String
source Sink m a2 String
true else Sink m a2 String
-> forall (d :: * -> *).
AncestorFunctor a2 d =>
String -> Coroutine d m String
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a2 String
true String
forall a. Monoid a => a
mempty
Coroutine d m String -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Any String String
-> Source m a1 String -> Sink m a3 String -> Coroutine d m ()
forall (m :: * -> *) p (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *)
x y.
(Monad m, MonoidNull x, MonoidNull y, AncestorFunctor a1 d,
AncestorFunctor a2 d) =>
Parser p x y -> Source m a1 x -> Sink m a2 y -> Coroutine d m ()
pourParsed Parser Any String String
forall {t}. Parser t String String
lineEndParser Source m a1 String
source Sink m a3 String
false
in Coroutine d m ()
loop
everything :: forall m x. Monad m => Splitter m x
everything :: forall (m :: * -> *) x. Monad m => Splitter m x
everything = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter (\Source m a1 x
source Sink m a2 x
true Sink m a3 x
_false-> Source m a1 x -> Sink m a2 x -> Coroutine d m Bool
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, Monoid x, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
Source m a1 x -> Sink m a2 x -> Coroutine d m Bool
pour Source m a1 x
source Sink m a2 x
true Coroutine d m Bool
-> (Bool -> Coroutine d m ()) -> Coroutine d m ()
forall a b.
Coroutine d m a -> (a -> Coroutine d m b) -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> Coroutine d m () -> Coroutine d m ())
-> Coroutine d m () -> Bool -> Coroutine d m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Coroutine d m () -> Coroutine d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Sink m a2 x
-> forall (d :: * -> *).
AncestorFunctor a2 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a2 x
true x
forall a. Monoid a => a
mempty Coroutine d m x -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
forall a. a -> Coroutine d m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
nothing :: forall m x. (Monad m, Monoid x) => Splitter m x
nothing :: forall (m :: * -> *) x. (Monad m, Monoid x) => Splitter m x
nothing = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter (\Source m a1 x
source Sink m a2 x
_true Sink m a3 x
false-> Source m a1 x -> Sink m a3 x -> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, Monoid x, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
Source m a1 x -> Sink m a2 x -> Coroutine d m ()
pour_ Source m a1 x
source Sink m a3 x
false)
one :: forall m x. (Monad m, FactorialMonoid x) => Splitter m x
one :: forall (m :: * -> *) x.
(Monad m, FactorialMonoid x) =>
Splitter m x
one = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter (\Source m a1 x
source Sink m a2 x
true Sink m a3 x
false-> Source m a1 x -> (x -> Coroutine d m ()) -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
Source m a x -> (x -> Coroutine d m ()) -> Coroutine d m ()
getWith Source m a1 x
source ((x -> Coroutine d m ()) -> Coroutine d m ())
-> (x -> Coroutine d m ()) -> Coroutine d m ()
forall a b. (a -> b) -> a -> b
$
\x
x-> Sink m a2 x
-> forall (d :: * -> *).
AncestorFunctor a2 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a2 x
true x
x
Coroutine d m x -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (x -> Coroutine d m x) -> Source m a1 x -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x r.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
(x -> Coroutine d m r) -> Source m a x -> Coroutine d m ()
mapMStream_ (\x
x-> Sink m a3 x
-> forall (d :: * -> *).
AncestorFunctor a3 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a3 x
false x
forall a. Monoid a => a
mempty Coroutine d m x -> Coroutine d m x -> Coroutine d m x
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sink m a2 x
-> forall (d :: * -> *).
AncestorFunctor a2 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a2 x
true x
x) Source m a1 x
source)
marked :: forall m x y. (Monad m, Eq y) => Splitter m [Markup y x]
marked :: forall (m :: * -> *) x y.
(Monad m, Eq y) =>
Splitter m [Markup y x]
marked = (y -> Bool) -> Splitter m [Markup y x]
forall (m :: * -> *) x y.
(Monad m, Eq y) =>
(y -> Bool) -> Splitter m [Markup y x]
markedWith (Bool -> y -> Bool
forall a b. a -> b -> a
const Bool
True)
markedContent :: forall m x y. (Monad m, Eq y) => Splitter m [Markup y x]
markedContent :: forall (m :: * -> *) x y.
(Monad m, Eq y) =>
Splitter m [Markup y x]
markedContent = (y -> Bool) -> Splitter m [Markup y x]
forall (m :: * -> *) x y.
(Monad m, Eq y) =>
(y -> Bool) -> Splitter m [Markup y x]
contentMarkedWith (Bool -> y -> Bool
forall a b. a -> b -> a
const Bool
True)
markedWith :: forall m x y. (Monad m, Eq y) => (y -> Bool) -> Splitter m [Markup y x]
markedWith :: forall (m :: * -> *) x y.
(Monad m, Eq y) =>
(y -> Bool) -> Splitter m [Markup y x]
markedWith y -> Bool
select = (([y], Bool) -> Markup y x -> (([y], Bool), Bool))
-> ([y], Bool) -> Splitter m [Markup y x]
forall (m :: * -> *) state x.
Monad m =>
(state -> x -> (state, Bool)) -> state -> Splitter m [x]
statefulSplitter ([y], Bool) -> Markup y x -> (([y], Bool), Bool)
forall {x}. ([y], Bool) -> Markup y x -> (([y], Bool), Bool)
transition ([], Bool
False)
where transition :: ([y], Bool) -> Markup y x -> (([y], Bool), Bool)
transition s :: ([y], Bool)
s@([], Bool
_) Content{} = (([y], Bool)
s, Bool
False)
transition s :: ([y], Bool)
s@([y]
_, Bool
truth) Content{} = (([y], Bool)
s, Bool
truth)
transition s :: ([y], Bool)
s@([], Bool
_) (Markup (Point y
y)) = (([y], Bool)
s, y -> Bool
select y
y)
transition s :: ([y], Bool)
s@([y]
_, Bool
truth) (Markup (Point y
_)) = (([y], Bool)
s, Bool
truth)
transition ([], Bool
_) (Markup (Start y
y)) = (([y
y], y -> Bool
select y
y), y -> Bool
select y
y)
transition ([y]
open, Bool
truth) (Markup (Start y
y)) = ((y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
open, Bool
truth), Bool
truth)
transition ([y]
open, Bool
truth) (Markup (End y
y)) = Bool -> (([y], Bool), Bool) -> (([y], Bool), Bool)
forall a. HasCallStack => Bool -> a -> a
assert (y -> [y] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem y
y [y]
open) ((y -> [y] -> [y]
forall a. Eq a => a -> [a] -> [a]
delete y
y [y]
open, Bool
truth), Bool
truth)
contentMarkedWith :: forall m x y. (Monad m, Eq y) => (y -> Bool) -> Splitter m [Markup y x]
contentMarkedWith :: forall (m :: * -> *) x y.
(Monad m, Eq y) =>
(y -> Bool) -> Splitter m [Markup y x]
contentMarkedWith y -> Bool
select = (([y], Bool) -> Markup y x -> (([y], Bool), Bool))
-> ([y], Bool) -> Splitter m [Markup y x]
forall (m :: * -> *) state x.
Monad m =>
(state -> x -> (state, Bool)) -> state -> Splitter m [x]
statefulSplitter ([y], Bool) -> Markup y x -> (([y], Bool), Bool)
forall {x}. ([y], Bool) -> Markup y x -> (([y], Bool), Bool)
transition ([], Bool
False)
where transition :: ([y], Bool) -> Markup y x -> (([y], Bool), Bool)
transition s :: ([y], Bool)
s@([y]
_, Bool
truth) Content{} = (([y], Bool)
s, Bool
truth)
transition s :: ([y], Bool)
s@([y]
_, Bool
truth) (Markup Point{}) = (([y], Bool)
s, Bool
truth)
transition ([], Bool
_) (Markup (Start y
y)) = (([y
y], y -> Bool
select y
y), Bool
False)
transition ([y]
open, Bool
truth) (Markup (Start y
y)) = ((y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
open, Bool
truth), Bool
truth)
transition ([y]
open, Bool
truth) (Markup (End y
y)) = Bool -> (([y], Bool), Bool) -> (([y], Bool), Bool)
forall a. HasCallStack => Bool -> a -> a
assert (y -> [y] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem y
y [y]
open) (let open' :: [y]
open' = y -> [y] -> [y]
forall a. Eq a => a -> [a] -> [a]
delete y
y [y]
open
truth' :: Bool
truth' = Bool -> Bool
not ([y] -> Bool
forall m. MonoidNull m => m -> Bool
null [y]
open') Bool -> Bool -> Bool
&& Bool
truth
in (([y]
open', Bool
truth'), Bool
truth'))
data OccurenceTag = Occurence Int deriving (OccurenceTag -> OccurenceTag -> Bool
(OccurenceTag -> OccurenceTag -> Bool)
-> (OccurenceTag -> OccurenceTag -> Bool) -> Eq OccurenceTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OccurenceTag -> OccurenceTag -> Bool
== :: OccurenceTag -> OccurenceTag -> Bool
$c/= :: OccurenceTag -> OccurenceTag -> Bool
/= :: OccurenceTag -> OccurenceTag -> Bool
Eq, Int -> OccurenceTag -> String -> String
[OccurenceTag] -> String -> String
OccurenceTag -> String
(Int -> OccurenceTag -> String -> String)
-> (OccurenceTag -> String)
-> ([OccurenceTag] -> String -> String)
-> Show OccurenceTag
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OccurenceTag -> String -> String
showsPrec :: Int -> OccurenceTag -> String -> String
$cshow :: OccurenceTag -> String
show :: OccurenceTag -> String
$cshowList :: [OccurenceTag] -> String -> String
showList :: [OccurenceTag] -> String -> String
Show)
instance Enum OccurenceTag where
succ :: OccurenceTag -> OccurenceTag
succ (Occurence Int
n) = Int -> OccurenceTag
Occurence (Int -> Int
forall a. Enum a => a -> a
succ Int
n)
pred :: OccurenceTag -> OccurenceTag
pred (Occurence Int
n) = Int -> OccurenceTag
Occurence (Int -> Int
forall a. Enum a => a -> a
pred Int
n)
toEnum :: Int -> OccurenceTag
toEnum = Int -> OccurenceTag
Occurence
fromEnum :: OccurenceTag -> Int
fromEnum (Occurence Int
n) = Int
n
parseSubstring :: forall m x. (Monad m, Eq x, LeftReductiveMonoid x, FactorialMonoid x) => x -> Parser m x OccurenceTag
parseSubstring :: forall (m :: * -> *) x.
(Monad m, Eq x, LeftReductiveMonoid x, FactorialMonoid x) =>
x -> Parser m x OccurenceTag
parseSubstring x
s =
case x -> Maybe (x, x)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix x
s
of Maybe (x, x)
Nothing -> (forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
OpenTransducer m a1 a2 d x [Markup OccurenceTag x] ())
-> Parser m x OccurenceTag
forall (m :: * -> *) x y.
(forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
OpenTransducer m a1 a2 d x y ())
-> Transducer m x y
Transducer ((forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
OpenTransducer m a1 a2 d x [Markup OccurenceTag x] ())
-> Parser m x OccurenceTag)
-> (forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
OpenTransducer m a1 a2 d x [Markup OccurenceTag x] ())
-> Parser m x OccurenceTag
forall a b. (a -> b) -> a -> b
$
\ Source m a1 x
source Sink m a2 [Markup OccurenceTag x]
sink -> Sink m a2 [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m a2 [Markup OccurenceTag x]
sink Markup OccurenceTag x
forall {x}. Markup OccurenceTag x
marker Coroutine d m () -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (x -> [Markup OccurenceTag x])
-> Source m a1 x
-> Sink m a2 [Markup OccurenceTag x]
-> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x
y.
(Monad m, FactorialMonoid x, Monoid y, AncestorFunctor a1 d,
AncestorFunctor a2 d) =>
(x -> y) -> Source m a1 x -> Sink m a2 y -> Coroutine d m ()
mapStream (\x
x-> [x -> Markup OccurenceTag x
forall y x. x -> Markup y x
Content x
x, Markup OccurenceTag x
forall {x}. Markup OccurenceTag x
marker]) Source m a1 x
source Sink m a2 [Markup OccurenceTag x]
sink
where marker :: Markup OccurenceTag x
marker = Boundary OccurenceTag -> Markup OccurenceTag x
forall y x. Boundary y -> Markup y x
Markup (OccurenceTag -> Boundary OccurenceTag
forall y. y -> Boundary y
Point (Int -> OccurenceTag
forall a. Enum a => Int -> a
toEnum Int
1))
Just (x
first, x
rest)->
(forall (d :: * -> *).
Functor d =>
Source m d x
-> Sink m d [Markup OccurenceTag x] -> Coroutine d m ())
-> Parser m x OccurenceTag
forall (m :: * -> *) x y.
(Monad m, Monoid x) =>
(forall (d :: * -> *).
Functor d =>
Source m d x -> Sink m d y -> Coroutine d m ())
-> Transducer m x y
isolateTransducer ((forall (d :: * -> *).
Functor d =>
Source m d x
-> Sink m d [Markup OccurenceTag x] -> Coroutine d m ())
-> Parser m x OccurenceTag)
-> (forall (d :: * -> *).
Functor d =>
Source m d x
-> Sink m d [Markup OccurenceTag x] -> Coroutine d m ())
-> Parser m x OccurenceTag
forall a b. (a -> b) -> a -> b
$ \ Source m d x
source Sink m d [Markup OccurenceTag x]
sink ->
(Sink m (SinkFunctor d x) x -> Coroutine (SinkFunctor d x) m ())
-> (Source m (SourceFunctor d x) x
-> Coroutine (SourceFunctor d x) m ())
-> Coroutine d m ((), ())
forall (m :: * -> *) (a :: * -> *) (a1 :: * -> *) (a2 :: * -> *) x
r1 r2.
(Monad m, Monoid x, Functor a, a1 ~ SinkFunctor a x,
a2 ~ SourceFunctor a x) =>
(Sink m a1 x -> Coroutine a1 m r1)
-> (Source m a2 x -> Coroutine a2 m r2) -> Coroutine a m (r1, r2)
pipe (\Sink m (SinkFunctor d x) x
sink'->
let findFirst :: Coroutine (SinkFunctor d x) m ()
findFirst = (x -> Bool)
-> Source m d x
-> Sink m (SinkFunctor d x) x
-> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a1 d,
AncestorFunctor a2 d) =>
(x -> Bool) -> Source m a1 x -> Sink m a2 x -> Coroutine d m ()
pourWhile (x -> x -> Bool
forall a. Eq a => a -> a -> Bool
/= x
first) Source m d x
source Sink m (SinkFunctor d x) x
sink'
Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine (SinkFunctor d x) m ()
test
test :: Coroutine (SinkFunctor d x) m ()
test = Parser Any x x -> Source m d x -> Coroutine (SinkFunctor d x) m x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) p x y.
(Monad m, Monoid x, Monoid y, AncestorFunctor a d) =>
Parser p x y -> Source m a x -> Coroutine d m y
getParsed (x -> Parser Any x x
forall s t.
(LeftReductive s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string x
s) Source m d x
source
Coroutine (SinkFunctor d x) m x
-> (x -> Coroutine (SinkFunctor d x) m ())
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> (a -> Coroutine (SinkFunctor d x) m b)
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x
t-> if x -> Bool
forall m. MonoidNull m => m -> Bool
null x
t
then Source m d x
-> (x -> Coroutine (SinkFunctor d x) m ())
-> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
Source m a x -> (x -> Coroutine d m ()) -> Coroutine d m ()
getWith Source m d x
source (\x
x-> Sink m d [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m d [Markup OccurenceTag x]
sink (x -> Markup OccurenceTag x
forall y x. x -> Markup y x
Content x
x) Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine (SinkFunctor d x) m ()
findFirst)
else Sink m d [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m d [Markup OccurenceTag x]
sink (Boundary OccurenceTag -> Markup OccurenceTag x
forall y x. Boundary y -> Markup y x
Markup (OccurenceTag -> Boundary OccurenceTag
forall y. y -> Boundary y
Start (Int -> OccurenceTag
forall a. Enum a => Int -> a
toEnum Int
0)))
Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sink m d [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m d [Markup OccurenceTag x]
sink Markup OccurenceTag x
forall {y}. Markup y x
prefixContent
Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> if x -> Bool
forall m. MonoidNull m => m -> Bool
null x
shared then Sink m d [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m d [Markup OccurenceTag x]
sink (Boundary OccurenceTag -> Markup OccurenceTag x
forall y x. Boundary y -> Markup y x
Markup (OccurenceTag -> Boundary OccurenceTag
forall y. y -> Boundary y
End (Int -> OccurenceTag
forall a. Enum a => Int -> a
toEnum Int
0))) Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine (SinkFunctor d x) m ()
findFirst
else Int -> Coroutine (SinkFunctor d x) m ()
testOverlap Int
0
testOverlap :: Int -> Coroutine (SinkFunctor d x) m ()
testOverlap Int
n = Parser Any x x -> Source m d x -> Coroutine (SinkFunctor d x) m x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) p x y.
(Monad m, Monoid x, Monoid y, AncestorFunctor a d) =>
Parser p x y -> Source m a x -> Coroutine d m y
getParsed (x -> Parser Any x x
forall s t.
(LeftReductive s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string x
postfix) Source m d x
source
Coroutine (SinkFunctor d x) m x
-> (x -> Coroutine (SinkFunctor d x) m ())
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> (a -> Coroutine (SinkFunctor d x) m b)
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x
t-> if x -> Bool
forall m. MonoidNull m => m -> Bool
null x
t
then [Int]
-> (Int -> Coroutine (SinkFunctor d x) m ())
-> Coroutine (SinkFunctor d x) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxOverlaps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
n]
(\Int
i-> Sink m d [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m d [Markup OccurenceTag x]
sink Markup OccurenceTag x
forall {y}. Markup y x
sharedContent
Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sink m d [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m d [Markup OccurenceTag x]
sink (Boundary OccurenceTag -> Markup OccurenceTag x
forall y x. Boundary y -> Markup y x
Markup (OccurenceTag -> Boundary OccurenceTag
forall y. y -> Boundary y
End (Int -> OccurenceTag
forall a. Enum a => Int -> a
toEnum Int
i))))
Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine (SinkFunctor d x) m ()
findFirst
else let n' :: Int
n' = Int -> Int
forall a. Enum a => a -> a
succ Int
n
in Sink m d [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m d [Markup OccurenceTag x]
sink (Boundary OccurenceTag -> Markup OccurenceTag x
forall y x. Boundary y -> Markup y x
Markup (OccurenceTag -> Boundary OccurenceTag
forall y. y -> Boundary y
Start (Int -> OccurenceTag
forall a. Enum a => Int -> a
toEnum Int
n')))
Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sink m d [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m d [Markup OccurenceTag x]
sink Markup OccurenceTag x
forall {y}. Markup y x
prefixContent
Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxOverlaps)
(Sink m d [Markup OccurenceTag x]
-> Markup OccurenceTag x -> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m d [Markup OccurenceTag x]
sink (Boundary OccurenceTag -> Markup OccurenceTag x
forall y x. Boundary y -> Markup y x
Markup (OccurenceTag -> Boundary OccurenceTag
forall y. y -> Boundary y
End (Int -> OccurenceTag
forall a. Enum a => Int -> a
toEnum (Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxOverlaps)))))
Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
-> Coroutine (SinkFunctor d x) m ()
forall a b.
Coroutine (SinkFunctor d x) m a
-> Coroutine (SinkFunctor d x) m b
-> Coroutine (SinkFunctor d x) m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Coroutine (SinkFunctor d x) m ()
testOverlap Int
n'
(x
prefix, x
shared, x
postfix) = x -> x -> (x, x, x)
forall x.
(LeftReductiveMonoid x, FactorialMonoid x) =>
x -> x -> (x, x, x)
overlap x
s x
s
maxOverlaps :: Int
maxOverlaps = (x -> Int
forall m. Factorial m => m -> Int
length x
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` x -> Int
forall m. Factorial m => m -> Int
length x
prefix
prefixContent :: Markup y x
prefixContent = x -> Markup y x
forall y x. x -> Markup y x
Content x
prefix
sharedContent :: Markup y x
sharedContent = x -> Markup y x
forall y x. x -> Markup y x
Content x
shared
in Coroutine (SinkFunctor d x) m ()
findFirst)
(\Source m (SourceFunctor d x) x
src-> (x -> [Markup OccurenceTag x])
-> Source m (SourceFunctor d x) x
-> Sink m d [Markup OccurenceTag x]
-> Coroutine (SourceFunctor d x) m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x
y.
(Monad m, Monoid x, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
(x -> y) -> Source m a1 x -> Sink m a2 y -> Coroutine d m ()
mapStreamChunks ((Markup OccurenceTag x
-> [Markup OccurenceTag x] -> [Markup OccurenceTag x]
forall a. a -> [a] -> [a]
: []) (Markup OccurenceTag x -> [Markup OccurenceTag x])
-> (x -> Markup OccurenceTag x) -> x -> [Markup OccurenceTag x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Markup OccurenceTag x
forall y x. x -> Markup y x
Content) Source m (SourceFunctor d x) x
src Sink m d [Markup OccurenceTag x]
sink)
Coroutine d m ((), ()) -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
forall a. a -> Coroutine d m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
substring :: forall m x. (Monad m, Eq x, LeftReductiveMonoid x, FactorialMonoid x) => x -> Splitter m x
substring :: forall (m :: * -> *) x.
(Monad m, Eq x, LeftReductiveMonoid x, FactorialMonoid x) =>
x -> Splitter m x
substring x
s =
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter ((forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
(d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x)
-> (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
(d :: * -> *).
OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
forall a b. (a -> b) -> a -> b
$ \ Source m a1 x
source Sink m a2 x
true Sink m a3 x
false ->
case x -> Maybe (x, x)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix x
s
of Maybe (x, x)
Nothing -> Sink m a2 x
-> forall (d :: * -> *).
AncestorFunctor a2 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a2 x
true x
forall a. Monoid a => a
mempty
Coroutine d m x -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (x -> Coroutine d m x) -> Source m a1 x -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x r.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
(x -> Coroutine d m r) -> Source m a x -> Coroutine d m ()
mapMStream_ (\x
x-> Sink m a3 x
-> forall (d :: * -> *).
AncestorFunctor a3 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a3 x
false x
x Coroutine d m x -> Coroutine d m x -> Coroutine d m x
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sink m a2 x
-> forall (d :: * -> *).
AncestorFunctor a2 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a2 x
true x
forall a. Monoid a => a
mempty) Source m a1 x
source
Just (x
first, x
rest) ->
let findFirst :: Coroutine d m ()
findFirst = (x -> Bool) -> Source m a1 x -> Sink m a3 x -> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a1 d,
AncestorFunctor a2 d) =>
(x -> Bool) -> Source m a1 x -> Sink m a2 x -> Coroutine d m ()
pourWhile (x -> x -> Bool
forall a. Eq a => a -> a -> Bool
/= x
first) Source m a1 x
source Sink m a3 x
false
Coroutine d m () -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
test
test :: Coroutine d m ()
test = Parser Any x x -> Source m a1 x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) p x y.
(Monad m, Monoid x, Monoid y, AncestorFunctor a d) =>
Parser p x y -> Source m a x -> Coroutine d m y
getParsed (x -> Parser Any x x
forall s t.
(LeftReductive s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string x
s) Source m a1 x
source
Coroutine d m x -> (x -> Coroutine d m ()) -> Coroutine d m ()
forall a b.
Coroutine d m a -> (a -> Coroutine d m b) -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x
t-> if x -> Bool
forall m. MonoidNull m => m -> Bool
null x
t
then Source m a1 x -> (x -> Coroutine d m ()) -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
Source m a x -> (x -> Coroutine d m ()) -> Coroutine d m ()
getWith Source m a1 x
source (\x
x-> Sink m a3 x
-> forall (d :: * -> *).
AncestorFunctor a3 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a3 x
false x
x Coroutine d m x -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
findFirst)
else Sink m a3 x
-> forall (d :: * -> *).
AncestorFunctor a3 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a3 x
false x
forall a. Monoid a => a
mempty
Coroutine d m x -> Coroutine d m x -> Coroutine d m x
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> x -> Sink m a2 x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll x
prefix Sink m a2 x
true
Coroutine d m x -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> if x -> Bool
forall m. MonoidNull m => m -> Bool
null x
shared then Coroutine d m ()
findFirst else Coroutine d m ()
testOverlap
testOverlap :: Coroutine d m ()
testOverlap = Parser Any x x -> Source m a1 x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) p x y.
(Monad m, Monoid x, Monoid y, AncestorFunctor a d) =>
Parser p x y -> Source m a x -> Coroutine d m y
getParsed (x -> Parser Any x x
forall s t.
(LeftReductive s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string x
postfix) Source m a1 x
source
Coroutine d m x -> (x -> Coroutine d m ()) -> Coroutine d m ()
forall a b.
Coroutine d m a -> (a -> Coroutine d m b) -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x
t-> if x -> Bool
forall m. MonoidNull m => m -> Bool
null x
t
then x -> Sink m a2 x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll x
shared Sink m a2 x
true Coroutine d m x -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
findFirst
else Sink m a3 x
-> forall (d :: * -> *).
AncestorFunctor a3 d =>
x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
AncestorFunctor a d =>
x -> Coroutine d m x
putChunk Sink m a3 x
false x
forall a. Monoid a => a
mempty
Coroutine d m x -> Coroutine d m x -> Coroutine d m x
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> x -> Sink m a2 x -> Coroutine d m x
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll x
prefix Sink m a2 x
true
Coroutine d m x -> Coroutine d m () -> Coroutine d m ()
forall a b. Coroutine d m a -> Coroutine d m b -> Coroutine d m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
testOverlap
(x
prefix, x
shared, x
postfix) = x -> x -> (x, x, x)
forall x.
(LeftReductiveMonoid x, FactorialMonoid x) =>
x -> x -> (x, x, x)
overlap x
s x
s
in Coroutine d m ()
findFirst
overlap :: (LeftReductiveMonoid x, FactorialMonoid x) => x -> x -> (x, x, x)
overlap :: forall x.
(LeftReductiveMonoid x, FactorialMonoid x) =>
x -> x -> (x, x, x)
overlap x
e x
s | x -> Bool
forall m. MonoidNull m => m -> Bool
null x
e = (x
e, x
e, x
s)
overlap x
s1 x
s2 = case x -> Maybe (x, x)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix x
s1
of Maybe (x, x)
Nothing -> (x
s1, x
s1, x
s2)
Just (x
head, x
tail) -> case x -> x -> Maybe x
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix x
tail x
s2
of Just x
rest -> (x
head, x
tail, x
rest)
Maybe x
Nothing -> let (x
o1, x
o2, x
o3) = x -> x -> (x, x, x)
forall x.
(LeftReductiveMonoid x, FactorialMonoid x) =>
x -> x -> (x, x, x)
overlap x
tail x
s2
in (x -> x -> x
forall a. Monoid a => a -> a -> a
mappend x
head x
o1, x
o2, x
o3)
cond :: a -> a -> Bool -> a
cond :: forall a. a -> a -> Bool -> a
cond a
x a
y Bool
test = if Bool
test then a
x else a
y