helic 0.6.0.0 → 0.6.1.0

raw patch · 13 files changed

+93/−57 lines, 13 filesdep +randomPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: random

API changes (from Hackage documentation)

Files

• changelog.md +4/−0
• helic.cabal +2/−3
• lib/Helic/App.hs +9/−11
• lib/Helic/Cli.hs +1/−1
• lib/Helic/Cli/Options.hs +5/−2
• lib/Helic/Data/AgentId.hs +1/−1
• lib/Helic/Data/Event.hs +5/−0
• lib/Helic/Data/YankConfig.hs +3/−2
• lib/Helic/Interpreter/History.hs +23/−20
• lib/Helic/Net/Api.hs +1/−2
• lib/Helic/Yank.hs +9/−6
• readme.md +10/−6
• test/Helic/Dev.hs +20/−3

@@ -1,5 +1,9 @@ # Unreleased +# 0.6.1.0++* Add cli option `--text` for the `yank` command as an alternative to stdin.+ # 0.6.0.0  * Allow all agents to be disabled in the config file.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           helic-version:        0.6.0.0+version:        0.6.1.0 synopsis:       Clipboard Manager description:    See https://hackage.haskell.org/package/helic/docs/Helic.html category:       Clipboard@@ -260,12 +260,11 @@     , path ==0.9.*     , polysemy ==1.9.*     , polysemy-chronos ==0.6.*-    , polysemy-conc ==0.12.*     , polysemy-log ==0.9.*     , polysemy-plugin ==0.4.*     , polysemy-test ==0.7.*-    , polysemy-time ==0.6.*     , prelate ==0.5.*+    , random     , tasty ==1.4.*     , torsor ==0.1.*     , zeugma ==0.7.*

@@ -47,17 +47,6 @@   withAsync_ serve $   Conc.subscribeLoop History.receive -yankApp ::-  Config ->-  YankConfig ->-  Sem AppStack ()-yankApp (Config name _ net _ _ _) yankConfig =-  interpretManager $-  interpretInstanceName name $-  runReader (fromMaybe def net) $-  interpretClientNet $-  yank yankConfig- runClient ::   Members [Log, Error Text, Race, Embed IO] r =>   Maybe NetConfig ->@@ -66,6 +55,15 @@   interpretManager .   runReader (fromMaybe def net) .   interpretClientNet++yankApp ::+  Config ->+  YankConfig ->+  Sem AppStack ()+yankApp (Config name _ net _ _ _) yankConfig =+  interpretInstanceName name $+  runClient net $+  yank yankConfig  listApp ::   Config ->

@@ -30,7 +30,7 @@ defaultCommand :: Sem AppStack Command defaultCommand = do   Conc.timeout_ (pure Nothing) (MilliSeconds 100) (Just <$> tryAny (hLookAhead stdin)) <&> \case-    Just (Right _) -> Yank (YankConfig (Just "cli"))+    Just (Right _) -> Yank (YankConfig (Just "cli") Nothing)     _ -> Listen  withCliOptions :: Conf -> Maybe Command -> IO ()

@@ -28,6 +28,7 @@  import Helic.Data.ListConfig (ListConfig (ListConfig)) import Helic.Data.LoadConfig (LoadConfig (LoadConfig))+import qualified Helic.Data.YankConfig import Helic.Data.YankConfig (YankConfig (YankConfig))  data Conf =@@ -63,8 +64,10 @@   command "listen" (info (pure Listen) (progDesc "Run the daemon"))  yankParser :: Parser YankConfig-yankParser =-  YankConfig <$> optional (strOption (long "agent" <> help "Source of the yank"))+yankParser = do+  agent <- optional (strOption (long "agent" <> help "Source of the yank"))+  text <- optional (strOption (long "text" <> help "Yank text, uses stdin if not specified"))+  pure YankConfig {..}  yankCommand :: Mod CommandFields Command yankCommand =

@@ -5,7 +5,7 @@  newtype AgentId =   AgentId { unAgentId :: Text }-  deriving stock (Eq, Show)+  deriving stock (Eq, Show, Generic)   deriving newtype (IsString)  json ''AgentId

@@ -7,6 +7,7 @@  import Helic.Data.AgentId (AgentId) import Helic.Data.InstanceName (InstanceName)+import Exon (exon)  -- |The central data type representing a clipboard event. data Event =@@ -34,3 +35,7 @@   sender <- ask   time <- Time.now   pure Event {..}++describe :: Event -> Text+describe Event {..} =+  [exon|##{sender}:##{source}|]

@@ -1,11 +1,12 @@ {-# options_haddock prune #-}--- |YankConfig Data Type, Internal +-- | YankConfig Data Type, Internal module Helic.Data.YankConfig where  data YankConfig =   YankConfig {-    agent :: Maybe Text+    agent :: Maybe Text,+    text :: Maybe Text   }   deriving stock (Eq, Show, Generic)   deriving anyclass (Default)

@@ -31,8 +31,8 @@   Sem r () runAgent (Event _ (AgentId eId) _ _) | eId == agentName @tag =   unit-runAgent e =-  tag (Agent.update e)+runAgent event =+  tag (Agent.update event)  -- |Send an event to all agents. broadcast ::@@ -63,8 +63,8 @@   Text.replace "\r" "\n" . Text.replace "\r\n" "\n"  sanitize :: Event -> Event-sanitize e@Event {content} =-  e { content = sanitizeNewlines content }+sanitize event@Event {content} =+  event { content = sanitizeNewlines content }  -- |Append an event to the history unless the latest event contains the same text, or there was an event within the last -- second that contained the same text, or the new event has an earlier time stamp than the latest event, to avoid@@ -74,24 +74,24 @@   Event ->   Seq Event ->   Maybe (Seq Event)-appendIfValid now (sanitize -> e@Event {content, time}) = \case+appendIfValid now (sanitize -> event@Event {content, time}) = \case   Seq.Empty ->-    Just (Seq.singleton e)+    Just (Seq.singleton event)   _ :|> Event _ _ latestTime latest | latest == content || time < latestTime ->     Nothing-  hist | inRecent now e hist ->+  hist | inRecent now event hist ->     Nothing   hist ->-    Just (hist |> e)+    Just (hist |> event)  -- |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+insertEvent event = do   now <- Time.now-  atomicState' \ s -> result s (appendIfValid now e s)+  atomicState' \ s -> result s (appendIfValid now event s)   where     result s = \case       Just new -> (new, True)@@ -127,11 +127,13 @@   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)+receiveEvent maxHistory event = do+  Log.debug [exon|listen: #{show event}|]+  ifM (insertEvent event)+    do+      broadcast event+      traverse_ logTruncation =<< truncateLog (fromMaybe 100 maxHistory)+    do Log.debug [exon|Ignoring duplicate event: #{Event.describe event}|]  -- |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.@@ -159,7 +161,7 @@   name <- ask   pure (name == sender && source == agentIdNet) --- |Interpret 'History' as 'AtomicState', broadcasting to agents.+-- |Interpret 'History' using 'AtomicState', broadcasting to agents. interpretHistory ::   Members Agents r =>   Members [Reader InstanceName, AtomicState (Seq Event), ChronosTime, Log] r =>@@ -170,8 +172,9 @@     History.Get ->       toList <$> atomicGet     History.Receive event ->-      unlessM (isNetworkCycle event) do-        receiveEvent maxHistory event+      ifM (isNetworkCycle event)+        do Log.debug [exon|Ignoring network cycle event: #{Event.describe event}|]+        do receiveEvent maxHistory event     History.Load index -> do-      e <- loadEvent index-      e <$ traverse_ broadcast e+      event <- loadEvent index+      event <$ traverse_ broadcast event

@@ -34,8 +34,7 @@  -- |The default port, 9500. defaultPort :: Int-defaultPort =-  9500+defaultPort = 9500  -- |Run the daemon API. serve ::

@@ -4,22 +4,25 @@ module Helic.Yank where  import qualified Data.Text.IO as Text+import Exon (exon)+import qualified Log import Polysemy.Chronos (ChronosTime) import System.IO (stdin)  import Helic.Data.AgentId (AgentId (AgentId)) import qualified Helic.Data.Event as Event import Helic.Data.InstanceName (InstanceName)-import Helic.Data.YankConfig (YankConfig (YankConfig))+import qualified Helic.Data.YankConfig+import Helic.Data.YankConfig (YankConfig) import qualified Helic.Effect.Client as Client import Helic.Effect.Client (Client)  -- |Send an event to the server. yank ::-  Members [Reader InstanceName, Client, ChronosTime, Error Text, Embed IO] r =>+  Members [Reader InstanceName, Client, ChronosTime, Log, 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-  fromEither =<< Client.yank event+yank conf = do+  text <- fromMaybeA (embed (Text.hGetContents stdin)) conf.text+  event <- Event.now (AgentId (fromMaybe "cli" conf.agent)) text+  Client.yank event >>= leftA \ err -> Log.debug [exon|Http client error: #{err}|]

@@ -20,7 +20,7 @@ |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 yank`|Send standard input or argument 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.| @@ -45,7 +45,7 @@ ## Nix  The project uses a [Nix] [flake] to configure its build, and it is recommended to install or run it using *Nix* as well.-If *Nix* is installed and configured for use with *flakes*, the app can be run like this:+If *Nix* is installed and configured for use with *flakes*, the app can be run without installation like this:  ```shell $ nix run github:tek/helic -- listen@@ -56,24 +56,25 @@  ## NixOS -The flake provides a *NixOS* module that can be used by adding it to `/etc/nixos/configuration.nix`:+The flake provides a *NixOS* module that can be used by adding it to `/etc/nixos/flake.nix`:  ```nix {   inputs.helic.url = "github:tek/helic";   outputs = { nixpkgs, helic, ... }: {     nixosConfigurations.myhost = nixpkgs.lib.nixosSystem {-      modules = [helic.nixosModule];+      modules = [helic.nixosModules.default];       services.helic.enable = true;     };   }; } ``` -With this, a *systemd* user service will be started on login and the client will be in `$PATH`:+With this, a `systemd` user service will be started on login and the client will be in `$PATH`:  ```shell $ echo 'yank me' | hel yank+$ hel yank --agent custom-name --text 'yank me' ```  After a rebuild, the service may not be started right away, so this command must be executed:@@ -82,7 +83,7 @@ $ systemctl --user start helic ``` -Globally enabled SystemD user services are started for all users on login.+Globally enabled `systemd` user services are started for all users on login. To prevent that, you can set the module option `services.helic.user = "myuser"`.  ## Without Nix@@ -112,6 +113,8 @@ |`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.|+|`yank`|`--agent NAME`|Custom name used in the `list` output and to avoid cycles.|+|`yank`|`--text TEXT`|Yank text, uses stdin if not specified.|  # Configuring Helic @@ -151,6 +154,7 @@     name = "myhost";     maxHistory = 1000;     verbose = true;+    user = "myuser";     net = {       enable = true;       port = 10001;

@@ -1,22 +1,39 @@ module Helic.Dev where  import Conc (withAsync_)+import Exon (exon) import Log (Severity (Trace)) import System.Environment (setEnv)+import System.Random (randomIO) import qualified Time import Time (Seconds (Seconds)) -import Helic.App (listenApp)+import Helic.App (listenApp, yankApp)+import Helic.Config.File (findFileConfig) import Helic.Data.Config (Config (Config)) import Helic.Data.NetConfig (NetConfig (NetConfig))+import Helic.Data.YankConfig (YankConfig (YankConfig))  conf :: Config conf =   Config (Just "dev") (Just def) (Just (NetConfig (Just True) (Just 11111) Nothing Nothing)) Nothing Nothing (Just True) -main :: IO ()-main =+listen :: IO ()+listen =   runAppLevel Trace (withAsync_ setenv (listenApp conf))   where     setenv =       Time.sleep (Seconds 12) *> embed (setEnv "DISPLAY" ":0")++listenSystem :: IO ()+listenSystem =+  runAppLevel Trace do+    config <- findFileConfig Nothing+    listenApp config++yank :: IO ()+yank =+  runAppLevel Trace do+    config <- findFileConfig Nothing+    num :: Int64 <- embed randomIO+    yankApp config (YankConfig Nothing (Just [exon|yanky #{show num}|]))