diff --git a/helic.cabal b/helic.cabal --- a/helic.cabal +++ b/helic.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: helic -version: 0.5.1.0 +version: 0.5.2.0 synopsis: Clipboard Manager description: See category: Clipboard @@ -13,7 +13,7 @@ bug-reports: https://github.com/tek/helic/issues author: Torsten Schmits maintainer: hackage@tryp.io -copyright: 2021 Torsten Schmits +copyright: 2022 Torsten Schmits license: BSD-2-Clause-Patent license-file: LICENSE build-type: Simple @@ -93,8 +93,10 @@ DeriveFoldable DeriveFunctor DeriveGeneric + DeriveLift DeriveTraversable DerivingStrategies + DerivingVia DisambiguateRecordFields DoAndIfThenElse DuplicateRecordFields @@ -124,9 +126,9 @@ RankNTypes RecordWildCards RecursiveDo + RoleAnnotations ScopedTypeVariables StandaloneDeriving - StandaloneKindSignatures TemplateHaskell TupleSections TypeApplications @@ -137,12 +139,13 @@ UndecidableInstances UnicodeSyntax ViewPatterns - ghc-options: -Wall -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin + ghc-options: -Wall -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin build-depends: aeson >=1.5 - , base ==4.* + , base >=4.12 && <5 , chronos >=1.1.1 , exon >=0.3 + , fast-logger >=3 , gi-gdk >=3 , gi-glib >=2 , gi-gtk >=3 @@ -196,8 +199,10 @@ DeriveFoldable DeriveFunctor DeriveGeneric + DeriveLift DeriveTraversable DerivingStrategies + DerivingVia DisambiguateRecordFields DoAndIfThenElse DuplicateRecordFields @@ -227,9 +232,9 @@ RankNTypes RecordWildCards RecursiveDo + RoleAnnotations ScopedTypeVariables StandaloneDeriving - StandaloneKindSignatures TemplateHaskell TupleSections TypeApplications @@ -240,13 +245,13 @@ UndecidableInstances UnicodeSyntax ViewPatterns - ghc-options: -Wall -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N build-depends: - base ==4.* + base >=4.12 && <5 , helic - , incipit - , polysemy - , polysemy-plugin + , incipit >=0.1.0.3 + , polysemy >=1.6 + , polysemy-plugin >=0.4 mixins: base hiding (Prelude) default-language: Haskell2010 @@ -279,8 +284,10 @@ DeriveFoldable DeriveFunctor DeriveGeneric + DeriveLift DeriveTraversable DerivingStrategies + DerivingVia DisambiguateRecordFields DoAndIfThenElse DuplicateRecordFields @@ -310,9 +317,9 @@ RankNTypes RecordWildCards RecursiveDo + RoleAnnotations ScopedTypeVariables StandaloneDeriving - StandaloneKindSignatures TemplateHaskell TupleSections TypeApplications @@ -323,20 +330,20 @@ UndecidableInstances UnicodeSyntax ViewPatterns - ghc-options: -Wall -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N build-depends: - base ==4.* + base >=4.12 && <5 , chronos , containers , exon , helic - , incipit + , incipit >=0.1.0.3 , path - , polysemy + , polysemy >=1.6 , polysemy-chronos , polysemy-conc , polysemy-log - , polysemy-plugin + , polysemy-plugin >=0.4 , polysemy-test , polysemy-time , tasty diff --git a/lib/Helic/Interpreter/AgentTmux.hs b/lib/Helic/Interpreter/AgentTmux.hs --- a/lib/Helic/Interpreter/AgentTmux.hs +++ b/lib/Helic/Interpreter/AgentTmux.hs @@ -4,6 +4,11 @@ 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.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) @@ -12,8 +17,6 @@ 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 :: @@ -34,11 +37,11 @@ -- |Interpret 'Agent' using a tmux server as the target. interpretAgentTmux :: - Members [Reader TmuxConfig, Log, Async, Race, Resource, Embed IO] r => + Members [Reader TmuxConfig, Log, Async, Race, Resource, ChronosTime, Embed IO] r => InterpreterFor (Tagged AgentTmux Agent) r interpretAgentTmux sem = do exe <- asks TmuxConfig.exe - interpretProcessByteStringNative True 64 (tmuxProc exe) $ + interpretProcessByteStringNative def { kill = KillAfter (convert (MilliSeconds 500)) } (tmuxProc exe) $ interpreting (raiseUnder (untag sem)) \case Update event -> whenM enableTmux do diff --git a/lib/Helic/Interpreter/Gtk.hs b/lib/Helic/Interpreter/Gtk.hs --- a/lib/Helic/Interpreter/Gtk.hs +++ b/lib/Helic/Interpreter/Gtk.hs @@ -14,6 +14,7 @@ import Helic.Gtk (getDisplay) import Helic.Stop (tryStop) +-- |In the case where no default display is available from the manager, attempt to connect to a named display. tryOpenDisplay :: Members [Stop Text, Log, Embed IO] r => DisplayId -> @@ -27,6 +28,7 @@ Nothing -> stop [exon|Could not connect to display #{fallbackDisplay}|] +-- |Test whether the display manager has a default display available. noDisplayAvailable :: Members [Stop Text, Embed IO] r => GiGdk.DisplayManager -> diff --git a/lib/Helic/Interpreter/History.hs b/lib/Helic/Interpreter/History.hs --- a/lib/Helic/Interpreter/History.hs +++ b/lib/Helic/Interpreter/History.hs @@ -115,7 +115,7 @@ Int -> Sem r () logTruncation num = - Log.info [exon|removed #{show num} #{noun} from the history.|] + Log.debug [exon|removed #{show num} #{noun} from the history.|] where noun = if num == 1 then "entry" else "entries" diff --git a/lib/Helic/Net/Server.hs b/lib/Helic/Net/Server.hs --- a/lib/Helic/Net/Server.hs +++ b/lib/Helic/Net/Server.hs @@ -14,7 +14,8 @@ setInstallShutdownHandler, setPort, ) -import Network.Wai.Middleware.RequestLogger (logStdout) +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) @@ -33,6 +34,7 @@ serveWithContext, type (.++), ) +import System.Log.FastLogger (fromLogStr) newtype ApiError = ApiError { unApiError :: Text } @@ -41,7 +43,7 @@ data ServerReady = ServerReady - deriving (Eq, Show) + deriving stock (Eq, Show) logErrors :: Member Log r => @@ -83,4 +85,7 @@ setInstallShutdownHandler shut $ setGracefulShutdownTimeout (Just 0) $ defaultSettings - (<$ s) <$> Warp.runSettings settings (logStdout app) + log msg = + void (wv ((Log.debug (decodeUtf8 (fromLogStr msg))) <$ s)) + logger <- mkRequestLogger def { destination = Logger.Callback log } + (<$ s) <$> Warp.runSettings settings (logger app)