RenderTest.hs

module Chiasma.Test.RenderTest where

import Path.IO (getCurrentDir)
import Polysemy.Chronos (ChronosTime)
import Polysemy.Test (UnitTest, (===))
import Test.Tasty (TestTree, testGroup)

import Chiasma.Codec.Data.Pane (Pane (..))
import Chiasma.Command.Pane (windowPanes)
import Chiasma.Data.CodecError (CodecError)
import Chiasma.Data.Ident (Ident (Str))
import Chiasma.Data.Panes (Panes)
import Chiasma.Data.RenderError (RenderError)
import Chiasma.Data.TmuxCommand (TmuxCommand)
import qualified Chiasma.Data.TmuxError as TmuxError
import Chiasma.Data.TmuxError (TmuxError)
import Chiasma.Data.TmuxId (PaneId (PaneId), SessionId (SessionId), WindowId (WindowId))
import Chiasma.Data.TmuxRequest (TmuxRequest)
import Chiasma.Data.TmuxResponse (TmuxResponse)
import Chiasma.Data.View (viewIdent)
import qualified Chiasma.Data.View as Tmux (View (View))
import Chiasma.Data.Views (Views (Views))
import Chiasma.Effect.Codec (Codec)
import Chiasma.Effect.TmuxApi (TmuxApi)
import Chiasma.Effect.TmuxClient (ScopedTmux)
import Chiasma.Render (render)
import Chiasma.Test.Tmux (tmuxTest)
import Chiasma.Test.Util (integrationTest)
import Chiasma.Tmux (withTmux, withTmuxApis)
import Chiasma.Ui.Data.View (Tree (..), TreeSub (..), ViewTree, consLayout, consLayoutVertical)
import qualified Chiasma.Ui.Data.View as Ui (Pane (Pane), View (View))
import Chiasma.Ui.Data.ViewGeometry (ViewGeometry (..))
import Chiasma.Ui.Data.ViewState (ViewState (ViewState))
import Chiasma.Ui.ViewTree (togglePane, toggleResultEither)

id0, id1, id2, id3 :: Ident
id0 = Str "0"
id1 = Str "1"
id2 = Str "2"
id3 = Str "3"

views :: Views
views =
  Views
    [Tmux.View id0 (Just (SessionId 0))]
    [Tmux.View id0 (Just (WindowId 0))]
    [Tmux.View id0 (Just (PaneId 0))]
    []

renderOnce ::
  Member (Codec TmuxCommand TmuxRequest TmuxResponse !! CodecError) r =>
  Member (Codec (Panes Pane) TmuxRequest TmuxResponse !! CodecError) r =>
  Members [ScopedTmux TmuxRequest TmuxResponse, AtomicState Views, Stop RenderError, Embed IO] r =>
  ViewTree ->
  Sem r ()
renderOnce tree = do
  cwd <- embed getCurrentDir
  withTmuxApis @[TmuxCommand, Panes _] (render cwd id0 id1 tree)

runRender ::
  ∀ r .
  Member (Codec TmuxCommand TmuxRequest TmuxResponse !! CodecError) r =>
  Member (Codec (Panes Pane) TmuxRequest TmuxResponse !! CodecError) r =>
  Member (ScopedTmux TmuxRequest TmuxResponse) r =>
  Members [Stop RenderError, Stop TmuxError, ChronosTime, Embed IO] r =>
  ViewTree ->
  Sem r ([Tmux.View PaneId], [Pane])
runRender tree = do
  (Views _ _ viewsResult _) <- execState views (atomicStateToState (renderOnce tree))
  panesResult <- withTmux (resumeHoist TmuxError.codec (windowPanes 1))
  pure (sortOn viewIdent viewsResult, sortOn paneLeft panesResult)

renderTest ::
  ViewTree ->
  [Pane] ->
  UnitTest
renderTest tree target = do
  tmuxTest do
    (_, ps) <- restop @TmuxError @(Scoped _ _) (runRender tree)
    target === ps

treeImbalanced :: ViewTree
treeImbalanced =
  Tree (consLayout id0) [
    TreeLeaf (openPane id0 def),
    TreeLeaf (openPane id1 (ViewGeometry Nothing Nothing (Just 150) Nothing Nothing Nothing))
    ]
  where
    openPane i geo = Ui.View i (ViewState False) geo (Ui.Pane True False Nothing)

imbalancedTarget :: [Pane]
imbalancedTarget =
  [
    Pane { paneId = PaneId 1, paneWidth = 89, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    Pane { paneId = PaneId 2, paneWidth = 150, paneHeight = 60, paneTop = 0, paneLeft = 90 }
  ]

test_imbalanced :: UnitTest
test_imbalanced =
  renderTest treeImbalanced imbalancedTarget

treeNested :: ViewTree
treeNested =
  Tree (consLayoutVertical id0) [
    TreeNode $
      Tree (consLayout id1) [
        TreeLeaf (openPane id0 def),
        TreeNode $
          Tree (consLayoutVertical id2) [
            TreeLeaf (openPane id1 def),
            TreeLeaf (openPane id2 def)
            ]
        ]
    ]
  where
    openPane i geo =
      Ui.View i (ViewState False) geo (Ui.Pane True False Nothing)

nestedTarget :: [Pane]
nestedTarget =
  [
    Pane { paneId = PaneId 1, paneWidth = 120, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    Pane { paneId = PaneId 2, paneWidth = 119, paneHeight = 30, paneTop = 0, paneLeft = 121 },
    Pane { paneId = PaneId 3, paneWidth = 119, paneHeight = 29, paneTop = 31, paneLeft = 121 }
  ]

test_nested :: UnitTest
test_nested =
  renderTest treeNested nestedTarget

treeTwoLayouts :: ViewTree
treeTwoLayouts =
  Tree (consLayout id0) [
    TreeNode $
      Tree (consLayoutVertical id1) [
        TreeLeaf (openPane id0 def)
        ],
    TreeNode $
      Tree (consLayoutVertical id2) [
        TreeLeaf (openPane id1 def)
        ]
    ]
  where
    openPane i geo = Ui.View i (ViewState False) geo (Ui.Pane True False Nothing)

twoLayoutsTarget :: [Pane]
twoLayoutsTarget =
  [
    Pane { paneId = PaneId 1, paneWidth = 120, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    Pane { paneId = PaneId 2, paneWidth = 119, paneHeight = 60, paneTop = 0, paneLeft = 121 }
    ]

test_twoLayouts :: UnitTest
test_twoLayouts =
  renderTest treeTwoLayouts twoLayoutsTarget

treePosition :: ViewTree
treePosition =
  Tree (consLayout id0) [
    TreeLeaf (openPane id0 1 (Just 10)),
    TreeLeaf (openPane id1 4 (Just 20)),
    TreeLeaf (openPane id2 2 (Just 30)),
    TreeLeaf (openPane id3 3 Nothing)
    ]
  where
    openPane i pos size =
      Ui.View i (ViewState False) def { position = Just pos, fixedSize = size } (Ui.Pane True False Nothing)

positionTarget :: [Pane]
positionTarget =
  [
    Pane { paneId = PaneId 1, paneWidth = 10, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    Pane { paneId = PaneId 2, paneWidth = 30, paneHeight = 60, paneTop = 0, paneLeft = 11 },
    Pane { paneId = PaneId 3, paneWidth = 177, paneHeight = 60, paneTop = 0, paneLeft = 42 },
    Pane { paneId = PaneId 4, paneWidth = 20, paneHeight = 60, paneTop = 0, paneLeft = 220 }
    ]

test_position :: UnitTest
test_position =
  renderTest treePosition positionTarget

treeSuccessiveOpen :: ViewTree
treeSuccessiveOpen =
  Tree (consLayout id0) [
    TreeNode $ Tree (consLayoutVertical id1) [
      TreeLeaf (pane id0 True False)
      ],
    TreeNode $ Tree (consLayoutVertical id2) [
      TreeLeaf (pane id1 False True),
      TreeLeaf (pane id2 False False)
      ]
    ]
  where
    pane i open pin =
      Ui.View i (ViewState False) def (Ui.Pane open pin Nothing)

successiveOpenTarget :: [Pane]
successiveOpenTarget =
  [
    Pane { paneId = PaneId 1, paneWidth = 120, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    Pane { paneId = PaneId 2, paneWidth = 119, paneHeight = 30, paneTop = 0, paneLeft = 121 },
    Pane { paneId = PaneId 3, paneWidth = 119, paneHeight = 29, paneTop = 31, paneLeft = 121 }
    ]

togglePaneE ::
  Member (Error Text) r =>
  Ident ->
  ViewTree ->
  Sem r (ViewTree)
togglePaneE i t =
  fromEither (first show (toggleResultEither (togglePane i t)))

test_successiveOpen :: UnitTest
test_successiveOpen = do
  tmuxTest do
    restop @TmuxError @(ScopedTmux _ _) do
      evalState views $ atomicStateToState do
        renderOnce treeSuccessiveOpen
        tree1 <- togglePaneE id1 treeSuccessiveOpen
        renderOnce tree1
        tree2 <- togglePaneE id2 tree1
        renderOnce tree2
      panesResult <- withTmux @(Panes Pane) do
        resumeHoist @CodecError @(TmuxApi (Panes Pane)) TmuxError.codec (windowPanes 1)
      successiveOpenTarget === panesResult

test_render :: TestTree
test_render =
  testGroup "render" [
    integrationTest "imbalanced tree" test_imbalanced,
    integrationTest "nested panes" test_nested,
    integrationTest "two layouts" test_twoLayouts,
    integrationTest "fixed pane position" test_position,
    integrationTest "open multiple panes" test_successiveOpen
  ]