little-logger 0.3.2 → 1.0.0
raw patch · 6 files changed
+149/−207 lines, 6 filesdep +monad-loggerdep −co-logdep −co-log-core
Dependencies added: monad-logger
Dependencies removed: co-log, co-log-core
Files
- little-logger.cabal +13/−10
- src/LittleLogger.hs +116/−9
- src/LittleLogger/Common.hs +0/−62
- src/LittleLogger/Manual.hs +0/−39
- src/LittleLogger/Reader.hs +0/−65
- test/Main.hs +20/−22
little-logger.cabal view
@@ -3,11 +3,9 @@ -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 110790790f5c519685b242fae0c899af7c2e6b43e4528a46e120286c9f8410c0 name: little-logger-version: 0.3.2+version: 1.0.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@@ -29,19 +27,20 @@ library exposed-modules: LittleLogger- LittleLogger.Manual- LittleLogger.Reader other-modules:- LittleLogger.Common Paths_little_logger hs-source-dirs: src+ default-extensions:+ ConstraintKinds+ DerivingStrategies+ DerivingVia+ GeneralizedNewtypeDeriving 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 && <1- , co-log-core >=0.2 && <1 , microlens >=0.4 && <1+ , monad-logger ==0.3.* , mtl >=2.2 && <3 , text >=1.2 && <2 , unliftio-core >=0.1.2.0 && <2@@ -54,14 +53,18 @@ Paths_little_logger hs-source-dirs: test+ default-extensions:+ ConstraintKinds+ DerivingStrategies+ DerivingVia+ GeneralizedNewtypeDeriving 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 , directory >=1.3.6.0 && <1.4 , little-logger , microlens >=0.4 && <1+ , monad-logger ==0.3.* , mtl >=2.2 && <3 , tasty >=1.2.3 && <2 , tasty-hunit >=0.10.0.2 && <1
src/LittleLogger.hs view
@@ -1,12 +1,119 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE Rank2Types #-}---- | Basic logging based on co-log. Meant to give you what you need to get started with a single module import.--- The root module exports 'LittleLogger.Reader' for use with RIO-style stacks, but if you want to manually--- pass a 'SimpleLogAction' around, import 'LittleLogger.Manual' instead. module LittleLogger- ( module LittleLogger.Reader+ ( textLogStr+ , LogAction (..)+ , defaultLogAction+ , filterActionSeverity+ , newLogAction+ , runLogAction+ , handleLogAction+ , openLoggingHandle+ , closeLoggingHandle+ , fileLogAction+ , HasLogAction (..)+ , WithLogAction+ , askLogAction+ , LogActionWrapperM (..)+ , LogActionT (..)+ , runLogActionT+ , LogActionM+ , runLogActionM+ -- Re-exports+ , MonadLogger (..)+ , Loc (..)+ , LogSource+ , LogLevel (..)+ , LogStr+ , ToLogStr (..)+ , logDebugN+ , logInfoN+ , logWarnN+ , logErrorN+ , logOtherN ) where -import LittleLogger.Reader+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.IO.Unlift (MonadUnliftIO, askRunInIO)+import Control.Monad.Logger.CallStack (Loc (..), LogLevel (..), LogSource, LogStr, MonadLogger (..), ToLogStr (..),+ defaultOutput, fromLogStr, logDebugN, logErrorN, logInfoN, logOtherN, logWarnN)+import Control.Monad.Reader (MonadReader, ReaderT (..), asks)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import Lens.Micro (Lens')+import Lens.Micro.Extras (view)+import System.IO (BufferMode (LineBuffering), Handle, IOMode (AppendMode), hClose, hSetBuffering, openFile, stderr,+ withFile)++textLogStr :: LogStr -> Text+textLogStr = decodeUtf8 . fromLogStr++newtype LogAction = LogAction { unLogAction :: Loc -> LogSource -> LogLevel -> LogStr -> IO () }++instance Semigroup LogAction where+ LogAction act1 <> LogAction act2 = LogAction (\loc src lvl msg -> act1 loc src lvl msg >> act2 loc src lvl msg)++instance Monoid LogAction where+ mempty = LogAction (\_ _ _ _ -> pure ())+ mappend = (<>)++newLogAction :: MonadUnliftIO m => (Loc -> LogSource -> LogLevel -> LogStr -> m ()) -> m LogAction+newLogAction act = fmap (\run -> LogAction (\loc src lvl msg -> run (act loc src lvl msg))) askRunInIO++runLogAction :: MonadIO m => LogAction -> Loc -> LogSource -> LogLevel -> LogStr -> m ()+runLogAction (LogAction act) loc src lvl msg = liftIO (act loc src lvl msg)++defaultLogAction :: LogAction+defaultLogAction = LogAction (defaultOutput stderr)++filterActionSeverity :: LogLevel -> LogAction -> LogAction+filterActionSeverity lim (LogAction act) = LogAction (\loc src lvl msg -> if lvl >= lim then act loc src lvl msg else pure ())++handleLogAction :: Handle -> LogAction+handleLogAction = LogAction . defaultOutput++openLoggingHandle :: MonadIO m => FilePath -> m Handle+openLoggingHandle fp = do+ handle <- liftIO (openFile fp AppendMode)+ liftIO (hSetBuffering handle LineBuffering)+ pure handle++closeLoggingHandle :: MonadIO m => Handle -> m ()+closeLoggingHandle = liftIO . hClose++fileLogAction :: MonadUnliftIO m => FilePath -> (LogAction -> m a) -> m a+fileLogAction fp f = do+ run <- askRunInIO+ liftIO $ withFile fp AppendMode $ \handle -> do+ hSetBuffering handle LineBuffering+ run (f (handleLogAction handle))++class HasLogAction env where+ logActionL :: Lens' env LogAction++instance HasLogAction LogAction where+ logActionL = id++type WithLogAction env m = (MonadIO m, MonadReader env m, HasLogAction env)++askLogAction :: (MonadReader env m, HasLogAction env) => m LogAction+askLogAction = asks (view logActionL)++-- | Use deriving-via with this wrapper to add MonadLogger instances to your types+newtype LogActionWrapperM env m a = LogActionM { unLogActionM :: m a }+ deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader env)++instance WithLogAction env m => MonadLogger (LogActionWrapperM env m) where+ monadLoggerLog loc src lvl msg = do+ LogAction act <- askLogAction+ liftIO (act loc src lvl (toLogStr msg))++newtype LogActionT m a = LogActionT { unLogActionT :: ReaderT LogAction m a }+ deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader LogAction)+ deriving MonadLogger via (LogActionWrapperM LogAction (LogActionT m))++runLogActionT :: LogActionT m a -> LogAction -> m a+runLogActionT = runReaderT . unLogActionT++type LogActionM a = LogActionT IO a++runLogActionM :: LogActionM a -> LogAction -> IO a+runLogActionM = runLogActionT
− src/LittleLogger/Common.hs
@@ -1,62 +0,0 @@-module LittleLogger.Common- ( LogAction (..)- , Message- , Msg (..)- , Severity (..)- , SimpleLogAction- , defaultSimpleLogAction- , filterActionSeverity- , newSimpleLogAction- , runLogAction- , runSimpleLogAction- , handleSimpleLogAction- , openLoggingHandle- , closeLoggingHandle- , fileSimpleLogAction- ) where--import Colog.Actions (logByteStringHandle, richMessageAction)-import Colog.Core.Action (LogAction (..), cmapM)-import Colog.Core.Severity (Severity (..))-import Colog.Message (Message, Msg (..), defaultFieldMap, fmtRichMessageDefault, upgradeMessageAction)-import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.IO.Unlift (MonadUnliftIO, askRunInIO)-import Data.Text.Encoding (encodeUtf8)-import System.IO (BufferMode (LineBuffering), Handle, IOMode (AppendMode), hClose, hSetBuffering, openFile, withFile)--type SimpleLogAction = LogAction IO Message--newSimpleLogAction :: MonadUnliftIO m => (Message -> m ()) -> m SimpleLogAction-newSimpleLogAction f = fmap (\run -> LogAction (run . f)) askRunInIO--runSimpleLogAction :: MonadIO m => SimpleLogAction -> Message -> m ()-runSimpleLogAction = runLogAction--runLogAction :: MonadIO m => LogAction IO msg -> msg -> m ()-runLogAction (LogAction actIO) = liftIO . actIO--defaultSimpleLogAction :: SimpleLogAction-defaultSimpleLogAction = richMessageAction--filterActionSeverity :: Severity -> SimpleLogAction -> SimpleLogAction-filterActionSeverity lim (LogAction f) = LogAction (\msg -> if msgSeverity msg >= lim then f msg else pure ())--handleSimpleLogAction :: Handle -> SimpleLogAction-handleSimpleLogAction handle = upgradeMessageAction defaultFieldMap $- cmapM (fmap encodeUtf8 . fmtRichMessageDefault) (logByteStringHandle handle)--openLoggingHandle :: MonadIO m => FilePath -> m Handle-openLoggingHandle fp = do- handle <- liftIO (openFile fp AppendMode)- liftIO (hSetBuffering handle LineBuffering)- pure handle--closeLoggingHandle :: MonadIO m => Handle -> m ()-closeLoggingHandle = liftIO . hClose--fileSimpleLogAction :: MonadUnliftIO m => FilePath -> (SimpleLogAction -> m a) -> m a-fileSimpleLogAction fp f = do- run <- askRunInIO- liftIO $ withFile fp AppendMode $ \handle -> do- hSetBuffering handle LineBuffering- run (f (handleSimpleLogAction handle))
− src/LittleLogger/Manual.hs
@@ -1,39 +0,0 @@--- | A logging "backend" where you pass around the log action manually.-module LittleLogger.Manual- ( module LittleLogger.Common- , logMsg- , logDebug- , logError- , logException- , logInfo- , logWarning- , logWithSeverity- ) where--import Control.Exception (Exception, displayException)-import Control.Monad.IO.Class (MonadIO)-import Data.Text (Text)-import qualified Data.Text as Text-import GHC.Stack (HasCallStack, callStack, withFrozenCallStack)-import LittleLogger.Common--logMsg :: MonadIO m => SimpleLogAction -> Message -> m ()-logMsg = runSimpleLogAction--logWithSeverity :: (MonadIO m, HasCallStack) => SimpleLogAction -> Severity -> Text -> m ()-logWithSeverity act sev txt = withFrozenCallStack (logMsg act Msg { msgStack = callStack, msgSeverity = sev, msgText = txt })--logDebug :: (MonadIO m, HasCallStack) => SimpleLogAction -> Text -> m ()-logDebug act = withFrozenCallStack (logWithSeverity act Debug)--logInfo :: (MonadIO m, HasCallStack) => SimpleLogAction -> Text -> m ()-logInfo act = withFrozenCallStack (logWithSeverity act Info)--logWarning :: (MonadIO m, HasCallStack) => SimpleLogAction -> Text -> m ()-logWarning act = withFrozenCallStack (logWithSeverity act Warning)--logError :: (MonadIO m, HasCallStack) => SimpleLogAction -> Text -> m ()-logError act = withFrozenCallStack (logWithSeverity act Error)--logException :: (MonadIO m, Exception e, HasCallStack) => SimpleLogAction -> e -> m ()-logException act = withFrozenCallStack (logError act . Text.pack . displayException)
− src/LittleLogger/Reader.hs
@@ -1,65 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE Rank2Types #-}---- | A logging "backend" where you get the log action from the environment.-module LittleLogger.Reader- ( module LittleLogger.Common- , HasSimpleLog (..)- , WithSimpleLog- , logMsg- , logDebug- , logError- , logException- , logInfo- , logWarning- , logWithSeverity- , runWithSimpleLogAction- ) where--import Control.Exception (Exception, displayException)-import Control.Monad.IO.Class (MonadIO (..))-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')-import Lens.Micro.Extras (view)-import LittleLogger.Common--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)--logMsg :: WithSimpleLog env m => Message -> m ()-logMsg msg = do- env <- ask- let LogAction act = view simpleLogL env- liftIO (act msg)--logWithSeverity :: WithSimpleLog env m => Severity -> Text -> m ()-logWithSeverity sev txt = withFrozenCallStack (logMsg Msg { msgStack = callStack, msgSeverity = sev, msgText = txt })--logDebug :: WithSimpleLog env m => Text -> m ()-logDebug = withFrozenCallStack (logWithSeverity Debug)--logInfo :: WithSimpleLog env m => Text -> m ()-logInfo = withFrozenCallStack (logWithSeverity Info)--logWarning :: WithSimpleLog env m => Text -> m ()-logWarning = withFrozenCallStack (logWithSeverity Warning)--logError :: WithSimpleLog env m => Text -> m ()-logError = withFrozenCallStack (logWithSeverity Error)--logException :: (WithSimpleLog env m, Exception e) => e -> m ()-logException = withFrozenCallStack (logError . Text.pack . displayException)---- | 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
@@ -1,46 +1,44 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Rank2Types #-} module Main (main) where import Control.Exception (finally) import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Data.Text (Text)-import LittleLogger (LogAction (LogAction), Msg (msgSeverity, msgText), Severity (..), SimpleLogAction, WithSimpleLog,- fileSimpleLogAction, filterActionSeverity, logDebug, logError, logInfo, logWarning,- runWithSimpleLogAction)+import LittleLogger (LogAction (..), LogActionM, LogLevel (..), fileLogAction, filterActionSeverity, logDebugN,+ logErrorN, logInfoN, logWarnN, runLogActionM, textLogStr) import System.Directory (removeFile) import System.IO.Temp (emptySystemTempFile) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) -emitLogs :: WithSimpleLog env m => m ()+emitLogs :: LogActionM () emitLogs = do- logDebug "debug"- logInfo "info"- logWarning "warning"- logError "error"+ logDebugN "debug"+ logInfoN "info"+ logWarnN "warn"+ logErrorN "error" -refAction :: IORef [(Severity, Text)] -> SimpleLogAction-refAction ref = LogAction (\msg -> modifyIORef' ref (++ [(msgSeverity msg, msgText msg)]))+refAction :: IORef [(LogLevel, Text)] -> LogAction+refAction ref = LogAction (\_ _ lvl msg -> modifyIORef' ref (++ [(lvl, textLogStr msg)])) -runWithRefAction :: (SimpleLogAction -> SimpleLogAction) -> (forall env m. WithSimpleLog env m => m ()) -> IO [(Severity, Text)]+runWithRefAction :: (LogAction -> LogAction) -> (LogActionM ()) -> IO [(LogLevel, Text)] runWithRefAction f m = do ref <- newIORef [] let action = f (refAction ref)- runWithSimpleLogAction action m+ runLogActionM m action readIORef ref -expectedFiltered :: [(Severity, Text)]+expectedFiltered :: [(LogLevel, Text)] expectedFiltered =- [ (Warning, "warning")- , (Error, "error")+ [ (LevelWarn, "warn")+ , (LevelError, "error") ] -expectedUnfiltered :: [(Severity, Text)]+expectedUnfiltered :: [(LogLevel, Text)] expectedUnfiltered =- [ (Debug, "debug")- , (Info, "info")+ [ (LevelDebug, "debug")+ , (LevelInfo, "info") ] ++ expectedFiltered testUnfiltered :: TestTree@@ -50,17 +48,17 @@ testFiltered :: TestTree testFiltered = testCase "Filtered" $ do- actual <- runWithRefAction (filterActionSeverity Warning) emitLogs+ actual <- runWithRefAction (filterActionSeverity LevelWarn) emitLogs actual @?= expectedFiltered testFile :: TestTree testFile = testCase "File" $ do fp <- emptySystemTempFile "little-logger-test" flip finally (removeFile fp) $ do- fileSimpleLogAction fp (`runWithSimpleLogAction` emitLogs)+ fileLogAction fp (runLogActionM emitLogs) firstContents <- readFile fp length (lines firstContents) @?= 4- fileSimpleLogAction fp (`runWithSimpleLogAction` emitLogs)+ fileLogAction fp (runLogActionM emitLogs) secondContents <- readFile fp length (lines secondContents) @?= 8