packages feed

chiasma 0.11.0.0 → 0.12.0.0

raw patch · 20 files changed

+174/−293 lines, 20 filesdep ~attoparsecdep ~basedep ~compositionPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: attoparsec, base, composition, lens, parsers, polysemy-conc, polysemy-log, polysemy-process, polysemy-time, prelate, prettyprinter, prettyprinter-ansi-terminal, random, typed-process, uuid

API changes (from Hackage documentation)

- Chiasma.Data.Event: WindowClosed :: WindowId -> Event
- Chiasma.Data.Event: data Event
- Chiasma.Data.Event: instance GHC.Classes.Eq Chiasma.Data.Event.Event
- Chiasma.Data.Event: instance GHC.Internal.Show.Show Chiasma.Data.Event.Event
- Chiasma.Data.ReceiveEvent: [ReceiveEvent] :: ReceiveEvent Event
- Chiasma.Data.ReceiveEvent: data ReceiveEvent a
- Chiasma.Effect.TmuxClient: flush :: forall e d (r :: EffectRow). Member (TmuxClient e d) r => InterpreterFor (TmuxClient e d) r
- Chiasma.Event: listen :: forall enc dec err t d (r :: EffectRow). (Show err, Member (Codec ReceiveEvent enc dec !! err) r, Members '[Scoped_ (TmuxClient enc dec) !! TmuxError, Events Event, Time t d, Log] r) => Sem r ()
- Chiasma.Event: listenLoop :: forall err t d (r :: EffectRow). (Show err, Members '[TmuxApi ReceiveEvent !! err, Events Event, Time t d, Log] r) => Sem r ()
- Chiasma.Event: receiveEvent :: forall (r :: EffectRow). Members '[TmuxApi ReceiveEvent, Events Event] r => Sem r ()
- Chiasma.Event: withTmuxEvents :: forall err enc dec (r :: EffectRow) t d a. (Show err, Member (Codec ReceiveEvent enc dec !! err) r, Member (Scoped_ (TmuxClient enc dec) !! TmuxError) r, Members '[Events Event, Time t d, Log, Race, Async, Resource] r) => Sem r a -> Sem r a
- Chiasma.Interpreter.ProcessOutput: interpretProcessOutputTmuxBlock :: forall (p :: OutputPipe) (r :: EffectRow). Member (Embed IO) r => InterpreterFor (ProcessOutput p (Either Text TmuxOutputBlock)) r
- Chiasma.Interpreter.TmuxApi: flush :: forall (c :: Type -> Type) (r :: EffectRow). Member (TmuxApi c) r => InterpreterFor (TmuxApi c) r
+ Chiasma.Data.TmuxEvent: Notification :: TmuxNotification -> TmuxEvent
+ Chiasma.Data.TmuxEvent: Response :: TmuxOutputBlock -> TmuxEvent
+ Chiasma.Data.TmuxEvent: data TmuxEvent
+ Chiasma.Data.TmuxEvent: instance GHC.Classes.Eq Chiasma.Data.TmuxEvent.TmuxEvent
+ Chiasma.Data.TmuxEvent: instance GHC.Internal.Show.Show Chiasma.Data.TmuxEvent.TmuxEvent
+ Chiasma.Data.TmuxNotification: TmuxNotification :: Text -> [Text] -> TmuxNotification
+ Chiasma.Data.TmuxNotification: [args] :: TmuxNotification -> [Text]
+ Chiasma.Data.TmuxNotification: [name] :: TmuxNotification -> Text
+ Chiasma.Data.TmuxNotification: data TmuxNotification
+ Chiasma.Data.TmuxNotification: instance GHC.Classes.Eq Chiasma.Data.TmuxNotification.TmuxNotification
+ Chiasma.Data.TmuxNotification: instance GHC.Classes.Ord Chiasma.Data.TmuxNotification.TmuxNotification
+ Chiasma.Data.TmuxNotification: instance GHC.Internal.Show.Show Chiasma.Data.TmuxNotification.TmuxNotification
+ Chiasma.Effect.TmuxApi: [ReceiveNotification] :: forall (command :: Type -> Type) (a :: Type -> Type). TmuxApi command a TmuxNotification
+ Chiasma.Effect.TmuxApi: receiveNotification :: forall (command :: Type -> Type) (r :: EffectRow). Member (TmuxApi command) r => Sem r TmuxNotification
+ Chiasma.Effect.TmuxClient: [ReceiveNotification] :: forall i o (a :: Type -> Type). TmuxClient i o a TmuxNotification
+ Chiasma.Effect.TmuxClient: receiveNotification :: forall i o (r :: EffectRow). Member (TmuxClient i o) r => Sem r TmuxNotification
+ Chiasma.Interpreter.ProcessOutput: interpretProcessOutputTmuxEvent :: forall (p :: OutputPipe) (r :: EffectRow). Member (Embed IO) r => InterpreterFor (ProcessOutput p (Either Text TmuxEvent)) r
+ Chiasma.Interpreter.TmuxClient: drainInitial :: forall (r :: EffectRow). Members '[TmuxProc, Log] r => Sem r ()
+ Chiasma.Interpreter.TmuxClient: receiverLoop :: forall (r :: EffectRow). Members '[Events TmuxEvent, TmuxProc, Log] r => Sem r ()
+ Chiasma.Native.TmuxOutputBlock: messageParser :: Parser TmuxEvent
+ Chiasma.Native.TmuxOutputBlock: notificationLine :: (CharParsing m, Monad m) => m TmuxNotification
+ Chiasma.Native.TmuxOutputBlock: parseMessage :: (CharParsing m, Monad m, LookAheadParsing m) => m TmuxEvent
+ Chiasma.Native.TmuxOutputBlock: word :: CharParsing m => m Text
- Chiasma.Interpreter.ProcessOutput: parseResult :: forall (r :: EffectRow). Member (AtomicState (Maybe ParseCont) :: (Type -> Type) -> Type -> Type) r => ParseResult -> Sem r ([Either Text TmuxOutputBlock], ByteString)
+ Chiasma.Interpreter.ProcessOutput: parseResult :: forall (r :: EffectRow). Member (AtomicState (Maybe ParseCont) :: (Type -> Type) -> Type -> Type) r => ParseResult -> Sem r ([Either Text TmuxEvent], ByteString)
- Chiasma.Interpreter.ProcessOutput: type ParseCont = ByteString -> IResult ByteString TmuxOutputBlock
+ Chiasma.Interpreter.ProcessOutput: type ParseCont = ByteString -> IResult ByteString TmuxEvent
- Chiasma.Interpreter.ProcessOutput: type ParseResult = IResult ByteString TmuxOutputBlock
+ Chiasma.Interpreter.ProcessOutput: type ParseResult = IResult ByteString TmuxEvent
- Chiasma.Interpreter.TmuxClient: flush :: forall (r :: EffectRow). Members '[TmuxProc, AtomicState (Seq TmuxRequest) :: (Type -> Type) -> Type -> Type, Log, Stop TmuxError] r => Sem r ()
+ Chiasma.Interpreter.TmuxClient: flush :: forall (r :: EffectRow). Members '[EventConsumer TmuxEvent, TmuxProc, AtomicState (Seq TmuxRequest) :: (Type -> Type) -> Type -> Type, Lock, Log, Stop TmuxError] r => Sem r ()
- Chiasma.Interpreter.TmuxClient: interpretTmuxNative :: forall (r :: EffectRow). Members '[Reader TmuxNative, Log, Resource, Race, Async, Embed IO] r => InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
+ Chiasma.Interpreter.TmuxClient: interpretTmuxNative :: forall (r :: EffectRow). Members '[Reader TmuxNative, Log, Resource, Race, Async, Final IO, Embed IO] r => InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
- Chiasma.Interpreter.TmuxClient: interpretTmuxNativeEnv :: forall (r :: EffectRow). Members '[Error TmuxError :: (Type -> Type) -> Type -> Type, Log, Resource, Race, Async, Embed IO] r => Maybe (Path Abs File) -> InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
+ Chiasma.Interpreter.TmuxClient: interpretTmuxNativeEnv :: forall (r :: EffectRow). Members '[Error TmuxError :: (Type -> Type) -> Type -> Type, Log, Resource, Race, Async, Final IO, Embed IO] r => Maybe (Path Abs File) -> InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
- Chiasma.Interpreter.TmuxClient: interpretTmuxNativeEnvGraceful :: forall (r :: EffectRow). Members '[Log, Resource, Race, Async, Embed IO] r => Maybe (Path Abs File) -> InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
+ Chiasma.Interpreter.TmuxClient: interpretTmuxNativeEnvGraceful :: forall (r :: EffectRow). Members '[Log, Resource, Race, Async, Final IO, Embed IO] r => Maybe (Path Abs File) -> InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
- Chiasma.Interpreter.TmuxClient: interpretTmuxProcessBuffered :: forall (r :: EffectRow). Members '[AtomicState (Seq TmuxRequest) :: (Type -> Type) -> Type -> Type, Scoped_ TmuxProc !! ProcessError, Log, Embed IO] r => InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
+ Chiasma.Interpreter.TmuxClient: interpretTmuxProcessBuffered :: forall (r :: EffectRow). (Members '[AtomicState (Seq TmuxRequest) :: (Type -> Type) -> Type -> Type, Scoped_ TmuxProc !! ProcessError] r, Members '[Lock, Log, Resource, Race, Async, Embed IO] r) => InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
- Chiasma.Interpreter.TmuxClient: interpretTmuxWithProcess :: forall (r :: EffectRow). Members '[Scoped_ TmuxProc !! ProcessError, Log, Embed IO] r => InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
+ Chiasma.Interpreter.TmuxClient: interpretTmuxWithProcess :: forall (r :: EffectRow). Members '[Scoped_ TmuxProc !! ProcessError, Log, Resource, Race, Async, Final IO, Embed IO] r => InterpreterFor (Scoped_ (TmuxClient TmuxRequest TmuxResponse) !! TmuxError) r
- Chiasma.Interpreter.TmuxClient: tmuxRequest :: forall (r :: EffectRow). Members '[Process ByteString (Either Text TmuxOutputBlock), Log, Stop TmuxError] r => TmuxRequest -> Sem r TmuxResponse
+ Chiasma.Interpreter.TmuxClient: tmuxRequest :: forall (r :: EffectRow). Members '[TmuxProc, EventConsumer TmuxEvent, Lock, Log, Stop TmuxError] r => TmuxRequest -> Sem r TmuxResponse
- Chiasma.Interpreter.TmuxClient: tmuxSession :: forall (r :: EffectRow) a. Members '[Scoped_ TmuxProc !! ProcessError, AtomicState (Seq TmuxRequest) :: (Type -> Type) -> Type -> Type, Log, Stop TmuxError] r => Sem (TmuxProc ': r) a -> Sem r a
+ Chiasma.Interpreter.TmuxClient: tmuxSession :: forall (r :: EffectRow) a. (Members '[Scoped_ TmuxProc !! ProcessError, AtomicState (Seq TmuxRequest) :: (Type -> Type) -> Type -> Type, Stop TmuxError] r, Members '[Lock, Log, Resource, Race, Async, Embed IO] r) => Sem (Consume TmuxEvent ': (EventConsumer TmuxEvent ': (TmuxProc ': r))) a -> Sem r a
- Chiasma.Interpreter.TmuxClient: type TmuxProc = Process ByteString Either Text TmuxOutputBlock
+ Chiasma.Interpreter.TmuxClient: type TmuxProc = Process ByteString Either Text TmuxEvent
- Chiasma.Interpreter.TmuxClient: type TmuxQueues = ProcessQueues Either Text TmuxOutputBlock Text
+ Chiasma.Interpreter.TmuxClient: type TmuxQueues = ProcessQueues Either Text TmuxEvent Text

Files

chiasma.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           chiasma-version:        0.11.0.0+version:        0.12.0.0 synopsis:       A tmux client for Polysemy description:    See https://hackage.haskell.org/package/chiasma/docs/Chiasma.html category:       Terminal@@ -51,7 +51,6 @@       Chiasma.Data.CopyModeParams       Chiasma.Data.DecodeError       Chiasma.Data.Direction-      Chiasma.Data.Event       Chiasma.Data.Ident       Chiasma.Data.KillPaneParams       Chiasma.Data.LayoutError@@ -60,7 +59,6 @@       Chiasma.Data.PaneSelection       Chiasma.Data.PipePaneParams       Chiasma.Data.ProcessError-      Chiasma.Data.ReceiveEvent       Chiasma.Data.RenderError       Chiasma.Data.ResizePaneParams       Chiasma.Data.SelectParams@@ -72,13 +70,14 @@       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.TmuxThunk       Chiasma.Data.View       Chiasma.Data.Views       Chiasma.Data.WindowParams@@ -88,7 +87,6 @@       Chiasma.Effect.Codec       Chiasma.Effect.TmuxApi       Chiasma.Effect.TmuxClient-      Chiasma.Event       Chiasma.Function       Chiasma.Interpreter.Codec       Chiasma.Interpreter.ProcessOutput@@ -97,8 +95,6 @@       Chiasma.Interpreter.TmuxClient       Chiasma.Lens.Tree       Chiasma.Lens.Where-      Chiasma.Monad.EvalFreeT-      Chiasma.Monad.Tmux       Chiasma.Native.Parse       Chiasma.Native.TmuxOutputBlock       Chiasma.Pack@@ -166,32 +162,32 @@       ViewPatterns   ghc-options: -fplugin=Polysemy.Plugin -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages   build-depends:-      attoparsec-    , base <5+      attoparsec >=0.13+    , base ==4.*     , bytestring-    , composition+    , composition >=1.0     , containers     , exon     , extra     , first-class-families-    , lens+    , lens >=4     , parsec-    , parsers+    , parsers >=0.12     , path     , polysemy-    , polysemy-conc-    , polysemy-log+    , polysemy-conc >=0.9+    , polysemy-log >=0.7     , polysemy-plugin-    , polysemy-process-    , polysemy-time-    , prelate-    , prettyprinter-    , prettyprinter-ansi-terminal-    , random+    , 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-    , uuid+    , typed-process >=0.2+    , uuid >=1.3   mixins:       base hiding (Prelude)     , prelate (Prelate as Prelude)
lib/Chiasma/Codec.hs view
@@ -11,7 +11,7 @@ import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId) import Chiasma.Data.TmuxQuery (TmuxQuery (TmuxQuery)) --- |Remove one leading and trailing space from tmux output if both are present.+-- | 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
− lib/Chiasma/Data/Event.hs
@@ -1,7 +0,0 @@-module Chiasma.Data.Event where--import Chiasma.Data.TmuxId (WindowId)--data Event =-  WindowClosed WindowId-  deriving stock (Eq, Show)
lib/Chiasma/Data/Panes.hs view
@@ -15,20 +15,20 @@ import Chiasma.Data.WithPaneId (WithPaneId (WithPaneId)) import Chiasma.Effect.TmuxApi (TmuxApi) --- |A 'TmuxApi' command for listing panes, with different query criteria.+-- | 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.+  -- | Return all panes covered by the selection.   List :: PaneSelection -> Panes p [p]-  -- |Return one pane covered by the selection, fail if there is none.+  -- | 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.+  -- | 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.+  -- | 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.+  -- | Return the pane with the specified ID if it exists.   Find :: PaneId -> Panes p (Maybe p)  type TmuxPanes p =
− lib/Chiasma/Data/ReceiveEvent.hs
@@ -1,6 +0,0 @@-module Chiasma.Data.ReceiveEvent where--import Chiasma.Data.Event (Event)--data ReceiveEvent :: Type -> Type where-  ReceiveEvent :: ReceiveEvent Event
+ 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/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/TmuxThunk.hs
@@ -1,16 +0,0 @@-module Chiasma.Data.TmuxThunk where---- import Chiasma.Codec.Decode (DecodeFailure)--- import Chiasma.Data.Cmd (Cmd(..))--- import Chiasma.Data.TmuxError (TmuxError(..))---- data TmuxThunk next =---   ∀ a . Read Cmd (Text -> Either DecodeFailure a) ([a] -> next)---   |---   Write Cmd (() -> next)---   |---   Flush (() -> next)---   |---   Failed TmuxError---- deriving instance Functor TmuxThunk
lib/Chiasma/Effect/TmuxApi.hs view
@@ -1,10 +1,13 @@ 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 
lib/Chiasma/Effect/TmuxClient.hs view
@@ -2,12 +2,15 @@  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 @@ -16,13 +19,3 @@  type NativeTmux =   ScopedTmux TmuxRequest TmuxResponse--flush ::-  Member (TmuxClient e d) r =>-  InterpreterFor (TmuxClient e d) r-flush =-  interpret \case-    Send cmd ->-      send cmd-    Schedule cmd ->-      void (send cmd)
− lib/Chiasma/Event.hs
@@ -1,58 +0,0 @@-module Chiasma.Event where--import Exon (exon)-import qualified Polysemy.Conc as Conc-import Polysemy.Conc (withAsync_)-import qualified Polysemy.Log as Log-import qualified Polysemy.Time as Time-import Polysemy.Time (Seconds (Seconds))-import Prelude hiding (listen)--import Chiasma.Data.Event (Event)-import Chiasma.Data.ReceiveEvent (ReceiveEvent (ReceiveEvent))-import Chiasma.Data.TmuxError (TmuxError)-import Chiasma.Effect.Codec (Codec)-import qualified Chiasma.Effect.TmuxApi as TmuxApi-import Chiasma.Effect.TmuxApi (TmuxApi)-import Chiasma.Effect.TmuxClient (TmuxClient)-import Chiasma.Tmux (withTmux)--receiveEvent ::-  ∀ r .-  Members [TmuxApi ReceiveEvent, Events Event] r =>-  Sem r ()-receiveEvent =-  Conc.publish =<< TmuxApi.send ReceiveEvent--listenLoop ::-  ∀ err t d r .-  Show err =>-  Members [TmuxApi ReceiveEvent !! err, Events Event, Time t d, Log] r =>-  Sem r ()-listenLoop = do-  resume @_ @(TmuxApi _) receiveEvent \ err ->-    Log.error [exon|Receiving tmux event: #{show err}|]-  listenLoop--listen ::-  ∀ enc dec err t d r .-  Show err =>-  Member (Codec ReceiveEvent enc dec !! err) r =>-  Members [Scoped_ (TmuxClient enc dec) !! TmuxError, Events Event, Time t d, Log] r =>-  Sem r ()-listen = do-  resume @_ @(Scoped_ _) (withTmux listenLoop) \ err -> do-    Log.error [exon|Lost connection to tmux: #{show err}-Reconnecting...|]-    Time.sleep (Seconds 1)--withTmuxEvents ::-  Show err =>-  Member (Codec ReceiveEvent enc dec !! err) r =>-  Member (Scoped_ (TmuxClient enc dec) !! TmuxError) r =>-  Members [Events Event, Time t d, Log, Race, Async, Resource] r =>-  Sem r a ->-  Sem r a-withTmuxEvents =-  withAsync_ do-    forever listen
lib/Chiasma/Interpreter/Codec.hs view
@@ -30,14 +30,12 @@   InterpreterFor (Codec TmuxCommand TmuxRequest TmuxResponse !! CodecError) r interpretCodecTmuxCommand =   interpretCodecNative TmuxCommand.encode TmuxCommand.decode-{-# inline interpretCodecTmuxCommand #-}  interpretCodecPanes ::   TmuxCodec p =>   InterpreterFor (Codec (Panes p) TmuxRequest TmuxResponse !! CodecError) r interpretCodecPanes =   interpretCodecNative Panes.encode Panes.decode-{-# inline interpretCodecPanes #-}  interpretCodecPure ::   (∀ a . command a -> Sem r (Either Text a)) ->
lib/Chiasma/Interpreter/ProcessOutput.hs view
@@ -5,35 +5,34 @@ import Polysemy.Conc (interpretAtomic) import Polysemy.Process.Effect.ProcessOutput (ProcessOutput (Chunk)) -import Chiasma.Data.TmuxOutputBlock (TmuxOutputBlock)-import Chiasma.Native.TmuxOutputBlock (parser)+import Chiasma.Data.TmuxEvent (TmuxEvent)+import Chiasma.Native.TmuxOutputBlock (messageParser)  type ParseResult =-  IResult ByteString TmuxOutputBlock+  IResult ByteString TmuxEvent  type ParseCont =-  ByteString -> IResult ByteString TmuxOutputBlock+  ByteString -> IResult ByteString TmuxEvent  parseResult ::   Member (AtomicState (Maybe ParseCont)) r =>   ParseResult ->-  Sem r ([Either Text TmuxOutputBlock], ByteString)+  Sem r ([Either Text TmuxEvent], ByteString) parseResult = \case   Fail _ _ err -> pure ([Left (toText err)], "")   Partial c -> ([], "") <$ atomicPut (Just c)   Done rest block -> pure ([Right block], rest) -interpretProcessOutputTmuxBlock ::+interpretProcessOutputTmuxEvent ::   ∀ p r .   Member (Embed IO) r =>-  InterpreterFor (ProcessOutput p (Either Text TmuxOutputBlock)) r-interpretProcessOutputTmuxBlock =+  InterpreterFor (ProcessOutput p (Either Text TmuxEvent)) r+interpretProcessOutputTmuxEvent =   interpretAtomic (Nothing :: Maybe ParseCont) .-  interpret \case+  reinterpret \case     Chunk _ new ->       atomicState' (Nothing,) >>= \case         Just cont ->           parseResult (cont new)         Nothing ->-          parseResult (parse parser new)-  . raiseUnder+          parseResult (parse messageParser new)
lib/Chiasma/Interpreter/TmuxApi.hs view
@@ -8,7 +8,7 @@ import Chiasma.Data.TmuxRequest (TmuxRequest) import Chiasma.Data.TmuxResponse (TmuxResponse) import Chiasma.Effect.Codec (Codec, encode, withCodec)-import Chiasma.Effect.TmuxApi (TmuxApi (Schedule, Send), send)+import Chiasma.Effect.TmuxApi (TmuxApi (..)) import qualified Chiasma.Effect.TmuxClient as TmuxClient import Chiasma.Effect.TmuxClient (TmuxClient) @@ -16,16 +16,6 @@   f <$> fa =     FMap (Pure1 f) @@ fa -flush ::-  Member (TmuxApi c) r =>-  InterpreterFor (TmuxApi c) r-flush =-  interpret \case-    Send cmd ->-      send cmd-    Schedule cmd ->-      void (send cmd)- interpretTmuxApi ::   ∀ command i o err r .   Members [TmuxClient i o, Codec command i o !! err] r =>@@ -38,6 +28,8 @@     Schedule cmd -> do       encoded <- restop (encode cmd)       TmuxClient.schedule encoded+    ReceiveNotification ->+      TmuxClient.receiveNotification  data TmuxApiEffect :: Type -> (Type -> Type) -> Exp Effect 
lib/Chiasma/Interpreter/TmuxClient.hs view
@@ -1,11 +1,13 @@ module Chiasma.Interpreter.TmuxClient where -import Conc (interpretAtomic)+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 (@@ -27,7 +29,10 @@  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@@ -35,13 +40,13 @@ import Chiasma.Data.TmuxResponse (TmuxResponse (TmuxResponse)) import qualified Chiasma.Effect.TmuxClient as TmuxClient import Chiasma.Effect.TmuxClient (TmuxClient)-import Chiasma.Interpreter.ProcessOutput (interpretProcessOutputTmuxBlock)+import Chiasma.Interpreter.ProcessOutput (interpretProcessOutputTmuxEvent)  type TmuxQueues =-  ProcessQueues (Either Text TmuxOutputBlock) Text+  ProcessQueues (Either Text TmuxEvent) Text  type TmuxProc =-  Process ByteString (Either Text TmuxOutputBlock)+  Process ByteString (Either Text TmuxEvent)  validate :: TmuxRequest -> TmuxOutputBlock -> Either TmuxError TmuxResponse validate request = \case@@ -50,18 +55,20 @@   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 [Process ByteString (Either Text TmuxOutputBlock), Log, Stop TmuxError] r =>+  Members [TmuxProc, EventConsumer TmuxEvent, Lock, Log, Stop TmuxError] r =>   TmuxRequest ->   Sem r TmuxResponse-tmuxRequest request = do-  Log.trace [exon|tmux request: #{Text.stripEnd (decodeUtf8 cmdline)}|]-  Process.send cmdline-  Process.recv >>= \case-    Left err -> stop (TmuxError.RequestFailed request [err])-    Right block -> do-      Log.trace [exon|tmux response: #{show block}|]-      stopEither (validate request block)+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@@ -88,62 +95,100 @@   Members [Resource, Race, Async, Embed IO] r =>   InterpreterFor (Scoped_ TmuxProc !! ProcessError) r interpretProcessTmux sem = do-  interpretProcessOutputTmuxBlock @'Stdout $+  interpretProcessOutputTmuxEvent @'Stdout $     interpretProcessOutputTextLines @'Stderr $     interpretProcessOutputLeft @'Stderr $     interpretProcessInputId $     interpretProcess_ def $     insertAt @1 sem-{-# inline interpretProcessTmux #-} +-- | 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 [TmuxProc, AtomicState (Seq TmuxRequest), Log, Stop TmuxError] r =>+  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), Log, Stop TmuxError] r =>-  Sem (TmuxProc : 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 @ProcessError @(Scoped_ TmuxProc) TmuxError.ProcessFailed $ withProcess_ do-    void Process.recv-    tmuxRequest (TmuxRequest "refresh-client" ["-C", "10000x10000"] Nothing)-    raiseUnder action <* flush+  resumeHoist TmuxError.ProcessFailed $ withProcess_ do+    drainInitial+    Conc.interpretEventsChan do+      withAsync_ receiverLoop do+        subscribe do+          void $ tmuxRequest (TmuxRequest "refresh-client" ["-C", "10000x10000"] Nothing)+          subsume_ action <* flush  interpretTmuxProcessBuffered ::-  Members [AtomicState (Seq TmuxRequest), Scoped_ TmuxProc !! ProcessError, Log, Embed IO] r =>+  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_ @'[TmuxProc] (const tmuxSession) \case+  interpretScopedResumableWith_ @'[Consume TmuxEvent, EventConsumer TmuxEvent, TmuxProc] (const tmuxSession) \case     TmuxClient.Schedule request ->       atomicModify' (|> request)     TmuxClient.Send cmd -> do       flush       tmuxRequest cmd-{-# inline interpretTmuxProcessBuffered #-}+    TmuxClient.ReceiveNotification ->+      Conc.consumeFirstJust $ pure . \case+        TmuxEvent.Notification n -> Just n+        TmuxEvent.Response _ -> Nothing  interpretTmuxWithProcess ::-  Members [Scoped_ TmuxProc !! ProcessError, Log, Embed IO] r =>+  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 .-  raiseUnder-{-# inline interpretTmuxWithProcess #-}+  raiseUnder3  interpretTmuxNative ::   ∀ r .-  Members [Reader TmuxNative, Log, Resource, Race, Async, Embed IO] 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-{-# inline interpretTmuxNative #-}  interpretTmuxFailing ::   TmuxError ->@@ -154,6 +199,8 @@       stop err     TmuxClient.Send _ ->       stop err+    TmuxClient.ReceiveNotification ->+      stop err  withTmuxNativeEnv ::   Member (Embed IO) r =>@@ -170,25 +217,22 @@ runReaderTmuxNativeEnv socket sem = do   tn <- withTmuxNativeEnv socket (note NoExe)   runReader tn sem-{-# inline runReaderTmuxNativeEnv #-}  interpretTmuxNativeEnv ::-  Members [Error TmuxError, Log, Resource, Race, Async, Embed IO] r =>+  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-{-# inline interpretTmuxNativeEnv #-}  interpretTmuxNativeEnvGraceful ::-  Members [Log, Resource, Race, Async, Embed IO] r =>+  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-{-# inline interpretTmuxNativeEnvGraceful #-}  interpretTmuxClientNull ::   InterpreterFor (Scoped_ (TmuxClient i ()) !! TmuxError) r@@ -198,4 +242,5 @@       unit     TmuxClient.Send _ ->       unit-{-# inline interpretTmuxClientNull #-}+    TmuxClient.ReceiveNotification ->+      pure (TmuxNotification {name = "null", args = []})
− lib/Chiasma/Monad/EvalFreeT.hs
@@ -1,50 +0,0 @@-module Chiasma.Monad.EvalFreeT where---- import Control.Monad.Trans.Free (FreeF(..), FreeT(..))---- import Chiasma.Codec.Decode (DecodeFailure)--- import Chiasma.Data.Cmd (Cmd(..), Cmds(..))--- import Chiasma.Data.TmuxError (TmuxError)--- import Chiasma.Data.TmuxThunk (TmuxThunk(..))---- newtype CmdBuffer = CmdBuffer [Cmd]---- instance Default CmdBuffer where---   def = CmdBuffer def---- type CommandExec m =---   (∀ b. (Text -> Either DecodeFailure b) -> Cmds -> m (Either TmuxError [b]))---- evalFreeF ::---   Monad m =>---   CommandExec m ->---   CmdBuffer ->---   FreeF TmuxThunk a (FreeT TmuxThunk m a) ->---   m (Either TmuxError a)--- evalFreeF _ (CmdBuffer []) (Pure a) =---   pure (Right a)--- evalFreeF exec (CmdBuffer cmds) (Pure a) =---   Right a <$ exec (const $ Right ()) (Cmds cmds)--- evalFreeF exec (CmdBuffer cmds) (Free (Read cmd decode next)) = do---   a <- exec decode $ Cmds (cmd : cmds)---   case a of---     Right a' -> evalFreeT exec def (next a')---     Left err -> pure (Left err)--- evalFreeF exec (CmdBuffer cmds) (Free (Write cmd next)) =---   evalFreeT exec (CmdBuffer (cmd : cmds)) (next ())--- evalFreeF exec (CmdBuffer cmds) (Free (Flush next)) =---   exec (const $ Right ()) (Cmds cmds) >>= \case---     Right _ -> evalFreeT exec def (next ())---     Left err -> pure (Left err)--- evalFreeF _ _ (Free (Failed err)) =---   pure (Left err)---- evalFreeT ::---   Monad m =>---   CommandExec m ->---   CmdBuffer ->---   FreeT TmuxThunk m a ->---   m (Either TmuxError a)--- evalFreeT exec s (FreeT ma) = do---   inner <- ma---   evalFreeF exec s inner
− lib/Chiasma/Monad/Tmux.hs
@@ -1,49 +0,0 @@-module Chiasma.Monad.Tmux where---- import Control.Monad.Free (liftF)--- import Control.Monad.Free.Class (MonadFree)---- import Chiasma.Codec (TmuxCodec, TmuxQuery(unQ))--- import qualified Chiasma.Codec as TmuxCodec (TmuxCodec(decode, query))--- import Chiasma.Data.Cmd (cmd)--- import Chiasma.Data.TmuxError (TmuxError(InvalidOutput))--- import Chiasma.Data.TmuxThunk (TmuxThunk(..))---- read :: ∀ a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m [a]--- read name args =---   liftF $ Read (cmd name (args <> formatArgs)) TmuxCodec.decode id---   where---     formatArgs = ["-F", "'", unQ (TmuxCodec.query @a), "'"]---- unsafeReadOne :: ∀ a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m a--- unsafeReadOne name args = do---   outputs <- read name args---   case outputs of---     [a] -> pure a---     [] -> liftF $ Failed $ InvalidOutput "no data" (name <> unwords args)---     _ -> liftF $ Failed $ InvalidOutput "multiple outputs for `unsafeReadOne`" (name <> unwords args)---- readFirst :: ∀ a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m (Maybe a)--- readFirst name args = do---   outputs <- read name args---   pure $ case outputs of---     (a : _) -> Just a---     [] -> Nothing---- unsafeReadFirst :: ∀ a m . (TmuxCodec a, MonadFree TmuxThunk m) => Text -> [Text] -> m a--- unsafeReadFirst name args = do---   mayFirst <- readFirst name args---   case mayFirst of---     (Just a) -> pure a---     Nothing -> liftF $ Failed $ InvalidOutput "no data" (name <> unwords args)---- readRaw :: ∀ m . (MonadFree TmuxThunk m) => Text -> [Text] -> m [Text]--- readRaw name args =---   liftF $ Read (cmd name args) Right id---- write :: MonadFree TmuxThunk m => Text -> [Text] -> m ()--- write name args = liftF $ Write (cmd name args) id---- flush :: MonadFree TmuxThunk m => m ()--- flush =---   liftF $ Flush id
lib/Chiasma/Native/TmuxOutputBlock.hs view
@@ -2,11 +2,14 @@  import Data.Attoparsec.ByteString (Parser) import Data.ByteString.Internal (packChars)-import Prelude hiding (try)-import Text.Parser.Char (CharParsing, anyChar, newline, string)+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@@ -24,15 +27,26 @@ notBeginLine :: (CharParsing m, Monad m) => m () notBeginLine = void $ notFollowedBy (string "%begin") >> tillEol --- |Parse a sequence of lines between a %start and a %end line.+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)-  end <- endLine-  pure $ case end of+  endLine <&> \case     EndSuccess -> Success dataLines     EndError -> Error dataLines @@ -42,5 +56,16 @@   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/Path.hs view
@@ -6,11 +6,9 @@ pathText :: Path b t -> Text pathText =   toText . toFilePath-{-# inline pathText #-}  pathText' :: Path b t -> Text pathText' p =   case pathText p of     "/" -> "/"     t -> Text.dropWhileEnd (== '/') t-{-# inline pathText' #-}
lib/Chiasma/Ui/Measure/Balance.hs view
@@ -135,7 +135,7 @@         (a1, z1) = diff a     diff a = (floor a, a - fromIntegral (floor a :: Int)) --- |Tmux doesn't render panes smaller than two cells.+-- | Tmux doesn't render panes smaller than two cells. ensureMinimum2 :: NonEmpty Float -> NonEmpty Float ensureMinimum2 sizes =   choose <$> positives