LensTest.hs

module Chiasma.Test.LensTest where

import Chiasma.Data.Ident (Ident(Str))
import Chiasma.Lens.Tree (leafByIdent, modifyLeafByIdent, treesAndSubs)
import Chiasma.Ui.Data.View (
  Pane(Pane),
  PaneView,
  Tree(Tree),
  TreeSub(TreeNode, TreeLeaf),
  View(View),
  ViewTree,
  ViewTreeSub,
  consLayout,
  consPane,
  )
import qualified Chiasma.Ui.Data.View as View (_ident, ident)
import Chiasma.Ui.Data.ViewState (ViewState(ViewState))
import Chiasma.Ui.ViewTree (togglePane)
import qualified Chiasma.Ui.ViewTree as ToggleResult (ToggleResult(..))
import Control.Lens (transformM)
import qualified Control.Lens as Lens (set)
import Hedgehog ((===))
import Test.Tasty (TestTree, testGroup)
import Chiasma.Test.Util (UnitTest, unitTest)

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

tree :: ViewTree
tree =
  Tree (consLayout id0) [subtree, TreeLeaf (consPane id2)]
  where
    subtree = st id2 subtree2
    subtree2 = st id3 subtree3
    subtree3 = st id4 (TreeLeaf openPane)
    openPane = View id1 (ViewState False) def (Pane True False Nothing)
    st i s =
      TreeNode $ Tree (consLayout i) [s]

test_modify :: UnitTest
test_modify = do
  let
    ident = Str "changed"
    modded = modifyLeafByIdent id1 (Lens.set View.ident ident) tree
  Nothing === leafByIdent ident tree
  Just ident === (View._ident <$> leafByIdent ident modded)

failOnPaneIdent :: Ident -> ViewTree -> Maybe ViewTree
failOnPaneIdent target t@(Tree _ sub) =
  t <$ traverse match sub
  where
    match (TreeLeaf (View i _ _ _)) = if target == i then Nothing else Just ()
    match _ = Just ()

test_monadicModify :: UnitTest
test_monadicModify = do
  Nothing === (transformM (failOnPaneIdent id2) tree)
  Just tree === (transformM (failOnPaneIdent id4) tree)

insertPane :: Ident -> PaneView -> ViewTree -> ViewTree
insertPane targetLayout pane (Tree l sub) =
  if View._ident l == targetLayout then Tree l (TreeLeaf pane : sub) else Tree l sub

ensurePaneUnique :: Ident -> ViewTreeSub -> Maybe ViewTreeSub
ensurePaneUnique paneIdent (TreeLeaf (View ident _ _ _)) | ident == paneIdent = Nothing
ensurePaneUnique _ n = Just n

subtreesTarget :: ViewTree
subtreesTarget =
  Tree (consLayout id0) [subtree, TreeLeaf (consPane id2)]
  where
    subtree = TreeNode $ Tree (consLayout id2) [TreeLeaf $ consPane id4, subtree2]
    subtree2 = TreeNode $ Tree (consLayout id3) [subtree3]
    subtree3 = TreeNode $ Tree (consLayout id4) [TreeLeaf openPane]
    openPane = View id1 (ViewState False) def (Pane True False Nothing)

test_subtrees :: UnitTest
test_subtrees =
  Just subtreesTarget === treesAndSubs (Just . insertPane id2 (consPane id4)) (ensurePaneUnique id4) tree

togglePaneTree :: ViewTree
togglePaneTree =
  Tree (consLayout id0) [TreeLeaf (consPane id0), TreeLeaf (consPane id0), TreeLeaf (consPane id2)]

test_togglePane :: UnitTest
test_togglePane = do
  ToggleResult.Ambiguous 2 === togglePane id0 togglePaneTree
  ToggleResult.NotFound === togglePane id1 togglePaneTree
  ToggleResult.Success (1 :: Int) === (1 <$ togglePane id2 togglePaneTree)

test_lenses :: TestTree
test_lenses =
  testGroup "lenses" [
    unitTest "modify leaves by ident" test_modify,
    unitTest "monadically transform leaves" test_monadicModify,
    unitTest "traverse all subtrees" test_subtrees,
    unitTest "toggle a pane" test_togglePane
  ]