little-logger 0.1.0 → 0.2.0
raw patch · 4 files changed
+106/−26 lines, 4 filesdep +little-loggerdep +tastydep +tasty-hunitdep ~co-logdep ~co-log-coredep ~microlens
Dependencies added: little-logger, tasty, tasty-hunit
Dependency ranges changed: co-log, co-log-core, microlens, mtl, text
Files
- README.md +1/−1
- little-logger.cabal +27/−7
- src/LittleLogger.hs +22/−18
- test/Main.hs +56/−0
README.md view
@@ -2,4 +2,4 @@ [](https://circleci.com/gh/ejconlon/little-logger/tree/master) -Basic logging based on co-log. The difference is that our log action runs in IO, and we expect to use it in any IO-lifting monad.+Basic logging based on co-log. Meant to give you what you need to get started with a single module import.
little-logger.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 116369e1748442fb579db3e98e1e84bd8587dfe04d6f401f9cd571b200220673+-- hash: 04ccafa118c9aff9469b3f6df3b75e278af4e203909e6cbc86a24b134f6125d3 name: little-logger-version: 0.1.0+version: 0.2.0 synopsis: Basic logging based on co-log description: Please see the README on GitHub at <https://github.com/ejconlon/little-logger#readme> category: Logging@@ -36,9 +36,29 @@ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds build-depends: base >=4.12 && <5- , co-log >=0.4- , co-log-core >=0.2- , microlens >=0.4- , mtl >=2.2- , text >=1.2+ , co-log >=0.4 && <1+ , co-log-core >=0.2 && <1+ , microlens >=0.4 && <1+ , mtl >=2.2 && <3+ , text >=1.2 && <2+ default-language: Haskell2010++test-suite little-logger-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Paths_little_logger+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.12 && <5+ , co-log >=0.4 && <1+ , co-log-core >=0.2 && <1+ , little-logger+ , microlens >=0.4 && <1+ , mtl >=2.2 && <3+ , tasty >=1.2.3 && <2+ , tasty-hunit >=0.10.0.2 && <1+ , text >=1.2 && <2 default-language: Haskell2010
src/LittleLogger.hs view
@@ -1,14 +1,18 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Rank2Types #-} -{-| Basic logging based on co-log. The difference is that our log action runs in IO, and- we expect to use it in any IO-lifting monad. -}+-- | Basic logging based on co-log. Meant to give you what you need to get started with a single module import. module LittleLogger- ( LogApp (..)- , SimpleLogAction+ ( LogAction (..) , HasSimpleLog (..)+ , Message+ , Msg (..)+ , Severity (..)+ , SimpleLogAction , WithSimpleLog- , logAppLogAction , defaultSimpleLogAction+ , filterActionSeverity , logMsg , logDebug , logError@@ -16,7 +20,7 @@ , logInfo , logWarning , logWithSeverity- , newLogApp+ , runWithSimpleLogAction ) where import Colog.Actions (richMessageAction)@@ -25,11 +29,11 @@ import Colog.Message (Message, Msg (..)) import Control.Exception (Exception, displayException) import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.Reader (MonadReader (..))+import Control.Monad.Reader (MonadReader (..), ReaderT (..)) import Data.Text (Text) import qualified Data.Text as Text import GHC.Stack (HasCallStack, callStack, withFrozenCallStack)-import Lens.Micro (Lens', lens)+import Lens.Micro (Lens') import Lens.Micro.Extras (view) import Prelude @@ -38,11 +42,17 @@ class HasSimpleLog env where simpleLogL :: Lens' env SimpleLogAction +instance HasSimpleLog SimpleLogAction where+ simpleLogL = id+ type WithSimpleLog env m = (MonadIO m, MonadReader env m, HasSimpleLog env, HasCallStack) defaultSimpleLogAction :: SimpleLogAction defaultSimpleLogAction = richMessageAction +filterActionSeverity :: Severity -> SimpleLogAction -> SimpleLogAction+filterActionSeverity lim (LogAction f) = LogAction (\msg -> if msgSeverity msg >= lim then f msg else pure ())+ logMsg :: WithSimpleLog env m => Message -> m () logMsg msg = do env <- ask@@ -67,13 +77,7 @@ logException :: (WithSimpleLog env m, Exception e) => e -> m () logException = withFrozenCallStack (logError . Text.pack . displayException) -newtype LogApp = LogApp { _logAppLogAction :: SimpleLogAction }--logAppLogAction :: Lens' LogApp SimpleLogAction-logAppLogAction = lens _logAppLogAction (const LogApp)--instance HasSimpleLog LogApp where- simpleLogL = logAppLogAction--newLogApp :: LogApp-newLogApp = LogApp defaultSimpleLogAction+-- | Usually 'm' will be some kind of 'Reader' monad. In the case where you don't care what it+-- is and you only need to do logging and IO, you can use this.+runWithSimpleLogAction :: SimpleLogAction -> (forall env m. WithSimpleLog env m => m a) -> IO a+runWithSimpleLogAction = flip runReaderT
+ test/Main.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}++module Main (main) where++import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Data.Text (Text)+import LittleLogger (LogAction (LogAction), Msg (msgSeverity, msgText), Severity (..), SimpleLogAction, WithSimpleLog,+ filterActionSeverity, logDebug, logError, logInfo, logWarning, runWithSimpleLogAction)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++emitLogs :: WithSimpleLog env m => m ()+emitLogs = do+ logDebug "debug"+ logInfo "info"+ logWarning "warning"+ logError "error"++refAction :: IORef [(Severity, Text)] -> SimpleLogAction+refAction ref = LogAction (\msg -> modifyIORef' ref (++ [(msgSeverity msg, msgText msg)]))++runWithRefAction :: (SimpleLogAction -> SimpleLogAction) -> (forall env m. WithSimpleLog env m => m ()) -> IO [(Severity, Text)]+runWithRefAction f m = do+ ref <- newIORef []+ let action = f (refAction ref)+ runWithSimpleLogAction action m+ readIORef ref++expectedFiltered :: [(Severity, Text)]+expectedFiltered =+ [ (Warning, "warning")+ , (Error, "error")+ ]++expectedUnfiltered :: [(Severity, Text)]+expectedUnfiltered =+ [ (Debug, "debug")+ , (Info, "info")+ ] ++ expectedFiltered++testUnfiltered :: TestTree+testUnfiltered = testCase "Unfiltered" $ do+ actual <- runWithRefAction id emitLogs+ actual @?= expectedUnfiltered++testFiltered :: TestTree+testFiltered = testCase "Filtered" $ do+ actual <- runWithRefAction (filterActionSeverity Warning) emitLogs+ actual @?= expectedFiltered++main :: IO ()+main = defaultMain $ testGroup "LittleLogger" $+ [ testUnfiltered+ , testFiltered+ ]