{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Control.Foldl.Transduce.Text (
decoder
, utf8
, utf8lenient
, utf8strict
, decoderE
, utf8E
, newline
, stripStart
, stripEnd
, words
, lines
, paragraphs
, sections
, textualSplit
, textualBreak
) where
import Prelude hiding (lines,words)
import Data.Char
import Data.Bool
import Data.Maybe
import Data.List (unfoldr)
import Data.Monoid (mempty,(<>))
import Data.Foldable (foldMap,foldl')
import qualified Data.ByteString as B
import qualified Data.Text
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import qualified Data.Monoid.Textual as MT
import qualified Data.Monoid.Null as MN
import Control.Applicative
import Control.Monad.Trans.Except
import Control.Monad.IO.Class
import Control.Exception.Base
import qualified Control.Foldl.Transduce as L
import qualified Data.List
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
data Pair a b = Pair !a !b
decoder :: (B.ByteString -> T.Decoding) -> T.OnDecodeError -> L.Transducer B.ByteString T.Text ()
decoder :: (ByteString -> Decoding)
-> OnDecodeError -> Transducer ByteString Text ()
decoder ByteString -> Decoding
_step OnDecodeError
onLeftovers = (Pair ByteString (ByteString -> Decoding)
-> ByteString
-> (Pair ByteString (ByteString -> Decoding), [Text], [[Text]]))
-> Pair ByteString (ByteString -> Decoding)
-> (Pair ByteString (ByteString -> Decoding)
-> ((), [Text], [[Text]]))
-> Transducer ByteString Text ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
L.Transducer Pair ByteString (ByteString -> Decoding)
-> ByteString
-> (Pair ByteString (ByteString -> Decoding), [Text], [[Text]])
forall a p a.
Pair a (p -> Decoding)
-> p -> (Pair ByteString (ByteString -> Decoding), [Text], [a])
step (ByteString
-> (ByteString -> Decoding)
-> Pair ByteString (ByteString -> Decoding)
forall a b. a -> b -> Pair a b
Pair ByteString
forall a. Monoid a => a
mempty ByteString -> Decoding
_step) Pair ByteString (ByteString -> Decoding) -> ((), [Text], [[Text]])
forall b a. Pair ByteString b -> ((), [Text], [a])
done
where
step :: Pair a (p -> Decoding)
-> p -> (Pair ByteString (ByteString -> Decoding), [Text], [a])
step (Pair a
_ p -> Decoding
next) p
i =
let
T.Some Text
txt ByteString
leftovers ByteString -> Decoding
next' = p -> Decoding
next p
i
in
(ByteString
-> (ByteString -> Decoding)
-> Pair ByteString (ByteString -> Decoding)
forall a b. a -> b -> Pair a b
Pair ByteString
leftovers ByteString -> Decoding
next',[Text
txt],[])
done :: Pair ByteString b -> ((), [Text], [a])
done (Pair ByteString
leftovers b
_) =
if ByteString -> Bool
B.null ByteString
leftovers
then ((), [], [])
else ((), (Char -> [Text]) -> Maybe Char -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> (Char -> Text) -> Char -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) Maybe Char
onLeftovers',[])
onLeftovers' :: Maybe Char
onLeftovers' = OnDecodeError
onLeftovers String
"leftovers" Maybe Word8
forall a. Maybe a
Nothing
utf8 :: T.OnDecodeError -> L.Transducer B.ByteString T.Text ()
utf8 :: OnDecodeError -> Transducer ByteString Text ()
utf8 OnDecodeError
onDecodeError =
(ByteString -> Decoding)
-> OnDecodeError -> Transducer ByteString Text ()
decoder (OnDecodeError -> ByteString -> Decoding
T.streamDecodeUtf8With OnDecodeError
onDecodeError) OnDecodeError
onDecodeError
utf8lenient :: L.Transducer B.ByteString T.Text ()
utf8lenient :: Transducer ByteString Text ()
utf8lenient = OnDecodeError -> Transducer ByteString Text ()
utf8 OnDecodeError
T.lenientDecode
utf8strict :: L.Transducer B.ByteString T.Text ()
utf8strict :: Transducer ByteString Text ()
utf8strict = OnDecodeError -> Transducer ByteString Text ()
utf8 OnDecodeError
T.strictDecode
decoderE :: MonadIO m
=> (T.OnDecodeError -> B.ByteString -> T.Decoding)
-> L.TransducerM (ExceptT T.UnicodeException m) B.ByteString T.Text ()
decoderE :: (OnDecodeError -> ByteString -> Decoding)
-> TransducerM (ExceptT UnicodeException m) ByteString Text ()
decoderE OnDecodeError -> ByteString -> Decoding
next = (Pair ByteString (ByteString -> Decoding)
-> ByteString
-> ExceptT
UnicodeException
m
(Pair ByteString (ByteString -> Decoding), [Text], [[Text]]))
-> ExceptT
UnicodeException m (Pair ByteString (ByteString -> Decoding))
-> (Pair ByteString (ByteString -> Decoding)
-> ExceptT UnicodeException m ((), [Text], [[Text]]))
-> TransducerM (ExceptT UnicodeException m) ByteString Text ()
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
L.TransducerM Pair ByteString (ByteString -> Decoding)
-> ByteString
-> ExceptT
UnicodeException
m
(Pair ByteString (ByteString -> Decoding), [Text], [[Text]])
forall (m :: * -> *) e a t a.
(MonadIO m, Exception e) =>
Pair a (t -> Decoding)
-> t
-> ExceptT
e m (Pair ByteString (ByteString -> Decoding), [Text], [a])
step (Pair ByteString (ByteString -> Decoding)
-> ExceptT
UnicodeException m (Pair ByteString (ByteString -> Decoding))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
-> (ByteString -> Decoding)
-> Pair ByteString (ByteString -> Decoding)
forall a b. a -> b -> Pair a b
Pair ByteString
forall a. Monoid a => a
mempty ByteString -> Decoding
next')) Pair ByteString (ByteString -> Decoding)
-> ExceptT UnicodeException m ((), [Text], [[Text]])
forall (m :: * -> *) e b a.
(MonadIO m, Exception e) =>
Pair ByteString b -> ExceptT e m ((), [Text], [a])
done
where
step :: Pair a (t -> Decoding)
-> t
-> ExceptT
e m (Pair ByteString (ByteString -> Decoding), [Text], [a])
step (Pair a
_ t -> Decoding
next1) t
i = do
Either e Decoding
emc <- IO (Either e Decoding) -> ExceptT e m (Either e Decoding)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either e Decoding) -> ExceptT e m (Either e Decoding))
-> (Decoding -> IO (Either e Decoding))
-> Decoding
-> ExceptT e m (Either e Decoding)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Decoding -> IO (Either e Decoding)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Decoding -> IO (Either e Decoding))
-> (Decoding -> IO Decoding) -> Decoding -> IO (Either e Decoding)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoding -> IO Decoding
forall a. a -> IO a
evaluate (Decoding -> ExceptT e m (Either e Decoding))
-> Decoding -> ExceptT e m (Either e Decoding)
forall a b. (a -> b) -> a -> b
$ t -> Decoding
next1 t
i
case Either e Decoding
emc of
Left e
ue -> do
e
-> ExceptT
e m (Pair ByteString (ByteString -> Decoding), [Text], [a])
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
ue
Right (T.Some Text
txt ByteString
leftovers ByteString -> Decoding
next2) -> do
(Pair ByteString (ByteString -> Decoding), [Text], [a])
-> ExceptT
e m (Pair ByteString (ByteString -> Decoding), [Text], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
-> (ByteString -> Decoding)
-> Pair ByteString (ByteString -> Decoding)
forall a b. a -> b -> Pair a b
Pair ByteString
leftovers ByteString -> Decoding
next2,[Text
txt],[])
done :: Pair ByteString b -> ExceptT e m ((), [Text], [a])
done (Pair ByteString
leftovers b
_) = do
if ByteString -> Bool
B.null ByteString
leftovers
then ((), [Text], [a]) -> ExceptT e m ((), [Text], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ((), [], [])
else do
Either e (Maybe Char)
emc <- IO (Either e (Maybe Char)) -> ExceptT e m (Either e (Maybe Char))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either e (Maybe Char)) -> ExceptT e m (Either e (Maybe Char)))
-> (Maybe Char -> IO (Either e (Maybe Char)))
-> Maybe Char
-> ExceptT e m (Either e (Maybe Char))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe Char) -> IO (Either e (Maybe Char))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Maybe Char) -> IO (Either e (Maybe Char)))
-> (Maybe Char -> IO (Maybe Char))
-> Maybe Char
-> IO (Either e (Maybe Char))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> IO (Maybe Char)
forall a. a -> IO a
evaluate (Maybe Char -> ExceptT e m (Either e (Maybe Char)))
-> Maybe Char -> ExceptT e m (Either e (Maybe Char))
forall a b. (a -> b) -> a -> b
$ Maybe Char
onLeftovers'
case Either e (Maybe Char)
emc of
Left e
ue -> do
e -> ExceptT e m ((), [Text], [a])
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
ue
Right Maybe Char
mc -> do
((), [Text], [a]) -> ExceptT e m ((), [Text], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ((), (Char -> [Text]) -> Maybe Char -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> (Char -> Text) -> Char -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) Maybe Char
mc,[])
next' :: ByteString -> Decoding
next' = OnDecodeError -> ByteString -> Decoding
next OnDecodeError
T.strictDecode
onLeftovers' :: Maybe Char
onLeftovers' = OnDecodeError
T.strictDecode String
"leftovers" Maybe Word8
forall a. Maybe a
Nothing
utf8E :: MonadIO m => L.TransducerM (ExceptT T.UnicodeException m) B.ByteString T.Text ()
utf8E :: TransducerM (ExceptT UnicodeException m) ByteString Text ()
utf8E = (OnDecodeError -> ByteString -> Decoding)
-> TransducerM (ExceptT UnicodeException m) ByteString Text ()
forall (m :: * -> *).
MonadIO m =>
(OnDecodeError -> ByteString -> Decoding)
-> TransducerM (ExceptT UnicodeException m) ByteString Text ()
decoderE OnDecodeError -> ByteString -> Decoding
T.streamDecodeUtf8With
newline :: L.Transducer T.Text T.Text ()
newline :: Transducer Text Text ()
newline = [Text] -> [Text] -> Transducer Text Text ()
forall (p :: * -> *) (s :: * -> *) a.
(Traversable p, Traversable s) =>
p a -> s a -> Transducer a a ()
L.surround [] [Text
"\n"]
blank :: T.Text -> Bool
blank :: Text -> Bool
blank = (Char -> Bool) -> Text -> Bool
Data.Text.all Char -> Bool
isSpace
stripStart :: L.Transducer T.Text T.Text ()
stripStart :: Transducer Text Text ()
stripStart = (Bool -> Text -> (Bool, [Text], [[Text]]))
-> Bool
-> (Bool -> ((), [Text], [[Text]]))
-> Transducer Text Text ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
L.Transducer Bool -> Text -> (Bool, [Text], [[Text]])
forall a. Bool -> Text -> (Bool, [Text], [a])
step Bool
False Bool -> ((), [Text], [[Text]])
forall p a a. p -> ((), [a], [a])
done
where
step :: Bool -> Text -> (Bool, [Text], [a])
step Bool
True Text
i = (Bool
True, [Text
i],[])
step Bool
False Text
i =
if Text -> Bool
blank Text
i
then (Bool
False,[],[])
else (Bool
True, [Text -> Text
T.stripStart Text
i],[])
done :: p -> ((), [a], [a])
done p
_ = ((),[],[])
stripEnd :: L.Transducer T.Text T.Text ()
stripEnd :: Transducer Text Text ()
stripEnd = ([Text] -> Text -> ([Text], [Text], [[Text]]))
-> [Text]
-> ([Text] -> ((), [Text], [[Text]]))
-> Transducer Text Text ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
L.Transducer [Text] -> Text -> ([Text], [Text], [[Text]])
forall a. [Text] -> Text -> ([Text], [Text], [a])
step [] [Text] -> ((), [Text], [[Text]])
forall a. [Text] -> ((), [Text], [a])
done
where
step :: [Text] -> Text -> ([Text], [Text], [a])
step [Text]
txts Text
i =
if Text -> Bool
blank Text
i
then (Text
iText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
txts, [], [])
else ([Text
i], [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
txts, [])
done :: [Text] -> ((), [Text], [a])
done [Text]
txts = case [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
txts of
Text
txt : [Text]
_ -> ((), [Text -> Text
T.stripEnd Text
txt], [])
[Text]
_ -> ((), [], [])
lines :: L.Transducer T.Text T.Text ()
lines :: Transducer Text Text ()
lines = (Bool -> Text -> (Bool, [Text], [[Text]]))
-> Bool
-> (Bool -> ((), [Text], [[Text]]))
-> Transducer Text Text ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
L.Transducer Bool -> Text -> (Bool, [Text], [[Text]])
forall (f :: * -> *).
Applicative f =>
Bool -> Text -> (Bool, [Text], [f Text])
step Bool
False Bool -> ((), [Text], [[Text]])
forall p a a. p -> ((), [a], [a])
done
where
step :: Bool -> Text -> (Bool, [Text], [f Text])
step Bool
previousnl Text
txt =
if Text -> Bool
Data.Text.null Text
txt
then
(Bool
previousnl,[],[])
else
let
lastc :: Bool
lastc = Text -> Char
Data.Text.last Text
txt Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
txts :: [Text]
txts = Text -> [Text]
T.lines Text
txt
in
case (Bool
previousnl,[Text]
txts) of
(Bool
_,[]) -> String -> (Bool, [Text], [f Text])
forall a. HasCallStack => String -> a
error String
"never happens"
(Bool
True,[Text]
_) -> (Bool
lastc, [], (Text -> f Text) -> [Text] -> [f Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
txts)
(Bool
False,Text
t:[Text]
ts) -> (Bool
lastc, [Text
t], (Text -> f Text) -> [Text] -> [f Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
ts)
done :: p -> ((), [a], [a])
done p
_ = ((),[],[])
data WordsState =
NoLastChar
| LastCharSpace
| LastCharNotSpace
words :: L.Transducer T.Text T.Text ()
words :: Transducer Text Text ()
words = (WordsState -> Text -> (WordsState, [Text], [[Text]]))
-> WordsState
-> (WordsState -> ((), [Text], [[Text]]))
-> Transducer Text Text ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
L.Transducer WordsState -> Text -> (WordsState, [Text], [[Text]])
forall (f :: * -> *).
Applicative f =>
WordsState -> Text -> (WordsState, [Text], [f Text])
step WordsState
NoLastChar WordsState -> ((), [Text], [[Text]])
forall p a a. p -> ((), [a], [a])
done
where
step :: WordsState -> Text -> (WordsState, [Text], [f Text])
step WordsState
tstate Text
txt
| Text -> Bool
Data.Text.null Text
txt = (WordsState
tstate,[],[])
| Text -> Bool
blank Text
txt =
case WordsState
tstate of
WordsState
NoLastChar -> (WordsState
NoLastChar,[],[])
WordsState
_ -> (WordsState
LastCharSpace,[],[])
| Bool
otherwise =
let nextstate :: WordsState
nextstate =
if Char -> Bool
isSpace (Text -> Char
T.last Text
txt)
then WordsState
LastCharSpace
else WordsState
LastCharNotSpace
([Text]
oldgroup,[f Text]
newgroups) = case (WordsState
tstate, Text -> [Text]
T.words Text
txt) of
(WordsState
NoLastChar,Text
w:[Text]
ws) ->
([Text
w],(Text -> f Text) -> [Text] -> [f Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
ws)
(WordsState
LastCharSpace,[Text]
ws) ->
([],(Text -> f Text) -> [Text] -> [f Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
ws)
(WordsState
LastCharNotSpace,Text
w:[Text]
ws) ->
if Char -> Bool
isSpace (Text -> Char
T.head Text
txt)
then ([],(Text -> f Text) -> [Text] -> [f Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
wText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ws))
else ([Text
w],(Text -> f Text) -> [Text] -> [f Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
ws)
(WordsState
_,[]) -> String -> ([Text], [f Text])
forall a. HasCallStack => String -> a
error String
"never happens, txt not blank"
in (WordsState
nextstate,[Text]
oldgroup,[f Text]
newgroups)
done :: p -> ((), [a], [a])
done p
_ = ((),[],[])
data ParagraphsState =
SkippingAfterStreamStart
| SkippingAfterNewline
| SkippingAfterBlankLine
| ContinuingNonemptyLine
paragraphs :: L.Transducer T.Text T.Text ()
paragraphs :: Transducer Text Text ()
paragraphs = (ParagraphsState -> Text -> (ParagraphsState, [Text], [[Text]]))
-> ParagraphsState
-> (ParagraphsState -> ((), [Text], [[Text]]))
-> Transducer Text Text ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
L.Transducer ParagraphsState -> Text -> (ParagraphsState, [Text], [[Text]])
step ParagraphsState
SkippingAfterStreamStart ParagraphsState -> ((), [Text], [[Text]])
forall p a a. p -> ((), [a], [a])
done
where
step :: ParagraphsState -> Text -> (ParagraphsState, [Text], [[Text]])
step ParagraphsState
tstate Text
txt
| Text -> Bool
Data.Text.null Text
txt =
(ParagraphsState
tstate,[],[])
| Bool
otherwise =
let ([Text]
initlines,Text
lastline) = Text -> ([Text], Text)
splittedLines Text
txt
(ParagraphsState
tstate', NonEmpty [Text]
outputsreversed) =
(ParagraphsState, NonEmpty [Text])
-> Text -> (ParagraphsState, NonEmpty [Text])
advanceLast
(((ParagraphsState, NonEmpty [Text])
-> Text -> (ParagraphsState, NonEmpty [Text]))
-> (ParagraphsState, NonEmpty [Text])
-> [Text]
-> (ParagraphsState, NonEmpty [Text])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
(ParagraphsState, NonEmpty [Text])
-> Text -> (ParagraphsState, NonEmpty [Text])
advance
(ParagraphsState
tstate,[Text] -> NonEmpty [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
[Text]
initlines)
Text
lastline
([Text]
xs :| [[Text]]
xss) = ([Text] -> [Text]) -> NonEmpty [Text] -> NonEmpty [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> [Text]
forall a. [a] -> [a]
reverse (NonEmpty [Text] -> NonEmpty [Text]
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse NonEmpty [Text]
outputsreversed)
in (ParagraphsState
tstate',[Text]
xs,[[Text]]
xss)
done :: p -> ((), [a], [a])
done p
_ =
((),[],[])
splittedLines :: T.Text -> ([T.Text],T.Text)
splittedLines :: Text -> ([Text], Text)
splittedLines Text
nonEmptyChunk =
let splitted :: [Text]
splitted =
Text -> [Text]
Data.Text.lines Text
nonEmptyChunk
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
if Text -> Char
T.last Text
nonEmptyChunk Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then [Text
forall a. Monoid a => a
mempty] else [Text]
forall a. Monoid a => a
mempty
in ([Text] -> [Text]
forall a. [a] -> [a]
init [Text]
splitted, [Text] -> Text
forall a. [a] -> a
last [Text]
splitted)
advance
:: (ParagraphsState, NonEmpty [T.Text])
-> T.Text
-> (ParagraphsState, NonEmpty [T.Text])
advance :: (ParagraphsState, NonEmpty [Text])
-> Text -> (ParagraphsState, NonEmpty [Text])
advance (ParagraphsState
s,NonEmpty [Text]
outputs) Text
i =
case (ParagraphsState
s, Text -> Bool
blank Text
i) of
(ParagraphsState
SkippingAfterStreamStart, Bool
True) ->
(,)
ParagraphsState
SkippingAfterStreamStart
NonEmpty [Text]
outputs
(ParagraphsState
SkippingAfterStreamStart, Bool
False) ->
(,)
ParagraphsState
SkippingAfterNewline
([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
continue [Text
"\n",Text -> Text
T.stripStart Text
i] NonEmpty [Text]
outputs)
(ParagraphsState
SkippingAfterNewline, Bool
True) ->
(,)
ParagraphsState
SkippingAfterBlankLine
NonEmpty [Text]
outputs
(ParagraphsState
SkippingAfterNewline, Bool
False) ->
(,)
ParagraphsState
SkippingAfterNewline
([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
continue [Text
"\n",Text -> Text
T.stripStart Text
i] NonEmpty [Text]
outputs)
(ParagraphsState
SkippingAfterBlankLine, Bool
True) ->
(,)
ParagraphsState
SkippingAfterBlankLine
NonEmpty [Text]
outputs
(ParagraphsState
SkippingAfterBlankLine, Bool
False) ->
(,)
ParagraphsState
SkippingAfterNewline
([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
continue [Text
"\n",Text -> Text
T.stripStart Text
i] ([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons [] NonEmpty [Text]
outputs))
(ParagraphsState
ContinuingNonemptyLine, Bool
_) ->
(,)
ParagraphsState
SkippingAfterNewline
([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
continue [Text
"\n",Text
i] NonEmpty [Text]
outputs)
advanceLast
:: (ParagraphsState, NonEmpty [T.Text])
-> T.Text
-> (ParagraphsState, NonEmpty [T.Text])
advanceLast :: (ParagraphsState, NonEmpty [Text])
-> Text -> (ParagraphsState, NonEmpty [Text])
advanceLast (ParagraphsState
s,NonEmpty [Text]
outputs) Text
i =
case (ParagraphsState
s, Text -> Bool
blank Text
i) of
(ParagraphsState
SkippingAfterStreamStart, Bool
True) ->
(,)
ParagraphsState
SkippingAfterStreamStart
NonEmpty [Text]
outputs
(ParagraphsState
SkippingAfterStreamStart, Bool
False) ->
(,)
ParagraphsState
ContinuingNonemptyLine
([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
continue [Text -> Text
T.stripStart Text
i] NonEmpty [Text]
outputs)
(ParagraphsState
SkippingAfterNewline, Bool
True) ->
(,)
ParagraphsState
SkippingAfterNewline
NonEmpty [Text]
outputs
(ParagraphsState
SkippingAfterNewline, Bool
False) ->
(,)
ParagraphsState
ContinuingNonemptyLine
([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
continue [Text -> Text
T.stripStart Text
i] NonEmpty [Text]
outputs)
(ParagraphsState
SkippingAfterBlankLine, Bool
True) ->
(,)
ParagraphsState
SkippingAfterBlankLine
NonEmpty [Text]
outputs
(ParagraphsState
SkippingAfterBlankLine, Bool
False) ->
(,)
ParagraphsState
ContinuingNonemptyLine
([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
continue [Text -> Text
T.stripStart Text
i] ([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons [] NonEmpty [Text]
outputs))
(ParagraphsState
ContinuingNonemptyLine, Bool
_) ->
(,)
ParagraphsState
ContinuingNonemptyLine
([Text] -> NonEmpty [Text] -> NonEmpty [Text]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
continue [Text
i] NonEmpty [Text]
outputs)
sections :: [T.Text] -> L.Transducer T.Text T.Text ()
sections :: [Text] -> Transducer Text Text ()
sections [Text]
seps = (SectionsState -> Text -> (SectionsState, [Text], [[Text]]))
-> SectionsState
-> (SectionsState -> ((), [Text], [[Text]]))
-> Transducer Text Text ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
L.Transducer SectionsState -> Text -> (SectionsState, [Text], [[Text]])
step ([Text] -> SectionsState
initialstate [Text]
seps) SectionsState -> ((), [Text], [[Text]])
forall a. SectionsState -> ((), [Text], [a])
done
where
step :: SectionsState -> Text -> (SectionsState, [Text], [[Text]])
step SectionsState
tstate Text
txt =
let ([([Text], Bool)]
emitted,((Text, SectionsState) -> SectionsState)
-> [(Text, SectionsState)] -> [SectionsState]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, SectionsState) -> SectionsState
forall a b. (a, b) -> b
snd -> [SectionsState]
states) = [(([Text], Bool), (Text, SectionsState))]
-> ([([Text], Bool)], [(Text, SectionsState)])
forall a b. [(a, b)] -> ([a], [b])
Data.List.unzip (((Text, SectionsState)
-> Maybe (([Text], Bool), (Text, SectionsState)))
-> (Text, SectionsState)
-> [(([Text], Bool), (Text, SectionsState))]
forall b a. (b -> Maybe (a, b)) -> b -> [(a, b)]
unfoldWithState (Text, SectionsState)
-> Maybe (([Text], Bool), (Text, SectionsState))
splitTextStep (Text
txt,SectionsState
tstate))
finalState :: SectionsState
finalState = NonEmpty SectionsState -> SectionsState
forall a. NonEmpty a -> a
NonEmpty.last (SectionsState
tstate SectionsState -> [SectionsState] -> NonEmpty SectionsState
forall a. a -> [a] -> NonEmpty a
:| [SectionsState]
states)
[Text]
continuing :| [[Text]]
following = NonEmpty [Text] -> NonEmpty [Text]
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse (([Text] -> [Text]) -> NonEmpty [Text] -> NonEmpty [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> [Text]
forall a. [a] -> [a]
Data.List.reverse ((NonEmpty [Text] -> ([Text], Bool) -> NonEmpty [Text])
-> NonEmpty [Text] -> [([Text], Bool)] -> NonEmpty [Text]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' NonEmpty [Text] -> ([Text], Bool) -> NonEmpty [Text]
forall x. NonEmpty [x] -> ([x], Bool) -> NonEmpty [x]
advance ([][Text] -> [[Text]] -> NonEmpty [Text]
forall a. a -> [a] -> NonEmpty a
:|[]) [([Text], Bool)]
emitted))
in (SectionsState
finalState, [Text]
continuing, [[Text]]
following)
advance :: NonEmpty [x] -> ([x],Bool) -> NonEmpty [x]
advance :: NonEmpty [x] -> ([x], Bool) -> NonEmpty [x]
advance NonEmpty [x]
l ([x]
e,Bool
b) = (NonEmpty [x] -> NonEmpty [x])
-> (NonEmpty [x] -> NonEmpty [x])
-> Bool
-> NonEmpty [x]
-> NonEmpty [x]
forall a. a -> a -> Bool -> a
bool NonEmpty [x] -> NonEmpty [x]
forall a. a -> a
id ([x] -> NonEmpty [x] -> NonEmpty [x]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
separate []) Bool
b ([x] -> NonEmpty [x] -> NonEmpty [x]
forall a. [a] -> NonEmpty [a] -> NonEmpty [a]
continue [x]
e NonEmpty [x]
l)
done :: SectionsState -> ((), [Text], [a])
done SectionsState
Done =
((),[],[])
done (Pending Text
acc Text
_ [Text]
_) =
((),[Text
acc],[])
initialstate :: [Text] -> SectionsState
initialstate [] = SectionsState
Done
initialstate (Text
x:[Text]
xs) = Text -> Text -> [Text] -> SectionsState
Pending Text
T.empty Text
x [Text]
xs
continue :: [a] -> NonEmpty [a] -> NonEmpty [a]
continue :: [a] -> NonEmpty [a] -> NonEmpty [a]
continue [a]
as ([a]
as':| [[a]]
rest) = ([a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
as') [a] -> [[a]] -> NonEmpty [a]
forall a. a -> [a] -> NonEmpty a
:| [[a]]
rest
separate :: [x] -> NonEmpty [x] -> NonEmpty [x]
separate :: [x] -> NonEmpty [x] -> NonEmpty [x]
separate = [x] -> NonEmpty [x] -> NonEmpty [x]
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons
data SectionsState =
Done
| Pending T.Text T.Text [T.Text]
deriving (Int -> SectionsState -> ShowS
[SectionsState] -> ShowS
SectionsState -> String
(Int -> SectionsState -> ShowS)
-> (SectionsState -> String)
-> ([SectionsState] -> ShowS)
-> Show SectionsState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SectionsState] -> ShowS
$cshowList :: [SectionsState] -> ShowS
show :: SectionsState -> String
$cshow :: SectionsState -> String
showsPrec :: Int -> SectionsState -> ShowS
$cshowsPrec :: Int -> SectionsState -> ShowS
Show)
splitTextStep
:: (T.Text, SectionsState)
-> Maybe (([T.Text],Bool), (T.Text, SectionsState))
splitTextStep :: (Text, SectionsState)
-> Maybe (([Text], Bool), (Text, SectionsState))
splitTextStep (Text
txt, SectionsState
_) | Text -> Bool
T.null Text
txt = Maybe (([Text], Bool), (Text, SectionsState))
forall a. Maybe a
Nothing
splitTextStep (Text
txt, SectionsState
Done) = (([Text], Bool), (Text, SectionsState))
-> Maybe (([Text], Bool), (Text, SectionsState))
forall a. a -> Maybe a
Just (([Text
txt],Bool
False),(Text
T.empty,SectionsState
Done))
splitTextStep (Text
txt, Pending Text
acc Text
sep [Text]
nextseps) = (([Text], Bool), (Text, SectionsState))
-> Maybe (([Text], Bool), (Text, SectionsState))
forall a. a -> Maybe a
Just ((([Text], Bool), (Text, SectionsState))
-> Maybe (([Text], Bool), (Text, SectionsState)))
-> (([Text], Bool), (Text, SectionsState))
-> Maybe (([Text], Bool), (Text, SectionsState))
forall a b. (a -> b) -> a -> b
$
let (Text
before,Text
after) = Text -> Text -> (Text, Text)
T.breakOn Text
sep (Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt)
in
if Text -> Bool
T.null Text
after
then
let (Text
m0,Text
m) = Text -> Text -> (Text, Text)
maxintersect Text
before Text
sep
in
(([Text
m0],Bool
False),(Text
T.empty, Text -> Text -> [Text] -> SectionsState
Pending Text
m Text
sep [Text]
nextseps))
else
let unprefixed :: Text
unprefixed = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
sep) Text
after
nextstate :: SectionsState
nextstate = case [Text]
nextseps of
[] -> SectionsState
Done
Text
z:[Text]
zs -> Text -> Text -> [Text] -> SectionsState
Pending Text
T.empty Text
z [Text]
zs
in
(([Text
before],Bool
True),(Text
unprefixed,SectionsState
nextstate))
maxintersect :: T.Text -> T.Text -> (T.Text,T.Text)
maxintersect :: Text -> Text -> (Text, Text)
maxintersect Text
txt Text
sep =
let prefixes :: [Text]
prefixes = ([Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.inits) Text
sep
partialmatches :: [Text]
partialmatches = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool) -> Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Bool
T.isSuffixOf Text
txt) [Text]
prefixes
m :: Text
m = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
T.empty Text -> Text
forall a. a -> a
id ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
partialmatches)
in
(Int -> Text -> Text
T.take (Text -> Int
T.length Text
txt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
m) Text
txt,Text
m)
unfoldWithState :: (b -> Maybe (a, b)) -> b -> [(a, b)]
unfoldWithState :: (b -> Maybe (a, b)) -> b -> [(a, b)]
unfoldWithState b -> Maybe (a, b)
f = (b -> Maybe ((a, b), b)) -> b -> [(a, b)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (((a, b) -> ((a, b), b)) -> Maybe (a, b) -> Maybe ((a, b), b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t :: (a, b)
t@(a
_, b
b) -> ((a, b)
t, b
b)) (Maybe (a, b) -> Maybe ((a, b), b))
-> (b -> Maybe (a, b)) -> b -> Maybe ((a, b), b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe (a, b)
f)
textualSplit :: MT.TextualMonoid m => (Char -> Bool) -> L.Transducer m m ()
textualSplit :: (Char -> Bool) -> Transducer m m ()
textualSplit Char -> Bool
predicate = (() -> m -> ((), [m], [[m]]))
-> () -> (() -> ((), [m], [[m]])) -> Transducer m m ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
L.Transducer () -> m -> ((), [m], [[m]])
forall a p. TextualMonoid a => p -> a -> ((), [a], [[a]])
step () () -> ((), [m], [[m]])
forall a p. Monoid a => p -> a
done
where
step :: p -> a -> ((), [a], [[a]])
step p
_ a
txt = case (Char -> Bool) -> a -> [a]
forall t. TextualMonoid t => (Char -> Bool) -> t -> [t]
MT.split Char -> Bool
predicate a
txt of
a
x:[a]
xs -> ((),[a
x],(a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) [a]
xs)
[a]
_ -> String -> ((), [a], [[a]])
forall a. HasCallStack => String -> a
error String
"never happens"
done :: p -> a
done p
_ = a
forall a. Monoid a => a
mempty
data SplitWhenWhenState =
SplitWhenConditionEncountered
| SplitWhenConditionPending
textualBreak :: MT.TextualMonoid m => (Char -> Bool) -> L.Transducer m m ()
textualBreak :: (Char -> Bool) -> Transducer m m ()
textualBreak Char -> Bool
predicate =
(SplitWhenWhenState -> m -> (SplitWhenWhenState, [m], [[m]]))
-> SplitWhenWhenState
-> (SplitWhenWhenState -> ((), [m], [[m]]))
-> Transducer m m ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
L.Transducer SplitWhenWhenState -> m -> (SplitWhenWhenState, [m], [[m]])
forall a.
TextualMonoid a =>
SplitWhenWhenState -> a -> (SplitWhenWhenState, [a], [[a]])
step SplitWhenWhenState
SplitWhenConditionPending SplitWhenWhenState -> ((), [m], [[m]])
done
where
step :: SplitWhenWhenState -> a -> (SplitWhenWhenState, [a], [[a]])
step SplitWhenWhenState
SplitWhenConditionPending ((a -> Bool) -> (Char -> Bool) -> a -> (a, a)
forall t.
TextualMonoid t =>
(t -> Bool) -> (Char -> Bool) -> t -> (t, t)
MT.break (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
False) Char -> Bool
predicate -> (a
i0,a
i1)) =
if a -> Bool
forall m. MonoidNull m => m -> Bool
MN.null a
i1
then (SplitWhenWhenState
SplitWhenConditionPending,[a
i0],[])
else (SplitWhenWhenState
SplitWhenConditionEncountered,[a
i0],[[a
i1]])
step SplitWhenWhenState
SplitWhenConditionEncountered a
i =
(SplitWhenWhenState
SplitWhenConditionEncountered,[a
i],[])
done :: SplitWhenWhenState -> ((), [m], [[m]])
done = SplitWhenWhenState -> ((), [m], [[m]])
forall a. Monoid a => a
mempty