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 +18/−22
- lib/Chiasma/Codec.hs +1/−1
- lib/Chiasma/Data/Event.hs +0/−7
- lib/Chiasma/Data/Panes.hs +6/−6
- lib/Chiasma/Data/ReceiveEvent.hs +0/−6
- lib/Chiasma/Data/TmuxEvent.hs +10/−0
- lib/Chiasma/Data/TmuxNotification.hs +8/−0
- lib/Chiasma/Data/TmuxThunk.hs +0/−16
- lib/Chiasma/Effect/TmuxApi.hs +3/−0
- lib/Chiasma/Effect/TmuxClient.hs +3/−10
- lib/Chiasma/Event.hs +0/−58
- lib/Chiasma/Interpreter/Codec.hs +0/−2
- lib/Chiasma/Interpreter/ProcessOutput.hs +10/−11
- lib/Chiasma/Interpreter/TmuxApi.hs +3/−11
- lib/Chiasma/Interpreter/TmuxClient.hs +81/−36
- lib/Chiasma/Monad/EvalFreeT.hs +0/−50
- lib/Chiasma/Monad/Tmux.hs +0/−49
- lib/Chiasma/Native/TmuxOutputBlock.hs +30/−5
- lib/Chiasma/Path.hs +0/−2
- lib/Chiasma/Ui/Measure/Balance.hs +1/−1
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