helic 0.1.0.0 → 0.1.1.0

raw patch · 16 files changed

+408/−73 lines, 16 filesdep +gi-glibdep +table-layoutdep +terminal-sizedep −waidep ~pathdep ~path-iodep ~polysemy-concPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: gi-glib, table-layout, terminal-size

Dependencies removed: wai

Dependency ranges changed: path, path-io, polysemy-conc

API changes (from Hackage documentation)

Files

• helic.cabal +16/−4
• lib/Helic/Cli.hs +21/−5
• lib/Helic/Cli/Options.hs +16/−1
• lib/Helic/Config/File.hs +2/−1
• lib/Helic/Data/ListConfig.hs +11/−0
• lib/Helic/Data/Selection.hs +6/−0
• lib/Helic/Data/YankConfig.hs +1/−0
• lib/Helic/Gtk.hs +92/−16
• lib/Helic/Interpreter/XClipboard.hs +20/−14
• lib/Helic/List.hs +65/−0
• lib/Helic/Listen.hs +29/−6
• lib/Helic/Net/Client.hs +22/−6
• lib/Helic/Prelude.hs +9/−0
• lib/Helic/Yank.hs +9/−8
• readme.md +16/−12
• test/Helic/Test/ListenTest.hs +73/−0

@@ -5,10 +5,12 @@ -- see: https://github.com/sol/hpack  name:           helic-version:        0.1.0.0+version:        0.1.1.0 synopsis:       Clipboard Manager description:    See <https://hackage.haskell.org/package/helic/docs/Helic.html> category:       Clipboard+homepage:       https://github.com/tek/helic#readme+bug-reports:    https://github.com/tek/helic/issues author:         Torsten Schmits maintainer:     hackage@tryp.io copyright:      2021 Torsten Schmits@@ -19,6 +21,10 @@     readme.md     changelog.md +source-repository head+  type: git+  location: https://github.com/tek/helic+ library   exposed-modules:       Helic@@ -31,6 +37,7 @@       Helic.Data.GtkState       Helic.Data.Host       Helic.Data.InstanceName+      Helic.Data.ListConfig       Helic.Data.NetConfig       Helic.Data.Selection       Helic.Data.TmuxConfig@@ -44,6 +51,7 @@       Helic.Interpreter.AgentX       Helic.Interpreter.InstanceName       Helic.Interpreter.XClipboard+      Helic.List       Helic.Listen       Helic.Net.Api       Helic.Net.Client@@ -127,13 +135,14 @@     , either >=5     , exon >=0.2.0.1     , gi-gdk >=3+    , gi-glib >=2     , gi-gtk >=3     , hostname >=1     , http-client >=0.5.14     , http-client-tls >=0.3.1     , optparse-applicative >=0.16-    , path-    , path-io+    , path >=0.8+    , path-io >=1.6     , polysemy >=1.6     , polysemy-chronos >=0.2.0.1     , polysemy-conc >=0.5@@ -148,11 +157,12 @@     , servant-client >=0.18     , servant-client-core >=0.18     , servant-server >=0.18+    , table-layout >=0.9     , template-haskell+    , terminal-size >=0.3.2.1     , text     , typed-process >=0.2.6     , unix-    , wai >=3.2     , wai-extra >=3.1     , warp >=3.3     , yaml >=0.11@@ -242,6 +252,7 @@   other-modules:       Helic.Test.ConfigFileTest       Helic.Test.InsertEventTest+      Helic.Test.ListenTest       Paths_helic   hs-source-dirs:       test@@ -312,6 +323,7 @@     , path     , polysemy     , polysemy-chronos+    , polysemy-conc     , polysemy-log     , polysemy-plugin     , polysemy-test

@@ -1,4 +1,5 @@ {-# options_haddock prune #-}+ -- |CLI, Internal module Helic.Cli where @@ -17,15 +18,16 @@ import Polysemy.Error (errorToIOFinal) import Polysemy.Http.Interpreter.Manager (interpretManager) import qualified Polysemy.Log as Log-import Polysemy.Log (Log, Severity (Info), interpretLogStdoutLevelConc)+import Polysemy.Log (Log, Severity (Info, Trace), interpretLogStdoutLevelConc) import Polysemy.Reader (runReader) import Polysemy.Time (MilliSeconds (MilliSeconds)) import System.IO (hLookAhead) -import Helic.Cli.Options (Command (Listen, Yank), Conf (Conf), parser)+import Helic.Cli.Options (Command (List, Listen, Yank), Conf (Conf), parser) import Helic.Config.File (findFileConfig) import Helic.Data.Config (Config (Config)) import Helic.Data.Event (Event)+import Helic.Data.ListConfig (ListConfig) import Helic.Data.XClipboardEvent (XClipboardEvent) import Helic.Data.YankConfig (YankConfig (YankConfig)) import Helic.Interpreter.AgentNet (interpretAgentNet)@@ -33,6 +35,7 @@ import Helic.Interpreter.AgentX (interpretAgentX) import Helic.Interpreter.InstanceName (interpretInstanceName) import Helic.Interpreter.XClipboard (interpretXClipboardGtk, listenXClipboard)+import Helic.List (list) import Helic.Listen (listen) import Helic.Yank (yank) @@ -70,7 +73,7 @@   asyncToIOFinal .   interpretRace .   interpretTimeChronos .-  interpretLogStdoutLevelConc (if verbose then Nothing else Just Info) .+  interpretLogStdoutLevelConc (if verbose then (Just Trace) else Just Info) .   interpretCritical .   interpretInterrupt .   logError@@ -97,17 +100,30 @@   Config ->   YankConfig ->   Sem IOStack ()-yankApp (Config name _ net _) yankConf =+yankApp (Config name _ net _) yankConfig =   interpretManager $   interpretInstanceName name $-  yank (fromMaybe def net) yankConf+  runReader (fromMaybe def net) $+  yank yankConfig +listApp ::+  Config ->+  ListConfig ->+  Sem IOStack ()+listApp (Config _ _ net _) listConfig =+  runReader listConfig $+  interpretManager $+  runReader (fromMaybe def net) $+  list+ runCommand :: Config -> Command -> Sem IOStack () runCommand config = \case   Listen ->     listenApp config   Yank yankConf ->     yankApp config yankConf+  List showConf ->+    listApp config showConf  defaultCommand :: Sem IOStack Command defaultCommand = do

@@ -1,4 +1,5 @@ {-# options_haddock prune #-}+ -- |CLI Options, Internal module Helic.Cli.Options where @@ -7,6 +8,8 @@   Mod,   Parser,   ReadM,+  argument,+  auto,   command,   help,   hsubparser,@@ -21,6 +24,7 @@ import Options.Applicative.Types (readerAsk) import Path (Abs, File, Path, parseAbsFile) +import Helic.Data.ListConfig (ListConfig (ListConfig)) import Helic.Data.YankConfig (YankConfig (YankConfig))  data Conf =@@ -34,6 +38,8 @@   Listen   |   Yank YankConfig+  |+  List ListConfig   deriving stock (Eq, Show)  filePathOption :: ReadM (Path Abs File)@@ -59,11 +65,20 @@ yankCommand =   command "yank" (Yank <$> info yankParser (progDesc "Send stdin to the daemon")) +listParser :: Parser ListConfig+listParser =+  ListConfig <$> optional (argument auto (help "Maximum number of events to list"))++listCommand :: Mod CommandFields Command+listCommand =+  command "list" (List <$> info listParser (progDesc "List clipboard events"))+ commands :: [Mod CommandFields Command] commands =   [     listenCommand,-    yankCommand+    yankCommand,+    listCommand   ]  parser :: Parser (Conf, Maybe Command)

@@ -1,4 +1,5 @@ {-# options_haddock prune #-}+ -- |Config File Parsing, Internal module Helic.Config.File where @@ -15,7 +16,7 @@   Path Abs File ->   Sem r Config parseFileConfig (toFilePath -> path) = do-  Log.info [exon|Reading config file #{toText path}|]+  Log.debug [exon|Reading config file #{toText path}|]   fromEither =<< mapLeft formatError <$> embed (decodeFileEither path)   where     formatError exc =

@@ -0,0 +1,11 @@+{-# options_haddock prune #-}++-- |ListConfig Data Type, Internal+module Helic.Data.ListConfig where++data ListConfig =+  ListConfig {+    limit :: Maybe Int+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (Default)

@@ -9,3 +9,9 @@   |   Secondary   deriving stock (Eq, Show)++toXString :: Selection -> Text+toXString = \case+  Clipboard -> "CLIPBOARD"+  Primary -> "PRIMARY"+  Secondary -> "SECONDARY"

@@ -1,5 +1,6 @@ {-# options_haddock prune #-} -- |YankConfig Data Type, Internal+ module Helic.Data.YankConfig where  data YankConfig =

@@ -1,32 +1,92 @@ {-# options_haddock prune #-}+ -- |GTK Helpers, Internal module Helic.Gtk where +import qualified Control.Exception as Base+import qualified GI.GLib as Glib import qualified GI.Gdk as Gdk import GI.Gdk (Display) import qualified GI.Gtk as GI+import Polysemy.Final (embedFinal, withWeavingToFinal)+import Polysemy.Log (Log)  import qualified Helic.Data.GtkState as GtkState import Helic.Data.GtkState (GtkState)+import qualified Helic.Data.Selection as Selection import Helic.Data.Selection (Selection (Clipboard, Primary, Secondary)) -gtkClipboard ::+gtkUi ::+  Member (Embed IO) r =>+  IO a ->+  Sem r a+gtkUi ma = do+  result <- newEmptyMVar+  _ <- Gdk.threadsAddIdle Glib.PRIORITY_DEFAULT do+    a <- ma+    False <$ putMVar result a+  takeMVar result++gtkUiSem ::+  Member (Final IO) r =>+  Sem r a ->+  Sem r a+gtkUiSem ma = do+  withWeavingToFinal \ s wv _ -> do+    result <- newEmptyMVar+    void $ Gdk.threadsAddIdle Glib.PRIORITY_DEFAULT do+      wv ((embedFinal . putMVar result =<< ma) <$ s)+      pure False+    (<$ s) <$> takeMVar result++unsafeGtkClipboard ::   MonadIO m =>   Display ->-  Text ->+  Selection ->   m GI.Clipboard-gtkClipboard display name = do-  selection <- Gdk.atomIntern name False+unsafeGtkClipboard display name = do+  selection <- Gdk.atomIntern (Selection.toXString name) False   GI.clipboardGetForDisplay display selection -subscribe ::+gtkClipboard ::+  Member (Embed IO) r =>+  Display ->+  Selection ->+  Sem r (Either Text GI.Clipboard)+gtkClipboard display name =+  tryAny (unsafeGtkClipboard display name)++unsafeSubscribe ::   MonadIO m =>   GI.Clipboard ->-  (Text -> IO ()) ->+  (Either Text Text -> IO ()) ->   m ()+unsafeSubscribe clipboard handle =+  void $ GI.onClipboardOwnerChange clipboard \ _ -> do+    Base.catch @SomeException (GI.clipboardRequestText clipboard (const (traverse_ (handle . Right)))) \ e ->+      handle (Left (show e))++clipboardRequest ::+  GI.Clipboard ->+  (Either Text Text -> IO ()) ->+  IO ()+clipboardRequest clipboard handle =+  Base.catch @SomeException run \ e ->+    handle (Left (show e))+  where+    run =+      GI.clipboardRequestText clipboard (const (handle . maybeToRight "no clipboard text"))++subscribe ::+  Member (Final IO) r =>+  GI.Clipboard ->+  (Either Text Text -> Sem r ()) ->+  Sem r () subscribe clipboard handle =-  void $ GI.onClipboardOwnerChange clipboard \ _ ->-    GI.clipboardRequestText clipboard (const (traverse_ handle))+  withWeavingToFinal \ s wv _ -> do+    let lower ma = void (wv (ma <$ s))+    s <$ GI.onClipboardOwnerChange clipboard \ _ ->+      clipboardRequest clipboard (lower . handle)  clipboardFor ::   Member (Reader GtkState) r =>@@ -37,31 +97,46 @@   Primary -> asks GtkState.primary   Secondary -> asks GtkState.secondary -getClipboard ::+unsafeGetClipboard ::   MonadIO m =>   GI.Clipboard ->   m (Maybe Text)-getClipboard clipboard =+unsafeGetClipboard clipboard =   GI.clipboardWaitForText clipboard +getClipboard ::+  Members [Log, Embed IO] r =>+  GI.Clipboard ->+  Sem r (Maybe Text)+getClipboard clipboard =+  gtkUi (unsafeGetClipboard clipboard)+ getClipboardFor ::-  Members [Reader GtkState, Embed IO] r =>+  Members [Reader GtkState, Log, Embed IO] r =>   Selection ->   Sem r (Maybe Text) getClipboardFor sel = do   cb <- clipboardFor sel   getClipboard cb -setClipboard ::+unsafeSetClipboard ::   MonadIO m =>   GI.Clipboard ->   Text ->   m ()-setClipboard clipboard text =+unsafeSetClipboard clipboard text =   GI.clipboardSetText clipboard text (-1) +setClipboard ::+  Member (Embed IO) r =>+  GI.Clipboard ->+  Text ->+  Sem r ()+setClipboard clipboard text =+  gtkUi (unsafeSetClipboard clipboard text)+ setClipboardFor ::-  Members [Reader GtkState, Embed IO] r =>+  Members [Reader GtkState, Log, Embed IO, Final IO] r =>   Selection ->   Text ->   Sem r ()@@ -70,12 +145,13 @@   setClipboard cb text  syncXClipboard ::-  Members [Reader GtkState, Embed IO] r =>+  Members [Reader GtkState, Log, Embed IO, Final IO] r =>   Text ->   Selection ->   Sem r () syncXClipboard text = \case-  Clipboard -> unit+  Clipboard ->+    unit   _ -> do     cb <- asks GtkState.clipboard     setClipboard cb text

@@ -5,7 +5,8 @@ import qualified GI.Gtk as GI import qualified Polysemy.Conc as Conc import Polysemy.Conc (Events, withAsync_)-import Polysemy.Final (withWeavingToFinal)+import qualified Polysemy.Log as Log+import Polysemy.Log (Log) import Polysemy.Reader (runReader) import Polysemy.Resource (bracket) @@ -21,37 +22,40 @@ -- The clipboards stored in the state need the main loop running to work properly. -- The main loop is killed after the interpreted program terminates. withMainLoop ::-  Members [Resource, Error Text, Race, Async, Embed IO] r =>+  Members [Log, Error Text, Race, Async, Resource, Embed IO] r =>   InterpreterFor (Reader GtkState) r withMainLoop prog = do   bracket acquire release \ display -> do-    clipboard <- gtkClipboard display "CLIPBOARD"-    primary <- gtkClipboard display "PRIMARY"-    secondary <- gtkClipboard display "SECONDARY"+    clipboard <- fromEither =<< gtkClipboard display Clipboard+    primary <- fromEither =<< gtkClipboard display Primary+    secondary <- fromEither =<< gtkClipboard display Secondary     runReader (GtkState clipboard primary secondary display) (withAsync_ GI.main prog)   where     acquire = do       _ <- embed (GI.init Nothing)       note "couldn't get a GTK display" =<< Gdk.displayGetDefault     release display = do+      Log.debug [exon|Quitting the GTK main loop|]       Gdk.displayFlush display       Gdk.displayClose display       GI.mainQuit  -- |Listen to clipboard events for a specific source, like "primary selection", and publish them via 'Events'. subscribeToClipboard ::-  Members [Events resource XClipboardEvent, Reader GtkState, Embed IO, Final IO] r =>+  Members [Events resource XClipboardEvent, Reader GtkState, Log, Embed IO, Final IO] r =>   GI.Clipboard ->   Selection ->   Sem r () subscribeToClipboard clipboard selection =-  withWeavingToFinal \ s wv _ -> do-    s <$ Gtk.subscribe clipboard \ t ->-      void (wv (Conc.publish (XClipboardEvent t selection) <$ s))+  Gtk.subscribe clipboard \case+    Right t ->+      Conc.publish (XClipboardEvent t selection)+    Left e ->+      Log.warn [exon|GTK: #{e}|]  -- |Listen to clipboard events and publish them via 'Events'. clipboardEvents ::-  Members [Events resource XClipboardEvent, Reader GtkState, Embed IO, Final IO] r =>+  Members [Events resource XClipboardEvent, Reader GtkState, Log, Embed IO, Final IO] r =>   Sem r () clipboardEvents = do   GtkState {..} <- ask@@ -61,15 +65,17 @@  -- |Run a GTK main loop and listen to clipboard events, publishing them via 'Events'. listenXClipboard ::-  Members [Events resource XClipboardEvent, Error Text, Race, Resource, Async, Embed IO, Final IO] r =>+  Members [Events resource XClipboardEvent, Log, Error Text, Race, Resource, Async, Embed IO, Final IO] r =>   InterpreterFor (Reader GtkState) r-listenXClipboard =-  withMainLoop . withAsync_ clipboardEvents+listenXClipboard sem =+  withMainLoop do+    clipboardEvents+    sem  -- |Interpret 'XClipboard' using a GTK backend. -- This uses the @gi-gtk@ library to access the X11 clipboard. interpretXClipboardGtk ::-  Members [Reader GtkState, Embed IO] r =>+  Members [Reader GtkState, Log, Embed IO, Final IO] r =>   InterpreterFor XClipboard r interpretXClipboardGtk = do   interpret \case

@@ -0,0 +1,65 @@+{-# options_haddock prune #-}++-- |List command logic, Internal+module Helic.List where++import Chronos (Datetime (Datetime), SubsecondPrecision (SubsecondPrecisionFixed), builder_HMS, timeToDatetime)+import Data.Text.Lazy.Builder (toLazyText)+import Polysemy.Http (Manager)+import qualified Polysemy.Http.Effect.Manager as Manager+import Servant.Client (mkClientEnv, runClientM)+import qualified System.Console.Terminal.Size as TerminalSize+import Text.Layout.Table (center, column, expandUntil, fixedCol, left, right, rowG, tableString, titlesH, unicodeRoundS)++import Helic.Data.AgentId (AgentId (AgentId))+import Helic.Data.Event (Event (Event), content, sender, source, time)+import Helic.Data.InstanceName (InstanceName (InstanceName))+import qualified Helic.Data.ListConfig as ListConfig+import Helic.Data.ListConfig (ListConfig)+import Helic.Data.NetConfig (NetConfig)+import qualified Helic.Net.Client as Api+import Helic.Net.Client (localhostUrl)++format :: Int -> [Event] -> String+format width events =+  tableString cols unicodeRoundS titles (row <$> zip [length events - 1..0] events)+  where+    cols =+      [col 4 right, col 16 center, col 10 center, fixedCol 8 center, col contentWidth left]+    col w al =+      column (expandUntil w) al def def+    titles =+      titlesH ["#", "Instance", "Agent", "Time", "Content"]+    row (i, Event {..}) =+      rowG (toString <$> [show i, coerce sender, coerce source, toStrict (formatTime (timeToDatetime time)), content])+    formatTime (Datetime _ tod) =+      toLazyText (builder_HMS (SubsecondPrecisionFixed 0) (Just ':') tod)+    contentWidth =+      max 20 (width - 40)++-- |Fetch all events from the server, limit them to the configured number and format them in a nice table.+buildList ::+  Members [Manager, Reader ListConfig, Reader NetConfig, Error Text, Embed IO] r =>+  Sem r String+buildList = do+  url <- localhostUrl+  mgr <- Manager.get+  let+    env =+      mkClientEnv mgr url+    req =+      mapLeft show <$> runClientM Api.get env+  history <- fromEither =<< embed req+  limit <- asks ListConfig.limit+  let+    events =+      maybe id take limit (reverse (toList history))+  width <- fromMaybe 80 . fmap TerminalSize.width <$> embed TerminalSize.size+  pure (format width events)++-- |Print a number of events to stdout.+list ::+  Members [Manager, Reader ListConfig, Reader NetConfig, Error Text, Embed IO] r =>+  Sem r ()+list =+  putStrLn =<< buildList

@@ -1,4 +1,5 @@ {-# options_haddock prune #-}+ -- |Daemon Logic, Internal module Helic.Listen where @@ -85,13 +86,36 @@ truncateLog ::   Member (AtomicState (Seq Event)) r =>   Int ->-  Sem r ()+  Sem r (Maybe Int) truncateLog maxHistory =-  atomicModify' \ evs ->+  atomicState' \ evs ->     if length evs > maxHistory-    then Seq.drop 1 evs-    else evs+    then (Seq.drop 1 evs, Just (length evs - maxHistory))+    else (evs, Nothing) +logTruncation ::+  Member Log r =>+  Int ->+  Sem r ()+logTruncation num =+  Log.info [exon|removed #{show num} #{noun} from the history.|]+  where+    noun =+      if num == 1 then "entry" else "entries"++-- TODO broadcast concurrently+handleEvent ::+  Members Agents r =>+  Members [AtomicState (Seq Event), ChronosTime, Log] r =>+  Maybe Int ->+  Event ->+  Sem r ()+handleEvent maxHistory e = do+  Log.debug [exon|listen: #{show e}|]+  whenM (insertEvent e) do+    broadcast e+    traverse_ logTruncation =<< truncateLog (fromMaybe 100 maxHistory)+ -- |Listen for 'Event' via 'Polysemy.Conc.Events', broadcasting them to agents. listen ::   Members Agents r =>@@ -99,5 +123,4 @@   Maybe Int ->   Sem r () listen maxHistory =-  Conc.subscribeLoop \ e ->-    whenM (insertEvent e) (broadcast e *> truncateLog (fromMaybe 100 maxHistory))+  Conc.subscribeLoop (handleEvent maxHistory)

@@ -1,4 +1,5 @@ {-# options_haddock prune #-}+ -- |HTTP Client, Internal module Helic.Net.Client where @@ -9,12 +10,13 @@ import Polysemy.Log (Log) import Polysemy.Time (MilliSeconds (MilliSeconds)) import Servant (type (:<|>) ((:<|>)))-import Servant.Client (ClientM, client, mkClientEnv, parseBaseUrl, runClientM)+import Servant.Client (BaseUrl, ClientM, client, mkClientEnv, parseBaseUrl, runClientM)  import Helic.Data.Event (Event) import Helic.Data.Host (Host (Host))-import Helic.Data.NetConfig (Timeout)-import Helic.Net.Api (Api)+import qualified Helic.Data.NetConfig as NetConfig+import Helic.Data.NetConfig (NetConfig, Timeout)+import Helic.Net.Api (Api, defaultPort)  get :: ClientM (Seq Event) yank :: Event -> ClientM ()@@ -28,7 +30,7 @@   Sem r () sendTo configTimeout (Host addr) event = do   Log.debug [exon|sending to #{addr}|]-  url <- note "bad url" (parseBaseUrl (toString addr))+  url <- note [exon|Invalid host name: #{addr}|] (parseBaseUrl (toString addr))   mgr <- Manager.get   let     timeout =@@ -36,5 +38,19 @@     env =       mkClientEnv mgr url     req =-      mapLeft show <$> runClientM (yank event) env-  fromEither =<< Conc.timeoutAs_ (Left "timed out") timeout (embed req)+      fmap (mapLeft show) <$> tryAny (runClientM (yank event) env)+  fromEither =<< fromEither =<< Conc.timeoutAs_ (Left "timed out") timeout req++localhost ::+  Member (Reader NetConfig) r =>+  Sem r Host+localhost = do+  port <- asks NetConfig.port+  pure (Host [exon|localhost:#{show (fromMaybe defaultPort port)}|])++localhostUrl ::+  Members [Reader NetConfig, Error Text] r =>+  Sem r BaseUrl+localhostUrl = do+  Host host <- localhost+  note [exon|Invalid server port: #{host}|] (parseBaseUrl (toString host))

@@ -116,6 +116,15 @@   embed . fmap (mapLeft show) . try @SomeException {-# inline tryAny #-} +catchAny ::+  Member (Embed IO) r =>+  IO a ->+  (Text -> Sem r a) ->+  Sem r a+catchAny ma handle =+  either handle pure =<< tryAny ma+{-# inline catchAny #-}+ basicOptions :: Aeson.Options basicOptions =   Aeson.defaultOptions {

@@ -1,4 +1,5 @@ {-# options_haddock prune #-}+ -- |Yank Logic, Internal module Helic.Yank where @@ -9,20 +10,20 @@  import Helic.Data.AgentId (AgentId (AgentId)) import qualified Helic.Data.Event as Event-import Helic.Data.Host (Host (Host)) import Helic.Data.InstanceName (InstanceName)-import Helic.Data.NetConfig (NetConfig (NetConfig))+import qualified Helic.Data.NetConfig as NetConfig+import Helic.Data.NetConfig (NetConfig) import Helic.Data.YankConfig (YankConfig (YankConfig))-import Helic.Net.Api (defaultPort)-import Helic.Net.Client (sendTo)+import Helic.Net.Client (localhost, sendTo)  -- |Send an event to the server. yank ::-  Members [Reader InstanceName, ChronosTime, Manager, Log, Race, Error Text, Embed IO] r =>-  NetConfig ->+  Members [Reader InstanceName, Reader NetConfig, ChronosTime, Manager, Log, Race, Error Text, Embed IO] r =>   YankConfig ->   Sem r ()-yank (NetConfig port timeout _) (YankConfig agent) = do+yank (YankConfig agent) = do   text <- embed (Text.hGetContents stdin)   event <- Event.now (AgentId (fromMaybe "cli" agent)) text-  sendTo timeout (Host [exon|localhost:#{show (fromMaybe defaultPort port)}|]) event+  host <- localhost+  timeout <- asks NetConfig.timeout+  sendTo timeout host event

@@ -67,6 +67,7 @@ Global CLI options are specified *before* the command name, command-specific ones after it.  |Command|Name|Description|+|---|---|---| |Global|`--verbose`|Increase the log level.| |Global|`--config-file FILE`|Use the specified file path instead of the default locations.| |`listen`|`--agent NAME`|Used to avoid sending yanks back to the application that sent them.|@@ -98,25 +99,28 @@ For *NixOS*, the file `/etc/helic.yaml` is generated from module options:  ```nix-services.helic = {-  enable = true;-  name = "myhost";-  maxHistory = 1000;-  net = {-    port = 10001;-    hosts = ["remote1:1000" "remote2:2000"];-    timeout = 5;-  };-  tmux = {+{+  services.helic = {     enable = true;-    package = old.tmux;+    name = "myhost";+    maxHistory = 1000;+    net = {+      port = 10001;+      hosts = ["remote1:1000" "remote2:2000"];+      timeout = 5;+    };+    tmux = {+      enable = true;+      package = old.tmux;+    };   };-};+} ```  The meaning of these options is:  |Key|Default|Description|+|---|---|---| |`name`|Host name|An identifier for the host, used for filtering duplicates.| |`maxHistory`|100|The number of yanks that should be kept.| |`net.port`|`9500`|The HTTP port the daemon listens to for both remote sync and `hel yank`.|

@@ -0,0 +1,73 @@+module Helic.Test.ListenTest where++import qualified Chronos+import Chronos (datetimeToTime)+import Polysemy.Chronos (interpretTimeChronos)+import qualified Polysemy.Conc as Conc+import Polysemy.Conc (Queue, interpretAtomic, interpretEventsChan, interpretQueueTBM, interpretRace, withAsync_)+import qualified Polysemy.Conc.Queue as Queue+import Polysemy.Log (interpretLogNull)+import Polysemy.Tagged (Tagged, untag)+import Polysemy.Test (UnitTest, runTestAuto)+import Polysemy.Time (mkDatetime, MilliSeconds (MilliSeconds))++import Helic.Data.AgentId (AgentId (AgentId))+import Helic.Data.Event (Event (Event))+import Helic.Effect.Agent (Agent (Update), AgentNet, AgentTmux, AgentX, agentIdNet, agentIdTmux, agentIdX)+import Helic.Listen (listen)+import qualified Polysemy.Time as Time++testTime :: Chronos.Time+testTime =+  datetimeToTime (mkDatetime 2030 1 1 12 0 0)++ev :: Text -> Event+ev =+    Event "test" (AgentId "nvim") testTime++interpretAgentQueue ::+  ∀ id r .+  Member (Queue (AgentId, Event)) r =>+  AgentId ->+  (Event -> Sem r ()) ->+  InterpreterFor (Tagged id Agent) r+interpretAgentQueue agentId handle sem =+  interpreting (untag sem) \case+    Update e -> do+      handle e+      Queue.write (agentId, e)++handleNet :: Event -> Sem r ()+handleNet =+  undefined++handleTmux :: Event -> Sem r ()+handleTmux =+  undefined++handleX :: Event -> Sem r ()+handleX =+  undefined++test_listen :: UnitTest+test_listen =+  runTestAuto $+  asyncToIOFinal $+  interpretRace $+  interpretLogNull $+  interpretTimeChronos $+  interpretEventsChan $+  interpretAtomic def $+  interpretQueueTBM 64 $+  interpretAgentQueue @AgentNet agentIdNet handleNet $+  interpretAgentQueue @AgentTmux agentIdTmux handleTmux $+  interpretAgentQueue @AgentX agentIdX handleX do+    withAsync_ (listen (Just 5)) do+      Conc.publish (ev "1")+      Conc.publish (ev "2")+      Conc.publish (ev "3")+      Conc.publish (ev "4")+      Conc.publish (ev "5")+      Conc.publish (ev "6")+      Time.sleep (MilliSeconds 100)+      dbgs =<< atomicGet