packages feed

polysemy-log-di (empty) → 0.1.0.0

raw patch · 9 files changed

+417/−0 lines, 9 filesdep +basedep +di-polysemydep +hedgehog

Dependencies added: base, di-polysemy, hedgehog, polysemy, polysemy-log, polysemy-log-di, 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/Di.hs view
@@ -0,0 +1,32 @@+-- |Description: /polysemy-log/ adapters for /di/+module Polysemy.Log.Di (+  -- * Introduction+  -- $intro++  -- * Interpreters+  interpretLogDi,+  interpretLogDi',+  interpretDataLogDi,+  interpretDiAtomic,+  interpretDiAtomic'+) where++import Polysemy.Log.Di.Di (interpretLogDi, interpretLogDi', interpretDataLogDi)+import Polysemy.Log.Di.Atomic (interpretDiAtomic', interpretDiAtomic)+-- $intro+-- This package is a [di](https://hackage.haskell.org/package/di-polysemy) adapter for+-- [polysemy-log](https://hackage.haskell.org/package/polysemy-log), providing interpreters that convert+-- 'Polysemy.Log.Log' and 'Polysemy.Log.DataLog' into 'DiPolysemy.Di' actions.+--+-- @+-- import Polysemy.Log+-- import Polysemy.Log.Di+--+-- prog :: Member Log r => Sem r ()+-- prog = do+--   Log.debug "debugging"+--   Log.error "failing"+--+-- interpretLogDi prog :: Sem [Di.Di Severity path (LogEntry LogMessage), Embed IO] ()+-- interpretLogStdout prog :: Sem '[Embed IO] ()+-- @
+ lib/Polysemy/Log/Di/Atomic.hs view
@@ -0,0 +1,31 @@+-- |Description: Internal+module Polysemy.Log.Di.Atomic where++import qualified DiPolysemy as Di+import Polysemy (interpretH, runTSimple)+import Polysemy.Internal (InterpretersFor)+import Polysemy.Internal.Tactics (liftT)++-- |Interpret 'Di.Di' by prepending each message to a list in an 'AtomicState'.+interpretDiAtomic' ::+  ∀ level path msg r .+  Member (AtomicState [msg]) r =>+  InterpreterFor (Di.Di level path msg) r+interpretDiAtomic' =+  interpretH \case+    Di.Log _ msg -> liftT (atomicModify' (msg :))+    Di.Flush -> pureT ()+    Di.Local _ ma -> runTSimple ma+    Di.Fetch -> pureT Nothing+{-# INLINE interpretDiAtomic' #-}++-- |Interpret 'Di.Di' by prepending each message to a list in an 'AtomicState', then interpret the+-- 'AtomicState' in a 'TVar'.+interpretDiAtomic ::+  ∀ level path msg r .+  Member (Embed IO) r =>+  InterpretersFor [Di.Di level path msg, AtomicState [msg]] r+interpretDiAtomic sem = do+  tv <- newTVarIO []+  runAtomicStateTVar tv (interpretDiAtomic' sem)+{-# INLINE interpretDiAtomic #-}
+ lib/Polysemy/Log/Di/Di.hs view
@@ -0,0 +1,53 @@+-- |Description: Internal+module Polysemy.Log.Di.Di where++import qualified DiPolysemy as Di+import Polysemy.Internal (InterpretersFor, raise2Under)+import Polysemy.Time (GhcTime)++import Polysemy.Log.Data.DataLog (DataLog(DataLog))+import Polysemy.Log.Data.Log (Log)+import qualified Polysemy.Log.Data.LogEntry as LogEntry+import Polysemy.Log.Data.LogEntry (LogEntry)+import qualified Polysemy.Log.Data.LogMessage as LogMessage+import Polysemy.Log.Data.LogMessage (LogMessage)+import Polysemy.Log.Data.Severity (Severity)+import Polysemy.Log.Log (interpretLogDataLog, interpretLogDataLog')++-- |Reinterpret 'DataLog' as 'Di.Di', using the provided function to extract the log level from the message.+interpretDataLogDi ::+  ∀ level path msg r .+  Member (Di.Di level path msg) r =>+  (msg -> level) ->+  InterpreterFor (DataLog msg) r+interpretDataLogDi extractLevel =+  interpret \case+    DataLog msg ->+      Di.log @_ @path (extractLevel msg) msg+{-# INLINE interpretDataLogDi #-}++-- |Reinterpret 'Log' as 'Di.Di', using the /polysemy-log/ default message.+--+-- Since this adds a timestamp, it has a dependency on 'GhcTime'.+-- Use 'interpretLogDi'' for a variant that interprets 'GhcTime' in-place.+interpretLogDi ::+  ∀ path r .+  Members [Di.Di Severity path (LogEntry LogMessage), GhcTime] r =>+  InterpreterFor Log r+interpretLogDi =+  interpretDataLogDi @_ @path (LogMessage.severity . LogEntry.message) .+  interpretLogDataLog .+  raiseUnder+{-# INLINE interpretLogDi #-}++-- |Reinterpret 'Log' as 'Di.Di', also interpreting 'GhcTime'.+interpretLogDi' ::+  ∀ path r .+  Members [Di.Di Severity path (LogEntry LogMessage), Embed IO] r =>+  InterpretersFor [Log, GhcTime] r+interpretLogDi' =+  interpretDataLogDi @_ @path (LogMessage.severity . LogEntry.message) .+  interpretLogDataLog' .+  raiseUnder .+  raise2Under+{-# INLINE interpretLogDi' #-}
+ polysemy-log-di.cabal view
@@ -0,0 +1,200 @@+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-di+version:        0.1.0.0+synopsis:       polysemy-log interpreter for di+description:    See <https://hackage.haskell.org/package/polysemy-log-di/docs/Polysemy-Log-Di.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.Di+      Polysemy.Log.Di.Atomic+      Polysemy.Log.Di.Di+  other-modules:+      Paths_polysemy_log_di+  autogen-modules:+      Paths_polysemy_log_di+  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.*+    , di-polysemy >=0.2.0.0 && <0.3+    , 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-di-unit+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Polysemy.Log.Di.Test.SimpleTest+      Paths_polysemy_log_di+  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.*+    , di-polysemy >=0.2.0.0 && <0.3+    , hedgehog+    , polysemy >=1.3 && <1.5+    , polysemy-log+    , polysemy-log-di+    , 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 *di* adapter for [polysemy-log](https://hackage.haskell.org/package/polysemy-log).++```haskell+import Polysemy.Log+import Polysemy.Log.Di++prog :: Member Log r => Sem r ()+prog = do+  Log.debug "debugging"+  Log.error "failing"++interpretLogDi prog :: Sem [Di.Di Severity path (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,15 @@+module Main where++import Polysemy.Log.Di.Test.SimpleTest (test_simpleDi)+import Polysemy.Test (unitTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+  testGroup "di" [+    unitTest "simple" test_simpleDi+  ]++main :: IO ()+main =+  defaultMain tests
+ test/Polysemy/Log/Di/Test/SimpleTest.hs view
@@ -0,0 +1,31 @@+module Polysemy.Log.Di.Test.SimpleTest where++import Polysemy.Test (UnitTest, assertEq, runTestAuto)++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+import Polysemy.Log.Data.Severity (Severity)+import Polysemy.Log.Di.Atomic (interpretDiAtomic)+import Polysemy.Log.Di.Di (interpretLogDi')++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_simpleDi :: UnitTest+test_simpleDi = do+  runTestAuto do+    msgs <- interpretDiAtomic @Severity @() @(LogEntry LogMessage) (interpretLogDi' @() prog)+    assertEq @_ @IO target (LogEntry.message <$> msgs)