helic 0.3.1.0 → 0.3.2.0

raw patch · 11 files changed

+188/−128 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• helic.cabal +2/−1
• lib/Helic/App.hs +116/−0
• lib/Helic/Cli.hs +36/−115
• lib/Helic/Cli/Options.hs +2/−2
• lib/Helic/Data/Config.hs +2/−1
• lib/Helic/Interpreter/History.hs +4/−3
• lib/Helic/List.hs +3/−3
• lib/Helic/Net/Api.hs +2/−2
• readme.md +19/−0
• test/Helic/Test/ConfigFileTest.hs +1/−1
• test/Helic/Test/LoadTest.hs +1/−0

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           helic-version:        0.3.1.0+version:        0.3.2.0 synopsis:       Clipboard Manager description:    See <https://hackage.haskell.org/package/helic/docs/Helic.html> category:       Clipboard@@ -28,6 +28,7 @@ library   exposed-modules:       Helic+      Helic.App       Helic.Cli       Helic.Cli.Options       Helic.Config.File

@@ -0,0 +1,116 @@+module Helic.App where++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 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.Interpreter.AgentNet (interpretAgentNet)+import Helic.Interpreter.AgentTmux (interpretAgentTmux)+import Helic.Interpreter.AgentX (interpretAgentX)+import Helic.Interpreter.Client (interpretClientNet)+import Helic.Interpreter.History (interpretHistory)+import Helic.Interpreter.InstanceName (interpretInstanceName)+import Helic.Interpreter.XClipboard (interpretXClipboardGtk, listenXClipboard)+import Helic.List (list)+import Helic.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 maxHistory _) =+  runReader (fromMaybe def tmux) $+  runReader (fromMaybe def net) $+  interpretEventsChan @XClipboardEvent $+  interpretEventsChan @Event $+  interpretAtomic mempty $+  interpretInstanceName name $+  interpretManager $+  listenXClipboard $+  interpretXClipboardGtk $+  interpretAgentX $+  interpretAgentNet $+  interpretAgentTmux $+  interpretHistory maxHistory $+  interpretSync $+  withAsync_ serve $+  Conc.subscribeLoop History.receive++yankApp ::+  Config ->+  YankConfig ->+  Sem AppStack ()+yankApp (Config name _ net _ _) yankConfig =+  interpretManager $+  interpretInstanceName name $+  runReader (fromMaybe def net) $+  interpretClientNet $+  yank yankConfig++runClient ::+  Members [Log, Error Text, Race, Embed IO] r =>+  Maybe NetConfig ->+  InterpretersFor [Client, Reader NetConfig, Manager] r+runClient net =+  interpretManager .+  runReader (fromMaybe def net) .+  interpretClientNet++listApp ::+  Config ->+  ListConfig ->+  Sem AppStack ()+listApp (Config _ _ net _ _) listConfig =+  runReader listConfig $+  runClient net $+  list++loadApp ::+  Config ->+  LoadConfig ->+  Sem AppStack ()+loadApp (Config _ _ net _ _) (LoadConfig event) =+  runClient net $+  (void . fromEither =<< Client.load event)

@@ -4,148 +4,68 @@ module Helic.Cli where  import Options.Applicative (customExecParser, fullDesc, header, helper, info, prefs, showHelpOnEmpty, showHelpOnError)-import Polysemy.Chronos (ChronosTime, interpretTimeChronos)+import Polysemy.Chronos (interpretTimeChronos) import qualified Polysemy.Conc as Conc import Polysemy.Conc (-  Critical,-  Interrupt,-  interpretAtomic,   interpretCritical,-  interpretEventsChan,   interpretInterrupt,   interpretRace,-  interpretSync,-  withAsync_,   ) import Polysemy.Error (errorToIOFinal)-import Polysemy.Http (Manager)-import Polysemy.Http.Interpreter.Manager (interpretManager)-import qualified Polysemy.Log as Log-import Polysemy.Log (Log, Severity (Info, Trace), interpretLogStdoutLevelConc)-import Polysemy.Time (MilliSeconds (MilliSeconds))+import Polysemy.Log (+  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 System.IO (hLookAhead) +import Helic.App (AppStack, IOStack, listApp, listenApp, loadApp, yankApp) import Helic.Cli.Options (Command (List, Listen, Load, Yank), Conf (Conf), parser) import Helic.Config.File (findFileConfig)-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 qualified Helic.Data.Config as Config+import Helic.Data.Config (Config) import Helic.Data.YankConfig (YankConfig (YankConfig))-import qualified Helic.Effect.Client as Client-import Helic.Effect.Client (Client)-import qualified Helic.Effect.History as History-import Helic.Interpreter.AgentNet (interpretAgentNet)-import Helic.Interpreter.AgentTmux (interpretAgentTmux)-import Helic.Interpreter.AgentX (interpretAgentX)-import Helic.Interpreter.Client (interpretClientNet)-import Helic.Interpreter.History (interpretHistory)-import Helic.Interpreter.InstanceName (interpretInstanceName)-import Helic.Interpreter.XClipboard (interpretXClipboardGtk, listenXClipboard)-import Helic.List (list)-import Helic.Net.Api (serve)-import Helic.Yank (yank)  logError ::-  Members [Log, Final IO] r =>+  Members [Logger, GhcTime, Final IO] r =>   Sem (Error Text : r) () ->   Sem r ()-logError sem =-  errorToIOFinal sem >>= \case-    Right () -> unit-    Left err -> Log.error err+logError =+  traverseLeft DataLog.error <=< errorToIOFinal -type IOStack =-  [-    Error Text,-    Interrupt,-    Critical,-    Log,-    ChronosTime,-    Race,-    Async,-    Resource,-    Embed IO,-    Final IO-  ]+interpretLog ::+  Maybe Bool ->+  InterpreterFor Log IOStack+interpretLog (fromMaybe False -> verbose) =+  setLogLevel (if verbose then Just Trace else Just Info) . interpretLogDataLog  runIO ::-  Bool ->   Sem IOStack () ->   IO ()-runIO verbose =+runIO =   runFinal .   embedToFinal .   resourceToIOFinal .   asyncToIOFinal .   interpretRace .+  interpretTimeGhc .   interpretTimeChronos .-  interpretLogStdoutLevelConc (if verbose then (Just Trace) else Just Info) .   interpretCritical .   interpretInterrupt .+  interpretDataLogStdoutWith formatLogEntry .+  interceptDataLogConc @(LogEntry LogMessage) 64 .   logError -listenApp ::-  Config ->-  Sem IOStack ()-listenApp (Config name tmux net maxHistory) =-  runReader (fromMaybe def tmux) $-  runReader (fromMaybe def net) $-  interpretEventsChan @XClipboardEvent $-  interpretEventsChan @Event $-  interpretAtomic mempty $-  interpretInstanceName name $-  interpretManager $-  listenXClipboard $-  interpretXClipboardGtk $-  interpretAgentX $-  interpretAgentNet $-  interpretAgentTmux $-  interpretHistory maxHistory $-  interpretSync $-  withAsync_ serve $-  Conc.subscribeLoop History.receive--yankApp ::-  Config ->-  YankConfig ->-  Sem IOStack ()-yankApp (Config name _ net _) yankConfig =-  interpretManager $-  interpretInstanceName name $-  runReader (fromMaybe def net) $-  interpretClientNet $-  yank yankConfig--runClient ::-  Members [Log, Error Text, Race, Embed IO] r =>-  Maybe NetConfig ->-  InterpretersFor [Client, Reader NetConfig, Manager] r-runClient net =-  interpretManager .-  runReader (fromMaybe def net) .-  interpretClientNet--listApp ::-  Config ->-  ListConfig ->-  Sem IOStack ()-listApp (Config _ _ net _) listConfig =-  runReader listConfig $-  runClient net $-  list--loadApp ::-  Config ->-  LoadConfig ->-  Sem IOStack ()-loadApp (Config _ _ net _) (LoadConfig event) =-  runClient net $-  (void . fromEither =<< Client.load event)--runCommand :: Config -> Command -> Sem IOStack ()+runCommand :: Config -> Command -> Sem AppStack () runCommand config = \case   Listen ->     listenApp config@@ -163,10 +83,11 @@     _ -> Listen  withCliOptions :: Conf -> Maybe Command -> IO ()-withCliOptions (Conf verbose file) cmd =-  runIO verbose do-    config <- findFileConfig file-    runCommand config =<< maybe defaultCommand pure cmd+withCliOptions (Conf cliVerbose file) cmd =+  runIO do+    config <- interpretLog cliVerbose (findFileConfig file)+    cmd' <- maybe defaultCommand pure cmd+    interpretLog (cliVerbose <|> Config.verbose config) (runCommand config cmd')  app :: IO () app = do

@@ -30,7 +30,7 @@  data Conf =   Conf {-    verbose :: Bool,+    verbose :: Maybe Bool,     configFile :: Maybe (Path Abs File)   }   deriving stock (Eq, Show)@@ -52,7 +52,7 @@  confParser :: Parser Conf confParser = do-  verbose <- switch (long "verbose")+  verbose <- optional (switch (long "verbose"))   configFile <- optional (option filePathOption (long "config-file"))   pure (Conf verbose configFile) 

@@ -10,7 +10,8 @@     name :: Maybe Text,     tmux :: Maybe TmuxConfig,     net :: Maybe NetConfig,-    maxHistory :: Maybe Int+    maxHistory :: Maybe Int,+    verbose :: Maybe Bool   }   deriving stock (Eq, Show, Generic)   deriving anyclass (Default)

@@ -134,10 +134,11 @@   Sem r (Maybe Event) loadEvent index = do   now <- Time.now-  atomicState' \ s ->-    case (s !? (length s - index - 1)) of+  atomicState' \ s -> do+    let rindex = length s - index - 1+    case (s !? rindex) of       Just event ->-        (Seq.deleteAt index s |> event { time = now }, Just event)+        (Seq.deleteAt rindex s |> event { time = now }, Just event)       Nothing ->         (s, Nothing) 

@@ -39,8 +39,8 @@     formatTime (Datetime _ tod) =       toLazyText (builder_HMS (SubsecondPrecisionFixed 0) (Just ':') tod) -format :: Int -> [Event] -> String-format width events =+format :: Int -> NonEmpty Event -> String+format width (toList -> events) =   tableString cols unicodeRoundS titles (row <$> zip [lastIndex,lastIndex-1..0] events)   where     lastIndex =@@ -69,7 +69,7 @@     events =       maybe id dropper limit (toList history)   width <- fromMaybe 80 . fmap TerminalSize.width <$> embed TerminalSize.size-  pure (format width events)+  pure (maybe "No events yet!" (format width) (nonEmpty events))  -- |Print a number of events to stdout. list ::

@@ -3,7 +3,7 @@  import Polysemy.Conc (Interrupt, Sync) import Polysemy.Log (Log)-import Servant (Get, JSON, NoContent (NoContent), Post, PostCreated, ReqBody, type (:<|>) ((:<|>)), type (:>))+import Servant (Get, JSON, NoContent (NoContent), PostCreated, PutAccepted, ReqBody, type (:<|>) ((:<|>)), type (:>)) import Servant.Server (Context (EmptyContext), ServerT)  import Helic.Data.Event (Event)@@ -20,7 +20,7 @@     :<|>     ReqBody '[JSON] Event :> PostCreated '[JSON] NoContent     :<|>-    ReqBody '[JSON] Int :> Post '[JSON] (Maybe Event)+    ReqBody '[JSON] Int :> PutAccepted '[JSON] (Maybe Event)   )  -- |The server implementation.

@@ -24,6 +24,22 @@ |`hel list`|Print the event history.| |`hel load`|Load an older event to the clipboard, given its index into the history.| +The `list` command will print a table like this:++```+╭───┬──────────┬───────┬──────────┬──────────────────────────╮+│ # │ Instance │ Agent │   Time   │         Content          │+╞═══╪══════════╪═══════╪══════════╪══════════════════════════╡+│ 2 │   test   │ nvim  │ 12:00:00 │ single line              │+├───┼──────────┼───────┼──────────┼──────────────────────────┤+│ 1 │   test   │ nvim  │ 12:00:00 │ single line with newline │+├───┼──────────┼───────┼──────────┼──────────────────────────┤+│ 0 │   test   │ nvim  │ 12:00:00 │ three lines 1 [3 lines]  │+╰───┴──────────┴───────┴──────────┴──────────────────────────╯+```++The index in the first column, with 0 being the latest event, can be used with `hel load`.+ # Installing and Running Helic  ## Nix@@ -107,6 +123,7 @@ ```yaml name: myhost maxHistory: 1000+verbose: true net:   port: 10001   hosts:@@ -126,6 +143,7 @@     enable = true;     name = "myhost";     maxHistory = 1000;+    verbose = true;     net = {       port = 10001;       hosts = ["remote1:1000" "remote2:2000"];@@ -145,6 +163,7 @@ |---|---|---| |`name`|Host name|An identifier for the host, used for filtering duplicates.| |`maxHistory`|100|The number of yanks that should be kept.|+|`verbose`||Increase the log level.| |`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.|

@@ -12,7 +12,7 @@  target :: Config target =-  Config (Just "name") (Just tmux) (Just net) (Just 1000)+  Config (Just "name") (Just tmux) (Just net) (Just 1000) (Just False)   where     tmux =       TmuxConfig (Just True) (Just [absfile|/bin/tmux|])

@@ -37,3 +37,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