PinTest.hs

module Chiasma.Test.PinTest where

import Chiasma.Data.Ident (Ident(Str))
import Chiasma.Ui.Data.View (
  Pane(Pane),
  Tree(Tree),
  TreeSub(TreeNode, TreeLeaf),
  View(View),
  ViewTree,
  ViewTreeSub,
  consLayout,
  )
import Chiasma.Ui.ViewTree (toggleLayout, togglePane)
import qualified Chiasma.Ui.ViewTree as ToggleResult (ToggleResult(..))
import Hedgehog ((===))
import Test.Tasty (TestTree, testGroup)

import Chiasma.Test.Util (UnitTest, unitTest)

node :: ViewTreeSub -> View Pane -> ViewTreeSub
node sub p =
  TreeNode $ Tree (consLayout "l") [sub, TreeLeaf p]

paneWith :: Bool -> Text -> ViewTreeSub
paneWith open i = TreeLeaf $ View (Str i) def def (Pane open False Nothing)

pane :: Text -> ViewTreeSub
pane =
  paneWith False

ppaneWithIdent :: Text -> Bool -> View Pane
ppaneWithIdent name open =
  View (Str name) def def (Pane open True Nothing)

ppaneWith :: Bool -> View Pane
ppaneWith =
  ppaneWithIdent "pin"

ppane :: View Pane
ppane =
  ppaneWith False

subtree4 :: ViewTreeSub
subtree4 = node subtree5 ppane

subtree5 :: ViewTreeSub
subtree5 = node subtree6 ppane

subtree6 :: ViewTreeSub
subtree6 = TreeNode $ Tree (consLayout (Str "l")) [pane "p2"]

tree :: ViewTree
tree =
  Tree (consLayout (Str "root")) [subtree4, subtree1, subtree4]
  where
    subtree1 = node subtree2 ppane
    subtree2 = node subtree3 ppane
    subtree3 = TreeNode $ Tree (consLayout (Str "l1")) [pane "p1"]

target :: ViewTree
target =
  Tree (consLayout (Str "root")) [subtree4, subtree1, subtree4]
  where
    subtree1 = node subtree2 (ppaneWith True)
    subtree2 = node subtree3 (ppaneWith True)
    subtree3 = TreeNode $ Tree (consLayout (Str "l1")) [TreeLeaf $ View (Str "p1") def def (Pane True False Nothing)]

test_pinOpenNonpinned :: UnitTest
test_pinOpenNonpinned =
  ToggleResult.Success target === togglePane (Str "p1") tree

test_layoutPinOpenNonpinned :: UnitTest
test_layoutPinOpenNonpinned =
  ToggleResult.Success target === toggleLayout (Str "l1") tree

pinnedTree :: ViewTree
pinnedTree =
  Tree (consLayout (Str "root")) [pane "left", subtree]
  where
    subtree = TreeNode $ Tree (consLayout (Str "l1")) [pane "p2", TreeLeaf $ ppaneWithIdent "p1" False]

pinnedTarget :: ViewTree
pinnedTarget =
  Tree (consLayout (Str "root")) [pane "left", subtree]
  where
    subtree = TreeNode $ Tree (consLayout (Str "l1")) [paneWith False "p2", TreeLeaf $ ppaneWithIdent "p1" True]

test_pinOpenPinned :: UnitTest
test_pinOpenPinned =
  ToggleResult.Success pinnedTarget === toggleLayout (Str "l1") pinnedTree

test_pin :: TestTree
test_pin =
  testGroup "pin" [
    unitTest "open an unpinned pane" test_pinOpenNonpinned,
    unitTest "open an unpinned layout" test_layoutPinOpenNonpinned,
    unitTest "open a pinned pane" test_pinOpenPinned
  ]