chiasma 0.1.0.0 → 0.2.0.0

raw patch · 91 files changed

+4271/−558 lines, 91 filesdep +aesondep +attoparsecdep +compositiondep −HTFdep −data-default-classdep ~basedep ~eitherdep ~freesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, attoparsec, composition, composition-extra, conduit, conduit-extra, containers, cornea, data-default, deepseq, exceptions, hedgehog, parsers, prettyprinter, prettyprinter-ansi-terminal, random, relude, stm-chans, stm-conduit, tasty, tasty-hedgehog, text, unliftio-core, uuid

Dependencies removed: HTF, data-default-class

Dependency ranges changed: base, either, free, lens, posix-pty, process, resourcet, split, typed-process, unliftio

API changes (from Hackage documentation)

Files

• LICENSE +28/−24
• README.md +0/−3
• Setup.hs +0/−2
• chiasma.cabal +374/−44
• integration/Chiasma/Test/IndividualProcessTest.hs +42/−0
• integration/Chiasma/Test/ProcessTest.hs +42/−0
• integration/Chiasma/Test/RenderTest.hs +216/−0
• integration/Chiasma/Test/TmuxStreamTest.hs +44/−0
• integration/Chiasma/Test/Util.hs +19/−0
• integration/Main.hs +21/−0
• lib/Chiasma/Api/Class.hs +15/−11
• lib/Chiasma/Codec.hs +20/−15
• lib/Chiasma/Codec/Data.hs +9/−0
• lib/Chiasma/Codec/Data/Pane.hs +16/−0
• lib/Chiasma/Codec/Data/PaneCoords.hs +17/−0
• lib/Chiasma/Codec/Data/PaneDetail.hs +18/−0
• lib/Chiasma/Codec/Data/PaneMode.hs +15/−0
• lib/Chiasma/Codec/Data/PanePid.hs +15/−0
• lib/Chiasma/Codec/Data/Session.hs +11/−0
• lib/Chiasma/Codec/Data/Window.hs +12/−0
• lib/Chiasma/Codec/Decode.hs +53/−25
• lib/Chiasma/Codec/Query.hs +18/−20
• lib/Chiasma/Command/Pane.hs +173/−0
• lib/Chiasma/Command/Session.hs +33/−0
• lib/Chiasma/Command/Window.hs +53/−0
• lib/Chiasma/Control/IO/Unsafe.hs +6/−0
• lib/Chiasma/Data/Cmd.hs +26/−0
• lib/Chiasma/Data/Conduit.hs +10/−0
• lib/Chiasma/Data/Ident.hs +59/−0
• lib/Chiasma/Data/List.hs +16/−0
• lib/Chiasma/Data/Maybe.hs +17/−0
• lib/Chiasma/Data/Pane.hs +0/−23
• lib/Chiasma/Data/RenderError.hs +17/−0
• lib/Chiasma/Data/TmuxError.hs +39/−0
• lib/Chiasma/Data/TmuxId.hs +64/−0
• lib/Chiasma/Data/TmuxThunk.hs +6/−43
• lib/Chiasma/Data/View.hs +21/−0
• lib/Chiasma/Data/Views.hs +37/−0
• lib/Chiasma/Data/Window.hs +0/−23
• lib/Chiasma/Data/WindowState.hs +18/−0
• lib/Chiasma/Lens/Tree.hs +127/−0
• lib/Chiasma/Lens/Where.hs +10/−0
• lib/Chiasma/Monad/Buffered.hs +0/−29
• lib/Chiasma/Monad/EvalFreeT.hs +50/−0
• lib/Chiasma/Monad/IndividualProcess.hs +40/−0
• lib/Chiasma/Monad/Simple.hs +0/−38
• lib/Chiasma/Monad/Stream.hs +80/−0
• lib/Chiasma/Monad/Tmux.hs +41/−13
• lib/Chiasma/Native/Api.hs +61/−9
• lib/Chiasma/Native/Parse.hs +18/−26
• lib/Chiasma/Native/Process.hs +37/−25
• lib/Chiasma/Native/StreamParse.hs +65/−0
• lib/Chiasma/Pack.hs +109/−0
• lib/Chiasma/Pane.hs +14/−0
• lib/Chiasma/Prelude.hs +71/−0
• lib/Chiasma/Render.hs +41/−0
• lib/Chiasma/Session.hs +49/−0
• lib/Chiasma/Test/File.hs +5/−6
• lib/Chiasma/Test/Screenshot.hs +67/−0
• lib/Chiasma/Test/Tmux.hs +83/−33
• lib/Chiasma/Ui/Data/Measure.hs +52/−0
• lib/Chiasma/Ui/Data/RenderableTree.hs +54/−0
• lib/Chiasma/Ui/Data/Tree.hs +45/−0
• lib/Chiasma/Ui/Data/TreeModError.hs +22/−0
• lib/Chiasma/Ui/Data/View.hs +151/−0
• lib/Chiasma/Ui/Data/ViewGeometry.hs +27/−0
• lib/Chiasma/Ui/Data/ViewState.hs +12/−0
• lib/Chiasma/Ui/Lens/Ident.hs +23/−0
• lib/Chiasma/Ui/Measure.hs +76/−0
• lib/Chiasma/Ui/Measure/Balance.hs +157/−0
• lib/Chiasma/Ui/Measure/Weights.hs +38/−0
• lib/Chiasma/Ui/Pane.hs +17/−0
• lib/Chiasma/Ui/ShowTree.hs +41/−0
• lib/Chiasma/Ui/ViewTree.hs +314/−0
• lib/Chiasma/View.hs +103/−0
• lib/Chiasma/View/State.hs +17/−0
• lib/Chiasma/Window.hs +225/−0
• lib/Prelude.hs +5/−0
• readme.md +3/−0
• test/Chiasma/Test/CodecTest.hs +24/−0
• test/Chiasma/Test/LensTest.hs +102/−0
• test/Chiasma/Test/OutputParseTest.hs +29/−0
• test/Chiasma/Test/PinTest.hs +98/−0
• test/Chiasma/Test/StreamParseTest.hs +30/−0
• test/Chiasma/Test/Util.hs +14/−0
• test/Main.hs +24/−0
• test/u/BufferedSpec.hs +0/−45
• test/u/CodecSpec.hs +0/−27
• test/u/OutputParseSpec.hs +0/−30
• test/u/SimpleSpec.hs +0/−32
• test/u/SpecMain.hs +0/−12

@@ -1,30 +1,34 @@-Copyright Torsten Schmits (c) 2018+Copyright (c) 2020 Torsten Schmits -All rights reserved.+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met: -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. -    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.+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: -    * 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.+  (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. -    * Neither the name of Torsten Schmits nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+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. -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-OWNER 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.+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.

@@ -1,3 +0,0 @@-# Intro--**chiasma** is a tmux api client for Haskell.

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,26 +1,24 @@-cabal-version: 1.12+cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 3809c3d5d4204b2ce3be054873e25b993f46159354efa61c45f34aa594ce9f29  name:           chiasma-version:        0.1.0.0+version:        0.2.0.0 synopsis:       tmux api-description:    Please see the README on GitHub at <https://github.com/tek/chiasma-hs>+description:    Please see the README on GitHub at <https://github.com/tek/chiasma> category:       Terminal homepage:       https://github.com/tek/chiasma-hs#readme bug-reports:    https://github.com/tek/chiasma-hs/issues author:         Torsten Schmits maintainer:     tek@tryp.io-copyright:      2019 Torsten Schmits-license:        MIT+copyright:      2021 Torsten Schmits+license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple extra-source-files:-    README.md+    readme.md  source-repository head   type: git@@ -30,77 +28,409 @@   exposed-modules:       Chiasma.Api.Class       Chiasma.Codec+      Chiasma.Codec.Data+      Chiasma.Codec.Data.Pane+      Chiasma.Codec.Data.PaneCoords+      Chiasma.Codec.Data.PaneDetail+      Chiasma.Codec.Data.PaneMode+      Chiasma.Codec.Data.PanePid+      Chiasma.Codec.Data.Session+      Chiasma.Codec.Data.Window       Chiasma.Codec.Decode       Chiasma.Codec.Query-      Chiasma.Data.Pane+      Chiasma.Command.Pane+      Chiasma.Command.Session+      Chiasma.Command.Window+      Chiasma.Control.IO.Unsafe+      Chiasma.Data.Cmd+      Chiasma.Data.Conduit+      Chiasma.Data.Ident+      Chiasma.Data.List+      Chiasma.Data.Maybe+      Chiasma.Data.RenderError+      Chiasma.Data.TmuxError+      Chiasma.Data.TmuxId       Chiasma.Data.TmuxThunk-      Chiasma.Data.Window-      Chiasma.Monad.Buffered-      Chiasma.Monad.Simple+      Chiasma.Data.View+      Chiasma.Data.Views+      Chiasma.Data.WindowState+      Chiasma.Lens.Tree+      Chiasma.Lens.Where+      Chiasma.Monad.EvalFreeT+      Chiasma.Monad.IndividualProcess+      Chiasma.Monad.Stream       Chiasma.Monad.Tmux       Chiasma.Native.Api       Chiasma.Native.Parse       Chiasma.Native.Process+      Chiasma.Native.StreamParse+      Chiasma.Pack+      Chiasma.Pane+      Chiasma.Prelude+      Chiasma.Render+      Chiasma.Session       Chiasma.Test.File+      Chiasma.Test.Screenshot       Chiasma.Test.Tmux+      Chiasma.Ui.Data.Measure+      Chiasma.Ui.Data.RenderableTree+      Chiasma.Ui.Data.Tree+      Chiasma.Ui.Data.TreeModError+      Chiasma.Ui.Data.View+      Chiasma.Ui.Data.ViewGeometry+      Chiasma.Ui.Data.ViewState+      Chiasma.Ui.Lens.Ident+      Chiasma.Ui.Measure+      Chiasma.Ui.Measure.Balance+      Chiasma.Ui.Measure.Weights+      Chiasma.Ui.Pane+      Chiasma.Ui.ShowTree+      Chiasma.Ui.ViewTree+      Chiasma.View+      Chiasma.View.State+      Chiasma.Window   other-modules:+      Prelude       Paths_chiasma+  autogen-modules:+      Paths_chiasma   hs-source-dirs:       lib-  default-extensions: ExistentialQuantification UnicodeSyntax TypeApplications ScopedTypeVariables DeriveGeneric DeriveAnyClass+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveTraversable+      DerivingStrategies+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedStrings+      OverloadedLists+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns   build-depends:-      base >=4.7 && <5+      aeson >=1.4 && <1.6+    , attoparsec ==0.13.*+    , base ==4.*     , bytestring-    , data-default-class+    , composition ==1.0.*+    , composition-extra ==2.0.*+    , conduit ==1.3.*+    , conduit-extra ==1.3.*+    , containers+    , cornea ==0.4.*+    , data-default ==0.7.*+    , deepseq     , directory-    , either+    , either >=5.0.1 && <5.1+    , exceptions     , filepath-    , free-    , lens+    , free ==5.1.*+    , lens ==4.*     , mtl     , parsec-    , posix-pty-    , process-    , resourcet-    , split+    , parsers ==0.12.*+    , posix-pty ==0.2.*+    , prettyprinter >=1.6 && <1.8+    , prettyprinter-ansi-terminal ==1.1.*+    , process ==1.6.*+    , random ==1.1.*+    , relude >=0.7 && <1.2+    , resourcet ==1.2.*+    , split ==0.2.*+    , stm-chans ==3.0.*+    , stm-conduit ==4.0.*+    , text     , transformers-    , typed-process+    , typed-process ==0.2.*     , unix-    , unliftio+    , unliftio ==0.2.*+    , unliftio-core >=0.1 && <0.3+    , uuid ==1.3.*+  mixins:+      base hiding (Prelude)   default-language: Haskell2010 +test-suite chiasma-integration+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Chiasma.Test.IndividualProcessTest+      Chiasma.Test.ProcessTest+      Chiasma.Test.RenderTest+      Chiasma.Test.TmuxStreamTest+      Chiasma.Test.Util+      Paths_chiasma+  hs-source-dirs:+      integration+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveTraversable+      DerivingStrategies+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedStrings+      OverloadedLists+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson >=1.4 && <1.6+    , attoparsec ==0.13.*+    , base ==4.*+    , bytestring+    , chiasma+    , composition ==1.0.*+    , composition-extra ==2.0.*+    , conduit ==1.3.*+    , conduit-extra ==1.3.*+    , containers+    , cornea ==0.4.*+    , data-default ==0.7.*+    , deepseq+    , directory+    , either >=5.0.1 && <5.1+    , exceptions+    , filepath+    , free ==5.1.*+    , hedgehog+    , lens ==4.*+    , mtl+    , parsec+    , parsers ==0.12.*+    , posix-pty ==0.2.*+    , prettyprinter >=1.6 && <1.8+    , prettyprinter-ansi-terminal ==1.1.*+    , process ==1.6.*+    , random ==1.1.*+    , relude >=0.7 && <1.2+    , resourcet ==1.2.*+    , split ==0.2.*+    , stm-chans ==3.0.*+    , stm-conduit ==4.0.*+    , tasty+    , tasty-hedgehog+    , text+    , transformers+    , typed-process ==0.2.*+    , unix+    , unliftio ==0.2.*+    , unliftio-core >=0.1 && <0.3+    , uuid ==1.3.*+  mixins:+      base hiding (Prelude)+    , chiasma (Chiasma.Prelude as Prelude)+    , chiasma hiding (Chiasma.Prelude)+  default-language: Haskell2010+ test-suite chiasma-unit   type: exitcode-stdio-1.0-  main-is: SpecMain.hs+  main-is: Main.hs   other-modules:-      BufferedSpec-      CodecSpec-      OutputParseSpec-      SimpleSpec+      Chiasma.Test.CodecTest+      Chiasma.Test.LensTest+      Chiasma.Test.OutputParseTest+      Chiasma.Test.PinTest+      Chiasma.Test.StreamParseTest+      Chiasma.Test.Util       Paths_chiasma   hs-source-dirs:-      test/u-  default-extensions: ExistentialQuantification UnicodeSyntax TypeApplications ScopedTypeVariables DeriveGeneric DeriveAnyClass+      test+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveTraversable+      DerivingStrategies+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedStrings+      OverloadedLists+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      HTF-    , base >=4.7 && <5+      aeson >=1.4 && <1.6+    , attoparsec ==0.13.*+    , base ==4.*     , bytestring     , chiasma-    , data-default-class+    , composition ==1.0.*+    , composition-extra ==2.0.*+    , conduit ==1.3.*+    , conduit-extra ==1.3.*+    , containers+    , cornea ==0.4.*+    , data-default ==0.7.*+    , deepseq     , directory-    , either+    , either >=5.0.1 && <5.1+    , exceptions     , filepath-    , free-    , lens+    , free ==5.1.*+    , hedgehog+    , lens ==4.*     , mtl     , parsec-    , posix-pty-    , process-    , resourcet-    , split+    , parsers ==0.12.*+    , posix-pty ==0.2.*+    , prettyprinter >=1.6 && <1.8+    , prettyprinter-ansi-terminal ==1.1.*+    , process ==1.6.*+    , random ==1.1.*+    , relude >=0.7 && <1.2+    , resourcet ==1.2.*+    , split ==0.2.*+    , stm-chans ==3.0.*+    , stm-conduit ==4.0.*+    , tasty+    , tasty-hedgehog+    , text     , transformers-    , typed-process+    , typed-process ==0.2.*     , unix-    , unliftio+    , unliftio ==0.2.*+    , unliftio-core >=0.1 && <0.3+    , uuid ==1.3.*+  mixins:+      base hiding (Prelude)+    , chiasma (Chiasma.Prelude as Prelude)+    , chiasma hiding (Chiasma.Prelude)   default-language: Haskell2010

@@ -0,0 +1,42 @@+module Chiasma.Test.IndividualProcessTest where++import Chiasma.Codec.Data (Pane(Pane), Window(Window))+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.TmuxId (PaneId(..), WindowId(..))+import Chiasma.Monad.IndividualProcess (TmuxProg, runTmux)+import qualified Chiasma.Monad.Tmux as Tmux (read, write)+import Chiasma.Native.Api (TmuxNative(..))+import Hedgehog ((===))++import Chiasma.Test.Tmux (tmuxSpec)+import Chiasma.Test.Util (UnitTest)++prog :: TmuxProg ([Pane], [Pane], [Window])+prog = do+  panes1 <- Tmux.read "list-panes" ["-t", "%0"]+  Tmux.write "new-window" []+  Tmux.write "new-window" []+  wins <- Tmux.read "list-windows" []+  panes <- Tmux.read "list-panes" ["-a"]+  return (panes1, panes, wins)++p :: Int -> Pane+p i = Pane (PaneId i) 240 60++w :: Int -> Window+w i = Window (WindowId i) 240 60++runProg :: TmuxNative -> IO (Either TmuxError ([Pane], [Pane], [Window]))+runProg api = runExceptT $ runTmux api prog++test_individual :: UnitTest+test_individual = do+  result :: Either TmuxError ([Pane], [Pane], [Window]) <- liftIO (tmuxSpec runProg)+  Right ([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

@@ -0,0 +1,42 @@+module Chiasma.Test.ProcessTest where++import Chiasma.Data.Conduit (createSinkFlush)+import Chiasma.Native.Api (TmuxNative(..))+import Chiasma.Native.Process (socketArg)+import Conduit (ConduitT, Flush(..), mapC, runConduit, sinkList, yieldMany, (.|))+import Data.ByteString.Internal (packChars)+import qualified Data.Conduit.Combinators as Conduit (concatMap, take)+import Data.Conduit.Process.Typed (+  Process,+  createSource,+  getStdin,+  getStdout,+  proc,+  setStdin,+  setStdout,+  withProcessTerm,+  )+import qualified Data.Text as Text (splitOn)+import Hedgehog (assert)++import Chiasma.Test.Tmux (tmuxSpec)+import Chiasma.Test.Util (UnitTest)++run :: Process (ConduitT (Flush ByteString) Void IO ()) (ConduitT () ByteString IO ()) () -> IO [Text]+run prc = do+  let stdin' = mapC (fmap packChars) .| getStdin prc+  let stdout' = getStdout prc+  runConduit $ yieldMany ([Chunk "list-panes\n"] :: [Flush String]) .| stdin'+  runConduit $ yieldMany ([Flush] :: [Flush String]) .| stdin'+  runConduit $ stdout' .| Conduit.take 2 .| mapC decodeUtf8 .| Conduit.concatMap (Text.splitOn "\n") .| sinkList++test_process :: UnitTest+test_process = do+  out <- liftIO $ tmuxSpec $ \(TmuxNative sock) -> do+    withProcessTerm (pc (args sock)) run+  assert (length out > 3)+    where+      pc =+        setStdin createSinkFlush . setStdout createSource . proc "tmux"+      args sock =+        toString <$> socketArg sock ++ ["-C", "attach"]

@@ -0,0 +1,216 @@+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+  ]

@@ -0,0 +1,44 @@+module Chiasma.Test.TmuxStreamTest where++import Chiasma.Codec.Data (Pane(Pane), Window(Window))+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.TmuxId (PaneId(..), WindowId(..))+import Chiasma.Data.TmuxThunk (TmuxThunk)+import Chiasma.Monad.Stream (runTmux)+import qualified Chiasma.Monad.Tmux as Tmux (read, write)+import Chiasma.Native.Api (TmuxNative(..))+import Control.Monad.Free.Class (MonadFree)+import Hedgehog ((===))++import Chiasma.Test.Tmux (tmuxSpec)+import Chiasma.Test.Util (UnitTest)++prog :: MonadFree TmuxThunk m => m ([Pane], [Pane], [Window])+prog = do+  panes1 <- Tmux.read "list-panes" ["-t", "%0"]+  Tmux.write "new-window" []+  Tmux.write "new-window" []+  wins <- Tmux.read "list-windows" []+  panes <- Tmux.read "list-panes" ["-a"]+  return (panes1, panes, wins)++p :: Int -> Pane+p i = Pane (PaneId i) 240 60++w :: Int -> Window+w i = Window (WindowId i) 240 60++runProg :: TmuxNative -> IO (Either TmuxError ([Pane], [Pane], [Window]))+runProg api = runExceptT @TmuxError $ runTmux api prog++test_streamed :: UnitTest+test_streamed = do+  result <- liftIO (tmuxSpec runProg)+  (Right ([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

@@ -0,0 +1,19 @@+module Chiasma.Test.Util where++import Hedgehog (TestT, withTests, property, test)+import Test.Tasty (TestName, TestTree)+import Test.Tasty.Hedgehog (testProperty)+import qualified System.Environment as Environment++type UnitTest = TestT IO ()++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

@@ -0,0 +1,21 @@+module Main where++import Chiasma.Test.IndividualProcessTest (test_individual)+import Chiasma.Test.ProcessTest (test_process)+import Chiasma.Test.RenderTest (test_render)+import Chiasma.Test.TmuxStreamTest (test_streamed)+import Chiasma.Test.Util (integrationTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+  testGroup "all" [+    integrationTest "use individual subprocesses for queries" test_individual,+    integrationTest "tmux control process" test_process,+    test_render,+    integrationTest "streamed tmux commands" test_streamed+  ]++main :: IO ()+main =+  defaultMain tests

@@ -1,15 +1,19 @@-module Chiasma.Api.Class(-  TmuxApi(..),-  DecodeTmuxResponse(..),-) where+module Chiasma.Api.Class where -import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.Except (ExceptT)+import Conduit (ConduitT, Flush)+ import Chiasma.Codec.Decode (TmuxDecodeError)-import Chiasma.Data.TmuxThunk (Cmds, TmuxError)+import Chiasma.Data.Cmd (Cmd, Cmds)+import Chiasma.Native.StreamParse (TmuxOutputBlock) -class TmuxApi a where-  runCommands :: MonadIO m => a -> ([String] -> Either TmuxDecodeError b) -> Cmds -> ExceptT TmuxError m [b]+class TmuxApi m a where+  runCommands ::+    a ->+    (Text -> Either TmuxDecodeError b) ->+    Cmds ->+    m [b] -class DecodeTmuxResponse a where-  decode :: String -> Either TmuxError a+  withTmux ::+    a ->+    (ConduitT (Flush Cmd) Void m () -> ConduitT () TmuxOutputBlock m () -> m b) ->+    m b

@@ -1,32 +1,37 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+module Chiasma.Codec where -module Chiasma.Codec(-  TmuxCodec(..),-  TmuxQuery(..),-) where+import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)+import qualified Data.Text as Text (drop, dropEnd, splitOn, take, takeEnd, unwords)+import GHC.Generics (Rep, to) -import GHC.Generics (Generic, Rep, to) import Chiasma.Codec.Decode (TmuxDataDecode(..), TmuxDecodeError(TooManyFields)) import Chiasma.Codec.Query (TmuxDataQuery(..))  newtype TmuxQuery =-  TmuxQuery { unQ :: String }+  TmuxQuery { unQ :: Text }   deriving (Eq, Show) -genDecode :: (Generic a, TmuxDataDecode (Rep a)) => [String] -> Either TmuxDecodeError a+genDecode :: (Generic a, TmuxDataDecode (Rep a)) => Text -> Either TmuxDecodeError a genDecode fields = do-  (rest, result) <- decode' fields+  (rest, result) <- decode' (Text.splitOn " " . trim $ fields)   case rest of     [] -> return $ to result     a -> Left $ TooManyFields a+  where+    trim text =+      if Text.take 1 text == " " && Text.takeEnd 1 text == " "+      then Text.drop 1 . Text.dropEnd 1 $ text+      else text  class TmuxCodec a where-    decode :: [String] -> Either TmuxDecodeError a-    default decode :: (Generic a, TmuxDataDecode (Rep a)) => [String] -> Either TmuxDecodeError a+    decode :: Text -> Either TmuxDecodeError a+    default decode :: (Generic a, TmuxDataDecode (Rep a)) => Text -> Either TmuxDecodeError a     decode = genDecode      query :: TmuxQuery-    default query :: (Generic a, TmuxDataQuery (Rep a)) => TmuxQuery-    query = TmuxQuery $ unwords $ query' @(Rep a)+    default query :: TmuxDataQuery (Rep a) => TmuxQuery+    query = TmuxQuery $ Text.unwords $ query' @(Rep a)++instance TmuxCodec SessionId+instance TmuxCodec WindowId+instance TmuxCodec PaneId

@@ -0,0 +1,9 @@+module Chiasma.Codec.Data(+  Session(..),+  Window(..),+  Pane(..),+) where++import Chiasma.Codec.Data.Pane (Pane(..))+import Chiasma.Codec.Data.Session (Session(..))+import Chiasma.Codec.Data.Window (Window(..))

@@ -0,0 +1,16 @@+module Chiasma.Codec.Data.Pane where++import Chiasma.Codec (TmuxCodec)+import Chiasma.Data.TmuxId (HasPaneId, PaneId)+import qualified Chiasma.Data.TmuxId as HasPaneId (HasPaneId(..))++data Pane =+  Pane {+    paneId :: PaneId,+    paneWidth :: Int,+    paneHeight :: Int+  }+  deriving (Eq, Show, Generic, TmuxCodec)++instance HasPaneId Pane where+  paneId = paneId

@@ -0,0 +1,17 @@+module Chiasma.Codec.Data.PaneCoords where++import Chiasma.Data.TmuxId (HasPaneId, PaneId, SessionId, WindowId)+import qualified Chiasma.Data.TmuxId as HasPaneId (HasPaneId(..))++import Chiasma.Codec (TmuxCodec)++data PaneCoords =+  PaneCoords {+    sessionId :: SessionId,+    windowId :: WindowId,+    paneId :: PaneId+  }+  deriving (Eq, Show, Generic, TmuxCodec)++instance HasPaneId PaneCoords where+  paneId = paneId

@@ -0,0 +1,18 @@+module Chiasma.Codec.Data.PaneDetail where++import Chiasma.Codec (TmuxCodec)+import Chiasma.Data.TmuxId (HasPaneId, PaneId)+import qualified Chiasma.Data.TmuxId as HasPaneId (HasPaneId(..))++data PaneDetail =+  PaneDetail {+    paneId :: PaneId,+    paneWidth :: Int,+    paneHeight :: Int,+    paneTop :: Int,+    paneLeft :: Int+  }+  deriving (Eq, Show, Generic, TmuxCodec)++instance HasPaneId PaneDetail where+  paneId = paneId

@@ -0,0 +1,15 @@+module Chiasma.Codec.Data.PaneMode where++import Chiasma.Codec (TmuxCodec)+import Chiasma.Data.TmuxId (HasPaneId, PaneId)+import qualified Chiasma.Data.TmuxId as HasPaneId (HasPaneId(paneId))++data PaneMode =+  PaneMode {+    paneId :: PaneId,+    paneMode :: Text+  }+  deriving (Eq, Show, Generic, TmuxCodec)++instance HasPaneId PaneMode where+  paneId = paneId

@@ -0,0 +1,15 @@+module Chiasma.Codec.Data.PanePid where++import Chiasma.Codec (TmuxCodec)+import Chiasma.Data.TmuxId (HasPaneId, PaneId)+import qualified Chiasma.Data.TmuxId as HasPaneId (HasPaneId(paneId))++data PanePid =+  PanePid {+    paneId :: PaneId,+    panePid :: Int+  }+  deriving (Eq, Show, Generic, TmuxCodec)++instance HasPaneId PanePid where+  paneId = paneId

@@ -0,0 +1,11 @@+module Chiasma.Codec.Data.Session where++import Chiasma.Codec (TmuxCodec)+import Chiasma.Data.TmuxId (SessionId)++-- must be data for now because of how derivation of `TmuxCodec` is implemented+data Session =+  Session {+    sessionId :: SessionId+  }+  deriving (Eq, Show, Generic, TmuxCodec)

@@ -0,0 +1,12 @@+module Chiasma.Codec.Data.Window where++import Chiasma.Codec (TmuxCodec)+import Chiasma.Data.TmuxId (WindowId)++data Window =+  Window {+    windowId :: WindowId,+    windowWidth :: Int,+    windowHeight :: Int+  }+  deriving (Eq, Show, Generic, TmuxCodec)

@@ -1,41 +1,38 @@-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} -module Chiasma.Codec.Decode(-  TmuxDecodeError(..),-  TmuxPrimDecode(..),-  TmuxDataDecode(..),-  idParser,-  parseId,-  readInt,-) where+module Chiasma.Codec.Decode where -import GHC.Generics ((:*:)(..), K1(..), M1(..))-import Data.Bifunctor (first, second)-import Text.Read (readEither)+import qualified Data.Text as Text (null, unpack)+import Data.Text.Read (decimal)+import GHC.Generics (K1(..), M1(..), (:*:)(..))+import Prelude hiding (many)+import Text.Parsec.Char (char, digit) import Text.ParserCombinators.Parsec (   GenParser,   ParseError,-  parse,   many,+  parse,   )-import Text.Parsec.Char (char, digit) +import Chiasma.Data.TmuxId (PaneId(..), SessionId(..), WindowId(..), panePrefix, sessionPrefix, windowPrefix)+ data TmuxDecodeError =-  ParseFailure String ParseError+  ParseFailure Text ParseError   |-  IntParsingFailure String+  IntParsingFailure Text   |+  BoolParsingFailure Text+  |   TooFewFields   |-  TooManyFields [String]+  TooManyFields [Text]   deriving (Eq, Show)  class TmuxPrimDecode a where-  primDecode :: String -> Either TmuxDecodeError a+  primDecode :: Text -> Either TmuxDecodeError a  class TmuxDataDecode f where-  decode' :: [String] -> Either TmuxDecodeError ([String], f a)+  decode' :: [Text] -> Either TmuxDecodeError ([Text], f a)  instance (TmuxDataDecode f, TmuxDataDecode g) => TmuxDataDecode (f :*: g) where   decode' fields = do@@ -53,18 +50,49 @@     return (as, K1 prim)   decode' [] = Left TooFewFields -readInt :: String -> String -> Either TmuxDecodeError Int+readInt :: Text -> Text -> Either TmuxDecodeError Int readInt input num =-  first (const $ IntParsingFailure input) $ readEither num+  first (const $ IntParsingFailure input) parsed+  where+    parsed = do+      (num', rest) <- decimal num+      if Text.null rest then Right num' else Left ""  instance TmuxPrimDecode Int where   primDecode field = readInt field field -idParser :: Char -> GenParser Char st String-idParser sym = char sym >> many digit+instance TmuxPrimDecode Bool where+  primDecode field =+    convert =<< readInt field field+    where+      convert 0 =+        Right False+      convert 1 =+        Right True+      convert _ =+        Left (BoolParsingFailure $ "got non-bool `" <> show field <> "`") -parseId :: (Int -> a) -> Char -> String -> Either TmuxDecodeError a+idParser :: Char -> GenParser Char st Text+idParser sym =+  char sym *> (toText <$> many digit)++parseId :: (Int -> a) -> Char -> Text -> Either TmuxDecodeError a parseId cons sym input = do-  num <- first (ParseFailure "id") $ parse (idParser sym) "none" input+  num <- first (ParseFailure "id") $ parse (idParser sym) "none" (Text.unpack input)   i <- readInt input num   return $ cons i++instance TmuxPrimDecode SessionId where+  primDecode = parseId SessionId sessionPrefix++instance TmuxPrimDecode WindowId where+  primDecode = parseId WindowId windowPrefix++instance TmuxPrimDecode PaneId where+  primDecode = parseId PaneId panePrefix++instance TmuxPrimDecode [Char] where+  primDecode = Right . toString++instance TmuxPrimDecode Text where+  primDecode = Right

@@ -1,20 +1,14 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeOperators #-} -module Chiasma.Codec.Query(-  TmuxDataQuery(..),-) where+module Chiasma.Codec.Query where -import GHC.Generics ((:*:), D1, C1, S1, Selector, selName)-import GHC.Unicode (isUpper, toLower)+import Data.Char (isUpper, toLower)+import qualified Data.Text as Text (concatMap, singleton)+import GHC.Generics (C1, D1, S1, Selector, selName, (:*:))  class TmuxDataQuery f where-  query' :: [String]--instance (TmuxDataQuery f, TmuxDataQuery g) => TmuxDataQuery (f :*: g) where-  query' = query' @f ++ query' @g+  query' :: [Text]  instance TmuxDataQuery f => (TmuxDataQuery (D1 c f)) where   query' = query' @f@@ -22,18 +16,22 @@ instance TmuxDataQuery f => (TmuxDataQuery (C1 c f)) where   query' = query' @f -trans :: Char -> String-trans a | isUpper a = ['_', toLower a]-trans a = [a]+instance (TmuxDataQuery f, TmuxDataQuery g) => TmuxDataQuery (f :*: g) where+  query' = query' @f <> query' @g -snakeCase :: String -> String-snakeCase = (>>= trans)+trans :: Char -> Text+trans a | isUpper a = toText @String ['_', toLower a]+trans a = Text.singleton a -formatQuery :: String -> String-formatQuery q = "#{" ++ snakeCase q ++ "}"+snakeCase :: Text -> Text+snakeCase =+  Text.concatMap trans +formatQuery :: Text -> Text+formatQuery q = "#{" <> snakeCase q <> "}"+ instance Selector s => (TmuxDataQuery (S1 s f)) where   query' =-    [formatQuery query]+    [formatQuery (toText query)]     where       query = selName (undefined :: t s f p)

@@ -0,0 +1,173 @@+module Chiasma.Command.Pane where++import Data.List (dropWhileEnd)+import qualified Data.Text as Text (intercalate, singleton, splitOn)++import Chiasma.Codec (TmuxCodec)+import qualified Chiasma.Codec.Data as Codec (Pane)+import qualified Chiasma.Codec.Data.PaneCoords as Codec (PaneCoords)+import qualified Chiasma.Codec.Data.PaneMode as Codec (PaneMode(PaneMode))+import qualified Chiasma.Codec.Data.PanePid as Codec (PanePid)+import Chiasma.Data.TmuxId (HasPaneId, PaneId, WindowId, formatId)+import qualified Chiasma.Data.TmuxId as HasPaneId (paneId)+import Chiasma.Data.TmuxThunk (TmuxThunk)+import Chiasma.Data.View (View(View))+import qualified Chiasma.Monad.Tmux as Tmux (read, readRaw, unsafeReadFirst, write)+import Control.Monad.Free.Class (MonadFree)++paneTarget :: PaneId -> [Text]+paneTarget paneId =+  ["-t", formatId paneId]++sameId :: HasPaneId a => PaneId -> a -> Bool+sameId target candidate = target == HasPaneId.paneId candidate++panesAs :: (MonadFree TmuxThunk m, TmuxCodec a) => m [a]+panesAs =+  Tmux.read "list-panes" ["-a"]++panes :: MonadFree TmuxThunk m => m [Codec.Pane]+panes =+  panesAs++pane :: (MonadFree TmuxThunk m, TmuxCodec a, HasPaneId a) => PaneId -> m (Maybe a)+pane paneId =+  find (sameId paneId) <$> Tmux.read "list-panes" ["-t", formatId paneId]++windowPanesAs :: (MonadFree TmuxThunk m, TmuxCodec a) => WindowId -> m [a]+windowPanesAs windowId =+  Tmux.read "list-panes" ["-t", formatId windowId]++windowPanes :: MonadFree TmuxThunk m => WindowId -> m [Codec.Pane]+windowPanes =+  windowPanesAs++firstWindowPane :: MonadFree TmuxThunk m => WindowId -> m Codec.Pane+firstWindowPane windowId =+  Tmux.unsafeReadFirst "list-panes" ["-t", formatId windowId]++closePane :: MonadFree TmuxThunk m => PaneId -> m ()+closePane paneId =+  Tmux.write "kill-pane" (paneTarget paneId)++isPaneIdOpen ::+  MonadFree TmuxThunk m =>+  PaneId ->+  m Bool+isPaneIdOpen paneId =+  any (sameId paneId) <$> panes++isPaneOpen ::+  MonadFree TmuxThunk m =>+  View PaneId ->+  m Bool+isPaneOpen (View _ (Just paneId)) =+  isPaneIdOpen paneId+isPaneOpen _ = return False++movePane ::+  MonadFree TmuxThunk m =>+  PaneId ->+  PaneId ->+  Bool ->+  m ()+movePane paneId refId vertical =+  Tmux.write "move-pane" ["-d", "-s", formatId paneId, "-t", formatId refId, direction]+  where+    direction = if vertical then "-v" else "-h"++resizePane ::+  MonadFree TmuxThunk m =>+  PaneId ->+  Bool ->+  Int ->+  m ()+resizePane paneId vertical size =+  Tmux.write "resize-pane" ["-t", formatId paneId, direction, show size]+  where+    direction = if vertical then "-y" else "-x"++formatLine :: Text -> [Text]+formatLine line =+  ["\"" <> replace "\"" "\\\"" line <> Text.singleton '"', "enter"]+  where+    replace from to =+      Text.intercalate to . Text.splitOn from++sendKeys ::+  MonadFree TmuxThunk m =>+  PaneId ->+  [Text] ->+  m ()+sendKeys paneId lines' =+  traverse_ send formatted+  where+    formatted = lines' >>= formatLine+    send line = Tmux.write "send-keys" (paneTarget paneId <> [line])++pipePane ::+  MonadFree TmuxThunk m =>+  PaneId ->+  Text ->+  m ()+pipePane paneId cmd =+  Tmux.write "pipe-pane" (paneTarget paneId <> [cmd])++capturePane ::+  MonadFree TmuxThunk m =>+  PaneId ->+  m [Text]+capturePane paneId = do+  lines' <- Tmux.readRaw "capture-pane" (paneTarget paneId <> ["-p", "-e"])+  return $ dropWhileEnd ("" ==) lines'++panePid ::+  MonadFree TmuxThunk m =>+  PaneId ->+  m (Maybe Codec.PanePid)+panePid =+  pane++panePids ::+  MonadFree TmuxThunk m =>+  m [Codec.PanePid]+panePids =+  panesAs++paneCoords ::+  MonadFree TmuxThunk m =>+  PaneId ->+  m (Maybe Codec.PaneCoords)+paneCoords =+  pane++selectPane ::+  MonadFree TmuxThunk m =>+  PaneId ->+  m ()+selectPane paneId =+  Tmux.write "select-pane" (paneTarget paneId)++copyMode ::+  MonadFree TmuxThunk m =>+  PaneId ->+  m ()+copyMode =+  Tmux.write "copy-mode" . paneTarget++paneMode ::+  MonadFree TmuxThunk m =>+  PaneId ->+  m (Maybe Codec.PaneMode)+paneMode =+  pane++quitCopyMode ::+  MonadFree TmuxThunk m =>+  PaneId ->+  m ()+quitCopyMode paneId =+  traverse_ check =<< pane paneId+  where+    check (Codec.PaneMode _ mode) =+      when (mode == "copy-mode") (sendKeys paneId ["C-c"])

@@ -0,0 +1,33 @@+module Chiasma.Command.Session where++import Control.Monad.Free.Class (MonadFree)++import Chiasma.Codec.Data (Session(Session))+import Chiasma.Data.Ident (Ident, identText)+import Chiasma.Data.TmuxId (SessionId)+import Chiasma.Data.TmuxThunk (TmuxThunk)+import qualified Chiasma.Monad.Tmux as Tmux (read, unsafeReadOne, write)++sameId :: SessionId -> Session -> Bool+sameId target (Session i) = target == i++sessions :: MonadFree TmuxThunk m => m [Session]+sessions =+  Tmux.read "list-sessions" []++doesSessionExist :: MonadFree TmuxThunk m => SessionId -> m Bool+doesSessionExist sessionId =+  any (sameId sessionId) <$> sessions++existingSessionId :: MonadFree TmuxThunk m => SessionId -> m (Maybe SessionId)+existingSessionId sessionId = do+  exists <- doesSessionExist sessionId+  return $ if exists then Just sessionId else Nothing++newSession :: MonadFree TmuxThunk m => Ident -> m Session+newSession name =+  Tmux.unsafeReadOne "new-session" ["-s", identText name, "-P"]++activateSession :: MonadFree TmuxThunk m => Int -> m ()+activateSession sessionId =+  Tmux.write "send-keys" ["-t", "%1", "'tmux switch-client -t \\$" <> show sessionId <> "'", "enter"]

@@ -0,0 +1,53 @@+module Chiasma.Command.Window where++import Control.Monad.Free.Class (MonadFree)++import Chiasma.Codec (TmuxCodec)+import Chiasma.Codec.Data (Pane, Window(Window))+import Chiasma.Data.Ident (Ident, identText)+import Chiasma.Data.TmuxId (SessionId, TmuxId(formatId), WindowId)+import Chiasma.Data.TmuxThunk (TmuxThunk)+import qualified Chiasma.Monad.Tmux as Tmux (read, unsafeReadFirst, unsafeReadOne)++sameId :: WindowId -> Window -> Bool+sameId target (Window i _ _) = target == i++windows :: MonadFree TmuxThunk m => m [Window]+windows =+  Tmux.read "list-windows" ["-a"]++window :: MonadFree TmuxThunk m => WindowId -> m (Maybe Window)+window windowId =+  find (sameId windowId) <$> windows++sessionWindows :: MonadFree TmuxThunk m => SessionId -> m [Window]+sessionWindows sid =+  Tmux.read "list-windows" ["-t", formatId sid]++newSessionWindow :: MonadFree TmuxThunk m => SessionId -> m Window+newSessionWindow sid =+  Tmux.unsafeReadOne "list-windows" ["-t", formatId sid]++doesWindowExist :: MonadFree TmuxThunk m => WindowId -> m Bool+doesWindowExist windowId =+  any (sameId windowId) <$> windows++newWindow :: MonadFree TmuxThunk m => SessionId -> Ident -> m Window+newWindow sid name =+  Tmux.unsafeReadOne "new-window" ["-t", formatId sid, "-n", identText name, "-P"]++splitWindowAs ::+  (MonadFree TmuxThunk m, TmuxCodec a) =>+  FilePath ->+  WindowId ->+  m a+splitWindowAs dir windowId =+  Tmux.unsafeReadFirst "split-window" ["-t", formatId windowId, "-d", "-P", "-c", toText dir]++splitWindow ::+  (MonadFree TmuxThunk m) =>+  FilePath ->+  WindowId ->+  m Pane+splitWindow =+  splitWindowAs

@@ -0,0 +1,6 @@+module Chiasma.Control.IO.Unsafe where++import GHC.IO.Unsafe (unsafePerformIO)++unsafeLog :: Show a => a -> b -> b+unsafeLog a b = unsafePerformIO $ print a >> return b

@@ -0,0 +1,26 @@+module Chiasma.Data.Cmd(+  CmdName(..),+  CmdArgs(..),+  Cmd(..),+  Cmds(..),+  cmd,+) where++newtype CmdName =+  CmdName Text+  deriving (Eq, Show)++newtype CmdArgs =+  CmdArgs [Text]+  deriving (Eq, Show)++data Cmd =+  Cmd CmdName CmdArgs+  deriving (Eq, Show)++newtype Cmds =+  Cmds [Cmd]+  deriving (Eq, Show)++cmd :: Text -> [Text] -> Cmd+cmd name args = Cmd (CmdName name) (CmdArgs args)

@@ -0,0 +1,10 @@+{-# LANGUAGE DataKinds #-}++module Chiasma.Data.Conduit where++import Conduit (ConduitT, Flush)+import Data.Conduit.Binary (sinkHandleFlush)+import Data.Conduit.Process.Typed (StreamSpec, StreamType(STInput), createPipe)++createSinkFlush :: MonadIO m => StreamSpec 'STInput (ConduitT (Flush ByteString) o m ())+createSinkFlush = sinkHandleFlush <$> createPipe

@@ -0,0 +1,59 @@+module Chiasma.Data.Ident where++import Data.Aeson (FromJSON, ToJSON(toEncoding), defaultOptions, genericToEncoding)+import Data.Data (Data)+import Data.Text.Prettyprint.Doc (Pretty(..))+import Data.UUID (UUID)+import qualified Data.UUID as UUID (fromText, toText)+import System.Random (randomIO)+import qualified Text.Show as Show++data Ident =+  Str Text+  |+  Uuid UUID+  deriving (Eq, Generic, Data, NFData, Ord)++instance Show Ident where+  show = toString . identText++class Identifiable a where+  identify :: a -> Ident++instance Identifiable Ident where+  identify = id++instance Pretty Ident where+  pretty (Str s) = pretty s+  pretty (Uuid u) = pretty . UUID.toText $ u++instance Default Ident where+  def = Str ""++instance IsString Ident where+  fromString = Str . toText++instance FromJSON Ident where++instance ToJSON Ident where+  toEncoding = genericToEncoding defaultOptions++sameIdent ::+  Identifiable a =>+  Identifiable b =>+  a ->+  b ->+  Bool+sameIdent target b =+  identify target == identify b++identText :: Ident -> Text+identText (Str a) = a+identText (Uuid a) = UUID.toText a++generateIdent :: MonadIO m => m Ident+generateIdent = liftIO $ Uuid <$> randomIO++parseIdent :: Text -> Ident+parseIdent text =+  maybe (Str text) Uuid (UUID.fromText text)

@@ -0,0 +1,16 @@+module Chiasma.Data.List(+  head',+  tail',+  last',+) where++head' :: [a] -> Maybe a+head' (a : _) = Just a+head' _ = Nothing++tail' :: [a] -> Maybe [a]+tail' (_ : as) = Just as+tail' _ = Nothing++last' :: [a] -> Maybe a+last' = head' . reverse

@@ -0,0 +1,17 @@+module Chiasma.Data.Maybe where++import Control.Monad.Error.Class (MonadError(throwError))++maybeExcept :: MonadError e m => e -> Maybe a -> m a+maybeExcept e Nothing = throwError e+maybeExcept _ (Just a) = return a++findMaybe :: (a -> Maybe b) -> [a] -> Maybe b+findMaybe f as =+  case mapMaybe f as of+    (a : _) -> Just a+    _ -> Nothing++orElse :: Maybe a -> Maybe a -> Maybe a+orElse _ (Just a) = Just a+orElse fallback Nothing = fallback

@@ -1,23 +0,0 @@-module Chiasma.Data.Pane(-  Pane(..),-  PaneId(..),-) where--import GHC.Generics (Generic)-import Chiasma.Codec (TmuxCodec)-import Chiasma.Codec.Decode (TmuxPrimDecode(..), parseId)--newtype PaneId =-  PaneId Int-  deriving (Eq, Show)--instance TmuxPrimDecode PaneId where-  primDecode = parseId PaneId '%'--data Pane =-  Pane {-    paneId :: PaneId,-    paneWidth :: Int,-    paneHeight :: Int-  }-  deriving (Eq, Show, Generic, TmuxCodec)

@@ -0,0 +1,17 @@+module Chiasma.Data.RenderError where++import Chiasma.Data.Ident (Ident)+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.Views (ViewsError)++data RenderError =+  NoPrincipal Ident+  |+  Views ViewsError+  |+  Pack Text+  |+  Fatal TmuxError+  deriving (Eq, Show)++deepPrisms ''RenderError

@@ -0,0 +1,39 @@+module Chiasma.Data.TmuxError where++import Chiasma.Codec.Decode (TmuxDecodeError)+import Text.ParserCombinators.Parsec (ParseError)++import Chiasma.Data.Cmd (Cmds(..))++data TmuxError =+  ProcessFailed {+    processFailedCmds :: Cmds,+    processFailedReason :: Text+    }+  |+  OutputParsingFailed {+    parsingFailedCmds :: Cmds,+    parsingFailedOutput :: [Text],+    parsingFailedError :: ParseError+  }+  |+  NoOutput Cmds+  |+  DecodingFailed {+    decodingFailedCmds :: Cmds,+    decodingFailedOutput :: Text,+    decodingFailedError :: TmuxDecodeError+  }+  |+  InvalidOutput {+    invalidOutputReason :: Text,+    invalidOutputCommand :: Text+  }+  |+  CommandFailed {+    commandFailedCmds :: Cmds,+    commandFailedError :: [Text]+  }+  deriving (Eq, Show)++deepPrisms ''TmuxError

@@ -0,0 +1,64 @@+module Chiasma.Data.TmuxId where++import Data.Text.Prettyprint.Doc (Pretty(..))++sessionPrefix :: Char+sessionPrefix = '$'++newtype SessionId =+  SessionId Int+  deriving (Eq, Show, Generic)+  deriving newtype (Num, Ord)++instance Pretty SessionId where+  pretty = pretty . formatId++windowPrefix :: Char+windowPrefix = '@'++newtype WindowId =+  WindowId Int+  deriving (Eq, Show, Generic)+  deriving newtype (Num, Ord)++instance Pretty WindowId where+  pretty = pretty . formatId++panePrefix :: Char+panePrefix = '%'++newtype PaneId =+  PaneId Int+  deriving (Eq, Show, Generic)+  deriving newtype (Num, Ord)++instance Pretty PaneId where+  pretty = pretty . formatId++class HasPaneId a where+  paneId :: a -> PaneId++newtype TmuxIdPrefix a =+  TmuxIdPrefix Char++class TmuxId a where+  prefix :: TmuxIdPrefix a+  number :: a -> Int++  formatId :: a -> Text+  formatId a =+    toText (p : show (number a))+    where+      (TmuxIdPrefix p) = prefix @a++instance TmuxId SessionId where+  prefix = TmuxIdPrefix sessionPrefix+  number (SessionId i) = i++instance TmuxId WindowId where+  prefix = TmuxIdPrefix windowPrefix+  number (WindowId i) = i++instance TmuxId PaneId where+  prefix = TmuxIdPrefix panePrefix+  number (PaneId i) = i

@@ -1,53 +1,16 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE StandaloneDeriving #-}--module Chiasma.Data.TmuxThunk(-  CmdName(..),-  CmdArgs(..),-  TmuxThunk(..),-  TmuxError(..),-  Cmd(..),-  Cmds(..),-  cmd,-) where+module Chiasma.Data.TmuxThunk where -import Text.ParserCombinators.Parsec (ParseError) import Chiasma.Codec.Decode (TmuxDecodeError)--newtype CmdName =-  CmdName String-  deriving (Eq, Show)--newtype CmdArgs =-  CmdArgs [String]-  deriving (Eq, Show)--data Cmd =-  Cmd CmdName CmdArgs-  deriving (Eq, Show)--newtype Cmds =-  Cmds [Cmd]-  deriving (Eq, Show)--data TmuxError =-  ProcessFailed Cmds String-  |-  OutputParsingFailed Cmds [String] ParseError-  |-  NoOutput Cmds-  |-  DecodingFailed Cmds String TmuxDecodeError-  deriving (Eq, Show)+import Chiasma.Data.Cmd (Cmd(..))+import Chiasma.Data.TmuxError (TmuxError(..))  data TmuxThunk next =-  ∀ a . Read Cmd ([String] -> Either TmuxDecodeError a) ([a] -> next)+  ∀ a . Read Cmd (Text -> Either TmuxDecodeError a) ([a] -> next)   |   Write Cmd (() -> next)   |+  Flush (() -> next)+  |   Failed TmuxError  deriving instance Functor TmuxThunk--cmd :: String -> [String] -> Cmd-cmd name args = Cmd (CmdName name) (CmdArgs args)

@@ -0,0 +1,21 @@+module Chiasma.Data.View where++import Chiasma.Data.Ident (Ident, Identifiable(..))+import Control.Lens (makeClassy_)+import qualified Control.Lens as Lens (set)++data View a =+  View {+    viewIdent :: Ident,+    viewId :: Maybe a+  }+  deriving (Eq, Show)++makeClassy_ ''View++instance Identifiable (View a) where+  identify = viewIdent++setViewId :: a -> View a -> View a+setViewId =+  Lens.set _viewId . Just

@@ -0,0 +1,37 @@+{-# LANGUAGE DeriveAnyClass #-}++module Chiasma.Data.Views where++import Data.Text.Prettyprint.Doc (Doc)+import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)++import Chiasma.Data.Ident (Ident)+import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)+import Chiasma.Data.View (View)++data ViewsError =+  NoSuchSession Ident+  |+  NoSuchWindow Ident+  |+  NoSuchPane Ident+  |+  NoPaneId Ident+  deriving (Eq, Show)++deepPrisms ''ViewsError++data Views =+  Views {+    _sessions :: [View SessionId],+    _windows :: [View WindowId],+    _panes :: [View PaneId],+    _log :: [Doc AnsiStyle]+  }+  deriving (Show, Generic, Default)++instance Eq Views where+  (Views sa wa pa _) == (Views sb wb pb _) =+    (sa == sb) && (wa == wb) && (pa == pb)++deepLenses ''Views

@@ -1,23 +0,0 @@-module Chiasma.Data.Window(-  Window(..),-  WindowId(..),-) where--import GHC.Generics (Generic)-import Chiasma.Codec (TmuxCodec)-import Chiasma.Codec.Decode (TmuxPrimDecode(..), parseId)--newtype WindowId =-  WindowId Int-  deriving (Eq, Show)--instance TmuxPrimDecode WindowId where-  primDecode = parseId WindowId '@'--data Window =-  Window {-    windowId :: WindowId,-    windowWidth :: Int,-    windowHeight :: Int-  }-  deriving (Eq, Show, Generic, TmuxCodec)

@@ -0,0 +1,18 @@+module Chiasma.Data.WindowState(+  WindowState(..),+) where++import qualified Chiasma.Codec.Data as Codec (Window, Pane)+import Chiasma.Data.Ident (Ident)+import Chiasma.Data.TmuxId (PaneId)+import Chiasma.Ui.Data.RenderableTree (RenderableTree)++data WindowState =+  WindowState {+    wsNativeWindow :: Codec.Window,+    wsNativeRefPane :: Codec.Pane,+    wsWindowIdent :: Ident,+    wsLayout :: RenderableTree,+    wsReferencePane :: PaneId+  }+  deriving (Eq, Show)

@@ -0,0 +1,127 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Chiasma.Lens.Tree where++import Chiasma.Data.Ident (Ident, Identifiable(..))+import Chiasma.Ui.Data.View+import Chiasma.Ui.Lens.Ident (matchIdentP)+import Control.Lens (+  Fold,+  Index,+  IxValue,+  Ixed(ix),+  Plated(..),+  Traversal',+  cosmos,+  each,+  makeClassy_,+  over,+  preview,+  toListOf,+  transform,+  )+import Data.Data (Data)+import Data.Foldable (foldrM)++newtype NodeIndexTree l p =+  NodeIndexTree {+    nitTree :: Tree l p+  }+  deriving (Eq, Show)++makeClassy_ ''NodeIndexTree++newtype LeafIndexTree l p =+  LeafIndexTree {+    litTree :: Tree l p+  }+  deriving (Eq, Show)++makeClassy_ ''LeafIndexTree++plateWrap :: (Data l, Data p) => (Tree l p -> t l p) -> (t l p -> Tree l p) -> Traversal' (t l p) (t l p)+plateWrap consWrapper unconsWrapper f wrappedTree =+  consWrapper <$> plate g (unconsWrapper wrappedTree)+  where+    g tree' = unconsWrapper <$> f (consWrapper tree')++instance (Data l, Data p) => Plated (NodeIndexTree l p) where+  plate = plateWrap NodeIndexTree nitTree++instance (Data l, Data p) => Plated (LeafIndexTree l p) where+  plate = plateWrap LeafIndexTree litTree++type LayoutIndexTree = NodeIndexTree LayoutView PaneView+type PaneIndexTree = LeafIndexTree LayoutView PaneView++type instance Index (NodeIndexTree _ _) = Ident+type instance Index (LeafIndexTree _ _) = Ident++type instance IxValue (NodeIndexTree l _) = l+type instance IxValue (LeafIndexTree _ p) = p++leafDataTraversal :: Traversal' (Tree l p) p+leafDataTraversal = _treeSubs . each . leafData++leafByIdentTraversal :: Identifiable p => Ident -> Traversal' (Tree l p) p+leafByIdentTraversal ident' = leafDataTraversal . matchIdentP ident'++instance Identifiable p => Ixed (LeafIndexTree l p) where+  ix ident' = _litTree . leafByIdentTraversal ident'++leavesByIdentRecursive :: (Identifiable p, Data l, Data p) => Ident -> Fold (LeafIndexTree l p) p+leavesByIdentRecursive ident' = cosmos . ix ident'++leafByIdent :: (Identifiable p, Data l, Data p) => Ident -> Tree l p -> Maybe p+leafByIdent ident' = preview (leavesByIdentRecursive ident') . LeafIndexTree++leavesByIdent :: (Identifiable p, Data l, Data p) => Ident -> Tree l p -> [p]+leavesByIdent ident' = toListOf (leavesByIdentRecursive ident') . LeafIndexTree++modifyLeafByIdent :: (Identifiable p, Data l, Data p) => Ident -> (p -> p) -> Tree l p -> Tree l p+modifyLeafByIdent ident' f tree' =+  litTree $ (transform $ over (ix ident') f) (LeafIndexTree tree')++-- subtreesWithLayout :: Traversal' (Tree l p) (l, TreeSub l p)+subtreesWithLayout :: ∀ l p m. Monad m => ((l, TreeSub l p) -> m (l, TreeSub l p)) -> Tree l p -> m (Tree l p)+subtreesWithLayout f (Tree l0 sub) = do+  (newL, newSub) <- foldrM applySub (l0, []) sub+  return (Tree newL newSub)+  where+    prependSub s (newL, newN) = (newL, newN : s)+    applySub :: TreeSub l p -> (l, [TreeSub l p]) -> m (l, [TreeSub l p])+    applySub (TreeNode t) (l, s) = do+      recur <- (\rsub -> (l, TreeNode rsub)) <$> subtreesWithLayout f t+      (fmap (prependSub s) . f) recur+    applySub p (l, s) =+      (fmap (prependSub s) . f) (l, p)++subtrees :: ∀ l p m. Monad m => (TreeSub l p -> m (TreeSub l p)) -> Tree l p -> m (Tree l p)+subtrees f (Tree l sub) = do+  newSub <- mapM applySub sub+  return (Tree l newSub)+  where+    applySub :: TreeSub l p -> m (TreeSub l p)+    applySub (TreeNode t) = do+      recur <- subtrees f t+      f (TreeNode recur)+    applySub p = f p++treesAndSubs ::+  Monad m =>+  (Tree l p -> m (Tree l p)) ->+  (TreeSub l p -> m (TreeSub l p)) ->+  Tree l p ->+  m (Tree l p)+treesAndSubs ft fs (Tree l sub) = do+  treeResult <- mapM applySub sub+  ft (Tree l treeResult)+  where+    applySub (TreeNode t) = do+      recur <- treesAndSubs ft fs t+      fs (TreeNode recur)+    applySub p = fs p

@@ -0,0 +1,10 @@+{-# LANGUAGE RankNTypes #-}++module Chiasma.Lens.Where(+  where1,+) where++import Control.Lens (Over, filtered, taking)++where1 :: (Applicative f, Traversable t) => (a -> Bool) -> Over (->) f (t a) (t a) a a+where1 predicate = taking 1 $ traverse . filtered predicate

@@ -1,29 +0,0 @@-module Chiasma.Monad.Buffered(-  runTmux,-) where--import Control.Monad.Free (Free(..))-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)-import Data.Default.Class (Default(def))-import Chiasma.Api.Class (TmuxApi(..))-import Chiasma.Data.TmuxThunk (Cmd(..), Cmds(..), TmuxThunk(..), TmuxError)-import Chiasma.Monad.Tmux (TmuxProg)--newtype TmuxState = TmuxState [Cmd]--instance Default TmuxState where-  def = TmuxState def--interpret :: (MonadIO m, TmuxApi api) => TmuxState -> api -> TmuxProg b -> ExceptT TmuxError m b-interpret (TmuxState cmds) api (Pure a) = a <$ runCommands api (const $ Right ()) (Cmds cmds)-interpret (TmuxState cmds) api (Free (Read cmd decode next)) = do-  a <- runCommands api decode $ Cmds (cmd : cmds)-  interpret def api (next a)-interpret (TmuxState cmds) api (Free (Write cmd next)) =-  interpret (TmuxState (cmd : cmds)) api (next ())-interpret _ _ (Free (Failed err)) =-  throwE err--runTmux :: (MonadIO m, TmuxApi api) => api -> TmuxProg b -> m (Either TmuxError b)-runTmux api prog = runExceptT $ interpret def api prog

@@ -0,0 +1,50 @@+module Chiasma.Monad.EvalFreeT where++import Control.Monad.Trans.Free (FreeF(..), FreeT(..))++import Chiasma.Codec.Decode (TmuxDecodeError)+import Chiasma.Data.Cmd (Cmd(..), Cmds(..))+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.TmuxThunk (TmuxThunk(..))++newtype CmdBuffer = CmdBuffer [Cmd]++instance Default CmdBuffer where+  def = CmdBuffer def++type CommandExec m =+  (∀ b. (Text -> Either TmuxDecodeError b) -> Cmds -> m (Either TmuxError [b]))++evalFreeF ::+  Monad m =>+  CommandExec m ->+  CmdBuffer ->+  FreeF TmuxThunk a (FreeT TmuxThunk m a) ->+  m (Either TmuxError a)+evalFreeF _ (CmdBuffer []) (Pure a) =+  return (Right a)+evalFreeF exec (CmdBuffer cmds) (Pure a) =+  Right a <$ exec (const $ Right ()) (Cmds cmds)+evalFreeF exec (CmdBuffer cmds) (Free (Read cmd decode next)) = do+  a <- exec decode $ Cmds (cmd : cmds)+  case a of+    Right a' -> evalFreeT exec def (next a')+    Left err -> return (Left err)+evalFreeF exec (CmdBuffer cmds) (Free (Write cmd next)) =+  evalFreeT exec (CmdBuffer (cmd : cmds)) (next ())+evalFreeF exec (CmdBuffer cmds) (Free (Flush next)) =+  exec (const $ Right ()) (Cmds cmds) >>= \case+    Right _ -> evalFreeT exec def (next ())+    Left err -> return (Left err)+evalFreeF _ _ (Free (Failed err)) =+  return (Left err)++evalFreeT ::+  Monad m =>+  CommandExec m ->+  CmdBuffer ->+  FreeT TmuxThunk m a ->+  m (Either TmuxError a)+evalFreeT exec s (FreeT ma) = do+  inner <- ma+  evalFreeF exec s inner

@@ -0,0 +1,40 @@+module Chiasma.Monad.IndividualProcess where++import Control.Monad.Free (Free(..))++import Chiasma.Api.Class (TmuxApi(..))+import Chiasma.Data.Cmd (Cmd(..), Cmds(..))+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.TmuxThunk (TmuxThunk(..))++type TmuxProg = Free TmuxThunk++newtype TmuxState = TmuxState [Cmd]++instance Default TmuxState where+  def = TmuxState def++interpret ::+  (TmuxApi m api, MonadDeepError e TmuxError m) =>+  TmuxState ->+  api ->+  TmuxProg a ->+  m a+interpret (TmuxState cmds) api (Pure a) = a <$ runCommands api (const $ Right ()) (Cmds cmds)+interpret (TmuxState cmds) api (Free (Read cmd decode next)) = do+  a <- runCommands api decode $ Cmds (cmd : cmds)+  interpret def api (next a)+interpret (TmuxState cmds) api (Free (Write cmd next)) =+  interpret (TmuxState (cmd : cmds)) api (next ())+interpret (TmuxState cmds) api (Free (Flush next)) = do+  _ <- runCommands api (const $ Right ()) (Cmds cmds)+  interpret def api (next ())+interpret _ _ (Free (Failed err)) =+  throwHoist err++runTmux ::+  (TmuxApi m api, MonadDeepError e TmuxError m) =>+  api ->+  TmuxProg a ->+  m a+runTmux = interpret def

@@ -1,38 +0,0 @@-module Chiasma.Monad.Simple(-  -- tmuxProcessConfig,-  -- tmuxProcess,-  -- interpret,-  -- runTmux,-) where---- import GHC.IO.Exception (ExitCode(ExitSuccess))--- import Control.Monad (when)--- import Control.Monad.Free (foldFree)--- import Control.Monad.IO.Class (MonadIO)--- import Control.Monad.Trans.Except (ExceptT(ExceptT), catchE, runExceptT)--- import qualified Data.ByteString.Lazy.Internal as B (unpackChars)--- import Data.Functor (void)--- import Data.List.Split (linesBy)--- import System.Process.Typed (ProcessConfig, readProcessStdout, proc)--- import UnliftIO (throwIO)--- import Chiasma.Data.TmuxThunk (Cmd(..), CmdName(..), CmdArgs(..), Cmds(..), TmuxThunk(..), TmuxError(..))--- import Chiasma.Monad.Tmux (TmuxProg)---- tmuxProcessConfig :: CmdName -> CmdArgs -> ProcessConfig () () ()--- tmuxProcessConfig (CmdName cmd) (CmdArgs args) =---   proc "tmux" (["-C", cmd] ++ args)---- tmuxProcess :: MonadIO m => Cmd -> m (Either TmuxError [String])--- tmuxProcess cmd@(Cmd name args) = do---   (code, out) <- readProcessStdout $ tmuxProcessConfig name args---   let outLines = linesBy (=='\n') $ B.unpackChars out---   return $ case code of---     ExitSuccess -> Right outLines---     _ -> Left $ TmuxProcessFailed (Cmds [cmd]) outLines---- interpret :: MonadIO m => TmuxThunk a next -> ExceptT TmuxError m next--- interpret (Read cmd next) = next <$> tmuxProcess cmd--- interpret (Write cmd next) = next <$> void (tmuxProcess cmd)---- runTmux :: MonadIO m => TmuxProg a next -> m (Either TmuxError next)--- runTmux = runExceptT . foldFree interpret

@@ -0,0 +1,80 @@+module Chiasma.Monad.Stream where++import Conduit (ConduitT, Flush(..), runConduit, sinkList, yield, yieldMany, (.|))+import Control.Monad.Trans.Free (FreeT(..))+import qualified Data.Conduit.Combinators as Conduit (drop, take)++import Chiasma.Api.Class (TmuxApi(..))+import Chiasma.Codec.Decode (TmuxDecodeError)+import Chiasma.Data.Cmd (Cmd(..), Cmds(..))+import Chiasma.Data.TmuxError (TmuxError)+import qualified Chiasma.Data.TmuxError as TmuxError (TmuxError(ProcessFailed, DecodingFailed, CommandFailed))+import Chiasma.Data.TmuxThunk (TmuxThunk)+import Chiasma.Monad.EvalFreeT (evalFreeT)+import Chiasma.Native.StreamParse (TmuxOutputBlock)+import qualified Chiasma.Native.StreamParse as TmuxOutputBlock (TmuxOutputBlock(..))++type TmuxProg = FreeT TmuxThunk++type WriteCmd m =+  ConduitT (Flush Cmd) Void m ()++type ReadOutput m =+  ConduitT () TmuxOutputBlock m ()++handleProcessOutput ::+  Cmds ->+  (Text -> Either TmuxDecodeError a) ->+  [TmuxOutputBlock] ->+  Either TmuxError [a]+handleProcessOutput cs@(Cmds cmds) _ output | length output < length cmds =+  Left $ TmuxError.ProcessFailed cs "tmux terminated before all commands were processed"+handleProcessOutput cmds decode output = do+  readOutput <- foldl validate (Right []) output+  traverse decode' readOutput+  where+    validate (Left err) _ = Left err+    validate _ (TmuxOutputBlock.Success a) = Right a+    validate _ (TmuxOutputBlock.Error a) = Left $ TmuxError.CommandFailed cmds a+    decode' outputLine =+      mapLeft (TmuxError.DecodingFailed cmds outputLine) . decode $ outputLine++executeCommands ::+  MonadIO m =>+  WriteCmd m ->+  ReadOutput m ->+  (Text -> Either TmuxDecodeError a) ->+  Cmds ->+  m (Either TmuxError [a])+executeCommands writeCmd readOutput decode cs@(Cmds cmds) = do+  output <- runConduit $ do+    yieldMany (Chunk <$> reverse cmds) .| writeCmd+    yield Flush .| writeCmd+    readOutput .| Conduit.take (length cmds) .| sinkList+  return $ handleProcessOutput cs decode output++runTmuxProg ::+  MonadIO m =>+  TmuxProg m a ->+  WriteCmd m ->+  ReadOutput m ->+  m (Either TmuxError a)+runTmuxProg prog writeCmd readOutput = do+  runConduit $ readOutput .| Conduit.drop 1+  evalFreeT (executeCommands writeCmd readOutput) def prog++runTmuxE ::+  (MonadIO m, TmuxApi m api) =>+  api ->+  TmuxProg m a ->+  m (Either TmuxError a)+runTmuxE api prog =+  withTmux api (runTmuxProg prog)++runTmux ::+  (MonadIO m, MonadDeepError e TmuxError m, TmuxApi m api) =>+  api ->+  TmuxProg m a ->+  m a+runTmux api =+  hoistEither <=< runTmuxE api

@@ -1,21 +1,49 @@-{-# LANGUAGE ScopedTypeVariables #-}+module Chiasma.Monad.Tmux where -module Chiasma.Monad.Tmux(-  Chiasma.Monad.Tmux.read,-  write,-  TmuxProg,-) where+import Control.Monad.Free (liftF)+import Control.Monad.Free.Class (MonadFree) -import Control.Monad.Free (Free, liftF) import Chiasma.Codec (TmuxCodec, TmuxQuery(unQ)) import qualified Chiasma.Codec as TmuxCodec (TmuxCodec(decode, query))-import Chiasma.Data.TmuxThunk (TmuxThunk(..), cmd)--type TmuxProg = Free TmuxThunk+import Chiasma.Data.Cmd (cmd)+import Chiasma.Data.TmuxError (TmuxError(InvalidOutput))+import Chiasma.Data.TmuxThunk (TmuxThunk(..)) -read :: ∀ a . TmuxCodec a => String -> [String] -> TmuxProg [a]+read :: ∀ a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m [a] read name args =-  liftF $ Read (cmd name (args ++ ["-F", "'" ++ unQ (TmuxCodec.query @a) ++ "'"])) TmuxCodec.decode id+  liftF $ Read (cmd name (args <> formatArgs)) TmuxCodec.decode id+  where+    formatArgs = ["-F", "'", unQ (TmuxCodec.query @a), "'"] -write :: String -> [String] -> TmuxProg ()+unsafeReadOne :: ∀ a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m a+unsafeReadOne name args = do+  outputs <- read name args+  case outputs of+    [a] -> return a+    [] -> liftF $ Failed $ InvalidOutput "no data" (name <> unwords args)+    _ -> liftF $ Failed $ InvalidOutput "multiple outputs for `unsafeReadOne`" (name <> unwords args)++readFirst :: ∀ a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m (Maybe a)+readFirst name args = do+  outputs <- read name args+  return $ case outputs of+    (a : _) -> Just a+    [] -> Nothing++unsafeReadFirst :: ∀ a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m a+unsafeReadFirst name args = do+  mayFirst <- readFirst name args+  case mayFirst of+    (Just a) -> return a+    Nothing -> liftF $ Failed $ InvalidOutput "no data" (name <> unwords args)++readRaw :: ∀ m . (MonadFree TmuxThunk m) => Text -> [Text] -> m [Text]+readRaw name args =+  liftF $ Read (cmd name args) Right id++write :: MonadFree TmuxThunk m => Text -> [Text] -> m () write name args = liftF $ Write (cmd name args) id++flush :: MonadFree TmuxThunk m => m ()+flush =+  liftF $ Flush id

@@ -1,15 +1,67 @@-module Chiasma.Native.Api(-  TmuxApi(..),-  TmuxNative(..),-) where+{-# LANGUAGE UndecidableInstances #-} -import Control.Monad.Trans.Except (ExceptT(ExceptT))+module Chiasma.Native.Api where++import Chiasma.Data.TmuxError (TmuxError)+import Conduit (ConduitT, Flush, mapC, (.|))+import Control.Monad.Catch (MonadMask)+import qualified Control.Monad.Catch as Catch (bracket)+import Data.Conduit.Process.Typed (createSource)+import qualified Data.Text as Text (unwords)+import System.Process.Typed (+  Process,+  ProcessConfig,+  getStdin,+  getStdout,+  proc,+  setStdin,+  setStdout,+  startProcess,+  stopProcess,+  ) import Text.ParserCombinators.Parsec ()+ import Chiasma.Api.Class (TmuxApi(..))-import Chiasma.Native.Process (nativeTmuxProcess)+import Chiasma.Data.Cmd (Cmd(..), CmdArgs(..), CmdName(..))+import Chiasma.Data.Conduit (createSinkFlush)+import Chiasma.Native.Process (nativeTmuxProcess, socketArg)+import Chiasma.Native.StreamParse (parseConduit)  newtype TmuxNative =-  TmuxNative FilePath+  TmuxNative { tmuxServerSocket :: Maybe FilePath }+  deriving Show -instance TmuxApi TmuxNative where-  runCommands (TmuxNative socket) decode cmds = ExceptT $ nativeTmuxProcess socket decode cmds+formatCmd :: Cmd -> ByteString+formatCmd (Cmd (CmdName name) (CmdArgs args)) =+  encodeUtf8 . Text.unwords $ name : args ++ ["\n"]++tmuxProcessConfig ::+  MonadIO m =>+  Maybe FilePath ->+  ProcessConfig (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) ()+tmuxProcessConfig sock =+  cons args+  where+    cons =+      setStdin createSinkFlush . setStdout createSource . proc "tmux"+    args =+      toString <$> (socketArg sock ++ ["-C", "attach"])++withProcess :: (MonadIO m, MonadMask m)+            => ProcessConfig stdin stdout stderr+            -> (Process stdin stdout stderr -> m a)+            -> m a+withProcess config = Catch.bracket (startProcess config) stopProcess++instance (MonadIO m, MonadDeepError e TmuxError m, MonadMask m) => TmuxApi m TmuxNative where+  runCommands (TmuxNative socket) =+    nativeTmuxProcess socket++  withTmux (TmuxNative socket) f =+    withProcess (tmuxProcessConfig socket) handler+    where+      handler prc =+        let+          stdin' = mapC (fmap formatCmd) .| getStdin prc+          stdout' = getStdout prc .| parseConduit+        in f stdin' stdout'

@@ -1,43 +1,35 @@-module Chiasma.Native.Parse(-  resultParser,-  resultLines,-) where+module Chiasma.Native.Parse where -import Text.ParserCombinators.Parsec (-  GenParser,+import qualified Data.Text as T (pack)+import Prelude hiding (many)+import Text.Parsec (   ParseError,-  parse,   many,-  skipMany,   manyTill,-  notFollowedBy,+  parse,+  skipMany,   try,   )-import Text.Parsec.Char (endOfLine, string, anyChar)+import Text.Parsec.Char (anyChar, endOfLine, string)+import Text.Parsec.Text (GenParser) -tillEol :: GenParser Char st String-tillEol = manyTill anyChar endOfLine+tillEol :: GenParser st Text+tillEol = T.pack <$> manyTill anyChar endOfLine -beginLine :: GenParser Char st String+beginLine :: GenParser st Text beginLine = string "%begin" >> tillEol -endLine :: GenParser Char st String+endLine :: GenParser st Text endLine = string "%end" >> tillEol -notBeginLine :: GenParser Char st String-notBeginLine = notFollowedBy (string "%begin") >> tillEol--parseBlock :: GenParser Char st [String]+parseBlock :: GenParser st [Text] parseBlock = do-  _ <- skipMany notBeginLine-  _ <- beginLine+  _ <- manyTill tillEol (try beginLine)   manyTill tillEol (try endLine) -resultParser :: GenParser Char st [[String]]-resultParser = do-  result <- many (try parseBlock)-  skipMany tillEol-  return result+resultParser :: GenParser st [[Text]]+resultParser =+  many (try parseBlock) <* skipMany tillEol -resultLines :: String -> Either ParseError [[String]]+resultLines :: Text -> Either ParseError [[Text]] resultLines = parse resultParser "tmux output"

@@ -1,45 +1,57 @@-module Chiasma.Native.Process(-  tmuxProcessConfig,-  nativeTmuxProcess,-) where+module Chiasma.Native.Process where -import GHC.IO.Exception (ExitCode(ExitSuccess))-import Control.Monad.IO.Class (MonadIO)-import Data.ByteString.Lazy (ByteString)-import Data.ByteString.Lazy.Internal (packChars, unpackChars)-import Data.Either.Combinators (mapLeft)-import Data.List (intercalate)-import System.Process.Typed (ProcessConfig, readProcessStdout, proc, setStdin, byteStringInput)+import qualified Data.ByteString.Lazy as Lazy (ByteString)+import Data.ByteString.Lazy.Internal (unpackChars)+import qualified Data.Text as Text (intercalate, lines, pack, unwords)+import System.Exit (ExitCode(ExitSuccess))+import System.Process.Typed (ProcessConfig, byteStringInput, proc, readProcessStdout, setStdin)+ import Chiasma.Codec.Decode (TmuxDecodeError)-import Chiasma.Data.TmuxThunk (CmdName(..), Cmd(..), CmdArgs(..), Cmds(..), TmuxError(..))-import qualified Chiasma.Data.TmuxThunk as TmuxError (-  TmuxError(OutputParsingFailed, NoOutput, ProcessFailed, DecodingFailed)+import Chiasma.Data.Cmd (Cmd(..), CmdArgs(..), CmdName(..), Cmds(..))+import Chiasma.Data.TmuxError (TmuxError)+import qualified Chiasma.Data.TmuxError as TmuxError (+  TmuxError(OutputParsingFailed, NoOutput, ProcessFailed, DecodingFailed),   ) import Chiasma.Native.Parse (resultLines) -cmdBytes :: [String] -> ByteString-cmdBytes cmds = packChars $ intercalate "\n" $ reverse $ "" : cmds+cmdBytes :: [Text] -> Lazy.ByteString+cmdBytes cmds = encodeUtf8 $ Text.intercalate "\n" $ reverse $ "" : cmds -tmuxProcessConfig :: FilePath -> [String] -> ProcessConfig () () ()+socketArg :: Maybe FilePath -> [Text]+socketArg (Just socket) = ["-S", toText socket]+socketArg Nothing = []++tmuxProcessConfig :: Maybe FilePath -> [Text] -> ProcessConfig () () () tmuxProcessConfig socket cmds =-  setStdin (byteStringInput $ cmdBytes cmds) $ proc "tmux" ["-S", socket, "-C", "attach"]+  cons args+  where+  cons =+    setStdin (byteStringInput $ cmdBytes cmds) . proc "tmux"+  args =+    toString <$> (socketArg socket <> ["-C", "attach"]) -handleProcessOutput :: Cmds -> ExitCode -> ([String] -> Either TmuxDecodeError a) -> String -> Either TmuxError [a]+handleProcessOutput :: Cmds -> ExitCode -> (Text -> Either TmuxDecodeError a) -> Text -> Either TmuxError [a] handleProcessOutput cmds ExitSuccess decode out = do-  outputs <- mapLeft (TmuxError.OutputParsingFailed cmds (lines out)) $ resultLines out+  outputs <- mapLeft (TmuxError.OutputParsingFailed cmds (Text.lines out)) $ resultLines out   case reverse outputs of     output : _ -> traverse decode' output     _ -> Left $ TmuxError.NoOutput cmds   where-    decode' = mapLeft (TmuxError.DecodingFailed cmds out) . decode . words+    decode' = mapLeft (TmuxError.DecodingFailed cmds out) . decode handleProcessOutput cmds _ _ out =   Left $ TmuxError.ProcessFailed cmds out -formatCmd :: Cmd -> String-formatCmd (Cmd (CmdName name) (CmdArgs args)) = unwords $ name : args+formatCmd :: Cmd -> Text+formatCmd (Cmd (CmdName name) (CmdArgs args)) =+  Text.unwords $ name : args -nativeTmuxProcess :: MonadIO m => FilePath -> ([String] -> Either TmuxDecodeError a) -> Cmds -> m (Either TmuxError [a])+nativeTmuxProcess ::+  (MonadIO m, MonadDeepError e TmuxError m) =>+  Maybe FilePath ->+  (Text -> Either TmuxDecodeError a) ->+  Cmds ->+  m [a] nativeTmuxProcess socket decode cmds@(Cmds cmds') = do   let cmdLines = fmap formatCmd cmds'   (code, out) <- readProcessStdout $ tmuxProcessConfig socket cmdLines-  return $ handleProcessOutput cmds code decode $ unpackChars out+  hoistEither $ handleProcessOutput cmds code decode $ Text.pack $ unpackChars out

@@ -0,0 +1,65 @@+module Chiasma.Native.StreamParse(+  parseConduit,+  parseBlocks,+  TmuxOutputBlock(..),+) where++import Conduit (ConduitT, mapC, (.|))+import Control.Monad.Catch (MonadThrow)+import Data.Attoparsec.ByteString (Parser)+import Data.Conduit.Attoparsec (conduitParser)+import qualified Data.Text as T (pack)+import Text.Parser.Char (CharParsing, anyChar, newline, string)+import Text.Parser.Combinators (choice, manyTill, notFollowedBy, skipMany, try)+import Text.Parser.LookAhead (LookAheadParsing, lookAhead)++data End =+  EndSuccess+  |+  EndError+  deriving (Eq, Show)++data TmuxOutputBlock =+  Success [Text]+  |+  Error [Text]+  deriving (Eq, Show)++tillEol :: (Alternative m, CharParsing m) => m Text+tillEol = T.pack <$> manyTill anyChar newline++beginLine :: (Alternative m, CharParsing m, Monad m) => m ()+beginLine = void $ string "%begin" >> tillEol++endLine :: (Alternative m, CharParsing m) => m End+endLine = do+  end <- choice [EndSuccess <$ string "%end", EndError <$ string "%error"]+  _ <- tillEol+  return end++notBeginLine :: (Alternative m, CharParsing m, Monad m) => m ()+notBeginLine = void $ notFollowedBy (string "%begin") >> tillEol++-- |Parse a sequence of lines between a %start and a %end line.+-- Tmux pads output lines with a single space on both sides, so strip those if the leading one is present.+parseBlock :: (Alternative m, CharParsing m, Monad m, LookAheadParsing m) => m TmuxOutputBlock+parseBlock = do+  _ <- skipMany notBeginLine+  _ <- beginLine+  dataLines <- manyTill tillEol $ try $ lookAhead endLine+  end <- endLine+  return $ case end of+    EndSuccess -> Success dataLines+    EndError -> Error dataLines++parseBlocks :: (Alternative m, CharParsing m, Monad m, LookAheadParsing m) => m [TmuxOutputBlock]+parseBlocks = do+  result <- many (try parseBlock)+  skipMany tillEol+  return result++parser :: Parser TmuxOutputBlock+parser = parseBlock++parseConduit :: MonadThrow m => ConduitT ByteString TmuxOutputBlock m ()+parseConduit = conduitParser parser .| mapC snd

@@ -0,0 +1,109 @@+module Chiasma.Pack where++import qualified Chiasma.Codec.Data as Codec (Window(Window))+import Chiasma.Command.Pane (movePane, resizePane)+import Chiasma.Data.TmuxId (PaneId)+import Chiasma.Data.TmuxThunk (TmuxThunk)+import Chiasma.Data.Views (Views)+import Chiasma.Data.WindowState (WindowState(..))+import Chiasma.Ui.Data.Measure (MLayout(..), MPane(..), MeasureTree, MeasureTreeSub, Measured(Measured))+import Chiasma.Ui.Data.Tree (Node(Sub, Leaf), Tree(Tree))+import qualified Chiasma.Ui.Data.Tree as Tree (subTree)+import Chiasma.Ui.Measure (measureTree)+import Chiasma.View (viewsLog)+import Control.Lens (each, mapMOf_)+import Control.Monad.Free.Class (MonadFree)+import qualified Data.List.NonEmpty as NonEmpty (reverse, toList)+import qualified Data.Set as Set (fromList, size)+import Data.Text.Prettyprint.Doc (Doc, line, pretty, (<+>))++packPane ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  PaneId ->+  Bool ->+  PaneId ->+  m ()+packPane refId vertical paneId =+  when (paneId /= refId) $ movePane paneId refId vertical++positionView ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  Bool ->+  PaneId ->+  MeasureTreeSub ->+  m ()+positionView vertical refId =+  position+  where+    position (Sub (Tree (Measured _ (MLayout layoutRef _ _ _)) _)) =+      packPane refId vertical layoutRef+    position (Leaf (Measured _ (MPane paneId _ _))) =+      packPane refId vertical paneId++describeVertical :: Bool -> Doc a+describeVertical True = "vertically"+describeVertical False = "horizontally"++resizeView ::+  MonadDeepState s Views m =>+  MonadFree TmuxThunk m =>+  Bool ->+  MeasureTreeSub ->+  m ()+resizeView vertical (Sub (Tree (Measured size (MLayout refId _ _ _)) _)) = do+  viewsLog $ "resizing layout with ref" <+> pretty refId <+> "to" <+> pretty size <+> describeVertical vertical+  resizePane refId vertical size+resizeView vertical (Leaf (Measured size (MPane paneId _ _))) = do+  viewsLog $ "resizing pane" <+> pretty paneId <+> "to" <+> pretty size <+> describeVertical vertical+  resizePane paneId vertical size++needPositioning ::+  NonEmpty MeasureTreeSub ->+  Bool+needPositioning sub =+  wrongOrder || wrongDirection || unaligned+  where+    wrongOrder =+      sort positions /= positions+    wrongDirection =+      Set.size (Set.fromList positions) /= length positions+    unaligned =+      length sub > 1 && Set.size (Set.fromList offPositions) > 1+    positions =+      NonEmpty.toList $ position <$> sub+    position (Sub (Tree (Measured _ (MLayout _ mainPos _ _)) _)) =+      mainPos+    position (Leaf (Measured _ (MPane _ mainPos _))) =+      mainPos+    offPositions =+      NonEmpty.toList $ offPosition <$> sub+    offPosition (Sub (Tree (Measured _ (MLayout _ _ offPos _)) _)) =+      offPos+    offPosition (Leaf (Measured _ (MPane _ _ offPos))) =+      offPos++packTree ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  MeasureTree ->+  m ()+packTree =+  pack+  where+    pack (Tree (Measured _ (MLayout ref _ _ vertical)) sub) = do+      when needPos runPos+      mapMOf_ (each . Tree.subTree) pack sub+      traverse_ (resizeView vertical) sub+      where+        needPos = needPositioning sub+        runPos = do+          viewsLog $ "repositioning views" <+> pretty sub+          traverse_ (positionView vertical ref) (NonEmpty.reverse sub)++packWindow ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  WindowState ->+  m ()+packWindow (WindowState (Codec.Window _ width height) _ _ tree _) = do+  let measures = measureTree tree width height+  viewsLog $ "measured tree:" <> line <> pretty measures+  packTree measures

@@ -0,0 +1,14 @@+module Chiasma.Pane where++import Chiasma.Data.Ident (Ident)+import Chiasma.Data.TmuxId (PaneId)+import qualified Chiasma.Data.View as Tmux (View(View))+import Chiasma.Data.Views (Views)+import qualified Chiasma.View as Views (insertPane)++addPane :: MonadDeepState s Views m => Ident -> m (Tmux.View PaneId)+addPane ident = do+  modify $ Views.insertPane pane+  return pane+  where+    pane = Tmux.View ident Nothing

@@ -0,0 +1,71 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Chiasma.Prelude (+  module Cornea,+  module Data.Default,+  module Data.Foldable,+  module Relude,+  dbg,+  dbgs,+  dbgm,+  makeClassy,+  mapLeft,+  tuple,+  undefined,+  unit,+  unsafeLogAnd,+  unsafeLogS,+  unsafeLogSAnd,+  (<$$>),+) where++import Control.Lens (makeClassy)+import Cornea+import Data.Default (Default(def))+import Data.Either.Combinators (mapLeft)+import Data.Foldable (foldl, traverse_)+import Data.Functor.Syntax ((<$$>))+import GHC.Err (undefined)+import GHC.IO.Unsafe (unsafePerformIO)+import Relude hiding (Type, ask, asks, get, gets, hoistEither, hoistMaybe, local, modify, put, state, undefined)++dbg :: Monad m => Text -> m ()+dbg msg = do+  () <- return $ unsafePerformIO (putStrLn (toString msg))+  return ()++dbgs :: Monad m => Show a => a -> m ()+dbgs =+  dbg . show++dbgm :: Monad m => Show a => m a -> m a+dbgm ma = do+  a <- ma+  dbgs a+  return a++unit ::+  Applicative f =>+  f ()+unit =+  pure ()++tuple ::+  Applicative f =>+  f a ->+  f b ->+  f (a, b)+tuple fa fb =+  (,) <$> fa <*> fb++unsafeLogSAnd :: Show a => a -> b -> b+unsafeLogSAnd a b =+  unsafePerformIO $ print a >> return b++unsafeLogAnd :: Text -> b -> b+unsafeLogAnd a b =+  unsafePerformIO $ putStrLn (toString a) >> return b++unsafeLogS :: Show a => a -> a+unsafeLogS a =+  unsafePerformIO $ print a >> return a

@@ -0,0 +1,41 @@+module Chiasma.Render where++import qualified Chiasma.Codec.Data as Codec (Window(Window))+import Chiasma.Data.Ident (Ident, identText)+import Chiasma.Data.RenderError (RenderError)+import Chiasma.Data.TmuxThunk (TmuxThunk)+import Chiasma.Data.Views (Views)+import Chiasma.Pack (packWindow)+import Chiasma.Session (ensureSession, findOrCreateSession)+import Chiasma.Ui.Data.RenderableTree (RenderableTree)+import Chiasma.Ui.Data.View (ViewTree)+import Chiasma.View (viewsLog)+import Chiasma.Window (ensureView, ensureWindow, findOrCreateWindow, windowState)+import Control.Monad.Error.Class (MonadError)+import Control.Monad.Free.Class (MonadFree)+import Data.Text.Prettyprint.Doc (line, pretty)++renderTree ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  Ident ->+  Codec.Window ->+  RenderableTree ->+  m ()+renderTree windowIdent window tree = do+  viewsLog $ pretty ("rendering tree in window " <> identText windowIdent <> ":") <> line <> pretty tree+  wState <- windowState windowIdent window tree+  packWindow wState++render ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m, MonadError RenderError m) =>+  FilePath ->+  Ident ->+  Ident ->+  ViewTree ->+  m ()+render cwd sessionIdent windowIdent tree = do+  initialSession <- findOrCreateSession sessionIdent+  initialWindow <- findOrCreateWindow windowIdent+  (sid, newSessionWid) <- ensureSession initialSession initialWindow+  window@(Codec.Window windowId _ _) <- ensureWindow sid initialWindow newSessionWid tree+  traverse_ (renderTree windowIdent window) =<< ensureView cwd windowId tree

@@ -0,0 +1,49 @@+{-# LANGUAGE FlexibleContexts #-}++module Chiasma.Session where++import Control.Monad.Free.Class (MonadFree)++import qualified Chiasma.Codec.Data as Codec (Session(Session), Window(Window))+import Chiasma.Command.Session (existingSessionId, newSession)+import Chiasma.Command.Window (newSessionWindow)+import Chiasma.Data.Ident (Ident)+import Chiasma.Data.TmuxId (SessionId, WindowId)+import Chiasma.Data.TmuxThunk (TmuxThunk)+import qualified Chiasma.Data.View as Tmux (View(viewId, viewIdent), setViewId)+import Chiasma.Data.Views (Views)+import Chiasma.View (findOrCreateView, viewsLogS)+import qualified Chiasma.View as Views (insertSession, session, updateSession, updateWindow)++findOrCreateSession ::+  MonadDeepState s Views m =>+  Ident ->+  m (Tmux.View SessionId)+findOrCreateSession =+  findOrCreateView Views.session Views.insertSession++spawnSession ::+  MonadDeepState s Views m =>+  MonadFree TmuxThunk m =>+  Tmux.View SessionId ->+  Tmux.View WindowId ->+  m (SessionId, WindowId)+spawnSession session' window = do+  Codec.Session sid <- newSession (Tmux.viewIdent session')+  modify $ Views.updateSession $ Tmux.setViewId sid session'+  Codec.Window wid _ _ <- newSessionWindow sid+  modify $ Views.updateWindow $ Tmux.setViewId wid window+  viewsLogS $ "spawned session " <> show session' <> " with id " <> show sid <> " and window id " <> show wid+  return (sid, wid)++ensureSession ::+  MonadDeepState s Views m =>+  MonadFree TmuxThunk m =>+  Tmux.View SessionId ->+  Tmux.View WindowId ->+  m (SessionId, Maybe WindowId)+ensureSession session' window = do+  existing <- join <$> traverse existingSessionId (Tmux.viewId session')+  case existing of+    Just sid -> return (sid, Nothing)+    Nothing -> second Just <$> spawnSession session' window

@@ -4,15 +4,14 @@   fixture, ) where -import Control.Monad.IO.Class (liftIO, MonadIO) import System.Directory (canonicalizePath, createDirectoryIfMissing, removePathForcibly) import System.FilePath ((</>)) -testDir :: String -> IO FilePath-testDir prefix = canonicalizePath $ "test" </> prefix+testDir :: Text -> IO FilePath+testDir prefix = canonicalizePath $ "test" </> toString prefix  -- raises exception if cwd is not the package root so we don't damage anything-tempDirIO :: String -> FilePath -> IO FilePath+tempDirIO :: Text -> FilePath -> IO FilePath tempDirIO prefix path = do   base <- testDir prefix   let dir = base </> "temp"@@ -22,11 +21,11 @@   createDirectoryIfMissing True absPath   return absPath -tempDir :: MonadIO m => String -> FilePath -> m FilePath+tempDir :: MonadIO m => Text -> FilePath -> m FilePath tempDir prefix path =   liftIO $ tempDirIO prefix path -fixture :: MonadIO m => String -> FilePath -> m FilePath+fixture :: MonadIO m => Text -> FilePath -> m FilePath fixture prefix path = do   base <- liftIO $ testDir prefix   return $ base </> "fixtures" </> path

@@ -0,0 +1,67 @@+module Chiasma.Test.Screenshot where++import Control.Monad.Free.Class (MonadFree)+import qualified Data.ByteString as ByteString (writeFile)+import qualified Data.Text as Text (lines, unlines)+import qualified Data.Text.Encoding as Text (encodeUtf8)+import System.FilePath (takeDirectory, (</>))+import UnliftIO.Directory (createDirectoryIfMissing, doesFileExist)++import Chiasma.Command.Pane (capturePane)+import Chiasma.Data.TmuxId (PaneId(PaneId))+import Chiasma.Data.TmuxThunk (TmuxThunk)++loadScreenshot :: MonadIO m => FilePath -> m (Maybe Text)+loadScreenshot path =+  ifM (doesFileExist path) (Just . toText <$> liftIO (readFile path)) (pure Nothing)++storeScreenshot :: MonadIO m => FilePath -> [Text] -> m ()+storeScreenshot path text = do+  createDirectoryIfMissing True (takeDirectory path)+  liftIO $ ByteString.writeFile path (Text.encodeUtf8 . Text.unlines $ text)++takeScreenshot ::+  MonadFree TmuxThunk m =>+  MonadIO m =>+  Int ->+  m [Text]+takeScreenshot =+  capturePane . PaneId++recordScreenshot ::+  MonadFree TmuxThunk m =>+  MonadIO m =>+  FilePath ->+  Int ->+  m ()+recordScreenshot path paneId = do+  current <- takeScreenshot paneId+  storeScreenshot path current++testScreenshot ::+  MonadFree TmuxThunk m =>+  MonadIO m =>+  FilePath ->+  Int ->+  m (Maybe ([Text], [Text]))+testScreenshot path pane = do+  current <- takeScreenshot pane+  loadScreenshot path >>= check current+  where+    check current (Just existing) =+      return $ Just (current, Text.lines existing)+    check current Nothing =+      Nothing <$ storeScreenshot path current++screenshot ::+  MonadFree TmuxThunk m =>+  MonadIO m =>+  Bool ->+  FilePath ->+  Text ->+  Int ->+  m (Maybe ([Text], [Text]))+screenshot record storage name paneId =+  if record then Nothing <$ recordScreenshot path paneId else testScreenshot path paneId+  where+    path = storage </> toString name

@@ -1,71 +1,121 @@-module Chiasma.Test.Tmux(-  withTestTmux,-  tmuxSpec,-) where+module Chiasma.Test.Tmux where -import GHC.Real (fromIntegral)-import GHC.IO.Handle (Handle)+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Monad.Stream (runTmux)+import qualified Chiasma.Monad.Tmux as Tmux (write)+import Chiasma.Native.Api (TmuxNative(..))+import Control.Concurrent (threadDelay)+import System.Directory (doesFileExist) import System.FilePath ((</>))-import System.Posix.Pty (Pty, resizePty, createPty)-import System.Posix.Terminal (openPseudoTerminal) import System.Posix.IO (fdToHandle)-import qualified System.Posix.Signals as Signal (signalProcess, killProcess)+import System.Posix.Pty (Pty, createPty, resizePty)+import qualified System.Posix.Signals as Signal (killProcess, signalProcess)+import System.Posix.Terminal (openPseudoTerminal) import System.Process (getPid) import System.Process.Typed (-  ProcessConfig,   Process,-  withProcess,+  ProcessConfig,+  StreamSpec,   proc,+  setStderr,   setStdin,   setStdout,-  setStderr,-  useHandleClose,   unsafeProcessHandle,+  useHandleClose,+  withProcessWait,   )-import UnliftIO (finally)+import UnliftIO (finally, throwString)+import UnliftIO.Exception (tryAny) import UnliftIO.Temporary (withSystemTempDirectory)-import Chiasma.Native.Api (TmuxNative(..))+ import Chiasma.Test.File (fixture)  data Terminal = Terminal Handle Pty +data TmuxTestConf =+  TmuxTestConf {+    ttcWidth :: Int,+    ttcHeight :: Int,+    ttcFontSize :: Int,+    ttcGui :: Bool+  }+  deriving (Eq, Show)++instance Default TmuxTestConf where+  def = TmuxTestConf 240 61 18 True++usleep :: MonadIO f => Double -> f ()+usleep =+  liftIO . threadDelay . round++sleep :: MonadIO f => Double -> f ()+sleep seconds =+  usleep $ seconds * 1e6+ unsafeTerminal :: IO Terminal unsafeTerminal = do   (_, slave) <- openPseudoTerminal   mayPty <- createPty slave   handle <- fdToHandle slave-  pty <- maybe (error "couldn't spawn pty") return mayPty+  pty <- maybe (throwString "couldn't spawn pty") return mayPty   return $ Terminal handle pty -testTmuxProcessConfig :: FilePath -> FilePath -> Terminal -> IO (ProcessConfig () () ())-testTmuxProcessConfig socket confFile (Terminal handle pty) = do-  resizePty pty (1000, 1000)-  let stream = useHandleClose handle-  let stdio = setStdin stream . setStdout stream . setStderr stream-  return $ stdio $ proc "tmux" ["-S", socket, "-f", confFile]+urxvtArgs :: Int -> Int -> Int -> [Text]+urxvtArgs width height fontSize =+  ["-geometry", show width <> "x" <> show height, "-fn", "xft:monospace:size=" <> show fontSize, "-e", "tmux"] +testTmuxProcessConfig :: TmuxTestConf -> FilePath -> FilePath -> Terminal -> IO (ProcessConfig () () ())+testTmuxProcessConfig (TmuxTestConf width height fontSize gui) socket confFile (Terminal handle pty) = do+  confFileExists <- doesFileExist confFile+  resizePty pty (width, height)+  let+    stream :: StreamSpec st ()+    stream = useHandleClose handle+    stdio = setStdin stream . setStdout stream . setStderr stream+    tmuxArgs = ["-S", toText socket, "-f", toText confFileArg]+    confFileArg = if confFileExists then confFile else "/dev/null"+    prc =+      if gui+      then proc "urxvt" (toString <$> urxvtArgs width height fontSize ++ tmuxArgs)+      else proc "tmux" (toString <$> tmuxArgs)+  return $ stdio prc+ killPid :: Integral a => a -> IO () killPid =-  Signal.signalProcess Signal.killProcess . fromIntegral+  void . tryAny . Signal.signalProcess Signal.killProcess . fromIntegral -killProcess :: Process () () () -> IO ()-killProcess prc = do+killProcess :: TmuxNative -> Process () () () -> IO ()+killProcess api prc = do+  _ <- runExceptT @TmuxError $ runTmux api $ Tmux.write "kill-server" []   let handle = unsafeProcessHandle prc   mayPid <- getPid handle   maybe (return ()) killPid mayPid +-- FIXME find a way to wait for tmux deterministically instead of sleeping+-- if the first tmux control mode process from a TmuxProg runs before urxvt has started the server,+-- it will not use the test tmux.conf+-- maybe start tmux first, then urxvt? runAndKillTmux :: (TmuxNative -> IO a) -> TmuxNative -> Process () () () -> IO a-runAndKillTmux thunk api prc =-  finally (thunk api) (killProcess prc)+runAndKillTmux thunk api prc = do+  sleep 0.2+  finally (thunk api) (killProcess api prc) -withTestTmux :: (TmuxNative -> IO a) -> FilePath -> IO a-withTestTmux thunk tempDir = do+withTestTmux :: TmuxTestConf -> (TmuxNative -> IO a) -> FilePath -> IO a+withTestTmux tConf thunk tempDir = do   let socket = tempDir </> "tmux_socket"   conf <- fixture "u" "tmux.conf"   terminal <- unsafeTerminal-  pc <- testTmuxProcessConfig socket conf terminal-  withProcess pc $ runAndKillTmux thunk (TmuxNative socket)+  pc <- testTmuxProcessConfig tConf socket conf terminal+  withProcessWait pc $ runAndKillTmux thunk (TmuxNative $ Just socket) +tmuxSpec' :: TmuxTestConf -> (TmuxNative -> IO a) -> IO a+tmuxSpec' conf thunk =+  withSystemTempDirectory "chiasma-test" $ withTestTmux conf thunk+ tmuxSpec :: (TmuxNative -> IO a) -> IO a-tmuxSpec thunk =-  withSystemTempDirectory "chiasma-test" $ withTestTmux thunk+tmuxSpec =+  tmuxSpec' def { ttcGui = False }++tmuxGuiSpec :: (TmuxNative -> IO a) -> IO a+tmuxGuiSpec =+  tmuxSpec' def

@@ -0,0 +1,52 @@+module Chiasma.Ui.Data.Measure where++import Chiasma.Data.TmuxId (PaneId(..))+import Data.Text.Prettyprint.Doc (Pretty(..), (<+>))++import Chiasma.Ui.Data.Tree (NNode, NTree)++data MPane =+  MPane {+    _paneId :: PaneId,+    _mainPosition :: Int,+    _offPosition :: Int+  }+  deriving (Eq, Show)++makeClassy ''MPane++data MLayout =+  MLayout {+    _reference :: PaneId,+    _lMainPosition :: Int,+    _lOffPosition :: Int,+    _vertical :: Bool+  }+  deriving (Eq, Show)++makeClassy ''MLayout++data Measured a =+  Measured {+    _size :: Int,+    _view :: a+  }+  deriving (Eq, Show)++makeClassy ''Measured++type MeasureTree = NTree (Measured MLayout) (Measured MPane)+type MeasureTreeSub = NNode (Measured MLayout) (Measured MPane)++instance Pretty MLayout where+  pretty (MLayout (PaneId refId) mainPos offPos vertical') =+    "l –" <+> "ref:" <+> pretty refId <+> "pos:" <+> pretty mainPos <+> "(" <> pretty offPos <> ")" <+>+      if vertical' then "v" else "h"++instance Pretty MPane where+  pretty (MPane (PaneId paneId') mainPos offPos) =+    "p –" <+> pretty paneId' <+> "pos:" <+> pretty mainPos <+> "(" <> pretty offPos <> ")"++instance Pretty a => Pretty (Measured a) where+  pretty (Measured size' a) =+    pretty a <+> "size:" <+> pretty size'

@@ -0,0 +1,54 @@+module Chiasma.Ui.Data.RenderableTree where++import Data.Text.Prettyprint.Doc (Doc, Pretty(..), emptyDoc, space, (<+>))++import Chiasma.Data.TmuxId (PaneId(..))+import Chiasma.Ui.Data.Tree (NNode, NTree)+import Chiasma.Ui.Data.ViewGeometry (ViewGeometry(ViewGeometry))+import Chiasma.Ui.Data.ViewState (ViewState)++data RLayout =+  RLayout {+    _ref :: RPane,+    _vertical :: Bool+  }+  deriving (Eq, Show)++data RPane =+  RPane {+    _id :: PaneId,+    _top :: Int,+    _left :: Int+  }+  deriving (Eq, Show)++data Renderable a =+  Renderable {+    _state :: ViewState,+    _geometry :: ViewGeometry,+    _view :: a+  }+  deriving (Eq, Show)++type RenderableLayout = Renderable RLayout+type RenderablePane = Renderable RPane+type RenderableTree = NTree RenderableLayout RenderablePane+type RenderableNode = NNode RenderableLayout RenderablePane++instance Pretty RLayout where+  pretty (RLayout (RPane (PaneId refId) _ _) vertical) =+    "l –" <+> "ref:" <+> pretty refId <+> "pos:" <+> if vertical then "v" else "h"++instance Pretty RPane where+  pretty (RPane (PaneId paneId) top left) =+    "p –" <+> pretty paneId <+> pretty top <+> pretty left++mayPretty :: Text -> Maybe Float -> Doc a+mayPretty prefix (Just a) =+  space <> pretty (prefix <> ":") <+> pretty a+mayPretty _ Nothing =+  emptyDoc++instance Pretty a => Pretty (Renderable a) where+  pretty (Renderable _ (ViewGeometry minSize maxSize fixedSize _ _ _) a) =+    pretty a <> mayPretty "min" minSize <> mayPretty "max" maxSize <> mayPretty "fixed" fixedSize

@@ -0,0 +1,45 @@+{-# LANGUAGE TemplateHaskell #-}++module Chiasma.Ui.Data.Tree where++import Data.Text.Prettyprint.Doc (Pretty(..), vsep, nest)++data Tree f l p =+  Tree {+    _treeData :: l,+    _forest :: f (Node f l p)+    }++deriving instance (Eq l, Eq p) => Eq (Tree [] l p)+deriving instance (Show l, Show p) => Show (Tree [] l p)++deriving instance (Eq l, Eq p) => Eq (Tree NonEmpty l p)+deriving instance (Show l, Show p) => Show (Tree NonEmpty l p)++data Node f l p =+  Sub { _subTree :: Tree f l p }+  |+  Leaf { _leafData :: p }++makeClassy ''Tree+makeClassy ''Node++deriving instance (Eq l, Eq p) => Eq (Node [] l p)+deriving instance (Show l, Show p) => Show (Node [] l p)++deriving instance (Eq l, Eq p) => Eq (Node NonEmpty l p)+deriving instance (Show l, Show p) => Show (Node NonEmpty l p)++type LTree l p = Tree [] l p+type LNode l p = Node [] l p++type NTree l p = Tree NonEmpty l p+type NNode l p = Node NonEmpty l p++instance (Foldable f, Pretty l, Pretty p) => Pretty (Tree f l p) where+  pretty (Tree l sub) =+    nest 2 $ vsep $ pretty l : (pretty <$> toList sub)++instance (Foldable f, Pretty l, Pretty p) => Pretty (Node f l p) where+  pretty (Sub tree') = pretty tree'+  pretty (Leaf a) = pretty a

@@ -0,0 +1,22 @@+module Chiasma.Ui.Data.TreeModError where++import Chiasma.Data.Ident (Ident)+import Chiasma.Ui.Data.View (LayoutView, PaneView)++data TreeModError =+  PaneExists PaneView+  |+  LayoutExists LayoutView+  |+  PaneMissing Ident+  |+  LayoutMissing Ident+  |+  AmbiguousPane Ident Int+  |+  AmbiguousLayout Ident Int+  |+  NoTrees+  deriving (Eq, Show)++deepPrisms ''TreeModError

@@ -0,0 +1,151 @@+module Chiasma.Ui.Data.View where++import Chiasma.Data.Ident (Ident, Identifiable(..))+import Control.Lens (Index, IxValue, Ixed(ix), makeClassy_)+import Control.Lens.Plated (Plated)+import Data.Data (Data)+import Data.Text.Prettyprint.Doc (Doc, Pretty(..), emptyDoc, nest, space, vsep, (<+>))+import Prelude hiding (state)++import Chiasma.Ui.Data.ViewGeometry (ViewGeometry)+import Chiasma.Ui.Data.ViewState (ViewState(ViewState))+import Chiasma.Ui.Lens.Ident (matchIdentP)++data Pane =+  Pane {+    _open :: Bool,+    _pin :: Bool,+    _cwd :: Maybe FilePath+  }+  deriving (Eq, Show, Data, Generic)++makeClassy ''Pane++instance Default Pane where+  def = Pane False False Nothing++newtype Layout =+  Layout {+    vertical :: Bool+  }+  deriving (Eq, Show, Data, Generic)++makeClassy_ ''Layout++instance Default Layout where+  def = Layout True++data View a =+  View {+    _ident :: Ident,+    _state :: ViewState,+    _geometry :: ViewGeometry,+    _extra :: a+  }+  deriving (Eq, Show, Data, Generic)++makeClassy ''View++instance Default a => Default (View a) where+  def = View def def def def++type PaneView = View Pane+type LayoutView = View Layout++instance Pretty Layout where+  pretty (Layout vertical) =+    if vertical then "▤" else "▥"++instance Pretty Pane where+  pretty (Pane open' pin' _) =+    (if open' then "🔓" else "🔒") <+> (if pin' then "📌" else emptyDoc)++prettyView :: Doc a -> Ident -> ViewState -> ViewGeometry -> Doc a+prettyView sym ident' (ViewState minimized) geo =+  sym <+> pretty ident' <+> "⎸" <+> (if minimized then "▂" <> space else emptyDoc) <> pretty geo++instance Pretty (View Pane) where+  pretty (View ident' st geo a) =+    prettyView "◳" ident' st geo <> pretty a++instance Pretty (View Layout) where+  pretty (View ident' st geo a) =+    prettyView (pretty a) ident' st geo++consPane :: Ident -> PaneView+consPane ident' = View ident' (ViewState False) def (Pane False False Nothing)++consLayoutAs :: Bool -> Ident -> LayoutView+consLayoutAs vert ident' = View ident' (ViewState False) def (Layout vert)++consLayout :: Ident -> LayoutView+consLayout =+  consLayoutAs False++consLayoutVertical :: Ident -> LayoutView+consLayoutVertical =+  consLayoutAs True++instance Identifiable (View a) where+  identify = _ident++-- split in two so there can be no lone leaves (panes without layout) as type 'Tree'+data Tree l p =+  Tree {+    treeData :: l,+    treeSubs :: [TreeSub l p]+    }+  deriving (Eq, Show, Data, Generic)++instance Bifunctor Tree where+  first f (Tree l sub) = Tree (f l) (fmap (first f) sub)++  second f (Tree l sub) =+    Tree l (fmap (second f) sub)++instance Bifoldable Tree where+  bifoldMap fl fr (Tree l sub) = mappend (fl l) (foldMap (bifoldMap fl fr) sub)++data TreeSub l p =+  TreeNode { _subTree :: Tree l p }+  |+  TreeLeaf { _leafData :: p }+  deriving (Eq, Show, Data, Generic)++instance Bifunctor TreeSub where+  first f (TreeNode t) = TreeNode (first f t)+  first _ (TreeLeaf p) = TreeLeaf p++  second f (TreeNode t) = TreeNode (second f t)+  second f (TreeLeaf p) = TreeLeaf (f p)++instance Bifoldable TreeSub where+  bifoldMap fl fr (TreeNode t) = bifoldMap fl fr t+  bifoldMap _ fr (TreeLeaf p) = fr p++instance (Data l, Data p) => Plated (Tree l p)++makeClassy_ ''Tree+makeClassy ''TreeSub++type ViewTree = Tree LayoutView PaneView+type ViewTreeSub = TreeSub LayoutView PaneView++instance Identifiable l => Identifiable (Tree l p) where+  identify (Tree l _) = identify l++type instance Index (Tree _ _) = Ident+type instance IxValue (Tree l p) = Tree l p++instance Identifiable l => Ixed (Tree l p) where+  ix = matchIdentP++instance (Pretty l, Pretty p) => Pretty (TreeSub l p) where+  pretty (TreeNode a) =+    pretty a+  pretty (TreeLeaf a) =+    pretty a++instance (Pretty l, Pretty p) => Pretty (Tree l p) where+  pretty (Tree l sub) =+    nest 2 . vsep $ pretty l : (pretty <$> sub)

@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveAnyClass #-}++module Chiasma.Ui.Data.ViewGeometry where++import Data.Data (Data)+import Data.Text.Prettyprint.Doc (Doc, Pretty(..), emptyDoc, space, (<+>))++data ViewGeometry =+  ViewGeometry {+    minSize :: Maybe Float,+    maxSize :: Maybe Float,+    fixedSize :: Maybe Float,+    minimizedSize :: Maybe Float,+    weight :: Maybe Float,+    position :: Maybe Float+  }+  deriving (Eq, Show, Data, Generic, Default)++mayPretty :: Text -> Maybe Float -> Doc a+mayPretty prefix (Just a) =+  space <> pretty prefix <> ":" <+> pretty a+mayPretty _ Nothing =+  emptyDoc++instance Pretty ViewGeometry where+  pretty (ViewGeometry minSize maxSize fixedSize _ _ _) =+    foldl @[] (<>) emptyDoc (uncurry mayPretty <$> [("min", minSize), ("max", maxSize), ("fixed", fixedSize)])

@@ -0,0 +1,12 @@+module Chiasma.Ui.Data.ViewState where++import Data.Data (Data)++newtype ViewState =+  ViewState {+    minimized :: Bool+  }+  deriving (Eq, Show, Data, Generic)++instance Default ViewState where+  def = ViewState False

@@ -0,0 +1,23 @@+{-# LANGUAGE RankNTypes #-}++module Chiasma.Ui.Lens.Ident(+  matchIdent,+  matchIdentL,+  matchIdentP,+) where++import Control.Lens (Traversal', Prism', filtered, each, prism)+import Chiasma.Data.Ident (Ident, Identifiable(..), sameIdent)++matchIdent :: Identifiable a => Ident -> Traversal' a a+matchIdent = filtered . sameIdent++matchIdentL :: Identifiable a => Ident -> Traversal' [a] a+matchIdentL ident = each . matchIdent ident++identEither :: Identifiable a => Ident -> a -> Either a a+identEither target a =+  if sameIdent target a then Right a else Left a++matchIdentP :: Identifiable a => Ident -> Prism' a a+matchIdentP ident = prism id (identEither ident)

@@ -0,0 +1,76 @@+module Chiasma.Ui.Measure where++import qualified Data.List.NonEmpty as NonEmpty (zip)+import GHC.Float (int2Float)++import Chiasma.Data.Maybe (orElse)+import Chiasma.Ui.Data.Measure (MLayout(..), MPane(..), MeasureTree, MeasureTreeSub, Measured(..))+import Chiasma.Ui.Data.RenderableTree (RLayout(..), RPane(..), Renderable(..), RenderableNode, RenderableTree)+import Chiasma.Ui.Data.Tree (Tree(..))+import qualified Chiasma.Ui.Data.Tree as Tree (Node(..))+import Chiasma.Ui.Data.ViewGeometry (ViewGeometry(minSize, maxSize, fixedSize))+import Chiasma.Ui.Data.ViewState (ViewState(ViewState))+import Chiasma.Ui.Measure.Balance (balanceSizes)+import Chiasma.Ui.Measure.Weights (viewWeights)++minimizedSizeOrDefault :: ViewGeometry -> Float+minimizedSizeOrDefault = fromMaybe 2 . minSize++effectiveFixedSize :: ViewState -> ViewGeometry -> Maybe Float+effectiveFixedSize (ViewState minimized) viewGeom =+  if minimized then Just (minimizedSizeOrDefault viewGeom) else fixedSize viewGeom++actualSize :: (ViewGeometry -> Maybe Float) ->  ViewState -> ViewGeometry -> Maybe Float+actualSize getter viewState viewGeom =+  orElse (getter viewGeom) (effectiveFixedSize viewState viewGeom)++actualMinSizes :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float+actualMinSizes =+  fmap (fromMaybe 0.0 . uncurry (actualSize minSize))++actualMaxSizes :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty (Maybe Float)+actualMaxSizes =+  fmap (uncurry $ actualSize maxSize)++isMinimized :: ViewState -> ViewGeometry -> Bool+isMinimized (ViewState minimized) _ = minimized++subMeasureData :: RenderableNode -> (ViewState, ViewGeometry)+subMeasureData (Tree.Sub (Tree (Renderable s g _) _)) = (s, g)+subMeasureData (Tree.Leaf (Renderable s g _)) = (s, g)++measureLayoutViews :: Float -> NonEmpty RenderableNode -> NonEmpty Int+measureLayoutViews total views =+  balanceSizes minSizes maxSizes weights minimized cells+  where+    measureData = fmap subMeasureData views+    paneSpacers = int2Float (length views) - 1.0+    cells = total - paneSpacers+    sizesInCells s = if s > 1 then s else s * cells+    minSizes = fmap sizesInCells (actualMinSizes measureData)+    maxSizes = fmap (fmap sizesInCells) (actualMaxSizes measureData)+    minimized = fmap (uncurry isMinimized) measureData+    weights = viewWeights measureData++measureSub :: Int -> Int -> Bool -> RenderableNode -> Int -> MeasureTreeSub+measureSub width height vertical (Tree.Sub tree) size =+  Tree.Sub $ measureLayout tree newWidth newHeight vertical+  where+    (newWidth, newHeight) = if vertical then (width, size) else (size, height)+measureSub _ _ vertical (Tree.Leaf (Renderable _ _ (RPane paneId top left))) size =+  Tree.Leaf (Measured size (MPane paneId (if vertical then top else left) (if vertical then left else top)))++measureLayout :: RenderableTree -> Int -> Int -> Bool -> MeasureTree+measureLayout (Tree (Renderable _ _ (RLayout (RPane refId refTop refLeft) vertical)) sub) width height parentVertical =+  Tree (Measured sizeInParent (MLayout refId mainPos offPos vertical)) measuredSub+  where+    sizeInParent = if parentVertical then height else width+    mainPos = if parentVertical then refTop else refLeft+    offPos = if parentVertical then refLeft else refTop+    subTotalSize = if vertical then height else width+    sizes = measureLayoutViews (int2Float subTotalSize) sub+    measuredSub = uncurry (measureSub width height vertical) <$> NonEmpty.zip sub sizes++measureTree :: RenderableTree -> Int -> Int -> MeasureTree+measureTree tree width height =+  measureLayout tree width height False

@@ -0,0 +1,157 @@+module Chiasma.Ui.Measure.Balance where++import Data.List (zipWith3)+import qualified Data.List.NonEmpty as NonEmpty (+  filter,+  toList,+  zip,+  zipWith,+  )+import GHC.Float (float2Int, int2Float)+import GHC.Float.RealFracMethods (floorFloatInt)++import Chiasma.Ui.Measure.Weights (+  amendAndNormalizeWeights,+  normalizeWeights,+  )++zipWith3NE :: (a -> b -> c -> d)  ->  NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d+zipWith3NE z ~(a :| as) ~(b :| bs) ~(c :| cs) =+  z a b c :| zipWith3 z as bs cs++data Balance =+  Balance {+    balanceMin :: NonEmpty Float,+    balanceMax :: NonEmpty (Maybe Float),+    balanceWeights :: NonEmpty Float,+    balanceMinimized :: NonEmpty Bool,+    balanceTotal :: Float+  }++reverseWeights :: NonEmpty Float -> NonEmpty Float+reverseWeights weights =+  if norm > 0 then fmap (/ norm) r else r+  where+    r = fmap (1 -) weights+    norm = sum r++cutSizes :: Balance -> NonEmpty Float+cutSizes (Balance min' _ weights _ total) =+  fmap addDist cut+  where+    surplus = sum min' - total+    dist = fmap (surplus *) (reverseWeights weights)+    cut = fmap (uncurry (-)) (NonEmpty.zip min' dist)+    negOrZero a = if a < 0 then a else 0+    neg = fmap negOrZero cut+    negTotal = sum neg+    negCount = length (NonEmpty.filter (< 0) neg)+    dist2 = negTotal / int2Float (length min' - negCount)+    addDist a = if a < 0 then 0 else a + dist2++distributeOnUnbounded :: Balance -> NonEmpty Float+distributeOnUnbounded (Balance min' max' weights _ total) =+  NonEmpty.zipWith addWeights initial newWeights+  where+    initial = NonEmpty.zipWith fromMaybe min' max'+    newWeights = normalizeWeights $ NonEmpty.zipWith weightOrZeroIfMax weights max'+    addWeights i w = i + (w * surplus)+    surplus = total - sum initial+    weightOrZeroIfMax w = maybe w (const 0)++weightsWithoutMinimized :: Balance -> NonEmpty Float+weightsWithoutMinimized (Balance _ _ weights minimized _) =+  normalizeWeights zeroIfMinimizedWeights+  where+    zeroIfMinimizedWeights = NonEmpty.zipWith zeroIfMinimized weights minimized+    zeroIfMinimized w m = if m then 0 else w++trimWeights :: NonEmpty Bool -> NonEmpty Float -> NonEmpty Float+trimWeights unsat withoutMinimized =+  amendAndNormalizeWeights onlyUnsat+  where+    onlyUnsat = NonEmpty.zipWith weightIfUnsat unsat withoutMinimized+    weightIfUnsat s w = if s then Just w else Nothing++distRest :: Balance -> Float -> NonEmpty Float -> NonEmpty Float -> NonEmpty Float+distRest balance rest sizes effectiveMax =+  NonEmpty.zipWith addRestWeights sizes restW+  where+    unsat = NonEmpty.zipWith (>) effectiveMax sizes+    unsatLeft = or unsat+    withoutMinimized = weightsWithoutMinimized balance+    restW =+      if unsatLeft+      then trimWeights unsat withoutMinimized+      else withoutMinimized+    addRestWeights s w = s + w * rest++saturate :: NonEmpty Float -> NonEmpty Float -> NonEmpty Float -> Float -> NonEmpty Float+saturate initial max' initialWeights total =+  loop initial initialWeights+  where+    loop current weights =+      if new == current || rest <= 0 then new else loop new newWeights+      where+        rest = total - sum current+        unsatWeights = zipWith3NE (\s m w -> if s >= m then 0 else w) current max' weights+        newWeights = normalizeWeights unsatWeights+        new = zipWith3NE (\l h w -> min (l + w * rest) h) current max' newWeights++distributeOnAll :: Balance -> NonEmpty Float+distributeOnAll balance@(Balance min' max' weights _ total) =+  if rest <= 0 then sizes else distRest balance rest sizes effectiveMax+  where+    effectiveMax = fromMaybe 1e6 <$> max'+    sizes = saturate min' effectiveMax weights total+    rest = total - sum sizes++hasUnbounded :: Balance -> Bool+hasUnbounded =+  any isNothing . balanceMax++distributeSizes :: Balance -> NonEmpty Float+distributeSizes balance =+  handler balance+  where+    handler =+      if (maxTotal < balanceTotal balance) && hasUnbounded balance+      then distributeOnUnbounded+      else distributeOnAll+    maxTotal = sum (catMaybes $ NonEmpty.toList $ balanceMax balance)++roundSizes :: NonEmpty Float -> NonEmpty Int+roundSizes (head' :| tail') =+  roundedHead + (float2Int surplus) :| roundedTail+  where+    (surplus, roundedTail) = mapAccumL folder diff0 tail'+    (roundedHead, diff0) = diff head'+    folder z a =+      (z + z1, a1)+      where+        (a1, z1) = diff a+    diff a = (floorFloatInt a, a - int2Float (floor a))++ensureMinimum2 :: NonEmpty Float -> NonEmpty Float+ensureMinimum2 sizes =+  choose <$> positives+  where+    positive = max 0+    positives = positive <$> sizes+    positivesCount = length $ NonEmpty.filter (>= 2) sizes+    unders = amountUnderTwo <$> positives+    sub = sum unders / int2Float positivesCount+    amountUnderTwo a = positive (2 - a)+    choose a = max 2 (a - sub)++rectifySizes :: NonEmpty Float -> NonEmpty Int+rectifySizes =+  roundSizes . ensureMinimum2++-- FIXME need to round manually, keeping track of the surplus, in order to achieve determinism+balanceSizes :: NonEmpty Float -> NonEmpty (Maybe Float) -> NonEmpty Float -> NonEmpty Bool -> Float -> NonEmpty Int+balanceSizes minSizes maxSizes weights minimized total =+  rectifySizes (fit balance)+  where+    fit = if sum minSizes > total then cutSizes else distributeSizes+    balance = Balance minSizes maxSizes weights minimized total

@@ -0,0 +1,38 @@+module Chiasma.Ui.Measure.Weights(+  viewWeights,+  normalizeWeights,+  amendAndNormalizeWeights,+) where++import qualified Data.List.NonEmpty as NonEmpty (toList, filter)+import GHC.Float (int2Float)++import Chiasma.Ui.Data.ViewGeometry (ViewGeometry(ViewGeometry))+import Chiasma.Ui.Data.ViewState (ViewState(ViewState))++effectiveWeight :: ViewState -> ViewGeometry -> Maybe Float+effectiveWeight (ViewState minimized) (ViewGeometry _ _ fixedSize _ weight _) =+  if isJust fixedSize || minimized then Just 0 else weight++amendWeights :: NonEmpty (Maybe Float) -> NonEmpty Float+amendWeights weights =+  fmap (fromMaybe emptyWeight) weights+  where+    total = sum (catMaybes $ NonEmpty.toList weights)+    normTotal = if total == 0 then 1 else total+    empties = length (NonEmpty.filter isNothing weights)+    normEmpties = if empties == 0 then 1 else empties+    emptyWeight = normTotal / int2Float normEmpties++normalizeWeights :: NonEmpty Float -> NonEmpty Float+normalizeWeights weights =+  fmap (/ normTotal) weights+  where+    total = sum weights+    normTotal = if total == 0 then 1 else total++amendAndNormalizeWeights :: NonEmpty (Maybe Float) -> NonEmpty Float+amendAndNormalizeWeights = normalizeWeights . amendWeights++viewWeights :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float+viewWeights = amendAndNormalizeWeights . fmap (uncurry effectiveWeight)

@@ -0,0 +1,17 @@+module Chiasma.Ui.Pane(+  paneToggleOpen,+  paneSetOpen,+) where++import Chiasma.Ui.Data.View (View(View), PaneView, Pane(Pane))+import Chiasma.Ui.Data.ViewState (ViewState(ViewState))++paneToggleOpen :: PaneView -> PaneView+paneToggleOpen (View i s g (Pane False pin cwd)) =+  View i s g (Pane True pin cwd)+paneToggleOpen (View i (ViewState m) g e) =+  View i (ViewState (not m)) g e++paneSetOpen :: PaneView -> PaneView+paneSetOpen (View i s g (Pane _ pin cwd)) =+  View i s g (Pane True pin cwd)

@@ -0,0 +1,41 @@+module Chiasma.Ui.ShowTree where++import Chiasma.Data.Ident (identText)+import Chiasma.Ui.Data.View (+  LayoutView,+  Pane(Pane),+  PaneView,+  Tree(Tree),+  TreeSub(TreeNode, TreeLeaf),+  View(View),+  ViewTree,+  )++formatLayout :: LayoutView -> Text+formatLayout (View ident _ _ _) = "l: " <> identText ident++formatPane :: PaneView -> Text+formatPane (View ident _ _ (Pane open _ _)) =+  "p: " <> identText ident <> openFrag+  where+    openFrag = " " <> if open then "open" else "closed"++formatViewTree :: ViewTree -> Tree Text Text+formatViewTree = bimap formatLayout formatPane++indent :: [Text] -> [Text]+indent = fmap (" " <>)++showTreeSub :: TreeSub Text Text -> [Text]+showTreeSub (TreeNode tree) = showTree tree+showTreeSub (TreeLeaf pane) = [pane]++showTree :: Tree Text Text -> [Text]+showTree (Tree l sub) =+  l : indent (sub >>= showTreeSub)++showViewTree :: ViewTree -> [Text]+showViewTree = showTree . formatViewTree++printViewTree :: MonadIO m => ViewTree -> m ()+printViewTree = liftIO . traverse_ putStrLn . fmap toString . showViewTree

@@ -0,0 +1,314 @@+module Chiasma.Ui.ViewTree where++import Chiasma.Data.Ident (Ident)+import Chiasma.Lens.Tree (+  LeafIndexTree(..),+  _litTree,+  leafDataTraversal,+  )+import Control.Lens (+  Traversal,+  Traversal',+  anyOf,+  cosmos,+  filtered,+  has,+  ix,+  mapMOf,+  over,+  transformM,+  )+import Control.Monad.Error.Class (throwError)+import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)+import Data.Composition ((.:))++import Chiasma.Ui.Data.TreeModError (TreeModError(PaneMissing, AmbiguousPane, LayoutMissing, AmbiguousLayout))+import Chiasma.Ui.Data.View (+  Pane(Pane),+  PaneView,+  Tree(Tree),+  TreeSub(TreeNode, TreeLeaf),+  View(View),+  ViewTree,+  ViewTreeSub,+  )+import qualified Chiasma.Ui.Data.View as Pane (open)+import qualified Chiasma.Ui.Data.View as TreeSub (leafData)+import qualified Chiasma.Ui.Data.View as View (extra)+import Chiasma.Ui.Data.ViewState (ViewState(ViewState))+import Chiasma.Ui.Pane (paneSetOpen, paneToggleOpen)++modCounted :: Monad m => (a -> m a) -> a -> WriterT (Sum Int) m a+modCounted f a = do+  tell (Sum 1)+  lift $ f a++treeToggleOpen :: ViewTree -> ViewTree+treeToggleOpen (Tree l sub) =+  Tree l (snd $ mapAccumL toggle False sub)+  where+    toggle False (TreeLeaf p) = (True, TreeLeaf (paneToggleOpen p))+    toggle a b = (a, b)++modifyTreeUniqueM :: Monad m => (ViewTree -> m ViewTree) -> Ident -> ViewTree -> ExceptT TreeModError m ViewTree+modifyTreeUniqueM f ident tree = do+  let st = (transformM $ mapMOf (ix ident) (modCounted f)) tree+  (result, Sum count) <- lift $ runWriterT st+  case count of+    1 -> return result+    0 -> throwError $ LayoutMissing ident+    n -> throwError $ AmbiguousLayout ident n++toggleLayout1 :: Ident -> ViewTree -> Either TreeModError ViewTree+toggleLayout1 ident tree =+  runIdentity $ runExceptT $ modifyTreeUniqueM (Identity . treeToggleOpen) ident tree++modifyPaneUniqueM :: Monad m => (PaneView -> m PaneView) -> Ident -> ViewTree -> ExceptT TreeModError m ViewTree+modifyPaneUniqueM f ident tree = do+  let st = (transformM $ mapMOf (ix ident) (modCounted f)) (LeafIndexTree tree)+  (result, Sum count) <- lift $ runWriterT st+  case count of+    1 -> return $ litTree result+    0 -> throwError $ PaneMissing ident+    n -> throwError $ AmbiguousPane ident n++modifyPane :: (PaneView -> PaneView) -> Ident -> ViewTree -> Either TreeModError ViewTree+modifyPane modification ident tree =+  runIdentity $ runExceptT $ modifyPaneUniqueM (Identity . modification) ident tree++openPane :: Ident -> ViewTree -> Either TreeModError ViewTree+openPane =+  modifyPane paneSetOpen++hasOpenPanes :: ViewTree -> Bool+hasOpenPanes tree =+  has (cosmos . _litTree . leafDataTraversal . filtered isOpen) (LeafIndexTree tree)+  where+    isOpen (View _ _ _ (Pane open _ _)) = open++depthTraverseTree ::+  ∀ a.+  Monoid a =>+  (a -> ViewTree -> (a, ViewTree)) ->+  (PaneView -> (a, PaneView)) ->+  ViewTree ->+  (a, ViewTree)+depthTraverseTree transformNode transformLeaf =+  recur+  where+    recur :: ViewTree -> (a, ViewTree)+    recur (Tree l sub) =+      uncurry transformNode . bimap fold (Tree l) . unzip $ (recSub <$> sub)+    recSub :: ViewTreeSub -> (a, ViewTreeSub)+    recSub (TreeNode t) =+      second TreeNode $ recur t+    recSub (TreeLeaf l) =+      second TreeLeaf $ transformLeaf l++data ToggleStatus =+  Minimized+  |+  Opened+  |+  Pristine+  |+  Multiple Int+  |+  Consistent+  deriving (Eq, Show)++instance Semigroup ToggleStatus where+  Pristine <> a = a+  a <> Pristine = a+  Multiple a <> Multiple b = Multiple (a + b)+  Multiple a <> _ = Multiple (a + 1)+  _ <> Multiple a = Multiple (a + 1)+  _ <> _ = Multiple 2++instance Monoid ToggleStatus where+  mempty = Pristine++data ToggleResult a =+  Success a+  |+  NotFound+  |+  Ambiguous Int+  deriving (Eq, Show, Functor)++instance Semigroup (ToggleResult a) where+  NotFound <> a = a+  a <> NotFound = a+  Ambiguous a <> Ambiguous b = Ambiguous (a + b)+  Ambiguous a <> _ = Ambiguous (a + 1)+  _ <> Ambiguous a = Ambiguous (a + 1)+  _ <> _ = Ambiguous 2++instance Monoid (ToggleResult a) where+  mempty = NotFound++instance Applicative ToggleResult where+  pure = Success+  (Success f) <*> fa = fmap f fa+  NotFound <*> _ = NotFound+  Ambiguous n <*> _ = Ambiguous n++instance Monad ToggleResult where+    Success a >>= f = f a+    NotFound >>= _ = NotFound+    Ambiguous n >>= _ = Ambiguous n++openPinnedSubs :: ToggleStatus -> ViewTree -> (ToggleStatus, ViewTree)+openPinnedSubs Pristine t =+  (Pristine, t)+openPinnedSubs Opened (Tree l sub) =+  (Opened, Tree l (openPinnedPane <$> sub))+  where+    openPinnedPane :: ViewTreeSub -> ViewTreeSub+    openPinnedPane (TreeLeaf (View i s g (Pane False True cwd))) =+      TreeLeaf $ View i s g (Pane True True cwd)+    openPinnedPane v =+      v+openPinnedSubs a t =+  (a, t)++checkToggleResult ::+  ToggleStatus ->+  a ->+  ToggleResult a+checkToggleResult =+  checkResult+  where+    checkResult Pristine _ = NotFound+    checkResult (Multiple n) _ = Ambiguous n+    checkResult _ result = Success result++togglePaneView :: Ident -> PaneView -> (ToggleStatus, PaneView)+togglePaneView ident (View i s g (Pane False p c)) | ident == i =+  (Opened, View i s g (Pane True p c))+togglePaneView ident (View i (ViewState minimized) g (Pane True p c)) | ident == i =+  (Minimized, View i (ViewState (not minimized)) g (Pane False p c))+togglePaneView _ v =+  (Pristine, v)++togglePaneNode :: Ident -> ViewTreeSub -> (ToggleStatus, ViewTreeSub)+togglePaneNode ident (TreeLeaf v) =+  second TreeLeaf (togglePaneView ident v)+togglePaneNode _ t =+  (Pristine, t)++togglePane :: Ident -> ViewTree -> ToggleResult ViewTree+togglePane ident =+  uncurry checkToggleResult . depthTraverseTree openPinnedSubs (togglePaneView ident)++togglePaneOpenTraversal' ::+  Traversal' a ViewTree ->+  Ident ->+  a ->+  ToggleResult a+togglePaneOpenTraversal' lens =+  mapMOf lens . togglePane++ensurePaneViewOpen :: Ident -> PaneView -> (ToggleStatus, PaneView)+ensurePaneViewOpen ident (View i s g (Pane False p c)) | ident == i =+  (Opened, View i s g (Pane True p c))+ensurePaneViewOpen ident v@(View i _ _ _) | ident == i =+  (Consistent, v)+ensurePaneViewOpen _ v =+  (Pristine, v)++ensurePaneOpen :: Ident -> ViewTree -> ToggleResult ViewTree+ensurePaneOpen ident =+  uncurry checkToggleResult . depthTraverseTree openPinnedSubs (ensurePaneViewOpen ident)++ensurePaneOpenTraversal ::+  Traversal a (ToggleResult a) ViewTree (ToggleResult ViewTree) ->+  Ident ->+  a ->+  ToggleResult a+ensurePaneOpenTraversal lens =+  over lens . ensurePaneOpen++ensurePaneOpenTraversal' ::+  Traversal' a ViewTree ->+  Ident ->+  a ->+  ToggleResult a+ensurePaneOpenTraversal' lens =+  mapMOf lens . ensurePaneOpen++skipFold ::+  Traversable t =>+  (a -> (ToggleStatus, a)) ->+  ToggleStatus ->+  t a ->+  (ToggleStatus, t a)+skipFold f =+  mapAccumL skipper+  where+    skipper Pristine a =+      f a+    skipper status a =+      (status, a)++isOpenPaneNode :: ViewTreeSub -> Bool+isOpenPaneNode =+  anyOf (TreeSub.leafData . View.extra . Pane.open) id++openPinnedPaneView :: PaneView -> (ToggleStatus, PaneView)+openPinnedPaneView (View i s g (Pane False True c)) =+  (Opened, View i s g (Pane True True c))+openPinnedPaneView v =+  (Pristine, v)++openFirstPinnedPaneNode :: ViewTreeSub -> (ToggleStatus, ViewTreeSub)+openFirstPinnedPaneNode (TreeLeaf v) =+  second TreeLeaf (openPinnedPaneView v)+openFirstPinnedPaneNode a =+  (Pristine, a)++openPaneView :: PaneView -> (ToggleStatus, PaneView)+openPaneView (View i s g (Pane False p c)) =+  (Opened, View i s g (Pane True p c))+openPaneView v =+  (Pristine, v)++openFirstPaneNode :: ViewTreeSub -> (ToggleStatus, ViewTreeSub)+openFirstPaneNode (TreeLeaf v) =+  second TreeLeaf (openPaneView v)+openFirstPaneNode a =+  (Pristine, a)++-- TODO recurse when opening pane+toggleLayoutNode :: Ident -> ToggleStatus -> ViewTree -> (ToggleStatus, ViewTree)+toggleLayoutNode ident previous (Tree v@(View i (ViewState minimized) g l) sub) | ident == i =+  first (previous <>) (if open then toggleMinimized else openPane')+  where+    open =+      any isOpenPaneNode sub+    toggleMinimized =+      (Minimized, Tree (View i (ViewState (not minimized)) g l) sub)+    openPane' =+      second (Tree v) (uncurry regularIfPristine openFirstPinned)+    openFirstPinned =+      skipFold openFirstPinnedPaneNode Pristine sub+    openFirstRegular =+      skipFold openFirstPaneNode Pristine sub+    regularIfPristine Pristine _ =+      openFirstRegular+    regularIfPristine status a =+      (status, a)+toggleLayoutNode _ a t =+  (a, t)++toggleLayout :: Ident -> ViewTree -> ToggleResult ViewTree+toggleLayout ident =+  uncurry checkToggleResult . depthTraverseTree (uncurry openPinnedSubs .: toggleLayoutNode ident) (Pristine,)++toggleLayoutOpenTraversal' ::+  Traversal' a ViewTree ->+  Ident ->+  a ->+  ToggleResult a+toggleLayoutOpenTraversal' lens =+  mapMOf lens . toggleLayout

@@ -0,0 +1,103 @@+{-# LANGUAGE RankNTypes #-}++module Chiasma.View where++import Chiasma.Data.Ident (Ident, identText, sameIdent)+import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)+import Chiasma.Data.View (View(View), viewIdent)+import Chiasma.Data.Views (Views, ViewsError(..))+import qualified Chiasma.Data.Views as Views (log, panes, sessions, windows)+import Chiasma.Lens.Where (where1)+import Control.Lens (Lens', over)+import qualified Control.Lens as Lens (over, set, view)+import Data.Text.Prettyprint.Doc (Doc, pretty)+import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)++sameId :: Eq a => a -> View a -> Bool+sameId id' (View _ (Just vid)) = id' == vid+sameId _ _ = False++view :: Lens' Views [View a] -> (Ident -> ViewsError) -> Ident -> Views -> Either ViewsError (View a)+view viewsL consError ident =+  maybeToRight (consError ident) . find (sameIdent ident) . Lens.view viewsL++viewById :: Eq a => Lens' Views [View a] -> a -> Views -> Maybe (View a)+viewById viewsL id' =+  find (sameId id') . Lens.view viewsL++insertView :: Lens' Views [View a] -> View a -> Views -> Views+insertView viewsL newView = Lens.over viewsL (newView :)++updateView :: Lens' Views [View a] -> (Ident -> ViewsError) -> View a -> Views -> Views+updateView viewsL _ newView =+  Lens.set (viewsL . where1 (sameIdent (viewIdent newView))) newView++session :: Ident -> Views -> Either ViewsError (View SessionId)+session = view Views.sessions NoSuchSession++sessionById :: SessionId -> Views -> Maybe (View SessionId)+sessionById = viewById Views.sessions++insertSession :: View SessionId -> Views -> Views+insertSession = insertView Views.sessions++updateSession :: View SessionId -> Views -> Views+updateSession = updateView Views.sessions NoSuchSession++window :: Ident -> Views -> Either ViewsError (View WindowId)+window = view Views.windows NoSuchWindow++windowById :: WindowId -> Views -> Maybe (View WindowId)+windowById = viewById Views.windows++insertWindow :: View WindowId -> Views -> Views+insertWindow = insertView Views.windows++updateWindow :: View WindowId -> Views -> Views+updateWindow = updateView Views.windows NoSuchWindow++pane :: Ident -> Views -> Either ViewsError (View PaneId)+pane = view Views.panes NoSuchPane++paneById :: PaneId -> Views -> Maybe (View PaneId)+paneById = viewById Views.panes++paneId :: Ident -> Views -> Either ViewsError PaneId+paneId paneIdent views =+  pane paneIdent views >>= trans+  where+    trans (View _ (Just paneId')) = Right paneId'+    trans _ = Left $ NoPaneId paneIdent++insertPane :: View PaneId -> Views -> Views+insertPane = insertView Views.panes++updatePane :: View PaneId -> Views -> Views+updatePane = updateView Views.panes NoSuchPane++type Getter a = Ident -> Views -> Either ViewsError (View a)+type Setter a = View a -> Views -> Views++addView :: MonadDeepState s Views m => Setter a -> Ident -> m (View a)+addView setter ident = do+  modify $ setter newView+  viewsLogS $ "added tmux view " <> identText ident+  return newView+  where+    newView = View ident Nothing++findOrCreateView :: (MonadDeepState s Views m) => Getter a -> Setter a -> Ident -> m (View a)+findOrCreateView getter setter ident = do+  existing <- gets $ getter ident+  either (const $ addView setter ident) return existing++viewsLog :: MonadDeepState s Views m => Doc AnsiStyle -> m ()+viewsLog message =+  modify f+  where+    f :: Views -> Views+    f = over Views.log (message :)++viewsLogS :: MonadDeepState s Views m => Text -> m ()+viewsLogS =+  viewsLog . pretty

@@ -0,0 +1,17 @@+module Chiasma.View.State where++import Chiasma.Data.Ident (Ident)+import Chiasma.Data.TmuxId (PaneId)+import Control.Monad.DeepError (MonadDeepError, hoistEither)+import Control.Monad.DeepState (MonadDeepState, gets)++import Chiasma.Data.Views (Views, ViewsError)+import qualified Chiasma.View as Views (paneId)++paneId ::+  (MonadDeepState s Views m, MonadDeepError e ViewsError m) =>+  Ident ->+  m PaneId+paneId paneIdent = do+  pid <- gets $ Views.paneId paneIdent+  hoistEither pid

@@ -0,0 +1,225 @@+module Chiasma.Window where++import qualified Chiasma.Codec.Data as Codec (Pane(Pane, paneId), Window(Window, windowId))+import qualified Chiasma.Codec.Data.PaneDetail as Codec (PaneDetail(PaneDetail))+import qualified Chiasma.Codec.Data.PaneDetail as PaneDetail (PaneDetail(..))+import qualified Chiasma.Command.Pane as Cmd (closePane, firstWindowPane, windowPanesAs)+import qualified Chiasma.Command.Window as Cmd (newWindow, splitWindowAs, window)+import Chiasma.Data.Ident (Ident, identText, identify)+import Chiasma.Data.Maybe (findMaybe, maybeExcept, orElse)+import Chiasma.Data.RenderError (RenderError)+import qualified Chiasma.Data.RenderError as RenderError (RenderError(NoPrincipal))+import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)+import Chiasma.Data.TmuxThunk (TmuxThunk)+import qualified Chiasma.Data.View as Tmux (View(View))+import Chiasma.Data.Views (Views)+import Chiasma.Data.WindowState (WindowState(..))+import Chiasma.Pane (addPane)+import Chiasma.Ui.Data.RenderableTree (+  RLayout(..),+  RPane(..),+  Renderable(..),+  RenderableNode,+  RenderableTree,+  )+import qualified Chiasma.Ui.Data.Tree as Tree (Node(Sub, Leaf), Tree(Tree))+import Chiasma.Ui.Data.View (Tree(..), TreeSub(..), ViewTree, ViewTreeSub)+import qualified Chiasma.Ui.Data.View as Ui (Layout(..), Pane(Pane), PaneView, View(View))+import Chiasma.Ui.Data.ViewGeometry (ViewGeometry(ViewGeometry, position))+import Chiasma.Ui.Data.ViewState (ViewState)+import Chiasma.View (findOrCreateView, viewsLog, viewsLogS)+import qualified Chiasma.View as Views (insertPane, insertWindow, pane, paneById, updatePane, updateWindow, window)+import Control.Monad.Error.Class (MonadError)+import Control.Monad.Free.Class (MonadFree)+import qualified Data.List.NonEmpty as NonEmpty (head, nonEmpty)+import Data.Text.Prettyprint.Doc (line, pretty, vsep, (<+>))++findOrCreateWindow ::+  (MonadDeepState s Views m) =>+  Ident ->+  m (Tmux.View WindowId)+findOrCreateWindow =+  findOrCreateView Views.window Views.insertWindow++registerWindowId ::+  (MonadDeepState s Views m) =>+  Ident ->+  WindowId ->+  m ()+registerWindowId ident windowId =+  modify $ Views.updateWindow $ Tmux.View ident (Just windowId)++spawnWindow ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  SessionId ->+  Ident ->+  m Codec.Window+spawnWindow sid ident = do+  win@(Codec.Window windowId _ _) <- Cmd.newWindow sid ident+  registerWindowId ident windowId+  viewsLogS $ "spawned window in session " <> show sid <> " with id " <> show windowId+  return win++findPrincipalSub :: ViewTreeSub -> Maybe Ui.PaneView+findPrincipalSub (TreeNode t) = findPrincipal t+findPrincipalSub (TreeLeaf p@(Ui.View _ _ _ (Ui.Pane True _ _))) = Just p+findPrincipalSub _ = Nothing++findPrincipal :: ViewTree -> Maybe Ui.PaneView+findPrincipal (Tree _ sub) =+  findMaybe findPrincipalSub sub++principalPane ::+  (MonadDeepState s Views m, MonadError RenderError m) =>+  ViewTree ->+  m (Ui.PaneView, Tmux.View PaneId)+principalPane tree = do+  uiPane@(Ui.View uiPaneIdent _ _ _) <- maybeExcept (RenderError.NoPrincipal $ identify tree) $ findPrincipal tree+  existingTmuxPane <- gets $ Views.pane uiPaneIdent+  tmuxPane <- either (const $ addPane uiPaneIdent) return existingTmuxPane+  return (uiPane, tmuxPane)++syncPrincipal ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m, MonadError RenderError m) =>+  WindowId ->+  ViewTree ->+  m ()+syncPrincipal windowId tree@(Tree (Ui.View layoutIdent _ _ _) _) = do+  (Codec.Pane paneId _ _) <- Cmd.firstWindowPane windowId+  existing <- gets (Views.paneById paneId)+  case existing of+    Nothing -> do+      (_, Tmux.View paneIdent _) <- principalPane tree+      viewsLog $ "setting principal of layout" <+> pretty layoutIdent <+> " to pane " <+> pretty paneIdent <+> "/" <+>+        pretty paneId+      modify $ Views.updatePane (Tmux.View paneIdent (Just paneId))+    _ -> return ()++ensureWindow ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m, MonadError RenderError m) =>+  SessionId ->+  Tmux.View WindowId ->+  Maybe WindowId ->+  ViewTree ->+  m Codec.Window+ensureWindow sid (Tmux.View ident mayWid) newSessionWid tree = do+  preexisting <- join <$> traverse Cmd.window (orElse newSessionWid mayWid)+  window <- maybe (spawnWindow sid ident) return preexisting+  syncPrincipal (Codec.windowId window) tree+  return window++findOrCreatePane :: MonadDeepState s Views m => Ident -> m (Tmux.View PaneId)+findOrCreatePane =+  findOrCreateView Views.pane Views.insertPane++nativePane ::+  MonadFree TmuxThunk m =>+  WindowId ->+  Tmux.View PaneId ->+  m (Maybe Codec.PaneDetail)+nativePane windowId (Tmux.View _ (Just paneId)) =+  find sameId <$> Cmd.windowPanesAs windowId+  where+    sameId (Codec.PaneDetail i _ _ _ _) = i == paneId+nativePane _ _ = return Nothing++openPane ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  FilePath ->+  WindowId ->+  m Codec.PaneDetail+openPane dir windowId = do+  detail <- Cmd.splitWindowAs dir windowId+  viewsLogS $ "opened pane " <> show (PaneDetail.paneId detail) <> " in window " <> show windowId+  return detail++ensurePaneOpen ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  FilePath ->+  Maybe Codec.PaneDetail ->+  WindowId ->+  m Codec.PaneDetail+ensurePaneOpen _ (Just detail) _ =+  return detail+ensurePaneOpen dir Nothing windowId =+  openPane dir windowId++ensurePaneClosed ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  Maybe Codec.PaneDetail ->+  m ()+ensurePaneClosed (Just (Codec.PaneDetail i _ _ _ _)) = do+  viewsLogS $ "closing pane " <> show i+  Cmd.closePane i+ensurePaneClosed _ = return ()++ensurePane ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  FilePath ->+  WindowId ->+  Ui.PaneView ->+  m (Maybe RenderableNode)+ensurePane cwd windowId (Ui.View paneIdent vState geometry (Ui.Pane open _ customDir)) = do+  tmuxPane <- findOrCreatePane paneIdent+  existingPane <- nativePane windowId tmuxPane+  updatedPane <-+    if open then Just <$> ensurePaneOpen dir existingPane windowId+    else Nothing <$ ensurePaneClosed existingPane+  modify $ Views.updatePane (Tmux.View paneIdent (PaneDetail.paneId <$> updatedPane))+  return $ cons <$> updatedPane+  where+    dir = fromMaybe cwd customDir+    cons (Codec.PaneDetail i _ _ top left) =+      Tree.Leaf . Renderable vState geometry $ RPane i top left++refPane :: RenderableNode -> RPane+refPane (Tree.Sub (Tree.Tree (Renderable _ _ (RLayout ref _)) _)) = ref+refPane (Tree.Leaf (Renderable _ _ pane)) = pane++renderableTree ::+  ViewState ->+  ViewGeometry ->+  Bool ->+  [RenderableNode] ->+  Maybe RenderableTree+renderableTree vState geometry vertical sub = do+  sub' <- NonEmpty.nonEmpty sub+  return $ Tree.Tree (Renderable vState geometry (RLayout (refPane $ NonEmpty.head sub') vertical)) sub'++viewPosition :: ViewTreeSub -> Float+viewPosition (TreeNode (Tree (Ui.View _ _ ViewGeometry { position = pos } _) _)) =+  fromMaybe 0.5 pos+viewPosition (TreeLeaf (Ui.View _ _ ViewGeometry { position = pos } _)) =+  fromMaybe 0.5 pos++ensureView ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  FilePath ->+  WindowId ->+  ViewTree ->+  m (Maybe RenderableTree)+ensureView cwd windowId =+  ensureTree+  where+    ensureTree (Tree (Ui.View layoutIdent vState geometry (Ui.Layout vertical)) sub) = do+      ensuredSub <- traverse ensureNode sortedSub+      viewsLog $ pretty ("new sub for layout `" <> identText layoutIdent <> "`:") <> line <>+        vsep (pretty <$> ensuredSub)+      return $ renderableTree vState geometry vertical $ catMaybes ensuredSub+      where+        sortedSub = sortOn viewPosition sub+    ensureNode (TreeNode t) = do+      newTree <- ensureTree t+      return $ Tree.Sub <$> newTree+    ensureNode (TreeLeaf v) =+      ensurePane cwd windowId v++windowState ::+  (MonadDeepState s Views m, MonadFree TmuxThunk m) =>+  Ident ->+  Codec.Window ->+  RenderableTree ->+  m WindowState+windowState windowIdent window tree = do+  nativeRef <- Cmd.firstWindowPane (Codec.windowId window)+  return $ WindowState window nativeRef windowIdent tree (Codec.paneId nativeRef)

@@ -0,0 +1,5 @@+module Prelude (+  module Chiasma.Prelude,+) where++import Chiasma.Prelude

@@ -0,0 +1,3 @@+# Intro++**chiasma** is a tmux api client for Haskell.

@@ -0,0 +1,24 @@+module Chiasma.Test.CodecTest where++import Chiasma.Codec (TmuxCodec(decode, query), TmuxQuery(TmuxQuery))+import Chiasma.Data.TmuxId (PaneId(..), WindowId(..))+import Hedgehog ((===))++import Chiasma.Test.Util (UnitTest)++data Dat =+  Dat {+    paneId :: PaneId,+    windowId :: WindowId+  }+  deriving (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

@@ -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+  ]

@@ -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

@@ -0,0 +1,98 @@+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+  ]

@@ -0,0 +1,30 @@+module Chiasma.Test.StreamParseTest where++import Chiasma.Native.StreamParse (TmuxOutputBlock(Success), parseConduit)+import Conduit+import Data.ByteString.Internal (packChars)+import Data.Conduit.List+import qualified Data.Text as T (unpack)+import Hedgehog ((===))++import Chiasma.Test.Util (UnitTest)++paneLine :: Text+paneLine = "%0 100 100"++tmuxOutput :: [Text]+tmuxOutput = [+  "%begin 123\n",+  "%end 123\n",+  "%session-changed $0 0\n%begin 234\n",+  paneLine <> "\nb\n%end 234\n",+  "%begin 345\n",+  "c\n",+  "d\n",+  "%end 345\n"+  ]++test_streamParse :: UnitTest+test_streamParse = do+  r <- runConduit $ sourceList tmuxOutput .| mapC (packChars . T.unpack) .| parseConduit .| sinkList+  [Success [], Success [paneLine, "b"], Success ["c", "d"]] === r

@@ -0,0 +1,14 @@+module Chiasma.Test.Util where++import Hedgehog (TestT, withTests, property, test)+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

@@ -0,0 +1,24 @@+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.StreamParseTest (test_streamParse)+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,+    unitTest "parse tmux output in stream" test_streamParse+  ]++main :: IO ()+main =+  defaultMain tests

@@ -1,45 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module BufferedSpec(-  htf_thisModulesTests-) where--import Test.Framework-import Chiasma.Native.Api (TmuxNative(..))-import Chiasma.Data.Pane (Pane(Pane), PaneId(..))-import Chiasma.Data.Window (Window(Window), WindowId(..))-import Chiasma.Data.TmuxThunk (TmuxError)-import Chiasma.Monad.Buffered (runTmux)-import Chiasma.Monad.Tmux (TmuxProg)-import qualified Chiasma.Monad.Tmux as Tmux (read, write)-import Chiasma.Test.Tmux (tmuxSpec)--prog :: TmuxProg ([Pane], [Pane], [Window])-prog = do-  panes1 <- Tmux.read "list-panes" ["-t", "%0"]-  Tmux.write "new-window" []-  Tmux.write "new-window" []-  wins <- Tmux.read @Window "list-windows" []-  panes <- Tmux.read "list-panes" ["-a"]-  return (panes1, panes, wins)--p :: Int -> Pane-p i = Pane (PaneId i) 1000 999--w :: Int -> Window-w i = Window (WindowId i) 1000 999--runProg :: TmuxNative -> IO (Either TmuxError ([Pane], [Pane], [Window]))-runProg api = runTmux api prog--test_buffered :: IO ()-test_buffered = do-  result <- tmuxSpec runProg-  assertEqual (Right ([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

@@ -1,27 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module CodecSpec(-  htf_thisModulesTests,-) where-import GHC.Generics (Generic)-import Test.Framework-import Chiasma.Data.Pane (PaneId(..))-import Chiasma.Data.Window (WindowId(..))-import Chiasma.Codec (TmuxCodec(decode, query), TmuxQuery(TmuxQuery))--data Dat =-  Dat {-    paneId :: PaneId,-    windowId :: WindowId-  }-  deriving (Eq, Show, Generic)--instance TmuxCodec Dat--test_decode :: IO ()-test_decode =-  assertEqual (Right $ Dat (PaneId 1) (WindowId 2)) $ decode ["%1", "@2"]--test_query :: IO ()-test_query =-  assertEqual (TmuxQuery "#{pane_id} #{window_id}") (query @Dat)

@@ -1,30 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module OutputParseSpec(-  htf_thisModulesTests-) where--import Test.Framework-import Chiasma.Native.Parse (resultLines)--paneLine :: String-paneLine = "%0 100 100"--tmuxOutput :: String-tmuxOutput = unlines [-  "%begin 123",-  "%end 123",-  "%session-changed $0 0",-  "%begin 234",-  paneLine,-  "b",-  "%end 234",-  "%begin 345",-  "c",-  "d",-  "%end 345"-  ]--test_outputParse :: IO ()-test_outputParse =-  assertEqual (Right [[], [paneLine, "b"], ["c", "d"]]) (resultLines tmuxOutput)

@@ -1,32 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module SimpleSpec(-  htf_thisModulesTests-) where---- import Data.Either (isLeft)-import Test.Framework--- import UnliftIO (try)--- import Chiasma.Data.TmuxThunk (TmuxError)--- import Chiasma.Monad.Simple (runTmux)--- import Chiasma.Monad.Tmux (TmuxProg)--- import qualified Chiasma.Monad.Tmux as Tmux (read, write)---- number :: TmuxProg a String--- number = return "1"---- prog :: TmuxProg a [String]--- prog = do---   a <- number---   out <- Tmux.read "list-panes" ["-t", "%" ++ a]---   Tmux.write "new-windowXXX" []---   return out---- runProg :: IO [String]--- runProg = runTmux prog--test_simple :: IO ()-test_simple =-  return ()-  -- result <- try runProg-  -- assertEqual True (isLeft (result :: Either TmuxError [String]))

@@ -1,12 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--module Main where--import {-@ HTF_TESTS @-} BufferedSpec-import {-@ HTF_TESTS @-} OutputParseSpec-import {-@ HTF_TESTS @-} CodecSpec-import Test.Framework-import Test.Framework.BlackBoxTest ()--main :: IO ()-main = htfMain htf_importedTests