helic 0.1.1.0 → 0.2.0.0

raw patch · 12 files changed

+205/−73 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +4/−0
• helic.cabal +4/−1
• lib/Helic/Cli.hs +3/−0
• lib/Helic/Effect/Client.hs +11/−0
• lib/Helic/Interpreter/Client.hs +34/−0
• lib/Helic/List.hs +8/−17
• lib/Helic/Listen.hs +0/−1
• lib/Helic/Yank.hs +4/−9
• readme.md +23/−4
• test/Helic/Test/ListTest.hs +62/−0
• test/Helic/Test/ListenTest.hs +47/−40
• test/Main.hs +5/−1

@@ -1,5 +1,9 @@ # Unreleased +# 0.2.0.0++* Add the `list` command that prints the current history.+ # 0.1.0.0  * Initial release

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           helic-version:        0.1.1.0+version:        0.2.0.0 synopsis:       Clipboard Manager description:    See <https://hackage.haskell.org/package/helic/docs/Helic.html> category:       Clipboard@@ -44,11 +44,13 @@       Helic.Data.XClipboardEvent       Helic.Data.YankConfig       Helic.Effect.Agent+      Helic.Effect.Client       Helic.Effect.XClipboard       Helic.Gtk       Helic.Interpreter.AgentNet       Helic.Interpreter.AgentTmux       Helic.Interpreter.AgentX+      Helic.Interpreter.Client       Helic.Interpreter.InstanceName       Helic.Interpreter.XClipboard       Helic.List@@ -253,6 +255,7 @@       Helic.Test.ConfigFileTest       Helic.Test.InsertEventTest       Helic.Test.ListenTest+      Helic.Test.ListTest       Paths_helic   hs-source-dirs:       test

@@ -33,6 +33,7 @@ import Helic.Interpreter.AgentNet (interpretAgentNet) import Helic.Interpreter.AgentTmux (interpretAgentTmux) import Helic.Interpreter.AgentX (interpretAgentX)+import Helic.Interpreter.Client (interpretClientNet) import Helic.Interpreter.InstanceName (interpretInstanceName) import Helic.Interpreter.XClipboard (interpretXClipboardGtk, listenXClipboard) import Helic.List (list)@@ -104,6 +105,7 @@   interpretManager $   interpretInstanceName name $   runReader (fromMaybe def net) $+  interpretClientNet $   yank yankConfig  listApp ::@@ -114,6 +116,7 @@   runReader listConfig $   interpretManager $   runReader (fromMaybe def net) $+  interpretClientNet $   list  runCommand :: Config -> Command -> Sem IOStack ()

@@ -0,0 +1,11 @@+-- Client Effect, Internal+module Helic.Effect.Client where++import Helic.Data.Event (Event)++-- An abstraction of the API, used by the @list@ command.+data Client :: Effect where+  Get :: Client m (Either Text [Event])+  Yank :: Event -> Client m (Either Text ())++makeSem ''Client

@@ -0,0 +1,34 @@+module Helic.Interpreter.Client where++import Polysemy.Http (Manager)+import qualified Polysemy.Http.Effect.Manager as Manager+import Polysemy.Log (Log)+import Servant.Client (mkClientEnv, runClientM)++import Helic.Data.Event (Event)+import qualified Helic.Data.NetConfig as NetConfig+import Helic.Data.NetConfig (NetConfig)+import Helic.Effect.Client (Client (Get, Yank))+import qualified Helic.Net.Client as Api+import Helic.Net.Client (localhost, localhostUrl, sendTo)++interpretClientNet ::+  Members [Manager, Reader NetConfig, Log, Error Text, Race, Embed IO] r =>+  InterpreterFor Client r+interpretClientNet =+  interpret \case+    Get -> do+      env <- mkClientEnv <$> Manager.get <*> localhostUrl+      bimap show toList <$> embed (runClientM Api.get env)+    Yank event -> do+      host <- localhost+      timeout <- asks NetConfig.timeout+      runError (sendTo timeout host event)++interpretClientConst ::+  [Event] ->+  InterpreterFor Client r+interpretClientConst evs =+  interpret \case+    Get -> pure (Right evs)+    Yank _ -> pure (Left "const client cannot yank")

@@ -5,9 +5,6 @@  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) @@ -16,14 +13,15 @@ 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)+import qualified Helic.Effect.Client as Client+import Helic.Effect.Client (Client)  format :: Int -> [Event] -> String format width events =-  tableString cols unicodeRoundS titles (row <$> zip [length events - 1..0] events)+  tableString cols unicodeRoundS titles (row <$> zip [lastIndex,lastIndex-1..0] events)   where+    lastIndex =+      length events - 1     cols =       [col 4 right, col 16 center, col 10 center, fixedCol 8 center, col contentWidth left]     col w al =@@ -39,17 +37,10 @@  -- |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 =>+  Members [Reader ListConfig, Client, 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+  history <- fromEither =<< Client.get   limit <- asks ListConfig.limit   let     events =@@ -59,7 +50,7 @@  -- |Print a number of events to stdout. list ::-  Members [Manager, Reader ListConfig, Reader NetConfig, Error Text, Embed IO] r =>+  Members [Reader ListConfig, Client, Error Text, Embed IO] r =>   Sem r () list =   putStrLn =<< buildList

@@ -103,7 +103,6 @@     noun =       if num == 1 then "entry" else "entries" --- TODO broadcast concurrently handleEvent ::   Members Agents r =>   Members [AtomicState (Seq Event), ChronosTime, Log] r =>

@@ -5,25 +5,20 @@  import qualified Data.Text.IO as Text import Polysemy.Chronos.Time (ChronosTime)-import Polysemy.Http (Manager)-import Polysemy.Log (Log)  import Helic.Data.AgentId (AgentId (AgentId)) import qualified Helic.Data.Event as Event import Helic.Data.InstanceName (InstanceName)-import qualified Helic.Data.NetConfig as NetConfig-import Helic.Data.NetConfig (NetConfig) import Helic.Data.YankConfig (YankConfig (YankConfig))-import Helic.Net.Client (localhost, sendTo)+import qualified Helic.Effect.Client as Client+import Helic.Effect.Client (Client)  -- |Send an event to the server. yank ::-  Members [Reader InstanceName, Reader NetConfig, ChronosTime, Manager, Log, Race, Error Text, Embed IO] r =>+  Members [Reader InstanceName, Client, ChronosTime, Error Text, Embed IO] r =>   YankConfig ->   Sem r () yank (YankConfig agent) = do   text <- embed (Text.hGetContents stdin)   event <- Event.now (AgentId (fromMaybe "cli" agent)) text-  host <- localhost-  timeout <- asks NetConfig.timeout-  sendTo timeout host event+  fromEither =<< Client.yank event

@@ -3,14 +3,26 @@ *Helic* is a tool for synchronizing clipboard contents across *X11*, *tmux* and network, consisting of a daemon listening for changes and a CLI client for use in programs like *Neovim*. +*X11* has three separate copy buffers, called the *clipboard*, the *primary selection* and the *secondary selection*.+Selections are used when text is selected with the mouse, while the clipboard is updated by `Ctrl-C`.+ When some text is copied or selected in *X11*, the daemon receives an event that it proceeds to broadcast to the configured targets. If the source was a selection, the *X11* clipboard is updated as well.+ The CLI program `hel` can be used to manually send text to the daemon, for example from *tmux* or *Neovim*. If remote hosts are configured, each yank event is sent over the network to update their clipboards. -Several yank events are stored in memory in order to avoid duplicates and cycles.+Several yank events are stored in memory in order to detect duplicates and cycles. +The CLI understands three different commands:++|Command|Meaning|+|---|---|+|`hel listen`|Start the daemon. This is best done from a *systemd* user service.|+|`hel yank`|Send standard input to the daemon as a manual yank event.|+|`hel list`|Print the event history.|+ # Installing and Running Helic  ## Nix@@ -20,7 +32,8 @@  ```shell $ nix run github:tek/helic -- listen-$ echo 'yank me' | nix run github:tek/helic -- yank+$ echo 'yank me' | nix run github:tek/helic -- yank --agent cli+$ nix run github:tek/helic -- list 100 ```  ## NixOS@@ -45,6 +58,12 @@ $ echo 'yank me' | hel yank ``` +After a rebuild, the service may not be started right away, so this command must be executed:++```shell+$ systemctl --user start helic+```+ ## Without Nix  Alternatively, the app can be installed using a *Haskell* package manager, like [Cabal]:@@ -56,8 +75,7 @@  ## CLI -If neither of the commands `listen` and `yank` have been specified explicitly, *Helic* decides which one to start by the-presence of stdin data:+If no command has been specified explicitly, *Helic* decides which one to start by the presence of stdin data:  ```shell $ hel # start daemon@@ -71,6 +89,7 @@ |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.|+|`list`|positional (`hel list 5`)|Limit the number of printed events.|  # Configuring Helic 

@@ -0,0 +1,62 @@+module Helic.Test.ListTest where++import qualified Chronos+import Chronos (datetimeToTime)+import Polysemy.Chronos (interpretTimeChronosConstant)+import Polysemy.Conc (+  Events,+  Queue,+  )+import qualified Polysemy.Conc.Queue as Queue+import Polysemy.Error (errorToIOFinal)+import Polysemy.Reader (runReader)+import Polysemy.Tagged (Tagged, untag)+import Polysemy.Test (UnitTest, assertRight, runTestAuto)+import Polysemy.Time (mkDatetime)++import Helic.Data.AgentId (AgentId (AgentId))+import qualified Helic.Data.Event as Event+import Helic.Data.Event (Event (Event, content))+import Helic.Data.InstanceName (InstanceName)+import Helic.Data.ListConfig (ListConfig (ListConfig))+import Helic.Effect.Agent (Agent (Update))+import Helic.Interpreter.Client (interpretClientConst)+import Helic.List (buildList)+import Helic.Net.Api (receiveEvent)++testTime :: Chronos.Time+testTime =+  datetimeToTime (mkDatetime 2030 1 1 12 0 0)++interpretAgent ::+  ∀ id r .+  (Event -> Sem r ()) ->+  InterpreterFor (Tagged id Agent) r+interpretAgent handle sem =+  interpreting (untag sem) \case+    Update e ->+      handle e++handleNet ::+  Members [Events resource Event, Reader InstanceName] r =>+  Event ->+  Sem r ()+handleNet (Event {..}) =+  receiveEvent (Event "test" (AgentId "net") testTime content)++handleLog ::+  Member (Queue Text) r =>+  Event ->+  Sem r ()+handleLog Event {content} =+  Queue.write content++test_listen :: UnitTest+test_listen =+  runTestAuto $+  interpretTimeChronosConstant testTime $+  runReader "test" $+  runReader (ListConfig (Just 8)) do+    events <- traverse (Event.now (AgentId "nvim") . show) ([1..10] :: [Int])+    interpretClientConst events do+      assertRight 873 . fmap length =<< errorToIOFinal buildList

@@ -2,52 +2,59 @@  import qualified Chronos import Chronos (datetimeToTime)-import Polysemy.Chronos (interpretTimeChronos)+import Polysemy.Chronos (interpretTimeChronosConstant) import qualified Polysemy.Conc as Conc-import Polysemy.Conc (Queue, interpretAtomic, interpretEventsChan, interpretQueueTBM, interpretRace, withAsync_)+import Polysemy.Conc (+  Events,+  Queue,+  interpretAtomic,+  interpretEventsChan,+  interpretQueueTBM,+  interpretRace,+  resultToMaybe,+  withAsync_,+  ) import qualified Polysemy.Conc.Queue as Queue import Polysemy.Log (interpretLogNull)+import Polysemy.Reader (runReader) import Polysemy.Tagged (Tagged, untag)-import Polysemy.Test (UnitTest, runTestAuto)-import Polysemy.Time (mkDatetime, MilliSeconds (MilliSeconds))+import Polysemy.Test (UnitTest, assertJust, runTestAuto)+import Polysemy.Time (mkDatetime)  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 qualified Helic.Data.Event as Event+import Helic.Data.Event (Event (Event, content))+import Helic.Data.InstanceName (InstanceName)+import Helic.Effect.Agent (Agent (Update), AgentNet, AgentTmux, AgentX) import Helic.Listen (listen)-import qualified Polysemy.Time as Time+import Helic.Net.Api (receiveEvent)  testTime :: Chronos.Time testTime =   datetimeToTime (mkDatetime 2030 1 1 12 0 0) -ev :: Text -> Event-ev =-    Event "test" (AgentId "nvim") testTime--interpretAgentQueue ::+interpretAgent ::   ∀ id r .-  Member (Queue (AgentId, Event)) r =>-  AgentId ->   (Event -> Sem r ()) ->   InterpreterFor (Tagged id Agent) r-interpretAgentQueue agentId handle sem =+interpretAgent handle sem =   interpreting (untag sem) \case-    Update e -> do+    Update e ->       handle e-      Queue.write (agentId, e) -handleNet :: Event -> Sem r ()-handleNet =-  undefined--handleTmux :: Event -> Sem r ()-handleTmux =-  undefined+handleNet ::+  Members [Events resource Event, Reader InstanceName] r =>+  Event ->+  Sem r ()+handleNet (Event {..}) =+  receiveEvent (Event "test" (AgentId "net") testTime content) -handleX :: Event -> Sem r ()-handleX =-  undefined+handleLog ::+  Member (Queue Text) r =>+  Event ->+  Sem r ()+handleLog Event {content} =+  Queue.write content  test_listen :: UnitTest test_listen =@@ -55,19 +62,19 @@   asyncToIOFinal $   interpretRace $   interpretLogNull $-  interpretTimeChronos $+  interpretTimeChronosConstant testTime $   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+  runReader "test" $+  interpretAgent @AgentNet handleNet $+  interpretAgent @AgentTmux handleLog $+  interpretAgent @AgentX (const unit) do+    result <- withAsync_ (listen (Just 5)) do+      Conc.subscribe do+        let+          pub n =+            Conc.publish =<< Event.now (AgentId "nvim") (show n)+        traverse_ pub ([1..10] :: [Int])+      traverse resultToMaybe <$> replicateM 10 Queue.read+    assertJust (show <$> ([1..10] :: [Int])) result

@@ -3,11 +3,15 @@ import Helic.Test.InsertEventTest (test_insertEvent) import Polysemy.Test (unitTest) import Test.Tasty (TestTree, defaultMain, testGroup)+import Helic.Test.ConfigFileTest (test_readConfigFile)+import Helic.Test.ListenTest (test_listen)  tests :: TestTree tests =   testGroup "all" [-    unitTest "insert an event" test_insertEvent+    unitTest "insert an event" test_insertEvent,+    unitTest "parse a config file" test_readConfigFile,+    unitTest "listen for events, filter duplicates from network feedback" test_listen   ]  main :: IO ()