helic 0.2.0.0 → 0.3.0.0

raw patch · 24 files changed

+488/−253 lines, 24 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +4/−0
• helic.cabal +7/−1
• lib/Helic/Cli.hs +32/−6
• lib/Helic/Data/LoadConfig.hs +11/−0
• lib/Helic/Effect/Client.hs +29/−3
• lib/Helic/Effect/History.hs +12/−0
• lib/Helic/Interpreter/Agent.hs +15/−0
• lib/Helic/Interpreter/AgentNet.hs +4/−8
• lib/Helic/Interpreter/Client.hs +9/−1
• lib/Helic/Interpreter/History.hs +168/−0
• lib/Helic/Interpreter/InstanceName.hs +0/−1
• lib/Helic/Interpreter/XClipboard.hs +0/−1
• lib/Helic/List.hs +29/−6
• lib/Helic/Listen.hs +27/−114
• lib/Helic/Net/Api.hs +15/−23
• lib/Helic/Net/Client.hs +6/−5
• lib/Helic/Prelude.hs +10/−1
• readme.md +4/−1
• test/Helic/Test/Fixtures.hs +10/−0
• test/Helic/Test/InsertEventTest.hs +1/−1
• test/Helic/Test/ListTest.hs +29/−44
• test/Helic/Test/ListenTest.hs +20/−34
• test/Helic/Test/LoadTest.hs +39/−0
• test/Main.hs +7/−3

@@ -1,5 +1,9 @@ # Unreleased +# 0.3.0.0++* Add the `load` command that sets the clipboard to an event from the history.+ # 0.2.0.0  * Add the `list` command that prints the current history.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           helic-version:        0.2.0.0+version:        0.3.0.0 synopsis:       Clipboard Manager description:    See <https://hackage.haskell.org/package/helic/docs/Helic.html> category:       Clipboard@@ -38,6 +38,7 @@       Helic.Data.Host       Helic.Data.InstanceName       Helic.Data.ListConfig+      Helic.Data.LoadConfig       Helic.Data.NetConfig       Helic.Data.Selection       Helic.Data.TmuxConfig@@ -45,12 +46,15 @@       Helic.Data.YankConfig       Helic.Effect.Agent       Helic.Effect.Client+      Helic.Effect.History       Helic.Effect.XClipboard       Helic.Gtk+      Helic.Interpreter.Agent       Helic.Interpreter.AgentNet       Helic.Interpreter.AgentTmux       Helic.Interpreter.AgentX       Helic.Interpreter.Client+      Helic.Interpreter.History       Helic.Interpreter.InstanceName       Helic.Interpreter.XClipboard       Helic.List@@ -253,9 +257,11 @@   main-is: Main.hs   other-modules:       Helic.Test.ConfigFileTest+      Helic.Test.Fixtures       Helic.Test.InsertEventTest       Helic.Test.ListenTest       Helic.Test.ListTest+      Helic.Test.LoadTest       Paths_helic   hs-source-dirs:       test

@@ -14,12 +14,14 @@   interpretEventsChan,   interpretInterrupt,   interpretRace,+  interpretSync,+  withAsync_,   ) import Polysemy.Error (errorToIOFinal)+import Polysemy.Http (Manager) import Polysemy.Http.Interpreter.Manager (interpretManager) import qualified Polysemy.Log as Log import Polysemy.Log (Log, Severity (Info, Trace), interpretLogStdoutLevelConc)-import Polysemy.Reader (runReader) import Polysemy.Time (MilliSeconds (MilliSeconds)) import System.IO (hLookAhead) @@ -28,16 +30,22 @@ import Helic.Data.Config (Config (Config)) import Helic.Data.Event (Event) import Helic.Data.ListConfig (ListConfig)+import Helic.Data.LoadConfig (LoadConfig (LoadConfig))+import Helic.Data.NetConfig (NetConfig) import Helic.Data.XClipboardEvent (XClipboardEvent) import Helic.Data.YankConfig (YankConfig (YankConfig))+import qualified Helic.Effect.Client as Client+import Helic.Effect.Client (Client)+import qualified Helic.Effect.History as History import Helic.Interpreter.AgentNet (interpretAgentNet) import Helic.Interpreter.AgentTmux (interpretAgentTmux) import Helic.Interpreter.AgentX (interpretAgentX) import Helic.Interpreter.Client (interpretClientNet)+import Helic.Interpreter.History (interpretHistory) import Helic.Interpreter.InstanceName (interpretInstanceName) import Helic.Interpreter.XClipboard (interpretXClipboardGtk, listenXClipboard) import Helic.List (list)-import Helic.Listen (listen)+import Helic.Net.Api (serve) import Helic.Yank (yank)  logError ::@@ -95,7 +103,10 @@   interpretAgentX $   interpretAgentNet $   interpretAgentTmux $-  listen maxHistory+  interpretHistory maxHistory $+  interpretSync $+  withAsync_ serve $+  Conc.subscribeLoop History.receive  yankApp ::   Config ->@@ -108,16 +119,31 @@   interpretClientNet $   yank yankConfig +runClient ::+  Members [Log, Error Text, Race, Embed IO] r =>+  Maybe NetConfig ->+  InterpretersFor [Client, Reader NetConfig, Manager] r+runClient net =+  interpretManager .+  runReader (fromMaybe def net) .+  interpretClientNet+ listApp ::   Config ->   ListConfig ->   Sem IOStack () listApp (Config _ _ net _) listConfig =   runReader listConfig $-  interpretManager $-  runReader (fromMaybe def net) $-  interpretClientNet $+  runClient net $   list++loadApp ::+  Config ->+  LoadConfig ->+  Sem IOStack ()+loadApp (Config _ _ net _) (LoadConfig event) =+  runClient net $+  (void . fromEither =<< Client.load event)  runCommand :: Config -> Command -> Sem IOStack () runCommand config = \case

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

@@ -1,11 +1,37 @@--- Client Effect, Internal+-- |Client Effect, Internal module Helic.Effect.Client where +import Polysemy (makeSem_)+ import Helic.Data.Event (Event) --- An abstraction of the API, used by the @list@ command.+-- |An abstraction of the API, used by the @list@ command. data Client :: Effect where+  -- |Return all events currently in memory.   Get :: Client m (Either Text [Event])+  -- |Add a new event.   Yank :: Event -> Client m (Either Text ())+  -- |Broadcast an older event.+  Load :: Int -> Client m (Either Text Event) -makeSem ''Client+makeSem_ ''Client++-- |Return all events currently in memory.+get ::+  ∀ r .+  Member Client r =>+  Sem r (Either Text [Event])++-- |Add a new event.+yank ::+  ∀ r .+  Member Client r =>+  Event ->+  Sem r (Either Text ())++-- |Broadcast an older event.+load ::+  ∀ r .+  Member Client r =>+  Int ->+  Sem r (Either Text Event)

@@ -0,0 +1,12 @@+-- |History Effect, Internal+module Helic.Effect.History where++import Helic.Data.Event (Event)++-- |The core actions of the 'Event' history.+data History :: Effect where+  Get :: History m [Event]+  Receive :: Event -> History m ()+  Load :: Int -> History m (Maybe Event)++makeSem ''History

@@ -0,0 +1,15 @@+module Helic.Interpreter.Agent where++import Polysemy.Tagged (Tagged, untag)++import Helic.Data.Event (Event)+import Helic.Effect.Agent (Agent (Update))++interpretAgent ::+  ∀ id r .+  (Event -> Sem r ()) ->+  InterpreterFor (Tagged id Agent) r+interpretAgent handle sem =+  interpreting (untag sem) \case+    Update e ->+      handle e

@@ -1,30 +1,26 @@ -- |Agent Interpreter for Network, Internal module Helic.Interpreter.AgentNet where -import Polysemy.Conc (Events, Interrupt, interpretSync, withAsync_)+import Polysemy.Conc (Interrupt) import Polysemy.Http (Manager) import qualified Polysemy.Log as Log import Polysemy.Log (Log) import Polysemy.Tagged (Tagged, untag)  import Helic.Data.Event (Event (source))-import Helic.Data.InstanceName (InstanceName) import Helic.Data.NetConfig (NetConfig (NetConfig)) import Helic.Effect.Agent (Agent (Update), AgentNet, agentIdNet)-import Helic.Net.Api (serve) import Helic.Net.Client (sendTo)  -- |Interpret 'Agent' using remote hosts as targets. -- This also starts the HTTP server that listens to network events, which are used both for remote hosts and CLI -- events. interpretAgentNet ::-  Members [Manager, Events resource Event, Reader InstanceName, Reader NetConfig] r =>-  Members [AtomicState (Seq Event), Log, Interrupt, Race, Resource, Async, Embed IO, Final IO] r =>+  Members [Manager, Reader NetConfig] r =>+  Members [Log, Interrupt, Race, Resource, Async, Embed IO, Final IO] r =>   InterpreterFor (Tagged AgentNet Agent) r interpretAgentNet sem =-  interpretSync $-  withAsync_ serve $-  interpreting (raiseUnder (untag sem)) \case+  interpreting (untag sem) \case     Update e -> do       NetConfig _ timeout hosts <- ask       for_ (fold hosts) \ host ->

@@ -1,3 +1,4 @@+-- |Client Interpreter, Internal module Helic.Interpreter.Client where  import Polysemy.Http (Manager)@@ -8,10 +9,11 @@ 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 Helic.Effect.Client (Client (Get, Load, Yank)) import qualified Helic.Net.Client as Api import Helic.Net.Client (localhost, localhostUrl, sendTo) +-- |Interpret 'Client' via HTTP. interpretClientNet ::   Members [Manager, Reader NetConfig, Log, Error Text, Race, Embed IO] r =>   InterpreterFor Client r@@ -24,7 +26,12 @@       host <- localhost       timeout <- asks NetConfig.timeout       runError (sendTo timeout host event)+    Load event -> do+      env <- mkClientEnv <$> Manager.get <*> localhostUrl+      result <- mapLeft show <$> embed (runClientM (Api.load event) env)+      pure (result >>= maybeToRight "There is no event for that index") +-- |Interpret 'Client' with a constant list of 'Event's and no capability to yank. interpretClientConst ::   [Event] ->   InterpreterFor Client r@@ -32,3 +39,4 @@   interpret \case     Get -> pure (Right evs)     Yank _ -> pure (Left "const client cannot yank")+    Load _ -> pure (Left "const client cannot load")

@@ -0,0 +1,168 @@+{-# options_haddock prune #-}++-- |Core daemon logic, Internal+module Helic.Interpreter.History where++import qualified Chronos+import qualified Data.Sequence as Seq+import Data.Sequence (Seq ((:|>)), (!?), (|>))+import Polysemy.AtomicState (atomicState')+import Polysemy.Chronos (ChronosTime)+import qualified Polysemy.Log as Log+import Polysemy.Log (Log)+import Polysemy.Tagged (Tagged, tag)+import qualified Polysemy.Time as Time+import Polysemy.Time (Seconds (Seconds), convert)+import Polysemy.Time.Diff (diff)++import Helic.Data.AgentId (AgentId (AgentId))+import qualified Helic.Data.Event as Event+import Helic.Data.Event (Event (Event, time))+import Helic.Data.InstanceName (InstanceName)+import qualified Helic.Effect.Agent as Agent+import Helic.Effect.Agent (Agent, AgentName, AgentNet, AgentTag, AgentTmux, AgentX, Agents, agentIdNet, agentName)+import qualified Helic.Effect.History as History+import Helic.Effect.History (History)++-- |Send an event to an agent unless it was published by that agent.+runAgent ::+  ∀ (tag :: AgentTag) r .+  AgentName tag =>+  Member (Tagged tag Agent) r =>+  Event ->+  Sem r ()+runAgent (Event _ (AgentId eId) _ _) | eId == agentName @tag =+  unit+runAgent e =+  tag (Agent.update e)++-- |Send an event to all agents.+broadcast ::+  Members Agents r =>+  Member Log r =>+  Event ->+  Sem r ()+broadcast event@(Event _ (AgentId ag) _ text) = do+  Log.debug [exon|broadcasting from #{ag}: #{show text}|]+  runAgent @AgentTmux event+  runAgent @AgentNet event+  runAgent @AgentX event++-- |Whether there was an event within the last second that contained the same text as the current event.+inRecent ::+  Chronos.Time ->+  Event ->+  Seq Event ->+  Bool+inRecent now (Event _ _ _ c) =+  any ((c ==) . Event.content) . Seq.takeWhileR newer+  where+    newer (Event _ _ t _) =+      diff now t <= convert (Seconds 1)++-- |Append an event to the history unless the newest event contains the same text or there was an event within the last+-- second that contained the same text, to avoid clobbering due to cycles induced by external programs.+appendIfValid ::+  Chronos.Time ->+  Event ->+  Seq Event ->+  Maybe (Seq Event)+appendIfValid now e = \case+  Seq.Empty ->+    Just (Seq.singleton e)+  _ :|> Event _ _ _ newest | newest == Event.content e ->+    Nothing+  hist | inRecent now e hist ->+    Nothing+  hist ->+    Just (hist |> e)++-- |Add an event to the history unless it is a duplicate.+insertEvent ::+  Members [AtomicState (Seq Event), ChronosTime] r =>+  Event ->+  Sem r Bool+insertEvent e = do+  now <- Time.now+  atomicState' \ s -> result s (appendIfValid now e s)+  where+    result s = \case+      Just new -> (new, True)+      Nothing -> (s, False)++-- |Remove excess entries from the front of the 'Seq', given a maximum number of entries.+-- Return the number of dropped entries.+truncateLog ::+  Member (AtomicState (Seq Event)) r =>+  Int ->+  Sem r (Maybe Int)+truncateLog maxHistory =+  atomicState' \ evs -> do+    let dropped = length evs - maxHistory+    if dropped > 0+    then (Seq.drop dropped evs, Just dropped)+    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"++-- |Process an event received from outside.+receiveEvent ::+  Members Agents r =>+  Members [AtomicState (Seq Event), ChronosTime, Log] r =>+  Maybe Int ->+  Event ->+  Sem r ()+receiveEvent maxHistory e = do+  Log.debug [exon|listen: #{show e}|]+  whenM (insertEvent e) do+    broadcast e+    traverse_ logTruncation =<< truncateLog (fromMaybe 100 maxHistory)++-- |Re-broadcast an older event from the history at the given index (ordered by increasing age) and move it to the end+-- of the history.+loadEvent ::+  Members [AtomicState (Seq Event), ChronosTime, Log] r =>+  Int ->+  Sem r (Maybe Event)+loadEvent index = do+  now <- Time.now+  atomicState' \ s ->+    case (s !? (length s - index - 1)) of+      Just event ->+        (Seq.deleteAt index s |> event { time = now }, Just event)+      Nothing ->+        (s, Nothing)++-- |In the unlikely case of a remote host sending an event back to this instance and not updating the sender, this will+-- be 'True'.+isNetworkCycle ::+  Member (Reader InstanceName) r =>+  Event ->+  Sem r Bool+isNetworkCycle Event {..} = do+  name <- ask+  pure (name == sender && source == agentIdNet)++-- |Interpret 'History' as 'AtomicState', broadcasting to agents.+interpretHistory ::+  Members Agents r =>+  Members [Reader InstanceName, AtomicState (Seq Event), ChronosTime, Log] r =>+  Maybe Int ->+  InterpreterFor History r+interpretHistory maxHistory =+  interpret \case+    History.Get ->+      toList <$> atomicGet+    History.Receive event ->+      unlessM (isNetworkCycle event) do+        receiveEvent maxHistory event+    History.Load index ->+      loadEvent index

@@ -3,7 +3,6 @@  import Network.HostName (getHostName) import qualified Polysemy.Error as Polysemy-import Polysemy.Reader (runReader)  import Helic.Data.InstanceName (InstanceName (InstanceName)) 

@@ -7,7 +7,6 @@ import Polysemy.Conc (Events, withAsync_) import qualified Polysemy.Log as Log import Polysemy.Log (Log)-import Polysemy.Reader (runReader) import Polysemy.Resource (bracket)  import qualified Helic.Data.GtkState as GtkState

@@ -4,6 +4,7 @@ module Helic.List where  import Chronos (Datetime (Datetime), SubsecondPrecision (SubsecondPrecisionFixed), builder_HMS, timeToDatetime)+import qualified Data.Text as Text import Data.Text.Lazy.Builder (toLazyText) import qualified System.Console.Terminal.Size as TerminalSize import Text.Layout.Table (center, column, expandUntil, fixedCol, left, right, rowG, tableString, titlesH, unicodeRoundS)@@ -16,6 +17,28 @@ import qualified Helic.Effect.Client as Client import Helic.Effect.Client (Client) +truncateLines :: Int -> Text -> Text+truncateLines maxWidth a =+  case Text.lines a of+    [] ->+      a+    [firstLine] ->+      firstLine+    firstLine : (length -> count) ->+      let+        lineIndicator =+          [exon| [#{show (count + 1)} lines]|]+        maxlen =+          maxWidth - Text.length lineIndicator+      in [exon|#{Text.take maxlen firstLine}#{lineIndicator}|]++eventColumns :: Int -> Int -> Event -> [Text]+eventColumns maxWidth i Event {..} =+  [show i, coerce sender, coerce source, toStrict (formatTime (timeToDatetime time)), truncateLines maxWidth content]+  where+    formatTime (Datetime _ tod) =+      toLazyText (builder_HMS (SubsecondPrecisionFixed 0) (Just ':') tod)+ format :: Int -> [Event] -> String format width events =   tableString cols unicodeRoundS titles (row <$> zip [lastIndex,lastIndex-1..0] events)@@ -28,12 +51,10 @@       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)+    row (i, event) =+      rowG (toString <$> eventColumns contentWidth i event)     contentWidth =-      max 20 (width - 40)+      min 100 (max 20 (width - 40))  -- |Fetch all events from the server, limit them to the configured number and format them in a nice table. buildList ::@@ -43,8 +64,10 @@   history <- fromEither =<< Client.get   limit <- asks ListConfig.limit   let+    dropper l =+      drop (length history - l)     events =-      maybe id take limit (reverse (toList history))+      maybe id dropper limit (toList history)   width <- fromMaybe 80 . fmap TerminalSize.width <$> embed TerminalSize.size   pure (format width events) 

@@ -1,125 +1,38 @@ {-# options_haddock prune #-} --- |Daemon Logic, Internal+-- |Listen, Internal module Helic.Listen where -import qualified Chronos-import qualified Data.Sequence as Seq-import Data.Sequence (Seq ((:|>)), (|>))-import Polysemy.AtomicState (atomicState')-import Polysemy.Chronos (ChronosTime) import qualified Polysemy.Conc as Conc-import Polysemy.Conc (EventConsumer)-import qualified Polysemy.Log as Log-import Polysemy.Log (Log)-import Polysemy.Tagged (Tagged, tag)-import qualified Polysemy.Time as Time-import Polysemy.Time (Seconds (Seconds), convert)-import Polysemy.Time.Diff (diff)--import Helic.Data.AgentId (AgentId (AgentId))-import qualified Helic.Data.Event as Event-import Helic.Data.Event (Event (Event))-import qualified Helic.Effect.Agent as Agent-import Helic.Effect.Agent (Agent, AgentName, AgentNet, AgentTag, AgentTmux, AgentX, Agents, agentName)--runAgent ::-  ∀ (tag :: AgentTag) r .-  AgentName tag =>-  Member (Tagged tag Agent) r =>-  Event ->-  Sem r ()-runAgent (Event _ (AgentId eId) _ _) | eId == agentName @tag =-  unit-runAgent e =-  tag (Agent.update e)--broadcast ::-  Members Agents r =>-  Member Log r =>-  Event ->-  Sem r ()-broadcast event@(Event _ (AgentId ag) _ text) = do-  Log.debug [exon|broadcasting from #{ag}: #{show text}|]-  runAgent @AgentTmux event-  runAgent @AgentNet event-  runAgent @AgentX event--inRecent ::-  Chronos.Time ->-  Event ->-  Seq Event ->-  Bool-inRecent now (Event _ _ _ c) =-  any ((c ==) . Event.content) . Seq.takeWhileR newer-  where-    newer (Event _ _ t _) =-      diff now t <= convert (Seconds 1)--appendIfValid ::-  Chronos.Time ->-  Event ->-  Seq Event ->-  Maybe (Seq Event)-appendIfValid now e = \case-  Seq.Empty ->-    Just (Seq.singleton e)-  _ :|> Event _ _ _ newest | newest == Event.content e ->-    Nothing-  hist | inRecent now e hist ->-    Nothing-  hist ->-    Just (hist |> e)--insertEvent ::-  Members [AtomicState (Seq Event), ChronosTime] r =>-  Event ->-  Sem r Bool-insertEvent e = do-  now <- Time.now-  atomicState' \ s -> result s (appendIfValid now e s)-  where-    result s = \case-      Just new -> (new, True)-      Nothing -> (s, False)--truncateLog ::-  Member (AtomicState (Seq Event)) r =>-  Int ->-  Sem r (Maybe Int)-truncateLog maxHistory =-  atomicState' \ evs ->-    if length evs > maxHistory-    then (Seq.drop 1 evs, Just (length evs - maxHistory))-    else (evs, Nothing)+import Polysemy.Conc (EventConsumer, Sync, interpretSync, withAsync_)+import qualified Polysemy.Conc.Sync as Sync -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"+import Helic.Data.Event (Event)+import qualified Helic.Effect.History as History+import Helic.Effect.History (History) -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)+-- |Signal type that indicates that the subscriber of 'listen' is running.+data Listening =+  Listening+  deriving stock (Eq, Show)  -- |Listen for 'Event' via 'Polysemy.Conc.Events', broadcasting them to agents. listen ::-  Members Agents r =>-  Members [EventConsumer token Event, AtomicState (Seq Event), ChronosTime, Log] r =>-  Maybe Int ->+  Members [EventConsumer token Event, History, Sync Listening] r =>   Sem r ()-listen maxHistory =-  Conc.subscribeLoop (handleEvent maxHistory)+listen =+  Conc.subscribe do+    Sync.putBlock Listening+    (forever (History.receive =<< Conc.consume))++-- |Run an action with 'listen' in a thread, waiting for the event subscriber to be up and running before executing the+-- action.+withListen ::+  Members [EventConsumer token Event, History, Resource, Race, Async, Embed IO] r =>+  Sem r a ->+  Sem r a+withListen ma =+  interpretSync $+  withAsync_ listen do+    Listening <- Sync.takeBlock+    raise ma

@@ -1,45 +1,38 @@ -- |HTTP API of the Daemon, Internal module Helic.Net.Api where -import qualified Polysemy.Conc as Conc-import Polysemy.Conc (Events, Interrupt, Sync)+import Polysemy.Conc (Interrupt, Sync) import Polysemy.Log (Log)-import Servant (Get, JSON, PostCreated, ReqBody, type (:<|>) ((:<|>)), type (:>))+import Servant (Get, JSON, NoContent (NoContent), Post, PostCreated, ReqBody, type (:<|>) ((:<|>)), type (:>)) import Servant.Server (Context (EmptyContext), ServerT) -import Helic.Data.Event (Event (Event, sender, source))-import Helic.Data.InstanceName (InstanceName)+import Helic.Data.Event (Event) import qualified Helic.Data.NetConfig as NetConfig import Helic.Data.NetConfig (NetConfig)-import Helic.Effect.Agent (agentIdNet)+import qualified Helic.Effect.History as History+import Helic.Effect.History (History) import Helic.Net.Server (ServerReady, runServerWithContext)  -- |The Servant API of the daemon, providing endpoints for getting all events and creating one. type Api =   "event" :> (-    Get '[JSON] (Seq Event)+    Get '[JSON] [Event]     :<|>-    ReqBody '[JSON] Event :> PostCreated '[JSON] ()+    ReqBody '[JSON] Event :> PostCreated '[JSON] NoContent+    :<|>+    ReqBody '[JSON] Int :> Post '[JSON] (Maybe Event)   ) --- |Publish a received event unless it was sent by the network agent of this instance.-receiveEvent ::-  Members [Events resource Event, Reader InstanceName] r =>-  Event ->-  Sem r ()-receiveEvent e@Event {sender, source} = do-  name <- ask-  unless (name == sender && source == agentIdNet) do-    Conc.publish e- -- |The server implementation. server ::-  Members [Events resource Event, AtomicState (Seq Event), Reader InstanceName] r =>+  Member History r =>   ServerT Api (Sem r) server =-  atomicGet+  History.get   :<|>-  receiveEvent+  as NoContent . History.receive+  :<|>+  History.load  -- |The default port, 9500. defaultPort :: Int@@ -48,8 +41,7 @@  -- |Run the daemon API. serve ::-  Members [Events resource Event, Reader NetConfig] r =>-  Members [AtomicState (Seq Event), Reader InstanceName, Sync ServerReady, Log, Interrupt, Final IO] r =>+  Members [History, Reader NetConfig, Sync ServerReady, Log, Interrupt, Final IO] r =>   Sem r () serve = do   port <- asks NetConfig.port

@@ -9,7 +9,7 @@ import qualified Polysemy.Log as Log import Polysemy.Log (Log) import Polysemy.Time (MilliSeconds (MilliSeconds))-import Servant (type (:<|>) ((:<|>)))+import Servant (NoContent, type (:<|>) ((:<|>))) import Servant.Client (BaseUrl, ClientM, client, mkClientEnv, parseBaseUrl, runClientM)  import Helic.Data.Event (Event)@@ -18,9 +18,10 @@ import Helic.Data.NetConfig (NetConfig, Timeout) import Helic.Net.Api (Api, defaultPort) -get :: ClientM (Seq Event)-yank :: Event -> ClientM ()-get :<|> yank = client (Proxy @Api)+get :: ClientM [Event]+yank :: Event -> ClientM NoContent+load :: Int -> ClientM (Maybe Event)+get :<|> yank :<|> load = client (Proxy @Api)  sendTo ::   Members [Manager, Log, Race, Error Text, Embed IO] r =>@@ -39,7 +40,7 @@       mkClientEnv mgr url     req =       fmap (mapLeft show) <$> tryAny (runClientM (yank event) env)-  fromEither =<< fromEither =<< Conc.timeoutAs_ (Left "timed out") timeout req+  void . fromEither =<< fromEither =<< Conc.timeoutAs_ (Left "timed out") timeout req  localhost ::   Member (Reader NetConfig) r =>

@@ -73,7 +73,7 @@ import Polysemy.Internal.CustomErrors (FirstOrder) import Polysemy.Internal.Kind (Append) import Polysemy.Internal.Tactics (liftT)-import Polysemy.Reader (Reader, ask, asks)+import Polysemy.Reader (Reader, ask, asks, runReader) import Polysemy.Resource (Resource, resourceToIOFinal, runResource) import Polysemy.State (State, evalState, get, gets, modify, modify', put, runState) import Relude hiding (@@ -178,3 +178,12 @@ interpreting s h =   interpret h s {-# inline interpreting #-}++as ::+  Functor m =>+  a ->+  m b ->+  m a+as =+  (<$)+{-# inline as #-}

@@ -15,13 +15,14 @@  Several yank events are stored in memory in order to detect duplicates and cycles. -The CLI understands three different commands:+The CLI understands four 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.|+|`hel load`|Load an older event to the clipboard, given its index into the history.|  # Installing and Running Helic @@ -34,6 +35,7 @@ $ nix run github:tek/helic -- listen $ echo 'yank me' | nix run github:tek/helic -- yank --agent cli $ nix run github:tek/helic -- list 100+$ nix run github:tek/helic -- load 5 ```  ## NixOS@@ -90,6 +92,7 @@ |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.|+|`load`|positional (`hel load 5`)|Choose the index of the event to be loaded.|  # Configuring Helic 

@@ -0,0 +1,10 @@+module Helic.Test.Fixtures where++import qualified Chronos+import Chronos (datetimeToTime)+import Polysemy.Chronos ()+import Polysemy.Time (mkDatetime)++testTime :: Chronos.Time+testTime =+  datetimeToTime (mkDatetime 2030 1 1 12 0 0)

@@ -10,7 +10,7 @@ import Torsor (add)  import Helic.Data.Event (Event (Event))-import Helic.Listen (appendIfValid)+import Helic.Interpreter.History (appendIfValid)  old :: Chronos.Time old =

@@ -1,62 +1,47 @@ 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+import Helic.Test.Fixtures (testTime) -handleNet ::-  Members [Events resource Event, Reader InstanceName] r =>-  Event ->-  Sem r ()-handleNet (Event {..}) =-  receiveEvent (Event "test" (AgentId "net") testTime content)+eventContents :: [Text]+eventContents =+  [+    "extra",+    "extra",+    "extra",+    "extra",+    "extra",+    "single line",+    "single line with newline\n",+    "three lines 1\nthree lines 2\nthree lines 3"+  ] -handleLog ::-  Member (Queue Text) r =>-  Event ->-  Sem r ()-handleLog Event {content} =-  Queue.write content+target :: String+target =+  [exon|╭───┬──────────┬───────┬──────────┬──────────────────────────╮+│ # │ Instance │ Agent │   Time   │         Content          │+╞═══╪══════════╪═══════╪══════════╪══════════════════════════╡+│ 2 │   test   │ nvim  │ 12:00:00 │ single line              │+├───┼──────────┼───────┼──────────┼──────────────────────────┤+│ 1 │   test   │ nvim  │ 12:00:00 │ single line with newline │+├───┼──────────┼───────┼──────────┼──────────────────────────┤+│ 0 │   test   │ nvim  │ 12:00:00 │ three lines 1 [3 lines]  │+╰───┴──────────┴───────┴──────────┴──────────────────────────╯|] -test_listen :: UnitTest-test_listen =+test_list :: UnitTest+test_list =   runTestAuto $   interpretTimeChronosConstant testTime $   runReader "test" $-  runReader (ListConfig (Just 8)) do-    events <- traverse (Event.now (AgentId "nvim") . show) ([1..10] :: [Int])+  runReader (ListConfig (Just 3)) do+    events <- traverse (Event.now (AgentId "nvim")) eventContents     interpretClientConst events do-      assertRight 873 . fmap length =<< errorToIOFinal buildList+      assertRight target =<< errorToIOFinal buildList

@@ -1,7 +1,6 @@ module Helic.Test.ListenTest where -import qualified Chronos-import Chronos (datetimeToTime)+import qualified Data.Set as Set import Polysemy.Chronos (interpretTimeChronosConstant) import qualified Polysemy.Conc as Conc import Polysemy.Conc (@@ -11,43 +10,28 @@   interpretEventsChan,   interpretQueueTBM,   interpretRace,+  interpretSync,   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, assertJust, runTestAuto)-import Polysemy.Time (mkDatetime)+import Polysemy.Test (UnitTest, assertEq, assertJust, runTestAuto)  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.Effect.Agent (Agent (Update), AgentNet, AgentTmux, AgentX)-import Helic.Listen (listen)-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+import Helic.Effect.Agent (AgentNet, AgentTmux, AgentX)+import Helic.Interpreter.Agent (interpretAgent)+import Helic.Interpreter.History (interpretHistory)+import Helic.Listen (withListen)+import Helic.Test.Fixtures (testTime)  handleNet ::-  Members [Events resource Event, Reader InstanceName] r =>+  Member (Events res Event) r =>   Event ->   Sem r () handleNet (Event {..}) =-  receiveEvent (Event "test" (AgentId "net") testTime content)+  Conc.publish (Event "test" (AgentId "net") testTime content)  handleLog ::   Member (Queue Text) r =>@@ -66,15 +50,17 @@   interpretEventsChan $   interpretAtomic def $   interpretQueueTBM 64 $+  interpretSync $   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])+  interpretAgent @AgentX (const unit) $+  interpretHistory (Just 5) do+    result <- withListen 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+    assertEq Nothing . resultToMaybe =<< Queue.tryRead+    assertJust (Set.map show ([1..10] :: Set Int)) (Set.fromList <$> result)

@@ -0,0 +1,39 @@+module Helic.Test.LoadTest where++import Polysemy.Chronos (ChronosTime, interpretTimeChronosConstant)+import Polysemy.Conc (interpretAtomic)+import Polysemy.Log (interpretLogNull)+import Polysemy.Test (UnitTest, assertEq, assertJust, runTestAuto)++import Helic.Data.AgentId (AgentId (AgentId))+import qualified Helic.Data.Event as Event+import Helic.Data.Event (Event)+import Helic.Data.InstanceName (InstanceName)+import Helic.Effect.Agent (AgentNet, AgentTmux, AgentX)+import qualified Helic.Effect.History as History+import Helic.Interpreter.Agent (interpretAgent)+import Helic.Interpreter.History (interpretHistory)+import Helic.Test.Fixtures (testTime)++event ::+  Members [ChronosTime, Reader InstanceName] r =>+  Int ->+  Sem r Event+event n =+  Event.now (AgentId "test") (show n)++test_load :: UnitTest+test_load =+  runTestAuto $+  interpretTimeChronosConstant testTime $+  interpretLogNull $+  runReader "test" $+  interpretAtomic def $+  interpretAgent @AgentNet (const unit) $+  interpretAgent @AgentTmux (const unit) $+  interpretAgent @AgentX (const unit) $+  interpretHistory Nothing do+    atomicPut =<< traverse event [1..10]+    ev5 <- event 6+    assertJust ev5 =<< History.load 4+    assertEq Nothing =<< History.load 11

@@ -1,17 +1,21 @@ module Main where +import Helic.Test.ConfigFileTest (test_readConfigFile) import Helic.Test.InsertEventTest (test_insertEvent)+import Helic.Test.ListTest (test_list)+import Helic.Test.ListenTest (test_listen)+import Helic.Test.LoadTest (test_load) 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 "parse a config file" test_readConfigFile,-    unitTest "listen for events, filter duplicates from network feedback" test_listen+    unitTest "listen for events, filter duplicates from network feedback" test_listen,+    unitTest "print the history" test_list,+    unitTest "load an old event to the clipboard" test_load   ]  main :: IO ()