{- 
    Copyright 2008-2013 Mario Blazevic

    This file is part of the Streaming Component Combinators (SCC) project.

    The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public
    License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later
    version.

    SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
    of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along with SCC.  If not, see
    <http://www.gnu.org/licenses/>.
-}

-- | Module "Primitives" defines primitive components of 'Producer', 'Consumer', 'Transducer' and 'Splitter' types,
-- defined in the "Types" module.

{-# LANGUAGE ScopedTypeVariables, Rank2Types #-}
{-# OPTIONS_HADDOCK hide #-}

module Control.Concurrent.SCC.Primitives (
   -- * I/O components
   -- ** I/O producers
   fromFile, fromHandle, fromStdIn, fromBinaryHandle,
   -- ** I/O consumers
   appendFile, toFile, toHandle, toStdOut, toBinaryHandle,
   -- * Generic components
   produceFrom, 
   -- ** Generic consumers
   suppress, erroneous, consumeInto,
   -- ** Generic transducers
   parse, unparse, parseSubstring, OccurenceTag, count, toString,
   -- *** List stream transducers
   -- | The following laws hold:
   --
   --    * 'group' '>>>' 'concatenate' == 'id'
   --
   --    * 'concatenate' == 'concatSeparate' []
   group, concatenate, concatSeparate,
   -- ** Generic splitters
   everything, nothing, marked, markedContent, markedWith, contentMarkedWith, one, substring,
   -- * Character stream components
   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)

-- | Collects the entire input source into the return value.
consumeInto :: forall m x. (Monad m, Monoid x) => Consumer m x x
consumeInto :: 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 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

-- | Produces the contents of the given argument.
produceFrom :: forall m x. (Monad m, MonoidNull x) => x -> Producer m x ()
produceFrom :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
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)

-- | Consumer 'toStdOut' copies the given source into the standard output.
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 (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))

-- | Producer 'fromStdIn' feeds the given sink from the standard input.
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty) ((Text -> Text) -> IO Text -> IO Text
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)))

-- | Reads the named file and feeds the given sink from its contents.
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 (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 () -> Sink IO a Text -> Coroutine d IO ()
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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handle -> IO ()
hClose Handle
handle)

-- | Feeds the given sink from the open text file /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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty) ((Text -> Text) -> IO Text -> IO Text
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)))

-- | Feeds the given sink from the open binary file /handle/. The argument /chunkSize/ determines the size of the chunks
-- read from the 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 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 (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 (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 -> 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 (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))

-- | Creates the named text file and writes the entire given source to it.
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 (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 () -> Source IO a Text -> Coroutine d IO ()
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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handle -> IO ()
hClose Handle
handle)

-- | Appends the given source to the named text file.
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 (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 () -> Source IO a Text -> Coroutine d IO ()
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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handle -> IO ()
hClose Handle
handle)

-- | Copies the given source into the open text file /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 (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))

-- | Copies the given source into the open binary file /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 (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))

-- | Transducer 'unparse' removes all markup from its input and passes the content through.
unparse :: forall m x b. (Monad m, Monoid x) => Transducer m [Markup b x] x
unparse :: 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 p y. Monoid p => Markup y p -> p
removeTag
   where removeTag :: Markup y p -> p
removeTag (Content p
x) = p
x
         removeTag Markup y p
_ = p
forall a. Monoid a => a
mempty

-- | Transducer 'parse' prepares input content for subsequent parsing.
parse :: forall m x y. (Monad m, Monoid x) => Parser m x y
parse :: Parser m x y
parse = (x -> [Markup y x]) -> Parser m x y
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)

-- | The 'suppress' consumer suppresses all input it receives. It is equivalent to 'substitute' []
suppress :: forall m x. Monad m => Consumer m x ()
suppress :: 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 (\(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))

-- | The 'erroneous' consumer reports an error if any input reaches it.
erroneous :: forall m x. (Monad m, MonoidNull x) => String -> Consumer m x ()
erroneous :: 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)))

-- | The 'lowercase' transforms all uppercase letters in the input to lowercase, leaving the rest unchanged.
lowercase :: forall m. Monad m => Transducer m String String
lowercase :: 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)

-- | The 'uppercase' transforms all lowercase letters in the input to uppercase, leaving the rest unchanged.
uppercase :: forall m. Monad m => Transducer m String String
uppercase :: 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)

-- | The 'count' transducer counts all its input values and outputs the final tally.
count :: forall m x. (Monad m, FactorialMonoid x) => Transducer m x [Integer]
count :: 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 (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)

-- | Converts each input value @x@ to @show x@.
toString :: forall m x. (Monad m, Show x) => Transducer m [x] [String]
toString :: 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)

-- | Transducer 'group' collects all its input into a single list item.
group :: forall m x. (Monad m, Monoid x) => Transducer m x [x]
group :: 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 (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)

-- | Transducer 'concatenate' flattens the input stream of lists of values into the output stream of values.
concatenate :: forall m x. (Monad m, Monoid x) => Transducer m [x] x
concatenate :: 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

-- | Same as 'concatenate' except it inserts the given separator list between every two input lists.
concatSeparate :: forall m x. (Monad m, MonoidNull x) => x -> Transducer m [x] x
concatSeparate :: 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

-- | Splitter 'whitespace' feeds all white-space characters into its /true/ sink, all others into /false/.
whitespace :: forall m. Monad m => Splitter m String
whitespace :: Splitter m String
whitespace = (Char -> Bool) -> Splitter m String
forall (m :: * -> *) x. Monad m => (x -> Bool) -> Splitter m [x]
statelessSplitter Char -> Bool
isSpace

-- | Splitter 'letters' feeds all alphabetical characters into its /true/ sink, all other characters into
-- | /false/.
letters :: forall m. Monad m => Splitter m String
letters :: Splitter m String
letters = (Char -> Bool) -> Splitter m String
forall (m :: * -> *) x. Monad m => (x -> Bool) -> Splitter m [x]
statelessSplitter Char -> Bool
isAlpha

-- | Splitter 'digits' feeds all digits into its /true/ sink, all other characters into /false/.
digits :: forall m. Monad m => Splitter m String
digits :: Splitter m String
digits = (Char -> Bool) -> Splitter m String
forall (m :: * -> *) x. Monad m => (x -> Bool) -> Splitter m [x]
statelessSplitter Char -> Bool
isDigit

-- | Splitter 'nonEmptyLine' feeds line-ends into its /false/ sink, and all other characters into /true/.
nonEmptyLine :: forall m. Monad m => Splitter m String
nonEmptyLine :: 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')

-- | 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 :: forall m. Monad m => Splitter m String
line :: 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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()) (( Coroutine d m () -> Coroutine d m () -> Coroutine d m ()
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.
(LeftReductiveMonoid 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.
(LeftReductiveMonoid 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.
(LeftReductiveMonoid 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.
(LeftReductiveMonoid 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. [a] -> a
head) Source m a1 String
source Sink m a2 String
true else Sink m a2 String -> 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 (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

-- | Splitter 'everything' feeds its entire input into its /true/ sink.
everything :: forall m x. Monad m => Splitter m x
everything :: 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 (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 -> 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))

-- | Splitter 'nothing' feeds its entire input into its /false/ sink.
nothing :: forall m x. (Monad m, Monoid x) => Splitter m x
nothing :: 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)

-- | Splitter 'one' feeds all input values to its /true/ sink, treating every value as a separate section.
one :: forall m x. (Monad m, FactorialMonoid x) => Splitter m x
one :: 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 -> 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 (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 -> 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sink m a2 x -> 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)

-- | Splitter 'marked' passes all marked-up input sections to its /true/ sink, and all unmarked input to its
-- /false/ sink.
marked :: forall m x y. (Monad m, Eq y) => Splitter m [Markup y x]
marked :: 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)

-- | Splitter 'markedContent' passes the content of all marked-up input sections to its /true/ sink, takeWhile the
-- outermost tags and all unmarked input go to its /false/ sink.
markedContent :: forall m x y. (Monad m, Eq y) => Splitter m [Markup y x]
markedContent :: 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)

-- | Splitter 'markedWith' passes input sections marked-up with the appropriate tag to its /true/ sink, and the
-- rest of the input to its /false/ sink. The argument /select/ determines if the tag is appropriate.
markedWith :: forall m x y. (Monad m, Eq y) => (y -> Bool) -> Splitter m [Markup y x]
markedWith :: (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 (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)

-- | Splitter 'contentMarkedWith' passes the content of input sections marked-up with the appropriate tag to
-- its /true/ sink, and the rest of the input to its /false/ sink. The argument /select/ determines if the tag is
-- appropriate.
contentMarkedWith :: forall m x y. (Monad m, Eq y) => (y -> Bool) -> Splitter m [Markup y x]
contentMarkedWith :: (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 (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'))

-- | Used by 'parseSubstring' to distinguish between overlapping substrings.
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
/= :: OccurenceTag -> OccurenceTag -> Bool
$c/= :: OccurenceTag -> OccurenceTag -> Bool
== :: OccurenceTag -> OccurenceTag -> Bool
$c== :: 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
showList :: [OccurenceTag] -> String -> String
$cshowList :: [OccurenceTag] -> String -> String
show :: OccurenceTag -> String
$cshow :: OccurenceTag -> String
showsPrec :: Int -> OccurenceTag -> String -> String
$cshowsPrec :: Int -> 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

-- | Performs the same task as the 'substring' splitter, but instead of splitting it outputs the input as @'Markup' x
-- 'OccurenceTag'@ in order to distinguish overlapping strings.
parseSubstring :: forall m x. (Monad m, Eq x, LeftReductiveMonoid x, FactorialMonoid x) => x -> Parser m x OccurenceTag
parseSubstring :: 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 (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 (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.
(LeftReductiveMonoid 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 (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 (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 (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 (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 (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.
(LeftReductiveMonoid 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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | 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, both are sent to /true/ and each is preceded
-- by an empty chunk on /false/.
substring :: forall m x. (Monad m, Eq x, LeftReductiveMonoid x, FactorialMonoid x) => x -> Splitter m x
substring :: 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 -> 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 (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 -> 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sink m a2 x -> 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 (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.
(LeftReductiveMonoid 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 (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 -> 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
findFirst)
                             else Sink m a3 x -> 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 (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 (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.
(LeftReductiveMonoid 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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
findFirst
                                    else Sink m a3 x -> 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 (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 (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 :: 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)

-- | A utility function wrapping if-then-else, useful for handling monadic truth values
cond :: a -> a -> Bool -> a
cond :: a -> a -> Bool -> a
cond a
x a
y Bool
test = if Bool
test then a
x else a
y