yet-another-logger 0.0.1 → 0.1

raw patch · 6 files changed

+66/−64 lines, 6 files

Files

• CHANGELOG.md +13/−0
• src/System/Logger/Internal.hs +0/−12
• src/System/Logger/Logger.hs +0/−14
• src/System/Logger/Logger/Internal.hs +11/−16
• src/System/Logger/Types.hs +40/−20
• yet-another-logger.cabal +2/−2

@@ -1,3 +1,16 @@+0.1+===++*   Added `localScope` function to `MonadLog` and and implemented `withLabel`+    based on it.++*   Added functions `popLabel` and `clearScope`. These are useful when setting+    log-labels for bracket style functions.++*   Remove overlapping `MonadLog` instances.++*   Lift `MonadTrace` instances into `LoggerCtxT`.+ 0.0.1 ===== 

@@ -24,18 +24,6 @@ -- Stability: experimental -- -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE UnicodeSyntax #-}  module System.Logger.Internal

@@ -32,20 +32,6 @@ -- The definitions in "System.Logger.Types" are re-exported by this module. -- -{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE OverlappingInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnicodeSyntax #-}  module System.Logger.Logger

@@ -31,19 +31,14 @@ -- module as an example and starting point. -- -{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE OverlappingInstances #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnicodeSyntax #-} @@ -301,14 +296,14 @@ -- > withConsoleLogger -- >     ∷ (MonadIO m, MonadBaseControl IO m) -- >     ⇒ LogLevel--- >     → (LoggerT T.Text m α)+-- >     → LoggerT T.Text m α -- >     → m α--- > withConsoleLogger level = do--- >     backend ← mkHandleLoggerBackend $ config ^. loggerConfigBackend--- >     withLogger config backend ∘ flip runLoggerT--- >   where--- >     config = defaultLoggerConfig--- >         & loggerConfigThreshold .~ level+-- > withConsoleLogger level inner = do+-- >    withHandleBackend (config ^. logConfigBackend) $ \backend →+-- >        withLogger (config ^. logConfigLogger) backend $ runLoggerT inner+-- >  where+-- >    config = defaultLogConfig+-- >        & logConfigLogger ∘ loggerConfigThreshold .~ level -- withLogger     ∷ (MonadIO μ, MonadBaseControl IO μ)

@@ -25,15 +25,15 @@ -- Stability: experimental -- +{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -76,6 +76,9 @@  -- * MonadLog , MonadLog(..)+, withLabel+, clearScope+, popLabel  ) where @@ -89,6 +92,7 @@ import Control.Monad.Trans.Control import Control.Monad.Trans.Either import Control.Monad.State+import Control.Monad.Trace import Control.Monad.Trans.Trace import Control.Monad.Writer import Control.Monad.Unicode@@ -268,87 +272,98 @@ class Monad m ⇒ MonadLog a m | m → a where     logg ∷ LogFunction a m     withLevel ∷ LogLevel → m α → m α-    withLabel ∷ LogLabel → m α → m α     withPolicy ∷ LogPolicy → m α → m α+    localScope ∷ (LogScope → LogScope) → m α → m α +withLabel ∷ MonadLog a m ⇒ LogLabel → m α → m α+withLabel = localScope ∘ (:)++popLabel ∷ MonadLog a m ⇒ m α → m α+popLabel = localScope $ \case { [] → []; (_:t) → t }++clearScope ∷ MonadLog a m ⇒ m α → m α+clearScope = localScope $ const []++{- -- Not sure if this instance is a good idea instance (Show a, Typeable a, NFData a, MonadIO m, LoggerCtx ctx a, MonadReader ctx m) ⇒ MonadLog a m where     logg l m = ask ≫= \ctx → liftIO (loggerFunIO ctx l m)     withLevel level = local $ setLoggerLevel .~ level-    withLabel label = local $ setLoggerScope %~ (:) label     withPolicy policy = local $ setLoggerPolicy .~ policy+    localScope = local ∘ over setLoggerScope      {-# INLINE logg #-}     {-# INLINE withLevel #-}-    {-# INLINE withLabel #-}     {-# INLINE withPolicy #-}+    {-# INLINE localScope #-}  -- Not sure if this instance is a good idea instance MonadLog a m ⇒ MonadLog a (ReaderT σ m) where     logg l = lift ∘ logg l     withLevel level inner = liftWith (\run → withLevel level (run inner)) ≫= restoreT ∘ return-    withLabel label inner = liftWith (\run → withLabel label (run inner)) ≫= restoreT ∘ return     withPolicy policy inner = liftWith (\run → withPolicy policy (run inner)) ≫= restoreT ∘ return+    localScope f inner = liftWith (\run → localScope f (run inner)) ≫= restoreT ∘ return      {-# INLINE logg #-}     {-# INLINE withLevel #-}-    {-# INLINE withLabel #-}     {-# INLINE withPolicy #-}+    {-# INLINE localScope #-}+-}  instance (Monoid σ, MonadLog a m) ⇒ MonadLog a (WriterT σ m) where     logg l = lift ∘ logg l     withLevel level inner = liftWith (\run → withLevel level (run inner)) ≫= restoreT ∘ return-    withLabel label inner = liftWith (\run → withLabel label (run inner)) ≫= restoreT ∘ return     withPolicy policy inner = liftWith (\run → withPolicy policy (run inner)) ≫= restoreT ∘ return+    localScope f inner = liftWith (\run → localScope f (run inner)) ≫= restoreT ∘ return      {-# INLINE logg #-}     {-# INLINE withLevel #-}-    {-# INLINE withLabel #-}     {-# INLINE withPolicy #-}+    {-# INLINE localScope #-}  instance (MonadLog a m) ⇒ MonadLog a (ExceptT ε m) where     logg l = lift ∘ logg l     withLevel level inner = liftWith (\run → withLevel level (run inner)) ≫= restoreT ∘ return-    withLabel label inner = liftWith (\run → withLabel label (run inner)) ≫= restoreT ∘ return     withPolicy policy inner = liftWith (\run → withPolicy policy (run inner)) ≫= restoreT ∘ return+    localScope f inner = liftWith (\run → localScope f (run inner)) ≫= restoreT ∘ return      {-# INLINE logg #-}     {-# INLINE withLevel #-}-    {-# INLINE withLabel #-}     {-# INLINE withPolicy #-}+    {-# INLINE localScope #-}  instance (MonadLog a m) ⇒ MonadLog a (StateT σ m) where     logg l = lift ∘ logg l     withLevel level inner = liftWith (\run → withLevel level (run inner)) ≫= restoreT ∘ return-    withLabel label inner = liftWith (\run → withLabel label (run inner)) ≫= restoreT ∘ return     withPolicy policy inner = liftWith (\run → withPolicy policy (run inner)) ≫= restoreT ∘ return+    localScope f inner = liftWith (\run → localScope f (run inner)) ≫= restoreT ∘ return      {-# INLINE logg #-}     {-# INLINE withLevel #-}-    {-# INLINE withLabel #-}     {-# INLINE withPolicy #-}+    {-# INLINE localScope #-}  instance (MonadLog a m) ⇒ MonadLog a (TraceT t e m) where     logg l = lift ∘ logg l     withLevel level inner = liftWith (\run → withLevel level (run inner)) ≫= restoreT ∘ return-    withLabel label inner = liftWith (\run → withLabel label (run inner)) ≫= restoreT ∘ return     withPolicy policy inner = liftWith (\run → withPolicy policy (run inner)) ≫= restoreT ∘ return+    localScope f inner = liftWith (\run → localScope f (run inner)) ≫= restoreT ∘ return      {-# INLINE logg #-}     {-# INLINE withLevel #-}-    {-# INLINE withLabel #-}     {-# INLINE withPolicy #-}+    {-# INLINE localScope #-}  instance (MonadLog a m) ⇒ MonadLog a (EitherT σ m) where     logg l = lift ∘ logg l     withLevel level inner = liftWith (\run → withLevel level (run inner)) ≫= restoreT ∘ return-    withLabel label inner = liftWith (\run → withLabel label (run inner)) ≫= restoreT ∘ return     withPolicy policy inner = liftWith (\run → withPolicy policy (run inner)) ≫= restoreT ∘ return+    localScope f inner = liftWith (\run → localScope f (run inner)) ≫= restoreT ∘ return      {-# INLINE logg #-}     {-# INLINE withLevel #-}-    {-# INLINE withLabel #-}     {-# INLINE withPolicy #-}+    {-# INLINE localScope #-}  {- -- Uses @OverlappingInstances@ to lift MonadLog in all transformers with an@@ -407,8 +422,13 @@     {-# INLINE withLoggerPolicy #-}  newtype LoggerCtxT ctx m α = LoggerCtxT { unLoggerCtxT ∷ ReaderT ctx m α }-    deriving (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadReader ctx, MonadError a, MonadState a, MonadWriter a, MonadBase a)+    deriving (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadReader ctx, MonadError a, MonadState a, MonadWriter a, MonadBase a, MonadTrace t) +-- This should eventually be defined in Control.Monad.Trace.Class+instance (Monad m, MonadTrace t m) ⇒ MonadTrace t (ReaderT ctx m) where+    traceScope s inner = liftWith (\run → traceScope s (run inner)) ≫= restoreT ∘ return+    readTrace = lift readTrace+ instance MonadTransControl (LoggerCtxT ctx) where     type StT (LoggerCtxT ctx) a = StT (ReaderT ctx) a     liftWith = defaultLiftWith LoggerCtxT unLoggerCtxT@@ -428,11 +448,11 @@ instance (Show a, Typeable a, NFData a, MonadIO m, LoggerCtx ctx a) ⇒ MonadLog a (LoggerCtxT ctx m) where     logg l m = ask ≫= \ctx → liftIO (loggerFunIO ctx l m)     withLevel level = local $ setLoggerLevel .~ level-    withLabel label = local $ setLoggerScope %~ (:) label     withPolicy policy = local $ setLoggerPolicy .~ policy+    localScope f = local $ setLoggerScope %~ f      {-# INLINE logg #-}     {-# INLINE withLevel #-}-    {-# INLINE withLabel #-}     {-# INLINE withPolicy #-}+    {-# INLINE localScope #-} 

@@ -1,5 +1,5 @@ Name: yet-another-logger-Version: 0.0.1+Version: 0.1 Synopsis: Yet Another Logger Description:     A logging framework written with flexibility and performance@@ -73,7 +73,7 @@     type: git     location: https://github.com/alephcloud/hs-yet-another-logger     branch: master-    tag: 0.0.1+    tag: 0.1  Library     default-language: Haskell2010