module Chiasma.Command.Pane where

import Data.List (dropWhileEnd)
import qualified Data.Text as Text (intercalate, singleton, splitOn)

import Chiasma.Codec (TmuxCodec)
import qualified Chiasma.Codec.Data as Codec (Pane)
import qualified Chiasma.Codec.Data.PaneCoords as Codec (PaneCoords)
import qualified Chiasma.Codec.Data.PaneMode as Codec (PaneMode(PaneMode))
import qualified Chiasma.Codec.Data.PanePid as Codec (PanePid)
import Chiasma.Data.TmuxId (HasPaneId, PaneId, WindowId, formatId)
import qualified Chiasma.Data.TmuxId as HasPaneId (paneId)
import Chiasma.Data.TmuxThunk (TmuxThunk)
import Chiasma.Data.View (View(View))
import qualified Chiasma.Monad.Tmux as Tmux (read, readRaw, unsafeReadFirst, write)
import Control.Monad.Free.Class (MonadFree)

paneTarget :: PaneId -> [Text]
paneTarget :: PaneId -> [Text]
paneTarget PaneId
paneId =
  [Item [Text]
"-t", PaneId -> Text
forall a. TmuxId a => a -> Text
formatId PaneId
paneId]

sameId :: HasPaneId a => PaneId -> a -> Bool
sameId :: PaneId -> a -> Bool
sameId PaneId
target a
candidate = PaneId
target PaneId -> PaneId -> Bool
forall a. Eq a => a -> a -> Bool
== a -> PaneId
forall a. HasPaneId a => a -> PaneId
HasPaneId.paneId a
candidate

panesAs :: (MonadFree TmuxThunk m, TmuxCodec a) => m [a]
panesAs :: m [a]
panesAs =
  Text -> [Text] -> m [a]
forall a (m :: * -> *).
(TmuxCodec a, MonadFree TmuxThunk m) =>
Text -> [Text] -> m [a]
Tmux.read Text
"list-panes" [Item [Text]
"-a"]

panes :: MonadFree TmuxThunk m => m [Codec.Pane]
panes :: m [Pane]
panes =
  m [Pane]
forall (m :: * -> *) a.
(MonadFree TmuxThunk m, TmuxCodec a) =>
m [a]
panesAs

pane :: (MonadFree TmuxThunk m, TmuxCodec a, HasPaneId a) => PaneId -> m (Maybe a)
pane :: PaneId -> m (Maybe a)
pane PaneId
paneId =
  (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (PaneId -> a -> Bool
forall a. HasPaneId a => PaneId -> a -> Bool
sameId PaneId
paneId) ([a] -> Maybe a) -> m [a] -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text] -> m [a]
forall a (m :: * -> *).
(TmuxCodec a, MonadFree TmuxThunk m) =>
Text -> [Text] -> m [a]
Tmux.read Text
"list-panes" [Item [Text]
"-t", PaneId -> Text
forall a. TmuxId a => a -> Text
formatId PaneId
paneId]

windowPanesAs :: (MonadFree TmuxThunk m, TmuxCodec a) => WindowId -> m [a]
windowPanesAs :: WindowId -> m [a]
windowPanesAs WindowId
windowId =
  Text -> [Text] -> m [a]
forall a (m :: * -> *).
(TmuxCodec a, MonadFree TmuxThunk m) =>
Text -> [Text] -> m [a]
Tmux.read Text
"list-panes" [Item [Text]
"-t", WindowId -> Text
forall a. TmuxId a => a -> Text
formatId WindowId
windowId]

windowPanes :: MonadFree TmuxThunk m => WindowId -> m [Codec.Pane]
windowPanes :: WindowId -> m [Pane]
windowPanes =
  WindowId -> m [Pane]
forall (m :: * -> *) a.
(MonadFree TmuxThunk m, TmuxCodec a) =>
WindowId -> m [a]
windowPanesAs

firstWindowPane :: MonadFree TmuxThunk m => WindowId -> m Codec.Pane
firstWindowPane :: WindowId -> m Pane
firstWindowPane WindowId
windowId =
  Text -> [Text] -> m Pane
forall a (m :: * -> *).
(TmuxCodec a, MonadFree TmuxThunk m) =>
Text -> [Text] -> m a
Tmux.unsafeReadFirst Text
"list-panes" [Item [Text]
"-t", WindowId -> Text
forall a. TmuxId a => a -> Text
formatId WindowId
windowId]

closePane :: MonadFree TmuxThunk m => PaneId -> m ()
closePane :: PaneId -> m ()
closePane PaneId
paneId =
  Text -> [Text] -> m ()
forall (m :: * -> *).
MonadFree TmuxThunk m =>
Text -> [Text] -> m ()
Tmux.write Text
"kill-pane" (PaneId -> [Text]
paneTarget PaneId
paneId)

isPaneIdOpen ::
  MonadFree TmuxThunk m =>
  PaneId ->
  m Bool
isPaneIdOpen :: PaneId -> m Bool
isPaneIdOpen PaneId
paneId =
  (Pane -> Bool) -> [Pane] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PaneId -> Pane -> Bool
forall a. HasPaneId a => PaneId -> a -> Bool
sameId PaneId
paneId) ([Pane] -> Bool) -> m [Pane] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Pane]
forall (m :: * -> *). MonadFree TmuxThunk m => m [Pane]
panes

isPaneOpen ::
  MonadFree TmuxThunk m =>
  View PaneId ->
  m Bool
isPaneOpen :: View PaneId -> m Bool
isPaneOpen (View Ident
_ (Just PaneId
paneId)) =
  PaneId -> m Bool
forall (m :: * -> *). MonadFree TmuxThunk m => PaneId -> m Bool
isPaneIdOpen PaneId
paneId
isPaneOpen View PaneId
_ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

movePane ::
  MonadFree TmuxThunk m =>
  PaneId ->
  PaneId ->
  Bool ->
  m ()
movePane :: PaneId -> PaneId -> Bool -> m ()
movePane PaneId
paneId PaneId
refId Bool
vertical =
  Text -> [Text] -> m ()
forall (m :: * -> *).
MonadFree TmuxThunk m =>
Text -> [Text] -> m ()
Tmux.write Text
"move-pane" [Item [Text]
"-d", Item [Text]
"-s", PaneId -> Text
forall a. TmuxId a => a -> Text
formatId PaneId
paneId, Item [Text]
"-t", PaneId -> Text
forall a. TmuxId a => a -> Text
formatId PaneId
refId, Text
Item [Text]
direction]
  where
    direction :: Text
direction = if Bool
vertical then Text
"-v" else Text
"-h"

resizePane ::
  MonadFree TmuxThunk m =>
  PaneId ->
  Bool ->
  Int ->
  m ()
resizePane :: PaneId -> Bool -> Int -> m ()
resizePane PaneId
paneId Bool
vertical Int
size =
  Text -> [Text] -> m ()
forall (m :: * -> *).
MonadFree TmuxThunk m =>
Text -> [Text] -> m ()
Tmux.write Text
"resize-pane" [Item [Text]
"-t", PaneId -> Text
forall a. TmuxId a => a -> Text
formatId PaneId
paneId, Text
Item [Text]
direction, Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
size]
  where
    direction :: Text
direction = if Bool
vertical then Text
"-y" else Text
"-x"

formatLine :: Text -> [Text]
formatLine :: Text -> [Text]
formatLine Text
line =
  [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text -> Text
replace Text
"\"" Text
"\\\"" Text
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
'"', Item [Text]
"enter"]
  where
    replace :: Text -> Text -> Text -> Text
replace Text
from Text
to =
      Text -> [Text] -> Text
Text.intercalate Text
to ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
from

sendKeys ::
  MonadFree TmuxThunk m =>
  PaneId ->
  [Text] ->
  m ()
sendKeys :: PaneId -> [Text] -> m ()
sendKeys PaneId
paneId [Text]
lines' =
  (Text -> m ()) -> [Text] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> m ()
send [Text]
formatted
  where
    formatted :: [Text]
formatted = [Text]
lines' [Text] -> (Text -> [Text]) -> [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [Text]
formatLine
    send :: Text -> m ()
send Text
line = Text -> [Text] -> m ()
forall (m :: * -> *).
MonadFree TmuxThunk m =>
Text -> [Text] -> m ()
Tmux.write Text
"send-keys" (PaneId -> [Text]
paneTarget PaneId
paneId [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
Item [Text]
line])

pipePane ::
  MonadFree TmuxThunk m =>
  PaneId ->
  Text ->
  m ()
pipePane :: PaneId -> Text -> m ()
pipePane PaneId
paneId Text
cmd =
  Text -> [Text] -> m ()
forall (m :: * -> *).
MonadFree TmuxThunk m =>
Text -> [Text] -> m ()
Tmux.write Text
"pipe-pane" (PaneId -> [Text]
paneTarget PaneId
paneId [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
Item [Text]
cmd])

capturePane ::
  MonadFree TmuxThunk m =>
  PaneId ->
  m [Text]
capturePane :: PaneId -> m [Text]
capturePane PaneId
paneId = do
  [Text]
lines' <- Text -> [Text] -> m [Text]
forall (m :: * -> *).
MonadFree TmuxThunk m =>
Text -> [Text] -> m [Text]
Tmux.readRaw Text
"capture-pane" (PaneId -> [Text]
paneTarget PaneId
paneId [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Item [Text]
"-p", Item [Text]
"-e"])
  return $ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Text
"" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) [Text]
lines'

panePid ::
  MonadFree TmuxThunk m =>
  PaneId ->
  m (Maybe Codec.PanePid)
panePid :: PaneId -> m (Maybe PanePid)
panePid =
  PaneId -> m (Maybe PanePid)
forall (m :: * -> *) a.
(MonadFree TmuxThunk m, TmuxCodec a, HasPaneId a) =>
PaneId -> m (Maybe a)
pane

panePids ::
  MonadFree TmuxThunk m =>
  m [Codec.PanePid]
panePids :: m [PanePid]
panePids =
  m [PanePid]
forall (m :: * -> *) a.
(MonadFree TmuxThunk m, TmuxCodec a) =>
m [a]
panesAs

paneCoords ::
  MonadFree TmuxThunk m =>
  PaneId ->
  m (Maybe Codec.PaneCoords)
paneCoords :: PaneId -> m (Maybe PaneCoords)
paneCoords =
  PaneId -> m (Maybe PaneCoords)
forall (m :: * -> *) a.
(MonadFree TmuxThunk m, TmuxCodec a, HasPaneId a) =>
PaneId -> m (Maybe a)
pane

selectPane ::
  MonadFree TmuxThunk m =>
  PaneId ->
  m ()
selectPane :: PaneId -> m ()
selectPane PaneId
paneId =
  Text -> [Text] -> m ()
forall (m :: * -> *).
MonadFree TmuxThunk m =>
Text -> [Text] -> m ()
Tmux.write Text
"select-pane" (PaneId -> [Text]
paneTarget PaneId
paneId)

copyMode ::
  MonadFree TmuxThunk m =>
  PaneId ->
  m ()
copyMode :: PaneId -> m ()
copyMode =
  Text -> [Text] -> m ()
forall (m :: * -> *).
MonadFree TmuxThunk m =>
Text -> [Text] -> m ()
Tmux.write Text
"copy-mode" ([Text] -> m ()) -> (PaneId -> [Text]) -> PaneId -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PaneId -> [Text]
paneTarget

paneMode ::
  MonadFree TmuxThunk m =>
  PaneId ->
  m (Maybe Codec.PaneMode)
paneMode :: PaneId -> m (Maybe PaneMode)
paneMode =
  PaneId -> m (Maybe PaneMode)
forall (m :: * -> *) a.
(MonadFree TmuxThunk m, TmuxCodec a, HasPaneId a) =>
PaneId -> m (Maybe a)
pane

quitCopyMode ::
  MonadFree TmuxThunk m =>
  PaneId ->
  m ()
quitCopyMode :: PaneId -> m ()
quitCopyMode PaneId
paneId =
  (PaneMode -> m ()) -> Maybe PaneMode -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ PaneMode -> m ()
check (Maybe PaneMode -> m ()) -> m (Maybe PaneMode) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PaneId -> m (Maybe PaneMode)
forall (m :: * -> *) a.
(MonadFree TmuxThunk m, TmuxCodec a, HasPaneId a) =>
PaneId -> m (Maybe a)
pane PaneId
paneId
  where
    check :: PaneMode -> m ()
check (Codec.PaneMode PaneId
_ Text
mode) =
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
mode Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"copy-mode") (PaneId -> [Text] -> m ()
forall (m :: * -> *).
MonadFree TmuxThunk m =>
PaneId -> [Text] -> m ()
sendKeys PaneId
paneId [Item [Text]
"C-c"])