module Chiasma.Monad.Stream where

import Conduit (ConduitT, Flush(..), runConduit, sinkList, yield, yieldMany, (.|))
import Control.Monad.Trans.Free (FreeT(..))
import qualified Data.Conduit.Combinators as Conduit (drop, take)

import Chiasma.Api.Class (TmuxApi(..))
import Chiasma.Codec.Decode (TmuxDecodeError)
import Chiasma.Data.Cmd (Cmd(..), Cmds(..))
import Chiasma.Data.TmuxError (TmuxError)
import qualified Chiasma.Data.TmuxError as TmuxError (TmuxError(ProcessFailed, DecodingFailed, CommandFailed))
import Chiasma.Data.TmuxThunk (TmuxThunk)
import Chiasma.Monad.EvalFreeT (evalFreeT)
import Chiasma.Native.StreamParse (TmuxOutputBlock)
import qualified Chiasma.Native.StreamParse as TmuxOutputBlock (TmuxOutputBlock(..))

type TmuxProg = FreeT TmuxThunk

type WriteCmd m =
  ConduitT (Flush Cmd) Void m ()

type ReadOutput m =
  ConduitT () TmuxOutputBlock m ()

handleProcessOutput ::
  Cmds ->
  (Text -> Either TmuxDecodeError a) ->
  [TmuxOutputBlock] ->
  Either TmuxError [a]
handleProcessOutput :: Cmds
-> (Text -> Either TmuxDecodeError a)
-> [TmuxOutputBlock]
-> Either TmuxError [a]
handleProcessOutput cs :: Cmds
cs@(Cmds [Cmd]
cmds) Text -> Either TmuxDecodeError a
_ [TmuxOutputBlock]
output | [TmuxOutputBlock] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TmuxOutputBlock]
output Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Cmd] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cmd]
cmds =
  TmuxError -> Either TmuxError [a]
forall a b. a -> Either a b
Left (TmuxError -> Either TmuxError [a])
-> TmuxError -> Either TmuxError [a]
forall a b. (a -> b) -> a -> b
$ Cmds -> Text -> TmuxError
TmuxError.ProcessFailed Cmds
cs Text
"tmux terminated before all commands were processed"
handleProcessOutput Cmds
cmds Text -> Either TmuxDecodeError a
decode [TmuxOutputBlock]
output = do
  [Text]
readOutput <- (Either TmuxError [Text]
 -> TmuxOutputBlock -> Either TmuxError [Text])
-> Either TmuxError [Text]
-> [TmuxOutputBlock]
-> Either TmuxError [Text]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Either TmuxError [Text]
-> TmuxOutputBlock -> Either TmuxError [Text]
validate ([Text] -> Either TmuxError [Text]
forall a b. b -> Either a b
Right []) [TmuxOutputBlock]
output
  (Text -> Either TmuxError a) -> [Text] -> Either TmuxError [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Either TmuxError a
decode' [Text]
readOutput
  where
    validate :: Either TmuxError [Text]
-> TmuxOutputBlock -> Either TmuxError [Text]
validate (Left TmuxError
err) TmuxOutputBlock
_ = TmuxError -> Either TmuxError [Text]
forall a b. a -> Either a b
Left TmuxError
err
    validate Either TmuxError [Text]
_ (TmuxOutputBlock.Success [Text]
a) = [Text] -> Either TmuxError [Text]
forall a b. b -> Either a b
Right [Text]
a
    validate Either TmuxError [Text]
_ (TmuxOutputBlock.Error [Text]
a) = TmuxError -> Either TmuxError [Text]
forall a b. a -> Either a b
Left (TmuxError -> Either TmuxError [Text])
-> TmuxError -> Either TmuxError [Text]
forall a b. (a -> b) -> a -> b
$ Cmds -> [Text] -> TmuxError
TmuxError.CommandFailed Cmds
cmds [Text]
a
    decode' :: Text -> Either TmuxError a
decode' Text
outputLine =
      (TmuxDecodeError -> TmuxError)
-> Either TmuxDecodeError a -> Either TmuxError a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (Cmds -> Text -> TmuxDecodeError -> TmuxError
TmuxError.DecodingFailed Cmds
cmds Text
outputLine) (Either TmuxDecodeError a -> Either TmuxError a)
-> (Text -> Either TmuxDecodeError a) -> Text -> Either TmuxError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TmuxDecodeError a
decode (Text -> Either TmuxError a) -> Text -> Either TmuxError a
forall a b. (a -> b) -> a -> b
$ Text
outputLine

executeCommands ::
  MonadIO m =>
  WriteCmd m ->
  ReadOutput m ->
  (Text -> Either TmuxDecodeError a) ->
  Cmds ->
  m (Either TmuxError [a])
executeCommands :: WriteCmd m
-> ReadOutput m
-> (Text -> Either TmuxDecodeError a)
-> Cmds
-> m (Either TmuxError [a])
executeCommands WriteCmd m
writeCmd ReadOutput m
readOutput Text -> Either TmuxDecodeError a
decode cs :: Cmds
cs@(Cmds [Cmd]
cmds) = do
  [TmuxOutputBlock]
output <- ConduitT () Void m [TmuxOutputBlock] -> m [TmuxOutputBlock]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m [TmuxOutputBlock] -> m [TmuxOutputBlock])
-> ConduitT () Void m [TmuxOutputBlock] -> m [TmuxOutputBlock]
forall a b. (a -> b) -> a -> b
$ do
    [Flush Cmd] -> ConduitT () (Element [Flush Cmd]) m ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany (Cmd -> Flush Cmd
forall a. a -> Flush a
Chunk (Cmd -> Flush Cmd) -> [Cmd] -> [Flush Cmd]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cmd] -> [Cmd]
forall a. [a] -> [a]
reverse [Cmd]
cmds) ConduitT () (Flush Cmd) m () -> WriteCmd m -> ConduitM () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| WriteCmd m
writeCmd
    Flush Cmd -> ConduitT () (Flush Cmd) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Flush Cmd
forall a. Flush a
Flush ConduitT () (Flush Cmd) m () -> WriteCmd m -> ConduitM () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| WriteCmd m
writeCmd
    ReadOutput m
readOutput ReadOutput m
-> ConduitM TmuxOutputBlock Void m [TmuxOutputBlock]
-> ConduitT () Void m [TmuxOutputBlock]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Int -> ConduitT TmuxOutputBlock TmuxOutputBlock m ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
Conduit.take ([Cmd] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cmd]
cmds) ConduitT TmuxOutputBlock TmuxOutputBlock m ()
-> ConduitM TmuxOutputBlock Void m [TmuxOutputBlock]
-> ConduitM TmuxOutputBlock Void m [TmuxOutputBlock]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM TmuxOutputBlock Void m [TmuxOutputBlock]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
  return $ Cmds
-> (Text -> Either TmuxDecodeError a)
-> [TmuxOutputBlock]
-> Either TmuxError [a]
forall a.
Cmds
-> (Text -> Either TmuxDecodeError a)
-> [TmuxOutputBlock]
-> Either TmuxError [a]
handleProcessOutput Cmds
cs Text -> Either TmuxDecodeError a
decode [TmuxOutputBlock]
output

runTmuxProg ::
  MonadIO m =>
  TmuxProg m a ->
  WriteCmd m ->
  ReadOutput m ->
  m (Either TmuxError a)
runTmuxProg :: TmuxProg m a
-> WriteCmd m -> ReadOutput m -> m (Either TmuxError a)
runTmuxProg TmuxProg m a
prog WriteCmd m
writeCmd ReadOutput m
readOutput = do
  ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$ ReadOutput m
readOutput ReadOutput m
-> ConduitM TmuxOutputBlock Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Int -> ConduitM TmuxOutputBlock Void m ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
Conduit.drop Int
1
  CommandExec m
-> CmdBuffer -> TmuxProg m a -> m (Either TmuxError a)
forall (m :: * -> *) a.
Monad m =>
CommandExec m
-> CmdBuffer -> FreeT TmuxThunk m a -> m (Either TmuxError a)
evalFreeT (WriteCmd m
-> ReadOutput m
-> (Text -> Either TmuxDecodeError b)
-> Cmds
-> m (Either TmuxError [b])
forall (m :: * -> *) a.
MonadIO m =>
WriteCmd m
-> ReadOutput m
-> (Text -> Either TmuxDecodeError a)
-> Cmds
-> m (Either TmuxError [a])
executeCommands WriteCmd m
writeCmd ReadOutput m
readOutput) CmdBuffer
forall a. Default a => a
def TmuxProg m a
prog

runTmuxE ::
  (MonadIO m, TmuxApi m api) =>
  api ->
  TmuxProg m a ->
  m (Either TmuxError a)
runTmuxE :: api -> TmuxProg m a -> m (Either TmuxError a)
runTmuxE api
api TmuxProg m a
prog =
  api
-> (ConduitT (Flush Cmd) Void m ()
    -> ConduitT () TmuxOutputBlock m () -> m (Either TmuxError a))
-> m (Either TmuxError a)
forall (m :: * -> *) a b.
TmuxApi m a =>
a
-> (ConduitT (Flush Cmd) Void m ()
    -> ConduitT () TmuxOutputBlock m () -> m b)
-> m b
withTmux api
api (TmuxProg m a
-> ConduitT (Flush Cmd) Void m ()
-> ConduitT () TmuxOutputBlock m ()
-> m (Either TmuxError a)
forall (m :: * -> *) a.
MonadIO m =>
TmuxProg m a
-> WriteCmd m -> ReadOutput m -> m (Either TmuxError a)
runTmuxProg TmuxProg m a
prog)

runTmux ::
  (MonadIO m, MonadDeepError e TmuxError m, TmuxApi m api) =>
  api ->
  TmuxProg m a ->
  m a
runTmux :: api -> TmuxProg m a -> m a
runTmux api
api =
  Either TmuxError a -> m a
forall e e' (m :: * -> *) a.
MonadDeepError e e' m =>
Either e' a -> m a
hoistEither (Either TmuxError a -> m a)
-> (TmuxProg m a -> m (Either TmuxError a)) -> TmuxProg m a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< api -> TmuxProg m a -> m (Either TmuxError a)
forall (m :: * -> *) api a.
(MonadIO m, TmuxApi m api) =>
api -> TmuxProg m a -> m (Either TmuxError a)
runTmuxE api
api