packages feed

chiasma-test (empty) → 0.10.0.0

raw patch · 20 files changed

+1465/−0 lines, 20 filesdep +basedep +bytestringdep +chiasmasetup-changed

Dependencies added: base, bytestring, chiasma, chiasma-test, chronos, exon, hedgehog, lens, path, path-io, polysemy, polysemy-chronos, polysemy-conc, polysemy-log, polysemy-plugin, polysemy-process, polysemy-test, polysemy-time, prelate, tasty, tasty-hedgehog, text, typed-process

Files

+ LICENSE view
@@ -0,0 +1,34 @@+Copyright (c) 2022 Torsten Schmits++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met:++  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+  disclaimer.+  2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+  disclaimer in the documentation and/or other materials provided with the distribution.++Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:++  (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+  contributors, in source or binary form) alone; or+  (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+  copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+  be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.++Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise.++DISCLAIMER++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ chiasma-test.cabal view
@@ -0,0 +1,309 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.34.7.+--+-- see: https://github.com/sol/hpack++name:           chiasma-test+version:        0.10.0.0+synopsis:       A tmux client for Polysemy+description:    See https://hackage.haskell.org/package/chiasma-test/docs/Chiasma-Test.html+category:       Terminal+homepage:       https://github.com/tek/chiasma#readme+bug-reports:    https://github.com/tek/chiasma/issues+author:         Torsten Schmits+maintainer:     hackage@tryp.io+copyright:      2022 Torsten Schmits+license:        BSD-2-Clause-Patent+license-file:   LICENSE+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/tek/chiasma++library+  exposed-modules:+      Chiasma.Test.Data.TmuxTestConfig+      Chiasma.Test.Screenshot+      Chiasma.Test.Tmux+      Chiasma.Test.Wait+  hs-source-dirs:+      lib+  default-extensions:+      ImpredicativeTypes+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin+  build-depends:+      base >=4.12 && <5+    , bytestring+    , chiasma+    , chronos+    , exon+    , hedgehog+    , path+    , path-io+    , polysemy+    , polysemy-chronos+    , polysemy-conc+    , polysemy-log+    , polysemy-plugin+    , polysemy-process+    , polysemy-test >=0.6+    , polysemy-time+    , prelate >=0.2+    , text+    , typed-process >=0.2+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: Haskell2010++test-suite chiasma-test-integration+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Chiasma.Test.CaptureTest+      Chiasma.Test.FindTest+      Chiasma.Test.RenderTest+      Chiasma.Test.TmuxTest+      Chiasma.Test.Util+  hs-source-dirs:+      integration+  default-extensions:+      ImpredicativeTypes+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.12 && <5+    , chiasma+    , chiasma-test+    , hedgehog+    , lens >=4+    , path-io+    , polysemy+    , polysemy-chronos+    , polysemy-plugin+    , polysemy-test >=0.6+    , prelate >=0.2+    , tasty+    , tasty-hedgehog+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: Haskell2010++test-suite chiasma-test-unit+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Chiasma.Test.CodecTest+      Chiasma.Test.LensTest+      Chiasma.Test.OutputParseTest+      Chiasma.Test.PinTest+      Chiasma.Test.PureTest+      Chiasma.Test.Util+  hs-source-dirs:+      test+  default-extensions:+      ImpredicativeTypes+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.12 && <5+    , chiasma+    , hedgehog+    , lens >=4+    , polysemy+    , polysemy-plugin+    , polysemy-test >=0.6+    , prelate >=0.2+    , tasty+    , tasty-hedgehog+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: Haskell2010
+ integration/Chiasma/Test/CaptureTest.hs view
@@ -0,0 +1,20 @@+module Chiasma.Test.CaptureTest where++import Polysemy.Test (UnitTest, assertEq)++import Chiasma.Command.Pane (capturePane, sendKeys)+import Chiasma.Data.SendKeysParams (Key (Lit))+import qualified Chiasma.Data.TmuxError as TmuxError+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Effect.TmuxClient (ScopedTmux)+import Chiasma.Test.Tmux (tmuxTest)+import Chiasma.Test.Wait (assertWait)+import Chiasma.Tmux (withTmux)++test_capture :: UnitTest+test_capture =+  tmuxTest do+    restop @TmuxError @(ScopedTmux _ _) do+      withTmux $ resumeHoist TmuxError.codec do+        sendKeys 0 [Lit "echo 1"]+        assertWait (capturePane 0) (assertEq ["$ echo 1", "1", "$"])
+ integration/Chiasma/Test/FindTest.hs view
@@ -0,0 +1,33 @@+module Chiasma.Test.FindTest where++import Polysemy.Test (UnitTest, assert, (===))++import Chiasma.Codec (TmuxCodec)+import qualified Chiasma.Codec.Data.Pane as Pane+import Chiasma.Codec.Data.Window (windowId)+import Chiasma.Command.Window (splitWindow)+import Chiasma.Data.CodecError (CodecError)+import qualified Chiasma.Data.Panes as Panes+import Chiasma.Data.Panes (Panes)+import Chiasma.Data.TmuxCommand (TmuxCommand (NewWindow))+import qualified Chiasma.Effect.TmuxApi as TmuxApi+import Chiasma.Interpreter.Codec (interpretCodecPanes)+import Chiasma.Test.Tmux (tmuxTest)+import Chiasma.Tmux (withTmuxApis_)++data Pid =+  Pid { panePid :: Int }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (TmuxCodec)++test_find :: UnitTest+test_find = do+  tmuxTest $ interpretCodecPanes do+    (Pid pid, found) <- withTmuxApis_ @[TmuxCommand, Panes Pid] @CodecError do+      win <- TmuxApi.send (NewWindow def)+      pane <- splitWindow (windowId win)+      p1 <- TmuxApi.send (Panes.Get (Pane.paneId pane))+      p2 <- TmuxApi.send (Panes.Find 100)+      pure (p1, p2)+    assert (pid > 0)+    Nothing === found
+ integration/Chiasma/Test/RenderTest.hs view
@@ -0,0 +1,235 @@+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+  ]
+ integration/Chiasma/Test/TmuxTest.hs view
@@ -0,0 +1,49 @@+module Chiasma.Test.TmuxTest where++import Polysemy.Test (UnitTest, (===))++import Chiasma.Codec.Data.Pane (Pane (Pane))+import Chiasma.Codec.Data.Window (Window (Window))+import Chiasma.Data.CodecError (CodecError)+import qualified Chiasma.Data.PaneSelection as PaneSelection+import qualified Chiasma.Data.Target as Target+import Chiasma.Data.TmuxCommand (TmuxCommand (ListPanes, ListWindows, NewWindow))+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.TmuxId (PaneId (PaneId), WindowId (WindowId))+import Chiasma.Data.WindowParams (WindowParams (name))+import qualified Chiasma.Effect.TmuxApi as TmuxApi+import Chiasma.Effect.TmuxApi (Tmux)+import Chiasma.Effect.TmuxClient (NativeTmux)+import Chiasma.Test.Tmux (tmuxTest)+import Chiasma.Tmux (withTmux)++prog ::+  Sem (Tmux : r) ([Pane], [Pane], [Window])+prog = do+  panes1 <- TmuxApi.send (ListPanes (PaneSelection.InWindow (Target.Pane 0)))+  TmuxApi.send (NewWindow def)+  TmuxApi.send (NewWindow def { name = Just "second" })+  wins <- TmuxApi.send (ListWindows def)+  panes <- TmuxApi.send (ListPanes PaneSelection.All)+  pure (panes1, panes, wins)++p :: Int -> Pane+p i =+  Pane (PaneId i) 240 60 0 0++w :: Int -> Window+w i =+  Window (WindowId i) 240 60++test_tmux :: UnitTest+test_tmux = do+  tmuxTest do+    result <- restop @TmuxError @NativeTmux (withTmux (restop @CodecError @Tmux prog))+    ([p0], [p0, p1, p2], [w0, w1, w2]) === result+  where+    p0 = p 0+    p1 = p 1+    p2 = p 2+    w0 = w 0+    w1 = w 1+    w2 = w 2
+ integration/Chiasma/Test/Util.hs view
@@ -0,0 +1,18 @@+module Chiasma.Test.Util where++import Hedgehog (property, test, withTests)+import Polysemy.Test (UnitTest)+import qualified System.Environment as Environment+import Test.Tasty (TestName, TestTree)+import Test.Tasty.Hedgehog (testProperty)++checkEnv :: UnitTest -> UnitTest+checkEnv t =+  maybe unit (const t) =<< liftIO (Environment.lookupEnv "DISPLAY")++integrationTest ::+  TestName ->+  UnitTest ->+  TestTree+integrationTest desc =+  testProperty desc . withTests 1 . property . test . checkEnv
+ integration/Main.hs view
@@ -0,0 +1,21 @@+module Main where++import Chiasma.Test.CaptureTest (test_capture)+import Chiasma.Test.FindTest (test_find)+import Chiasma.Test.RenderTest (test_render)+import Chiasma.Test.TmuxTest (test_tmux)+import Chiasma.Test.Util (integrationTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+  testGroup "all" [+    integrationTest "basic tmux commands" test_tmux,+    integrationTest "find pane by ID" test_find,+    test_render,+    integrationTest "capture pane content" test_capture+  ]++main :: IO ()+main =+  defaultMain tests
+ lib/Chiasma/Test/Data/TmuxTestConfig.hs view
@@ -0,0 +1,20 @@+module Chiasma.Test.Data.TmuxTestConfig where++import Log (Severity (Info))+import qualified Polysemy.Process.Effect.Pty as Pty++data TmuxTestConfig =+  TmuxTestConfig {+    width :: Pty.Rows,+    height :: Pty.Cols,+    fontSize :: Int,+    gui :: Bool,+    conf :: [Text],+    logLevel :: Severity,+    waitForPrompt :: Bool+  }+  deriving stock (Eq, Show, Generic)++instance Default TmuxTestConfig where+  def =+    TmuxTestConfig 240 61 12 False mempty Info True
+ lib/Chiasma/Test/Screenshot.hs view
@@ -0,0 +1,77 @@+module Chiasma.Test.Screenshot where++import qualified Data.ByteString as ByteString (writeFile)+import qualified Data.Text as Text (lines, unlines)+import qualified Data.Text.Encoding as Text (encodeUtf8)+import Data.Text.IO (readFile)+import Path (Abs, Dir, File, Path, parent, parseRelFile, toFilePath, (</>))+import Path.IO (createDirIfMissing, doesFileExist)++import Chiasma.Command.Pane (capturePane)+import Chiasma.Data.TmuxId (PaneId (PaneId))+import Chiasma.Effect.TmuxApi (Tmux)++loadScreenshot :: MonadIO m => Path Abs File -> m (Maybe Text)+loadScreenshot path =+  ifM (doesFileExist path) (Just <$> liftIO (readFile (toFilePath path))) (pure Nothing)++storeScreenshot :: MonadIO m => Path Abs File -> [Text] -> m ()+storeScreenshot path text = do+  createDirIfMissing True (parent path)+  liftIO $ ByteString.writeFile (toFilePath path) (Text.encodeUtf8 (Text.unlines text))++takeScreenshot ::+  Member Tmux r =>+  (Text -> Text) ->+  Int ->+  Sem r [Text]+takeScreenshot sanitize =+  fmap (fmap sanitize) . capturePane . PaneId++recordScreenshot ::+  Members [Tmux, Embed IO] r =>+  (Text -> Text) ->+  Path Abs File ->+  Int ->+  Sem r ()+recordScreenshot sanitize path paneId = do+  current <- takeScreenshot sanitize paneId+  storeScreenshot path current++testScreenshot ::+  Members [Tmux, Embed IO] r =>+  (Text -> Text) ->+  Path Abs File ->+  Int ->+  Sem r (Maybe ([Text], [Text]))+testScreenshot sanitize path pane = do+  current <- takeScreenshot sanitize pane+  loadScreenshot path >>= check current+  where+    check current (Just existing) =+      pure $ Just (current, Text.lines existing)+    check current Nothing =+      Nothing <$ storeScreenshot path current++screenshotSanitized ::+  Members [Tmux, Error Text, Embed IO] r =>+  (Text -> Text) ->+  Bool ->+  Path Abs Dir ->+  Text ->+  Int ->+  Sem r (Maybe ([Text], [Text]))+screenshotSanitized sanitize record storage name paneId = do+  rel <- fromEither (first show (parseRelFile (toString name)))+  let path = storage </> rel+  if record then Nothing <$ recordScreenshot sanitize path paneId else testScreenshot sanitize path paneId++screenshot ::+  Members [Tmux, Error Text, Embed IO] r =>+  Bool ->+  Path Abs Dir ->+  Text ->+  Int ->+  Sem r (Maybe ([Text], [Text]))+screenshot =+  screenshotSanitized id
+ lib/Chiasma/Test/Tmux.hs view
@@ -0,0 +1,250 @@+module Chiasma.Test.Tmux where++import qualified Chronos+import Chronos (datetimeToTime)+import Exon (exon)+import Hedgehog (TestT)+import Hedgehog.Internal.Property (Failure)+import Path (Abs, Dir, File, Path, relfile, (</>))+import Path.IO (createTempDir, doesFileExist, getTempDir, removeDirRecur)+import Polysemy.Chronos (ChronosTime, interpretTimeChronos)+import qualified Polysemy.Conc as Race+import Polysemy.Conc (interpretRace)+import qualified Polysemy.Log as Log+import Polysemy.Log (Severity (Trace), interpretLogStdoutLevelConc)+import Polysemy.Process (interpretSystemProcessNativeOpaqueSingle, resolveExecutable)+import qualified Polysemy.Process.Effect.Pty as Pty+import Polysemy.Process.Effect.Pty (Pty, withPty)+import qualified Polysemy.Process.Effect.SystemProcess as SystemProcess+import Polysemy.Process.Effect.SystemProcess (SystemProcess)+import Polysemy.Process.Interpreter.Pty (interpretPty)+import qualified Polysemy.Test as Test+import Polysemy.Test (Hedgehog, Test, TestError (TestError), runTestAuto)+import qualified Polysemy.Time as Time+import Polysemy.Time (MilliSeconds (MilliSeconds), Seconds (Seconds), mkDatetime)+import System.Process.Typed (ProcessConfig, StreamSpec, proc, setStderr, setStdin, setStdout, useHandleClose)++import Chiasma.Codec.Data.Pane (Pane)+import Chiasma.Codec.Data.Session (Session (Session))+import Chiasma.Command.Pane (capturePane)+import Chiasma.Data.CodecError (CodecError)+import Chiasma.Data.Panes (Panes)+import Chiasma.Data.RenderError (RenderError)+import Chiasma.Data.TmuxCommand (TmuxCommand (KillServer, ListSessions))+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.TmuxNative (TmuxNative (..))+import Chiasma.Effect.Codec (Codec, NativeCodecE)+import qualified Chiasma.Effect.TmuxApi as TmuxApi+import Chiasma.Effect.TmuxClient (NativeTmux, TmuxClient)+import Chiasma.Interpreter.Codec (interpretCodecPanes, interpretCodecTmuxCommand)+import Chiasma.Interpreter.TmuxClient (interpretTmuxNative)+import Chiasma.Path (pathText)+import qualified Chiasma.Test.Data.TmuxTestConfig as TmuxTestConfig+import Chiasma.Test.Data.TmuxTestConfig (TmuxTestConfig (TmuxTestConfig))+import Chiasma.Tmux (withTmux)++xtermArgs :: Int -> Int -> Int -> [Text]+xtermArgs width height fontSize =+  ["-geometry", show width <> "x" <> show height, "-fn", "xft:monospace:size=" <> show fontSize, "-e", "tmux"]++bashrcContent :: [Text]+bashrcContent =+  [+    "PS1='$ '"+  ]++createTmuxConf ::+  Member Test r =>+  Path Abs File ->+  [Text] ->+  Sem r (Path Abs File)+createTmuxConf wait content = do+  bashrc <- Test.tempFile bashrcContent [relfile|bashrc|]+  Test.tempFile (defaultContent bashrc ++ content ++ initCommands) [relfile|tmux.conf|]+  where+    defaultContent rc =+      [[exon|set -g default-command '/usr/bin/env bash --noprofile --rcfile #{pathText rc}'|]]+    initCommands =+      [+        [exon|run-shell -b 'touch #{pathText wait}'|]+      ]++testTmuxProcessConfig ::+  Members [Pty, Test, Embed IO] r =>+  Path Abs File ->+  TmuxTestConfig ->+  Path Abs File ->+  Sem r (ProcessConfig () () ())+testTmuxProcessConfig wait (TmuxTestConfig {..}) socket = do+  confFile <- createTmuxConf wait conf+  Pty.resize width height+  handle <- Pty.handle+  let+    tmuxArgs =+      ["-S", pathText socket, "-f", pathText confFile]+    prc =+      if gui+      then proc "xterm" (toString <$> xtermArgs (fromIntegral width) (fromIntegral height) fontSize ++ tmuxArgs)+      else proc "tmux" (toString <$> tmuxArgs)+  pure (stdio (useHandleClose handle) prc)+  where+    stdio (s :: ∀ st . StreamSpec st ()) =+      setStdin s . setStdout s . setStderr s++waitForServer ::+  ∀ enc dec t d r .+  Members [Scoped_ (TmuxClient enc dec) !! TmuxError, Codec TmuxCommand enc dec !! CodecError, Time t d] r =>+  Sem r ()+waitForServer =+  Time.while (MilliSeconds 10) do+    resumeAs @CodecError @(Codec _ _ _) True $ resumeAs @TmuxError @(Scoped_ _) True $ withTmux do+      s <- [] <! TmuxApi.send ListSessions+      pure (s /= [Session 0 "0"])++waitForEmptyPrompt ::+  ∀ enc dec t d r .+  Members [Scoped_ (TmuxClient enc dec) !! TmuxError, Codec TmuxCommand enc dec !! CodecError, Time t d] r =>+  Sem r ()+waitForEmptyPrompt =+  Time.while (MilliSeconds 10) do+    resumeAs @CodecError @(Codec _ _ _) True $ resumeAs @TmuxError @(Scoped_ _) True $ withTmux do+      prompt <- [] <! capturePane 0+      pure (["$"] /= prompt)++waitForFile ::+  Members [Time t d, Embed IO] r =>+  Path Abs File ->+  Sem r ()+waitForFile file =+  Time.while (MilliSeconds 10) do+    not <$> doesFileExist file++runAndKillTmux ::+  ∀ err enc dec t d r a .+  Members [Scoped_ (TmuxClient enc dec) !! TmuxError, Codec TmuxCommand enc dec !! CodecError] r =>+  Members [SystemProcess !! err, Time t d, Log, Resource, Error Text, Race, Embed IO] r =>+  Bool ->+  Sem r a ->+  Sem r a+runAndKillTmux waitForPrompt thunk = do+  void (Race.timeout (throw "tmux didn't create sessions") (Seconds 3) waitForServer)+  when waitForPrompt do+    void (Race.timeout (throw "empty prompt did not appear in pane 0") (Seconds 3) waitForEmptyPrompt)+  result <- finally thunk do+    resumeWith @_ @(Scoped_ _) (withTmux (resume_ (TmuxApi.send KillServer))) (Log.error "failed to kill server")+    resume_ SystemProcess.kill+  result <$ resume_ (void SystemProcess.wait)++type TestTmuxEffects =+  [+    NativeTmux,+    NativeTmux !! TmuxError,+    NativeCodecE TmuxCommand,+    NativeCodecE (Panes Pane),+    Reader TmuxNative+  ]++withTestTmux ::+  Members [Test, Time t d, Log, Resource, Stop TmuxError, Error Text, Race, Async, Embed IO] r =>+  TmuxTestConfig ->+  Sem (TestTmuxEffects ++ r) a ->+  Path Abs Dir ->+  Sem r a+withTestTmux tConf@TmuxTestConfig {waitForPrompt} thunk tempDir = do+  let socket = tempDir </> [relfile|tmux_socket|]+  let wait = tempDir </> [relfile|wait|]+  exe <- fromEither =<< resolveExecutable [relfile|tmux|] Nothing+  interpretPty $ resumeHoistError @_ @(Scoped_ _) show $ withPty do+    pc <- testTmuxProcessConfig wait tConf socket+    interpretSystemProcessNativeOpaqueSingle pc $ runReader (TmuxNative exe (Just socket)) do+      void $ Race.timeout (throw "tmux didn't start") (Seconds 3) (waitForFile wait)+      interpretCodecPanes $ interpretCodecTmuxCommand $ interpretTmuxNative $ restop @TmuxError do+        runAndKillTmux waitForPrompt (insertAt @5 thunk)++withTempDir ::+  Members [Resource, Embed IO] r =>+  Path Abs Dir ->+  (Path Abs Dir -> Sem r a) ->+  Sem r a+withTempDir targetDir =+  bracket+    (createTempDir targetDir "chiasma-test")+    (tryAny . removeDirRecur)++withSystemTempDir ::+  Members [Resource, Embed IO] r =>+  (Path Abs Dir -> Sem r a) ->+  Sem r a+withSystemTempDir f = do+  targetDir <- getTempDir+  withTempDir targetDir f++type TestStack =+  TestTmuxEffects ++ [+    ChronosTime,+    Log,+    Stop CodecError,+    Error CodecError,+    Stop RenderError,+    Error RenderError,+    Stop TmuxError,+    Error TmuxError,+    Error Text,+    Race,+    Async,+    Test,+    Fail,+    Error TestError,+    Hedgehog IO,+    Error Failure,+    Embed IO,+    Resource,+    Final IO+  ]++testTime :: Chronos.Time+testTime =+  datetimeToTime (mkDatetime 2030 3 20 12 0 0)++runTmuxTest ::+  TmuxTestConfig ->+  Sem TestStack a ->+  TestT IO a+runTmuxTest conf thunk =+  runTestAuto $+  asyncToIOFinal $+  interpretRace $+  mapError TestError $+  mapError show $+  stopToError $+  mapError @RenderError @Text show $+  stopToError $+  mapError @CodecError @Text show $+  stopToError $+  interpretLogStdoutLevelConc (Just (TmuxTestConfig.logLevel conf)) $+  interpretTimeChronos do+    withSystemTempDir (withTestTmux conf thunk)++tmuxTest ::+  Sem TestStack a ->+  TestT IO a+tmuxTest =+  runTmuxTest def++tmuxTestTrace ::+  Sem TestStack a ->+  TestT IO a+tmuxTestTrace =+  runTmuxTest def { TmuxTestConfig.logLevel = Trace }++tmuxGuiTest ::+  Sem TestStack a ->+  TestT IO a+tmuxGuiTest =+  runTmuxTest def { TmuxTestConfig.gui = True }++tmuxGuiTestTrace ::+  Sem TestStack a ->+  TestT IO a+tmuxGuiTestTrace =+  runTmuxTest def { TmuxTestConfig.gui = True, TmuxTestConfig.logLevel = Trace  }
+ lib/Chiasma/Test/Wait.hs view
@@ -0,0 +1,46 @@+module Chiasma.Test.Wait where++import Hedgehog.Internal.Property (Failure, failWith, liftTest, mkTest)+import qualified Polysemy.Conc as Conc+import Polysemy.Conc (interpretAtomic)+import Polysemy.Test (Hedgehog, liftH)+import qualified Polysemy.Time as Time+import Polysemy.Time (MilliSeconds (MilliSeconds), Seconds (Seconds))++assertWaitFor ::+  Monad m =>+  HasCallStack =>+  Members [Hedgehog m, Time t d, Race, Error Failure, Embed IO] r =>+  TimeUnit t1 =>+  TimeUnit t2 =>+  t1 ->+  t2 ->+  Sem r a ->+  (a -> Sem r b) ->+  Sem r b+assertWaitFor timeout interval acquire test =+  withFrozenCallStack do+    interpretAtomic Nothing do+      Conc.timeout_ timeoutError timeout spin+  where+    spin = do+      a <- raise acquire+      catch (raise (test a)) \ e -> do+        atomicPut (Just e)+        Time.sleep interval+        spin+    timeoutError =+      atomicGet >>= liftH . \case+        Just e -> liftTest (mkTest (Left e, mempty))+        Nothing -> failWith Nothing "timed out before an assertion was made"++assertWait ::+  Monad m =>+  HasCallStack =>+  Members [Hedgehog m, Time t d, Race, Error Failure, Embed IO] r =>+  Sem r a ->+  (a -> Sem r b) ->+  Sem r b+assertWait acquire test =+  withFrozenCallStack do+    assertWaitFor (Seconds 3) (MilliSeconds 100) acquire test
+ test/Chiasma/Test/CodecTest.hs view
@@ -0,0 +1,25 @@+module Chiasma.Test.CodecTest where++import Hedgehog ((===))++import Chiasma.Codec (TmuxCodec (decode, query))+import Chiasma.Data.TmuxId (PaneId (..), WindowId (..))+import Chiasma.Data.TmuxQuery (TmuxQuery (TmuxQuery))+import Chiasma.Test.Util (UnitTest)++data Dat =+  Dat {+    paneId :: PaneId,+    windowId :: WindowId+  }+  deriving stock (Eq, Show, Generic)++instance TmuxCodec Dat++test_decode :: UnitTest+test_decode =+  Right (Dat (PaneId 1) (WindowId 2)) === decode " %1 @2 "++test_query :: UnitTest+test_query =+  TmuxQuery "#{pane_id} #{window_id}" === query @Dat
+ test/Chiasma/Test/LensTest.hs view
@@ -0,0 +1,102 @@+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+  ]
+ test/Chiasma/Test/OutputParseTest.hs view
@@ -0,0 +1,29 @@+module Chiasma.Test.OutputParseTest where++import Chiasma.Native.Parse (resultLines)+import qualified Data.Text as T (unlines)+import Hedgehog ((===))++import Chiasma.Test.Util (UnitTest)++paneLine :: Text+paneLine = "%0 100 100"++tmuxOutput :: Text+tmuxOutput = T.unlines [+  "%begin 123",+  "%end 123",+  "%session-changed $0 0",+  "%begin 234",+  paneLine,+  "b",+  "%end 234",+  "%begin 345",+  "c",+  "d",+  "%end 345"+  ]++test_outputParse :: UnitTest+test_outputParse =+  Right [[], [paneLine, "b"], ["c", "d"]] === resultLines tmuxOutput
+ test/Chiasma/Test/PinTest.hs view
@@ -0,0 +1,98 @@+module Chiasma.Test.PinTest where++import Hedgehog ((===))+import Test.Tasty (TestTree, testGroup)++import Chiasma.Data.Ident (Ident (Str))+import Chiasma.Test.Util (UnitTest, unitTest)+import Chiasma.Ui.Data.View (+  Pane (Pane),+  Tree (Tree),+  TreeSub (TreeLeaf, TreeNode),+  View (View),+  ViewTree,+  ViewTreeSub,+  consLayout,+  )+import Chiasma.Ui.ViewTree (toggleLayout, togglePane)+import qualified Chiasma.Ui.ViewTree as ToggleResult (ToggleResult (..))++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+  ]
+ test/Chiasma/Test/PureTest.hs view
@@ -0,0 +1,61 @@+module Chiasma.Test.PureTest where++import Conc (interpretAtomic)+import Polysemy.Test (TestError (TestError), UnitTest, runTestAuto, (===))++import Chiasma.Codec.Data.Pane (Pane (Pane))+import Chiasma.Codec.Data.Window (Window (Window))+import qualified Chiasma.Data.PaneSelection as PaneSelection+import qualified Chiasma.Data.Target as Target+import Chiasma.Data.TmuxCommand (TmuxCommand (ListPanes, ListWindows, NewWindow))+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.TmuxId (PaneId (PaneId), WindowId (WindowId))+import Chiasma.Data.WindowParams (WindowParams (name))+import qualified Chiasma.Effect.TmuxApi as TmuxApi+import Chiasma.Effect.TmuxApi (Tmux)+import Chiasma.Interpreter.Pure (interpretTmuxPure)+import Chiasma.Tmux (withTmux_)++prog ::+  Sem (Tmux : r) ([Pane], [Pane], [Window])+prog = do+  panes1 <- TmuxApi.send (ListPanes (PaneSelection.InWindow (Target.Pane 0)))+  TmuxApi.send (NewWindow def)+  TmuxApi.send (NewWindow def { name = Just "second" })+  wins <- TmuxApi.send (ListWindows def)+  panes <- TmuxApi.send (ListPanes PaneSelection.All)+  pure (panes1, panes, wins)++p :: Int -> Pane+p i =+  Pane (PaneId i) 240 60 0 0++w :: Int -> Window+w i =+  Window (WindowId i) 240 60++responses ::+  Member (AtomicState Int) r =>+  TmuxCommand a ->+  Sem r (Either Text a)+responses = \case+  ListPanes _ ->+    atomicState' \case+      0 -> (1, Right [Pane 0 240 60 0 0])+      i -> (i, Right [Pane 0 240 60 0 0, Pane 1 240 60 0 0, Pane 2 240 60 0 0])+  NewWindow _ -> pure (Right (Window 1 240 60))+  ListWindows _ -> pure (Right [Window 0 240 60, Window 1 240 60, Window 2 240 60])+  _ -> pure (Left "unexpected")++test_pureClient :: UnitTest+test_pureClient =+  runTestAuto $ interpretAtomic 0 $ interpretTmuxPure responses $ stopToErrorWith TestError $ mapStop @TmuxError show do+    result <- restop @_ @(Scoped _ _) (withTmux_ @TmuxCommand @Text prog)+    ([p0], [p0, p1, p2], [w0, w1, w2]) === result+  where+    p0 = p 0+    p1 = p 1+    p2 = p 2+    w0 = w 0+    w1 = w 1+    w2 = w 2
+ test/Chiasma/Test/Util.hs view
@@ -0,0 +1,14 @@+module Chiasma.Test.Util where++import Hedgehog (TestT, property, test, withTests)+import Test.Tasty (TestName, TestTree)+import Test.Tasty.Hedgehog (testProperty)++type UnitTest = TestT IO ()++unitTest ::+  TestName ->+  UnitTest ->+  TestTree+unitTest desc =+  testProperty desc . withTests 1 . property . test
+ test/Main.hs view
@@ -0,0 +1,22 @@+module Main where++import Chiasma.Test.CodecTest (test_decode, test_query)+import Chiasma.Test.LensTest (test_lenses)+import Chiasma.Test.OutputParseTest (test_outputParse)+import Chiasma.Test.PinTest (test_pin)+import Chiasma.Test.Util (unitTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+  testGroup "all" [+    unitTest "tmux-decode a value" test_decode,+    unitTest "tmux-encode a query" test_query,+    test_lenses,+    unitTest "parse tmux output" test_outputParse,+    test_pin+  ]++main :: IO ()+main =+  defaultMain tests