{-# Language OverloadedStrings #-}
module Reflex.Process.Lines where

import Control.Monad.Fix (MonadFix)
import qualified Data.ByteString.Char8 as C8
import Data.ByteString.Char8 (ByteString)
import Data.Foldable (toList)
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Reflex

-- * Output lines

-- | Accumulator for line-based output that keeps track of any dangling,
-- unterminated line
data Lines = Lines
  { Lines -> Seq ByteString
_lines_terminated :: Seq C8.ByteString
  , Lines -> Maybe ByteString
_lines_unterminated :: Maybe C8.ByteString
  }
  deriving (Int -> Lines -> ShowS
[Lines] -> ShowS
Lines -> String
(Int -> Lines -> ShowS)
-> (Lines -> String) -> ([Lines] -> ShowS) -> Show Lines
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lines] -> ShowS
$cshowList :: [Lines] -> ShowS
show :: Lines -> String
$cshow :: Lines -> String
showsPrec :: Int -> Lines -> ShowS
$cshowsPrec :: Int -> Lines -> ShowS
Show, Lines -> Lines -> Bool
(Lines -> Lines -> Bool) -> (Lines -> Lines -> Bool) -> Eq Lines
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lines -> Lines -> Bool
$c/= :: Lines -> Lines -> Bool
== :: Lines -> Lines -> Bool
$c== :: Lines -> Lines -> Bool
Eq, Eq Lines
Eq Lines
-> (Lines -> Lines -> Ordering)
-> (Lines -> Lines -> Bool)
-> (Lines -> Lines -> Bool)
-> (Lines -> Lines -> Bool)
-> (Lines -> Lines -> Bool)
-> (Lines -> Lines -> Lines)
-> (Lines -> Lines -> Lines)
-> Ord Lines
Lines -> Lines -> Bool
Lines -> Lines -> Ordering
Lines -> Lines -> Lines
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Lines -> Lines -> Lines
$cmin :: Lines -> Lines -> Lines
max :: Lines -> Lines -> Lines
$cmax :: Lines -> Lines -> Lines
>= :: Lines -> Lines -> Bool
$c>= :: Lines -> Lines -> Bool
> :: Lines -> Lines -> Bool
$c> :: Lines -> Lines -> Bool
<= :: Lines -> Lines -> Bool
$c<= :: Lines -> Lines -> Bool
< :: Lines -> Lines -> Bool
$c< :: Lines -> Lines -> Bool
compare :: Lines -> Lines -> Ordering
$ccompare :: Lines -> Lines -> Ordering
$cp1Ord :: Eq Lines
Ord, ReadPrec [Lines]
ReadPrec Lines
Int -> ReadS Lines
ReadS [Lines]
(Int -> ReadS Lines)
-> ReadS [Lines]
-> ReadPrec Lines
-> ReadPrec [Lines]
-> Read Lines
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Lines]
$creadListPrec :: ReadPrec [Lines]
readPrec :: ReadPrec Lines
$creadPrec :: ReadPrec Lines
readList :: ReadS [Lines]
$creadList :: ReadS [Lines]
readsPrec :: Int -> ReadS Lines
$creadsPrec :: Int -> ReadS Lines
Read)

-- | Empty output
emptyLines :: Lines
emptyLines :: Lines
emptyLines = Seq ByteString -> Maybe ByteString -> Lines
Lines Seq ByteString
forall a. Seq a
Seq.empty Maybe ByteString
forall a. Maybe a
Nothing

-- | Add some raw output to a 'Lines'. This will chop the raw output up into lines.
addLines :: ByteString -> Lines -> Lines
addLines :: ByteString -> Lines -> Lines
addLines ByteString
new (Lines Seq ByteString
t Maybe ByteString
u) =
  let newLines' :: Seq ByteString
newLines' = [ByteString] -> Seq ByteString
forall a. [a] -> Seq a
Seq.fromList ([ByteString] -> Seq ByteString) -> [ByteString] -> Seq ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
C8.null) (ByteString -> [ByteString]
C8.lines ByteString
new)
  in
    case Maybe ByteString
u of
      Maybe ByteString
Nothing -> if ByteString
"\n" ByteString -> ByteString -> Bool
`C8.isSuffixOf` ByteString
new
        then Seq ByteString -> Maybe ByteString -> Lines
Lines (Seq ByteString
t Seq ByteString -> Seq ByteString -> Seq ByteString
forall a. Semigroup a => a -> a -> a
<> Seq ByteString
newLines') Maybe ByteString
forall a. Maybe a
Nothing
        else case Seq ByteString -> ViewR ByteString
forall a. Seq a -> ViewR a
Seq.viewr Seq ByteString
newLines' of
                ViewR ByteString
Seq.EmptyR -> Seq ByteString -> Maybe ByteString -> Lines
Lines Seq ByteString
t Maybe ByteString
forall a. Maybe a
Nothing
                (Seq ByteString
t' Seq.:> ByteString
u') -> Seq ByteString -> Maybe ByteString -> Lines
Lines (Seq ByteString
t Seq ByteString -> Seq ByteString -> Seq ByteString
forall a. Semigroup a => a -> a -> a
<> Seq ByteString
t') (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
u')
      Just ByteString
u' -> ByteString -> Lines -> Lines
addLines (ByteString
u' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
new) (Lines -> Lines) -> Lines -> Lines
forall a b. (a -> b) -> a -> b
$ Seq ByteString -> Maybe ByteString -> Lines
Lines Seq ByteString
t Maybe ByteString
forall a. Maybe a
Nothing

-- | Convert a 'ByteString' into a 'Lines'
linesFromBS :: C8.ByteString -> Lines
linesFromBS :: ByteString -> Lines
linesFromBS = (ByteString -> Lines -> Lines) -> Lines -> ByteString -> Lines
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Lines -> Lines
addLines Lines
forall a. Monoid a => a
mempty

instance Semigroup Lines where
  Lines
a <> :: Lines -> Lines -> Lines
<> Lines
b = ByteString -> Lines -> Lines
addLines (Lines -> ByteString
unLines Lines
b) Lines
a

instance Monoid Lines where
  mempty :: Lines
mempty = Lines
emptyLines

-- | Convert a 'Lines' back into a 'ByteString'
unLines :: Lines -> ByteString
unLines :: Lines -> ByteString
unLines (Lines Seq ByteString
t Maybe ByteString
u) =
  [ByteString] -> ByteString
C8.unlines (Seq ByteString -> [ByteString]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq ByteString
t) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
u

-- | Convenience accessor for the last whole line received by a 'Lines'.
-- Ignores any unterminated line that may follow.
lastWholeLine :: Lines -> Maybe C8.ByteString
lastWholeLine :: Lines -> Maybe ByteString
lastWholeLine (Lines Seq ByteString
t Maybe ByteString
_) = case Seq ByteString -> ViewR ByteString
forall a. Seq a -> ViewR a
Seq.viewr Seq ByteString
t of
  ViewR ByteString
Seq.EmptyR -> Maybe ByteString
forall a. Maybe a
Nothing
  Seq ByteString
_ Seq.:> ByteString
x -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
x

-- | Split lines into two. The sequence that satisfies the predicate is
-- consumed and will not appear in either resulting 'Lines'.
splitLinesOn :: (ByteString -> Bool) -> Lines -> Maybe (Lines, Lines)
splitLinesOn :: (ByteString -> Bool) -> Lines -> Maybe (Lines, Lines)
splitLinesOn ByteString -> Bool
test (Lines Seq ByteString
t Maybe ByteString
u) = 
  let (Seq ByteString
before, Seq ByteString
after) = (ByteString -> Bool)
-> Seq ByteString -> (Seq ByteString, Seq ByteString)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl ByteString -> Bool
test Seq ByteString
t
  in if Seq ByteString -> Bool
forall a. Seq a -> Bool
Seq.null Seq ByteString
after then Maybe (Lines, Lines)
forall a. Maybe a
Nothing else (Lines, Lines) -> Maybe (Lines, Lines)
forall a. a -> Maybe a
Just (Seq ByteString -> Maybe ByteString -> Lines
Lines Seq ByteString
before Maybe ByteString
forall a. Maybe a
Nothing, Seq ByteString -> Maybe ByteString -> Lines
Lines (Int -> Seq ByteString -> Seq ByteString
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq ByteString
after) Maybe ByteString
u)

-- | Given an event of raw bytes, fire an output event of *terminated* lines.
-- Unterminated lines are held until the line they belong to is completed or
-- until the flush event fires.
newLines
  :: (Reflex t, MonadHold t m, MonadFix m)
  => Event t ByteString
  -> Event t () -- ^ Event that flushes any remaining unterminated lines
  -> m (Event t Lines) -- ^ These will be complete lines except when the flush event fires, in which it may include unterminated lines
newLines :: Event t ByteString -> Event t () -> m (Event t Lines)
newLines Event t ByteString
e Event t ()
flush = do
  Dynamic t (Lines, Lines)
x <- (((Lines, Lines) -> (Lines, Lines))
 -> (Lines, Lines) -> (Lines, Lines))
-> (Lines, Lines)
-> Event t ((Lines, Lines) -> (Lines, Lines))
-> m (Dynamic t (Lines, Lines))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn ((Lines, Lines) -> (Lines, Lines))
-> (Lines, Lines) -> (Lines, Lines)
forall a b. (a -> b) -> a -> b
($) (Lines
forall a. Monoid a => a
mempty, Lines
forall a. Monoid a => a
mempty) (Event t ((Lines, Lines) -> (Lines, Lines))
 -> m (Dynamic t (Lines, Lines)))
-> Event t ((Lines, Lines) -> (Lines, Lines))
-> m (Dynamic t (Lines, Lines))
forall a b. (a -> b) -> a -> b
$ (((Lines, Lines) -> (Lines, Lines))
 -> ((Lines, Lines) -> (Lines, Lines))
 -> (Lines, Lines)
 -> (Lines, Lines))
-> [Event t ((Lines, Lines) -> (Lines, Lines))]
-> Event t ((Lines, Lines) -> (Lines, Lines))
forall k (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith ((Lines, Lines) -> (Lines, Lines))
-> ((Lines, Lines) -> (Lines, Lines))
-> (Lines, Lines)
-> (Lines, Lines)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
    [ Event t ByteString
-> (ByteString -> (Lines, Lines) -> (Lines, Lines))
-> Event t ((Lines, Lines) -> (Lines, Lines))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t ByteString
e ((ByteString -> (Lines, Lines) -> (Lines, Lines))
 -> Event t ((Lines, Lines) -> (Lines, Lines)))
-> (ByteString -> (Lines, Lines) -> (Lines, Lines))
-> Event t ((Lines, Lines) -> (Lines, Lines))
forall a b. (a -> b) -> a -> b
$ \ByteString
new (Lines
_, Lines
old) ->
        let Lines Seq ByteString
t Maybe ByteString
u = ByteString -> Lines -> Lines
addLines ByteString
new Lines
old
        in (Seq ByteString -> Maybe ByteString -> Lines
Lines Seq ByteString
t Maybe ByteString
forall a. Maybe a
Nothing, Seq ByteString -> Maybe ByteString -> Lines
Lines Seq ByteString
forall a. Monoid a => a
mempty Maybe ByteString
u)
    , Event t ()
-> (() -> (Lines, Lines) -> (Lines, Lines))
-> Event t ((Lines, Lines) -> (Lines, Lines))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t ()
flush ((() -> (Lines, Lines) -> (Lines, Lines))
 -> Event t ((Lines, Lines) -> (Lines, Lines)))
-> (() -> (Lines, Lines) -> (Lines, Lines))
-> Event t ((Lines, Lines) -> (Lines, Lines))
forall a b. (a -> b) -> a -> b
$ \()
_ (Lines
_, Lines
old) -> (Lines
old, Lines
emptyLines)
    ]
  Event t Lines -> m (Event t Lines)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event t Lines -> m (Event t Lines))
-> Event t Lines -> m (Event t Lines)
forall a b. (a -> b) -> a -> b
$ Event t (Lines, Lines)
-> ((Lines, Lines) -> Maybe Lines) -> Event t Lines
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe (Dynamic t (Lines, Lines) -> Event t (Lines, Lines)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Lines, Lines)
x) (((Lines, Lines) -> Maybe Lines) -> Event t Lines)
-> ((Lines, Lines) -> Maybe Lines) -> Event t Lines
forall a b. (a -> b) -> a -> b
$ \(Lines
terminatedLines, Lines
_) -> if Lines
terminatedLines Lines -> Lines -> Bool
forall a. Eq a => a -> a -> Bool
== Lines
forall a. Monoid a => a
mempty
    then Maybe Lines
forall a. Maybe a
Nothing
    else Lines -> Maybe Lines
forall a. a -> Maybe a
Just Lines
terminatedLines