packages feed

polysemy-log-co (empty) → 0.1.0.0

raw patch · 11 files changed

+588/−0 lines, 11 filesdep +basedep +co-logdep +co-log-core

Dependencies added: base, co-log, co-log-core, co-log-polysemy, hedgehog, polysemy, polysemy-log, polysemy-log-co, polysemy-test, polysemy-time, relude, string-interpolate, tasty, tasty-hedgehog, text, time

Files

+ Changelog.md view
+ LICENSE view
@@ -0,0 +1,34 @@+Copyright (c) 2020 Torsten Schmits++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met:++  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+  disclaimer.+  2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+  disclaimer in the documentation and/or other materials provided with the distribution.++Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:++  (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+  contributors, in source or binary form) alone; or+  (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+  copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+  be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.++Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise.++DISCLAIMER++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ lib/Polysemy/Log/Colog.hs view
@@ -0,0 +1,44 @@+-- |Description: /polysemy-log/ adapters for /co-log/+module Polysemy.Log.Colog (+  -- * Introduction+  -- $intro++  -- * Interpreters+  interpretLogStdout,+  interpretLogStdoutAsNative,+  interpretLogColog,+  interpretLogColog',+  interpretDataLogColog,+  interpretCologConc,+  interpretCologConcWith,+  interpretCologAtomic,+  interpretCologAtomic'+) where++import Polysemy.Log.Colog.Colog (+  interpretLogStdout,+  interpretLogColog,+  interpretLogStdoutAsNative,+  interpretLogColog',+  interpretDataLogColog,+  )+import Polysemy.Log.Colog.Conc (interpretCologConc, interpretCologConcWith)+import Polysemy.Log.Colog.Atomic (interpretCologAtomic, interpretCologAtomic')++-- $intro+-- This package is a [co-log](https://hackage.haskell.org/package/co-log-polysemy) adapter for+-- [polysemy-log](https://hackage.haskell.org/package/polysemy-log), providing interpreters that convert+-- 'Polysemy.Log.Log' and 'Polysemy.Log.DataLog' into 'Colog.Polysemy.Log' actions.+--+-- @+-- import Polysemy.Log+-- import Polysemy.Log.Colog+--+-- prog :: Member Log r => Sem r ()+-- prog = do+--   Log.debug "debugging"+--   Log.error "failing"+--+-- interpretLogColog prog :: Sem [Colog.Log (LogEntry LogMessage), Embed IO] ()+-- interpretLogStdout prog :: Sem '[Embed IO] ()+-- @
+ lib/Polysemy/Log/Colog/Atomic.hs view
@@ -0,0 +1,27 @@+-- |Description: Internal+module Polysemy.Log.Colog.Atomic where++import qualified Colog.Polysemy as Colog++import Polysemy.Internal (InterpretersFor)++-- |Interpret 'Colog.Log' by prepending each message to a list in an 'AtomicState'.+interpretCologAtomic' ::+  ∀ a r .+  Member (AtomicState [a]) r =>+  InterpreterFor (Colog.Log a) r+interpretCologAtomic' =+  interpret \case+    Colog.Log msg -> atomicModify' (msg :)+{-# INLINE interpretCologAtomic' #-}++-- |Interpret 'Colog.Log' by prepending each message to a list in an 'AtomicState', then interpret the 'AtomicState' in+-- a 'TVar'.+interpretCologAtomic ::+  ∀ a r .+  Member (Embed IO) r =>+  InterpretersFor [Colog.Log a, AtomicState [a]] r+interpretCologAtomic sem = do+  tv <- newTVarIO []+  runAtomicStateTVar tv (interpretCologAtomic' sem)+{-# INLINE interpretCologAtomic #-}
+ lib/Polysemy/Log/Colog/Colog.hs view
@@ -0,0 +1,142 @@+-- |Description: Interpreters+module Polysemy.Log.Colog.Colog where++import qualified Colog (Message, Msg(Msg), Severity(..), logTextStdout, richMessageAction)+import qualified Colog.Polysemy as Colog+import Colog.Polysemy (runLogAction)+import Polysemy.Internal (InterpretersFor)+import Polysemy.Time (GhcTime, interpretTimeGhc)++import Polysemy.Log.Data.DataLog (DataLog(DataLog))+import Polysemy.Log.Data.Log (Log)+import Polysemy.Log.Data.LogEntry (LogEntry (LogEntry))+import Polysemy.Log.Data.LogMessage (LogMessage(..))+import qualified Polysemy.Log.Data.Severity as Severity+import Polysemy.Log.Data.Severity (Severity)+import Polysemy.Log.Format (formatLogEntry)+import Polysemy.Log.Log (interpretLogDataLog)++-- |Convert 'Severity' into the /co-log/ variant, 'Colog.Severity'.+-- 'Severity.Trace' is conflated with 'Colog.Debug', and 'Severity.Crit' into 'Colog.Error'.+severityToColog ::+  Severity ->+  Colog.Severity+severityToColog = \case+  Severity.Trace -> Colog.Debug+  Severity.Debug -> Colog.Debug+  Severity.Info -> Colog.Info+  Severity.Warn -> Colog.Warning+  Severity.Error -> Colog.Error+  Severity.Crit -> Colog.Error+{-# INLINE severityToColog #-}++-- |Convert a default log message into the /co-log/-native 'Colog.Message'.+toColog :: LogEntry LogMessage -> Colog.Message+toColog (LogEntry LogMessage {..} _ source) =+  Colog.Msg (severityToColog severity) source message+{-# INLINE toColog #-}++-- |Reinterpret 'DataLog' as 'Colog.Log'.+interpretDataLogColog ::+  ∀ a r .+  Member (Colog.Log a) r =>+  InterpreterFor (DataLog a) r+interpretDataLogColog =+  interpret \case+    DataLog msg -> Colog.log msg+{-# INLINE interpretDataLogColog #-}++-- |Reinterpret 'DataLog', specialized to the default message, as 'Colog.Log'.+interpretDataLogNative ::+  Member (Colog.Log Colog.Message) r =>+  InterpreterFor (DataLog (LogEntry LogMessage)) r+interpretDataLogNative =+  interpret \case+    DataLog msg -> Colog.log (toColog msg)+{-# INLINE interpretDataLogNative #-}++-- |Reinterpret 'Log' as 'Colog.Log', using the /polysemy-log/ default message.+--+-- Since this adds a timestamp, it has a dependency on 'GhcTime'.+-- Use 'interpretLogColog'' for a variant that interprets 'GhcTime' in-place.+interpretLogColog ::+  Members [Colog.Log (LogEntry LogMessage), GhcTime] r =>+  InterpreterFor Log r+interpretLogColog =+  interpretDataLogColog @(LogEntry LogMessage) .+  interpretLogDataLog .+  raiseUnder+{-# INLINE interpretLogColog #-}++-- |Reinterpret 'Log' as 'Colog.Log', also interpreting 'GhcTime'.+interpretLogColog' ::+  Members [Colog.Log (LogEntry LogMessage), Embed IO] r =>+  InterpretersFor [Log, GhcTime] r+interpretLogColog' =+  interpretTimeGhc . interpretLogColog+{-# INLINE interpretLogColog' #-}++-- |Interpret 'Colog.Log' by printing to stdout, using the provided message formatter.+interpretCologStdoutFormat ::+  ∀ msg m r .+  MonadIO m =>+  Member (Embed m) r =>+  (msg -> Text) ->+  InterpreterFor (Colog.Log msg) r+interpretCologStdoutFormat format =+  runLogAction @m (contramap format Colog.logTextStdout)+{-# INLINE interpretCologStdoutFormat #-}++-- |Interpret 'Colog.Log' with the default message by printing to stdout, using the default message formatter.+interpretCologStdout ::+  ∀ m r .+  MonadIO m =>+  Member (Embed m) r =>+  InterpreterFor (Colog.Log (LogEntry LogMessage)) r+interpretCologStdout =+  interpretCologStdoutFormat @_ @m formatLogEntry+{-# INLINE interpretCologStdout #-}++-- |Interpret 'Log' fully in terms of 'Colog.Log', using the default message and stdout.+interpretLogStdout ::+  Member (Embed IO) r =>+  InterpreterFor Log r+interpretLogStdout =+  interpretCologStdout @IO .+  interpretTimeGhc .+  interpretDataLogColog @(LogEntry LogMessage) .+  interpretLogDataLog .+  raiseUnder3+{-# INLINE interpretLogStdout #-}++-- |Interpret 'Colog.Log' with the /co-log/ message protocol by printing to stdout, using /co-log/'s rich message+-- formatter.+interpretCologStdoutNative ::+  ∀ m r .+  MonadIO m =>+  Member (Embed m) r =>+  InterpreterFor (Colog.Log Colog.Message) r+interpretCologStdoutNative =+  runLogAction @m Colog.richMessageAction+{-# INLINE interpretCologStdoutNative #-}++-- |Reinterpret 'Log' as 'Colog.Log', using the /co-log/ message protocol.+interpretLogCologAsNative ::+  Members [Colog.Log Colog.Message, GhcTime] r =>+  InterpreterFor Log r+interpretLogCologAsNative =+  interpretDataLogNative .+  interpretLogDataLog .+  raiseUnder+{-# INLINE interpretLogCologAsNative #-}++-- |Interpret 'Log' fully in terms of 'Colog.Log', using /co-log/'s message protocol and stdout.+interpretLogStdoutAsNative ::+  Member (Embed IO) r =>+  InterpretersFor [Log, Colog.Log Colog.Message] r+interpretLogStdoutAsNative =+  interpretCologStdoutNative @IO .+  interpretTimeGhc .+  interpretLogCologAsNative .+  raiseUnder+{-# INLINE interpretLogStdoutAsNative #-}
+ lib/Polysemy/Log/Colog/Conc.hs view
@@ -0,0 +1,33 @@+-- |Description: Internal+module Polysemy.Log.Colog.Conc where++import qualified Colog+import Colog (LogAction, convertToLogAction, defCapacity, forkBackgroundLogger, killBackgroundLogger)+import Colog.Concurrent.Internal (Capacity)+import qualified Colog.Polysemy as Colog+import Colog.Polysemy (runLogAction)+import Polysemy.Resource (Resource, bracket)++import Polysemy.Log.Data.LogEntry (LogEntry)+import Polysemy.Log.Data.LogMessage (LogMessage)+import Polysemy.Log.Format (formatLogEntry)++-- |Interpret 'Colog.Log' using /co-log/'s concurrent logger with the provided 'LogAction'.+interpretCologConcWith ::+  ∀ msg r .+  Members [Resource, Embed IO] r =>+  Capacity ->+  LogAction IO msg ->+  InterpreterFor (Colog.Log msg) r+interpretCologConcWith capacity action sem = do+  bracket (embed (forkBackgroundLogger capacity action)) (embed . killBackgroundLogger) run+  where+    run worker =+      runLogAction (convertToLogAction @IO worker) sem++-- |Interpret 'Colog.Log' using /co-log/'s concurrent logger with the default message and formatting.+interpretCologConc ::+  Members [Resource, Embed IO] r =>+  InterpreterFor (Colog.Log (LogEntry LogMessage)) r+interpretCologConc =+  interpretCologConcWith defCapacity (contramap formatLogEntry Colog.logTextStdout)
+ polysemy-log-co.cabal view
@@ -0,0 +1,206 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           polysemy-log-co+version:        0.1.0.0+synopsis:       polysemy-log interpreter for co-log+description:    See <https://hackage.haskell.org/package/polysemy-log-co/docs/Polysemy-Log-Colog.html>+category:       Logging+homepage:       https://github.com/tek/polysemy-log#readme+bug-reports:    https://github.com/tek/polysemy-log/issues+author:         Torsten Schmits+maintainer:     tek@tryp.io+copyright:      2021 Torsten Schmits+license:        BSD-2-Clause-Patent+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    readme.md+    Changelog.md++source-repository head+  type: git+  location: https://github.com/tek/polysemy-log++library+  exposed-modules:+      Polysemy.Log.Colog+      Polysemy.Log.Colog.Atomic+      Polysemy.Log.Colog.Colog+      Polysemy.Log.Colog.Conc+  other-modules:+      Paths_polysemy_log_co+  autogen-modules:+      Paths_polysemy_log_co+  hs-source-dirs:+      lib+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedStrings+      OverloadedLists+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints+  build-depends:+      base ==4.*+    , co-log >=0.4.0.1 && <0.5+    , co-log-core >=0.2.1 && <0.3+    , co-log-polysemy >=0.0.1.2 && <0.1+    , polysemy >=1.3 && <1.5+    , polysemy-log+    , polysemy-time >=0.1.1.0 && <0.2+    , relude >=0.5 && <0.8+    , string-interpolate >=0.2.1+    , text+    , time+  mixins:+      base hiding (Prelude)+    , polysemy-log hiding (Polysemy.Log.Prelude)+    , polysemy-log (Polysemy.Log.Prelude as Prelude)+  default-language: Haskell2010++test-suite polysemy-log-co-unit+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Polysemy.Log.Colog.Test.ConcTest+      Polysemy.Log.Colog.Test.SimpleTest+      Paths_polysemy_log_co+  hs-source-dirs:+      test+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedStrings+      OverloadedLists+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base ==4.*+    , co-log >=0.4.0.1 && <0.5+    , co-log-core >=0.2.1 && <0.3+    , co-log-polysemy >=0.0.1.2 && <0.1+    , hedgehog+    , polysemy >=1.3 && <1.5+    , polysemy-log+    , polysemy-log-co+    , polysemy-test+    , polysemy-time >=0.1.1.0 && <0.2+    , relude >=0.5 && <0.8+    , string-interpolate >=0.2.1+    , tasty+    , tasty-hedgehog+    , text+    , time+  mixins:+      base hiding (Prelude)+    , polysemy-log hiding (Polysemy.Log.Prelude)+    , polysemy-log (Polysemy.Log.Prelude as Prelude)+  default-language: Haskell2010
+ readme.md view
@@ -0,0 +1,21 @@+# About++The *co-log* adapter for [polysemy-log](https://hackage.haskell.org/package/polysemy-log).++```haskell+import Polysemy.Log+import Polysemy.Log.Colog++prog :: Member Log r => Sem r ()+prog = do+  Log.debug "debugging"+  Log.error "failing"++interpretLogColog prog :: Sem [Colog.Log (LogEntry LogMessage), Embed IO] ()+interpretLogStdout prog :: Sem '[Embed IO] ()+```++For more documentation, please consult Hackage:+* [polysemy-log](https://hackage.haskell.org/package/polysemy-log)+* [polysemy-log-co](https://hackage.haskell.org/package/polysemy-log-co)+* [polysemy-log-di](https://hackage.haskell.org/package/polysemy-log-di)
+ test/Main.hs view
@@ -0,0 +1,17 @@+module Main where++import Polysemy.Log.Colog.Test.ConcTest (test_concColog)+import Polysemy.Log.Colog.Test.SimpleTest (test_simpleColog)+import Polysemy.Test (unitTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+  testGroup "colog" [+    unitTest "simple" test_simpleColog,+    unitTest "conc" test_concColog+  ]++main :: IO ()+main =+  defaultMain tests
+ test/Polysemy/Log/Colog/Test/ConcTest.hs view
@@ -0,0 +1,33 @@+module Polysemy.Log.Colog.Test.ConcTest where++import Colog (LogAction(LogAction), defCapacity)+import Polysemy.Test (UnitTest, assertEq, runTestAuto)++import Polysemy.Log.Colog.Colog (interpretLogColog')+import Polysemy.Log.Colog.Conc (interpretCologConcWith)+import qualified Polysemy.Log.Data.Log as Log+import Polysemy.Log.Data.Log (Log)+import qualified Polysemy.Log.Data.LogEntry as LogEntry+import Polysemy.Log.Data.LogEntry (LogEntry)+import Polysemy.Log.Data.LogMessage (LogMessage(LogMessage))+import qualified Polysemy.Log.Data.Severity as Severity++prog ::+  Member Log r =>+  Sem r ()+prog = do+  Log.debug "debug"+  Log.warn "warn"++target :: [LogMessage]+target =+  [LogMessage Severity.Warn "warn", LogMessage Severity.Debug "debug"]++test_concColog :: UnitTest+test_concColog =+  runTestAuto do+    tv <- newTVarIO []+    let action msg = atomically (modifyTVar' tv (msg :))+    interpretCologConcWith @(LogEntry LogMessage) defCapacity (LogAction action) (interpretLogColog' prog)+    msgs <- readTVarIO tv+    assertEq @_ @IO target (LogEntry.message <$> msgs)
+ test/Polysemy/Log/Colog/Test/SimpleTest.hs view
@@ -0,0 +1,31 @@+module Polysemy.Log.Colog.Test.SimpleTest where++import Polysemy.Test (UnitTest, assertEq, runTestAuto)+import Polysemy.Time (interpretTimeGhc)++import Polysemy.Log.Colog.Atomic (interpretCologAtomic)+import Polysemy.Log.Colog.Colog (interpretLogColog)+import qualified Polysemy.Log.Data.Log as Log+import Polysemy.Log.Data.Log (Log)+import qualified Polysemy.Log.Data.LogEntry as LogEntry (LogEntry(..))+import Polysemy.Log.Data.LogEntry (LogEntry)+import Polysemy.Log.Data.LogMessage (LogMessage(LogMessage))+import qualified Polysemy.Log.Data.Severity as Severity++prog ::+  Members [Log, AtomicState [LogEntry LogMessage]] r =>+  Sem r [LogEntry LogMessage]+prog = do+  Log.debug "debug"+  Log.warn "warn"+  atomicGet++target :: [LogMessage]+target =+  [LogMessage Severity.Warn "warn", LogMessage Severity.Debug "debug"]++test_simpleColog :: UnitTest+test_simpleColog =+  runTestAuto do+    msgs <- interpretCologAtomic @(LogEntry LogMessage) (interpretTimeGhc (interpretLogColog prog))+    assertEq @_ @IO target (LogEntry.message <$> msgs)