Add Lines

ChangeLog.md

@@ -1,5 +1,9 @@
 # Revision history for reflex-process
 
+## 0.3.3.0
+
+* Add `Lines` for keeping track of accumulated output, including both terminated and unterminated lines
+
 ## 0.3.2.0-r1
 
 * Allow reflex-vty 0.5

reflex-process.cabal

@@ -1,6 +1,6 @@
 cabal-version: >=1.10
 name: reflex-process
-version: 0.3.2.0
+version: 0.3.3.0
 synopsis: Reflex FRP interface for running system processes
 description:
   Run and interact with system processes from within a Reflex FRP application.
@@ -25,9 +25,11 @@ source-repository head
 
 library
   exposed-modules: Reflex.Process
+                   Reflex.Process.Lines
   build-depends: base >=4.12 && <4.19
                , async >= 2 && < 3
-               , bytestring >=0.10 && < 0.12
+               , bytestring >= 0.10 && < 0.12
+               , containers >= 0.6 && < 0.7
                , data-default >= 0.2 && < 0.8
                , process >= 1.6.4 && < 1.7
                , reflex >= 0.7.1 && < 1

src/Reflex/Process/Lines.hs

@@ -0,0 +1,86 @@
+{-# 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_terminated :: Seq C8.ByteString
+  , _lines_unterminated :: Maybe C8.ByteString
+  }
+  deriving (Show, Eq, Ord, Read)
+
+-- | Empty output
+emptyLines :: Lines
+emptyLines = Lines Seq.empty Nothing
+
+-- | Add some raw output to a 'Lines'. This will chop the raw output up into lines.
+addLines :: ByteString -> Lines -> Lines
+addLines new (Lines t u) =
+  let newLines' = Seq.fromList $ filter (not . C8.null) (C8.lines new)
+  in
+    case u of
+      Nothing -> if "\n" `C8.isSuffixOf` new
+        then Lines (t <> newLines') Nothing
+        else case Seq.viewr newLines' of
+                Seq.EmptyR -> Lines t Nothing
+                (t' Seq.:> u') -> Lines (t <> t') (Just u')
+      Just u' -> addLines (u' <> new) $ Lines t Nothing
+
+-- | Convert a 'ByteString' into a 'Lines'
+linesFromBS :: C8.ByteString -> Lines
+linesFromBS = flip addLines mempty
+
+instance Semigroup Lines where
+  a <> b = addLines (unLines b) a
+
+instance Monoid Lines where
+  mempty = emptyLines
+
+-- | Convert a 'Lines' back into a 'ByteString'
+unLines :: Lines -> ByteString
+unLines (Lines t u) =
+  C8.unlines (toList t) <> fromMaybe "" 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 t _) = case Seq.viewr t of
+  Seq.EmptyR -> Nothing
+  _ Seq.:> x -> Just 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 test (Lines t u) = 
+  let (before, after) = Seq.breakl test t
+  in if Seq.null after then Nothing else Just (Lines before Nothing, Lines (Seq.drop 1 after) 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 e flush = do
+  x <- foldDyn ($) (mempty, mempty) $ mergeWith (.)
+    [ ffor e $ \new (_, old) ->
+        let Lines t u = addLines new old
+        in (Lines t Nothing, Lines mempty u)
+    , ffor flush $ \_ (_, old) -> (old, emptyLines)
+    ]
+  pure $ fforMaybe (updated x) $ \(terminatedLines, _) -> if terminatedLines == mempty
+    then Nothing
+    else Just terminatedLines