RenderTest.hs

module Chiasma.Test.RenderTest where

import Chiasma.Codec.Data.PaneDetail (PaneDetail(..))
import Chiasma.Command.Pane (panesAs)
import Chiasma.Command.Session (activateSession)
import Chiasma.Data.Ident (Ident(Str))
import Chiasma.Data.TmuxError (TmuxError)
import Chiasma.Data.TmuxId (PaneId(PaneId), SessionId(SessionId), WindowId(WindowId))
import Chiasma.Data.View (viewIdent)
import qualified Chiasma.Data.View as Tmux (View(View))
import Chiasma.Data.Views (Views(Views))
import Chiasma.Monad.Stream (runTmux)
import Chiasma.Native.Api (TmuxNative(..))
import Chiasma.Render (render)
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)
import qualified Chiasma.Ui.ViewTree as ToggleResult (ToggleResult(Success))
import Hedgehog (evalEither, (===))
import Test.Tasty (TestTree, testGroup)
import UnliftIO (throwString)
import UnliftIO.Directory (getCurrentDirectory)

import Chiasma.Test.Tmux (sleep, tmuxSpec)
import Chiasma.Test.Util (UnitTest, integrationTest)

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 :: ViewTree -> TmuxNative -> FilePath -> Views -> IO Views
renderOnce tree api cwd vs = do
  r <- runExceptT $ runStateT (runTmux api $ render cwd id1 id1 tree) vs
  either (throwString . show) (return . snd) r

safeRender :: Views -> ViewTree -> TmuxNative -> IO Views
safeRender vs tree api = do
  cwd <- getCurrentDirectory
  vs1 <- renderOnce tree api cwd vs
  _ <- runExceptT @TmuxError $ runTmux api $ activateSession 0
  _ <- runExceptT @TmuxError $ runTmux api $ activateSession 1
  sleep 1
  renderOnce tree api cwd vs1

runRender :: ViewTree -> TmuxNative -> IO ([Tmux.View PaneId], Either TmuxError [PaneDetail])
runRender tree api = do
  (Views _ _ vs2 _) <- safeRender views tree api
  sleep 1
  ps <- runExceptT @TmuxError $ runTmux api panesAs
  return (sortOn viewIdent vs2, sortOn paneLeft . drop 1 <$> ps)

renderSpec :: ViewTree -> [PaneDetail] -> UnitTest
renderSpec tree target = do
  (_, pse) <- liftIO $ tmuxSpec $ runRender tree
  ps <- evalEither pse
  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 :: [PaneDetail]
imbalancedTarget =
  [
    PaneDetail { paneId = PaneId 1, paneWidth = 89, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    PaneDetail { paneId = PaneId 2, paneWidth = 150, paneHeight = 60, paneTop = 0, paneLeft = 90 }
    ]

test_imbalanced :: UnitTest
test_imbalanced =
  renderSpec 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 :: [PaneDetail]
nestedTarget =
  [
    PaneDetail { paneId = PaneId 1, paneWidth = 120, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    PaneDetail { paneId = PaneId 2, paneWidth = 119, paneHeight = 30, paneTop = 0, paneLeft = 121 },
    PaneDetail { paneId = PaneId 3, paneWidth = 119, paneHeight = 29, paneTop = 31, paneLeft = 121 }
  ]

test_nested :: UnitTest
test_nested =
  renderSpec 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 :: [PaneDetail]
twoLayoutsTarget =
  [
    PaneDetail { paneId = PaneId 1, paneWidth = 120, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    PaneDetail { paneId = PaneId 2, paneWidth = 119, paneHeight = 60, paneTop = 0, paneLeft = 121 }
    ]

test_twoLayouts :: UnitTest
test_twoLayouts =
  renderSpec 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 :: [PaneDetail]
positionTarget =
  [
    PaneDetail { paneId = PaneId 1, paneWidth = 10, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    PaneDetail { paneId = PaneId 2, paneWidth = 30, paneHeight = 60, paneTop = 0, paneLeft = 11 },
    PaneDetail { paneId = PaneId 3, paneWidth = 177, paneHeight = 60, paneTop = 0, paneLeft = 42 },
    PaneDetail { paneId = PaneId 4, paneWidth = 20, paneHeight = 60, paneTop = 0, paneLeft = 220 }
    ]

test_position :: UnitTest
test_position =
  renderSpec 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 :: [PaneDetail]
successiveOpenTarget =
  [
    PaneDetail { paneId = PaneId 1, paneWidth = 120, paneHeight = 60, paneTop = 0, paneLeft = 0 },
    PaneDetail { paneId = PaneId 2, paneWidth = 119, paneHeight = 30, paneTop = 0, paneLeft = 121 },
    PaneDetail { paneId = PaneId 3, paneWidth = 119, paneHeight = 29, paneTop = 31, paneLeft = 121 }
    ]

test_successiveOpen :: UnitTest
test_successiveOpen = do
  ps <- liftIO $ tmuxSpec \ api -> do
    vs1 <- safeRender views treeSuccessiveOpen api
    sleep 0.2
    vs2 <- safeRender vs1 tree1 api
    sleep 0.2
    _ <- safeRender vs2 tree2 api
    sleep 0.2
    runExceptT @TmuxError $ runTmux api panesAs
  ps1 <- evalEither (sortOn paneId . drop 1 <$> ps)
  successiveOpenTarget === ps1
  where
    (ToggleResult.Success tree2) = togglePane id2 tree1
    (ToggleResult.Success tree1) = togglePane id1 treeSuccessiveOpen

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
  ]