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