{-# options_haddock prune #-}

-- |Description: ProcessOutput Interpreters, Internal
module Polysemy.Process.Interpreter.ProcessOutput where

import qualified Data.ByteString as ByteString

import Polysemy.Process.Data.ProcessOutputParseResult (ProcessOutputParseResult (Done, Fail, Partial))
import Polysemy.Process.Effect.ProcessOutput (ProcessOutput (Chunk))
import qualified Polysemy.Process.Effect.ProcessOutput as ProcessOutput

-- |Interpret 'ProcessOutput' by discarding any output.
interpretProcessOutputIgnore ::
  ∀ p a r .
  InterpreterFor (ProcessOutput p a) r
interpretProcessOutputIgnore :: forall (p :: OutputPipe) a (r :: [Effect]).
InterpreterFor (ProcessOutput p a) r
interpretProcessOutputIgnore =
  (forall (rInitial :: [Effect]) x.
 ProcessOutput p a (Sem rInitial) x -> Sem r x)
-> Sem (ProcessOutput p a : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Chunk ByteString
_ ByteString
_ ->
      ([a], ByteString) -> Sem r ([a], ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], ByteString
"")
{-# inline interpretProcessOutputIgnore #-}

-- |Interpret 'ProcessOutput' by immediately emitting raw 'ByteString's without accumulation.
interpretProcessOutputId ::
  ∀ p r .
  InterpreterFor (ProcessOutput p ByteString) r
interpretProcessOutputId :: forall (p :: OutputPipe) (r :: [Effect]).
InterpreterFor (ProcessOutput p ByteString) r
interpretProcessOutputId =
  (forall (rInitial :: [Effect]) x.
 ProcessOutput p ByteString (Sem rInitial) x -> Sem r x)
-> Sem (ProcessOutput p ByteString : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Chunk ByteString
buffer ByteString
new ->
      ([ByteString], ByteString) -> Sem r ([ByteString], ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString
buffer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
new], ByteString
"")
{-# inline interpretProcessOutputId #-}

-- |Transformer for 'ProcessOutput' that lifts results into 'Left', creating 'ProcessOutput p (Either a b)' from
-- 'ProcessOutput p a'.
interpretProcessOutputLeft ::
  ∀ p a b r .
  Member (ProcessOutput p a) r =>
  InterpreterFor (ProcessOutput p (Either a b)) r
interpretProcessOutputLeft :: forall (p :: OutputPipe) a b (r :: [Effect]).
Member (ProcessOutput p a) r =>
InterpreterFor (ProcessOutput p (Either a b)) r
interpretProcessOutputLeft =
  (forall (rInitial :: [Effect]) x.
 ProcessOutput p (Either a b) (Sem rInitial) x -> Sem r x)
-> Sem (ProcessOutput p (Either a b) : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Chunk ByteString
buf ByteString
new ->
      ([a] -> [Either a b])
-> ([a], ByteString) -> ([Either a b], ByteString)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a -> Either a b) -> [a] -> [Either a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left) (([a], ByteString) -> ([Either a b], ByteString))
-> Sem r ([a], ByteString) -> Sem r ([Either a b], ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: OutputPipe) a (r :: [Effect]).
MemberWithError (ProcessOutput p a) r =>
ByteString -> ByteString -> Sem r ([a], ByteString)
ProcessOutput.chunk @p ByteString
buf ByteString
new

-- |Transformer for 'ProcessOutput' that lifts results into 'Right', creating 'ProcessOutput p (Either a b)' from
-- 'ProcessOutput p b'.
interpretProcessOutputRight ::
  ∀ p a b r .
  Member (ProcessOutput p b) r =>
  InterpreterFor (ProcessOutput p (Either a b)) r
interpretProcessOutputRight :: forall (p :: OutputPipe) a b (r :: [Effect]).
Member (ProcessOutput p b) r =>
InterpreterFor (ProcessOutput p (Either a b)) r
interpretProcessOutputRight =
  (forall (rInitial :: [Effect]) x.
 ProcessOutput p (Either a b) (Sem rInitial) x -> Sem r x)
-> Sem (ProcessOutput p (Either a b) : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Chunk ByteString
buf ByteString
new ->
      ([b] -> [Either a b])
-> ([b], ByteString) -> ([Either a b], ByteString)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((b -> Either a b) -> [b] -> [Either a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right) (([b], ByteString) -> ([Either a b], ByteString))
-> Sem r ([b], ByteString) -> Sem r ([Either a b], ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: OutputPipe) a (r :: [Effect]).
MemberWithError (ProcessOutput p a) r =>
ByteString -> ByteString -> Sem r ([a], ByteString)
ProcessOutput.chunk @p ByteString
buf ByteString
new

splitLines :: ByteString -> ByteString -> ([ByteString], ByteString)
splitLines :: ByteString -> ByteString -> ([ByteString], ByteString)
splitLines ByteString
buffer ByteString
new =
  (Maybe ByteString -> ByteString)
-> ([ByteString], Maybe ByteString) -> ([ByteString], ByteString)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Maybe ByteString -> ByteString
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ((ByteString
 -> ([ByteString], Maybe ByteString)
 -> ([ByteString], Maybe ByteString))
-> ([ByteString], Maybe ByteString)
-> [ByteString]
-> ([ByteString], Maybe ByteString)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' ByteString
-> ([ByteString], Maybe ByteString)
-> ([ByteString], Maybe ByteString)
forall {a}. a -> ([a], Maybe a) -> ([a], Maybe a)
folder ([], Maybe ByteString
forall a. Maybe a
Nothing) [ByteString]
parts)
  where
    parts :: [ByteString]
parts =
      Word8 -> ByteString -> [ByteString]
ByteString.split Word8
10 (ByteString
buffer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
new)
    folder :: a -> ([a], Maybe a) -> ([a], Maybe a)
folder a
a ([a]
z, Maybe a
Nothing) =
      ([a]
z, a -> Maybe a
forall a. a -> Maybe a
Just a
a)
    folder a
a ([a]
z, Just a
r) =
      (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
z, a -> Maybe a
forall a. a -> Maybe a
Just a
r)

-- |Interpret 'ProcessOutput' by emitting individual 'ByteString' lines of output.
interpretProcessOutputLines ::
  ∀ p r .
  InterpreterFor (ProcessOutput p ByteString) r
interpretProcessOutputLines :: forall (p :: OutputPipe) (r :: [Effect]).
InterpreterFor (ProcessOutput p ByteString) r
interpretProcessOutputLines =
  (forall (rInitial :: [Effect]) x.
 ProcessOutput p ByteString (Sem rInitial) x -> Sem r x)
-> Sem (ProcessOutput p ByteString : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Chunk ByteString
buffer ByteString
new ->
      ([ByteString], ByteString) -> Sem r ([ByteString], ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteString -> ([ByteString], ByteString)
splitLines ByteString
buffer ByteString
new)
{-# inline interpretProcessOutputLines #-}

-- |Interpret 'ProcessOutput' by immediately emitting 'Text' without accumulation.
interpretProcessOutputText ::
  ∀ p r .
  InterpreterFor (ProcessOutput p Text) r
interpretProcessOutputText :: forall (p :: OutputPipe) (r :: [Effect]).
InterpreterFor (ProcessOutput p Text) r
interpretProcessOutputText =
  (forall (rInitial :: [Effect]) x.
 ProcessOutput p Text (Sem rInitial) x -> Sem r x)
-> Sem (ProcessOutput p Text : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Chunk ByteString
buffer ByteString
new ->
      ([Text], ByteString) -> Sem r ([Text], ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString
buffer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
new)], ByteString
"")
{-# inline interpretProcessOutputText #-}

-- |Interpret 'ProcessOutput' by emitting individual 'Text' lines of output.
interpretProcessOutputTextLines ::
  ∀ p r .
  InterpreterFor (ProcessOutput p Text) r
interpretProcessOutputTextLines :: forall (p :: OutputPipe) (r :: [Effect]).
InterpreterFor (ProcessOutput p Text) r
interpretProcessOutputTextLines =
  (forall (rInitial :: [Effect]) x.
 ProcessOutput p Text (Sem rInitial) x -> Sem r x)
-> Sem (ProcessOutput p Text : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Chunk ByteString
buffer ByteString
new ->
      ([Text], ByteString) -> Sem r ([Text], ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([ByteString] -> [Text])
-> ([ByteString], ByteString) -> ([Text], ByteString)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((ByteString -> Text) -> [ByteString] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8) (ByteString -> ByteString -> ([ByteString], ByteString)
splitLines ByteString
buffer ByteString
new))
{-# inline interpretProcessOutputTextLines #-}

type Parser a =
  ByteString -> ProcessOutputParseResult a

-- |Internal helper for 'interpretProcessOutputIncremental' that repeatedly parses elements from a chunk until the
-- parser returns a failure or a partial result.
parseMany ::
  Parser a ->
  Maybe (Parser a) ->
  ByteString ->
  (Maybe (Parser a), ([Either Text a], ByteString))
parseMany :: forall a.
Parser a
-> Maybe (Parser a)
-> ByteString
-> (Maybe (Parser a), ([Either Text a], ByteString))
parseMany Parser a
parse =
  ([Either Text a] -> [Either Text a])
-> Maybe (Parser a)
-> ByteString
-> (Maybe (Parser a), ([Either Text a], ByteString))
spin [Either Text a] -> [Either Text a]
forall a. a -> a
id
  where
    spin :: ([Either Text a] -> [Either Text a])
-> Maybe (Parser a)
-> ByteString
-> (Maybe (Parser a), ([Either Text a], ByteString))
spin [Either Text a] -> [Either Text a]
cons Maybe (Parser a)
cont = \case
      ByteString
"" ->
        (Maybe (Parser a)
cont, ([Either Text a] -> [Either Text a]
cons [], ByteString
""))
      ByteString
chunk ->
        case Parser a -> Maybe (Parser a) -> Parser a
forall a. a -> Maybe a -> a
fromMaybe Parser a
parse Maybe (Parser a)
cont ByteString
chunk of
          Fail Text
e ->
            (Maybe (Parser a)
forall a. Maybe a
Nothing, ([Either Text a] -> [Either Text a]
cons [Text -> Either Text a
forall a b. a -> Either a b
Left Text
e], ByteString
""))
          Partial Parser a
c ->
            (Parser a -> Maybe (Parser a)
forall a. a -> Maybe a
Just Parser a
c, ([Either Text a] -> [Either Text a]
cons [], ByteString
""))
          Done a
a ByteString
rest ->
            ([Either Text a] -> [Either Text a])
-> Maybe (Parser a)
-> ByteString
-> (Maybe (Parser a), ([Either Text a], ByteString))
spin ([Either Text a] -> [Either Text a]
cons ([Either Text a] -> [Either Text a])
-> ([Either Text a] -> [Either Text a])
-> [Either Text a]
-> [Either Text a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either Text a
forall a b. b -> Either a b
Right a
a Either Text a -> [Either Text a] -> [Either Text a]
forall a. a -> [a] -> [a]
:)) Maybe (Parser a)
forall a. Maybe a
Nothing ByteString
rest

-- |Whenever a chunk of output arrives, call the supplied incremental parser whose result must be converted to
-- 'ProcessOutputParseResult'.
-- If a partial parse result is produced, it is stored in the state and resumed when the next chunk is available.
-- If parsing an @a@ succeeds, the parser recurses until it fails.
interpretProcessOutputIncremental ::
  ∀ p a r .
  (ByteString -> ProcessOutputParseResult a) ->
  InterpreterFor (ProcessOutput p (Either Text a)) r
interpretProcessOutputIncremental :: forall (p :: OutputPipe) a (r :: [Effect]).
(ByteString -> ProcessOutputParseResult a)
-> InterpreterFor (ProcessOutput p (Either Text a)) r
interpretProcessOutputIncremental ByteString -> ProcessOutputParseResult a
parse =
  Maybe (ByteString -> ProcessOutputParseResult a)
-> Sem
     (State (Maybe (ByteString -> ProcessOutputParseResult a)) : r) a
-> Sem r a
forall s (r :: [Effect]) a. s -> Sem (State s : r) a -> Sem r a
evalState (Maybe (ByteString -> ProcessOutputParseResult a)
forall a. Maybe a
Nothing :: Maybe (ByteString -> ProcessOutputParseResult a)) (Sem
   (State (Maybe (ByteString -> ProcessOutputParseResult a)) : r) a
 -> Sem r a)
-> (Sem (ProcessOutput p (Either Text a) : r) a
    -> Sem
         (State (Maybe (ByteString -> ProcessOutputParseResult a)) : r) a)
-> Sem (ProcessOutput p (Either Text a) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall s (r :: [Effect]) a.
Member (State s) r =>
Sem (AtomicState s : r) a -> Sem r a
atomicStateToState @(Maybe (ByteString -> ProcessOutputParseResult a)) (Sem
   (AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
      : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
   a
 -> Sem
      (State (Maybe (ByteString -> ProcessOutputParseResult a)) : r) a)
-> (Sem (ProcessOutput p (Either Text a) : r) a
    -> Sem
         (AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
            : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
         a)
-> Sem (ProcessOutput p (Either Text a) : r) a
-> Sem
     (State (Maybe (ByteString -> ProcessOutputParseResult a)) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall (rInitial :: [Effect]) x.
 ProcessOutput p (Either Text a) (Sem rInitial) x
 -> Sem
      (AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
         : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
      x)
-> Sem
     (ProcessOutput p (Either Text a)
        : AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
        : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
     a
-> Sem
     (AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
        : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
     a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [Effect]) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Chunk ByteString
buffer ByteString
new -> (Maybe (ByteString -> ProcessOutputParseResult a)
 -> (Maybe (ByteString -> ProcessOutputParseResult a),
     ([Either Text a], ByteString)))
-> Sem
     (AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
        : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
     ([Either Text a], ByteString)
forall s a (r :: [Effect]).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState ((Maybe (ByteString -> ProcessOutputParseResult a)
 -> ByteString
 -> (Maybe (ByteString -> ProcessOutputParseResult a),
     ([Either Text a], ByteString)))
-> ByteString
-> Maybe (ByteString -> ProcessOutputParseResult a)
-> (Maybe (ByteString -> ProcessOutputParseResult a),
    ([Either Text a], ByteString))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ByteString -> ProcessOutputParseResult a)
-> Maybe (ByteString -> ProcessOutputParseResult a)
-> ByteString
-> (Maybe (ByteString -> ProcessOutputParseResult a),
    ([Either Text a], ByteString))
forall a.
Parser a
-> Maybe (Parser a)
-> ByteString
-> (Maybe (Parser a), ([Either Text a], ByteString))
parseMany ByteString -> ProcessOutputParseResult a
parse) (ByteString
buffer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
new))
  (Sem
   (ProcessOutput p (Either Text a)
      : AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
      : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
   a
 -> Sem
      (AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
         : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
      a)
-> (Sem (ProcessOutput p (Either Text a) : r) a
    -> Sem
         (ProcessOutput p (Either Text a)
            : AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
            : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
         a)
-> Sem (ProcessOutput p (Either Text a) : r) a
-> Sem
     (AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
        : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (ProcessOutput p (Either Text a) : r) a
-> Sem
     (ProcessOutput p (Either Text a)
        : AtomicState (Maybe (ByteString -> ProcessOutputParseResult a))
        : State (Maybe (ByteString -> ProcessOutputParseResult a)) : r)
     a
forall (e2 :: Effect) (e3 :: Effect) (e1 :: Effect) (r :: [Effect])
       a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2