helic 0.3.2.0 → 0.4.0.0

raw patch · 56 files changed

+763/−604 lines, 56 filesdep +incipitdep +transformersdep −aesondep −data-defaultdep −eitherdep ~exondep ~polysemy-chronosdep ~polysemy-concsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: incipit, transformers

Dependencies removed: aeson, data-default, either, polysemy-resume, relude, text

Dependency ranges changed: exon, polysemy-chronos, polysemy-conc, polysemy-http, polysemy-log, polysemy-process, polysemy-time

API changes (from Hackage documentation)

Files

• Setup.hs +2/−0
• changelog.md +8/−0
• helic.cabal +27/−31
• lib/Helic.hs +25/−10
• lib/Helic/App.hs +17/−15
• lib/Helic/Cli.hs +2/−4
• lib/Helic/Cli/Options.hs +2/−0
• lib/Helic/Config/File.hs +2/−2
• lib/Helic/Data/AgentId.hs +4/−1
• lib/Helic/Data/Config.hs +4/−1
• lib/Helic/Data/Event.hs +3/−2
• lib/Helic/Data/GtkState.hs +1/−0
• lib/Helic/Data/Host.hs +4/−1
• lib/Helic/Data/InstanceName.hs +4/−1
• lib/Helic/Data/NetConfig.hs +5/−2
• lib/Helic/Data/Selection.hs +8/−3
• lib/Helic/Data/TmuxConfig.hs +3/−1
• lib/Helic/Effect/Agent.hs +2/−4
• lib/Helic/Effect/Client.hs +0/−2
• lib/Helic/Effect/Gtk.hs +13/−0
• lib/Helic/Effect/GtkClipboard.hs +18/−0
• lib/Helic/Effect/GtkMain.hs +23/−0
• lib/Helic/Effect/History.hs +0/−1
• lib/Helic/Gtk.hs +98/−89
• lib/Helic/GtkClipboard.hs +24/−0
• lib/Helic/GtkMain.hs +57/−0
• lib/Helic/Interpreter.hs +16/−0
• lib/Helic/Interpreter/Agent.hs +1/−2
• lib/Helic/Interpreter/AgentNet.hs +2/−4
• lib/Helic/Interpreter/AgentTmux.hs +9/−6
• lib/Helic/Interpreter/AgentX.hs +13/−9
• lib/Helic/Interpreter/Client.hs +1/−2
• lib/Helic/Interpreter/Gtk.hs +45/−0
• lib/Helic/Interpreter/GtkClipboard.hs +44/−0
• lib/Helic/Interpreter/GtkMain.hs +87/−0
• lib/Helic/Interpreter/History.hs +13/−6
• lib/Helic/Interpreter/InstanceName.hs +1/−0
• lib/Helic/Interpreter/XClipboard.hs +19/−77
• lib/Helic/List.hs +2/−1
• lib/Helic/Listen.hs +2/−1
• lib/Helic/Net/Api.hs +1/−3
• lib/Helic/Net/Client.hs +2/−2
• lib/Helic/Net/Server.hs +4/−3
• lib/Helic/Prelude.hs +0/−189
• lib/Helic/Prelude/Debug.hs +0/−103
• lib/Helic/Stop.hs +11/−0
• lib/Helic/Tmux.hs +4/−9
• lib/Helic/Yank.hs +2/−1
• lib/Prelude.hs +0/−9
• test/Helic/Dev.hs +22/−0
• test/Helic/Test/ConfigFileTest.hs +2/−0
• test/Helic/Test/GtkMainTest.hs +87/−0
• test/Helic/Test/InsertEventTest.hs +13/−3
• test/Helic/Test/ListTest.hs +1/−1
• test/Helic/Test/ListenTest.hs +0/−2
• test/Main.hs +3/−1

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -1,5 +1,13 @@ # Unreleased +# 0.4.0.0++* Rewrite the GTK main loop effects for better resilience when no display is available (yet).++# 0.3.1.0++* Sanitize newlines when inserting events+ # 0.3.0.0  * Add the `load` command that sets the clipboard to an event from the history.

@@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.34.6. -- -- see: https://github.com/sol/hpack  name:           helic-version:        0.3.2.0+version:        0.4.0.0 synopsis:       Clipboard Manager description:    See <https://hackage.haskell.org/package/helic/docs/Helic.html> category:       Clipboard@@ -47,14 +47,23 @@       Helic.Data.YankConfig       Helic.Effect.Agent       Helic.Effect.Client+      Helic.Effect.Gtk+      Helic.Effect.GtkClipboard+      Helic.Effect.GtkMain       Helic.Effect.History       Helic.Effect.XClipboard       Helic.Gtk+      Helic.GtkClipboard+      Helic.GtkMain+      Helic.Interpreter       Helic.Interpreter.Agent       Helic.Interpreter.AgentNet       Helic.Interpreter.AgentTmux       Helic.Interpreter.AgentX       Helic.Interpreter.Client+      Helic.Interpreter.Gtk+      Helic.Interpreter.GtkClipboard+      Helic.Interpreter.GtkMain       Helic.Interpreter.History       Helic.Interpreter.InstanceName       Helic.Interpreter.XClipboard@@ -63,15 +72,9 @@       Helic.Net.Api       Helic.Net.Client       Helic.Net.Server-      Helic.Prelude-      Helic.Prelude.Debug+      Helic.Stop       Helic.Tmux       Helic.Yank-  other-modules:-      Prelude-      Paths_helic-  autogen-modules:-      Paths_helic   hs-source-dirs:       lib   default-extensions:@@ -134,32 +137,27 @@       ViewPatterns   ghc-options: -Wall -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin   build-depends:-      aeson >=1.4-    , base ==4.*+      base ==4.*     , chronos >=1.1.1-    , containers-    , data-default >=0.2-    , either >=5-    , exon >=0.2.0.1+    , exon >=0.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.2.0.1-    , polysemy-conc >=0.5-    , polysemy-http >=0.5-    , polysemy-log >=0.4+    , polysemy-chronos >=0.3+    , polysemy-conc >=0.6+    , polysemy-http >=0.6+    , polysemy-log >=0.5     , polysemy-plugin >=0.4-    , polysemy-process >=0.5-    , polysemy-resume >=0.2-    , polysemy-time >=0.1.4-    , relude >=0.7+    , polysemy-process >=0.6+    , polysemy-time >=0.3     , servant >=0.18     , servant-client >=0.18     , servant-client-core >=0.18@@ -167,7 +165,7 @@     , table-layout >=0.9     , template-haskell     , terminal-size >=0.3.2.1-    , text+    , transformers     , typed-process >=0.2.6     , unix     , wai-extra >=3.1@@ -179,8 +177,6 @@  executable hel   main-is: Main.hs-  other-modules:-      Paths_helic   hs-source-dirs:       app   default-extensions:@@ -245,25 +241,25 @@   build-depends:       base ==4.*     , helic+    , incipit     , polysemy     , polysemy-plugin   mixins:       base hiding (Prelude)-    , helic hiding (Helic.Prelude)-    , helic (Helic.Prelude as Prelude)   default-language: Haskell2010  test-suite helic-unit   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       Helic.Test.ListTest       Helic.Test.LoadTest-      Paths_helic   hs-source-dirs:       test   default-extensions:@@ -329,7 +325,9 @@       base ==4.*     , chronos     , containers+    , exon     , helic+    , incipit     , path     , polysemy     , polysemy-chronos@@ -342,6 +340,4 @@     , torsor   mixins:       base hiding (Prelude)-    , helic hiding (Helic.Prelude)-    , helic (Helic.Prelude as Prelude)   default-language: Haskell2010

@@ -9,22 +9,32 @@   Agents,   -- ** XClipboard   XClipboard,+  -- ** Gtk+  Gtk,+  -- ** GtkMain+  GtkMain,+  -- ** GtkClipboard+  GtkClipboard,    -- * Interpreters   interpretAgentNet,   interpretAgentX,   interpretAgentTmux,   interpretXClipboardGtk,+  interpretGtk,+  interpretGtkMain,+  handleGtkMain,+  interpretGtkClipboard,+  handleGtkClipboard,    -- * Data   Event,+  Selection (..),    -- * Utilities   transformXEvents,-  withMainLoop,   subscribeToClipboard,-  clipboardEvents,-  listenXClipboard,+  gtkMainLoop,   Api,   serve,   listen,@@ -32,19 +42,24 @@  ) where +import Prelude hiding (listen)+ import Helic.Data.Event (Event)+import Helic.Data.Selection (Selection (..)) import Helic.Effect.Agent (Agent, AgentTag, Agents)+import Helic.Effect.Gtk (Gtk)+import Helic.Effect.GtkClipboard (GtkClipboard)+import Helic.Effect.GtkMain (GtkMain) import Helic.Effect.XClipboard (XClipboard)+import Helic.Gtk (subscribeToClipboard)+import Helic.GtkMain (gtkMainLoop) import Helic.Interpreter.AgentNet (interpretAgentNet) import Helic.Interpreter.AgentTmux (interpretAgentTmux) import Helic.Interpreter.AgentX (interpretAgentX, transformXEvents)-import Helic.Interpreter.XClipboard (-  clipboardEvents,-  interpretXClipboardGtk,-  listenXClipboard,-  subscribeToClipboard,-  withMainLoop,-  )+import Helic.Interpreter.Gtk (interpretGtk)+import Helic.Interpreter.GtkClipboard (handleGtkClipboard, interpretGtkClipboard)+import Helic.Interpreter.GtkMain (handleGtkMain, interpretGtkMain)+import Helic.Interpreter.XClipboard (interpretXClipboardGtk) import Helic.Listen (listen) import Helic.Net.Api (Api, serve) import Helic.Yank (yank)

@@ -1,22 +1,16 @@+{-# options_haddock prune #-}++-- |App entry points.+-- Internal. module Helic.App where +import Conc (Critical, interpretAtomic, interpretEventsChan, interpretSync, withAsync_) import Polysemy.Chronos (ChronosTime) import qualified Polysemy.Conc as Conc-import Polysemy.Conc (-  Critical,-  Interrupt,-  interpretAtomic,-  interpretEventsChan,-  interpretSync,-  withAsync_,-  ) import Polysemy.Http (Manager) import Polysemy.Http.Interpreter.Manager (interpretManager)-import Polysemy.Log (-  Log,-  Logger,-  )-import Polysemy.Time (GhcTime)+import Polysemy.Log (Logger)+import Polysemy.Time (GhcTime, MilliSeconds (MilliSeconds), Seconds (Seconds))  import Helic.Data.Config (Config (Config)) import Helic.Data.Event (Event)@@ -28,13 +22,18 @@ 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.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, listenXClipboard)+import Helic.Interpreter.XClipboard (interpretXClipboardGtk) import Helic.List (list) import Helic.Net.Api (serve) import Helic.Yank (yank)@@ -68,7 +67,10 @@   interpretAtomic mempty $   interpretInstanceName name $   interpretManager $-  listenXClipboard $+  interpretGtk $+  interpretGtkMain (MilliSeconds 500) (Seconds 10) $+  interpretGtkClipboard $+  gtkMainLoop subscribeEvents $   interpretXClipboardGtk $   interpretAgentX $   interpretAgentNet $

@@ -11,9 +11,7 @@   interpretInterrupt,   interpretRace,   )-import Polysemy.Error (errorToIOFinal) import Polysemy.Log (-  Log,   LogEntry,   LogMessage,   Logger,@@ -26,7 +24,7 @@   ) import qualified Polysemy.Log.Data.DataLog as DataLog import Polysemy.Time (GhcTime, MilliSeconds (MilliSeconds), interpretTimeGhc)-import System.IO (hLookAhead)+import System.IO (hLookAhead, stdin)  import Helic.App (AppStack, IOStack, listApp, listenApp, loadApp, yankApp) import Helic.Cli.Options (Command (List, Listen, Load, Yank), Conf (Conf), parser)@@ -40,7 +38,7 @@   Sem (Error Text : r) () ->   Sem r () logError =-  traverseLeft DataLog.error <=< errorToIOFinal+  either DataLog.error pure <=< errorToIOFinal  interpretLog ::   Maybe Bool ->

@@ -3,6 +3,7 @@ -- |CLI Options, Internal module Helic.Cli.Options where +import Exon (exon) import Options.Applicative (   CommandFields,   Mod,@@ -23,6 +24,7 @@   ) import Options.Applicative.Types (readerAsk) import Path (Abs, File, Path, parseAbsFile)+import Prelude hiding (Mod)  import Helic.Data.ListConfig (ListConfig (ListConfig)) import Helic.Data.LoadConfig (LoadConfig (LoadConfig))

@@ -4,10 +4,10 @@ module Helic.Config.File where  import Data.Yaml (decodeFileEither, prettyPrintParseException)+import Exon (exon) import Path (Abs, File, Path, Rel, absfile, relfile, toFilePath, (</>)) import Path.IO (XdgDirectory (XdgConfig), doesFileExist, getXdgDir) import qualified Polysemy.Log as Log-import Polysemy.Log (Log)  import Helic.Data.Config (Config) @@ -17,7 +17,7 @@   Sem r Config parseFileConfig (toFilePath -> path) = do   Log.debug [exon|Reading config file #{toText path}|]-  fromEither =<< mapLeft formatError <$> embed (decodeFileEither path)+  fromEither =<< first formatError <$> embed (decodeFileEither path)   where     formatError exc =       toText [exon|invalid config file: #{prettyPrintParseException exc}|]

@@ -1,10 +1,13 @@ {-# options_haddock prune #-}+ -- |AgentId Data Type, Internal module Helic.Data.AgentId where +import Polysemy.Time.Json (json)+ newtype AgentId =   AgentId { unAgentId :: Text }   deriving stock (Eq, Show)   deriving newtype (IsString) -defaultJson ''AgentId+json ''AgentId

@@ -1,7 +1,10 @@ {-# options_haddock prune #-}+ -- |Config Data Type, Internal module Helic.Data.Config where +import Polysemy.Time.Json (json)+ import Helic.Data.NetConfig (NetConfig) import Helic.Data.TmuxConfig (TmuxConfig) @@ -16,4 +19,4 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (Default) -defaultJson ''Config+json ''Config

@@ -1,9 +1,10 @@--- |Event Data Type+-- |The data type 'Event' consists of a yank text and metadata identifying its source and time. module Helic.Data.Event where  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)@@ -22,7 +23,7 @@   }   deriving stock (Eq, Show) -defaultJson ''Event+json ''Event  -- |Construct an event for the current host and time. now ::

@@ -1,4 +1,5 @@ {-# options_haddock prune #-}+ -- |GtkState Data Type, Internal module Helic.Data.GtkState where 

@@ -1,10 +1,13 @@ {-# options_haddock prune #-}+ -- |Host Data Type, Internal module Helic.Data.Host where +import Polysemy.Time.Json (json)+ newtype Host =   Host { unHost :: Text }   deriving stock (Eq, Show)   deriving newtype (IsString) -defaultJson ''Host+json ''Host

@@ -1,10 +1,13 @@ {-# options_haddock prune #-}+ -- |InstanceName Data Type, Internal module Helic.Data.InstanceName where +import Polysemy.Time.Json (json)+ newtype InstanceName =   InstanceName { unInstanceName :: Text }   deriving stock (Eq, Show, Generic)   deriving newtype (IsString) -defaultJson ''InstanceName+json ''InstanceName

@@ -1,7 +1,10 @@ {-# options_haddock prune #-}+ -- |NetConfig Data Type, Internal module Helic.Data.NetConfig where +import Polysemy.Time.Json (json)+ import Helic.Data.Host (Host)  newtype Timeout =@@ -9,7 +12,7 @@   deriving stock (Eq, Show, Generic)   deriving newtype (Num, Real, Enum, Integral, Ord) -defaultJson ''Timeout+json ''Timeout  data NetConfig =   NetConfig {@@ -20,4 +23,4 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (Default) -defaultJson ''NetConfig+json ''NetConfig

@@ -1,15 +1,20 @@-{-# options_haddock prune #-}--- |Selection Data Type, Internal+-- |The data type 'Selection' enumerates the different types of basic clipboards that X11 operates on.+-- Internal. module Helic.Data.Selection where +-- |This type enumerates the different types of basic clipboards that X11 operates on. data Selection =+  -- |Usually the target of explicit copy commands (ctrl-c).   Clipboard   |+  -- |Stores the cursor selection.   Primary   |+  -- |Only used in exotic situations.   Secondary-  deriving stock (Eq, Show)+  deriving stock (Eq, Show, Ord, Enum, Bounded) +-- |Convert a 'Selection' into the string that X11 uses to identify it. toXString :: Selection -> Text toXString = \case   Clipboard -> "CLIPBOARD"

@@ -1,8 +1,10 @@ {-# options_haddock prune #-}+ -- |TmuxConfig Data Type, Internal module Helic.Data.TmuxConfig where  import Path (Abs, File, Path)+import Polysemy.Time.Json (json)  data TmuxConfig =   TmuxConfig {@@ -12,4 +14,4 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (Default) -defaultJson ''TmuxConfig+json ''TmuxConfig

@@ -1,9 +1,7 @@ {-# options_haddock prune #-}--- |The Agent Effect-module Helic.Effect.Agent where -import GHC.TypeLits (KnownSymbol, symbolVal)-import Polysemy.Tagged (Tagged)+-- |The 'Agent' effect abstracts a clipboard synchronization target.+module Helic.Effect.Agent where  import Helic.Data.AgentId (AgentId (AgentId)) import Helic.Data.Event (Event)

@@ -1,8 +1,6 @@ -- |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.

@@ -0,0 +1,13 @@+{-# options_haddock prune #-}++-- |The effect 'Gtk' is a utility for running the GTK main loop in a resource-safe manner.+module Helic.Effect.Gtk where++-- |This effect is a utility for running the GTK main loop in a resource-safe manner.+data Gtk s :: Effect where+  -- |Run the Gtk main loop, blocking.+  Main :: Gtk s m ()+  -- |Return the default resource, usually a 'GI.Gdk.Display'.+  Resource :: Gtk s m s++makeSem ''Gtk

@@ -0,0 +1,18 @@+{-# options_haddock prune #-}++-- |The effect 'GtkClipboard' allows an app to read from, write to, and subscribe to events from a clipboard.+module Helic.Effect.GtkClipboard where++import Helic.Data.Selection (Selection)++-- |This effect 'GtkClipboard' allows an app to read from, write to, and subscribe to events from a clipboard.+-- It is intended to be scoped with a GTK display by 'Helic.interpretWithGtk'.+data GtkClipboard :: Effect where+  -- |Fetch the text content of the X11 clipboard identified by the argument.+  Read :: Selection -> GtkClipboard m (Maybe Text)+  -- |Set the text content of the X11 clipboard identified by the first argument.+  Write :: Selection -> Text -> GtkClipboard m ()+  -- |Listen to clipboard events and invoke the callback.+  Events :: (Selection -> Text -> m ()) -> GtkClipboard m ()++makeSem ''GtkClipboard

@@ -0,0 +1,23 @@+{-# options_haddock prune #-}++-- |An effect for concurrently controlling the lifecycle of a GTK main loop and accessing its resource.+module Helic.Effect.GtkMain where++-- |This effect is a communication bridge between 'Helic.Gtk' and GTK functionality effects like 'Helic.GtkClipboard'.+-- It does not directly interact with the GTK API, but allows a scope to ensure that the GTK main loop is running and to+-- access its resource (usually a display handle).+data GtkMain (s :: Type) :: Effect where+  -- |If a resource is currently available, return it.+  -- Otherwise, execute the supplied action.+  -- Should be used to bracket 'Request'.+  Access :: m s -> GtkMain s m s+  -- |Trigger the execution of the GTK main loop, then wait for its resource to be available.+  -- If it does not, execute the supplied action.+  Request :: m s -> GtkMain s m s+  -- |Bracket an action that runs the GTK main loop by clearing the resource, running the supplied action, then clearing+  -- the resource again and waiting for the next request.+  Run :: m a -> GtkMain s m a+  -- |Store the main loop resource in the state to mark the loop as running.+  Running :: s -> GtkMain s m ()++makeSem ''GtkMain

@@ -1,7 +1,6 @@ -- |History Effect, Internal module Helic.Effect.History where -import Polysemy (makeSem_) import Helic.Data.Event (Event)  -- |The core actions of the 'Event' history.

@@ -1,44 +1,45 @@-{-# options_haddock prune #-}---- |GTK Helpers, Internal+-- |General GTK API adapter functions.+-- Internal. module Helic.Gtk where  import qualified Control.Exception as Base+import Exon (exon) import qualified GI.GLib as Glib+import qualified GI.Gdk as GiGdk import qualified GI.Gdk as Gdk import GI.Gdk (Display)+import qualified GI.Gtk as GiGtk import qualified GI.Gtk as GI-import Polysemy.Final (embedFinal, withWeavingToFinal)-import Polysemy.Log (Log)+import Polysemy.Final (withWeavingToFinal)+import qualified Polysemy.Log as Log -import qualified Helic.Data.GtkState as GtkState-import Helic.Data.GtkState (GtkState) import qualified Helic.Data.Selection as Selection-import Helic.Data.Selection (Selection (Clipboard, Primary, Secondary))+import Helic.Data.Selection (Selection)+import Helic.Stop (tryStop) +-- |Safe wrapper around calls to ght GTK API.+-- This schedules an 'IO' action for execution on the GTK main loop thread, which is crucial for some actions to avoid+-- horrible crashes.+-- Since this results in asynchronous execution, an 'MVar' is used to extract the result.+-- Catches all exception and converts them to 'Stop'. gtkUi ::-  Member (Embed IO) r =>+  Members [Stop Text, Embed IO] r =>+  Text ->   IO a ->   Sem r a-gtkUi ma = do-  result <- newEmptyMVar-  _ <- Gdk.threadsAddIdle Glib.PRIORITY_DEFAULT do-    a <- ma-    False <$ putMVar result a-  takeMVar result--gtkUiSem ::-  Member (Final IO) r =>-  Sem r a ->-  Sem r a-gtkUiSem ma = do-  withWeavingToFinal \ s wv _ -> do-    result <- newEmptyMVar-    void $ Gdk.threadsAddIdle Glib.PRIORITY_DEFAULT do-      wv ((embedFinal . putMVar result =<< ma) <$ s)-      pure False-    (<$ s) <$> takeMVar result+gtkUi desc ma = do+  result <- embed newEmptyMVar+  let+    recovering :: IO x -> IO x+    recovering =+      flip Base.onException (putMVar result Nothing)+  _ <- tryStop $ recovering $ Gdk.threadsAddIdle Glib.PRIORITY_DEFAULT do+    putMVar result . Just =<< recovering ma+    pure False+  stopNote [exon|Gtk ui thread computation '#{desc}' failed|] =<< embed (takeMVar result) +-- |Accesses a clipboard by creating the appropriate X11 atom structure.+-- Does not catch exceptions. unsafeGtkClipboard ::   MonadIO m =>   Display ->@@ -48,24 +49,17 @@   selection <- Gdk.atomIntern (Selection.toXString name) False   GI.clipboardGetForDisplay display selection +-- |Return a GTK clipboard, converting all exceptions to 'Stop'. gtkClipboard ::-  Member (Embed IO) r =>+  Members [Stop Text, Embed IO] r =>   Display ->   Selection ->-  Sem r (Either Text GI.Clipboard)+  Sem r GI.Clipboard gtkClipboard display name =-  tryAny (unsafeGtkClipboard display name)--unsafeSubscribe ::-  MonadIO m =>-  GI.Clipboard ->-  (Either Text Text -> IO ()) ->-  m ()-unsafeSubscribe clipboard handle =-  void $ GI.onClipboardOwnerChange clipboard \ _ -> do-    Base.catch @SomeException (GI.clipboardRequestText clipboard (const (traverse_ (handle . Right)))) \ e ->-      handle (Left (show e))+  tryStop (unsafeGtkClipboard display name) +-- |Request the text contents of a GTK clipboard, catching all exceptions, and passing the result to a handler.+-- If the clipboard is empty or an exception was thrown, the value passed to the handler is 'Left', otherwise 'Right'. clipboardRequest ::   GI.Clipboard ->   (Either Text Text -> IO ()) ->@@ -77,48 +71,32 @@     run =       GI.clipboardRequestText clipboard (const (handle . maybeToRight "no clipboard text")) -subscribe ::+-- |Registers a callback for the "owner change" event of a GTK clipboard, which is triggered whenever a client updates+-- the text.+-- The callback then fetches the current text and passes it to the supplied handler as 'Right', or a 'Left' if an+-- exception was thrown.+subscribeWith ::   Member (Final IO) r =>   GI.Clipboard ->   (Either Text Text -> Sem r ()) ->   Sem r ()-subscribe clipboard handle =+subscribeWith clipboard handle =   withWeavingToFinal \ s wv _ -> do     let lower ma = void (wv (ma <$ s))     s <$ GI.onClipboardOwnerChange clipboard \ _ ->       clipboardRequest clipboard (lower . handle) -clipboardFor ::-  Member (Reader GtkState) r =>-  Selection ->-  Sem r GI.Clipboard-clipboardFor = \case-  Clipboard -> asks GtkState.clipboard-  Primary -> asks GtkState.primary-  Secondary -> asks GtkState.secondary--unsafeGetClipboard ::-  MonadIO m =>-  GI.Clipboard ->-  m (Maybe Text)-unsafeGetClipboard clipboard =-  GI.clipboardWaitForText clipboard--getClipboard ::-  Members [Log, Embed IO] r =>+-- |Safely request the text contents of a clipboard by scheduling an action on the UI thread and converting exceptions+-- into 'Stop'.+readClipboard ::+  Members [Log, Stop Text, Embed IO] r =>   GI.Clipboard ->   Sem r (Maybe Text)-getClipboard clipboard =-  gtkUi (unsafeGetClipboard clipboard)--getClipboardFor ::-  Members [Reader GtkState, Log, Embed IO] r =>-  Selection ->-  Sem r (Maybe Text)-getClipboardFor sel = do-  cb <- clipboardFor sel-  getClipboard cb+readClipboard =+  gtkUi "readClipboard" . GI.clipboardWaitForText +-- |Update the text contents of a clipboard.+-- Does not catch exceptions. unsafeSetClipboard ::   MonadIO m =>   GI.Clipboard ->@@ -127,31 +105,62 @@ unsafeSetClipboard clipboard text =   GI.clipboardSetText clipboard text (-1) -setClipboard ::-  Member (Embed IO) r =>+-- |Safely update the text contents of a clipboard by scheduling an action on the UI thread and converting exceptions+-- into 'Stop'.+writeClipboard ::+  Members [Stop Text, Embed IO] r =>   GI.Clipboard ->   Text ->   Sem r ()-setClipboard clipboard text =-  gtkUi (unsafeSetClipboard clipboard text)+writeClipboard clipboard =+  gtkUi "writeClipboard" . unsafeSetClipboard clipboard -setClipboardFor ::-  Members [Reader GtkState, Log, Embed IO, Final IO] r =>+-- |Obtain the default GTK display, converting exceptions into 'Stop'.+getDisplay ::+  Members [Stop Text, Embed IO] r =>+  Sem r Display+getDisplay =+  stopNote "couldn't get a GTK display" =<< tryStop GiGdk.displayGetDefault++-- |Obtain a GTK clipboard handle for a specific 'Selection'+getClipboard ::+  Members [Reader Display, Stop Text, Embed IO] r =>   Selection ->-  Text ->+  Sem r GiGtk.Clipboard+getClipboard selection = do+  display <- ask+  gtkClipboard display selection++-- |Listen to clipboard events for a specific source, like "primary selection", and pass them to the callback.+subscribeToClipboard ::+  Members [Reader Display, Log, Stop Text, Embed IO, Final IO] r =>+  (Selection -> Text -> Sem r ()) ->+  Selection ->   Sem r ()-setClipboardFor sel text = do-  cb <- clipboardFor sel-  setClipboard cb text+subscribeToClipboard f selection = do+  cb <- getClipboard selection+  subscribeWith cb \case+    Right t ->+      f selection t+    Left e ->+      Log.warn [exon|GTK: #{e}|] -syncXClipboard ::-  Members [Reader GtkState, Log, Embed IO, Final IO] r =>-  Text ->+-- |Fetch the text contents of the GTK clipboard corresponding to the specified X11 selection, converting exceptions+-- into 'Stop'.+clipboardText ::+  Members [Reader Display, Log, Stop Text, Embed IO] r =>   Selection ->+  Sem r (Maybe Text)+clipboardText =+  readClipboard <=< getClipboard++-- |Update the text contents of the GTK clipboard corresponding to the specified X11 selection, converting exceptions+-- into 'Stop'.+setClipboardText ::+  Members [Reader Display, Log, Stop Text, Embed IO, Final IO] r =>+  Selection ->+  Text ->   Sem r ()-syncXClipboard text = \case-  Clipboard ->-    unit-  _ -> do-    cb <- asks GtkState.clipboard-    setClipboard cb text+setClipboardText sel text = do+  cb <- getClipboard sel+  writeClipboard cb text

@@ -0,0 +1,24 @@+-- |Utilities for 'GtkClipboard'.+-- Internal.+module Helic.GtkClipboard where++import Exon (exon)+import qualified Polysemy.Log as Log++import Helic.Data.XClipboardEvent (XClipboardEvent (XClipboardEvent))+import qualified Helic.Effect.GtkClipboard as GtkClipboard+import Helic.Effect.GtkClipboard (GtkClipboard)+import Helic.Interpreter.GtkClipboard (withGtkClipboard)++-- |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 =>+  Sem r ()+subscribeEvents =+  resuming failure $ withGtkClipboard do+    GtkClipboard.events \ selection t ->+      publish (XClipboardEvent t selection)+  where+    failure e =+      Log.error [exon|Subscribing to Gtk events failed: #{e}|]

@@ -0,0 +1,57 @@+-- |API for the GTK main loop.+-- Internal.+module Helic.GtkMain where++import Exon (exon)+import Polysemy.Conc (withAsync_)+import qualified Polysemy.Log as Log++import qualified Helic.Effect.Gtk as Gtk+import Helic.Effect.Gtk (Gtk)+import qualified Helic.Effect.GtkMain as GtkMain+import Helic.Effect.GtkMain (GtkMain)++-- |Run the GTK main loop.+-- 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 =>+  Sem r () ->+  Sem r ()+gtkMain onInit =+  scoped do+    GtkMain.running =<< Gtk.resource+    raise onInit+    Gtk.main++-- |Run the GTK main loop in an infinite loop, recovering from errors by logging them.+-- 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 =>+  Sem r () ->+  Sem r ()+loopGtkMain onInit =+  forever do+    GtkMain.run do+      gtkMain (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+-- the GTK main loop to be started.+gtkResource ::+  Members [GtkMain s, Log, Stop Text] r =>+  Sem r s+gtkResource =+  GtkMain.access do+    Log.info "Gtk main loop inactive, requesting restart"+    GtkMain.request (stop "Gtk main loop didn't start") <* Log.info "Gtk main loop started"++-- |Run 'loopGtkMain' in a thread.+gtkMainLoop ::+  Members [Scoped resource (Gtk s) !! Text, GtkMain s, Log, Race, Resource, Async] r =>+  Sem r () ->+  Sem r a ->+  Sem r a+gtkMainLoop onInit =+  withAsync_ (loopGtkMain onInit)

@@ -0,0 +1,16 @@+-- |Interpretation combinators.+-- Internal.+module Helic.Interpreter where++import Polysemy.Internal.CustomErrors (FirstOrder)++-- |Flipped version of 'interpret'.+interpreting ::+  ∀ e r a .+  FirstOrder e "interpret" =>+  Sem (e : r) a ->+  (∀ r0 x . e (Sem r0) x -> Sem r x) ->+  Sem r a+interpreting s h =+  interpret h s+{-# inline interpreting #-}

@@ -1,10 +1,9 @@ -- |Simple Agent Interpreter, Internal module Helic.Interpreter.Agent where -import Polysemy.Tagged (Tagged, untag)- import Helic.Data.Event (Event) import Helic.Effect.Agent (Agent (Update))+import Helic.Interpreter (interpreting)  -- |Interpret 'Agent' with an action. interpretAgent ::

@@ -1,15 +1,13 @@ -- |Agent Interpreter for Network, Internal module Helic.Interpreter.AgentNet where -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.NetConfig (NetConfig (NetConfig)) import Helic.Effect.Agent (Agent (Update), AgentNet, agentIdNet)+import Helic.Interpreter (interpreting) import Helic.Net.Client (sendTo)  -- |Interpret 'Agent' using remote hosts as targets.@@ -24,4 +22,4 @@     Update e -> do       NetConfig _ timeout hosts <- ask       for_ (fold hosts) \ host ->-        traverseLeft Log.debug =<< runError (sendTo timeout host e { source = agentIdNet })+        either Log.debug pure =<< runError (sendTo timeout host e { source = agentIdNet })

@@ -1,17 +1,19 @@ -- |Agent Interpreter for Tmux, Internal module Helic.Interpreter.AgentTmux where +import Exon (exon)+import qualified Log import Path (Abs, File, Path, toFilePath)-import Polysemy.Log (Log)-import Polysemy.Process.Interpreter.ProcessIOE (interpretProcessIOE)-import Polysemy.Tagged (Tagged, untag) import qualified System.Process.Typed as Process import System.Process.Typed (ProcessConfig)  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.Tmux (sendToTmux)+import Polysemy.Process (interpretProcessByteStringNative)+import Polysemy.Process.Data.ProcessError (ProcessError)  -- |Process definition for running `tmux load-buffer -`. tmuxProc ::@@ -36,8 +38,9 @@   InterpreterFor (Tagged AgentTmux Agent) r interpretAgentTmux sem = do   exe <- asks TmuxConfig.exe-  interpretProcessIOE True 64 (tmuxProc exe) $+  interpretProcessByteStringNative True 64 (tmuxProc exe) $     interpreting (raiseUnder (untag sem)) \case-      Update e ->+      Update event ->         whenM enableTmux do-          sendToTmux e+          sendToTmux event !! \ (e :: ProcessError) ->+            Log.error [exon|Sending to tmux: #{show e}|]

@@ -1,10 +1,11 @@ -- |Agent Interpreter for X11, Internal module Helic.Interpreter.AgentX where +import qualified Conc+import Conc (withAsync_)+import Exon (exon) import Polysemy.Chronos (ChronosTime)-import qualified Polysemy.Conc as Conc-import Polysemy.Conc (EventConsumer, Events, withAsync_)-import Polysemy.Tagged (Tagged, untag)+import qualified Polysemy.Log as Log  import qualified Helic.Data.Event as Event import Helic.Data.Event (Event (Event))@@ -13,18 +14,20 @@ import Helic.Effect.Agent (Agent (Update), AgentX, agentIdX) import qualified Helic.Effect.XClipboard as XClipboard import Helic.Effect.XClipboard (XClipboard)+import Helic.Interpreter (interpreting)  -- |Listen for 'XClipboardEvent's and publish them as 'Event's. transformXEvents ::-  Member (Reader InstanceName) r =>-  Members [EventConsumer xr XClipboardEvent, Events er Event, XClipboard, ChronosTime, Resource, Race, Async] r =>+  Members [EventConsumer xr XClipboardEvent, Reader InstanceName] r =>+  Members [Events er Event, XClipboard !! Text, Log, ChronosTime, Resource, Race, Async] r =>   Sem r a ->   Sem r a transformXEvents =   withAsync_ do     Conc.subscribeLoop \case       XClipboardEvent text selection -> do-        XClipboard.sync text selection+        XClipboard.sync text selection !! \ e ->+          Log.error [exon|Syncing the X clipboard failed: #{e}|]         ev <- Event.now agentIdX text         Conc.publish ev @@ -32,11 +35,12 @@ -- 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, ChronosTime] r =>-  Members [Events xr XClipboardEvent, Error Text, Race, Resource, Async, Embed IO, Final IO] r =>+  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     Update Event {..} ->-      XClipboard.set content+      XClipboard.set content !! \ e ->+        Log.error [exon|Setting the X clipboard failed: #{e}|]

@@ -3,7 +3,6 @@  import Polysemy.Http (Manager) import qualified Polysemy.Http.Effect.Manager as Manager-import Polysemy.Log (Log) import Servant.Client (mkClientEnv, runClientM)  import Helic.Data.Event (Event)@@ -28,7 +27,7 @@       runError (sendTo timeout host event)     Load event -> do       env <- mkClientEnv <$> Manager.get <*> localhostUrl-      result <- mapLeft show <$> embed (runClientM (Api.load event) env)+      result <- first 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.

@@ -0,0 +1,45 @@+-- |Native interpreter for 'Gtk'.+-- Internal.+module Helic.Interpreter.Gtk where++import qualified GI.Gdk as GiGdk+import GI.Gdk (Display)+import qualified GI.Gtk as GiGtk+import Polysemy.Conc (interpretScopedResumable)+import qualified Polysemy.Log as Log++import qualified Helic.Effect.Gtk as Gtk+import Helic.Effect.Gtk (Gtk)+import Helic.Gtk (getDisplay)+import Helic.Stop (tryStop)++-- |Initialize GTK, run the scoped action, then tear down the GTK environment.+bracketGtk ::+  Members [Resource, Log, Embed IO] r =>+  (Display -> Sem (Stop Text : r) a) ->+  Sem (Stop Text : r) a+bracketGtk =+  bracket acquire release+  where+    acquire = do+      unlessM (fst <$> tryStop (GiGtk.initCheck Nothing)) do+        stop "GTK intialization failed"+      getDisplay+    release display = do+      Log.debug "Quitting the GTK main loop"+      ignoreException do+        GiGdk.displayFlush display+        GiGdk.displayClose display+      tryStop GiGtk.mainQuit++-- |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 =>+  InterpreterFor (Scoped Display (Gtk Display) !! Text) r+interpretGtk =+  interpretScopedResumable bracketGtk \ display -> \case+    Gtk.Main ->+      GiGtk.main+    Gtk.Resource ->+      pure display

@@ -0,0 +1,44 @@+-- |Native interpreters for 'GtkClipboard', for scoped interpretation with 'interpretWithGtk'.+module Helic.Interpreter.GtkClipboard where++import GI.Gdk (Display)++import qualified Helic.Effect.GtkClipboard as GtkClipboard+import Helic.Effect.GtkClipboard (GtkClipboard)+import Helic.Effect.GtkMain (GtkMain)+import Helic.Gtk (clipboardText, setClipboardText, subscribeToClipboard)+import Helic.Interpreter.GtkMain (interpretWithGtk)++-- |Specialization of 'scoped' to 'GtkClipboard' for syntactic sugar.+withGtkClipboard ::+  Member (Scoped resource GtkClipboard) r =>+  InterpreterFor GtkClipboard r+withGtkClipboard =+  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.+-- The effect then needs to be scoped using 'withGtkClipboard'.+-- The default implementation for this purpose is 'interpretWithGtk'.+handleGtkClipboard ::+  Members [Log, Embed IO, Final IO] r =>+  Display ->+  GtkClipboard (Sem r0) a ->+  Tactical effect (Sem r0) (Stop Text : r) a+handleGtkClipboard display = \case+  GtkClipboard.Read selection ->+    pureT =<< runReader display (clipboardText selection)+  GtkClipboard.Write selection text ->+    pureT =<< runReader display (setClipboardText selection text)+  GtkClipboard.Events f -> do+    let f' s t = void (raise (runTSimple (f s t)))+    runReader display do+      for_ @[] [minBound..maxBound] (subscribeToClipboard f')+    pureT ()++-- |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+interpretGtkClipboard =+  interpretWithGtk handleGtkClipboard

@@ -0,0 +1,87 @@+{-# options_haddock prune #-}++-- |An interpreter for 'GtkMain' that uses 'MVar's.+-- Internal.+module Helic.Interpreter.GtkMain where++import Polysemy.Conc (interpretScopedResumableH, interpretSync, interpretSyncAs, lock)+import qualified Polysemy.Conc.Sync as Sync++import qualified Helic.Effect.GtkMain as GtkMain+import Helic.Effect.GtkMain (GtkMain)+import Helic.GtkMain (gtkResource)++data GtkLock =+  GtkLock+  deriving stock (Eq, Show)++data StartGtkMain =+  StartGtkMain+  deriving stock (Eq, Show)++newtype GtkResource s =+  GtkResource { unGtkResource :: s }+  deriving stock (Eq, Show)++-- TODO Access needs to be a scope to ensure it must be executed+-- this means that access/request and run/running must be two separate effects++-- |Interpret the GTK main loop communication bridge with 'MVar's.+handleGtkMain ::+  ∀ s wait restart e m r a .+  TimeUnit wait =>+  TimeUnit restart =>+  Members [Resource, Sync GtkLock, 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+      Sync.try >>= \case+        Just (GtkResource s) ->+          pureT s+        Nothing ->+          runTSimple ms+  GtkMain.Request ms -> do+    Sync.clear @(GtkResource _)+    Sync.putTry StartGtkMain+    Sync.wait wait >>= \case+      Just (GtkResource s) ->+        pureT s+      Nothing ->+        runTSimple ms+  GtkMain.Run ma -> do+    Sync.clear @StartGtkMain+    Sync.clear @(GtkResource _)+    runTSimple ma <* do+      Sync.clear @(GtkResource _)+      Sync.takeWait @StartGtkMain restart+  GtkMain.Running s ->+    pureT =<< Sync.putBlock (GtkResource s)++-- |Interpret the GTK main loop communication bridge with 'MVar's.+interpretGtkMain ::+  ∀ s wait restart r .+  TimeUnit wait =>+  TimeUnit restart =>+  Members [Resource, Race, Embed IO] r =>+  wait ->+  restart ->+  InterpreterFor (GtkMain s) r+interpretGtkMain wait restart =+  interpretSync .+  interpretSyncAs GtkLock .+  interpretSync @StartGtkMain .+  interpretH (handleGtkMain wait restart) .+  raiseUnder3++-- |Scope an effect that uses a GTK main loop resource by acquiring it via 'GtkMain'.+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+interpretWithGtk =+  interpretScopedResumableH (=<< gtkResource)

@@ -6,18 +6,17 @@ import qualified Chronos import qualified Data.Sequence as Seq import Data.Sequence (Seq ((:|>)), (!?), (|>))-import Polysemy.AtomicState (atomicState')+import qualified Data.Text as Text+import Exon (exon) 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.Event (Event (Event, content, 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)@@ -60,6 +59,14 @@     newer (Event _ _ t _) =       diff now t <= convert (Seconds 1) +sanitizeNewlines :: Text -> Text+sanitizeNewlines =+  Text.replace "\r" "\n" . Text.replace "\r\n" "\n"++sanitize :: Event -> Event+sanitize e@Event {content} =+  e { content = sanitizeNewlines content }+ -- |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 ::@@ -67,10 +74,10 @@   Event ->   Seq Event ->   Maybe (Seq Event)-appendIfValid now e = \case+appendIfValid now (sanitize -> e@Event {content}) = \case   Seq.Empty ->     Just (Seq.singleton e)-  _ :|> Event _ _ _ newest | newest == Event.content e ->+  _ :|> Event _ _ _ newest | newest == content ->     Nothing   hist | inRecent now e hist ->     Nothing

@@ -1,6 +1,7 @@ -- |Reader Interpreter for InstanceName, Internal module Helic.Interpreter.InstanceName where +import Exon (exon) import Network.HostName (getHostName) import qualified Polysemy.Error as Polysemy 

@@ -1,86 +1,28 @@--- |XClipboard Interpreter, Internal+-- |Interpreter for 'XClipboard' using GTK.+-- Internal. module Helic.Interpreter.XClipboard where -import qualified GI.Gdk as Gdk-import qualified GI.Gtk as GI-import qualified Polysemy.Conc as Conc-import Polysemy.Conc (Events, withAsync_)-import qualified Polysemy.Log as Log-import Polysemy.Log (Log)-import Polysemy.Resource (bracket)--import qualified Helic.Data.GtkState as GtkState-import Helic.Data.GtkState (GtkState (GtkState))-import Helic.Data.Selection (Selection (Clipboard, Primary, Secondary))-import Helic.Data.XClipboardEvent (XClipboardEvent (XClipboardEvent))+import Helic.Data.Selection (Selection (Clipboard))+import qualified Helic.Effect.GtkClipboard as GtkClipboard+import Helic.Effect.GtkClipboard (GtkClipboard) import Helic.Effect.XClipboard (XClipboard (Current, Set, Sync))-import qualified Helic.Gtk as Gtk-import Helic.Gtk (getClipboardFor, gtkClipboard, setClipboardFor, syncXClipboard)---- |Execute a GTK main loop in a baackground thread and interpret @'Reader' 'GtkState'@.--- The clipboards stored in the state need the main loop running to work properly.--- The main loop is killed after the interpreted program terminates.-withMainLoop ::-  Members [Log, Error Text, Race, Async, Resource, Embed IO] r =>-  InterpreterFor (Reader GtkState) r-withMainLoop prog = do-  bracket acquire release \ display -> do-    clipboard <- fromEither =<< gtkClipboard display Clipboard-    primary <- fromEither =<< gtkClipboard display Primary-    secondary <- fromEither =<< gtkClipboard display Secondary-    runReader (GtkState clipboard primary secondary display) (withAsync_ GI.main prog)-  where-    acquire = do-      _ <- embed (GI.init Nothing)-      note "couldn't get a GTK display" =<< Gdk.displayGetDefault-    release display = do-      Log.debug [exon|Quitting the GTK main loop|]-      Gdk.displayFlush display-      Gdk.displayClose display-      GI.mainQuit---- |Listen to clipboard events for a specific source, like "primary selection", and publish them via 'Events'.-subscribeToClipboard ::-  Members [Events resource XClipboardEvent, Reader GtkState, Log, Embed IO, Final IO] r =>-  GI.Clipboard ->-  Selection ->-  Sem r ()-subscribeToClipboard clipboard selection =-  Gtk.subscribe clipboard \case-    Right t ->-      Conc.publish (XClipboardEvent t selection)-    Left e ->-      Log.warn [exon|GTK: #{e}|]---- |Listen to clipboard events and publish them via 'Events'.-clipboardEvents ::-  Members [Events resource XClipboardEvent, Reader GtkState, Log, Embed IO, Final IO] r =>-  Sem r ()-clipboardEvents = do-  GtkState {..} <- ask-  subscribeToClipboard clipboard Clipboard-  subscribeToClipboard primary Primary-  subscribeToClipboard secondary Secondary---- |Run a GTK main loop and listen to clipboard events, publishing them via 'Events'.-listenXClipboard ::-  Members [Events resource XClipboardEvent, Log, Error Text, Race, Resource, Async, Embed IO, Final IO] r =>-  InterpreterFor (Reader GtkState) r-listenXClipboard sem =-  withMainLoop do-    clipboardEvents-    sem+import Helic.Interpreter.GtkClipboard (withGtkClipboard)  -- |Interpret 'XClipboard' using a GTK backend.--- This uses the @gi-gtk@ library to access the X11 clipboard.+-- This uses the library @gi-gtk@ to access the X11 clipboard. interpretXClipboardGtk ::-  Members [Reader GtkState, Log, Embed IO, Final IO] r =>-  InterpreterFor XClipboard r+  Members [Scoped resource GtkClipboard !! Text, Log, Embed IO, Final IO] r =>+  InterpreterFor (XClipboard !! Text) r interpretXClipboardGtk = do-  interpret \case+  interpretResumable \case     Current ->-      getClipboardFor Clipboard+      restop $ withGtkClipboard do+        GtkClipboard.read Clipboard     Set text ->-      setClipboardFor Clipboard text-    Sync text selection ->-      syncXClipboard text selection+      restop $ withGtkClipboard do+        (GtkClipboard.write Clipboard text)+    Sync _ Clipboard ->+      unit+    Sync text _ ->+      restop $ withGtkClipboard do+        GtkClipboard.write Clipboard text

@@ -6,6 +6,7 @@ import Chronos (Datetime (Datetime), SubsecondPrecision (SubsecondPrecisionFixed), builder_HMS, timeToDatetime) import qualified Data.Text as Text import Data.Text.Lazy.Builder (toLazyText)+import Exon (exon) import qualified System.Console.Terminal.Size as TerminalSize import Text.Layout.Table (center, column, expandUntil, fixedCol, left, right, rowG, tableString, titlesH, unicodeRoundS) @@ -76,4 +77,4 @@   Members [Reader ListConfig, Client, Error Text, Embed IO] r =>   Sem r () list =-  putStrLn =<< buildList+  embed . putStrLn =<< buildList

@@ -4,8 +4,9 @@ module Helic.Listen where  import qualified Polysemy.Conc as Conc-import Polysemy.Conc (EventConsumer, Sync, interpretSync, withAsync_)+import Polysemy.Conc (interpretSync, withAsync_) import qualified Polysemy.Conc.Sync as Sync+import Prelude hiding (listen)  import Helic.Data.Event (Event) import qualified Helic.Effect.History as History

@@ -1,8 +1,6 @@ -- |HTTP API of the Daemon, Internal module Helic.Net.Api where -import Polysemy.Conc (Interrupt, Sync)-import Polysemy.Log (Log) import Servant (Get, JSON, NoContent (NoContent), PostCreated, PutAccepted, ReqBody, type (:<|>) ((:<|>)), type (:>)) import Servant.Server (Context (EmptyContext), ServerT) @@ -30,7 +28,7 @@ server =   History.get   :<|>-  as NoContent . History.receive+  (NoContent <$) . History.receive   :<|>   History.load 

@@ -3,11 +3,11 @@ -- |HTTP Client, Internal module Helic.Net.Client where +import Exon (exon) import qualified Polysemy.Conc as Conc import Polysemy.Http (Manager) import qualified Polysemy.Http.Effect.Manager as Manager import qualified Polysemy.Log as Log-import Polysemy.Log (Log) import Polysemy.Time (MilliSeconds (MilliSeconds)) import Servant (NoContent, type (:<|>) ((:<|>))) import Servant.Client (BaseUrl, ClientM, client, mkClientEnv, parseBaseUrl, runClientM)@@ -39,7 +39,7 @@     env =       mkClientEnv mgr url     req =-      fmap (mapLeft show) <$> tryAny (runClientM (yank event) env)+      fmap (first show) <$> tryAny (runClientM (yank event) env)   void . fromEither =<< fromEither =<< Conc.timeoutAs_ (Left "timed out") timeout req  localhost ::

@@ -1,7 +1,10 @@ {-# options_haddock prune #-}+ -- |HTTP Server Plumbing, Internal module Helic.Net.Server where +import Control.Monad.Trans.Except (ExceptT (ExceptT))+import Exon (exon) import qualified Network.Wai.Handler.Warp as Warp import Network.Wai.Handler.Warp (   defaultSettings,@@ -12,12 +15,10 @@   setPort,   ) import Network.Wai.Middleware.RequestLogger (logStdout)-import Polysemy.Conc (Interrupt, Sync) import qualified Polysemy.Conc.Effect.Interrupt as Interrupt-import qualified Polysemy.Conc.Effect.Sync as Sync+import qualified Polysemy.Conc.Sync as Sync import Polysemy.Final (withWeavingToFinal) import qualified Polysemy.Log as Log-import Polysemy.Log (Log) import Servant (   Context,   DefaultErrorFormatters,

@@ -1,189 +0,0 @@-{-# language NoImplicitPrelude #-}-{-# options_haddock prune, hide #-}--- |Prelude, Internal--module Helic.Prelude (-  module Data.Aeson,-  module Data.Aeson.TH,-  module Data.Default,-  module Data.Either.Combinators,-  module Data.Foldable,-  module Data.Kind,-  module Exon,-  module GHC.Err,-  module GHC.TypeLits,-  module Helic.Prelude,-  module Helic.Prelude.Debug,-  module Polysemy,-  module Polysemy.Async,-  module Polysemy.AtomicState,-  module Polysemy.Conc,-  module Polysemy.Error,-  module Polysemy.Internal.Tactics,-  module Polysemy.Reader,-  module Polysemy.Resource,-  module Polysemy.State,-  module Relude,-) where--import Control.Exception (try)-import qualified Data.Aeson as Aeson-import Data.Aeson (FromJSON (parseJSON), SumEncoding (UntaggedValue), ToJSON (toJSON), Value, camelTo2)-import Data.Aeson.TH (deriveFromJSON, deriveJSON)-import Data.Default (Default (def))-import Data.Either.Combinators (mapLeft)-import Data.Foldable (foldl, traverse_)-import Data.Kind (Type)-import Exon (exon)-import GHC.Err (undefined)-import GHC.TypeLits (Symbol)-import qualified Language.Haskell.TH.Syntax as TH-import Polysemy (-  Effect,-  EffectRow,-  Embed,-  Final,-  InterpreterFor,-  InterpretersFor,-  Member,-  Members,-  Sem,-  WithTactics,-  bindT,-  embed,-  embedToFinal,-  interpret,-  interpretH,-  makeSem,-  pureT,-  raise,-  raise2Under,-  raise3Under,-  raiseUnder,-  raiseUnder2,-  raiseUnder3,-  reinterpret,-  runFinal,-  runT,-  )-import Polysemy.Async (Async, async, asyncToIOFinal, await, sequenceConcurrently)-import Polysemy.AtomicState (AtomicState, atomicGet, atomicGets, atomicModify', atomicPut, runAtomicStateTVar)-import Polysemy.Conc (Race)-import Polysemy.Error (Error, fromEither, fromExceptionVia, mapError, note, runError, throw)-import Polysemy.Internal.CustomErrors (FirstOrder)-import Polysemy.Internal.Kind (Append)-import Polysemy.Internal.Tactics (liftT)-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 (-  Reader,-  State,-  Type,-  ask,-  asks,-  evalState,-  filterM,-  get,-  gets,-  hoistEither,-  modify,-  modify',-  put,-  readFile,-  runReader,-  runState,-  state,-  trace,-  traceShow,-  undefined,-  )--import Helic.Prelude.Debug (dbg, dbgs, dbgsWith, dbgs_, tr, trs, trs')--unit ::-  Applicative f =>-  f ()-unit =-  pure ()-{-# inline unit #-}--tryAny ::-  Member (Embed IO) r =>-  IO a ->-  Sem r (Either Text a)-tryAny =-  embed . fmap (mapLeft show) . try @SomeException-{-# inline tryAny #-}--catchAny ::-  Member (Embed IO) r =>-  IO a ->-  (Text -> Sem r a) ->-  Sem r a-catchAny ma handle =-  either handle pure =<< tryAny ma-{-# inline catchAny #-}--basicOptions :: Aeson.Options-basicOptions =-  Aeson.defaultOptions {-    Aeson.fieldLabelModifier = dropWhile ('_' ==)-  }--jsonOptions :: Aeson.Options-jsonOptions =-  basicOptions {-    Aeson.unwrapUnaryRecords = True-  }--untaggedOptions :: Aeson.Options-untaggedOptions =-  jsonOptions {-    Aeson.sumEncoding = UntaggedValue-  }--defaultJson :: TH.Name -> TH.Q [TH.Dec]-defaultJson =-  deriveJSON jsonOptions--lowerMinusJson :: TH.Name -> TH.Q [TH.Dec]-lowerMinusJson =-  deriveJSON jsonOptions {-    Aeson.constructorTagModifier = camelTo2 '-'-  }--unaryRecordJson :: TH.Name -> TH.Q [TH.Dec]-unaryRecordJson =-  deriveJSON basicOptions--type a ++ b =-  Append a b--traverseLeft ::-  Applicative m =>-  (a -> m b) ->-  Either a b ->-  m b-traverseLeft f =-  either f pure-{-# inline traverseLeft #-}--interpreting ::-  ∀ e r a .-  FirstOrder e "interpret" =>-  Sem (e : r) a ->-  (∀ r0 x . e (Sem r0) x -> Sem r x) ->-  Sem r a-interpreting s h =-  interpret h s-{-# inline interpreting #-}--as ::-  Functor m =>-  a ->-  m b ->-  m a-as =-  (<$)-{-# inline as #-}

@@ -1,103 +0,0 @@-{-# language NoImplicitPrelude #-}-{-# options_haddock prune #-}--- |Debug Printing, Internal--module Helic.Prelude.Debug where--import qualified Data.Text as Text-import Exon (exon)-import GHC.Stack (SrcLoc (..))-import Relude-import System.IO.Unsafe (unsafePerformIO)--srcLoc :: CallStack -> SrcLoc-srcLoc = \case-  (getCallStack -> (_, loc) : _) -> loc-  _ -> error "Debug.srcLoc: empty CallStack"--debugPrint ::-  SrcLoc ->-  Text ->-  IO ()-debugPrint SrcLoc{ srcLocModule = (toText -> slm), ..} msg =-  putStrLn [exon|#{toString moduleName}:#{show srcLocStartLine} #{toString msg}|]-  where-    moduleName =-      fromMaybe slm $ listToMaybe $ reverse $ Text.splitOn "." slm--debugPrintWithLoc ::-  Monad m =>-  SrcLoc ->-  Text ->-  m ()-debugPrintWithLoc loc msg = do-  () <- return (unsafePerformIO (debugPrint loc msg))-  pure ()--dbg ::-  HasCallStack =>-  Monad m =>-  Text ->-  m ()-dbg =-  debugPrintWithLoc (srcLoc callStack)-{-# inline dbg #-}--dbgsWith ::-  HasCallStack =>-  Monad m =>-  Show a =>-  Text ->-  a ->-  m ()-dbgsWith prefix a =-  debugPrintWithLoc (srcLoc callStack) [exon|#{prefix}: #{show @Text a}|]-{-# inline dbgsWith #-}--dbgs ::-  HasCallStack =>-  Monad m =>-  Show a =>-  a ->-  m ()-dbgs a =-  debugPrintWithLoc (srcLoc callStack) (show a)-{-# inline dbgs_ #-}--dbgs_ ::-  HasCallStack =>-  Monad m =>-  Show a =>-  a ->-  m a-dbgs_ a =-  a <$ debugPrintWithLoc (srcLoc callStack) (show a)-{-# inline dbgs #-}--tr ::-  HasCallStack =>-  Text ->-  a ->-  a-tr msg a =-  unsafePerformIO (a <$ debugPrint (srcLoc callStack) msg)-{-# INLINE tr #-}--trs ::-  Show a =>-  HasCallStack =>-  a ->-  a-trs a =-  unsafePerformIO (a <$ debugPrint (srcLoc callStack) (show a))-{-# INLINE trs #-}--trs' ::-  Show b =>-  HasCallStack =>-  b ->-  a ->-  a-trs' b a =-  unsafePerformIO (a <$ debugPrint (srcLoc callStack) (show b))-{-# INLINE trs' #-}

@@ -0,0 +1,11 @@+-- |Combinators for 'Stop'.+-- Internal.+module Helic.Stop where++-- |Catch all exceptions in an 'IO' action, embed it into a 'Sem' and convert exceptions to 'Stop'.+tryStop ::+  Members [Stop Text, Embed IO] r =>+  IO a ->+  Sem r a+tryStop =+  stopEither <=< tryAny

@@ -1,24 +1,19 @@ {-# options_haddock prune #-}+ -- |Tmux Helpers, Internal module Helic.Tmux where -import Polysemy.Conc (Scoped)-import qualified Polysemy.Log as Log-import Polysemy.Log (Log) import qualified Polysemy.Process as Process import Polysemy.Process (Process) import Polysemy.Process.Effect.Process (withProcess)-import Polysemy.Resume (type (!!), (!!))  import Helic.Data.Event (Event (Event))  sendToTmux ::-  ∀ err o e resource r .-  Show err =>-  Members [Scoped resource (Process ByteString o e !! err), Log] r =>+  ∀ o e resource r .+  Members [Scoped resource (Process ByteString o e), Log] r =>   Event ->   Sem r () sendToTmux (Event _ _ _ text) =   withProcess do-    Process.send (encodeUtf8 text) !! \ e ->-      Log.error [exon|failed to send data to tmux: #{show e}|]+    Process.send (encodeUtf8 text)

@@ -4,7 +4,8 @@ module Helic.Yank where  import qualified Data.Text.IO as Text-import Polysemy.Chronos.Time (ChronosTime)+import Polysemy.Chronos (ChronosTime)+import System.IO (stdin)  import Helic.Data.AgentId (AgentId (AgentId)) import qualified Helic.Data.Event as Event

@@ -1,9 +0,0 @@-{-# language NoImplicitPrelude #-}-{-# options_haddock prune #-}--- |Prelude, Internal--module Prelude (-  module Helic.Prelude,-) where--import Helic.Prelude

@@ -0,0 +1,22 @@+module Helic.Dev where++import Polysemy.Conc (withAsync_)+import qualified Polysemy.Time as Time+import Polysemy.Time (Seconds (Seconds))+import System.Environment (setEnv)++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 (Just True)++main :: IO ()+main =+  runIO (withAsync_ setenv (interpretLog (Just True) (listenApp conf)))+  where+    setenv =+      Time.sleep (Seconds 12) *> embed (setEnv "DISPLAY" ":0")

@@ -1,3 +1,5 @@+{-# options_ghc -Wno-unused-imports #-}+ module Helic.Test.ConfigFileTest where  import Path (Abs, File, Rel, absfile, relfile)

@@ -0,0 +1,87 @@+module Helic.Test.GtkMainTest where++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 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 qualified Helic.Effect.Gtk as Gtk+import Helic.Effect.Gtk (Gtk)+import qualified Helic.Effect.GtkClipboard as GtkClipboard+import Helic.Effect.GtkClipboard (GtkClipboard)+import Helic.GtkClipboard (subscribeEvents)+import Helic.GtkMain (gtkMainLoop)+import Helic.Interpreter.AgentX (interpretAgentX)+import Helic.Interpreter.GtkMain (interpretGtkMain, interpretWithGtk)+import Helic.Interpreter.InstanceName (interpretInstanceName)+import Helic.Interpreter.XClipboard (interpretXClipboardGtk)++handleGtkClipboardTest ::+  Member (AtomicState [Text]) r =>+  () ->+  GtkClipboard (Sem r0) a ->+  Tactical effect (Sem r0) (Stop Text : r) a+handleGtkClipboardTest _ = \case+  GtkClipboard.Read _ -> do+    pureT (Just "here")+  GtkClipboard.Write _ t ->+    pureT =<< atomicModify' (t :)+  GtkClipboard.Events _ -> do+    pureT ()++bracketGtk ::+  Member (AtomicState Bool) r =>+  (() -> Sem (Stop Text : r) a) ->+  Sem (Stop Text : r) a+bracketGtk f = do+  unlessM atomicGet do+    stop "no display"+  f ()++interpretGtk ::+  Members [AtomicState Bool, ChronosTime] r =>+  InterpreterFor (Scoped () (Gtk ()) !! Text) r+interpretGtk =+  interpretScopedResumable 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 $+  interpretInstanceName (Just "test") $+  interpretEventsChan @XClipboardEvent $+  interpretEventsChan @Event $+  interpretAtomic [] $+  interpretAtomic False $+  interpretGtk $+  interpretGtkMain (MilliSeconds 50) (MilliSeconds 100) $+  interpretWithGtk @GtkClipboard handleGtkClipboardTest $+  gtkMainLoop subscribeEvents $+  interpretXClipboardGtk $+  interpretAgentX do+    tag @AgentX . Agent.update =<< Event.now agentIdNet "not running"+    atomicPut True+    let pub = tag @AgentX . 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)

@@ -3,10 +3,11 @@ import qualified Chronos import Chronos (datetimeToTime) import Data.Sequence ((|>))-import Polysemy.Chronos (interpretTimeChronos)+import Exon (exon)+import Polysemy.Chronos (interpretTimeChronosConstant) import Polysemy.Test (UnitTest, assertJust, runTestAuto, (===)) import qualified Polysemy.Time as Time-import Polysemy.Time (MilliSeconds (MilliSeconds), convert, mkDatetime)+import Polysemy.Time (Days (Days), MilliSeconds (MilliSeconds), convert, mkDatetime) import Torsor (add)  import Helic.Data.Event (Event (Event))@@ -24,16 +25,25 @@ event2 =   Event "me" "test" old "event2" +eventMixedNl :: Event+eventMixedNl =+  Event "me" "test" old ("line1\r\nline2\rline3\nline4" <> [exon|
line5|])++eventNl :: Event+eventNl =+  Event "me" "test" old "line1\nline2\nline3\nline4\nline5"+ historyLatest :: Seq Event historyLatest =   [event2, event1]  test_insertEvent :: UnitTest test_insertEvent =-  runTestAuto $ interpretTimeChronos do+  runTestAuto $ interpretTimeChronosConstant (add (convert (Days 1)) old) do     now <- Time.now     assertJust [Event "me" "test" now "string"] (appendIfValid now (Event "me" "test" now "string") mempty)     Nothing === appendIfValid now event1 historyLatest     assertJust (historyLatest |> event2) (appendIfValid now event2 historyLatest)     Nothing === appendIfValid (add (convert (MilliSeconds 100)) old) event2 historyLatest     assertJust (historyLatest |> event2) (appendIfValid (add (convert (MilliSeconds 1100)) old) event2 historyLatest)+    assertJust (historyLatest |> eventNl) (appendIfValid now eventMixedNl historyLatest)

@@ -1,7 +1,7 @@ module Helic.Test.ListTest where +import Exon(exon) import Polysemy.Chronos (interpretTimeChronosConstant)-import Polysemy.Error (errorToIOFinal) import Polysemy.Test (UnitTest, assertRight, runTestAuto)  import Helic.Data.AgentId (AgentId (AgentId))

@@ -4,8 +4,6 @@ import Polysemy.Chronos (interpretTimeChronosConstant) import qualified Polysemy.Conc as Conc import Polysemy.Conc (-  Events,-  Queue,   interpretAtomic,   interpretEventsChan,   interpretQueueTBM,

@@ -1,6 +1,7 @@ module Main where  import Helic.Test.ConfigFileTest (test_readConfigFile)+import Helic.Test.GtkMainTest (test_gtkMain) import Helic.Test.InsertEventTest (test_insertEvent) import Helic.Test.ListTest (test_list) import Helic.Test.ListenTest (test_listen)@@ -15,7 +16,8 @@     unitTest "parse a config file" test_readConfigFile,     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+    unitTest "load an old event to the clipboard" test_load,+    unitTest "restart the gtk main loop when requested after failure" test_gtkMain   ]  main :: IO ()