module Ribosome.Host.Interpreter.Process.Cereal where

import qualified Data.ByteString as ByteString
import qualified Data.Serialize as Serialize
import Data.Serialize (Serialize, runGetPartial)
import Exon (exon)
import qualified Polysemy.Log as Log
import Polysemy.Process (
  OutputPipe (Stderr, Stdout),
  Process,
  ProcessInput,
  ProcessOptions,
  ProcessOutputParseResult (Done, Fail, Partial),
  SystemProcess,
  interpretProcessOutputIncremental,
  interpretProcess_,
  interpretSystemProcessNative_, SystemProcessScopeError,
  )
import Polysemy.Process.Data.ProcessError (ProcessError)
import Polysemy.Process.Data.SystemProcessError (SystemProcessError)
import qualified Polysemy.Process.Effect.ProcessInput as ProcessInput
import Polysemy.Process.Effect.ProcessOutput (ProcessOutput (Chunk))
import Polysemy.Process.Interpreter.SystemProcess (PipesProcess)
import System.Process.Typed (ProcessConfig)

convertResult :: Serialize.Result a -> ProcessOutputParseResult a
convertResult :: forall a. Result a -> ProcessOutputParseResult a
convertResult = \case
  Serialize.Fail String
err ByteString
_ ->
    Text -> ProcessOutputParseResult a
forall a. Text -> ProcessOutputParseResult a
Fail (String -> Text
forall a. ToText a => a -> Text
toText String
err)
  Serialize.Done a
a ByteString
leftover ->
    a -> ByteString -> ProcessOutputParseResult a
forall a. a -> ByteString -> ProcessOutputParseResult a
Done a
a ByteString
leftover
  Serialize.Partial ByteString -> Result a
cont ->
    (ByteString -> ProcessOutputParseResult a)
-> ProcessOutputParseResult a
forall a.
(ByteString -> ProcessOutputParseResult a)
-> ProcessOutputParseResult a
Partial (Result a -> ProcessOutputParseResult a
forall a. Result a -> ProcessOutputParseResult a
convertResult (Result a -> ProcessOutputParseResult a)
-> (ByteString -> Result a)
-> ByteString
-> ProcessOutputParseResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Result a
cont)

type Parser a =
  ByteString -> ProcessOutputParseResult a

interpretProcessOutputCereal ::
  ∀ a r .
  Serialize a =>
  InterpreterFor (ProcessOutput 'Stdout (Either Text a)) r
interpretProcessOutputCereal :: forall a (r :: [Effect]).
Serialize a =>
InterpreterFor (ProcessOutput 'Stdout (Either Text a)) r
interpretProcessOutputCereal =
  (ByteString -> ProcessOutputParseResult a)
-> InterpreterFor (ProcessOutput 'Stdout (Either Text a)) r
forall (p :: OutputPipe) a (r :: [Effect]).
(ByteString -> ProcessOutputParseResult a)
-> InterpreterFor (ProcessOutput p (Either Text a)) r
interpretProcessOutputIncremental (Result a -> ProcessOutputParseResult a
forall a. Result a -> ProcessOutputParseResult a
convertResult (Result a -> ProcessOutputParseResult a)
-> (ByteString -> Result a)
-> ByteString
-> ProcessOutputParseResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get a -> ByteString -> Result a
forall a. Get a -> ByteString -> Result a
runGetPartial Get a
forall t. Serialize t => Get t
Serialize.get)

interpretProcessOutputLog ::
  ∀ p a r .
  Member Log r =>
  InterpreterFor (ProcessOutput p a) r
interpretProcessOutputLog :: forall (p :: OutputPipe) a (r :: [Effect]).
Member Log r =>
InterpreterFor (ProcessOutput p a) r
interpretProcessOutputLog =
  (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
msg ->
      ([], ByteString
"") ([a], ByteString) -> Sem r () -> Sem r ([a], ByteString)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
ByteString.null ByteString
msg) (Text -> Sem r ()
forall (r :: [Effect]).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.debug [exon|Nvim stderr: #{decodeUtf8 msg}|])

interpretProcessInputCereal ::
  Serialize a =>
  InterpreterFor (ProcessInput a) r
interpretProcessInputCereal :: forall a (r :: [Effect]).
Serialize a =>
InterpreterFor (ProcessInput a) r
interpretProcessInputCereal =
  (forall (rInitial :: [Effect]) x.
 ProcessInput a (Sem rInitial) x -> Sem r x)
-> Sem (ProcessInput 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
    ProcessInput.Encode a
msg ->
      ByteString -> Sem r ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ByteString
forall a. Serialize a => a -> ByteString
Serialize.encode a
msg)

interpretProcessCereal ::
  ∀ resource a r .
  Serialize a =>
  Member (Scoped resource (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r =>
  Members [Log, Resource, Race, Async, Embed IO] r =>
  ProcessOptions ->
  InterpreterFor (Scoped () (Process a (Either Text a)) !! ProcessError) r
interpretProcessCereal :: forall resource a (r :: [Effect]).
(Serialize a,
 Member
   (Scoped resource (SystemProcess !! SystemProcessError)
    !! SystemProcessScopeError)
   r,
 Members '[Log, Resource, Race, Async, Embed IO] r) =>
ProcessOptions
-> InterpreterFor
     (Scoped () (Process a (Either Text a)) !! ProcessError) r
interpretProcessCereal ProcessOptions
options =
  forall (p :: OutputPipe) a (r :: [Effect]).
Member Log r =>
InterpreterFor (ProcessOutput p a) r
interpretProcessOutputLog @'Stderr (Sem (ProcessOutput 'Stderr (Either Text a) : r) a -> Sem r a)
-> (Sem
      ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
    -> Sem (ProcessOutput 'Stderr (Either Text a) : r) a)
-> Sem
     ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (ProcessOutput 'Stdout (Either Text a)
     : ProcessOutput 'Stderr (Either Text a) : r)
  a
-> Sem (ProcessOutput 'Stderr (Either Text a) : r) a
forall a (r :: [Effect]).
Serialize a =>
InterpreterFor (ProcessOutput 'Stdout (Either Text a)) r
interpretProcessOutputCereal (Sem
   (ProcessOutput 'Stdout (Either Text a)
      : ProcessOutput 'Stderr (Either Text a) : r)
   a
 -> Sem (ProcessOutput 'Stderr (Either Text a) : r) a)
-> (Sem
      ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
    -> Sem
         (ProcessOutput 'Stdout (Either Text a)
            : ProcessOutput 'Stderr (Either Text a) : r)
         a)
-> Sem
     ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
-> Sem (ProcessOutput 'Stderr (Either Text a) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (ProcessInput a
     : ProcessOutput 'Stdout (Either Text a)
     : ProcessOutput 'Stderr (Either Text a) : r)
  a
-> Sem
     (ProcessOutput 'Stdout (Either Text a)
        : ProcessOutput 'Stderr (Either Text a) : r)
     a
forall a (r :: [Effect]).
Serialize a =>
InterpreterFor (ProcessInput a) r
interpretProcessInputCereal (Sem
   (ProcessInput a
      : ProcessOutput 'Stdout (Either Text a)
      : ProcessOutput 'Stderr (Either Text a) : r)
   a
 -> Sem
      (ProcessOutput 'Stdout (Either Text a)
         : ProcessOutput 'Stderr (Either Text a) : r)
      a)
-> (Sem
      ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
    -> Sem
         (ProcessInput a
            : ProcessOutput 'Stdout (Either Text a)
            : ProcessOutput 'Stderr (Either Text a) : r)
         a)
-> Sem
     ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
-> Sem
     (ProcessOutput 'Stdout (Either Text a)
        : ProcessOutput 'Stderr (Either Text a) : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall resource i o (r :: [Effect]).
(Member
   (Scoped resource (SystemProcess !! SystemProcessError)
    !! SystemProcessScopeError)
   r,
 Members
   '[ProcessOutput 'Stdout o, ProcessOutput 'Stderr o, ProcessInput i,
     Resource, Race, Async, Embed IO]
   r) =>
ProcessOptions
-> InterpreterFor (Scoped () (Process i o) !! ProcessError) r
interpretProcess_ @resource ProcessOptions
options (Sem
   ((Scoped () (Process a (Either Text a)) !! ProcessError)
      : ProcessInput a : ProcessOutput 'Stdout (Either Text a)
      : ProcessOutput 'Stderr (Either Text a) : r)
   a
 -> Sem
      (ProcessInput a
         : ProcessOutput 'Stdout (Either Text a)
         : ProcessOutput 'Stderr (Either Text a) : r)
      a)
-> (Sem
      ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
    -> Sem
         ((Scoped () (Process a (Either Text a)) !! ProcessError)
            : ProcessInput a : ProcessOutput 'Stdout (Either Text a)
            : ProcessOutput 'Stderr (Either Text a) : r)
         a)
-> Sem
     ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
-> Sem
     (ProcessInput a
        : ProcessOutput 'Stdout (Either Text a)
        : ProcessOutput 'Stderr (Either Text a) : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
-> Sem
     ((Scoped () (Process a (Either Text a)) !! ProcessError)
        : ProcessInput a : ProcessOutput 'Stdout (Either Text a)
        : ProcessOutput 'Stderr (Either Text a) : r)
     a
forall (e2 :: Effect) (e3 :: Effect) (e4 :: Effect) (e1 :: Effect)
       (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
raiseUnder3

interpretProcessCerealNative ::
  ∀ a r .
  Serialize a =>
  Members [Log, Resource, Race, Async, Embed IO] r =>
  ProcessOptions ->
  ProcessConfig () () () ->
  InterpreterFor (Scoped () (Process a (Either Text a)) !! ProcessError) r
interpretProcessCerealNative :: forall a (r :: [Effect]).
(Serialize a, Members '[Log, Resource, Race, Async, Embed IO] r) =>
ProcessOptions
-> ProcessConfig () () ()
-> InterpreterFor
     (Scoped () (Process a (Either Text a)) !! ProcessError) r
interpretProcessCerealNative ProcessOptions
options ProcessConfig () () ()
conf =
  ProcessConfig () () ()
-> InterpreterFor
     (Scoped PipesProcess (SystemProcess !! SystemProcessError)
      !! SystemProcessScopeError)
     r
forall (r :: [Effect]).
Members '[Resource, Embed IO] r =>
ProcessConfig () () ()
-> InterpreterFor
     (Scoped PipesProcess (SystemProcess !! SystemProcessError)
      !! SystemProcessScopeError)
     r
interpretSystemProcessNative_ ProcessConfig () () ()
conf (Sem
   ((Scoped PipesProcess (SystemProcess !! SystemProcessError)
     !! SystemProcessScopeError)
      : r)
   a
 -> Sem r a)
-> (Sem
      ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
    -> Sem
         ((Scoped PipesProcess (SystemProcess !! SystemProcessError)
           !! SystemProcessScopeError)
            : r)
         a)
-> Sem
     ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall resource a (r :: [Effect]).
(Serialize a,
 Member
   (Scoped resource (SystemProcess !! SystemProcessError)
    !! SystemProcessScopeError)
   r,
 Members '[Log, Resource, Race, Async, Embed IO] r) =>
ProcessOptions
-> InterpreterFor
     (Scoped () (Process a (Either Text a)) !! ProcessError) r
interpretProcessCereal @PipesProcess @a ProcessOptions
options (Sem
   ((Scoped () (Process a (Either Text a)) !! ProcessError)
      : (Scoped PipesProcess (SystemProcess !! SystemProcessError)
         !! SystemProcessScopeError)
      : r)
   a
 -> Sem
      ((Scoped PipesProcess (SystemProcess !! SystemProcessError)
        !! SystemProcessScopeError)
         : r)
      a)
-> (Sem
      ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
    -> Sem
         ((Scoped () (Process a (Either Text a)) !! ProcessError)
            : (Scoped PipesProcess (SystemProcess !! SystemProcessError)
               !! SystemProcessScopeError)
            : r)
         a)
-> Sem
     ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
-> Sem
     ((Scoped PipesProcess (SystemProcess !! SystemProcessError)
       !! SystemProcessScopeError)
        : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem ((Scoped () (Process a (Either Text a)) !! ProcessError) : r) a
-> Sem
     ((Scoped () (Process a (Either Text a)) !! ProcessError)
        : (Scoped PipesProcess (SystemProcess !! SystemProcessError)
           !! SystemProcessScopeError)
        : r)
     a
forall (e2 :: Effect) (e1 :: Effect) (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder