helic 0.5.3.0 → 0.6.0.0

raw patch · 46 files changed

+336/−476 lines, 46 filesdep +prelatedep +zeugmadep −aesondep −http-clientdep −http-client-tlsdep ~basedep ~chronosdep ~exonPVP ok

version bump matches the API change (PVP)

Dependencies added: prelate, zeugma

Dependencies removed: aeson, http-client, http-client-tls, incipit, servant, servant-client-core, template-haskell, unix

Dependency ranges changed: base, chronos, exon, fast-logger, gi-gdk, gi-glib, gi-gtk, hostname, optparse-applicative, path, path-io, polysemy, polysemy-chronos, polysemy-conc, polysemy-http, polysemy-log, polysemy-plugin, polysemy-process, polysemy-test, polysemy-time, servant-client, servant-server, table-layout, tasty, terminal-size, torsor, typed-process, wai-extra, warp, yaml

API changes (from Hackage documentation)

Files

• changelog.md +6/−0
• helic.cabal +76/−153
• lib/Helic/App.hs +10/−43
• lib/Helic/Cli.hs +14/−56
• lib/Helic/Config/File.hs +1/−1
• lib/Helic/Data/AgentId.hs +0/−2
• lib/Helic/Data/Config.hs +0/−2
• lib/Helic/Data/Event.hs +0/−1
• lib/Helic/Data/Host.hs +0/−2
• lib/Helic/Data/InstanceName.hs +0/−2
• lib/Helic/Data/NetConfig.hs +1/−2
• lib/Helic/Data/TmuxConfig.hs +0/−1
• lib/Helic/Data/X11Config.hs +1/−2
• lib/Helic/Effect/Agent.hs +3/−3
• lib/Helic/Effect/Client.hs +2/−0
• lib/Helic/Effect/History.hs +2/−0
• lib/Helic/Effect/XClipboard.hs +2/−0
• lib/Helic/Gtk.hs +1/−1
• lib/Helic/GtkClipboard.hs +1/−1
• lib/Helic/GtkMain.hs +7/−8
• lib/Helic/Interpreter/Agent.hs +19/−1
• lib/Helic/Interpreter/AgentNet.hs +16/−8
• lib/Helic/Interpreter/AgentTmux.hs +27/−19
• lib/Helic/Interpreter/AgentX.hs +35/−10
• lib/Helic/Interpreter/Client.hs +1/−1
• lib/Helic/Interpreter/Gtk.hs +11/−11
• lib/Helic/Interpreter/GtkClipboard.hs +3/−3
• lib/Helic/Interpreter/GtkMain.hs +10/−9
• lib/Helic/Interpreter/History.hs +6/−7
• lib/Helic/Interpreter/XClipboard.hs +1/−1
• lib/Helic/Json.hs +0/−21
• lib/Helic/List.hs +1/−1
• lib/Helic/Listen.hs +5/−5
• lib/Helic/Net/Api.hs +1/−1
• lib/Helic/Net/Client.hs +4/−4
• lib/Helic/Net/Server.hs +2/−2
• lib/Helic/Tmux.hs +4/−5
• readme.md +18/−3
• test/Helic/Dev.hs +6/−6
• test/Helic/Test/ConfigFileTest.hs +3/−3
• test/Helic/Test/Fixtures.hs +0/−10
• test/Helic/Test/GtkMainTest.hs +14/−24
• test/Helic/Test/InsertEventTest.hs +6/−7
• test/Helic/Test/ListTest.hs +3/−5
• test/Helic/Test/ListenTest.hs +7/−20
• test/Helic/Test/LoadTest.hs +6/−9

@@ -1,3 +1,9 @@+# Unreleased++# 0.6.0.0++* Allow all agents to be disabled in the config file.+ # 0.5.3.0  * Prevent events with timestamps older than the current history head from getting added to the history.

@@ -1,19 +1,19 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.34.6.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack  name:           helic-version:        0.5.3.0+version:        0.6.0.0 synopsis:       Clipboard Manager-description:    See <https://hackage.haskell.org/package/helic/docs/Helic.html>+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:      2022 Torsten Schmits+copyright:      2023 Torsten Schmits license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple@@ -68,7 +68,6 @@       Helic.Interpreter.History       Helic.Interpreter.InstanceName       Helic.Interpreter.XClipboard-      Helic.Json       Helic.List       Helic.Listen       Helic.Net.Api@@ -82,104 +81,74 @@   default-extensions:       AllowAmbiguousTypes       ApplicativeDo-      BangPatterns-      BinaryLiterals       BlockArguments-      ConstraintKinds       DataKinds       DefaultSignatures       DeriveAnyClass-      DeriveDataTypeable-      DeriveFoldable-      DeriveFunctor-      DeriveGeneric-      DeriveLift-      DeriveTraversable       DerivingStrategies       DerivingVia       DisambiguateRecordFields-      DoAndIfThenElse       DuplicateRecordFields-      EmptyDataDecls-      ExistentialQuantification-      FlexibleContexts-      FlexibleInstances       FunctionalDependencies       GADTs-      GeneralizedNewtypeDeriving-      InstanceSigs-      KindSignatures       LambdaCase       LiberalTypeSynonyms-      MultiParamTypeClasses       MultiWayIf-      NamedFieldPuns-      OverloadedStrings+      OverloadedLabels       OverloadedLists+      OverloadedStrings       PackageImports       PartialTypeSignatures-      PatternGuards       PatternSynonyms-      PolyKinds       QuantifiedConstraints       QuasiQuotes-      RankNTypes       RecordWildCards       RecursiveDo       RoleAnnotations-      ScopedTypeVariables-      StandaloneDeriving       TemplateHaskell-      TupleSections-      TypeApplications       TypeFamilies       TypeFamilyDependencies-      TypeOperators-      TypeSynonymInstances       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -Wall -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin+      OverloadedRecordDot+      NoFieldSelectors+  ghc-options: -fplugin=Polysemy.Plugin -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages   build-depends:-      aeson >=1.5-    , base >=4.12 && <5-    , chronos >=1.1.1-    , exon >=0.3-    , fast-logger >=3-    , gi-gdk >=3-    , gi-glib >=2-    , gi-gtk >=3-    , hostname >=1-    , http-client >=0.5.14-    , http-client-tls >=0.3.1-    , incipit >=0.1.0.3-    , optparse-applicative >=0.16-    , path >=0.8-    , path-io >=1.6-    , polysemy >=1.6-    , polysemy-chronos >=0.3-    , polysemy-conc >=0.6-    , polysemy-http >=0.6-    , polysemy-log >=0.5-    , polysemy-plugin >=0.4-    , polysemy-process >=0.6-    , polysemy-time >=0.3-    , servant >=0.18-    , 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+      base ==4.*+    , chronos >=1.1.1 && <1.2+    , exon ==1.4.*+    , fast-logger ==3.1.*+    , gi-gdk >=3 && <3.1+    , gi-glib >=2 && <2.1+    , gi-gtk >=3 && <3.1+    , hostname >=1 && <1.1+    , optparse-applicative ==0.17.*+    , path ==0.9.*+    , path-io ==1.7.*+    , polysemy ==1.9.*+    , polysemy-chronos ==0.6.*+    , polysemy-conc ==0.12.*+    , polysemy-http ==0.11.*+    , polysemy-log ==0.9.*+    , polysemy-plugin ==0.4.*+    , polysemy-process ==0.12.*+    , polysemy-time ==0.6.*+    , prelate ==0.5.*+    , servant-client ==0.19.*+    , servant-server ==0.19.*+    , table-layout ==0.9.*+    , terminal-size >=0.3.2.1 && <0.4     , transformers-    , typed-process >=0.2.6-    , unix-    , wai-extra >=3.1-    , warp >=3.3-    , yaml >=0.11+    , typed-process >=0.2.6 && <0.3+    , wai-extra ==3.1.*+    , warp ==3.3.*+    , yaml ==0.11.*   mixins:       base hiding (Prelude)-  default-language: Haskell2010+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: GHC2021  executable hel   main-is: Main.hs@@ -188,81 +157,57 @@   default-extensions:       AllowAmbiguousTypes       ApplicativeDo-      BangPatterns-      BinaryLiterals       BlockArguments-      ConstraintKinds       DataKinds       DefaultSignatures       DeriveAnyClass-      DeriveDataTypeable-      DeriveFoldable-      DeriveFunctor-      DeriveGeneric-      DeriveLift-      DeriveTraversable       DerivingStrategies       DerivingVia       DisambiguateRecordFields-      DoAndIfThenElse       DuplicateRecordFields-      EmptyDataDecls-      ExistentialQuantification-      FlexibleContexts-      FlexibleInstances       FunctionalDependencies       GADTs-      GeneralizedNewtypeDeriving-      InstanceSigs-      KindSignatures       LambdaCase       LiberalTypeSynonyms-      MultiParamTypeClasses       MultiWayIf-      NamedFieldPuns-      OverloadedStrings+      OverloadedLabels       OverloadedLists+      OverloadedStrings       PackageImports       PartialTypeSignatures-      PatternGuards       PatternSynonyms-      PolyKinds       QuantifiedConstraints       QuasiQuotes-      RankNTypes       RecordWildCards       RecursiveDo       RoleAnnotations-      ScopedTypeVariables-      StandaloneDeriving       TemplateHaskell-      TupleSections-      TypeApplications       TypeFamilies       TypeFamilyDependencies-      TypeOperators-      TypeSynonymInstances       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -Wall -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+      OverloadedRecordDot+      NoFieldSelectors+  ghc-options: -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages   build-depends:-      base >=4.12 && <5+      base ==4.*     , helic-    , incipit >=0.1.0.3-    , polysemy >=1.6-    , polysemy-plugin >=0.4+    , polysemy ==1.9.*+    , polysemy-plugin ==0.4.*+    , prelate ==0.5.*   mixins:       base hiding (Prelude)-  default-language: Haskell2010+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: GHC2021 -test-suite helic-unit+test-suite helic-test   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:       Helic.Dev       Helic.Test.ConfigFileTest-      Helic.Test.Fixtures       Helic.Test.GtkMainTest       Helic.Test.InsertEventTest       Helic.Test.ListenTest@@ -273,81 +218,59 @@   default-extensions:       AllowAmbiguousTypes       ApplicativeDo-      BangPatterns-      BinaryLiterals       BlockArguments-      ConstraintKinds       DataKinds       DefaultSignatures       DeriveAnyClass-      DeriveDataTypeable-      DeriveFoldable-      DeriveFunctor-      DeriveGeneric-      DeriveLift-      DeriveTraversable       DerivingStrategies       DerivingVia       DisambiguateRecordFields-      DoAndIfThenElse       DuplicateRecordFields-      EmptyDataDecls-      ExistentialQuantification-      FlexibleContexts-      FlexibleInstances       FunctionalDependencies       GADTs-      GeneralizedNewtypeDeriving-      InstanceSigs-      KindSignatures       LambdaCase       LiberalTypeSynonyms-      MultiParamTypeClasses       MultiWayIf-      NamedFieldPuns-      OverloadedStrings+      OverloadedLabels       OverloadedLists+      OverloadedStrings       PackageImports       PartialTypeSignatures-      PatternGuards       PatternSynonyms-      PolyKinds       QuantifiedConstraints       QuasiQuotes-      RankNTypes       RecordWildCards       RecursiveDo       RoleAnnotations-      ScopedTypeVariables-      StandaloneDeriving       TemplateHaskell-      TupleSections-      TypeApplications       TypeFamilies       TypeFamilyDependencies-      TypeOperators-      TypeSynonymInstances       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -Wall -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+      OverloadedRecordDot+      NoFieldSelectors+  ghc-options: -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages   build-depends:-      base >=4.12 && <5-    , chronos+      base ==4.*+    , chronos >=1.1.1 && <1.2     , containers-    , exon+    , exon ==1.4.*     , helic-    , incipit >=0.1.0.3-    , path-    , polysemy >=1.6-    , polysemy-chronos-    , polysemy-conc-    , polysemy-log-    , polysemy-plugin >=0.4-    , polysemy-test-    , polysemy-time-    , tasty-    , torsor+    , 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.*+    , tasty ==1.4.*+    , torsor ==0.1.*+    , zeugma ==0.7.*   mixins:       base hiding (Prelude)-  default-language: Haskell2010+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: GHC2021

@@ -4,77 +4,44 @@ -- Internal. module Helic.App where -import Conc (Critical, interpretAtomic, interpretEventsChan, interpretSync, withAsync_)-import Polysemy.Chronos (ChronosTime)-import qualified Polysemy.Conc as Conc+import qualified Conc+import Conc (interpretAtomic, interpretEventsChan, interpretSync, withAsync_) import Polysemy.Http (Manager) import Polysemy.Http.Interpreter.Manager (interpretManager)-import Polysemy.Log (Logger)-import Polysemy.Time (GhcTime, MilliSeconds (MilliSeconds), Seconds (Seconds))  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) import qualified Helic.Effect.Client as Client import Helic.Effect.Client (Client) import qualified Helic.Effect.History as History-import Helic.GtkClipboard (subscribeEvents)-import Helic.GtkMain (gtkMainLoop)-import Helic.Interpreter.AgentNet (interpretAgentNet)-import Helic.Interpreter.AgentTmux (interpretAgentTmux)-import Helic.Interpreter.AgentX (interpretAgentX)+import Helic.Interpreter.AgentNet (interpretAgentNetIfEnabled)+import Helic.Interpreter.AgentTmux (interpretAgentTmuxIfEnabled)+import Helic.Interpreter.AgentX (interpretX) import Helic.Interpreter.Client (interpretClientNet)-import Helic.Interpreter.Gtk (interpretGtk)-import Helic.Interpreter.GtkClipboard (interpretGtkClipboard)-import Helic.Interpreter.GtkMain (interpretGtkMain) import Helic.Interpreter.History (interpretHistory) import Helic.Interpreter.InstanceName (interpretInstanceName)-import Helic.Interpreter.XClipboard (interpretXClipboardGtk) import Helic.List (list) import Helic.Net.Api (serve) import Helic.Yank (yank) -type IOStack =-  [-    Error Text,-    Logger,-    Interrupt,-    Critical,-    ChronosTime,-    GhcTime,-    Race,-    Async,-    Resource,-    Embed IO,-    Final IO-  ]--type AppStack =-    Log : IOStack- listenApp ::   Config ->   Sem AppStack () listenApp (Config name tmux net x11 maxHistory _) =-  runReader (fromMaybe def tmux) $   runReader (fromMaybe def net) $-  interpretEventsChan @XClipboardEvent $+  runReader (fromMaybe def x11) $+  runReader (fromMaybe def tmux) $   interpretEventsChan @Event $   interpretAtomic mempty $   interpretInstanceName name $   interpretManager $-  interpretGtk (fromMaybe def x11) $-  interpretGtkMain (MilliSeconds 500) (Seconds 10) $-  interpretGtkClipboard $-  gtkMainLoop subscribeEvents $-  interpretXClipboardGtk $-  interpretAgentX $-  interpretAgentNet $-  interpretAgentTmux $+  interpretX $+  interpretAgentNetIfEnabled $+  interpretAgentTmuxIfEnabled $   interpretHistory maxHistory $   interpretSync $   withAsync_ serve $

@@ -3,66 +3,19 @@ -- |CLI, Internal module Helic.Cli where +import qualified Conc import Options.Applicative (customExecParser, fullDesc, header, helper, info, prefs, showHelpOnEmpty, showHelpOnError)-import Polysemy.Chronos (interpretTimeChronos)-import qualified Polysemy.Conc as Conc-import Polysemy.Conc (-  interpretCritical,-  interpretInterrupt,-  interpretRace,-  )-import Polysemy.Log (-  LogEntry,-  LogMessage,-  Logger,-  Severity (Info, Trace),-  formatLogEntry,-  interceptDataLogConc,-  interpretDataLogStdoutWith,-  interpretLogDataLog,-  setLogLevel,-  )-import qualified Polysemy.Log.Data.DataLog as DataLog-import Polysemy.Time (GhcTime, MilliSeconds (MilliSeconds), interpretTimeGhc)+import Polysemy.Log (Severity (Info, Trace)) import System.IO (hLookAhead, stdin)+import Time (MilliSeconds (MilliSeconds)) -import Helic.App (AppStack, IOStack, listApp, listenApp, loadApp, yankApp)+import Helic.App (listApp, listenApp, loadApp, yankApp) import Helic.Cli.Options (Command (List, Listen, Load, Yank), Conf (Conf), parser) import Helic.Config.File (findFileConfig) import qualified Helic.Data.Config as Config import Helic.Data.Config (Config) import Helic.Data.YankConfig (YankConfig (YankConfig)) -logError ::-  Members [Logger, GhcTime, Final IO] r =>-  Sem (Error Text : r) () ->-  Sem r ()-logError =-  either DataLog.error pure <=< errorToIOFinal--interpretLog ::-  Maybe Bool ->-  InterpreterFor Log IOStack-interpretLog (fromMaybe False -> verbose) =-  setLogLevel (if verbose then Just Trace else Just Info) . interpretLogDataLog--runIO ::-  Sem IOStack () ->-  IO ()-runIO =-  runFinal .-  embedToFinal .-  resourceToIOFinal .-  asyncToIOFinal .-  interpretRace .-  interpretTimeGhc .-  interpretTimeChronos .-  interpretCritical .-  interpretInterrupt .-  interpretDataLogStdoutWith formatLogEntry .-  interceptDataLogConc @(LogEntry LogMessage) 64 .-  logError- runCommand :: Config -> Command -> Sem AppStack () runCommand config = \case   Listen ->@@ -74,18 +27,23 @@   Load loadConf ->     loadApp config loadConf -defaultCommand :: Sem IOStack Command+defaultCommand :: Sem AppStack Command defaultCommand = do   Conc.timeout_ (pure Nothing) (MilliSeconds 100) (Just <$> tryAny (hLookAhead stdin)) <&> \case     Just (Right _) -> Yank (YankConfig (Just "cli"))     _ -> Listen  withCliOptions :: Conf -> Maybe Command -> IO ()-withCliOptions (Conf cliVerbose file) cmd =-  runIO do-    config <- interpretLog cliVerbose (findFileConfig file)+withCliOptions (Conf cliVerbose file) cmd = do+  config <- runLevel cliVerbose (findFileConfig file)+  runLevel (cliVerbose <|> config.verbose) do     cmd' <- maybe defaultCommand pure cmd-    interpretLog (cliVerbose <|> Config.verbose config) (runCommand config cmd')+    runCommand config cmd'+  where+    runLevel l = runAppLevel (level l)+    level = \case+      Just True -> Trace+      _ -> Info  app :: IO () app = do

@@ -5,7 +5,7 @@  import Data.Yaml (decodeFileEither, prettyPrintParseException) import Exon (exon)-import Path (Abs, File, Path, Rel, absfile, relfile, toFilePath, (</>))+import Path (Abs, File, Path, absfile, relfile, toFilePath, (</>)) import Path.IO (XdgDirectory (XdgConfig), doesFileExist, getXdgDir) import qualified Polysemy.Log as Log 

@@ -3,8 +3,6 @@ -- |AgentId Data Type, Internal module Helic.Data.AgentId where -import Polysemy.Time.Json (json)- newtype AgentId =   AgentId { unAgentId :: Text }   deriving stock (Eq, Show)

@@ -3,8 +3,6 @@ -- |Config Data Type, Internal module Helic.Data.Config where -import Polysemy.Time.Json (json)- import Helic.Data.NetConfig (NetConfig) import Helic.Data.TmuxConfig (TmuxConfig) import Helic.Data.X11Config (X11Config)

@@ -4,7 +4,6 @@ import qualified Chronos import Polysemy.Chronos (ChronosTime) import qualified Polysemy.Time as Time-import Polysemy.Time.Json (json)  import Helic.Data.AgentId (AgentId) import Helic.Data.InstanceName (InstanceName)

@@ -3,8 +3,6 @@ -- |Host Data Type, Internal module Helic.Data.Host where -import Polysemy.Time.Json (json)- newtype Host =   Host { unHost :: Text }   deriving stock (Eq, Show)

@@ -3,8 +3,6 @@ -- |InstanceName Data Type, Internal module Helic.Data.InstanceName where -import Polysemy.Time.Json (json)- newtype InstanceName =   InstanceName { unInstanceName :: Text }   deriving stock (Eq, Show, Generic)

@@ -3,8 +3,6 @@ -- |NetConfig Data Type, Internal module Helic.Data.NetConfig where -import Polysemy.Time.Json (json)- import Helic.Data.Host (Host)  newtype Timeout =@@ -16,6 +14,7 @@  data NetConfig =   NetConfig {+    enable :: Maybe Bool,     port :: Maybe Int,     timeout :: Maybe Timeout,     hosts :: Maybe [Host]

@@ -4,7 +4,6 @@ module Helic.Data.TmuxConfig where  import Path (Abs, File, Path)-import Polysemy.Time.Json (json)  data TmuxConfig =   TmuxConfig {

@@ -3,8 +3,6 @@ -- |X11Config Data Type, Internal module Helic.Data.X11Config where -import Helic.Json (json, unaryJson)- newtype DisplayId =   DisplayId { unDisplayId :: Text }   deriving stock (Eq, Show, Generic)@@ -14,6 +12,7 @@  data X11Config =   X11Config {+    enable :: Maybe Bool,     display :: Maybe DisplayId   }   deriving stock (Eq, Show, Generic)

@@ -30,9 +30,9 @@ -- |The default agents for the Helic CLI. type Agents =   [-    Tagged AgentTmux Agent,-    Tagged AgentX Agent,-    Tagged AgentNet Agent+    Agent @@ AgentTmux,+    Agent @@ AgentX,+    Agent @@ AgentNet   ]  class AgentName (tag :: AgentTag) where

@@ -1,6 +1,8 @@ -- |Client Effect, Internal module Helic.Effect.Client where +import Prelude hiding (get)+ import Helic.Data.Event (Event)  -- |An abstraction of the API, used by the @list@ command.

@@ -1,6 +1,8 @@ -- |History Effect, Internal module Helic.Effect.History where +import Prelude hiding (get)+ import Helic.Data.Event (Event)  -- |The core actions of the 'Event' history.

@@ -2,6 +2,8 @@ -- |The XClipboard Effect module Helic.Effect.XClipboard where +import Prelude hiding (set)+ import Helic.Data.Selection (Selection)  -- |Communicate with the X11 clipboard.

@@ -8,8 +8,8 @@ import qualified GI.Gdk as GiGdk import GI.Gdk (Display) import qualified GI.Gtk as GiGtk+import qualified Log import Polysemy.Final (withWeavingToFinal)-import qualified Polysemy.Log as Log  import qualified Helic.Data.Selection as Selection import Helic.Data.Selection (Selection)

@@ -13,7 +13,7 @@ -- |Registers a callback with GTK's clipboard event system that converts each update into an 'XClipboardEvent' published -- through 'Events'. subscribeEvents ::-  Members [Scoped s GtkClipboard !! Text, Events res XClipboardEvent, Log] r =>+  Members [Scoped_ GtkClipboard !! Text, Events XClipboardEvent, Log] r =>   Sem r () subscribeEvents =   resuming failure $ withGtkClipboard do

@@ -1,10 +1,9 @@ -- |API for the GTK main loop.--- Internal. module Helic.GtkMain where +import Conc (withAsync_) import Exon (exon)-import Polysemy.Conc (withAsync_)-import qualified Polysemy.Log as Log+import qualified Log  import qualified Helic.Effect.Gtk as Gtk import Helic.Effect.Gtk (Gtk)@@ -15,11 +14,11 @@ -- Before that, initialize the GTK client environment, store the default display in the state of 'GtkMain', and execute -- the user-supplied initialization action. gtkMain ::-  Members [Scoped resource (Gtk s), GtkMain s, Resource] r =>+  Members [Scoped_ (Gtk s), GtkMain s, Resource] r =>   Sem r () ->   Sem r () gtkMain onInit =-  scoped do+  scoped_ do     GtkMain.running =<< Gtk.resource     raise onInit     Gtk.main@@ -28,13 +27,13 @@ -- After the loop has failed or was terminated, the default implementation waits for 10 seconds before restarting it, -- but can be forced to start when a consumer tries to use it. loopGtkMain ::-  Members [Scoped resource (Gtk s) !! Text, GtkMain s, Resource, Log] r =>+  Members [Scoped_ (Gtk s) !! Text, GtkMain s, Resource, Log] r =>   Sem r () ->   Sem r () loopGtkMain onInit =   forever do     GtkMain.run do-      gtkMain (raise onInit) !! \ e ->+      gtkMain @_ @(Scoped_ (Gtk _) : _) (raise onInit) !! \ e ->         Log.error [exon|Gtk main loop failed: #{e}|]  -- |Acquire a GTK resource by first examining the value currently stored in 'GtkMain', and if there is none, requesting@@ -49,7 +48,7 @@  -- |Run 'loopGtkMain' in a thread. gtkMainLoop ::-  Members [Scoped resource (Gtk s) !! Text, GtkMain s, Log, Race, Resource, Async] r =>+  Members [Scoped_ (Gtk s) !! Text, GtkMain s, Log, Race, Resource, Async] r =>   Sem r () ->   Sem r a ->   Sem r a

@@ -1,6 +1,8 @@ -- |Simple Agent Interpreter, Internal module Helic.Interpreter.Agent where +import GHC.Records (HasField)+ import Helic.Data.Event (Event) import Helic.Effect.Agent (Agent (Update)) import Helic.Interpreter (interpreting)@@ -9,8 +11,24 @@ interpretAgent ::   ∀ id r .   (Event -> Sem r ()) ->-  InterpreterFor (Tagged id Agent) r+  InterpreterFor (Agent @@ id) r interpretAgent handle sem =   interpreting (untag sem) \case     Update e ->       handle e++-- | Interpret 'Agent' by doing nothing.+interpretAgentNull :: InterpreterFor (Agent @@ id) r+interpretAgentNull = interpretAgent (const unit)++-- | Interpret 'Agent' using the supplied interpreter unless the first argument is 'Just False', in which case run the+-- dummy interpreter.+interpretAgentIf ::+  HasField "enable" conf (Maybe Bool) =>+  Member (Reader conf) r =>+  InterpreterFor Agent r ->+  InterpreterFor (Agent @@ id) r+interpretAgentIf int sem = do+  conf <- ask+  if | Just False <- conf.enable -> interpretAgentNull sem+     | otherwise -> int (untag sem)

@@ -5,9 +5,10 @@ import qualified Polysemy.Log as Log  import Helic.Data.Event (Event (source))+import qualified Helic.Data.NetConfig import Helic.Data.NetConfig (NetConfig (NetConfig)) import Helic.Effect.Agent (Agent (Update), AgentNet, agentIdNet)-import Helic.Interpreter (interpreting)+import Helic.Interpreter.Agent (interpretAgentIf) import Helic.Net.Client (sendTo)  -- |Interpret 'Agent' using remote hosts as targets.@@ -16,10 +17,17 @@ interpretAgentNet ::   Members [Manager, Reader NetConfig] r =>   Members [Log, Interrupt, Race, Resource, Async, Embed IO, Final IO] r =>-  InterpreterFor (Tagged AgentNet Agent) r-interpretAgentNet sem =-  interpreting (untag sem) \case-    Update e -> do-      NetConfig _ timeout hosts <- ask-      for_ (fold hosts) \ host ->-        either Log.debug pure =<< runError (sendTo timeout host e { source = agentIdNet })+  InterpreterFor Agent r+interpretAgentNet =+  interpret \ (Update e) -> do+    NetConfig _ _ timeout hosts <- ask+    for_ (fold hosts) \ host ->+      either Log.debug pure =<< runError (sendTo timeout host e { source = agentIdNet })++-- | Interpret 'Agent' for remote hosts if it is enabled by the configuration.+interpretAgentNetIfEnabled ::+  Members [Manager, Reader NetConfig] r =>+  Members [Log, Interrupt, Race, Resource, Async, Embed IO, Final IO] r =>+  InterpreterFor (Agent @@ AgentNet) r+interpretAgentNetIfEnabled sem = do+  interpretAgentIf interpretAgentNet sem

@@ -4,18 +4,17 @@ import Exon (exon) import qualified Log import Path (Abs, File, Path, toFilePath)-import Polysemy.Chronos (ChronosTime)-import Polysemy.Process (ProcessKill (KillAfter), interpretProcessByteStringNative)+import Polysemy.Process (Process, ProcessKill (KillAfter), interpretProcessByteString, interpretProcessNative_) import Polysemy.Process.Data.ProcessError (ProcessError) import Polysemy.Process.Data.ProcessOptions (ProcessOptions (kill))-import Polysemy.Time (MilliSeconds (MilliSeconds), convert) import qualified System.Process.Typed as Process import System.Process.Typed (ProcessConfig)+import Time (MilliSeconds (MilliSeconds), convert)  import qualified Helic.Data.TmuxConfig as TmuxConfig import Helic.Data.TmuxConfig (TmuxConfig) import Helic.Effect.Agent (Agent (Update), AgentTmux)-import Helic.Interpreter (interpreting)+import Helic.Interpreter.Agent (interpretAgentIf) import Helic.Tmux (sendToTmux)  -- |Process definition for running `tmux load-buffer -`.@@ -28,22 +27,31 @@     cmd =       maybe "tmux" toFilePath exe --- |Consult the config as to whether tmux should be used, defaulting to true.-enableTmux ::-  Member (Reader TmuxConfig) r =>-  Sem r Bool-enableTmux =-  fromMaybe True <$> asks TmuxConfig.enable+-- |Handle 'Agent' using a tmux server as the target.+handleAgentTmux ::+  Members [Scoped_ (Process ByteString o) !! ProcessError, Log] r =>+  Agent m a ->+  Sem r a+handleAgentTmux (Update event) =+  sendToTmux @_ @(_ _ : _) event !! \ (e :: ProcessError) ->+    Log.error [exon|Sending to tmux: #{show e}|]  -- |Interpret 'Agent' using a tmux server as the target. interpretAgentTmux ::-  Members [Reader TmuxConfig, Log, Async, Race, Resource, ChronosTime, Embed IO] r =>-  InterpreterFor (Tagged AgentTmux Agent) r+  Members [Reader TmuxConfig, Log, Resource, Race, Async, Embed IO] r =>+  InterpreterFor Agent r interpretAgentTmux sem = do-  exe <- asks TmuxConfig.exe-  interpretProcessByteStringNative def { kill = KillAfter (convert (MilliSeconds 500)) } (tmuxProc exe) $-    interpreting (raiseUnder (untag sem)) \case-      Update event ->-        whenM enableTmux do-          sendToTmux event !! \ (e :: ProcessError) ->-            Log.error [exon|Sending to tmux: #{show e}|]+  conf <- ask+  interpretProcessByteString $+    interpretProcessNative_ options (tmuxProc conf.exe) $+    interpret handleAgentTmux $+    insertAt @1 sem+  where+    options = def { kill = KillAfter (convert (MilliSeconds 500)) }++-- | Interpret 'Agent' for tmux if it is enabled by the configuration.+interpretAgentTmuxIfEnabled ::+  Members [Reader TmuxConfig, Log, Resource, Race, Async, Embed IO] r =>+  InterpreterFor (Agent @@ AgentTmux) r+interpretAgentTmuxIfEnabled =+  interpretAgentIf interpretAgentTmux

@@ -2,24 +2,33 @@ module Helic.Interpreter.AgentX where  import qualified Conc-import Conc (withAsync_)+import Conc (interpretEventsChan, withAsync_) import Exon (exon) import Polysemy.Chronos (ChronosTime) import qualified Polysemy.Log as Log+import Time (MilliSeconds (MilliSeconds), Seconds (Seconds))  import qualified Helic.Data.Event as Event import Helic.Data.Event (Event (Event)) import Helic.Data.InstanceName (InstanceName)+import qualified Helic.Data.X11Config+import Helic.Data.X11Config (X11Config) import Helic.Data.XClipboardEvent (XClipboardEvent (XClipboardEvent)) import Helic.Effect.Agent (Agent (Update), AgentX, agentIdX) import qualified Helic.Effect.XClipboard as XClipboard import Helic.Effect.XClipboard (XClipboard)-import Helic.Interpreter (interpreting)+import Helic.GtkClipboard (subscribeEvents)+import Helic.GtkMain (gtkMainLoop)+import Helic.Interpreter.Agent (interpretAgentIf)+import Helic.Interpreter.Gtk (interpretGtk)+import Helic.Interpreter.GtkClipboard (interpretGtkClipboard)+import Helic.Interpreter.GtkMain (interpretGtkMain)+import Helic.Interpreter.XClipboard (interpretXClipboardGtk)  -- |Listen for 'XClipboardEvent's and publish them as 'Event's. transformXEvents ::-  Members [EventConsumer xr XClipboardEvent, Reader InstanceName] r =>-  Members [Events er Event, XClipboard !! Text, Log, ChronosTime, Resource, Race, Async] r =>+  Members [EventConsumer XClipboardEvent, Reader InstanceName] r =>+  Members [Events Event, XClipboard !! Text, Log, ChronosTime, Resource, Race, Async] r =>   Sem r a ->   Sem r a transformXEvents =@@ -35,12 +44,28 @@ -- This interpreter also runs a thread that converts events generated by the 'XClipboard' interpreter -- ('XClipboardEvent') to the main 'Event' type. interpretAgentX ::-  Members [EventConsumer xr XClipboardEvent, Events er Event, Reader InstanceName, XClipboard !! Text, ChronosTime] r =>-  Members [Events xr XClipboardEvent, Log, Error Text, Race, Resource, Async, Embed IO, Final IO] r =>-  InterpreterFor (Tagged AgentX Agent) r-interpretAgentX sem =-  transformXEvents $-  interpreting (untag sem) \case+  Members [EventConsumer XClipboardEvent, Events Event, Reader InstanceName, XClipboard !! Text] r =>+  Members [ChronosTime, Log, Race, Resource, Async] r =>+  InterpreterFor Agent r+interpretAgentX =+  transformXEvents .+  interpret \case     Update Event {..} ->       XClipboard.set content !! \ e ->         Log.error [exon|Setting the X clipboard failed: #{e}|]++-- | Interpret 'Agent' for X11 if it is enabled by the configuration.+interpretX ::+  Members [Reader X11Config, Events Event, Reader InstanceName] r =>+  Members [ChronosTime, Log, Error Text, Race, Resource, Mask, Async, Embed IO, Final IO] r =>+  InterpreterFor (Agent @@ AgentX) r+interpretX =+  interpretAgentIf @X11Config $+  interpretEventsChan @XClipboardEvent .+  interpretGtk .+  interpretGtkMain (MilliSeconds 500) (Seconds 10) .+  interpretGtkClipboard .+  gtkMainLoop subscribeEvents .+  interpretXClipboardGtk .+  interpretAgentX .+  insertAt @1

@@ -23,7 +23,7 @@       bimap show toList <$> embed (runClientM Api.get env)     Yank event -> do       host <- localhost-      timeout <- asks NetConfig.timeout+      timeout <- asks (.timeout)       runError (sendTo timeout host event)     Load event -> do       env <- mkClientEnv <$> Manager.get <*> localhostUrl

@@ -5,10 +5,10 @@ import Exon (exon) import qualified GI.Gdk as GiGdk import qualified GI.Gtk as GiGtk-import Polysemy.Conc (interpretScopedResumable) import qualified Polysemy.Log as Log -import Helic.Data.X11Config (DisplayId (DisplayId), X11Config (X11Config))+import qualified Helic.Data.X11Config+import Helic.Data.X11Config (DisplayId (DisplayId), X11Config) import qualified Helic.Effect.Gtk as Gtk import Helic.Effect.Gtk (Gtk) import Helic.Gtk (getDisplay)@@ -38,21 +38,22 @@  -- |Initialize GTK, run the scoped action, then tear down the GTK environment. bracketGtk ::-  Members [Resource, Log, Embed IO] r =>-  DisplayId ->+  Members [Reader X11Config, Resource, Log, Embed IO] r =>   (GiGdk.Display -> Sem (Stop Text : r) a) ->   Sem (Stop Text : r) a-bracketGtk fallbackDisplay =+bracketGtk =   bracket acquire release   where     acquire = do       unlessM (fst <$> tryStop (GiGtk.initCheck Nothing)) do+        conf <- ask+        let fallbackDisplay = fromMaybe ":0" conf.display         dm <- tryStop GiGdk.displayManagerGet         ifM (noDisplayAvailable dm) (tryOpenDisplay fallbackDisplay dm) (stop "GTK intialization failed")       getDisplay     release display = do       Log.debug "Quitting the GTK main loop"-      ignoreException do+      tryAny_ do         GiGdk.displayFlush display         GiGdk.displayClose display       tryStop GiGtk.mainQuit@@ -60,11 +61,10 @@ -- |Interpret 'Gtk' natively, using the "GI.Gtk" and "Gi.Gdk" libraries. -- This uses 'Scoped' to bracket the initialization and termination of the GTK environment. interpretGtk ::-  Members [Resource, Log, Embed IO] r =>-  X11Config ->-  InterpreterFor (Scoped GiGdk.Display (Gtk GiGdk.Display) !! Text) r-interpretGtk (X11Config fallbackDisplay) =-  interpretScopedResumable (bracketGtk (fromMaybe ":0" fallbackDisplay)) \ display -> \case+  Members [Reader X11Config, Resource, Log, Embed IO] r =>+  InterpreterFor (Scoped_ (Gtk GiGdk.Display) !! Text) r+interpretGtk =+  interpretScopedResumable (const bracketGtk) \ display -> \case     Gtk.Main ->       GiGtk.main     Gtk.Resource ->

@@ -11,10 +11,10 @@  -- |Specialization of 'scoped' to 'GtkClipboard' for syntactic sugar. withGtkClipboard ::-  Member (Scoped resource GtkClipboard) r =>+  Member (Scoped_ GtkClipboard) r =>   InterpreterFor GtkClipboard r withGtkClipboard =-  scoped+  scoped_  -- |This handler for 'GtkClipboard' depends on a 'Display', which should optimally be provided by a 'Scoped' -- interpreter to ensure safe acquisition of the resource.@@ -39,6 +39,6 @@ -- |Native interpreter for 'GtkClipboard' that requires the effect to be used within a 'withGtkClipboard' region. interpretGtkClipboard ::   Members [GtkMain Display, Log, Embed IO, Final IO] r =>-  InterpreterFor (Scoped Display GtkClipboard !! Text) r+  InterpreterFor (Scoped_ GtkClipboard !! Text) r interpretGtkClipboard =   interpretWithGtk handleGtkClipboard

@@ -4,8 +4,9 @@ -- Internal. module Helic.Interpreter.GtkMain where -import Polysemy.Conc (interpretScopedResumableH, interpretSync, interpretSyncAs, lock)-import qualified Polysemy.Conc.Sync as Sync+import Conc (Lock, interpretLockReentrant, interpretSync, lock)+import Polysemy.Opaque (Opaque)+import qualified Sync  import qualified Helic.Effect.GtkMain as GtkMain import Helic.Effect.GtkMain (GtkMain)@@ -31,14 +32,14 @@   ∀ s wait restart e m r a .   TimeUnit wait =>   TimeUnit restart =>-  Members [Resource, Sync GtkLock, Sync StartGtkMain, Sync (GtkResource s)] r =>+  Members [Resource, Lock, Sync StartGtkMain, Sync (GtkResource s)] r =>   wait ->   restart ->   GtkMain s m a ->   Tactical e m r a handleGtkMain wait restart = \case   GtkMain.Access ms -> do-    lock GtkLock do+    lock do       Sync.try >>= \case         Just (GtkResource s) ->           pureT s@@ -66,13 +67,13 @@   ∀ s wait restart r .   TimeUnit wait =>   TimeUnit restart =>-  Members [Resource, Race, Embed IO] r =>+  Members [Mask, Resource, Race, Embed IO] r =>   wait ->   restart ->   InterpreterFor (GtkMain s) r interpretGtkMain wait restart =   interpretSync .-  interpretSyncAs GtkLock .+  interpretLockReentrant .   interpretSync @StartGtkMain .   interpretH (handleGtkMain wait restart) .   raiseUnder3@@ -81,7 +82,7 @@ interpretWithGtk ::   ∀ e s r .   Members [GtkMain s, Log] r =>-  (∀ r0 x . s -> e (Sem r0) x -> Tactical e (Sem r0) (Stop Text : r) x) ->-  InterpreterFor (Scoped s e !! Text) r+  (∀ q r0 x . s -> e (Sem r0) x -> Tactical e (Sem r0) (Stop Text : Opaque q : r) x) ->+  InterpreterFor (Scoped_ e !! Text) r interpretWithGtk =-  interpretScopedResumableH (=<< gtkResource)+  interpretScopedResumableH \ () -> (=<< gtkResource)

@@ -8,11 +8,10 @@ import Data.Sequence (Seq ((:|>)), (!?), (|>)) import qualified Data.Text as Text import Exon (exon)+import qualified Log import Polysemy.Chronos (ChronosTime)-import qualified Polysemy.Log as Log-import qualified Polysemy.Time as Time-import Polysemy.Time (Seconds (Seconds), convert)-import Polysemy.Time.Diff (diff)+import qualified Time+import Time (MilliSeconds (MilliSeconds), diff)  import Helic.Data.AgentId (AgentId (AgentId)) import qualified Helic.Data.Event as Event@@ -27,7 +26,7 @@ runAgent ::   ∀ (tag :: AgentTag) r .   AgentName tag =>-  Member (Tagged tag Agent) r =>+  Member (Agent @@ tag) r =>   Event ->   Sem r () runAgent (Event _ (AgentId eId) _ _) | eId == agentName @tag =@@ -54,10 +53,10 @@   Seq Event ->   Bool inRecent now (Event _ _ _ c) =-  any ((c ==) . Event.content) . Seq.takeWhileR newer+  any ((c ==) . (.content)) . Seq.takeWhileR newer   where     newer (Event _ _ t _) =-      diff now t <= convert (Seconds 1)+      diff now t <= MilliSeconds 1000  sanitizeNewlines :: Text -> Text sanitizeNewlines =

@@ -11,7 +11,7 @@ -- |Interpret 'XClipboard' using a GTK backend. -- This uses the library @gi-gtk@ to access the X11 clipboard. interpretXClipboardGtk ::-  Members [Scoped resource GtkClipboard !! Text, Log, Embed IO, Final IO] r =>+  Members [Scoped_ GtkClipboard !! Text, Log, Embed IO, Final IO] r =>   InterpreterFor (XClipboard !! Text) r interpretXClipboardGtk = do   interpretResumable \case

@@ -1,21 +0,0 @@--- |Aeson TH deriving, Internal-module Helic.Json where--import qualified Data.Aeson as Aeson-import Data.Aeson.TH (deriveJSON)-import qualified Language.Haskell.TH as TH---- |Derive Aeson codecs for single-field types with custom settings.-unaryJson :: TH.Name -> TH.Q [TH.Dec]-unaryJson =-  deriveJSON Aeson.defaultOptions {-    Aeson.fieldLabelModifier = dropWhile ('_' ==)-  }---- |Derive Aeson codecs with custom settings.-json :: TH.Name -> TH.Q [TH.Dec]-json =-  deriveJSON Aeson.defaultOptions {-    Aeson.fieldLabelModifier = dropWhile ('_' ==),-    Aeson.unwrapUnaryRecords = True-  }

@@ -63,7 +63,7 @@   Sem r String buildList = do   history <- fromEither =<< Client.get-  limit <- asks ListConfig.limit+  limit <- asks (.limit)   let     dropper l =       drop (length history - l)

@@ -3,10 +3,10 @@ -- |Listen, Internal module Helic.Listen where -import qualified Polysemy.Conc as Conc-import Polysemy.Conc (interpretSync, withAsync_)-import qualified Polysemy.Conc.Sync as Sync+import qualified Conc+import Conc (interpretSync, withAsync_) import Prelude hiding (listen)+import qualified Sync  import Helic.Data.Event (Event) import qualified Helic.Effect.History as History@@ -19,7 +19,7 @@  -- |Listen for 'Event' via 'Polysemy.Conc.Events', broadcasting them to agents. listen ::-  Members [EventConsumer token Event, History, Sync Listening] r =>+  Members [EventConsumer Event, History, Sync Listening] r =>   Sem r () listen =   Conc.subscribe do@@ -29,7 +29,7 @@ -- |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 =>+  Members [EventConsumer Event, History, Resource, Race, Async, Embed IO] r =>   Sem r a ->   Sem r a withListen ma =

@@ -42,5 +42,5 @@   Members [History, Reader NetConfig, Sync ServerReady, Log, Interrupt, Final IO] r =>   Sem r () serve = do-  port <- asks NetConfig.port+  port <- asks (.port)   runServerWithContext @Api server EmptyContext (fromMaybe defaultPort port)

@@ -3,14 +3,14 @@ -- |HTTP Client, Internal module Helic.Net.Client where +import qualified Conc import Exon (exon)-import qualified Polysemy.Conc as Conc+import qualified Log import Polysemy.Http (Manager) import qualified Polysemy.Http.Effect.Manager as Manager-import qualified Polysemy.Log as Log-import Polysemy.Time (MilliSeconds (MilliSeconds)) import Servant (NoContent, type (:<|>) ((:<|>))) import Servant.Client (BaseUrl, ClientM, client, mkClientEnv, parseBaseUrl, runClientM)+import Time (MilliSeconds (MilliSeconds))  import Helic.Data.Event (Event) import Helic.Data.Host (Host (Host))@@ -46,7 +46,7 @@   Member (Reader NetConfig) r =>   Sem r Host localhost = do-  port <- asks NetConfig.port+  port <- asks (.port)   pure (Host [exon|localhost:#{show (fromMaybe defaultPort port)}|])  localhostUrl ::

@@ -5,6 +5,7 @@  import Control.Monad.Trans.Except (ExceptT (ExceptT)) import Exon (exon)+import qualified Log import qualified Network.Wai.Handler.Warp as Warp import Network.Wai.Handler.Warp (   defaultSettings,@@ -17,9 +18,7 @@ import qualified Network.Wai.Middleware.RequestLogger as Logger import Network.Wai.Middleware.RequestLogger (destination, mkRequestLogger) import qualified Polysemy.Conc.Effect.Interrupt as Interrupt-import qualified Polysemy.Conc.Sync as Sync import Polysemy.Final (withWeavingToFinal)-import qualified Polysemy.Log as Log import Servant (   Context,   DefaultErrorFormatters,@@ -34,6 +33,7 @@   serveWithContext,   type (.++),   )+import qualified Sync import System.Log.FastLogger (fromLogStr)  newtype ApiError =

@@ -4,16 +4,15 @@ module Helic.Tmux where  import qualified Polysemy.Process as Process-import Polysemy.Process (Process)-import Polysemy.Process.Effect.Process (withProcess)+import Polysemy.Process (Process, withProcess_)  import Helic.Data.Event (Event (Event))  sendToTmux ::-  ∀ o e resource r .-  Members [Scoped resource (Process ByteString o e), Log] r =>+  ∀ o r .+  Members [Scoped_ (Process ByteString o), Log] r =>   Event ->   Sem r () sendToTmux (Event _ _ _ text) =-  withProcess do+  withProcess_ do     Process.send (encodeUtf8 text)

@@ -60,7 +60,7 @@  ```nix {-  inputs.helic.url = github:/tek/helic;+  inputs.helic.url = "github:tek/helic";   outputs = { nixpkgs, helic, ... }: {     nixosConfigurations.myhost = nixpkgs.lib.nixosSystem {       modules = [helic.nixosModule];@@ -82,6 +82,9 @@ $ systemctl --user start helic ``` +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  Alternatively, the app can be installed using a *Haskell* package manager, like [Cabal]:@@ -125,6 +128,7 @@ maxHistory: 1000 verbose: true net:+  enable: true   port: 10001   hosts:     - "remote1:1000"@@ -133,6 +137,9 @@ tmux:   enable: true   exe: /bin/tmux+x11:+  enable: true+  display: ":0" ```  For *NixOS*, the file `/etc/helic.yaml` is generated from module options:@@ -145,14 +152,19 @@     maxHistory = 1000;     verbose = true;     net = {+      enable = true;       port = 10001;       hosts = ["remote1:1000" "remote2:2000"];       timeout = 5;     };     tmux = {       enable = true;-      package = old.tmux;+      package = pkgs.tmux;     };+    x11 = {+      enable = true;+      display = ":0";+    };   }; } ```@@ -162,15 +174,18 @@ |Key|Default|Description| |---|---|---| |`name`|Host name|An identifier for the host, used for filtering duplicates.|+|`user`|null|Only for *NixOS*: If set, only start the service for that user.| |`maxHistory`|100|The number of yanks that should be kept.| |`verbose`||Increase the log level.|+|`net.enable`|`true`|Whether to send events over the network.| |`net.port`|`9500`|The HTTP port the daemon listens to for both remote sync and `hel yank`.| |`net.hosts`|`[]`|The addresses (with port) of the hosts to which this instance should broadcast yank events.| |`net.timeout`|`300`|The timeout in milliseconds for requests to remote hosts.| |`tmux.enable`|`true`|Whether to send events to *tmux*.| |`tmux.package`|`pkgs.tmux`|Only for *NixOS*: The `nixpkgs` package used for the *tmux* executable.| |`tmux.exe`|`tmux`|Only for YAML file: The path to the *tmux* executable|-|`x11.display`|`:0`|Only for YAML file: The path to the *tmux* executable|+|`x11.enable`|`true`|Whether to synchronize the X11 clipboard.|+|`x11.display`|`:0`|The display identifier used when connecting to the default display via GTK fails.|  # Neovim 

@@ -1,22 +1,22 @@ module Helic.Dev where -import Polysemy.Conc (withAsync_)-import qualified Polysemy.Time as Time-import Polysemy.Time (Seconds (Seconds))+import Conc (withAsync_)+import Log (Severity (Trace)) import System.Environment (setEnv)+import qualified Time+import Time (Seconds (Seconds))  import Helic.App (listenApp)-import Helic.Cli (interpretLog, runIO) import Helic.Data.Config (Config (Config)) import Helic.Data.NetConfig (NetConfig (NetConfig))  conf :: Config conf =-  Config (Just "dev") (Just def) (Just (NetConfig (Just 11111) Nothing Nothing)) Nothing Nothing (Just True)+  Config (Just "dev") (Just def) (Just (NetConfig (Just True) (Just 11111) Nothing Nothing)) Nothing Nothing (Just True)  main :: IO () main =-  runIO (withAsync_ setenv (interpretLog (Just True) (listenApp conf)))+  runAppLevel Trace (withAsync_ setenv (listenApp conf))   where     setenv =       Time.sleep (Seconds 12) *> embed (setEnv "DISPLAY" ":0")

@@ -1,6 +1,6 @@ module Helic.Test.ConfigFileTest where -import Path (Abs, File, Rel, absfile, relfile)+import Path (absfile, relfile) import Polysemy.Log (interpretLogNull) import Polysemy.Test (UnitTest, assertRight, runTestAuto) import qualified Polysemy.Test.Data.Test as Test@@ -18,9 +18,9 @@     tmux =       TmuxConfig (Just True) (Just [absfile|/bin/tmux|])     net =-      NetConfig (Just 10001) (Just 5) (Just ["remote:1000"])+      NetConfig (Just True) (Just 10001) (Just 5) (Just ["remote:1000"])     x =-      X11Config (Just ":1")+      X11Config (Just True) (Just ":1")  test_readConfigFile :: UnitTest test_readConfigFile = do

@@ -1,10 +0,0 @@-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)

@@ -1,18 +1,18 @@ module Helic.Test.GtkMainTest where +import Conc (interpretAtomic, interpretEventsChan) import qualified Data.Set as Set-import Polysemy.Chronos (ChronosTime, interpretTimeChronos)-import Polysemy.Conc (interpretAtomic, interpretEventsChan, interpretRace, interpretScopedResumable)-import Polysemy.Log (interpretLogNull)-import Polysemy.Test (Hedgehog, UnitTest, assertEq, evalEither, runTestAuto)-import qualified Polysemy.Time as Time-import Polysemy.Time (MilliSeconds (MilliSeconds), Seconds (Seconds))+import Polysemy.Chronos (ChronosTime)+import Polysemy.Test (UnitTest, assertEq)+import qualified Time+import Time (MilliSeconds (MilliSeconds), Seconds (Seconds))+import Zeugma (runTest)  import qualified Helic.Data.Event as Event import Helic.Data.Event (Event) import Helic.Data.XClipboardEvent (XClipboardEvent) import qualified Helic.Effect.Agent as Agent-import Helic.Effect.Agent (AgentX, agentIdNet)+import Helic.Effect.Agent (agentIdNet) import qualified Helic.Effect.Gtk as Gtk import Helic.Effect.Gtk (Gtk) import qualified Helic.Effect.GtkClipboard as GtkClipboard@@ -48,23 +48,17 @@  interpretGtk ::   Members [AtomicState Bool, ChronosTime] r =>-  InterpreterFor (Scoped () (Gtk ()) !! Text) r+  InterpreterFor (Scoped_ (Gtk ()) !! Text) r interpretGtk =-  interpretScopedResumable bracketGtk \ () -> \case+  interpretScopedResumable (const bracketGtk) \ () -> \case     Gtk.Main ->       Time.sleep (Seconds 10)     Gtk.Resource ->       unit -gtkMainTest ::-  Members [Hedgehog IO, Resource, Embed IO, Final IO] r =>-  Sem r (Either Text ())-gtkMainTest =-  asyncToIOFinal $-  errorToIOFinal $-  interpretRace $-  interpretTimeChronos $-  interpretLogNull $+test_gtkMain :: UnitTest+test_gtkMain =+  runTest $   interpretInstanceName (Just "test") $   interpretEventsChan @XClipboardEvent $   interpretEventsChan @Event $@@ -76,12 +70,8 @@   gtkMainLoop subscribeEvents $   interpretXClipboardGtk $   interpretAgentX do-    tag @AgentX . Agent.update =<< Event.now agentIdNet "not running"+    Agent.update =<< Event.now agentIdNet "not running"     atomicPut True-    let pub = tag @AgentX . Agent.update <=< Event.now agentIdNet . show+    let pub = Agent.update <=< Event.now agentIdNet . show     sequenceConcurrently @[] (pub <$> [1..5 :: Int])     assertEq ["1", "2", "3", "4", "5"] . Set.fromList =<< atomicGet @[Text]--test_gtkMain :: UnitTest-test_gtkMain =-  runTestAuto (evalEither =<< gtkMainTest)

@@ -1,21 +1,20 @@ module Helic.Test.InsertEventTest where  import qualified Chronos-import Chronos (datetimeToTime) import Data.Sequence ((|>)) import Exon (exon)-import Polysemy.Chronos (interpretTimeChronosConstant)-import Polysemy.Test (UnitTest, assertJust, runTestAuto, (===))-import qualified Polysemy.Time as Time-import Polysemy.Time (Days (Days), Hours (Hours), MilliSeconds (MilliSeconds), convert, mkDatetime)+import Polysemy.Test (UnitTest, assertJust, (===))+import qualified Time+import Time (Days (Days), Hours (Hours), MilliSeconds (MilliSeconds), convert) import Torsor (add)+import Zeugma (runTestFrozen, testTime)  import Helic.Data.Event (Event (Event)) import Helic.Interpreter.History (appendIfValid)  old :: Chronos.Time old =-  datetimeToTime (mkDatetime 2000 1 1 0 0 0)+  add (convert (-(Days 1))) testTime  event1 :: Event event1 =@@ -39,7 +38,7 @@  test_insertEvent :: UnitTest test_insertEvent =-  runTestAuto $ interpretTimeChronosConstant (add (convert (Days 1)) old) do+  runTestFrozen do     now <- Time.now     assertJust [Event "me" "test" now "string"] (appendIfValid now (Event "me" "test" now "string") mempty)     Nothing === appendIfValid now event1 historyLatest

@@ -1,15 +1,14 @@ module Helic.Test.ListTest where  import Exon(exon)-import Polysemy.Chronos (interpretTimeChronosConstant)-import Polysemy.Test (UnitTest, assertRight, runTestAuto)+import Polysemy.Test (UnitTest, assertRight)+import Zeugma (runTestFrozen)  import Helic.Data.AgentId (AgentId (AgentId)) import qualified Helic.Data.Event as Event import Helic.Data.ListConfig (ListConfig (ListConfig)) import Helic.Interpreter.Client (interpretClientConst) import Helic.List (buildList)-import Helic.Test.Fixtures (testTime)  eventContents :: [Text] eventContents =@@ -38,8 +37,7 @@  test_list :: UnitTest test_list =-  runTestAuto $-  interpretTimeChronosConstant testTime $+  runTestFrozen $   runReader "test" $   runReader (ListConfig (Just 3)) do     events <- traverse (Event.now (AgentId "nvim")) eventContents

@@ -1,19 +1,11 @@ module Helic.Test.ListenTest where +import qualified Conc+import Conc (interpretAtomic, interpretEventsChan, interpretQueueTBM, interpretSync, resultToMaybe) import qualified Data.Set as Set-import Polysemy.Chronos (interpretTimeChronosConstant)-import qualified Polysemy.Conc as Conc-import Polysemy.Conc (-  interpretAtomic,-  interpretEventsChan,-  interpretQueueTBM,-  interpretRace,-  interpretSync,-  resultToMaybe,-  )-import qualified Polysemy.Conc.Queue as Queue-import Polysemy.Log (interpretLogNull)-import Polysemy.Test (UnitTest, assertEq, assertJust, runTestAuto)+import Polysemy.Test (UnitTest, assertEq, assertJust)+import qualified Queue+import Zeugma (runTestFrozen, testTime)  import Helic.Data.AgentId (AgentId (AgentId)) import qualified Helic.Data.Event as Event@@ -22,10 +14,9 @@ import Helic.Interpreter.Agent (interpretAgent) import Helic.Interpreter.History (interpretHistory) import Helic.Listen (withListen)-import Helic.Test.Fixtures (testTime)  handleNet ::-  Member (Events res Event) r =>+  Member (Events Event) r =>   Event ->   Sem r () handleNet (Event {..}) =@@ -40,11 +31,7 @@  test_listen :: UnitTest test_listen =-  runTestAuto $-  asyncToIOFinal $-  interpretRace $-  interpretLogNull $-  interpretTimeChronosConstant testTime $+  runTestFrozen $   interpretEventsChan $   interpretAtomic def $   interpretQueueTBM 64 $

@@ -1,9 +1,9 @@ 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 Conc (interpretAtomic)+import Polysemy.Chronos (ChronosTime)+import Polysemy.Test (UnitTest, assertEq, assertJust)+import Zeugma (runTestFrozen)  import Helic.Data.AgentId (AgentId (AgentId)) import qualified Helic.Data.Event as Event@@ -13,7 +13,6 @@ 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 =>@@ -24,9 +23,7 @@  test_load :: UnitTest test_load =-  runTestAuto $-  interpretTimeChronosConstant testTime $-  interpretLogNull $+  runTestFrozen $   runReader "test" $   interpretAtomic def $   interpretAgent @AgentNet (const unit) $@@ -37,4 +34,4 @@     ev5 <- event 6     assertJust ev5 =<< History.load 4     assertEq Nothing =<< History.load 11-    assertEq (show <$> ([1..5] ++ [7..10] ++ [6 :: Int])) . fmap Event.content =<< History.get+    assertEq (show <$> ([1..5] ++ [7..10] ++ [6 :: Int])) . fmap (.content) =<< History.get