module Chiasma.Monad.Tmux where

import Control.Monad.Free (liftF)
import Control.Monad.Free.Class (MonadFree)

import Chiasma.Codec (TmuxCodec, TmuxQuery(unQ))
import qualified Chiasma.Codec as TmuxCodec (TmuxCodec(decode, query))
import Chiasma.Data.Cmd (cmd)
import Chiasma.Data.TmuxError (TmuxError(InvalidOutput))
import Chiasma.Data.TmuxThunk (TmuxThunk(..))

read ::  a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m [a]
read :: Text -> [Text] -> m [a]
read Text
name [Text]
args =
  TmuxThunk [a] -> m [a]
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (TmuxThunk [a] -> m [a]) -> TmuxThunk [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ Cmd
-> (Text -> Either TmuxDecodeError a)
-> ([a] -> [a])
-> TmuxThunk [a]
forall next a.
Cmd
-> (Text -> Either TmuxDecodeError a)
-> ([a] -> next)
-> TmuxThunk next
Read (Text -> [Text] -> Cmd
cmd Text
name ([Text]
args [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
formatArgs)) Text -> Either TmuxDecodeError a
forall a. TmuxCodec a => Text -> Either TmuxDecodeError a
TmuxCodec.decode [a] -> [a]
forall a. a -> a
id
  where
    formatArgs :: [Text]
formatArgs = [Item [Text]
"-F", Item [Text]
"'", TmuxQuery -> Text
unQ (TmuxCodec a => TmuxQuery
forall a. TmuxCodec a => TmuxQuery
TmuxCodec.query @a), Item [Text]
"'"]

unsafeReadOne ::  a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m a
unsafeReadOne :: Text -> [Text] -> m a
unsafeReadOne Text
name [Text]
args = do
  [a]
outputs <- Text -> [Text] -> m [a]
forall a (m :: * -> *).
(TmuxCodec a, MonadFree TmuxThunk m) =>
Text -> [Text] -> m [a]
read Text
name [Text]
args
  case [a]
outputs of
    [Item [a]
a] -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
Item [a]
a
    [] -> TmuxThunk a -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (TmuxThunk a -> m a) -> TmuxThunk a -> m a
forall a b. (a -> b) -> a -> b
$ TmuxError -> TmuxThunk a
forall next. TmuxError -> TmuxThunk next
Failed (TmuxError -> TmuxThunk a) -> TmuxError -> TmuxThunk a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TmuxError
InvalidOutput Text
"no data" (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords [Text]
args)
    [a]
_ -> TmuxThunk a -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (TmuxThunk a -> m a) -> TmuxThunk a -> m a
forall a b. (a -> b) -> a -> b
$ TmuxError -> TmuxThunk a
forall next. TmuxError -> TmuxThunk next
Failed (TmuxError -> TmuxThunk a) -> TmuxError -> TmuxThunk a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TmuxError
InvalidOutput Text
"multiple outputs for `unsafeReadOne`" (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords [Text]
args)

readFirst ::  a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m (Maybe a)
readFirst :: Text -> [Text] -> m (Maybe a)
readFirst Text
name [Text]
args = do
  [a]
outputs <- Text -> [Text] -> m [a]
forall a (m :: * -> *).
(TmuxCodec a, MonadFree TmuxThunk m) =>
Text -> [Text] -> m [a]
read Text
name [Text]
args
  return $ case [a]
outputs of
    (a
a : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
    [] -> Maybe a
forall a. Maybe a
Nothing

unsafeReadFirst ::  a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m a
unsafeReadFirst :: Text -> [Text] -> m a
unsafeReadFirst Text
name [Text]
args = do
  Maybe a
mayFirst <- Text -> [Text] -> m (Maybe a)
forall a (m :: * -> *).
(TmuxCodec a, MonadFree TmuxThunk m) =>
Text -> [Text] -> m (Maybe a)
readFirst Text
name [Text]
args
  case Maybe a
mayFirst of
    (Just a
a) -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Maybe a
Nothing -> TmuxThunk a -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (TmuxThunk a -> m a) -> TmuxThunk a -> m a
forall a b. (a -> b) -> a -> b
$ TmuxError -> TmuxThunk a
forall next. TmuxError -> TmuxThunk next
Failed (TmuxError -> TmuxThunk a) -> TmuxError -> TmuxThunk a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> TmuxError
InvalidOutput Text
"no data" (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords [Text]
args)

readRaw ::  m . (MonadFree TmuxThunk m) => Text -> [Text] -> m [Text]
readRaw :: Text -> [Text] -> m [Text]
readRaw Text
name [Text]
args =
  TmuxThunk [Text] -> m [Text]
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (TmuxThunk [Text] -> m [Text]) -> TmuxThunk [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ Cmd
-> (Text -> Either TmuxDecodeError Text)
-> ([Text] -> [Text])
-> TmuxThunk [Text]
forall next a.
Cmd
-> (Text -> Either TmuxDecodeError a)
-> ([a] -> next)
-> TmuxThunk next
Read (Text -> [Text] -> Cmd
cmd Text
name [Text]
args) Text -> Either TmuxDecodeError Text
forall a b. b -> Either a b
Right [Text] -> [Text]
forall a. a -> a
id

write :: MonadFree TmuxThunk m => Text -> [Text] -> m ()
write :: Text -> [Text] -> m ()
write Text
name [Text]
args = TmuxThunk () -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (TmuxThunk () -> m ()) -> TmuxThunk () -> m ()
forall a b. (a -> b) -> a -> b
$ Cmd -> (() -> ()) -> TmuxThunk ()
forall next. Cmd -> (() -> next) -> TmuxThunk next
Write (Text -> [Text] -> Cmd
cmd Text
name [Text]
args) () -> ()
forall a. a -> a
id

flush :: MonadFree TmuxThunk m => m ()
flush :: m ()
flush =
  TmuxThunk () -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (TmuxThunk () -> m ()) -> TmuxThunk () -> m ()
forall a b. (a -> b) -> a -> b
$ (() -> ()) -> TmuxThunk ()
forall next. (() -> next) -> TmuxThunk next
Flush () -> ()
forall a. a -> a
id