packages feed

chiasma 0.1.0.0 → 0.12.2.0

raw patch · 116 files changed

Files

LICENSE view
@@ -1,30 +1,34 @@-Copyright Torsten Schmits (c) 2018+Copyright (c) 2022 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.
− README.md
@@ -1,3 +0,0 @@-# Intro--**chiasma** is a tmux api client for Haskell.
+ changelog.md view
@@ -0,0 +1,3 @@+# 0.10.1.0++* Convert to Polysemy
chiasma.cabal view
@@ -1,106 +1,195 @@-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.38.2. -- -- see: https://github.com/sol/hpack------ hash: 3809c3d5d4204b2ce3be054873e25b993f46159354efa61c45f34aa594ce9f29  name:           chiasma-version:        0.1.0.0-synopsis:       tmux api-description:    Please see the README on GitHub at <https://github.com/tek/chiasma-hs>+version:        0.12.2.0+synopsis:       A tmux client for Polysemy+description:    See https://hackage.haskell.org/package/chiasma/docs/Chiasma.html category:       Terminal-homepage:       https://github.com/tek/chiasma-hs#readme-bug-reports:    https://github.com/tek/chiasma-hs/issues+homepage:       https://github.com/tek/chiasma#readme+bug-reports:    https://github.com/tek/chiasma/issues author:         Torsten Schmits-maintainer:     tek@tryp.io-copyright:      2019 Torsten Schmits-license:        MIT+maintainer:     hackage@tryp.io+copyright:      2025 Torsten Schmits+license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple extra-source-files:-    README.md+    readme.md+    changelog.md  source-repository head   type: git-  location: https://github.com/tek/chiasma-hs+  location: https://github.com/tek/chiasma  library   exposed-modules:-      Chiasma.Api.Class+      Chiasma+      Chiasma.Class.CmdArgs       Chiasma.Codec+      Chiasma.Codec.Data+      Chiasma.Codec.Data.Client+      Chiasma.Codec.Data.Pane+      Chiasma.Codec.Data.PaneCoords+      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.Data.TmuxThunk-      Chiasma.Data.Window-      Chiasma.Monad.Buffered-      Chiasma.Monad.Simple-      Chiasma.Monad.Tmux-      Chiasma.Native.Api+      Chiasma.Command.Pane+      Chiasma.Command.Session+      Chiasma.Command.Window+      Chiasma.Control.IO.Unsafe+      Chiasma.Data.Axis+      Chiasma.Data.CapturePaneParams+      Chiasma.Data.Cmd+      Chiasma.Data.CodecError+      Chiasma.Data.CopyModeParams+      Chiasma.Data.DecodeError+      Chiasma.Data.Direction+      Chiasma.Data.Ident+      Chiasma.Data.KillPaneParams+      Chiasma.Data.LayoutError+      Chiasma.Data.List+      Chiasma.Data.Panes+      Chiasma.Data.PaneSelection+      Chiasma.Data.PipePaneParams+      Chiasma.Data.ProcessError+      Chiasma.Data.RenderError+      Chiasma.Data.ResizePaneParams+      Chiasma.Data.SelectParams+      Chiasma.Data.SelectWindowParams+      Chiasma.Data.SendKeysParams+      Chiasma.Data.SessionGroupId+      Chiasma.Data.SessionParams+      Chiasma.Data.SplitParams+      Chiasma.Data.Target+      Chiasma.Data.TmuxCommand+      Chiasma.Data.TmuxError+      Chiasma.Data.TmuxEvent+      Chiasma.Data.TmuxId+      Chiasma.Data.TmuxNative+      Chiasma.Data.TmuxNotification+      Chiasma.Data.TmuxOutputBlock+      Chiasma.Data.TmuxQuery+      Chiasma.Data.TmuxRequest+      Chiasma.Data.TmuxResponse+      Chiasma.Data.View+      Chiasma.Data.Views+      Chiasma.Data.WindowParams+      Chiasma.Data.WindowSelection+      Chiasma.Data.WindowState+      Chiasma.Data.WithPaneId+      Chiasma.Effect.Codec+      Chiasma.Effect.TmuxApi+      Chiasma.Effect.TmuxClient+      Chiasma.Function+      Chiasma.Interpreter.Codec+      Chiasma.Interpreter.ProcessOutput+      Chiasma.Interpreter.Pure+      Chiasma.Interpreter.TmuxApi+      Chiasma.Interpreter.TmuxClient+      Chiasma.Lens.Tree+      Chiasma.Lens.Where       Chiasma.Native.Parse-      Chiasma.Native.Process-      Chiasma.Test.File-      Chiasma.Test.Tmux-  other-modules:-      Paths_chiasma+      Chiasma.Native.TmuxOutputBlock+      Chiasma.Pack+      Chiasma.Pane+      Chiasma.Path+      Chiasma.Render+      Chiasma.Session+      Chiasma.Tmux+      Chiasma.TmuxApi+      Chiasma.TmuxNative+      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   hs-source-dirs:       lib-  default-extensions: ExistentialQuantification UnicodeSyntax TypeApplications ScopedTypeVariables DeriveGeneric DeriveAnyClass-  build-depends:-      base >=4.7 && <5-    , bytestring-    , data-default-class-    , directory-    , either-    , filepath-    , free-    , lens-    , mtl-    , parsec-    , posix-pty-    , process-    , resourcet-    , split-    , transformers-    , typed-process-    , unix-    , unliftio-  default-language: Haskell2010--test-suite chiasma-unit-  type: exitcode-stdio-1.0-  main-is: SpecMain.hs-  other-modules:-      BufferedSpec-      CodecSpec-      OutputParseSpec-      SimpleSpec-      Paths_chiasma-  hs-source-dirs:-      test/u-  default-extensions: ExistentialQuantification UnicodeSyntax TypeApplications ScopedTypeVariables DeriveGeneric DeriveAnyClass-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BlockArguments+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DuplicateRecordFields+      FunctionalDependencies+      GADTs+      LambdaCase+      LiberalTypeSynonyms+      MonadComprehensions+      MultiWayIf+      NoFieldSelectors+      OverloadedLabels+      OverloadedLists+      OverloadedRecordDot+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternSynonyms+      QuantifiedConstraints+      QuasiQuotes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      TemplateHaskell+      TypeFamilies+      TypeFamilyDependencies+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -fplugin=Polysemy.Plugin -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages   build-depends:-      HTF-    , base >=4.7 && <5+      attoparsec >=0.13+    , base ==4.*     , bytestring-    , chiasma-    , data-default-class-    , directory-    , either-    , filepath-    , free-    , lens-    , mtl+    , composition >=1.0+    , containers+    , exon+    , extra+    , first-class-families+    , lens >=4     , parsec-    , posix-pty-    , process-    , resourcet-    , split+    , parsers >=0.12+    , path+    , polysemy+    , polysemy-conc >=0.9+    , polysemy-log >=0.7+    , polysemy-plugin+    , polysemy-process >=0.9+    , polysemy-time >=0.5+    , prelate ==0.9.*+    , prettyprinter >=1.6+    , prettyprinter-ansi-terminal >=1.1+    , random >=1.1+    , text     , transformers-    , typed-process-    , unix-    , unliftio-  default-language: Haskell2010+    , typed-process >=0.2+    , uuid >=1.3+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: GHC2021
+ lib/Chiasma.hs view
@@ -0,0 +1,12 @@+module Chiasma (+  TmuxApi,+  Tmux,+  Codec,+  NativeCodec,+  NativeCodecE,+  NativeCommandCodec,+  NativeCommandCodecE,+) where++import Chiasma.Effect.Codec (Codec, NativeCodec, NativeCodecE, NativeCommandCodec, NativeCommandCodecE)+import Chiasma.Effect.TmuxApi (Tmux, TmuxApi)
− lib/Chiasma/Api/Class.hs
@@ -1,15 +0,0 @@-module Chiasma.Api.Class(-  TmuxApi(..),-  DecodeTmuxResponse(..),-) where--import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.Except (ExceptT)-import Chiasma.Codec.Decode (TmuxDecodeError)-import Chiasma.Data.TmuxThunk (Cmds, TmuxError)--class TmuxApi a where-  runCommands :: MonadIO m => a -> ([String] -> Either TmuxDecodeError b) -> Cmds -> ExceptT TmuxError m [b]--class DecodeTmuxResponse a where-  decode :: String -> Either TmuxError a
+ lib/Chiasma/Class/CmdArgs.hs view
@@ -0,0 +1,55 @@+module Chiasma.Class.CmdArgs where++import qualified Data.Map.Strict as Map+import Exon (exon)++import Chiasma.Data.Ident (Ident, identText)++class CmdArgs a where+  cmdArgs :: a -> [Text]++flag :: [Text] -> Bool -> [Text]+flag =+  bool []++flag1 :: Text -> Bool -> [Text]+flag1 =+  flag . pure++optionWith :: Text -> (a -> Text) -> Maybe a -> [Text]+optionWith flg f =+  foldMap \ a -> [flg, f a]++option :: Text -> Maybe Text -> [Text]+option flg =+  optionWith flg id++identOption :: Text -> Maybe Ident -> [Text]+identOption flg =+  optionWith flg identText++arg :: Maybe Text -> [Text]+arg =+  maybeToList++envVars :: Map Text Text -> [Text]+envVars =+  concatMap \case+    (k, v) -> ["-e", [exon|#{k}=#{v}|]]+  .+  Map.toList++optionArgs ::+  CmdArgs a =>+  Maybe a ->+  [Text]+optionArgs =+  foldMap cmdArgs++optionArgsWith ::+  CmdArgs a =>+  Text ->+  Maybe a ->+  [Text]+optionArgsWith flg =+  foldMap \ a -> flg : cmdArgs a
lib/Chiasma/Codec.hs view
@@ -1,32 +1,74 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE AllowAmbiguousTypes #-}+module Chiasma.Codec where -module Chiasma.Codec(-  TmuxCodec(..),-  TmuxQuery(..),-) where+import qualified Data.Text as Text+import GHC.Generics (Rep, to)+import Prelude hiding (to) -import GHC.Generics (Generic, Rep, to)-import Chiasma.Codec.Decode (TmuxDataDecode(..), TmuxDecodeError(TooManyFields))-import Chiasma.Codec.Query (TmuxDataQuery(..))+import Chiasma.Codec.Decode (TmuxDataDecode (..))+import Chiasma.Codec.Query (TmuxDataQuery (..))+import qualified Chiasma.Data.DecodeError as DecodeFailure (DecodeFailure (..))+import Chiasma.Data.DecodeError (DecodeError (DecodeError), DecodeFailure)+import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)+import Chiasma.Data.TmuxQuery (TmuxQuery (TmuxQuery)) -newtype TmuxQuery =-  TmuxQuery { unQ :: String }-  deriving (Eq, Show)+-- | Remove one leading and trailing space from tmux output if both are present.+tryTrim :: Text -> Maybe Text+tryTrim text = do+  (prefix, lastChar) <- Text.unsnoc text+  guard (lastChar == ' ')+  (firstChar, payload) <- Text.uncons prefix+  guard (firstChar == ' ')+  pure payload -genDecode :: (Generic a, TmuxDataDecode (Rep a)) => [String] -> Either TmuxDecodeError a+trim :: Text -> Text+trim text =+  fromMaybe text (tryTrim text)++checkRemainder :: ([Text], b) -> Either DecodeFailure b+checkRemainder = \case+  ([], result) -> Right result+  (a, _) -> Left (DecodeFailure.TooManyFields a)++genDecode ::+  Generic a =>+  TmuxDataDecode (Rep a) =>+  Text ->+  Either DecodeError a genDecode fields = do-  (rest, result) <- decode' fields-  case rest of-    [] -> return $ to result-    a -> Left $ TooManyFields a+  bimap (DecodeError [fields]) to do+    checkRemainder =<< dataDecode (Text.splitOn " " (trim fields))  class TmuxCodec a where-    decode :: [String] -> Either TmuxDecodeError a-    default decode :: (Generic a, TmuxDataDecode (Rep a)) => [String] -> Either TmuxDecodeError a-    decode = genDecode+  decode :: Text -> Either DecodeError a+  default decode ::+    Generic a =>+    TmuxDataDecode (Rep a) =>+    Text ->+    Either DecodeError a+  decode =+    genDecode -    query :: TmuxQuery-    default query :: (Generic a, TmuxDataQuery (Rep a)) => TmuxQuery-    query = TmuxQuery $ unwords $ query' @(Rep a)+  query :: TmuxQuery+  default query :: TmuxDataQuery (Rep a) => TmuxQuery+  query =+    TmuxQuery (Text.unwords (dataQuery @(Rep a)))++instance TmuxCodec SessionId+instance TmuxCodec WindowId+instance TmuxCodec PaneId++multi ::+  TmuxCodec a =>+  [Text] ->+  Either DecodeError [a]+multi =+  traverse decode++single ::+  TmuxCodec a =>+  [Text] ->+  Either DecodeError a+single = \case+  [out] -> decode out+  [] -> Left (DecodeError [] DecodeFailure.TargetMissing)+  out -> Left (DecodeError out (DecodeFailure.TooManyRecords out))
+ lib/Chiasma/Codec/Data.hs view
@@ -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(..))
+ lib/Chiasma/Codec/Data/Client.hs view
@@ -0,0 +1,13 @@+module Chiasma.Codec.Data.Client where++import Chiasma.Codec (TmuxCodec)+import Chiasma.Data.TmuxId (ClientId, SessionId)++data Client =+  Client {+    clientName :: ClientId,+    clientControlMode :: Bool,+    sessionId :: SessionId+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (TmuxCodec)
+ lib/Chiasma/Codec/Data/Pane.hs view
@@ -0,0 +1,19 @@+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,+    paneTop :: Int,+    paneLeft :: Int+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (TmuxCodec)++instance HasPaneId Pane where+  paneId = (.paneId)
+ lib/Chiasma/Codec/Data/PaneCoords.hs view
@@ -0,0 +1,17 @@+module Chiasma.Codec.Data.PaneCoords where++import Chiasma.Codec (TmuxCodec)+import Chiasma.Data.TmuxId (HasPaneId, PaneId, SessionId, WindowId)+import qualified Chiasma.Data.TmuxId as HasPaneId (HasPaneId (..))++data PaneCoords =+  PaneCoords {+    sessionId :: SessionId,+    windowId :: WindowId,+    paneId :: PaneId+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (TmuxCodec)++instance HasPaneId PaneCoords where+  paneId = (.paneId)
+ lib/Chiasma/Codec/Data/PaneMode.hs view
@@ -0,0 +1,16 @@+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 stock (Eq, Show, Generic)+  deriving anyclass (TmuxCodec)++instance HasPaneId PaneMode where+  paneId = (.paneId)
+ lib/Chiasma/Codec/Data/PanePid.hs view
@@ -0,0 +1,16 @@+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 stock (Eq, Show, Generic)+  deriving anyclass (TmuxCodec)++instance HasPaneId PanePid where+  paneId = (.paneId)
+ lib/Chiasma/Codec/Data/Session.hs view
@@ -0,0 +1,13 @@+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,+    sessionName :: Text+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (TmuxCodec)
+ lib/Chiasma/Codec/Data/Window.hs view
@@ -0,0 +1,13 @@+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 stock (Eq, Show, Generic)+  deriving anyclass (TmuxCodec)
lib/Chiasma/Codec/Decode.hs view
@@ -1,70 +1,91 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeOperators #-}+module Chiasma.Codec.Decode where -module Chiasma.Codec.Decode(-  TmuxDecodeError(..),-  TmuxPrimDecode(..),-  TmuxDataDecode(..),-  idParser,-  parseId,-  readInt,-) where+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 (digit, string)+import Text.ParserCombinators.Parsec (GenParser, many, parse) -import GHC.Generics ((:*:)(..), K1(..), M1(..))-import Data.Bifunctor (first, second)-import Text.Read (readEither)-import Text.ParserCombinators.Parsec (-  GenParser,-  ParseError,-  parse,-  many,+import Chiasma.Data.DecodeError (DecodeFailure (BoolParsingFailure, IntParsingFailure, ParseFailure, TooFewFields))+import Chiasma.Data.TmuxId (+  ClientId (ClientId),+  PaneId (..),+  SessionId (..),+  WindowId (..),+  panePrefix,+  sessionPrefix,+  windowPrefix,   )-import Text.Parsec.Char (char, digit) -data TmuxDecodeError =-  ParseFailure String ParseError-  |-  IntParsingFailure String-  |-  TooFewFields-  |-  TooManyFields [String]-  deriving (Eq, Show)- class TmuxPrimDecode a where-  primDecode :: String -> Either TmuxDecodeError a+  primDecode :: Text -> Either DecodeFailure a  class TmuxDataDecode f where-  decode' :: [String] -> Either TmuxDecodeError ([String], f a)+  dataDecode :: [Text] -> Either DecodeFailure ([Text], f a)  instance (TmuxDataDecode f, TmuxDataDecode g) => TmuxDataDecode (f :*: g) where-  decode' fields = do-    (rest, left) <- decode' fields-    (rest1, right) <- decode' rest-    return (rest1, left :*: right)+  dataDecode fields = do+    (rest, left) <- dataDecode fields+    (rest1, right) <- dataDecode rest+    pure (rest1, left :*: right)  instance TmuxDataDecode f => (TmuxDataDecode (M1 i c f)) where-  decode' fields =-    second M1 <$> decode' fields+  dataDecode fields =+    second M1 <$> dataDecode fields  instance TmuxPrimDecode a => (TmuxDataDecode (K1 c a)) where-  decode' (a:as) = do+  dataDecode (a:as') = do     prim <- primDecode a-    return (as, K1 prim)-  decode' [] = Left TooFewFields+    pure (as', K1 prim)+  dataDecode [] = Left TooFewFields -readInt :: String -> String -> Either TmuxDecodeError Int-readInt input num =-  first (const $ IntParsingFailure input) $ readEither num+readInt :: Text -> Text -> Either DecodeFailure Int+readInt text num =+  first (const $ IntParsingFailure text) 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-parseId cons sym input = do-  num <- first (ParseFailure "id") $ parse (idParser sym) "none" input-  i <- readInt input num-  return $ cons i+idParser :: Text -> GenParser Char st Text+idParser sym =+  string (toString sym) *> (toText <$> many digit)++parseId :: (Int -> a) -> Text -> Text -> Either DecodeFailure a+parseId cons sym text = do+  num <- first (ParseFailure "id") $ parse (idParser sym) "none" (Text.unpack text)+  i <- readInt text num+  pure (cons i)++instance TmuxPrimDecode ClientId where+  primDecode = pure . ClientId++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
lib/Chiasma/Codec/Query.hs view
@@ -1,39 +1,34 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--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+  dataQuery :: [Text]  instance TmuxDataQuery f => (TmuxDataQuery (D1 c f)) where-  query' = query' @f+  dataQuery = dataQuery @f  instance TmuxDataQuery f => (TmuxDataQuery (C1 c f)) where-  query' = query' @f+  dataQuery = dataQuery @f -trans :: Char -> String-trans a | isUpper a = ['_', toLower a]-trans a = [a]+instance (TmuxDataQuery f, TmuxDataQuery g) => TmuxDataQuery (f :*: g) where+  dataQuery = dataQuery @f <> dataQuery @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]+  dataQuery =+    [formatQuery (toText query)]     where       query = selName (undefined :: t s f p)
+ lib/Chiasma/Command/Pane.hs view
@@ -0,0 +1,158 @@+module Chiasma.Command.Pane where++import Prelude hiding (output)++import qualified Chiasma.Codec.Data.Pane as Codec (Pane)+import qualified Chiasma.Codec.Data.PaneMode as Codec (PaneMode (PaneMode))+import Chiasma.Data.Axis (Axis)+import Chiasma.Data.CapturePaneParams (CaptureOutput (Stdout), CapturePaneParams (..))+import qualified Chiasma.Data.CopyModeParams as CopyModeParams+import qualified Chiasma.Data.KillPaneParams as KillPaneParams+import qualified Chiasma.Data.PaneSelection as PaneSelection+import qualified Chiasma.Data.Panes as Panes+import Chiasma.Data.Panes (TmuxPanes)+import Chiasma.Data.PipePaneParams (PipePaneParams (..))+import Chiasma.Data.ResizePaneParams (ResizeAbsolute (ResizeAbsolute), ResizePaneParams (..))+import qualified Chiasma.Data.SelectParams as SelectParams+import qualified Chiasma.Data.SendKeysParams as SendKeysParams+import Chiasma.Data.SendKeysParams (Key, SendKeysParams (..))+import Chiasma.Data.SplitParams (JoinPaneParams (axis, detach, source, target))+import qualified Chiasma.Data.Target as Target+import Chiasma.Data.TmuxCommand (TmuxCommand (..))+import Chiasma.Data.TmuxId (PaneId, WindowId)+import Chiasma.Data.View (View (View))+import qualified Chiasma.Effect.TmuxApi as Tmux+import Chiasma.Effect.TmuxApi (Tmux)++panes ::+  Member (TmuxPanes a) r =>+  Sem r [a]+panes =+  Tmux.send (Panes.List PaneSelection.All)++pane ::+  Member (TmuxPanes a) r =>+  PaneId ->+  Sem r (Maybe a)+pane paneId =+  Tmux.send (Panes.Find paneId)++windowPanes ::+  Member (TmuxPanes a) r =>+  WindowId ->+  Sem r [a]+windowPanes windowId =+  Tmux.send (Panes.List (PaneSelection.InWindow (Target.Window windowId)))++firstWindowPane ::+  Member (TmuxPanes a) r =>+  WindowId ->+  Sem r a+firstWindowPane windowId =+  Tmux.send (Panes.First (PaneSelection.InWindow (Target.Window windowId)))++closePane ::+  Member Tmux r =>+  PaneId ->+  Sem r ()+closePane paneId =+  Tmux.send (KillPane def { KillPaneParams.target = Target.Pane paneId })++isPaneIdOpen ::+  Member (TmuxPanes Codec.Pane) r =>+  PaneId ->+  Sem r Bool+isPaneIdOpen paneId =+  isJust <$> pane paneId++isPaneOpen ::+  Member (TmuxPanes Codec.Pane) r =>+  View PaneId ->+  Sem r Bool+isPaneOpen (View _ (Just paneId)) =+  isPaneIdOpen paneId+isPaneOpen _ =+  pure False++movePane ::+  Member Tmux r =>+  PaneId ->+  PaneId ->+  Axis ->+  Sem r ()+movePane paneId refId axis =+  Tmux.send (MovePane def {+    detach = True,+    source = Just (Target.Pane paneId),+    target = Target.Pane refId,+    axis = Just axis+  })++resizePane ::+  Member Tmux r =>+  PaneId ->+  Axis ->+  Int ->+  Sem r ()+resizePane paneId axis size =+  Tmux.send (ResizePane def {+    target = Target.Pane paneId,+    absolute = Just (ResizeAbsolute axis size)+  })++sendKeys ::+  Member Tmux r =>+  PaneId ->+  [Key] ->+  Sem r ()+sendKeys paneId lines' =+  for_ lines' \ line ->+    Tmux.send (SendKeys def { target = Target.Pane paneId, keys = [line] })++pipePane ::+  Member Tmux r =>+  PaneId ->+  Text ->+  Sem r ()+pipePane paneId cmd =+  Tmux.schedule (PipePane def { target = Target.Pane paneId, command = Just cmd })++capturePane ::+  Member Tmux r =>+  PaneId ->+  Sem r [Text]+capturePane paneId =+  Tmux.send (CapturePane def { target = Target.Pane paneId, escapeSequences = True, output = Just Stdout})++selectPane ::+  Member Tmux r =>+  PaneId ->+  Sem r ()+selectPane paneId =+  Tmux.send (SelectPane def { SelectParams.target = Target.Pane paneId })++copyMode ::+  Member Tmux r =>+  PaneId ->+  Sem r ()+copyMode paneId =+  Tmux.send (CopyMode def { CopyModeParams.target = Target.Pane paneId })++paneMode ::+  Member (TmuxPanes Codec.PaneMode) r =>+  PaneId ->+  Sem r (Maybe Codec.PaneMode)+paneMode =+  pane++quitCopyMode ::+  Member Tmux r =>+  Member (TmuxPanes Codec.PaneMode) r =>+  PaneId ->+  Sem r ()+quitCopyMode paneId =+  traverse_ check =<< pane paneId+  where+    check (Codec.PaneMode _ mode) =+      when (mode == "copy-mode") do+        Tmux.send (SendKeys def { target = Target.Pane paneId, SendKeysParams.copyMode = True, keys = ["cancel"] })
+ lib/Chiasma/Command/Session.hs view
@@ -0,0 +1,61 @@+module Chiasma.Command.Session where++import Chiasma.Codec.Data.Client (Client (Client))+import Chiasma.Codec.Data.Session (Session (Session))+import Chiasma.Data.Ident (Ident)+import Chiasma.Data.SessionParams (SessionParams (..))+import qualified Chiasma.Data.Target as Target+import Chiasma.Data.TmuxCommand (TmuxCommand (ListClients, ListSessions, NewSession, SwitchClient))+import Chiasma.Data.TmuxError (TmuxError (NoClients))+import Chiasma.Data.TmuxId (SessionId)+import qualified Chiasma.Effect.TmuxApi as Tmux+import Chiasma.Effect.TmuxApi (Tmux)++sameId :: SessionId -> Session -> Bool+sameId target (Session i _) = target == i++sessions ::+  Member Tmux r =>+  Sem r [Session]+sessions =+  Tmux.send ListSessions++doesSessionExist ::+  Member Tmux r =>+  SessionId ->+  Sem r Bool+doesSessionExist sessionId =+  any (sameId sessionId) <$> sessions++existingSessionId ::+  Member Tmux r =>+  SessionId ->+  Sem r (Maybe SessionId)+existingSessionId sessionId = do+  exists <- doesSessionExist sessionId+  pure $ if exists then Just sessionId else Nothing++newSession ::+  Member Tmux r =>+  Ident ->+  Sem r Session+newSession name =+  Tmux.send (NewSession def { name = Just name })++clientForSession :: SessionId -> [Client] -> Maybe Client+clientForSession session =+  find \case+    Client _ False sid ->+      sid == session+    _ ->+      False++switchClient ::+  Members [Tmux, Stop TmuxError] r =>+  SessionId ->+  SessionId ->+  Sem r ()+switchClient clientSession session = do+  clients <- Tmux.send ListClients+  Client client _ _ <- stopNote NoClients (clientForSession clientSession clients)+  Tmux.send (SwitchClient client (Target.Session session))
+ lib/Chiasma/Command/Window.hs view
@@ -0,0 +1,79 @@+module Chiasma.Command.Window where++import Exon (exon)+import Path (Abs, Dir, Path)++import Chiasma.Codec.Data.Pane (Pane)+import Chiasma.Codec.Data.Window (Window (Window))+import Chiasma.Data.Ident (Ident)+import Chiasma.Data.LayoutError (LayoutError (LayoutError))+import qualified Chiasma.Data.Target as Target+import Chiasma.Data.TmuxCommand (TmuxCommand (ListWindows, NewWindow, SplitWindow))+import Chiasma.Data.TmuxId (SessionId, WindowId)+import Chiasma.Data.WindowParams (WindowParams (..))+import qualified Chiasma.Data.WindowSelection as WindowSelection+import qualified Chiasma.Effect.TmuxApi as Tmux+import Chiasma.Effect.TmuxApi (Tmux)++sameId :: WindowId -> Window -> Bool+sameId target (Window i _ _) = target == i++windows ::+  Member Tmux r =>+  Sem r [Window]+windows =+  Tmux.send (ListWindows WindowSelection.All)++window ::+  Member Tmux r =>+  WindowId ->+  Sem r (Maybe Window)+window windowId =+  find (sameId windowId) <$> windows++sessionWindows ::+  Member Tmux r =>+  SessionId ->+  Sem r [Window]+sessionWindows sid =+  Tmux.send (ListWindows (WindowSelection.InSession (Target.Session sid)))++-- TODO this could be ListWindow+newSessionWindow ::+  Members [Tmux, Stop LayoutError] r =>+  SessionId ->+  Sem r Window+newSessionWindow sid =+  sessionWindows sid >>= \case+    [w] -> pure w+    ws -> stop (LayoutError [exon|New session contains multiple windows: #{show ws}|])++doesWindowExist ::+  Member Tmux r =>+  WindowId ->+  Sem r Bool+doesWindowExist windowId =+  any (sameId windowId) <$> windows++newWindow ::+  Member Tmux r =>+  SessionId ->+  Ident ->+  Sem r Window+newWindow sid name =+  Tmux.send (NewWindow def { target = Target.Session sid, name = Just name })++splitWindowInDir ::+  Member Tmux r =>+  Path Abs Dir ->+  WindowId ->+  Sem r Pane+splitWindowInDir dir windowId =+  Tmux.send (SplitWindow def { target = Target.Window windowId, detach = True, cwd = Just dir } def)++splitWindow ::+  Member Tmux r =>+  WindowId ->+  Sem r Pane+splitWindow windowId =+  Tmux.send (SplitWindow def { target = Target.Window windowId, detach = True } def)
+ lib/Chiasma/Control/IO/Unsafe.hs view
@@ -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 >> pure b
+ lib/Chiasma/Data/Axis.hs view
@@ -0,0 +1,31 @@+module Chiasma.Data.Axis where++import Data.Data (Data)+import Prettyprinter (Pretty (pretty))++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs))++data Axis =+  Horizontal+  |+  Vertical+  deriving stock (Eq, Show, Data)++instance Pretty Axis where+  pretty = \case+    Horizontal -> "h"+    Vertical -> "v"++instance CmdArgs Axis where+  cmdArgs = \case+    Horizontal -> ["-h"]+    Vertical -> ["-v"]++instance Default Axis where+  def =+    Vertical++vertical :: Axis -> Bool+vertical = \case+  Horizontal -> False+  Vertical -> True
+ lib/Chiasma/Data/CapturePaneParams.hs view
@@ -0,0 +1,84 @@+module Chiasma.Data.CapturePaneParams where++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), flag1, optionArgs, optionArgsWith)+import qualified Chiasma.Data.Target as Target+import Chiasma.Data.Target (Target)+import Prelude hiding (output)++data CaptureOutput =+  Stdout+  |+  Buffer Text+  deriving stock (Eq, Show)++instance CmdArgs CaptureOutput where+  cmdArgs = \case+    Stdout -> ["-p"]+    Buffer name -> ["-b", name]++data CaptureLine =+  Edge+  |+  CaptureLine Int+  deriving stock (Eq, Show)++instance CmdArgs CaptureLine where+  cmdArgs = \case+    Edge -> ["-"]+    CaptureLine n -> [show n]++data CapturePaneParams =+  CapturePaneParams {+    output :: Maybe CaptureOutput,+    alternate :: Bool,+    quiet :: Bool,+    escapeSequences :: Bool,+    octal :: Bool,+    joinWrapped :: Bool,+    incomplete :: Bool,+    startLine :: Maybe CaptureLine,+    endLine :: Maybe CaptureLine,+    target :: Target,+    stripBlank :: Bool,+    stripTrailingWs :: Bool+  }+  deriving stock (Eq, Show)++instance Default CapturePaneParams where+  def =+    CapturePaneParams {+      output = Nothing,+      alternate = False,+      quiet = False,+      escapeSequences = False,+      octal = False,+      joinWrapped = True,+      incomplete = False,+      startLine = Nothing,+      endLine = Nothing,+      target = Target.Current,+      stripBlank = True,+      stripTrailingWs = True+    }++instance CmdArgs CapturePaneParams where+  cmdArgs CapturePaneParams {..} =+    flag1 "-a" alternate+    <>+    flag1 "-q" quiet+    <>+    flag1 "-e" escapeSequences+    <>+    flag1 "-C" octal+    <>+    flag1 "-J" joinWrapped+    <>+    flag1 "-P" incomplete+    <>+    optionArgs output+    <>+    optionArgsWith "-S" startLine+    <>+    optionArgsWith "-E" endLine+    <>+    cmdArgs target
+ lib/Chiasma/Data/Cmd.hs view
@@ -0,0 +1,26 @@+module Chiasma.Data.Cmd(+  CmdName(..),+  CmdArgs(..),+  Cmd(..),+  Cmds(..),+  cmd,+) where++newtype CmdName =+  CmdName Text+  deriving stock (Eq, Show)++newtype CmdArgs =+  CmdArgs [Text]+  deriving stock (Eq, Show)++data Cmd =+  Cmd CmdName CmdArgs+  deriving stock (Eq, Show)++newtype Cmds =+  Cmds [Cmd]+  deriving stock (Eq, Show)++cmd :: Text -> [Text] -> Cmd+cmd name args = Cmd (CmdName name) (CmdArgs args)
+ lib/Chiasma/Data/CodecError.hs view
@@ -0,0 +1,8 @@+module Chiasma.Data.CodecError where++import Chiasma.Data.DecodeError (DecodeError)+import Chiasma.Data.TmuxRequest (TmuxRequest)++data CodecError =+  CodecError TmuxRequest DecodeError+  deriving stock (Eq, Show)
+ lib/Chiasma/Data/CopyModeParams.hs view
@@ -0,0 +1,32 @@+module Chiasma.Data.CopyModeParams where++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), flag1)+import Chiasma.Data.Target (Target)++data CopyModeParams =+  CopyModeParams {+    mouseDrag :: Bool,+    scrollUp :: Bool,+    exitBottom :: Bool,+    target :: Target+  }+  deriving stock (Eq, Show)++instance Default CopyModeParams where+  def =+    CopyModeParams {+      mouseDrag = False,+      scrollUp = False,+      exitBottom = False,+      target = def+    }++instance CmdArgs CopyModeParams where+  cmdArgs CopyModeParams {..} =+    flag1 "-M" mouseDrag+    <>+    flag1 "-u" scrollUp+    <>+    flag1 "-e" exitBottom+    <>+    cmdArgs target
+ lib/Chiasma/Data/DecodeError.hs view
@@ -0,0 +1,26 @@+module Chiasma.Data.DecodeError where++import Text.ParserCombinators.Parsec (ParseError)++data DecodeFailure =+  ParseFailure Text ParseError+  |+  IntParsingFailure Text+  |+  BoolParsingFailure Text+  |+  TooFewFields+  |+  TooManyFields [Text]+  |+  TooManyRecords [Text]+  |+  TargetMissing+  deriving stock (Eq, Show)++data DecodeError =+  DecodeError {+    output :: [Text],+    failure :: DecodeFailure+  }+  deriving stock (Eq, Show)
+ lib/Chiasma/Data/Direction.hs view
@@ -0,0 +1,22 @@+module Chiasma.Data.Direction where++import Prelude hiding (Down, Left, Right)++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs))++data Direction =+  Up+  |+  Down+  |+  Left+  |+  Right+  deriving stock (Eq, Show)++instance CmdArgs Direction where+  cmdArgs = \case+    Up -> ["-U"]+    Down -> ["-D"]+    Left -> ["-L"]+    Right -> ["-R"]
+ lib/Chiasma/Data/Ident.hs view
@@ -0,0 +1,55 @@+module Chiasma.Data.Ident where++import Data.Data (Data)+import Data.UUID (UUID)+import qualified Data.UUID as UUID (fromText, toText)+import Prettyprinter (Pretty (..))+import System.Random (randomIO)++data Ident =+  Str Text+  |+  Uuid UUID+  deriving stock (Eq, Show, Ord, Generic, Data)++json ''Ident++class Identifiable a where+  identify :: a -> Ident++instance Identifiable Ident where+  identify = id++instance Pretty Ident where+  pretty =+    pretty . \case+      Str s -> s+      Uuid u -> UUID.toText u++instance Default Ident where+  def =+    Str ""++instance IsString Ident where+  fromString =+    Str . toText++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)
+ lib/Chiasma/Data/KillPaneParams.hs view
@@ -0,0 +1,24 @@+module Chiasma.Data.KillPaneParams where++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), flag1)+import Chiasma.Data.Target (Target)++data KillPaneParams =+  KillPaneParams {+    allbut :: Bool,+    target :: Target+  }+  deriving stock (Eq, Show)++instance Default KillPaneParams where+  def =+    KillPaneParams {+      allbut = False,+      target = def+    }++instance CmdArgs KillPaneParams where+  cmdArgs KillPaneParams {..} =+    flag1 "-a" allbut+    <>+    cmdArgs target
+ lib/Chiasma/Data/LayoutError.hs view
@@ -0,0 +1,6 @@+module Chiasma.Data.LayoutError where++newtype LayoutError =+  LayoutError { unLayoutError :: Text }+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString)
+ lib/Chiasma/Data/List.hs view
@@ -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
− lib/Chiasma/Data/Pane.hs
@@ -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)
+ lib/Chiasma/Data/PaneSelection.hs view
@@ -0,0 +1,22 @@+module Chiasma.Data.PaneSelection where++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs))+import Chiasma.Data.Target (Target (Current))++data PaneSelection =+  All+  |+  InSession Target+  |+  InWindow Target+  deriving stock (Eq, Show)++instance CmdArgs PaneSelection where+  cmdArgs = \case+    All -> ["-a"]+    InSession target -> ["-s"] <> cmdArgs target+    InWindow target -> cmdArgs target++instance Default PaneSelection where+  def =+    InWindow Current
+ lib/Chiasma/Data/Panes.hs view
@@ -0,0 +1,105 @@+module Chiasma.Data.Panes where++import Chiasma.Class.CmdArgs (cmdArgs)+import qualified Chiasma.Codec as Codec+import Chiasma.Codec (TmuxCodec, multi, single)+import qualified Chiasma.Data.DecodeError as DecodeFailure+import Chiasma.Data.DecodeError (DecodeError (DecodeError))+import qualified Chiasma.Data.PaneSelection as PaneSelection+import Chiasma.Data.PaneSelection (PaneSelection)+import qualified Chiasma.Data.Target as Target+import Chiasma.Data.TmuxId (PaneId)+import Chiasma.Data.TmuxQuery (TmuxQuery)+import Chiasma.Data.TmuxRequest (TmuxRequest (TmuxRequest))+import Chiasma.Data.TmuxResponse (TmuxResponse (TmuxResponse))+import Chiasma.Data.WithPaneId (WithPaneId (WithPaneId))+import Chiasma.Effect.TmuxApi (TmuxApi)++-- | A 'TmuxApi' command for listing panes, with different query criteria.+-- The constructors taking a 'PaneSelection' list all panes that are present in the selected scope, but may constrain+-- the return value.+-- The constructors 'Get' and 'Find' return only the pane with the requested ID.+data Panes (p :: Type) (a :: Type) :: Type where+  -- | Return all panes covered by the selection.+  List :: PaneSelection -> Panes p [p]+  -- | Return one pane covered by the selection, fail if there is none.+  First :: PaneSelection -> Panes p p+  -- | Return one pane covered by the selection, fail if there is none or more than one.+  One :: PaneSelection -> Panes p p+  -- | Return the pane with the specified ID, fail if there is none.+  Get :: PaneId -> Panes p p+  -- | Return the pane with the specified ID if it exists.+  Find :: PaneId -> Panes p (Maybe p)++type TmuxPanes p =+  TmuxApi (Panes p)++query ::+  ∀ p a .+  TmuxCodec p =>+  Panes p a ->+  TmuxQuery+query _ =+  Codec.query @p++selection :: Panes p a -> PaneSelection+selection = \case+  List ps -> ps+  First ps -> ps+  One ps -> ps+  Get i -> PaneSelection.InWindow (Target.Pane i)+  Find _ -> PaneSelection.All++request ::+  Panes p a ->+  TmuxQuery ->+  TmuxRequest+request (selection -> s) =+  TmuxRequest "list-panes" (cmdArgs s) . Just++encode ::+  ∀ p a .+  TmuxCodec p =>+  Panes p a ->+  TmuxRequest+encode (Get i) =+  request (Get i) (Codec.query @(WithPaneId p))+encode (Find i) =+  request (Find i) (Codec.query @(WithPaneId p))+encode cmd =+  request cmd (query cmd)++sameId :: PaneId -> WithPaneId a -> Maybe a+sameId target (WithPaneId paneId p)+  | target == paneId = Just p+  | otherwise = Nothing++paneById ::+  TmuxCodec p =>+  PaneId ->+  [Text] ->+  Either DecodeError (Maybe p)+paneById paneId out = do+  firstJust (sameId paneId) <$> multi out++decode ::+  ∀ p a .+  TmuxCodec p =>+  TmuxResponse ->+  Panes p a ->+  Either DecodeError a+decode (TmuxResponse out) = \case+  List _ ->+    multi out+  First _ ->+    multi out >>= \case+      [] -> Left (DecodeError out DecodeFailure.TooFewFields)+      a : _ -> Right a+  One _ ->+    single out+  Get paneId -> do+    ps <- multi @(WithPaneId p) out+    maybeToRight (DecodeError out DecodeFailure.TargetMissing) (firstJust (sameId paneId) ps)+  Find paneId -> do+    ps <- multi @(WithPaneId p) out+    pure (firstJust (sameId paneId) ps)
+ lib/Chiasma/Data/PipePaneParams.hs view
@@ -0,0 +1,38 @@+module Chiasma.Data.PipePaneParams where++import Prelude hiding (input, output)++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), arg, flag1)+import Chiasma.Data.Target (Target (Current))++data PipePaneParams =+  PipePaneParams {+    input :: Bool,+    output :: Bool,+    onlyNew :: Bool,+    target :: Target,+    command :: Maybe Text+  }+  deriving stock (Eq, Show)++instance Default PipePaneParams where+  def =+    PipePaneParams {+      input = False,+      output = False,+      onlyNew = False,+      target = Current,+      command = Nothing+    }++instance CmdArgs PipePaneParams where+  cmdArgs PipePaneParams {..} =+    flag1 "-I" input+    <>+    flag1 "-O" output+    <>+    flag1 "-o" onlyNew+    <>+    cmdArgs target+    <>+    arg command
+ lib/Chiasma/Data/ProcessError.hs view
@@ -0,0 +1,5 @@+module Chiasma.Data.ProcessError where++data ProcessError =+  Terminated Text+  deriving stock (Eq, Show)
+ lib/Chiasma/Data/RenderError.hs view
@@ -0,0 +1,21 @@+module Chiasma.Data.RenderError where++import Chiasma.Data.CodecError (CodecError)+import Chiasma.Data.Ident (Ident)+import Chiasma.Data.LayoutError (LayoutError)+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.Views (ViewsError)++data RenderError =+  NoPrincipal Ident+  |+  Views ViewsError+  |+  Layout LayoutError+  |+  Pack Text+  |+  Fatal TmuxError+  |+  Codec CodecError+  deriving stock (Eq, Show)
+ lib/Chiasma/Data/ResizePaneParams.hs view
@@ -0,0 +1,58 @@+module Chiasma.Data.ResizePaneParams where++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), arg, flag1, optionArgs)+import Chiasma.Data.Axis (Axis (Horizontal, Vertical))+import Chiasma.Data.Direction (Direction)+import Chiasma.Data.Target (Target (Current))++data ResizeAbsolute =+  ResizeAbsolute Axis Int+  deriving stock (Eq, Show)++instance CmdArgs ResizeAbsolute where+  cmdArgs (ResizeAbsolute axis amount) =+    [axisArg axis, show amount]+    where+      axisArg = \case+        Horizontal -> "-x"+        Vertical -> "-y"++data Adjustment =+  Adjustment (Maybe Direction) (Maybe Int)+  deriving stock (Eq, Show)++instance CmdArgs Adjustment where+  cmdArgs (Adjustment dir amount) =+    optionArgs dir <> arg (show <$> amount)++data ResizePaneParams =+  ResizePaneParams {+    absolute :: Maybe ResizeAbsolute,+    adjustment :: Maybe Adjustment,+    zoom :: Bool,+    mouse :: Bool,+    target :: Target+  }+  deriving stock (Eq, Show)++instance Default ResizePaneParams where+  def =+    ResizePaneParams {+      absolute = Nothing,+      adjustment = Nothing,+      zoom = False,+      mouse = False,+      target = Current+    }++instance CmdArgs ResizePaneParams where+  cmdArgs ResizePaneParams {..} =+    optionArgs absolute+    <>+    flag1 "-Z" zoom+    <>+    flag1 "-M" mouse+    <>+    optionArgs adjustment+    <>+    cmdArgs target
+ lib/Chiasma/Data/SelectParams.hs view
@@ -0,0 +1,65 @@+module Chiasma.Data.SelectParams where++import Prelude hiding (input, last)++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), flag1, option, optionArgs)+import Chiasma.Data.Direction (Direction)+import Chiasma.Data.Target (Target)++data SelectInput =+  EnableInput+  |+  DisableInput+  deriving stock (Eq, Show)++instance CmdArgs SelectInput where+  cmdArgs = \case+    EnableInput -> ["-e"]+    DisableInput -> ["-d"]++data SelectMark =+  SelectMark+  |+  SelectUnmark+  deriving stock (Eq, Show)++instance CmdArgs SelectMark where+  cmdArgs = \case+    SelectMark -> ["-m"]+    SelectUnmark -> ["-M"]++data SelectParams =+  SelectParams {+    neighbor :: Maybe Direction,+    last :: Bool,+    input :: Maybe SelectInput,+    mark :: Maybe SelectMark,+    title :: Maybe Text,+    target :: Target+  }+  deriving stock (Eq, Show)++instance Default SelectParams where+  def =+    SelectParams {+      neighbor = Nothing,+      last = False,+      input = Nothing,+      mark = Nothing,+      title = Nothing,+      target = def+    }++instance CmdArgs SelectParams where+  cmdArgs SelectParams {..} =+    optionArgs neighbor+    <>+    flag1 "-l" last+    <>+    optionArgs input+    <>+    optionArgs mark+    <>+    option "-T" title+    <>+    cmdArgs target
+ lib/Chiasma/Data/SelectWindowParams.hs view
@@ -0,0 +1,38 @@+module Chiasma.Data.SelectWindowParams where++import Prelude hiding (last)++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), flag1)+import Chiasma.Data.Target (Target)++data SelectWindowParams =+  SelectWindowParams {+    last :: Bool,+    next :: Bool,+    previous :: Bool,+    toggle :: Bool,+    target :: Target+  }+  deriving stock (Eq, Show)++instance Default SelectWindowParams where+  def =+    SelectWindowParams {+      last = False,+      next = False,+      previous = False,+      toggle = False,+      target = def+    }++instance CmdArgs SelectWindowParams where+  cmdArgs SelectWindowParams {..} =+    flag1 "-l" last+    <>+    flag1 "-n" next+    <>+    flag1 "-p" previous+    <>+    flag1 "-T" toggle+    <>+    cmdArgs target
+ lib/Chiasma/Data/SendKeysParams.hs view
@@ -0,0 +1,78 @@+module Chiasma.Data.SendKeysParams where++import qualified Data.Text as Text+import Exon (exon)+import Prelude hiding (repeat)++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), flag1, optionWith)+import Chiasma.Data.Target (Target)++escape :: Text -> Text+escape fragment =+  [exon|"#{escapeQuotes}"|]+  where+    escapeQuotes =+      Text.replace [exon|"|] [exon|\"|] fragment++data Key =+  Key Text+  |+  Lit Text+  deriving stock (Eq, Show)++instance IsString Key where+  fromString =+    Lit . toText++instance CmdArgs Key where+  cmdArgs = \case+    Key k -> [k]+    Lit s -> [escape s]++data SendKeysParams =+  SendKeysParams {+    enter :: Bool,+    literal :: Bool,+    hex :: Bool,+    reset :: Bool,+    mouse :: Bool,+    copyMode :: Bool,+    repeat :: Maybe Int,+    keys :: [Key],+    target :: Target+  }+  deriving stock (Eq, Show)++instance Default SendKeysParams where+  def =+    SendKeysParams {+      enter = True,+      literal = False,+      hex = False,+      reset = False,+      mouse = False,+      copyMode = False,+      repeat = Nothing,+      keys = mempty,+      target = def+    }++instance CmdArgs SendKeysParams where+  cmdArgs SendKeysParams {..} =+    flag1 "-l" literal+    <>+    flag1 "-H" hex+    <>+    flag1 "-R" reset+    <>+    flag1 "-M" mouse+    <>+    flag1 "-X" copyMode+    <>+    optionWith "-N" show repeat+    <>+    cmdArgs target+    <>+    (cmdArgs =<< keys)+    <>+    flag1 "enter" (enter && not copyMode)
+ lib/Chiasma/Data/SessionGroupId.hs view
@@ -0,0 +1,6 @@+module Chiasma.Data.SessionGroupId where++newtype SessionGroupId =+  SessionGroupId { unSessionGroupId :: Text }+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString)
+ lib/Chiasma/Data/SessionParams.hs view
@@ -0,0 +1,72 @@+module Chiasma.Data.SessionParams where++import Path (Abs, Dir, Path)++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), arg, envVars, flag1, identOption, optionWith)+import Chiasma.Data.Ident (Ident)+import Chiasma.Data.SessionGroupId (SessionGroupId (unSessionGroupId))+import Chiasma.Path (pathText)++data SessionParams =+  SessionParams {+    attach :: Bool,+    defaultSize :: Bool,+    detach :: Bool,+    exitClient :: Bool,+    printInfo :: Bool,+    cwd :: Maybe (Path Abs Dir),+    environment :: Map Text Text,+    name :: Maybe Ident,+    windowName :: Maybe Ident,+    target :: Maybe SessionGroupId,+    width :: Maybe Int,+    height :: Maybe Int,+    command :: Maybe Text+  }+  deriving stock (Eq, Show)++instance Default SessionParams where+  def =+    SessionParams {+      attach = False,+      defaultSize = False,+      detach = False,+      exitClient = False,+      printInfo = True,+      cwd = Nothing,+      environment = mempty,+      name = Nothing,+      windowName = Nothing,+      target = Nothing,+      width = Nothing,+      height = Nothing,+      command = Nothing+    }++instance CmdArgs SessionParams where+  cmdArgs SessionParams {..} =+    flag1 "-A" attach+    <>+    flag1 "-d" defaultSize+    <>+    flag1 "-D" detach+    <>+    envVars environment+    <>+    flag1 "-P" printInfo+    <>+    flag1 "-X" exitClient+    <>+    optionWith "-c" pathText cwd+    <>+    identOption "-n" windowName+    <>+    identOption "-s" name+    <>+    optionWith "-t" (.unSessionGroupId) target+    <>+    optionWith "-x" show width+    <>+    optionWith "-y" show height+    <>+    arg command
+ lib/Chiasma/Data/SplitParams.hs view
@@ -0,0 +1,84 @@+module Chiasma.Data.SplitParams where++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), flag1, optionArgs)+import Chiasma.Data.Axis (Axis)+import Chiasma.Data.Target (Target (Current), formatTarget)++data SplitSize =+  Units Int+  |+  Percentage Int+  deriving stock (Eq, Show)++instance CmdArgs SplitSize where+  cmdArgs = \case+    Units n -> ["-l", show n]+    Percentage n -> ["-p", show n]++data SplitWindowParams =+  SplitWindowParams {+    axis :: Maybe Axis,+    size :: Maybe SplitSize,+    before :: Bool,+    fullSize :: Bool,+    readStdin :: Bool+  }+  deriving stock (Eq, Show)++instance Default SplitWindowParams where+  def =+    SplitWindowParams {+      axis = Nothing,+      size = Nothing,+      before = False,+      fullSize = False,+      readStdin = False+    }++instance CmdArgs SplitWindowParams where+  cmdArgs SplitWindowParams {..} =+    optionArgs axis+    <>+    optionArgs size+    <>+    flag1 "-b" before+    <>+    flag1 "-f" fullSize+    <>+    flag1 "-K" readStdin++data JoinPaneParams =+  JoinPaneParams {+    axis :: Maybe Axis,+    size :: Maybe SplitSize,+    before :: Bool,+    detach :: Bool,+    source :: Maybe Target,+    target :: Target+  }+  deriving stock (Eq, Show)++instance Default JoinPaneParams where+  def =+    JoinPaneParams {+      axis = Nothing,+      size = Nothing,+      before = False,+      detach = False,+      source = Nothing,+      target = Current+    }++instance CmdArgs JoinPaneParams where+  cmdArgs JoinPaneParams {..} =+    optionArgs axis+    <>+    optionArgs size+    <>+    flag1 "-b" before+    <>+    flag1 "-d" detach+    <>+    foldMap (formatTarget ["-s"]) source+    <>+    cmdArgs target
+ lib/Chiasma/Data/Target.hs view
@@ -0,0 +1,32 @@+module Chiasma.Data.Target where++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs))+import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId, formatId)++data Target =+  Pane PaneId+  |+  Window WindowId+  |+  Session SessionId+  |+  Current+  deriving stock (Eq, Show)++formatTarget :: [Text] -> Target -> [Text]+formatTarget pre = \case+    Pane i -> pre <> [formatId i]+    Window i -> pre <> [formatId i]+    Session i -> pre <> [formatId i]+    Current -> []++instance CmdArgs Target where+  cmdArgs = \case+    Pane i -> ["-t", formatId i]+    Window i -> ["-t", formatId i]+    Session i -> ["-t", formatId i]+    Current -> []++instance Default Target where+  def =+    Current
+ lib/Chiasma/Data/TmuxCommand.hs view
@@ -0,0 +1,213 @@+module Chiasma.Data.TmuxCommand where++import Data.List (dropWhileEnd)+import qualified Data.Text as Text+import Exon (exon)+import Text.Show (shows)++import Chiasma.Class.CmdArgs (cmdArgs)+import qualified Chiasma.Codec as Codec+import Chiasma.Codec (multi, single)+import Chiasma.Codec.Data.Client (Client)+import Chiasma.Codec.Data.Pane (Pane)+import Chiasma.Codec.Data.Session (Session)+import Chiasma.Codec.Data.Window (Window)+import Chiasma.Data.CapturePaneParams (CapturePaneParams (..))+import Chiasma.Data.CopyModeParams (CopyModeParams)+import Chiasma.Data.DecodeError (DecodeError)+import Chiasma.Data.KillPaneParams (KillPaneParams)+import Chiasma.Data.PaneSelection (PaneSelection)+import Chiasma.Data.PipePaneParams (PipePaneParams)+import Chiasma.Data.ResizePaneParams (ResizePaneParams)+import Chiasma.Data.SelectParams (SelectParams)+import Chiasma.Data.SelectWindowParams (SelectWindowParams)+import Chiasma.Data.SendKeysParams (SendKeysParams)+import Chiasma.Data.SessionParams (SessionParams)+import Chiasma.Data.SplitParams (JoinPaneParams, SplitWindowParams)+import Chiasma.Data.Target (Target)+import Chiasma.Data.TmuxId (ClientId (ClientId))+import Chiasma.Data.TmuxQuery (TmuxQuery)+import Chiasma.Data.TmuxRequest (TmuxRequest (TmuxRequest))+import Chiasma.Data.TmuxResponse (TmuxResponse (TmuxResponse))+import Chiasma.Data.WindowParams (WindowParams)+import Chiasma.Data.WindowSelection (WindowSelection)+import Chiasma.Function (applyWhen)++data TmuxCommand :: Type -> Type where+  Fmap :: (a -> b) -> TmuxCommand a -> TmuxCommand b+  ListPanes :: PaneSelection -> TmuxCommand [Pane]+  ListWindows :: WindowSelection -> TmuxCommand [Window]+  ListSessions :: TmuxCommand [Session]+  ListClients :: TmuxCommand [Client]+  SwitchClient :: ClientId -> Target -> TmuxCommand ()+  NewWindow :: WindowParams -> TmuxCommand Window+  SplitWindow :: WindowParams -> SplitWindowParams -> TmuxCommand Pane+  SelectWindow :: SelectWindowParams -> TmuxCommand ()+  NewSession :: SessionParams -> TmuxCommand Session+  CopyMode :: CopyModeParams -> TmuxCommand ()+  SendKeys :: SendKeysParams -> TmuxCommand ()+  SelectPane :: SelectParams -> TmuxCommand ()+  KillPane :: KillPaneParams -> TmuxCommand ()+  MovePane :: JoinPaneParams -> TmuxCommand ()+  ResizePane :: ResizePaneParams -> TmuxCommand ()+  PipePane :: PipePaneParams -> TmuxCommand ()+  CapturePane :: CapturePaneParams -> TmuxCommand [Text]+  KillServer :: TmuxCommand ()++instance Functor TmuxCommand where+  fmap = Fmap++instance Show (TmuxCommand a) where+  showsPrec d = \case+    Fmap _ cmd ->+      showParen (d > 10) [exon|Fmap #{showsPrec 11 cmd}|]+    ListPanes sel ->+      showParen (d > 10) [exon|ListPanes #{showsPrec 11 sel}|]+    ListWindows sel ->+      showParen (d > 10) [exon|ListWindows #{showsPrec 11 sel}|]+    ListClients ->+      showString "ListClients"+    ListSessions ->+      showString "ListSessions"+    SwitchClient c t ->+      showParen (d > 10) [exon|SwitchClient #{showsPrec 11 c} #{showsPrec 11 t}|]+    NewWindow params ->+      showParen (d > 10) [exon|NewWindow #{showsPrec 11 params}|]+    SplitWindow wParams sParams ->+      showParen (d > 10) [exon|SplitWindow #{showsPrec 11 wParams} #{showsPrec 11 sParams}|]+    SelectWindow params ->+      showParen (d > 10) [exon|SelectWindow #{showsPrec 11 params}|]+    NewSession params ->+      showParen (d > 10) [exon|NewSession #{showsPrec 11 params}|]+    CopyMode params ->+      showParen (d > 10) [exon|SelectPane #{showsPrec 11 params}|]+    SendKeys params ->+      showParen (d > 10) [exon|SendKeys #{showsPrec 11 params}|]+    SelectPane paneId ->+      showParen (d > 10) [exon|SelectPane #{shows paneId}|]+    KillPane params ->+      showParen (d > 10) [exon|KillPane #{showsPrec 11 params}|]+    MovePane params ->+      showParen (d > 10) [exon|MovePane #{showsPrec 11 params}|]+    ResizePane params ->+      showParen (d > 10) [exon|ResizePane #{showsPrec 11 params}|]+    PipePane params ->+      showParen (d > 10) [exon|PipePane #{showsPrec 11 params}|]+    CapturePane params ->+      showParen (d > 10) [exon|CapturePane #{showsPrec 11 params}|]+    KillServer ->+      showString "KillServer"++query ::+  ∀ a .+  TmuxCommand a ->+  Maybe TmuxQuery+query = \case+  Fmap _ cmd -> query cmd+  ListPanes _ -> Just (Codec.query @Pane)+  ListWindows _ -> Just (Codec.query @Window)+  ListSessions -> Just (Codec.query @Session)+  ListClients -> Just (Codec.query @Client)+  SwitchClient _ _ -> Nothing+  NewWindow _ -> Just (Codec.query @Window)+  SplitWindow _ _ -> Just (Codec.query @Pane)+  SelectWindow _ -> Nothing+  NewSession _ -> Just (Codec.query @Session)+  CopyMode _ -> Nothing+  SendKeys _ -> Nothing+  SelectPane _ -> Nothing+  KillPane _ -> Nothing+  MovePane _ -> Nothing+  ResizePane _ -> Nothing+  PipePane _ -> Nothing+  CapturePane _ -> Nothing+  KillServer -> Nothing++request :: TmuxCommand a -> Maybe TmuxQuery -> TmuxRequest+request = \case+  Fmap _ c ->+    request c+  ListPanes selection ->+    TmuxRequest "list-panes" (cmdArgs selection)+  ListWindows selection ->+    TmuxRequest "list-windows" (cmdArgs selection)+  ListSessions ->+    TmuxRequest "list-sessions" []+  ListClients ->+    TmuxRequest "list-clients" []+  SwitchClient (ClientId client) target ->+    TmuxRequest "switch-client" (["-c", client] <> cmdArgs target)+  NewWindow params ->+    TmuxRequest "new-window" (cmdArgs params)+  SplitWindow wParams sParams ->+    TmuxRequest "split-window" (cmdArgs wParams <> cmdArgs sParams)+  SelectWindow params ->+    TmuxRequest "select-window" (cmdArgs params)+  NewSession params ->+    TmuxRequest "new-session" (cmdArgs params)+  CopyMode params ->+    TmuxRequest "copy-mode" (cmdArgs params)+  SendKeys params ->+    TmuxRequest "send-keys" (cmdArgs params)+  SelectPane params ->+    TmuxRequest "select-pane" (cmdArgs params)+  KillPane params ->+    TmuxRequest "kill-pane" (cmdArgs params)+  MovePane params ->+    TmuxRequest "move-pane" (cmdArgs params)+  ResizePane params ->+    TmuxRequest "resize-pane" (cmdArgs params)+  PipePane params ->+    TmuxRequest "pipe-pane" (cmdArgs params)+  CapturePane params ->+    TmuxRequest "capture-pane" (cmdArgs params)+  KillServer ->+    TmuxRequest "kill-server" []++encode :: TmuxCommand a -> TmuxRequest+encode cmd =+  request cmd (query cmd)++decode :: TmuxResponse -> TmuxCommand a -> Either DecodeError a+decode (TmuxResponse out) = \case+  Fmap f cmd ->+    f <$> decode (TmuxResponse out) cmd+  ListPanes _ ->+    multi out+  ListWindows _ ->+    multi out+  ListSessions ->+    multi out+  ListClients ->+    multi out+  SwitchClient _ _ ->+    unit+  NewWindow _ ->+    single out+  SplitWindow _ _ ->+    single out+  SelectWindow _ ->+    unit+  NewSession _ ->+    single out+  CopyMode _ ->+    unit+  SendKeys _ ->+    unit+  SelectPane _ ->+    unit+  KillPane _ ->+    unit+  MovePane _ ->+    unit+  ResizePane _ ->+    unit+  PipePane _ ->+    unit+  CapturePane CapturePaneParams {stripBlank, stripTrailingWs} ->+    pure $+    applyWhen stripBlank (dropWhileEnd ("" ==)) $+    applyWhen stripTrailingWs (fmap Text.stripEnd) $+    out+  KillServer ->+    unit
+ lib/Chiasma/Data/TmuxError.hs view
@@ -0,0 +1,23 @@+module Chiasma.Data.TmuxError where++import Polysemy.Process.Data.ProcessError (ProcessError)++import Chiasma.Data.CodecError (CodecError (CodecError))+import Chiasma.Data.DecodeError (DecodeError)+import Chiasma.Data.TmuxRequest (TmuxRequest)++data TmuxError =+  ProcessFailed ProcessError+  |+  RequestFailed TmuxRequest [Text]+  |+  DecodeFailed TmuxRequest DecodeError+  |+  NoClients+  |+  NoExe+  deriving stock (Eq, Show)++codec :: CodecError -> TmuxError+codec (CodecError req err) =+  DecodeFailed req err
+ lib/Chiasma/Data/TmuxEvent.hs view
@@ -0,0 +1,10 @@+module Chiasma.Data.TmuxEvent where++import Chiasma.Data.TmuxNotification (TmuxNotification)+import Chiasma.Data.TmuxOutputBlock (TmuxOutputBlock)++data TmuxEvent =+  Response TmuxOutputBlock+  |+  Notification TmuxNotification+  deriving stock (Eq, Show)
+ lib/Chiasma/Data/TmuxId.hs view
@@ -0,0 +1,75 @@+module Chiasma.Data.TmuxId where++import Data.Data (Data)+import Prettyprinter (Pretty (..))++newtype ClientId =+  ClientId { unClientId :: Text }+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString)++instance Pretty ClientId where+  pretty = pretty . (.unClientId)++sessionPrefix :: Text+sessionPrefix = "$"++newtype SessionId =+  SessionId Int+  deriving stock (Eq, Show, Generic)+  deriving newtype (Num, Ord)++instance Pretty SessionId where+  pretty = pretty . formatId++windowPrefix :: Text+windowPrefix = "@"++newtype WindowId =+  WindowId Int+  deriving stock (Eq, Show, Generic)+  deriving newtype (Num, Ord)++instance Pretty WindowId where+  pretty = pretty . formatId++panePrefix :: Text+panePrefix = "%"++newtype PaneId =+  PaneId Int+  deriving stock (Eq, Show, Generic, Data)+  deriving newtype (Num, Ord)++instance Pretty PaneId where+  pretty = pretty . formatId++class HasPaneId a where+  paneId :: a -> PaneId++newtype TmuxIdPrefix a =+  TmuxIdPrefix { unTmuxIdPrefix :: Text }+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString)++class TmuxId a where+  prefix :: TmuxIdPrefix a+  number :: a -> Int++  formatId :: a -> Text+  formatId a =+    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
+ lib/Chiasma/Data/TmuxNative.hs view
@@ -0,0 +1,10 @@+module Chiasma.Data.TmuxNative where++import Path (Abs, File, Path)++data TmuxNative =+  TmuxNative {+    executable :: Path Abs File,+    tmuxServerSocket :: Maybe (Path Abs File)+  }+  deriving stock (Eq, Show)
+ lib/Chiasma/Data/TmuxNotification.hs view
@@ -0,0 +1,8 @@+module Chiasma.Data.TmuxNotification where++data TmuxNotification =+  TmuxNotification {+    name :: Text,+    args :: [Text]+  }+  deriving stock (Eq, Show, Ord)
+ lib/Chiasma/Data/TmuxOutputBlock.hs view
@@ -0,0 +1,13 @@+module Chiasma.Data.TmuxOutputBlock where++data End =+  EndSuccess+  |+  EndError+  deriving stock (Eq, Show)++data TmuxOutputBlock =+  Success [Text]+  |+  Error [Text]+  deriving stock (Eq, Show)
+ lib/Chiasma/Data/TmuxQuery.hs view
@@ -0,0 +1,6 @@+module Chiasma.Data.TmuxQuery where++newtype TmuxQuery =+  TmuxQuery { unTmuxQuery :: Text }+  deriving stock (Eq, Show, Generic)+  deriving newtype (IsString, Semigroup, Monoid)
+ lib/Chiasma/Data/TmuxRequest.hs view
@@ -0,0 +1,24 @@+module Chiasma.Data.TmuxRequest where++import qualified Data.Text as Text+import Chiasma.Data.TmuxQuery (TmuxQuery (TmuxQuery))++data TmuxRequest =+  TmuxRequest {+    cmd :: Text,+    args :: [Text],+    query :: Maybe TmuxQuery+  }+  deriving stock (Eq, Show)++queryArgs :: TmuxQuery -> [Text]+queryArgs (TmuxQuery q) =+  ["-F", "'", q, "'"]++cmdline :: TmuxRequest -> [Text]+cmdline TmuxRequest { ..} =+  cmd : args ++ foldMap queryArgs query ++ ["\n"]++encode :: TmuxRequest -> ByteString+encode req =+  encodeUtf8 (Text.unwords (cmdline req))
+ lib/Chiasma/Data/TmuxResponse.hs view
@@ -0,0 +1,6 @@+module Chiasma.Data.TmuxResponse where++newtype TmuxResponse =+  TmuxResponse { unTmuxResponse :: [Text] }+  deriving stock (Eq, Show)+  deriving newtype (Semigroup, Monoid)
− lib/Chiasma/Data/TmuxThunk.hs
@@ -1,53 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE StandaloneDeriving #-}--module Chiasma.Data.TmuxThunk(-  CmdName(..),-  CmdArgs(..),-  TmuxThunk(..),-  TmuxError(..),-  Cmd(..),-  Cmds(..),-  cmd,-) 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)--data TmuxThunk next =-  ∀ a . Read Cmd ([String] -> Either TmuxDecodeError a) ([a] -> next)-  |-  Write Cmd (() -> next)-  |-  Failed TmuxError--deriving instance Functor TmuxThunk--cmd :: String -> [String] -> Cmd-cmd name args = Cmd (CmdName name) (CmdArgs args)
+ lib/Chiasma/Data/View.hs view
@@ -0,0 +1,19 @@+module Chiasma.Data.View where++import qualified Control.Lens as Lens (set)++import Chiasma.Data.Ident (Ident, Identifiable (..))++data View a =+  View {+    ident :: Ident,+    id :: Maybe a+  }+  deriving stock (Eq, Show, Generic)++instance Identifiable (View a) where+  identify = (.ident)++setViewId :: a -> View a -> View a+setViewId =+  Lens.set #id . Just
+ lib/Chiasma/Data/Views.hs view
@@ -0,0 +1,35 @@+module Chiasma.Data.Views where++import Control.Lens (makeClassy)+import Prettyprinter (Doc)+import Prettyprinter.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 stock (Eq, Show)++data Views =+  Views {+    _sessions :: [View SessionId],+    _windows :: [View WindowId],+    _panes :: [View PaneId],+    _log :: [Doc AnsiStyle]+  }+  deriving stock (Show, Generic)+  deriving anyclass (Default)++makeClassy ''Views++instance Eq Views where+  (Views sa wa pa _) == (Views sb wb pb _) =+    (sa == sb) && (wa == wb) && (pa == pb)
− lib/Chiasma/Data/Window.hs
@@ -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)
+ lib/Chiasma/Data/WindowParams.hs view
@@ -0,0 +1,56 @@+module Chiasma.Data.WindowParams where++import Path (Abs, Dir, Path)++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs), arg, envVars, flag1, identOption, optionWith)+import Chiasma.Data.Ident (Ident)+import Chiasma.Data.Target (Target)+import Chiasma.Path (pathText')++data WindowParams =+  WindowParams {+    after :: Bool,+    detach :: Bool,+    killExisting :: Bool,+    printInfo :: Bool,+    cwd :: Maybe (Path Abs Dir),+    environment :: Map Text Text,+    name :: Maybe Ident,+    target :: Target,+    command :: Maybe Text+  }+  deriving stock (Eq, Show)++instance Default WindowParams where+  def =+    WindowParams {+      after = False,+      detach = False,+      killExisting = False,+      printInfo = True,+      cwd = Nothing,+      environment = mempty,+      name = Nothing,+      target = def,+      command = Nothing+    }++instance CmdArgs WindowParams where+  cmdArgs WindowParams {..} =+    flag1 "-a" after+    <>+    flag1 "-d" detach+    <>+    flag1 "-k" killExisting+    <>+    flag1 "-P" printInfo+    <>+    optionWith "-c" pathText' cwd+    <>+    envVars environment+    <>+    identOption "-n" name+    <>+    cmdArgs target+    <>+    arg command
+ lib/Chiasma/Data/WindowSelection.hs view
@@ -0,0 +1,19 @@+module Chiasma.Data.WindowSelection where++import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs))+import Chiasma.Data.Target (Target (Current))++data WindowSelection =+  All+  |+  InSession Target+  deriving stock (Eq, Show)++instance CmdArgs WindowSelection where+  cmdArgs = \case+    All -> ["-a"]+    InSession target -> cmdArgs target++instance Default WindowSelection where+  def =+    InSession Current
+ lib/Chiasma/Data/WindowState.hs view
@@ -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 stock (Eq, Show)
+ lib/Chiasma/Data/WithPaneId.hs view
@@ -0,0 +1,39 @@+module Chiasma.Data.WithPaneId where++import qualified Data.Text as Text++import Chiasma.Codec (TmuxCodec (decode, query), trim)+import Chiasma.Codec.Decode (primDecode)+import Chiasma.Data.DecodeError (DecodeError (DecodeError), DecodeFailure (TooFewFields))+import qualified Chiasma.Data.TmuxId as TmuxId+import Chiasma.Data.TmuxId (HasPaneId, PaneId)+import Chiasma.Data.TmuxQuery (TmuxQuery (TmuxQuery))++data WithPaneId a =+  WithPaneId {+    paneId :: PaneId,+    pane :: a+  }+  deriving stock (Eq, Show, Generic)++instance HasPaneId (WithPaneId a) where+  paneId = (.paneId)++safeBreakOn :: Text -> Text -> Maybe (Text, Text)+safeBreakOn n = \case+  "" -> Nothing+  t -> Just (second (Text.drop 1) (Text.breakOn n t))++instance TmuxCodec a => TmuxCodec (WithPaneId a) where+  decode payload =+    case safeBreakOn " " (trim payload) of+      Just (idField, rest) -> do+        pane <- decode rest+        paneId <- first (DecodeError [payload]) (primDecode idField)+        pure WithPaneId {..}+      Nothing ->+        Left (DecodeError [payload] TooFewFields)++  query =+    let TmuxQuery paneQuery = query @a+    in TmuxQuery ("#{pane_id} " <> paneQuery)
+ lib/Chiasma/Effect/Codec.hs view
@@ -0,0 +1,32 @@+module Chiasma.Effect.Codec where++import Chiasma.Data.CodecError (CodecError)+import Chiasma.Data.TmuxCommand (TmuxCommand)+import Chiasma.Data.TmuxRequest (TmuxRequest)+import Chiasma.Data.TmuxResponse (TmuxResponse)++data Codec (command :: Type -> Type) (i :: Type) (o :: Type) :: Effect where+  WithCodec :: command a -> (i -> m o) -> Codec command i o m a+  Encode :: command a -> Codec command i o m i++makeSem ''Codec++type NativeCodec command =+  Codec command TmuxRequest TmuxResponse++type NativeCodecE command =+  NativeCodec command !! CodecError++type NativeCommandCodec =+  NativeCodec TmuxCommand++type NativeCommandCodecE =+  NativeCodecE TmuxCommand++type family NativeCodecs (cs :: [Type -> Type]) :: [Effect] where+  NativeCodecs '[] = '[]+  NativeCodecs (c : cs) = NativeCodec c : NativeCodecs cs++type family NativeCodecsE (cs :: [Type -> Type]) :: [Effect] where+  NativeCodecsE '[] = '[]+  NativeCodecsE (c : cs) = NativeCodecE c : NativeCodecsE cs
+ lib/Chiasma/Effect/TmuxApi.hs view
@@ -0,0 +1,15 @@+module Chiasma.Effect.TmuxApi where++import Chiasma.Data.TmuxCommand (TmuxCommand)+import Chiasma.Data.TmuxNotification (TmuxNotification)++data TmuxApi (command :: Type -> Type) :: Effect where+  Send :: command a -> TmuxApi command m a+  Schedule :: command a -> TmuxApi command m ()+  -- | Block until the next tmux control mode notification (e.g. @%window-add@, @%layout-changed@).+  ReceiveNotification :: TmuxApi command m TmuxNotification++makeSem ''TmuxApi++type Tmux =+  TmuxApi TmuxCommand
+ lib/Chiasma/Effect/TmuxClient.hs view
@@ -0,0 +1,21 @@+module Chiasma.Effect.TmuxClient where++import Prelude hiding (send)++import Chiasma.Data.TmuxNotification (TmuxNotification)+import Chiasma.Data.TmuxRequest (TmuxRequest)+import Chiasma.Data.TmuxResponse (TmuxResponse)++data TmuxClient (i :: Type) (o :: Type) :: Effect where+  Send :: i -> TmuxClient i o m o+  Schedule :: i -> TmuxClient i o m ()+  -- | Block until the next tmux control mode notification (e.g. @%window-add@, @%layout-changed@).+  ReceiveNotification :: TmuxClient i o m TmuxNotification++makeSem ''TmuxClient++type ScopedTmux i o =+  Scoped_ (TmuxClient i o)++type NativeTmux =+  ScopedTmux TmuxRequest TmuxResponse
+ lib/Chiasma/Function.hs view
@@ -0,0 +1,7 @@+module Chiasma.Function where++applyWhen :: Bool -> (a -> a) -> a -> a+applyWhen True f x =+  f x+applyWhen False _ x =+  x
+ lib/Chiasma/Interpreter/Codec.hs view
@@ -0,0 +1,48 @@+module Chiasma.Interpreter.Codec where++import Chiasma.Codec (TmuxCodec)+import Chiasma.Data.CodecError (CodecError (CodecError))+import Chiasma.Data.DecodeError (DecodeError)+import qualified Chiasma.Data.Panes as Panes+import Chiasma.Data.Panes (Panes)+import qualified Chiasma.Data.TmuxCommand as TmuxCommand+import Chiasma.Data.TmuxCommand (TmuxCommand)+import Chiasma.Data.TmuxRequest (TmuxRequest)+import Chiasma.Data.TmuxResponse (TmuxResponse)+import qualified Chiasma.Effect.Codec as Codec+import Chiasma.Effect.Codec (Codec)++interpretCodecNative ::+  (∀ x . cmd x -> TmuxRequest) ->+  (∀ x . TmuxResponse -> cmd x -> Either DecodeError x) ->+  InterpreterFor (Codec cmd TmuxRequest TmuxResponse !! CodecError) r+interpretCodecNative enc dec =+  interpretResumableH \case+    Codec.Encode cmd ->+      pureT (enc cmd)+    Codec.WithCodec cmd use -> do+      let req = enc cmd+      out <- runTSimple (use req)+      Inspector ins <- getInspectorT+      pureT =<< stopEitherWith (CodecError req) (dec (fold (ins out)) cmd)++interpretCodecTmuxCommand ::+  InterpreterFor (Codec TmuxCommand TmuxRequest TmuxResponse !! CodecError) r+interpretCodecTmuxCommand =+  interpretCodecNative TmuxCommand.encode TmuxCommand.decode++interpretCodecPanes ::+  TmuxCodec p =>+  InterpreterFor (Codec (Panes p) TmuxRequest TmuxResponse !! CodecError) r+interpretCodecPanes =+  interpretCodecNative Panes.encode Panes.decode++interpretCodecPure ::+  (∀ a . command a -> Sem r (Either Text a)) ->+  InterpreterFor (Codec command () decode !! Text) r+interpretCodecPure run =+  interpretResumableH \case+    Codec.Encode _ ->+      pureT ()+    Codec.WithCodec cmd _ ->+      either stop pureT =<< raise (raise (run cmd))
+ lib/Chiasma/Interpreter/ProcessOutput.hs view
@@ -0,0 +1,24 @@+module Chiasma.Interpreter.ProcessOutput where++import Data.Attoparsec.ByteString (parse)+import qualified Data.Attoparsec.Types as Attoparsec+import qualified Polysemy.Process.Data.ProcessOutputParseResult as ProcessOutputParseResult+import Polysemy.Process.Data.ProcessOutputParseResult (ProcessOutputParseResult)+import Polysemy.Process.Effect.ProcessOutput (ProcessOutput)+import Polysemy.Process.Interpreter.ProcessOutput (interpretProcessOutputIncremental)++import Chiasma.Data.TmuxEvent (TmuxEvent)+import Chiasma.Native.TmuxOutputBlock (messageParser)++-- | Convert an attoparsec 'Attoparsec.IResult' to 'ProcessOutputParseResult'.+fromAttoparsec :: Attoparsec.IResult ByteString TmuxEvent -> ProcessOutputParseResult TmuxEvent+fromAttoparsec = \case+  Attoparsec.Fail _ _ err -> ProcessOutputParseResult.Fail (toText err)+  Attoparsec.Partial c -> ProcessOutputParseResult.Partial (fromAttoparsec . c)+  Attoparsec.Done rest a -> ProcessOutputParseResult.Done a rest++interpretProcessOutputTmuxEvent ::+  ∀ p r .+  InterpreterFor (ProcessOutput p (Either Text TmuxEvent)) r+interpretProcessOutputTmuxEvent =+  interpretProcessOutputIncremental (fromAttoparsec . parse messageParser)
+ lib/Chiasma/Interpreter/Pure.hs view
@@ -0,0 +1,13 @@+module Chiasma.Interpreter.Pure where++import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Effect.Codec (Codec)+import Chiasma.Effect.TmuxClient (TmuxClient)+import Chiasma.Interpreter.Codec (interpretCodecPure)+import Chiasma.Interpreter.TmuxClient (interpretTmuxClientNull)++interpretTmuxPure ::+  (∀ a . command a -> Sem r (Either Text a)) ->+  InterpretersFor [Scoped_ (TmuxClient () ()) !! TmuxError, Codec command () () !! Text] r+interpretTmuxPure run =+  interpretCodecPure run . interpretTmuxClientNull
+ lib/Chiasma/Interpreter/TmuxApi.hs view
@@ -0,0 +1,82 @@+module Chiasma.Interpreter.TmuxApi where++import Fcf (Eval, Exp, Pure1, type (@@))+import Fcf.Class.Functor (FMap)+import Prelude hiding (send, type (@@))++import Chiasma.Data.CodecError (CodecError)+import Chiasma.Data.TmuxRequest (TmuxRequest)+import Chiasma.Data.TmuxResponse (TmuxResponse)+import Chiasma.Effect.Codec (Codec, encode, withCodec)+import Chiasma.Effect.TmuxApi (TmuxApi (..))+import qualified Chiasma.Effect.TmuxClient as TmuxClient+import Chiasma.Effect.TmuxClient (TmuxClient)++type family (f :: l -> k) <$> (fa :: [l]) :: [k] where+  f <$> fa =+    FMap (Pure1 f) @@ fa++interpretTmuxApi ::+  ∀ command i o err r .+  Members [TmuxClient i o, Codec command i o !! err] r =>+  InterpreterFor (TmuxApi command !! err) r+interpretTmuxApi =+  interpretResumable \case+    Send cmd -> do+      restop @_ @(Codec _ _ _) $ withCodec cmd \ encoded -> do+        TmuxClient.send encoded+    Schedule cmd -> do+      encoded <- restop (encode cmd)+      TmuxClient.schedule encoded+    ReceiveNotification ->+      TmuxClient.receiveNotification++data TmuxApiEffect :: Type -> (Type -> Type) -> Exp Effect++type instance Eval (TmuxApiEffect err command) =+  TmuxApi command !! err++type family TmuxApis (commands :: [Type -> Type]) (err :: Type) :: EffectRow where+  TmuxApis commands err =+    FMap (TmuxApiEffect err) @@ commands++class InterpretApis (commands :: [Type -> Type]) err i o r where+  interpretApis :: InterpretersFor (TmuxApis commands err) (TmuxClient i o : r)++instance InterpretApis '[] err i o r where+  interpretApis =+    id++instance (+    r1 ~ (TmuxApis commands err ++ TmuxClient i o : r),+    Member (TmuxClient i o) r1,+    Member (Codec command i o !! err) r1,+    InterpretApis commands err i o r+  ) => InterpretApis (command : commands) err i o r where+    interpretApis =+      interpretApis @commands @err . interpretTmuxApi++type InterpretApisNative commands r =+  InterpretApis commands CodecError TmuxRequest TmuxResponse r++class RestopApis (commands :: [Type -> Type]) err i o r where+  restopApis :: InterpretersFor (TmuxApi <$> commands) (TmuxClient i o : r)++instance RestopApis '[] err i o r where+  restopApis =+    id++instance (+    r1 ~ (TmuxApi <$> commands ++ TmuxClient i o : r),+    Members [TmuxClient i o, Stop err] r1,+    Member (Codec command i o !! err) r1,+    RestopApis commands err i o r+  ) => RestopApis (command : commands) err i o r where+    restopApis =+      restopApis @commands @err @i @o .+      interpretTmuxApi @command @i @o .+      restop @err @(TmuxApi command) .+      raiseUnder++type RestopApisNative commands r =+  RestopApis commands CodecError TmuxRequest TmuxResponse r
+ lib/Chiasma/Interpreter/TmuxClient.hs view
@@ -0,0 +1,246 @@+module Chiasma.Interpreter.TmuxClient where++import qualified Conc+import Conc (Consume, Lock, interpretAtomic, interpretLockReentrant, lock, withAsync_)+import Data.Sequence ((|>))+import qualified Data.Text as Text+import Exon (exon)+import qualified Log as Log+import Path (Abs, File, Path, relfile, toFilePath)+import Polysemy.Conc.Interpreter.Mask (interpretMaskFinal)+import Polysemy.Process.Interpreter.Process (ProcessQueues)+import qualified Process as Process+import Process (+  OutputPipe (Stderr, Stdout),+  Process,+  ProcessError,+  SystemProcess,+  SystemProcessError,+  SystemProcessScopeError,+  interpretProcessInputId,+  interpretProcessOutputLeft,+  interpretProcessOutputTextLines,+  interpretProcess_,+  interpretSystemProcessNative_,+  resolveExecutable,+  withProcess_,+  )+import System.Process.Typed (ProcessConfig, proc)++import qualified Chiasma.Data.TmuxError as TmuxError+import Chiasma.Data.TmuxError (TmuxError (NoExe))+import qualified Chiasma.Data.TmuxEvent as TmuxEvent+import Chiasma.Data.TmuxEvent (TmuxEvent)+import Chiasma.Data.TmuxNative (TmuxNative (TmuxNative))+import Chiasma.Data.TmuxNotification (TmuxNotification (..))+import qualified Chiasma.Data.TmuxOutputBlock as TmuxOutputBlock+import Chiasma.Data.TmuxOutputBlock (TmuxOutputBlock)+import qualified Chiasma.Data.TmuxRequest as TmuxRequest+import Chiasma.Data.TmuxRequest (TmuxRequest (TmuxRequest))+import Chiasma.Data.TmuxResponse (TmuxResponse (TmuxResponse))+import qualified Chiasma.Effect.TmuxClient as TmuxClient+import Chiasma.Effect.TmuxClient (TmuxClient)+import Chiasma.Interpreter.ProcessOutput (interpretProcessOutputTmuxEvent)++type TmuxQueues =+  ProcessQueues (Either Text TmuxEvent) Text++type TmuxProc =+  Process ByteString (Either Text TmuxEvent)++validate :: TmuxRequest -> TmuxOutputBlock -> Either TmuxError TmuxResponse+validate request = \case+  TmuxOutputBlock.Success a ->+    Right (TmuxResponse a)+  TmuxOutputBlock.Error a ->+    Left (TmuxError.RequestFailed request a)++-- | Send a command and wait for the response.+-- The lock ensures only one request is in flight at a time (tmux control mode responses are ordered).+-- Opens a fresh subscription so only messages arriving after the send are seen.+tmuxRequest ::+  Members [TmuxProc, EventConsumer TmuxEvent, Lock, Log, Stop TmuxError] r =>+  TmuxRequest ->+  Sem r TmuxResponse+tmuxRequest request =+  lock $ subscribe do+    Log.trace [exon|tmux request: #{Text.stripEnd (decodeUtf8 cmdline)}|]+    Process.send cmdline+    stopEither =<< Conc.consumeFirstJust \case+      TmuxEvent.Response block -> pure (Just (validate request block))+      TmuxEvent.Notification _ -> pure Nothing+  where+    cmdline =+      TmuxRequest.encode request++socketArg :: Path Abs File -> [String]+socketArg socket =+  ["-S", toFilePath socket]++tmuxProc ::+  TmuxNative ->+  ProcessConfig () () ()+tmuxProc (TmuxNative exe socket) =+  proc (toFilePath exe) (foldMap socketArg socket <> ["-C", "-u", "attach-session", "-f", "ignore-size,no-output"])++interpretSystemProcessTmux ::+  Members [Reader TmuxNative, Resource, Race, Async, Embed IO] r =>+  InterpreterFor (Scoped_ (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r+interpretSystemProcessTmux sem = do+  conf <- tmuxProc <$> ask+  interpretSystemProcessNative_ conf sem++interpretProcessTmux ::+  Member (Scoped_ (SystemProcess !! SystemProcessError) !! SystemProcessScopeError) r =>+  Members [Resource, Race, Async, Embed IO] r =>+  InterpreterFor (Scoped_ TmuxProc !! ProcessError) r+interpretProcessTmux sem = do+  interpretProcessOutputTmuxEvent @'Stdout $+    interpretProcessOutputTextLines @'Stderr $+    interpretProcessOutputLeft @'Stderr $+    interpretProcessInputId $+    interpretProcess_ def $+    insertAt @1 sem++-- | Consume messages from the process until the first command response block.+-- Tmux emits a response block for the implicit attach-session command on connect.+-- Notification lines are discarded during this phase.+drainInitial ::+  Members [TmuxProc, Log] r =>+  Sem r ()+drainInitial =+  Process.recv >>= \case+    Right (TmuxEvent.Response _) ->+      Log.trace "tmux: drained initial response"+    Right (TmuxEvent.Notification n) -> do+      Log.trace [exon|tmux: initial notification: #{n.name}|]+      drainInitial+    Left err -> do+      Log.warn [exon|tmux: initial recv error: #{err}|]+      drainInitial++-- | Background receiver loop: reads from the tmux process and publishes each message.+receiverLoop ::+  Members [Events TmuxEvent, TmuxProc, Log] r =>+  Sem r ()+receiverLoop =+  forever do+    Process.recv >>= \case+      Left err ->+        Log.warn [exon|tmux recv error: #{err}|]+      Right msg -> do+        Log.trace [exon|tmux recv message: #{show msg}|]+        Conc.publish msg++-- | Send all scheduled requests and discard their responses.+flush ::+  Members [EventConsumer TmuxEvent, TmuxProc, AtomicState (Seq TmuxRequest), Lock, Log, Stop TmuxError] r =>+  Sem r ()+flush =+  traverse_ tmuxRequest =<< atomicState' (mempty,)++tmuxSession ::+  ∀ r a .+  Members [Scoped_ TmuxProc !! ProcessError, AtomicState (Seq TmuxRequest), Stop TmuxError] r =>+  Members [Lock, Log, Resource, Race, Async, Embed IO] r =>+  Sem (Consume TmuxEvent : EventConsumer TmuxEvent : TmuxProc : r) a ->+  Sem r a+tmuxSession action =+  resumeHoist TmuxError.ProcessFailed $ withProcess_ do+    drainInitial+    Conc.interpretEventsChan do+      withAsync_ receiverLoop do+        subscribe do+          void $ tmuxRequest (TmuxRequest "refresh-client" ["-C", "200x1000"] Nothing)+          subsume_ action <* flush++interpretTmuxProcessBuffered ::+  Members [AtomicState (Seq TmuxRequest), Scoped_ TmuxProc !! ProcessError] r =>+  Members [Lock, Log, Resource, Race, Async, Embed IO] r =>+  InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r+interpretTmuxProcessBuffered =+  interpretScopedResumableWith_ @'[Consume TmuxEvent, EventConsumer TmuxEvent, TmuxProc] (const tmuxSession) \case+    TmuxClient.Schedule request ->+      atomicModify' (|> request)+    TmuxClient.Send cmd -> do+      flush+      tmuxRequest cmd+    TmuxClient.ReceiveNotification ->+      Conc.consumeFirstJust $ pure . \case+        TmuxEvent.Notification n -> Just n+        TmuxEvent.Response _ -> Nothing++interpretTmuxWithProcess ::+  Members [Scoped_ TmuxProc !! ProcessError, Log, Resource, Race, Async, Final IO, Embed IO] r =>+  InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r+interpretTmuxWithProcess =+  interpretAtomic mempty .+  interpretMaskFinal .+  interpretLockReentrant .+  interpretTmuxProcessBuffered .+  raiseUnder3++interpretTmuxNative ::+  ∀ r .+  Members [Reader TmuxNative, Log, Resource, Race, Async, Final IO, Embed IO] r =>+  InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r+interpretTmuxNative =+  interpretSystemProcessTmux .+  interpretProcessTmux .+  interpretTmuxWithProcess .+  raiseUnder2++interpretTmuxFailing ::+  TmuxError ->+  InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r+interpretTmuxFailing err =+  interpretScopedResumable_ mempty \ () -> \case+    TmuxClient.Schedule _ ->+      stop err+    TmuxClient.Send _ ->+      stop err+    TmuxClient.ReceiveNotification ->+      stop err++withTmuxNativeEnv ::+  Member (Embed IO) r =>+  Maybe (Path Abs File) ->+  (Maybe TmuxNative -> Sem r a) ->+  Sem r a+withTmuxNativeEnv socket use =+  use . fmap (flip TmuxNative socket) . rightToMaybe =<< resolveExecutable [relfile|tmux|] Nothing++runReaderTmuxNativeEnv ::+  Members [Error TmuxError, Embed IO] r =>+  Maybe (Path Abs File) ->+  InterpreterFor (Reader TmuxNative) r+runReaderTmuxNativeEnv socket sem = do+  tn <- withTmuxNativeEnv socket (note NoExe)+  runReader tn sem++interpretTmuxNativeEnv ::+  Members [Error TmuxError, Log, Resource, Race, Async, Final IO, Embed IO] r =>+  Maybe (Path Abs File) ->+  InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r+interpretTmuxNativeEnv socket =+  runReaderTmuxNativeEnv socket . interpretTmuxNative . raiseUnder++interpretTmuxNativeEnvGraceful ::+  Members [Log, Resource, Race, Async, Final IO, Embed IO] r =>+  Maybe (Path Abs File) ->+  InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r+interpretTmuxNativeEnvGraceful socket sem =+  withTmuxNativeEnv socket \case+    Just tn -> runReader tn (interpretTmuxNative (raiseUnder sem))+    Nothing -> interpretTmuxFailing NoExe sem++interpretTmuxClientNull ::+  InterpreterFor (Scoped_ (TmuxClient i ()) !! TmuxError) r+interpretTmuxClientNull =+  interpretScopedResumable_ mempty \ () -> \case+    TmuxClient.Schedule _ ->+      unit+    TmuxClient.Send _ ->+      unit+    TmuxClient.ReceiveNotification ->+      pure (TmuxNotification {name = "null", args = []})
+ lib/Chiasma/Lens/Tree.hs view
@@ -0,0 +1,178 @@+module Chiasma.Lens.Tree where++import Control.Lens (Fold, Index, IxValue, Ixed (ix), Plated (..), cosmos, makeClassy_, preview, transform, lens)+import Data.Data (Data)+import Data.Foldable (foldrM)+import Prelude hiding (ix, transform)++import Chiasma.Data.Ident (Ident, Identifiable (..))+import Chiasma.Ui.Data.View (LayoutView, PaneView, Tree (Tree), TreeSub (TreeNode))+import Chiasma.Ui.Lens.Ident (matchIdentP)++newtype NodeIndexTree l p =+  NodeIndexTree {+    nitTree :: Tree l p+  }+  deriving stock (Eq, Show)++makeClassy_ ''NodeIndexTree++newtype LeafIndexTree l p =+  LeafIndexTree {+    litTree :: Tree l p+  }+  deriving stock (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++nodeTraversal :: Traversal' (Tree l p) l+nodeTraversal = #treeSubs . each . #_TreeNode . #treeData++nodeByIdentTraversal :: Identifiable l => Ident -> Traversal' (Tree l p) l+nodeByIdentTraversal ident = nodeTraversal . matchIdentP ident++leafDataTraversal :: Traversal' (Tree l p) p+leafDataTraversal = #treeSubs . each . #_TreeLeaf++leafByIdentTraversal :: Identifiable p => Ident -> Traversal' (Tree l p) p+leafByIdentTraversal ident = leafDataTraversal . matchIdentP ident++instance Identifiable l => Ixed (NodeIndexTree l p) where+  ix ident = _nitTree . nodeByIdentTraversal ident++nodesByIdentRecursive :: (Identifiable l, Data l, Data p) => Ident -> Fold (NodeIndexTree l p) l+nodesByIdentRecursive ident = cosmos . ix ident++nodesIdent ::+  ∀ l p .+  Identifiable l =>+  Data l =>+  Data p =>+  Ident ->+  Fold (Tree l p) l+nodesIdent ident = lens coerce (const (.nitTree)) . nodesByIdentRecursive ident++nodeByIdent ::+  ∀ l p .+  Identifiable l =>+  Data l =>+  Data p =>+  Ident ->+  Tree l p ->+  Maybe l+nodeByIdent ident = preview (nodesIdent ident)++nodesByIdent ::+  ∀ l p .+  Identifiable l =>+  Data l =>+  Data p =>+  Ident ->+  Tree l p ->+  [l]+nodesByIdent ident = toListOf (nodesIdent ident)++instance Identifiable p => Ixed (LeafIndexTree l p) where+  ix ident = _litTree . leafByIdentTraversal ident++leavesByIdentRecursive ::+  ∀ l p .+  Identifiable p =>+  Data l =>+  Data p =>+  Ident ->+  Fold (LeafIndexTree l p) p+leavesByIdentRecursive ident = cosmos . ix ident++leavesIdent ::+  ∀ l p .+  Identifiable p =>+  Data l =>+  Data p =>+  Ident ->+  Fold (Tree l p) p+leavesIdent ident = lens coerce (const (.litTree)) . leavesByIdentRecursive ident++leafByIdent ::+  ∀ l p .+  Identifiable p =>+  Data l =>+  Data p =>+  Ident ->+  Tree l p ->+  Maybe p+leafByIdent ident = preview (leavesIdent ident)++leavesByIdent ::+  ∀ l p .+  Identifiable p =>+  Data l =>+  Data p =>+  Ident ->+  Tree l p ->+  [p]+leavesByIdent ident = toListOf (leavesIdent ident)++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 :: ∀ 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+  pure (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+  pure (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
+ lib/Chiasma/Lens/Where.hs view
@@ -0,0 +1,6 @@+module Chiasma.Lens.Where where++import Control.Lens (Over, taking)++where1 :: (Applicative f, Traversable t) => (a -> Bool) -> Over (->) f (t a) (t a) a a+where1 predicate = taking 1 $ traverse . filtered predicate
− lib/Chiasma/Monad/Buffered.hs
@@ -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
− lib/Chiasma/Monad/Simple.hs
@@ -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
− lib/Chiasma/Monad/Tmux.hs
@@ -1,21 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module Chiasma.Monad.Tmux(-  Chiasma.Monad.Tmux.read,-  write,-  TmuxProg,-) where--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--read :: ∀ a . TmuxCodec a => String -> [String] -> TmuxProg [a]-read name args =-  liftF $ Read (cmd name (args ++ ["-F", "'" ++ unQ (TmuxCodec.query @a) ++ "'"])) TmuxCodec.decode id--write :: String -> [String] -> TmuxProg ()-write name args = liftF $ Write (cmd name args) id
− lib/Chiasma/Native/Api.hs
@@ -1,15 +0,0 @@-module Chiasma.Native.Api(-  TmuxApi(..),-  TmuxNative(..),-) where--import Control.Monad.Trans.Except (ExceptT(ExceptT))-import Text.ParserCombinators.Parsec ()-import Chiasma.Api.Class (TmuxApi(..))-import Chiasma.Native.Process (nativeTmuxProcess)--newtype TmuxNative =-  TmuxNative FilePath--instance TmuxApi TmuxNative where-  runCommands (TmuxNative socket) decode cmds = ExceptT $ nativeTmuxProcess socket decode cmds
lib/Chiasma/Native/Parse.hs view
@@ -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, try)+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"
− lib/Chiasma/Native/Process.hs
@@ -1,45 +0,0 @@-module Chiasma.Native.Process(-  tmuxProcessConfig,-  nativeTmuxProcess,-) 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 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.Native.Parse (resultLines)--cmdBytes :: [String] -> ByteString-cmdBytes cmds = packChars $ intercalate "\n" $ reverse $ "" : cmds--tmuxProcessConfig :: FilePath -> [String] -> ProcessConfig () () ()-tmuxProcessConfig socket cmds =-  setStdin (byteStringInput $ cmdBytes cmds) $ proc "tmux" ["-S", socket, "-C", "attach"]--handleProcessOutput :: Cmds -> ExitCode -> ([String] -> Either TmuxDecodeError a) -> String -> Either TmuxError [a]-handleProcessOutput cmds ExitSuccess decode out = do-  outputs <- mapLeft (TmuxError.OutputParsingFailed cmds (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-handleProcessOutput cmds _ _ out =-  Left $ TmuxError.ProcessFailed cmds out--formatCmd :: Cmd -> String-formatCmd (Cmd (CmdName name) (CmdArgs args)) = unwords $ name : args--nativeTmuxProcess :: MonadIO m => FilePath -> ([String] -> Either TmuxDecodeError a) -> Cmds -> m (Either TmuxError [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
+ lib/Chiasma/Native/TmuxOutputBlock.hs view
@@ -0,0 +1,71 @@+module Chiasma.Native.TmuxOutputBlock where++import Data.Attoparsec.ByteString (Parser)+import Data.ByteString.Internal (packChars)+import Prelude hiding (noneOf, try)+import Text.Parser.Char (CharParsing, anyChar, char, newline, noneOf, string)+import Text.Parser.Combinators (choice, manyTill, notFollowedBy, skipMany, try)+import Text.Parser.LookAhead (LookAheadParsing, lookAhead)++import qualified Chiasma.Data.TmuxEvent as TmuxEvent+import Chiasma.Data.TmuxEvent (TmuxEvent)+import Chiasma.Data.TmuxNotification (TmuxNotification (..))+import Chiasma.Data.TmuxOutputBlock (End (EndError, EndSuccess), TmuxOutputBlock (Error, Success))++tillEol :: (CharParsing m) => m Text+tillEol = decodeUtf8 . packChars <$> manyTill anyChar newline++beginLine :: (CharParsing m, Monad m) => m ()+beginLine = void $ string "%begin" >> tillEol++endLine :: (CharParsing m) => m End+endLine = do+  end <- choice [EndSuccess <$ string "%end", EndError <$ string "%error"]+  _ <- tillEol+  pure end++notBeginLine :: (CharParsing m, Monad m) => m ()+notBeginLine = void $ notFollowedBy (string "%begin") >> tillEol++word :: CharParsing m => m Text+word = toText <$> some (noneOf " \n")++notificationLine :: (CharParsing m, Monad m) => m TmuxNotification+notificationLine = do+  notFollowedBy (string "%begin")+  _ <- char '%'+  name <- word+  args <- many (char ' ' *> word)+  _ <- newline+  pure TmuxNotification {name, args}++-- | 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 :: (CharParsing m, Monad m, LookAheadParsing m) => m TmuxOutputBlock+parseBlock = do+  _ <- skipMany notBeginLine+  _ <- beginLine+  dataLines <- manyTill tillEol $ try (lookAhead endLine)+  endLine <&> \case+    EndSuccess -> Success dataLines+    EndError -> Error dataLines++parseBlocks :: (CharParsing m, Monad m, LookAheadParsing m) => m [TmuxOutputBlock]+parseBlocks = do+  result <- many (try parseBlock)+  skipMany tillEol+  pure result++-- | Parse either a notification line or a command response block.+parseMessage :: (CharParsing m, Monad m, LookAheadParsing m) => m TmuxEvent+parseMessage =+  choice+    [ TmuxEvent.Notification <$> try notificationLine+    , TmuxEvent.Response <$> parseBlock+    ]++parser :: Parser TmuxOutputBlock+parser = parseBlock++messageParser :: Parser TmuxEvent+messageParser = parseMessage
+ lib/Chiasma/Pack.hs view
@@ -0,0 +1,112 @@+module Chiasma.Pack where++import Control.Lens (mapMOf_)+import qualified Data.List.NonEmpty as NonEmpty (reverse, toList)+import qualified Data.Set as Set (fromList, size)+import Prettyprinter (Doc, line, pretty, (<+>))++import qualified Chiasma.Codec.Data.Window as Codec (Window (Window))+import Chiasma.Command.Pane (movePane, resizePane)+import Chiasma.Data.Axis (Axis (Horizontal, Vertical))+import Chiasma.Data.TmuxId (PaneId)+import Chiasma.Data.Views (Views)+import Chiasma.Data.WindowState (WindowState (..))+import Chiasma.Effect.TmuxApi (Tmux)+import Chiasma.Ui.Data.Measure (MLayout (..), MPane (..), MeasureTree, MeasureTreeSub, Measured (Measured))+import Chiasma.Ui.Data.Tree (Node (Leaf, Sub), Tree (Tree))+import qualified Chiasma.Ui.Data.Tree as Tree (subTree)+import Chiasma.Ui.Measure (measureTree)+import Chiasma.View (viewsLog)++packPane ::+  Members [AtomicState Views, Tmux] r =>+  PaneId ->+  Axis ->+  PaneId ->+  Sem r ()+packPane refId axis paneId =+  when (paneId /= refId) do+    movePane paneId refId axis++positionView ::+  Members [AtomicState Views, Tmux] r =>+  Axis ->+  PaneId ->+  MeasureTreeSub ->+  Sem r ()+positionView axis refId =+  position+  where+    position (Sub (Tree (Measured _ (MLayout layoutRef _ _ _)) _)) =+      packPane refId axis layoutRef+    position (Leaf (Measured _ (MPane paneId _ _))) =+      packPane refId axis paneId++describeAxis :: Axis -> Doc a+describeAxis = \case+  Vertical -> "vertically"+  Horizontal -> "horizontally"++resizeView ::+  Members [AtomicState Views, Tmux] r =>+  Axis ->+  MeasureTreeSub ->+  Sem r ()+resizeView axis = \case+  Sub (Tree (Measured size (MLayout refId _ _ _)) _) -> do+    viewsLog ("resizing layout with ref" <+> pretty refId <+> "to" <+> pretty size <+> describeAxis axis)+    resizePane refId axis size+  Leaf (Measured size (MPane paneId _ _)) -> do+    viewsLog $ "resizing pane" <+> pretty paneId <+> "to" <+> pretty size <+> describeAxis axis+    resizePane paneId axis 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 ::+  Members [AtomicState Views, Tmux] r =>+  MeasureTree ->+  Sem r ()+packTree =+  pack+  where+    pack (Tree (Measured _ (MLayout ref _ _ axis)) sub) = do+      when needPos runPos+      mapMOf_ (each . Tree.subTree) pack sub+      traverse_ (resizeView axis) sub+      where+        needPos = needPositioning sub+        runPos = do+          viewsLog $ "repositioning views" <+> pretty sub+          traverse_ (positionView axis ref) (NonEmpty.reverse sub)++packWindow ::+  Members [AtomicState Views, Tmux] r =>+  WindowState ->+  Sem r ()+packWindow (WindowState (Codec.Window _ width height) _ _ tree _) = do+  let measures = measureTree tree width height+  viewsLog $ "measured tree:" <> line <> pretty measures+  packTree measures
+ lib/Chiasma/Pane.hs view
@@ -0,0 +1,17 @@+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 ::+  Member (AtomicState Views) r =>+  Ident ->+  Sem r (Tmux.View PaneId)+addPane ident =+  pane <$ atomicModify' (Views.insertPane pane)+  where+    pane =+      Tmux.View ident Nothing
+ lib/Chiasma/Path.hs view
@@ -0,0 +1,14 @@+module Chiasma.Path where++import qualified Data.Text as Text+import Path (Path, toFilePath)++pathText :: Path b t -> Text+pathText =+  toText . toFilePath++pathText' :: Path b t -> Text+pathText' p =+  case pathText p of+    "/" -> "/"+    t -> Text.dropWhileEnd (== '/') t
+ lib/Chiasma/Render.hs view
@@ -0,0 +1,47 @@+module Chiasma.Render where++import Path (Abs, Dir, Path)+import Prettyprinter (line, pretty)++import Chiasma.Codec.Data.Pane (Pane)+import qualified Chiasma.Codec.Data.Window as Codec (Window (Window))+import Chiasma.Data.CodecError (CodecError)+import Chiasma.Data.Ident (Ident, identText)+import Chiasma.Data.Panes (TmuxPanes)+import qualified Chiasma.Data.RenderError as RenderError+import Chiasma.Data.RenderError (RenderError)+import Chiasma.Data.Views (Views)+import Chiasma.Effect.TmuxApi (Tmux)+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)++renderTree ::+  Members [TmuxPanes Pane, AtomicState Views, Tmux] r =>+  Ident ->+  Codec.Window ->+  RenderableTree ->+  Sem r ()+renderTree windowIdent window tree = do+  viewsLog $ pretty ("rendering tree in window " <> identText windowIdent <> ":") <> line <> pretty tree+  wState <- windowState windowIdent window tree+  packWindow wState++render ::+  Members [TmuxPanes Pane !! CodecError, AtomicState Views, Tmux !! CodecError, Stop RenderError] r =>+  Path Abs Dir ->+  Ident ->+  Ident ->+  ViewTree ->+  Sem r ()+render cwd sessionIdent windowIdent tree = do+  resumeHoist @_ @(TmuxPanes _) RenderError.Codec do+    resumeHoist @_ @Tmux RenderError.Codec do+      initialSession <- findOrCreateSession sessionIdent+      initialWindow <- findOrCreateWindow windowIdent+      (sid, newSessionWid) <- mapStop RenderError.Layout (ensureSession initialSession initialWindow)+      window@(Codec.Window windowId _ _) <- ensureWindow sid initialWindow newSessionWid tree+      traverse_ (renderTree windowIdent window) =<< ensureView cwd windowId tree
+ lib/Chiasma/Session.hs view
@@ -0,0 +1,47 @@+module Chiasma.Session where++import Exon (exon)++import qualified Chiasma.Codec.Data.Session as Codec (Session (Session))+import qualified Chiasma.Codec.Data.Window as Codec (Window (Window))+import Chiasma.Command.Session (existingSessionId, newSession)+import Chiasma.Command.Window (newSessionWindow)+import Chiasma.Data.Ident (Ident)+import Chiasma.Data.LayoutError (LayoutError)+import Chiasma.Data.TmuxId (SessionId, WindowId)+import qualified Chiasma.Data.View as Tmux+import Chiasma.Data.Views (Views)+import Chiasma.Effect.TmuxApi (Tmux)+import Chiasma.View (findOrCreateView, viewsLogS)+import qualified Chiasma.View as Views (insertSession, session, updateSession, updateWindow)++findOrCreateSession ::+  Member (AtomicState Views) r =>+  Ident ->+  Sem r (Tmux.View SessionId)+findOrCreateSession =+  findOrCreateView Views.session Views.insertSession++spawnSession ::+  Members [AtomicState Views, Tmux, Stop LayoutError] r =>+  Tmux.View SessionId ->+  Tmux.View WindowId ->+  Sem r (SessionId, WindowId)+spawnSession session' window = do+  Codec.Session sid _ <- newSession session'.ident+  atomicModify' (Views.updateSession (Tmux.setViewId sid session'))+  Codec.Window wid _ _ <- newSessionWindow sid+  atomicModify' (Views.updateWindow (Tmux.setViewId wid window))+  viewsLogS [exon|spawned session #{show session'} with id #{show sid} and window id #{show wid}|]+  pure (sid, wid)++ensureSession ::+  Members [AtomicState Views, Tmux, Stop LayoutError] r =>+  Tmux.View SessionId ->+  Tmux.View WindowId ->+  Sem r (SessionId, Maybe WindowId)+ensureSession session' window = do+  existing <- join <$> traverse existingSessionId session'.id+  case existing of+    Just sid -> pure (sid, Nothing)+    Nothing -> second Just <$> spawnSession session' window
− lib/Chiasma/Test/File.hs
@@ -1,32 +0,0 @@-module Chiasma.Test.File(-  tempDirIO,-  tempDir,-  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---- raises exception if cwd is not the package root so we don't damage anything-tempDirIO :: String -> FilePath -> IO FilePath-tempDirIO prefix path = do-  base <- testDir prefix-  let dir = base </> "temp"-  removePathForcibly dir-  createDirectoryIfMissing False dir-  let absPath = dir </> path-  createDirectoryIfMissing True absPath-  return absPath--tempDir :: MonadIO m => String -> FilePath -> m FilePath-tempDir prefix path =-  liftIO $ tempDirIO prefix path--fixture :: MonadIO m => String -> FilePath -> m FilePath-fixture prefix path = do-  base <- liftIO $ testDir prefix-  return $ base </> "fixtures" </> path
− lib/Chiasma/Test/Tmux.hs
@@ -1,71 +0,0 @@-module Chiasma.Test.Tmux(-  withTestTmux,-  tmuxSpec,-) where--import GHC.Real (fromIntegral)-import GHC.IO.Handle (Handle)-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.Process (getPid)-import System.Process.Typed (-  ProcessConfig,-  Process,-  withProcess,-  proc,-  setStdin,-  setStdout,-  setStderr,-  useHandleClose,-  unsafeProcessHandle,-  )-import UnliftIO (finally)-import UnliftIO.Temporary (withSystemTempDirectory)-import Chiasma.Native.Api (TmuxNative(..))-import Chiasma.Test.File (fixture)--data Terminal = Terminal Handle Pty--unsafeTerminal :: IO Terminal-unsafeTerminal = do-  (_, slave) <- openPseudoTerminal-  mayPty <- createPty slave-  handle <- fdToHandle slave-  pty <- maybe (error "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]--killPid :: Integral a => a -> IO ()-killPid =-  Signal.signalProcess Signal.killProcess . fromIntegral--killProcess :: Process () () () -> IO ()-killProcess prc = do-  let handle = unsafeProcessHandle prc-  mayPid <- getPid handle-  maybe (return ()) killPid mayPid--runAndKillTmux :: (TmuxNative -> IO a) -> TmuxNative -> Process () () () -> IO a-runAndKillTmux thunk api prc =-  finally (thunk api) (killProcess prc)--withTestTmux :: (TmuxNative -> IO a) -> FilePath -> IO a-withTestTmux 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)--tmuxSpec :: (TmuxNative -> IO a) -> IO a-tmuxSpec thunk =-  withSystemTempDirectory "chiasma-test" $ withTestTmux thunk
+ lib/Chiasma/Tmux.hs view
@@ -0,0 +1,89 @@+module Chiasma.Tmux where++import Polysemy.Internal (hoistSem)+import Polysemy.Internal.Sing (KnownList (singList))+import Polysemy.Internal.Union (hoist, weakenMid)++import Chiasma.Data.Panes (Panes, TmuxPanes)+import Chiasma.Effect.Codec (Codec)+import Chiasma.Effect.TmuxApi (TmuxApi)+import Chiasma.Effect.TmuxClient (ScopedTmux, TmuxClient)+import Chiasma.Interpreter.TmuxApi (+  InterpretApis (interpretApis),+  RestopApis (restopApis),+  TmuxApis,+  interpretTmuxApi,+  type (<$>),+  )++withTmuxApis' ::+  ∀ commands err i o r a .+  InterpretApis commands err i o r =>+  Member (ScopedTmux i o) r =>+  Sem (TmuxApis commands err ++ TmuxClient i o : r) a ->+  Sem r a+withTmuxApis' =+  scoped_ . interpretApis @commands @err++insertAfter ::+  ∀ left e r a .+  KnownList left =>+  Sem (left ++ r) a ->+  Sem (left ++ e : r) a+insertAfter =+  hoistSem $ hoist (insertAfter @left @e @r) . weakenMid @r (singList @left) (singList @'[e])++withTmuxApis ::+  ∀ commands err i o r .+  KnownList (TmuxApis commands err) =>+  InterpretApis commands err i o r =>+  Member (ScopedTmux i o) r =>+  InterpretersFor (TmuxApis commands err) r+withTmuxApis =+  scoped_ .+  interpretApis @commands @err .+  insertAfter @(TmuxApis commands err) @(TmuxClient i o) @r++withTmuxApis_ ::+  ∀ commands err i o apis r .+  apis ~ TmuxApi <$> commands =>+  KnownList apis =>+  RestopApis commands err i o r =>+  Member (ScopedTmux i o) r =>+  InterpretersFor apis r+withTmuxApis_ =+  scoped_ .+  restopApis @commands @err .+  insertAfter @apis @(TmuxClient i o) @r++withTmux ::+  ∀ command err i o r .+  Members [ScopedTmux i o, Codec command i o !! err] r =>+  InterpreterFor (TmuxApi command !! err) r+withTmux =+  scoped_ . interpretTmuxApi . raiseUnder++withTmux_ ::+  ∀ command err i o r .+  Members [ScopedTmux i o, Codec command i o !! err, Stop err] r =>+  InterpreterFor (TmuxApi command) r+withTmux_ =+  scoped_ .+  interpretTmuxApi .+  raiseUnder .+  restop @err @(TmuxApi command) .+  raiseUnder++withPanes ::+  ∀ p err i o r .+  Members [ScopedTmux i o, Codec (Panes p) i o !! err] r =>+  InterpreterFor (TmuxPanes p !! err) r+withPanes =+  withTmux++withPanes_ ::+  ∀ p err i o r .+  Members [ScopedTmux i o, Codec (Panes p) i o !! err, Stop err] r =>+  InterpreterFor (TmuxPanes p) r+withPanes_ =+  withTmux_
+ lib/Chiasma/TmuxApi.hs view
@@ -0,0 +1,7 @@+module Chiasma.TmuxApi (+  module Chiasma.Effect.TmuxApi,+  module Chiasma.Interpreter.TmuxApi,+) where++import Chiasma.Effect.TmuxApi+import Chiasma.Interpreter.TmuxApi
+ lib/Chiasma/TmuxNative.hs view
@@ -0,0 +1,68 @@+module Chiasma.TmuxNative where++import Polysemy.Internal.Sing (KnownList)++import Chiasma.Data.CodecError (CodecError)+import Chiasma.Data.Panes (Panes, TmuxPanes)+import Chiasma.Data.TmuxRequest (TmuxRequest)+import Chiasma.Data.TmuxResponse (TmuxResponse)+import Chiasma.Effect.Codec (NativeCodecE)+import Chiasma.Effect.TmuxApi (TmuxApi)+import Chiasma.Effect.TmuxClient (NativeTmux, TmuxClient)+import Chiasma.Interpreter.TmuxApi (InterpretApisNative, RestopApisNative, TmuxApis, type (<$>))+import Chiasma.Tmux (withTmux, withTmuxApis, withTmuxApis', withTmuxApis_, withTmux_)++withTmuxApisNative' ::+  ∀ commands r a .+  InterpretApisNative commands r =>+  Member NativeTmux r =>+  Sem (TmuxApis commands CodecError ++ TmuxClient TmuxRequest TmuxResponse : r) a ->+  Sem r a+withTmuxApisNative' =+  withTmuxApis' @commands @CodecError++withTmuxApisNative ::+  ∀ commands r .+  KnownList (TmuxApis commands CodecError) =>+  InterpretApisNative commands r =>+  Member NativeTmux r =>+  InterpretersFor (TmuxApis commands CodecError) r+withTmuxApisNative =+  withTmuxApis @commands @CodecError++withTmuxApisNative_ ::+  ∀ commands r .+  KnownList (TmuxApi <$> commands) =>+  RestopApisNative commands r =>+  Member NativeTmux r =>+  InterpretersFor (TmuxApi <$> commands) r+withTmuxApisNative_ =+  withTmuxApis_ @commands @CodecError++withTmuxNative ::+  ∀ command r .+  Members [NativeTmux, NativeCodecE command] r =>+  InterpreterFor (TmuxApi command !! CodecError) r+withTmuxNative =+  withTmux++withTmuxNative_ ::+  ∀ command r .+  Members [NativeTmux, NativeCodecE command, Stop CodecError] r =>+  InterpreterFor (TmuxApi command) r+withTmuxNative_ =+  withTmux_++withPanesNative ::+  ∀ p r .+  Members [NativeTmux, NativeCodecE (Panes p)] r =>+  InterpreterFor (TmuxPanes p !! CodecError) r+withPanesNative =+  withTmuxNative++withPanesNative_ ::+  ∀ p r .+  Members [NativeTmux, NativeCodecE (Panes p), Stop CodecError] r =>+  InterpreterFor (TmuxPanes p) r+withPanesNative_ =+  withTmuxNative_
+ lib/Chiasma/Ui/Data/Measure.hs view
@@ -0,0 +1,53 @@+module Chiasma.Ui.Data.Measure where++import Control.Lens (makeClassy)+import Prettyprinter (Pretty (..), (<+>))++import Chiasma.Data.Axis (Axis)+import Chiasma.Data.TmuxId (PaneId (..))+import Chiasma.Ui.Data.Tree (NNode, NTree)++data MPane =+  MPane {+    _paneId :: PaneId,+    _mainPosition :: Int,+    _offPosition :: Int+  }+  deriving stock (Eq, Show)++makeClassy ''MPane++data MLayout =+  MLayout {+    _reference :: PaneId,+    _lMainPosition :: Int,+    _lOffPosition :: Int,+    _axis :: Axis+  }+  deriving stock (Eq, Show)++makeClassy ''MLayout++data Measured a =+  Measured {+    _size :: Int,+    _view :: a+  }+  deriving stock (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 axis') =+    "l –" <+> "ref:" <+> pretty refId <+> "pos:" <+> pretty mainPos <+> "(" <> pretty offPos <> ")" <+> pretty axis'++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'
+ lib/Chiasma/Ui/Data/RenderableTree.hs view
@@ -0,0 +1,55 @@+module Chiasma.Ui.Data.RenderableTree where++import Prettyprinter (Doc, Pretty (..), emptyDoc, space, (<+>))++import Chiasma.Data.Axis (Axis)+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,+    _axis :: Axis+  }+  deriving stock (Eq, Show)++data RPane =+  RPane {+    _id :: PaneId,+    _top :: Int,+    _left :: Int+  }+  deriving stock (Eq, Show)++data Renderable a =+  Renderable {+    _state :: ViewState,+    _geometry :: ViewGeometry,+    _view :: a+  }+  deriving stock (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) _ _) axis) =+    "l –" <+> "ref:" <+> pretty refId <+> "pos:" <+> pretty axis++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
+ lib/Chiasma/Ui/Data/Tree.hs view
@@ -0,0 +1,44 @@+module Chiasma.Ui.Data.Tree where++import Control.Lens (makeClassy)+import Prettyprinter (Pretty (..), nest, vsep)++data Tree f l p =+  Tree {+    _treeData :: l,+    _forest :: f (Node f l p)+    }++deriving stock instance (Eq l, Eq (Node [] l p)) => Eq (Tree [] l p)+deriving stock instance (Show l, Show (Node [] l p)) => Show (Tree [] l p)++deriving stock instance (Eq l, Eq (Node NonEmpty l p)) => Eq (Tree NonEmpty l p)+deriving stock instance (Show l, Show (Node NonEmpty l 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 stock instance (Eq l, Eq p) => Eq (Node [] l p)+deriving stock instance (Show l, Show p) => Show (Node [] l p)++deriving stock instance (Eq l, Eq p) => Eq (Node NonEmpty l p)+deriving stock 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
+ lib/Chiasma/Ui/Data/TreeModError.hs view
@@ -0,0 +1,21 @@+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 stock (Eq, Show)
+ lib/Chiasma/Ui/Data/View.hs view
@@ -0,0 +1,198 @@+module Chiasma.Ui.Data.View where++import Control.Lens (Fold, Index, IxValue, Ixed (ix), cosmos, preview)+import Control.Lens.Plated (Plated)+import Data.Bifoldable (Bifoldable (bifoldMap))+import Data.Data (Data)+import Prelude hiding (ix)+import Prettyprinter (Doc, Pretty (..), emptyDoc, nest, space, vsep, (<+>))++import Chiasma.Data.Axis (Axis (Horizontal, Vertical))+import Chiasma.Data.Ident (Ident, Identifiable (..))+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 Text+  }+  deriving stock (Eq, Show, Data, Generic)++instance Default Pane where+  def = Pane False False Nothing++newtype Layout =+  Layout {+    axis :: Axis+  }+  deriving stock (Eq, Show, Data, Generic)+  deriving newtype (Default)++data View a =+  View {+    ident :: Ident,+    state :: ViewState,+    geometry :: ViewGeometry,+    extra :: a+  }+  deriving stock (Eq, Show, Data, Generic)++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 = \case+    Layout Vertical ->+      "➡"+    Layout Horizontal ->+      "⬇"++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 :: Axis -> Ident -> LayoutView+consLayoutAs axis ident' = View ident' (ViewState False) def (Layout axis)++consLayout :: Ident -> LayoutView+consLayout =+  consLayoutAs Horizontal++consLayoutVertical :: Ident -> LayoutView+consLayoutVertical =+  consLayoutAs Vertical++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 stock (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 Functor (Tree l) where+  fmap = second++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 stock (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 Functor (TreeSub l) where+  fmap = second++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)++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 i = matchIdentP i++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)++treeTraversal :: Traversal' (Tree l p) (Tree l p)+treeTraversal = #treeSubs . each . #_TreeNode++treeByIdentTraversal :: Identifiable l => Ident -> Traversal' (Tree l p) (Tree l p)+treeByIdentTraversal ident' = treeTraversal . ix ident'++treesIdent ::+  ∀ l p .+  Identifiable l =>+  Data l =>+  Data p =>+  Ident ->+  Fold (Tree l p) (Tree l p)+treesIdent ident' = cosmos . ix ident'++treeByIdent ::+  ∀ l p .+  Identifiable l =>+  Data l =>+  Data p =>+  Ident ->+  Tree l p ->+  Maybe (Tree l p)+treeByIdent ident' = preview (treesIdent ident')++treesByIdent ::+  ∀ l p .+  Identifiable l =>+  Data l =>+  Data p =>+  Ident ->+  Tree l p ->+  [Tree l p]+treesByIdent ident' = toListOf (treesIdent ident')++-- | All subtrees including self.+trees :: (Data l, Data p) => Fold (Tree l p) (Tree l p)+trees = cosmos++-- | All transitive leaves in the tree.+leaves :: (Data l, Data p) => Fold (Tree l p) p+leaves = cosmos . #treeSubs . each . #_TreeLeaf++-- | All transitive nodes in the tree.+nodes :: (Data l, Data p) => Fold (Tree l p) l+nodes = cosmos . #treeData
+ lib/Chiasma/Ui/Data/ViewGeometry.hs view
@@ -0,0 +1,26 @@+module Chiasma.Ui.Data.ViewGeometry where++import Data.Data (Data)+import Prettyprinter (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 stock (Eq, Show, Data, Generic)+  deriving anyclass (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)])
+ lib/Chiasma/Ui/Data/ViewState.hs view
@@ -0,0 +1,12 @@+module Chiasma.Ui.Data.ViewState where++import Data.Data (Data)++newtype ViewState =+  ViewState {+    minimized :: Bool+  }+  deriving stock (Eq, Show, Data, Generic)++instance Default ViewState where+  def = ViewState False
+ lib/Chiasma/Ui/Lens/Ident.hs view
@@ -0,0 +1,21 @@+module Chiasma.Ui.Lens.Ident where++import Control.Lens (Prism', prism)++import Chiasma.Data.Ident (Ident, Identifiable (..), sameIdent)++matchIdent :: Identifiable a => Ident -> Traversal' a a+matchIdent i =+  filtered (sameIdent i)++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)
+ lib/Chiasma/Ui/Measure.hs view
@@ -0,0 +1,79 @@+module Chiasma.Ui.Measure where++import qualified Data.List.NonEmpty as NonEmpty (zip)++import qualified Chiasma.Data.Axis as Axis+import Chiasma.Data.Axis (Axis (Horizontal, Vertical))+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 (fixedSize, maxSize, minSize))+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 viewGeom.fixedSize++actualSize :: (ViewGeometry -> Maybe Float) ->  ViewState -> ViewGeometry -> Maybe Float+actualSize getter viewState viewGeom =+  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 = fromIntegral (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 -> Axis -> RenderableNode -> Int -> MeasureTreeSub+measureSub width height axis (Tree.Sub tree) size =+  Tree.Sub (measureLayout tree newWidth newHeight axis)+  where+    (newWidth, newHeight) =+      case axis of+        Vertical -> (width, size)+        Horizontal -> (size, height)+measureSub _ _ (Axis.vertical -> 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 -> Axis -> MeasureTree+measureLayout (Tree (Renderable _ _ (RLayout (RPane refId refTop refLeft) axis)) sub) width height (Axis.vertical -> parentVertical) =+  Tree (Measured sizeInParent (MLayout refId mainPos offPos axis)) 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 Axis.vertical axis then height else width+    sizes = measureLayoutViews (fromIntegral subTotalSize) sub+    measuredSub = uncurry (measureSub width height axis) <$> NonEmpty.zip sub sizes++measureTree :: RenderableTree -> Int -> Int -> MeasureTree+measureTree tree width height =+  measureLayout tree width height Horizontal
+ lib/Chiasma/Ui/Measure/Balance.hs view
@@ -0,0 +1,169 @@+module Chiasma.Ui.Measure.Balance where++import Data.List (zipWith3)+import qualified Data.List.NonEmpty as NonEmpty++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 =+  rev <$> r+  where+    rev a =+      fromMaybe a (a / norm)+    r =+      fmap (1 -) weights+    norm =+      sum r++cutSizes :: Balance -> NonEmpty Float+cutSizes (Balance minSizes _ weights _ total) =+  addNegatives <$> truncatedWeighted+  where+    surplus =+      sum minSizes - total+    surplusDistWeighted =+      fmap (surplus *) (reverseWeights weights)+    truncatedWeighted =+      fmap (uncurry (-)) (NonEmpty.zip minSizes surplusDistWeighted)+    negOrZero a =+      if a < 0 then a else 0+    neg =+      fmap negOrZero truncatedWeighted+    negTotal =+      sum neg+    negCount =+      length (NonEmpty.filter (< 0) neg)+    negativesDist =+      fromMaybe 0 (negTotal / realToFrac (length minSizes - negCount))+    addNegatives a =+      if a < 0 then 0 else a + negativesDist++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 < balance.balanceTotal) && hasUnbounded balance+      then distributeOnUnbounded+      else distributeOnAll+    maxTotal = sum (catMaybes $ NonEmpty.toList $ (.balanceMax) balance)++roundSizes :: NonEmpty Float -> NonEmpty Int+roundSizes (h :| t) =+  roundedHead + round surplus :| roundedTail+  where+    (surplus, roundedTail) = mapAccumL folder diff0 t+    (roundedHead, diff0) = diff h+    folder z a =+      (z + z1, a1)+      where+        (a1, z1) = diff a+    diff a = (floor a, a - fromIntegral (floor a :: Int))++-- | Tmux doesn't render panes smaller than two cells.+ensureMinimum2 :: NonEmpty Float -> NonEmpty Float+ensureMinimum2 sizes =+  choose <$> positives+  where+    positive =+      max 0+    positives =+      positive <$> sizes+    overTwoCount =+      length (NonEmpty.filter (>= 2) sizes)+    unders =+      amountUnderTwo <$> positives+    -- If no sizes are larger than 2, nothing will have to be subtracted, all sizes will be clamped to 2+    amountUnderTwoDist =+      fromMaybe 0 (sum unders / realToFrac overTwoCount)+    amountUnderTwo a =+      positive (2 - a)+    choose a =+      max 2 (a - amountUnderTwoDist)++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
+ lib/Chiasma/Ui/Measure/Weights.hs view
@@ -0,0 +1,36 @@+module Chiasma.Ui.Measure.Weights where++import qualified Data.List.NonEmpty as NonEmpty (filter, toList)++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)+    emptyWeight =+      fromMaybe normTotal (normTotal / realToFrac empties)++normalizeWeights :: NonEmpty Float -> NonEmpty Float+normalizeWeights weights =+  fmap norm weights+  where+    norm a =+      fromMaybe a (a / sum weights)++amendAndNormalizeWeights :: NonEmpty (Maybe Float) -> NonEmpty Float+amendAndNormalizeWeights = normalizeWeights . amendWeights++viewWeights :: NonEmpty (ViewState, ViewGeometry) -> NonEmpty Float+viewWeights = amendAndNormalizeWeights . fmap (uncurry effectiveWeight)
+ lib/Chiasma/Ui/Pane.hs view
@@ -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)
+ lib/Chiasma/Ui/ShowTree.hs view
@@ -0,0 +1,45 @@+module Chiasma.Ui.ShowTree where++import Chiasma.Data.Ident (identText)+import Chiasma.Ui.Data.View (+  LayoutView,+  Pane (Pane),+  PaneView,+  Tree (Tree),+  TreeSub (TreeLeaf, TreeNode),+  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
+ lib/Chiasma/Ui/ViewTree.hs view
@@ -0,0 +1,306 @@+module Chiasma.Ui.ViewTree where++import Control.Lens (cosmos, ix, transformM)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT)+import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)+import Data.Composition ((.:))+import Data.Semigroup (Sum (Sum))+import Exon (exon)+import Prelude hiding (ix, tell)++import Chiasma.Data.Ident (Ident)+import Chiasma.Lens.Tree (LeafIndexTree (..), _litTree, leafDataTraversal)+import Chiasma.Ui.Data.TreeModError (TreeModError (AmbiguousLayout, AmbiguousPane, LayoutMissing, PaneMissing))+import Chiasma.Ui.Data.View (+  Pane (Pane),+  PaneView,+  Tree (Tree),+  TreeSub (TreeLeaf, TreeNode),+  View (View),+  ViewTree,+  ViewTreeSub,+  )+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 -> pure result+    0 -> ExceptT (pure (Left (LayoutMissing ident)))+    n -> ExceptT (pure (Left (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 -> pure $ (.litTree) result+    0 -> ExceptT (pure (Left (PaneMissing ident)))+    n -> ExceptT (pure (Left (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 stock (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 stock (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++toggleResultEither :: ToggleResult a -> Either Text a+toggleResultEither = \case+  Success a -> Right a+  NotFound -> Left "not found"+  Ambiguous n -> Left [exon|ambiguous: #{show 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 (#_TreeLeaf . #extra . #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
+ lib/Chiasma/View.hs view
@@ -0,0 +1,125 @@+module Chiasma.View where++import qualified Control.Lens as Lens+import Exon (exon)+import Prettyprinter (Doc, pretty)+import Prettyprinter.Render.Terminal (AnsiStyle)++import Chiasma.Data.Ident (Ident, identText, sameIdent)+import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)+import qualified Chiasma.Data.View+import Chiasma.Data.View (View (View))+import Chiasma.Data.Views (Views, ViewsError (..))+import qualified Chiasma.Data.Views as Views (log, panes, sessions, windows)+import Chiasma.Lens.Where (where1)++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 = over viewsL (newView :)++updateView ::+  ∀ a .+  Lens' Views [View a] ->+  (Ident -> ViewsError) ->+  View a ->+  Views ->+  Views+updateView viewsL _ newView =+  set (viewsL . where1 (sameIdent newView.ident)) 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++viewsLog ::+  Member (AtomicState Views) r =>+  Doc AnsiStyle ->+  Sem r ()+viewsLog message =+  atomicModify' f+  where+    f :: Views -> Views+    f = over Views.log (message :)++viewsLogS ::+  Member (AtomicState Views) r =>+  Text ->+  Sem r ()+viewsLogS =+  viewsLog . pretty++addView ::+  Member (AtomicState Views) r =>+  Setter a ->+  Ident ->+  Sem r (View a)+addView setter ident = do+  atomicModify' (setter newView)+  viewsLogS [exon|added tmux view #{identText ident}|]+  pure newView+  where+    newView =+      View ident Nothing++findOrCreateView ::+  Member (AtomicState Views) r =>+  Getter a ->+  Setter a ->+  Ident ->+  Sem r (View a)+findOrCreateView getter setter ident = do+  existing <- atomicGets (getter ident)+  either (const (addView setter ident)) pure existing
+ lib/Chiasma/View/State.hs view
@@ -0,0 +1,13 @@+module Chiasma.View.State where++import Chiasma.Data.Ident (Ident)+import Chiasma.Data.TmuxId (PaneId)+import Chiasma.Data.Views (Views, ViewsError)+import qualified Chiasma.View as Views (paneId)++paneId ::+  Members [AtomicState Views, Stop ViewsError] r =>+  Ident ->+  Sem r PaneId+paneId paneIdent =+  stopEither =<< atomicGets (Views.paneId paneIdent)
+ lib/Chiasma/Window.hs view
@@ -0,0 +1,224 @@+module Chiasma.Window where++import qualified Data.List.NonEmpty as NonEmpty (head, nonEmpty)+import Path (Abs, Dir, Path, parseAbsDir)+import Prettyprinter (line, pretty, vsep, (<+>))++import qualified Chiasma.Codec.Data.Pane as Pane+import qualified Chiasma.Codec.Data.Pane as Codec (Pane (Pane))+import Chiasma.Codec.Data.Pane (Pane (Pane))+import qualified Chiasma.Codec.Data.Window as Codec (Window (Window, windowId))+import qualified Chiasma.Command.Pane as Cmd (closePane, firstWindowPane, windowPanes)+import qualified Chiasma.Command.Window as Cmd (newWindow, splitWindowInDir, window)+import Chiasma.Data.Axis (Axis)+import Chiasma.Data.Ident (Ident, identText, identify)+import Chiasma.Data.Panes (TmuxPanes)+import Chiasma.Data.RenderError (RenderError)+import qualified Chiasma.Data.RenderError as RenderError (RenderError (NoPrincipal))+import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)+import qualified Chiasma.Data.View as Tmux (View (View))+import Chiasma.Data.Views (Views)+import Chiasma.Data.WindowState (WindowState (..))+import Chiasma.Effect.TmuxApi (Tmux)+import Chiasma.Pane (addPane)+import Chiasma.Ui.Data.RenderableTree (RLayout (..), RPane (..), Renderable (..), RenderableNode, RenderableTree)+import qualified Chiasma.Ui.Data.Tree as Tree (Node (Leaf, Sub), 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)++findOrCreateWindow ::+  Member (AtomicState Views) r =>+  Ident ->+  Sem r (Tmux.View WindowId)+findOrCreateWindow =+  findOrCreateView Views.window Views.insertWindow++registerWindowId ::+  Member (AtomicState Views) r =>+  Ident ->+  WindowId ->+  Sem r ()+registerWindowId ident windowId =+  atomicModify' (Views.updateWindow (Tmux.View ident (Just windowId)))++spawnWindow ::+  Members [AtomicState Views, Tmux] r =>+  SessionId ->+  Ident ->+  Sem r 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+  pure 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) =+  firstJust findPrincipalSub sub++principalPane ::+  Members [AtomicState Views, Tmux, Stop RenderError] r =>+  ViewTree ->+  Sem r (Ui.PaneView, Tmux.View PaneId)+principalPane tree = do+  uiPane@(Ui.View uiPaneIdent _ _ _) <- stopNote (RenderError.NoPrincipal (identify tree)) $ (findPrincipal tree)+  existingTmuxPane <- atomicGets (Views.pane uiPaneIdent)+  tmuxPane <- either (const $ addPane uiPaneIdent) pure existingTmuxPane+  pure (uiPane, tmuxPane)++syncPrincipal ::+  Members [TmuxPanes Pane, AtomicState Views, Tmux, Stop RenderError] r =>+  WindowId ->+  ViewTree ->+  Sem r ()+syncPrincipal windowId tree@(Tree (Ui.View layoutIdent _ _ _) _) = do+  (Codec.Pane paneId _ _ _ _) <- Cmd.firstWindowPane windowId+  existing <- atomicGets (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+      atomicModify' $ Views.updatePane (Tmux.View paneIdent (Just paneId))+    _ -> pure ()++ensureWindow ::+  Members [TmuxPanes Pane, AtomicState Views, Tmux, Stop RenderError] r =>+  SessionId ->+  Tmux.View WindowId ->+  Maybe WindowId ->+  ViewTree ->+  Sem r Codec.Window+ensureWindow sid (Tmux.View ident mayWid) newSessionWid tree = do+  preexisting <- join <$> traverse Cmd.window (newSessionWid <|> mayWid)+  window <- maybe (spawnWindow sid ident) pure preexisting+  syncPrincipal ((.windowId) window) tree+  pure window++findOrCreatePane ::+  Member (AtomicState Views) r =>+  Ident ->+  Sem r (Tmux.View PaneId)+findOrCreatePane =+  findOrCreateView Views.pane Views.insertPane++nativePane ::+  Member (TmuxPanes Pane) r =>+  WindowId ->+  Tmux.View PaneId ->+  Sem r (Maybe Pane)+nativePane windowId (Tmux.View _ (Just paneId)) =+  find sameId <$> Cmd.windowPanes windowId+  where+    sameId (Pane i _ _ _ _) = i == paneId+nativePane _ _ = pure Nothing++openPane ::+  Members [AtomicState Views, Tmux] r =>+  Path Abs Dir ->+  WindowId ->+  Sem r Pane+openPane dir windowId = do+  detail <- Cmd.splitWindowInDir dir windowId+  viewsLogS $ "opened pane " <> show ((.paneId) detail) <> " in window " <> show windowId+  pure detail++ensurePaneOpen ::+  Members [AtomicState Views, Tmux] r =>+  Path Abs Dir ->+  Maybe Pane ->+  WindowId ->+  Sem r Pane+ensurePaneOpen _ (Just detail) _ =+  pure detail+ensurePaneOpen dir Nothing windowId =+  openPane dir windowId++ensurePaneClosed ::+  Members [AtomicState Views, Tmux] r =>+  Maybe Pane ->+  Sem r ()+ensurePaneClosed (Just (Pane i _ _ _ _)) = do+  viewsLogS $ "closing pane " <> show i+  Cmd.closePane i+ensurePaneClosed _ = pure ()++ensurePane ::+  Members [TmuxPanes Pane, AtomicState Views, Tmux] r =>+  Path Abs Dir ->+  WindowId ->+  Ui.PaneView ->+  Sem r (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+  atomicModify' $ Views.updatePane (Tmux.View paneIdent ((.paneId) <$> updatedPane))+  pure $ cons <$> updatedPane+  where+    dir = fromMaybe cwd (parseAbsDir . toString =<< customDir)+    cons (Pane 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 ->+  Axis ->+  [RenderableNode] ->+  Maybe RenderableTree+renderableTree vState geometry axis sub = do+  sub' <- NonEmpty.nonEmpty sub+  pure $ Tree.Tree (Renderable vState geometry (RLayout (refPane $ NonEmpty.head sub') axis)) 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 ::+  Members [TmuxPanes Pane, AtomicState Views, Tmux] r =>+  Path Abs Dir ->+  WindowId ->+  ViewTree ->+  Sem r (Maybe RenderableTree)+ensureView cwd windowId =+  ensureTree+  where+    ensureTree (Tree (Ui.View layoutIdent vState geometry (Ui.Layout axis)) sub) = do+      ensuredSub <- traverse ensureNode sortedSub+      viewsLog $ pretty ("new sub for layout `" <> identText layoutIdent <> "`:") <> line <>+        vsep (pretty <$> ensuredSub)+      pure $ renderableTree vState geometry axis $ catMaybes ensuredSub+      where+        sortedSub = sortOn viewPosition sub+    ensureNode (TreeNode t) = do+      newTree <- ensureTree t+      pure $ Tree.Sub <$> newTree+    ensureNode (TreeLeaf v) =+      ensurePane cwd windowId v++windowState ::+  Member (TmuxPanes Pane) r =>+  Ident ->+  Codec.Window ->+  RenderableTree ->+  Sem r WindowState+windowState windowIdent window tree = do+  nativeRef <- Cmd.firstWindowPane window.windowId+  pure $ WindowState window nativeRef windowIdent tree nativeRef.paneId
+ readme.md view
@@ -0,0 +1,3 @@+# Intro++**Chiasma** is a [tmux](https://github.com/tmux/tmux) api client for [Haskell](https://www.haskell.org/).
− test/u/BufferedSpec.hs
@@ -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
− test/u/CodecSpec.hs
@@ -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)
− test/u/OutputParseSpec.hs
@@ -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)
− test/u/SimpleSpec.hs
@@ -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]))
− test/u/SpecMain.hs
@@ -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