diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,189 @@ +# ChangeLog for monad-logger + +## 0.3.42 + +* Forward compatibility with `-Wnoncanonical-monad-instances` becoming an error + +## 0.3.41 + +* Add `MonadAccum` instances for `LoggingT` and `NoLoggingT` + +## 0.3.40 + +* Relax `fast-logger` upper bound from 3.2 to 3.3 +* Add `Alternative` instances for `LoggingT` and `NoLoggingT` + +## 0.3.39 + +* Make the previous change backwards compatible with CPP + +## 0.3.38 + +* Drop old deprecated instances to support transformers 0.6 [#39](https://github.com/snoyberg/monad-logger/pull/39) + +## 0.3.37 + +* Add `Semigroup`/`Monoid` instances to `LoggingT`, `NoLoggingT`, and `WriterLoggingT` + +## 0.3.36 + +* Export the `defaultOutput` function, useful for defining custom instances of `MonadLogger`. [#29](https://github.com/snoyberg/monad-logger/pull/29) + +## 0.3.35 + +* Add Hackage status badge +* Document `Loc` [#26](https://github.com/snoyberg/monad-logger/pull/26) + +## 0.3.34 + +* Fix build for lts-9 resolver + +## 0.3.33 + +* Export `LogLine` type synonym. + +## 0.3.32 + +* Compat with `unliftio-core` 0.2 + +## 0.3.31 + +* Re-export `fromLogStr` to make implementing custom instances more convenient. + [#14](https://github.com/snoyberg/monad-logger/pull/14) + +## 0.3.30 + +* Added `MonadFail` instances for `LoggingT` and `NoLoggingT`. + +## 0.3.29 + +* Export mapLoggingT and mapNoLoggingT + +## 0.3.28.5 + +* Fix missing module [#1](https://github.com/snoyberg/monad-logger/issues/1) + +## 0.3.28.4 + +* Move to a new repo + +## 0.3.28.3 + +* Compat for older GHCs [#161](https://github.com/kazu-yamamoto/logger/pull/161) + +## 0.3.28.2 + +* Support for exceptions 0.9 and 0.10 [#158](https://github.com/kazu-yamamoto/logger/issues/158) +* Drop blaze-builder dependency + +## 0.3.28.1 + +* Fix support for GHC 7.8 [#154](https://github.com/kazu-yamamoto/logger/pull/154) + +## 0.3.28 + +* Added `WriterLoggingT` for collecting log lines and help with testing + +## 0.3.27 + +* Drop backwards compat with older library versions + +## 0.3.26 + +* Add `MonadUnliftIO` instances + +## 0.3.25.1 + +* Fix some incorrect `@since` comments + +## 0.3.25 + +* Export all CallStack log functions [#143](https://github.com/kazu-yamamoto/logger/pull/143) + +## 0.3.24 +* Added `MonadReader` instance for `NoLoggingT`. + +## 0.3.23 +* Changed `runFileLoggingT` buffering to line buffering. +* Added `defaultLog` and `logWithoutLoc` to list of exported functions. + +## 0.3.22 +* Added `runFileLoggingT`. + +## 0.3.21 + +* Reimplemented Functor & Applicative for LoggingT & NoLoggingT [#125](https://github.com/kazu-yamamoto/logger/issues/125) [#126](https://github.com/kazu-yamamoto/logger/pull/126) + +## 0.3.20.2 + +* Support for GHC 8.2 + +## 0.3.20.1 + +* Fix #106 by correcting the default signature for MonadLoggerIO [#108](https://github.com/kazu-yamamoto/logger/pull/108) + +## 0.3.20 + +* Generalize the type of `unChanLoggingT` + [#104](https://github.com/kazu-yamamoto/logger/pull/104) + +## 0.3.19 + +* Add CallStack-based functions and `Control.Monad.Logger.CallStack` module + +## 0.3.18 + +* Added logTHShow and logDebugSH, logInfoSH, etc. Accepts an argument of `Show a => a` instead of just `Text`. + +## 0.3.17 + +* log to a chan [#74](https://github.com/kazu-yamamoto/logger/pull/74) + +## 0.3.16 + +* Provide default monadLoggerLog implementation [#72](https://github.com/kazu-yamamoto/logger/pull/72) + +## 0.3.15 + +* Expose Loc constructor [#70](https://github.com/kazu-yamamoto/logger/pull/70) + +## 0.3.14 + +* Don't include source location for defaultLoc [#69](https://github.com/kazu-yamamoto/logger/issues/69) + +## 0.3.13.1 + +* Allow fast-logger 2.3 + +## 0.3.13 + +* Re-export LogStr from fast-logger [#56](https://github.com/kazu-yamamoto/logger/pull/56) +* Added `filterLogger` + +## 0.3.12 + +* Use transformers-compat to provide universal ExceptT support [#53](https://github.com/kazu-yamamoto/logger/pull/53) + +## 0.3.11.1 + +Add support for monad-control 1.0 [#52](https://github.com/kazu-yamamoto/logger/pull/52) + +## 0.3.11 + +Add missing `MonadState` and `MonadWriter` instances for `NoLoggingT` [#51](https://github.com/kazu-yamamoto/logger/pull/51) + +## 0.3.10.1 + +Remove unnecessary extra newline in log messages. + +## 0.3.10 + +Introduce the `MonadLoggerIO` typeclass. + +## 0.3.9 + +Add missing `MonadError NoLoggingT` instance #49 + +## 0.3.8 + +Simplify constraint on `MonadLogger (NoLoggingT m)` from `MonadIO m` to `Monad m` [Github issue #48](https://github.com/kazu-yamamoto/logger/issues/48). diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs --- a/Control/Monad/Logger.hs +++ b/Control/Monad/Logger.hs @@ -1,4 +1,10 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +#if WITH_CALLSTACK +{-# LANGUAGE ImplicitParams #-} +#endif #if WITH_TEMPLATE_HASKELL {-# LANGUAGE TemplateHaskell #-} #endif @@ -8,12 +14,14 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TupleSections #-} -- | This module provides the facilities needed for a decoupled logging system. -- -- The 'MonadLogger' class is implemented by monads that give access to a -- logging facility. If you're defining a custom monad, then you may define an -- instance of 'MonadLogger' that routes the log messages to the appropriate --- place (e.g., that's what @yesod-core@'s @GHandler@ does). Otherwise, you +-- place (e.g., that's what @yesod-core@'s @HandlerT@ does). Otherwise, you -- may use the 'LoggingT' monad included in this module (see -- 'runStderrLoggingT'). To simply discard log message, use 'NoLoggingT'. -- @@ -24,14 +32,29 @@ module Control.Monad.Logger ( -- * MonadLogger MonadLogger(..) + , MonadLoggerIO (..) , LogLevel(..) + , LogLine , LogSource - -- * Helper transformer + -- * Re-export from fast-logger + , LogStr + , ToLogStr(..) + , fromLogStr + -- * Helper transformers , LoggingT (..) , runStderrLoggingT , runStdoutLoggingT + , runChanLoggingT + , runFileLoggingT + , unChanLoggingT , withChannelLogger + , filterLogger , NoLoggingT (..) + , mapNoLoggingT + , WriterLoggingT (..) + , execWriterLoggingT + , runWriterLoggingT + , mapLoggingT #if WITH_TEMPLATE_HASKELL -- * TH logging , logDebug @@ -39,6 +62,12 @@ , logWarn , logError , logOther + -- * TH logging of showable values + , logDebugSH + , logInfoSH + , logWarnSH + , logErrorSH + , logOtherSH -- * TH logging with source , logDebugS , logInfoS @@ -55,52 +84,65 @@ , logErrorN , logOtherN -- * Non-TH logging with source + , logWithoutLoc , logDebugNS , logInfoNS , logWarnNS , logErrorNS , logOtherNS - +#if WITH_CALLSTACK + -- * Callstack logging + , logDebugCS + , logInfoCS + , logWarnCS + , logErrorCS + , logOtherCS +#endif -- * utilities for defining your own loggers , defaultLogStr - , Loc + -- $locDocs + , Loc (..) + , defaultLoc + , defaultOutput ) where #if WITH_TEMPLATE_HASKELL import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation) #endif +import Data.Functor ((<$>)) import Data.Monoid (Monoid) -import Control.Applicative (Applicative (..)) +import Control.Applicative (Alternative (..), Applicative (..)) +import Control.Concurrent.Chan (Chan(),writeChan,readChan) import Control.Concurrent.STM import Control.Concurrent.STM.TBChan -import Control.Exception.Lifted (onException) -import Control.Monad (liftM, ap, when, void) -import Control.Monad.Base (MonadBase (liftBase)) +import Control.Exception.Lifted (onException, bracket) +import Control.Monad (liftM, when, void, forever) +import Control.Monad.Base (MonadBase (liftBase), liftBaseDefault) +#if MIN_VERSION_base(4, 9, 0) +import qualified Control.Monad.Fail as Fail +#endif +import Control.Monad.IO.Unlift import Control.Monad.Loops (untilM) -import Control.Monad.Trans.Control (MonadBaseControl (..), MonadTransControl (..)) +import Control.Monad.Trans.Control (MonadBaseControl (..), MonadTransControl (..), ComposeSt, defaultLiftBaseWith, defaultRestoreM) import qualified Control.Monad.Trans.Class as Trans import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Resource (MonadResource (liftResourceT), MonadThrow, monadThrow) -#if MIN_VERSION_resourcet(1,1,0) -import Control.Monad.Trans.Resource (throwM) -import Control.Monad.Catch (MonadCatch (..) -#if MIN_VERSION_exceptions(0,6,0) - , MonadMask (..) -#endif - ) +import Control.Monad.Trans.Resource (MonadResource (liftResourceT)) +import Control.Monad.Catch (MonadThrow (..), MonadCatch (..), MonadMask (..) +#if MIN_VERSION_exceptions(0, 10, 0) + , ExitCase (..) #endif + ) import Control.Monad.Trans.Identity ( IdentityT) -import Control.Monad.Trans.List ( ListT ) import Control.Monad.Trans.Maybe ( MaybeT ) +#if !MIN_VERSION_transformers(0, 6, 0) +import Control.Monad.Trans.List ( ListT ) import Control.Monad.Trans.Error ( ErrorT, Error) - -#if MIN_VERSION_transformers(0,4,0) -import Control.Monad.Trans.Except ( ExceptT ) #endif +import Control.Monad.Trans.Except ( ExceptT ) import Control.Monad.Trans.Reader ( ReaderT ) import Control.Monad.Trans.Cont ( ContT ) @@ -120,7 +162,7 @@ import Data.Monoid (mappend, mempty) import System.Log.FastLogger -import System.IO (Handle, stdout, stderr) +import System.IO (Handle, IOMode(AppendMode), BufferMode(LineBuffering), openFile, hClose, hSetBuffering, stdout, stderr) import Control.Monad.Cont.Class ( MonadCont (..) ) import Control.Monad.Error.Class ( MonadError (..) ) @@ -128,25 +170,37 @@ import Control.Monad.Reader.Class ( MonadReader (..) ) import Control.Monad.State.Class ( MonadState (..) ) import Control.Monad.Writer.Class ( MonadWriter (..) ) - -import Blaze.ByteString.Builder (toByteString) - -import Prelude hiding (catch) +#if MIN_VERSION_mtl(2, 3, 1) +import Control.Monad.Accum ( MonadAccum (..) ) +#endif -#if !MIN_VERSION_fast_logger(2, 1, 0) && MIN_VERSION_bytestring(0, 10, 2) -import qualified Data.ByteString.Lazy as L -import Data.ByteString.Builder (toLazyByteString) +#if WITH_CALLSTACK +import GHC.Stack as GHC #endif -#if MIN_VERSION_conduit_extra(1,1,0) import Data.Conduit.Lazy (MonadActive, monadActive) -#endif data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text deriving (Eq, Prelude.Show, Prelude.Read, Ord) type LogSource = Text +-- $locDocs +-- +-- === Loc +-- +-- When @monad-logger@ is compiled with the @template_haskell@ flag set to true (the default), the 'Loc' below is a re-export from the @template-haskell@ package. +-- When the flag is false, the 'Loc' below is a copy of that data structure defined in @monad-logger@ itself. +-- +-- If you are making a library that: +-- +-- * Uses @monad-logger@ +-- * Uses 'Loc' in a type signature +-- * But doesn't need to depend on @template-haskell@ for other reasons +-- +-- You can import 'Loc' directly from this package, instead of adding an dependency on @template-haskell@ and importing from there. +-- This allows users to compile your package in environments that don't support @template-haskell@. + #if WITH_TEMPLATE_HASKELL instance Lift LogLevel where @@ -168,10 +222,29 @@ #endif +-- | A @Monad@ which has the ability to log messages in some manner. class Monad m => MonadLogger m where monadLoggerLog :: ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> m () + default monadLoggerLog :: (MonadLogger m', Trans.MonadTrans t, MonadLogger (t m'), ToLogStr msg, m ~ t m') + => Loc -> LogSource -> LogLevel -> msg -> m () + monadLoggerLog loc src lvl msg = Trans.lift $ monadLoggerLog loc src lvl msg +-- | An extension of @MonadLogger@ for the common case where the logging action +-- is a simple @IO@ action. The advantage of using this typeclass is that the +-- logging function itself can be extracted as a first-class value, which can +-- make it easier to manipulate monad transformer stacks, as an example. +-- +-- @since 0.3.10 +class (MonadLogger m, MonadIO m) => MonadLoggerIO m where + -- | Request the logging function itself. + -- + -- @since 0.3.10 + askLoggerIO :: m (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) + default askLoggerIO :: (Trans.MonadTrans t, MonadLoggerIO n, m ~ t n) + => m (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) + askLoggerIO = Trans.lift askLoggerIO + {- instance MonadLogger IO where monadLoggerLog _ _ _ = return () instance MonadLogger Identity where monadLoggerLog _ _ _ = return () @@ -181,14 +254,12 @@ #define DEF monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d instance MonadLogger m => MonadLogger (IdentityT m) where DEF +#if !MIN_VERSION_transformers(0, 6, 0) instance MonadLogger m => MonadLogger (ListT m) where DEF -instance MonadLogger m => MonadLogger (MaybeT m) where DEF instance (MonadLogger m, Error e) => MonadLogger (ErrorT e m) where DEF - -#if MIN_VERSION_transformers(0,4,0) -instance MonadLogger m => MonadLogger (ExceptT e m) where DEF #endif - +instance MonadLogger m => MonadLogger (MaybeT m) where DEF +instance MonadLogger m => MonadLogger (ExceptT e m) where DEF instance MonadLogger m => MonadLogger (ReaderT r m) where DEF instance MonadLogger m => MonadLogger (ContT r m) where DEF instance MonadLogger m => MonadLogger (StateT s m) where DEF @@ -202,11 +273,39 @@ instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF #undef DEF +instance MonadLoggerIO m => MonadLoggerIO (IdentityT m) +#if !MIN_VERSION_transformers(0, 6, 0) +instance MonadLoggerIO m => MonadLoggerIO (ListT m) +instance (MonadLoggerIO m, Error e) => MonadLoggerIO (ErrorT e m) +#endif +instance MonadLoggerIO m => MonadLoggerIO (MaybeT m) +instance MonadLoggerIO m => MonadLoggerIO (ExceptT e m) +instance MonadLoggerIO m => MonadLoggerIO (ReaderT r m) +instance MonadLoggerIO m => MonadLoggerIO (ContT r m) +instance MonadLoggerIO m => MonadLoggerIO (StateT s m) +instance (MonadLoggerIO m, Monoid w) => MonadLoggerIO (WriterT w m) +instance (MonadLoggerIO m, Monoid w) => MonadLoggerIO (RWST r w s m) +instance MonadLoggerIO m => MonadLoggerIO (ResourceT m) +instance MonadLoggerIO m => MonadLoggerIO (Pipe l i o u m) +instance MonadLoggerIO m => MonadLoggerIO (ConduitM i o m) +instance MonadLoggerIO m => MonadLoggerIO (Strict.StateT s m) +instance (MonadLoggerIO m, Monoid w) => MonadLoggerIO (Strict.WriterT w m) +instance (MonadLoggerIO m, Monoid w) => MonadLoggerIO (Strict.RWST r w s m) + #if WITH_TEMPLATE_HASKELL logTH :: LogLevel -> Q Exp logTH level = - [|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level) . (id :: Text -> Text)|] + [|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level) + . (id :: Text -> Text)|] +-- | Generates a function that takes a 'LogLevel' and a 'Show a => a'. +-- +-- @since 0.3.18 +logTHShow :: LogLevel -> Q Exp +logTHShow level = + [|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level) + . ((pack . show) :: Show a => a -> Text)|] + -- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage: -- -- > $(logDebug) "This is a debug log message" @@ -229,9 +328,34 @@ logOther :: Text -> Q Exp logOther = logTH . LevelOther + +-- | Generates a function that takes a 'Show a => a' and logs a 'LevelDebug' message. Usage: +-- +-- > $(logDebugSH) (Just "This is a debug log message") +-- +-- @since 0.3.18 +logDebugSH :: Q Exp +logDebugSH = logTHShow LevelDebug + +-- | See 'logDebugSH' +logInfoSH :: Q Exp +logInfoSH = logTHShow LevelInfo +-- | See 'logDebugSH' +logWarnSH :: Q Exp +logWarnSH = logTHShow LevelWarn +-- | See 'logDebugSH' +logErrorSH :: Q Exp +logErrorSH = logTHShow LevelError + +-- | Generates a function that takes a 'Show a => a' and logs a 'LevelOther' message. Usage: +-- +-- > $(logOtherSH "My new level") "This is a log message" +logOtherSH :: Text -> Q Exp +logOtherSH = logTHShow . LevelOther + -- | Lift a location into an Exp. -- --- Since 0.3.1 +-- @since 0.3.1 liftLoc :: Loc -> Q Exp liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc $(lift a) @@ -266,90 +390,231 @@ -- | Monad transformer that disables logging. -- --- Since 0.2.4 +-- @since 0.2.4 newtype NoLoggingT m a = NoLoggingT { runNoLoggingT :: m a } - -instance Monad m => Functor (NoLoggingT m) where - fmap = liftM - -instance Monad m => Applicative (NoLoggingT m) where - pure = return - (<*>) = ap - -instance Monad m => Monad (NoLoggingT m) where - return = NoLoggingT . return - NoLoggingT ma >>= f = NoLoggingT $ ma >>= runNoLoggingT . f - -instance MonadIO m => MonadIO (NoLoggingT m) where - liftIO = Trans.lift . liftIO - -#if MIN_VERSION_resourcet(1,1,0) -instance MonadThrow m => MonadThrow (NoLoggingT m) where - throwM = Trans.lift . throwM + deriving ( + Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask, MonadActive, MonadBase b + , Alternative -- ^ @since 0.3.40 + ) -instance MonadCatch m => MonadCatch (NoLoggingT m) where - catch (NoLoggingT m) c = - NoLoggingT $ m `catch` \e -> runNoLoggingT (c e) -#if MIN_VERSION_exceptions(0,6,0) -instance MonadMask m => MonadMask (NoLoggingT m) where -#endif - mask a = NoLoggingT $ mask $ \u -> runNoLoggingT (a $ q u) - where q u (NoLoggingT b) = NoLoggingT $ u b - uninterruptibleMask a = - NoLoggingT $ uninterruptibleMask $ \u -> runNoLoggingT (a $ q u) - where q u (NoLoggingT b) = NoLoggingT $ u b -#else -instance MonadThrow m => MonadThrow (NoLoggingT m) where - monadThrow = Trans.lift . monadThrow -#endif +-- For some reason GND is a fool on GHC 7.10 and older, we have to help it by providing the context explicitly. +deriving instance MonadResource m => MonadResource (NoLoggingT m) -#if MIN_VERSION_conduit_extra(1,1,0) -instance MonadActive m => MonadActive (NoLoggingT m) where - monadActive = Trans.lift monadActive instance MonadActive m => MonadActive (LoggingT m) where monadActive = Trans.lift monadActive -#endif -instance MonadResource m => MonadResource (NoLoggingT m) where - liftResourceT = Trans.lift . liftResourceT - -instance MonadBase b m => MonadBase b (NoLoggingT m) where - liftBase = Trans.lift . liftBase - instance Trans.MonadTrans NoLoggingT where lift = NoLoggingT instance MonadTransControl NoLoggingT where - newtype StT NoLoggingT a = StIdent {unStIdent :: a} - liftWith f = NoLoggingT $ f $ \(NoLoggingT t) -> liftM StIdent t - restoreT = NoLoggingT . liftM unStIdent + type StT NoLoggingT a = a + liftWith f = NoLoggingT $ f runNoLoggingT + restoreT = NoLoggingT {-# INLINE liftWith #-} {-# INLINE restoreT #-} +#if MIN_VERSION_base(4, 9, 0) +-- | @since 0.3.30 +instance (Fail.MonadFail m) => Fail.MonadFail (NoLoggingT m) where + fail = Trans.lift . Fail.fail +#endif + instance MonadBaseControl b m => MonadBaseControl b (NoLoggingT m) where - newtype StM (NoLoggingT m) a = StMT' (StM m a) + type StM (NoLoggingT m) a = StM m a liftBaseWith f = NoLoggingT $ liftBaseWith $ \runInBase -> - f $ liftM StMT' . runInBase . (\(NoLoggingT r) -> r) - restoreM (StMT' base) = NoLoggingT $ restoreM base + f $ runInBase . runNoLoggingT + restoreM = NoLoggingT . restoreM -instance MonadIO m => MonadLogger (NoLoggingT m) where +instance Monad m => MonadLogger (NoLoggingT m) where monadLoggerLog _ _ _ _ = return () +instance MonadIO m => MonadLoggerIO (NoLoggingT m) where + askLoggerIO = return $ \_ _ _ _ -> return () +-- | @since 0.3.26 +instance MonadUnliftIO m => MonadUnliftIO (NoLoggingT m) where +#if MIN_VERSION_unliftio_core(0, 1, 1) + {-# INLINE withRunInIO #-} + withRunInIO inner = + NoLoggingT $ + withRunInIO $ \run -> + inner (run . runNoLoggingT) +#else + askUnliftIO = + NoLoggingT $ + withUnliftIO $ \u -> + return (UnliftIO (unliftIO u . runNoLoggingT)) +#endif + +instance (Applicative m, Semigroup a) => Semigroup (NoLoggingT m a) where + (<>) = liftA2 (<>) + +instance (Applicative m, Monoid a) => Monoid (NoLoggingT m a) where + mempty = pure mempty + +-- | @since 0.3.32 +type LogLine = (Loc, LogSource, LogLevel, LogStr) + +-- | @since 0.3.28 +newtype WriterLoggingT m a = WriterLoggingT { unWriterLoggingT :: m (a, DList LogLine) } + +-- | Simple implementation of a difference list to support WriterLoggingT +newtype DList a = DList { unDList :: [a] -> [a] } + +emptyDList :: DList a +emptyDList = DList id + +singleton :: a -> DList a +singleton = DList . (:) + +dListToList :: DList a -> [a] +dListToList (DList dl) = dl [] + +appendDList :: DList a -> DList a -> DList a +appendDList dl1 dl2 = DList (unDList dl1 . unDList dl2) + +-- | Run a block using a @MonadLogger@ instance. Return a value and logs in a list +-- | @since 0.3.28 +runWriterLoggingT :: Functor m => WriterLoggingT m a -> m (a, [LogLine]) +runWriterLoggingT (WriterLoggingT ma) = fmap dListToList <$> ma + +-- | Run a block using a @MonadLogger@ instance. Return logs in a list +-- | @since 0.3.28 +execWriterLoggingT :: Functor m => WriterLoggingT m a -> m [LogLine] +execWriterLoggingT ma = snd <$> runWriterLoggingT ma + +instance Monad m => Monad (WriterLoggingT m) where + (WriterLoggingT ma) >>= f = WriterLoggingT $ do + (a, msgs) <- ma + (a', msgs') <- unWriterLoggingT $ f a + return (a', appendDList msgs msgs') + +instance Applicative m => Applicative (WriterLoggingT m) where + pure a = WriterLoggingT . pure $ (a, emptyDList) + WriterLoggingT mf <*> WriterLoggingT ma = WriterLoggingT $ + fmap (\((f, msgs), (a, msgs')) -> (f a, appendDList msgs msgs')) ((,) <$> mf <*> ma) + +instance Functor m => Functor (WriterLoggingT m) where + fmap f (WriterLoggingT ma) = WriterLoggingT $ + fmap (\(a, msgs) -> (f a, msgs)) ma + +instance Monad m => MonadLogger (WriterLoggingT m) where + monadLoggerLog loc source level msg = WriterLoggingT . return $ ((), singleton (loc, source, level, toLogStr msg)) + + +instance Trans.MonadTrans WriterLoggingT where + lift ma = WriterLoggingT $ (, emptyDList) `liftM` ma + +instance MonadIO m => MonadIO (WriterLoggingT m) where + liftIO ioa = WriterLoggingT $ (, emptyDList) `liftM` liftIO ioa + +instance MonadBase b m => MonadBase b (WriterLoggingT m) where + liftBase = liftBaseDefault + +instance MonadTransControl WriterLoggingT where + type StT WriterLoggingT a = (a, DList LogLine) + liftWith f = WriterLoggingT $ liftM (\x -> (x, emptyDList)) + (f $ unWriterLoggingT) + restoreT = WriterLoggingT + +instance MonadBaseControl b m => MonadBaseControl b (WriterLoggingT m) where + type StM (WriterLoggingT m) a = ComposeSt WriterLoggingT m a + liftBaseWith = defaultLiftBaseWith + restoreM = defaultRestoreM + +instance MonadThrow m => MonadThrow (WriterLoggingT m) where + throwM = Trans.lift . throwM + +instance MonadCatch m => MonadCatch (WriterLoggingT m) where + catch (WriterLoggingT m) c = + WriterLoggingT $ m `catch` \e -> unWriterLoggingT (c e) + +instance MonadMask m => MonadMask (WriterLoggingT m) where + mask a = WriterLoggingT $ (mask $ \ u -> unWriterLoggingT (a $ q u)) + where q u b = WriterLoggingT $ u (unWriterLoggingT b) + + uninterruptibleMask a = WriterLoggingT $ uninterruptibleMask $ \u -> unWriterLoggingT (a $ q u) + where q u b = WriterLoggingT $ u (unWriterLoggingT b) + +#if MIN_VERSION_exceptions(0, 10, 0) + generalBracket acquire release use = WriterLoggingT $ do + ((b, _w12), (c, w123)) <- generalBracket + (unWriterLoggingT acquire) + (\(resource, w1) exitCase -> case exitCase of + ExitCaseSuccess (b, w12) -> do + (c, w3) <- unWriterLoggingT (release resource (ExitCaseSuccess b)) + return (c, appendDList w12 w3) + -- In the two other cases, the base monad overrides @use@'s state + -- changes and the state reverts to @w1@. + ExitCaseException e -> do + (c, w3) <- unWriterLoggingT (release resource (ExitCaseException e)) + return (c, appendDList w1 w3) + ExitCaseAbort -> do + (c, w3) <- unWriterLoggingT (release resource ExitCaseAbort) + return (c, appendDList w1 w3)) + (\(resource, w1) -> do + (a, w2) <- unWriterLoggingT (use resource) + return (a, appendDList w1 w2)) + return ((b, c), w123) +#elif MIN_VERSION_exceptions(0, 9, 0) + generalBracket acquire release releaseEx use = + WriterLoggingT $ generalBracket + (unWriterLoggingT acquire) + (\(x, w1) -> do + (y, w2) <- unWriterLoggingT (release x) + return (y, appendDList w1 w2)) + (\(x, w1) ex -> do + (y, w2) <- unWriterLoggingT (releaseEx x ex) + return (y, appendDList w1 w2)) + (\(x, w1) -> do + (y, w2) <- unWriterLoggingT (use x) + return (y, appendDList w1 w2)) +#endif + +instance (Applicative m, Semigroup a) => Semigroup (WriterLoggingT m a) where + (<>) = liftA2 (<>) + +instance (Applicative m, Monoid a) => Monoid (WriterLoggingT m a) where + mempty = pure mempty + -- | Monad transformer that adds a new logging function. -- --- Since 0.2.2 +-- @since 0.2.2 newtype LoggingT m a = LoggingT { runLoggingT :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a } +#if __GLASGOW_HASKELL__ < 710 instance Monad m => Functor (LoggingT m) where fmap = liftM instance Monad m => Applicative (LoggingT m) where pure = return (<*>) = ap +#else +instance Functor m => Functor (LoggingT m) where + fmap f logger = LoggingT $ \loggerFn -> fmap f $ (runLoggingT logger) loggerFn + {-# INLINE fmap #-} +instance Applicative m => Applicative (LoggingT m) where + pure = LoggingT . const . pure + {-# INLINE pure #-} + loggerF <*> loggerA = LoggingT $ \loggerFn -> + (runLoggingT loggerF) loggerFn + <*> (runLoggingT loggerA) loggerFn + {-# INLINE (<*>) #-} +#endif + +-- | @since 0.3.40 +instance (Alternative m) => Alternative (LoggingT m) where + empty = LoggingT (const empty) + LoggingT x <|> LoggingT y = LoggingT (\f -> x f <|> y f) + +#if MIN_VERSION_base(4, 9, 0) +-- | @since 0.3.30 +instance (Fail.MonadFail m) => Fail.MonadFail (LoggingT m) where + fail = Trans.lift . Fail.fail +#endif + instance Monad m => Monad (LoggingT m) where - return = LoggingT . const . return LoggingT ma >>= f = LoggingT $ \r -> do a <- ma r let LoggingT f' = f a @@ -358,23 +623,30 @@ instance MonadIO m => MonadIO (LoggingT m) where liftIO = Trans.lift . liftIO -#if MIN_VERSION_resourcet(1,1,0) instance MonadThrow m => MonadThrow (LoggingT m) where throwM = Trans.lift . throwM instance MonadCatch m => MonadCatch (LoggingT m) where catch (LoggingT m) c = LoggingT $ \r -> m r `catch` \e -> runLoggingT (c e) r -#if MIN_VERSION_exceptions(0,6,0) instance MonadMask m => MonadMask (LoggingT m) where -#endif mask a = LoggingT $ \e -> mask $ \u -> runLoggingT (a $ q u) e where q u (LoggingT b) = LoggingT (u . b) uninterruptibleMask a = LoggingT $ \e -> uninterruptibleMask $ \u -> runLoggingT (a $ q u) e where q u (LoggingT b) = LoggingT (u . b) -#else -instance MonadThrow m => MonadThrow (LoggingT m) where - monadThrow = Trans.lift . monadThrow +#if MIN_VERSION_exceptions(0, 10, 0) + generalBracket acquire release use = + LoggingT $ \e -> generalBracket + (runLoggingT acquire e) + (\x ec -> runLoggingT (release x ec) e) + (\x -> runLoggingT (use x) e) +#elif MIN_VERSION_exceptions(0, 9, 0) + generalBracket acquire release releaseEx use = + LoggingT $ \e -> generalBracket + (runLoggingT acquire e) + (\x -> runLoggingT (release x) e) + (\x y -> runLoggingT (releaseEx x y) e) + (\x -> runLoggingT (use x) e) #endif instance MonadResource m => MonadResource (LoggingT m) where @@ -387,22 +659,57 @@ lift = LoggingT . const instance MonadTransControl LoggingT where - newtype StT LoggingT a = StReader {unStReader :: a} - liftWith f = LoggingT $ \r -> f $ \(LoggingT t) -> liftM StReader $ t r - restoreT = LoggingT . const . liftM unStReader + type StT LoggingT a = a + liftWith f = LoggingT $ \r -> f $ \(LoggingT t) -> t r + restoreT = LoggingT . const {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance MonadBaseControl b m => MonadBaseControl b (LoggingT m) where - newtype StM (LoggingT m) a = StMT (StM m a) + type StM (LoggingT m) a = StM m a liftBaseWith f = LoggingT $ \reader' -> liftBaseWith $ \runInBase -> - f $ liftM StMT . runInBase . (\(LoggingT r) -> r reader') - restoreM (StMT base) = LoggingT $ const $ restoreM base + f $ runInBase . (\(LoggingT r) -> r reader') + restoreM = LoggingT . const . restoreM instance MonadIO m => MonadLogger (LoggingT m) where monadLoggerLog a b c d = LoggingT $ \f -> liftIO $ f a b c (toLogStr d) +instance MonadIO m => MonadLoggerIO (LoggingT m) where + askLoggerIO = LoggingT return +-- | @since 0.3.26 +instance MonadUnliftIO m => MonadUnliftIO (LoggingT m) where +#if MIN_VERSION_unliftio_core(0, 1, 1) + {-# INLINE withRunInIO #-} + withRunInIO inner = + LoggingT $ \r -> + withRunInIO $ \run -> + inner (run . flip runLoggingT r) +#else + askUnliftIO = + LoggingT $ \f -> + withUnliftIO $ \u -> + return (UnliftIO (unliftIO u . flip runLoggingT f)) +#endif + +instance (Applicative m, Semigroup a) => Semigroup (LoggingT m a) where + (<>) = liftA2 (<>) + +instance (Applicative m, Monoid a) => Monoid (LoggingT m a) where + mempty = pure mempty + +-- | A default implementation of 'monadLoggerLog' that accepts a file +-- handle as the first argument. +-- +-- This is used in the definition of 'runStdoutLoggingT': +-- +-- @ +-- 'runStdoutLoggingT' :: 'MonadIO' m => 'LoggingT' m a -> m a +-- 'runStdoutLoggingT' action = +-- 'runLoggingT' action ('defaultOutput' 'stdout') +-- @ +-- +-- @since 0.3.36 defaultOutput :: Handle -> Loc -> LogSource @@ -410,24 +717,19 @@ -> LogStr -> IO () defaultOutput h loc src level msg = - S8.hPutStrLn h ls + S8.hPutStr h ls where ls = defaultLogStrBS loc src level msg + defaultLogStrBS :: Loc -> LogSource -> LogLevel -> LogStr -> S8.ByteString defaultLogStrBS a b c d = - toBS $ defaultLogStr a b c d + fromLogStr $ defaultLogStr a b c d where -#if MIN_VERSION_fast_logger(2, 1, 0) toBS = fromLogStr -#elif MIN_VERSION_bytestring(0, 10, 2) - toBS = L.toStrict . toLazyByteString . logStrBuilder -#else - toBS = toByteString . logStrBuilder -#endif defaultLogLevelStr :: LogLevel -> LogStr defaultLogLevelStr level = case level of @@ -438,40 +740,20 @@ -> LogSource -> LogLevel -> LogStr -#if MIN_VERSION_fast_logger(0, 2, 0) -> LogStr -#else - -> S8.ByteString -#endif defaultLogStr loc src level msg = -#if MIN_VERSION_fast_logger(0, 2, 0) "[" `mappend` defaultLogLevelStr level `mappend` (if T.null src then mempty else "#" `mappend` toLogStr src) `mappend` "] " `mappend` msg `mappend` - " @(" `mappend` - toLogStr (S8.pack fileLocStr) `mappend` - ")\n" -#else - S8.concat - [ S8.pack "[" - , case level of - LevelOther t -> encodeUtf8 t - _ -> encodeUtf8 $ pack $ drop 5 $ show level - , if T.null src - then S8.empty - else encodeUtf8 $ '#' `T.cons` src - , S8.pack "] " - , case msg of - LS s -> encodeUtf8 $ pack s - LB b -> b - , S8.pack " @(" - , encodeUtf8 $ pack fileLocStr - , S8.pack ")\n" - ] -#endif + (if isDefaultLoc loc + then "\n" + else + " @(" `mappend` + toLogStr (S8.pack fileLocStr) `mappend` + ")\n") where -- taken from file-location package -- turn the TH Loc loaction information into a human readable string @@ -494,25 +776,57 @@ -} +-- | Run a block using a @MonadLogger@ instance which appends to the specified file. +-- +-- @since 0.3.22 +runFileLoggingT :: MonadBaseControl IO m => FilePath -> LoggingT m a -> m a +runFileLoggingT fp logt = bracket + (liftBase $ openFile fp AppendMode) + (liftBase . hClose) + $ \h -> liftBase (hSetBuffering h LineBuffering) >> (runLoggingT logt) (defaultOutput h) + -- | Run a block using a @MonadLogger@ instance which prints to stderr. -- --- Since 0.2.2 +-- @since 0.2.2 runStderrLoggingT :: MonadIO m => LoggingT m a -> m a runStderrLoggingT = (`runLoggingT` defaultOutput stderr) -- | Run a block using a @MonadLogger@ instance which prints to stdout. -- --- Since 0.2.2 +-- @since 0.2.2 runStdoutLoggingT :: MonadIO m => LoggingT m a -> m a runStdoutLoggingT = (`runLoggingT` defaultOutput stdout) +-- | Run a block using a @MonadLogger@ instance which writes tuples to an +-- unbounded channel. +-- +-- The tuples can be extracted (ie. in another thread) with `unChanLoggingT` +-- or a custom extraction funtion, and written to a destination. +-- +-- @since 0.3.17 +runChanLoggingT :: MonadIO m => Chan LogLine -> LoggingT m a -> m a +runChanLoggingT chan = (`runLoggingT` sink chan) + where + sink chan' loc src lvl msg = writeChan chan' (loc,src,lvl,msg) + +-- | Read logging tuples from an unbounded channel and log them into a +-- `MonadLoggerIO` monad, forever. +-- +-- For use in a dedicated thread with a channel fed by `runChanLoggingT`. +-- +-- @since 0.3.17 +unChanLoggingT :: (MonadLogger m, MonadIO m) => Chan LogLine -> m void +unChanLoggingT chan = forever $ do + (loc,src,lvl,msg) <- liftIO $ readChan chan + monadLoggerLog loc src lvl msg + -- | Within the 'LoggingT' monad, capture all log messages to a bounded -- channel of the indicated size, and only actually log them if there is an -- exception. -- --- Since 0.3.2 +-- @since 0.3.2 withChannelLogger :: (MonadBaseControl IO m, MonadIO m) - => Int -- ^ Number of mesasges to keep + => Int -- ^ Number of messages to keep -> LoggingT m a -> LoggingT m a withChannelLogger size action = LoggingT $ \logger -> do @@ -527,6 +841,18 @@ dumpLogs chan = liftIO $ sequence_ =<< atomically (untilM (readTBChan chan) (isEmptyTBChan chan)) +-- | Only log messages passing the given predicate function. +-- +-- This can be a convenient way, for example, to ignore debug level messages. +-- +-- @since 0.3.13 +filterLogger :: (LogSource -> LogLevel -> Bool) + -> LoggingT m a + -> LoggingT m a +filterLogger p (LoggingT f) = LoggingT $ \logger -> + f $ \loc src level msg -> + when (p src level) $ logger loc src level msg + instance MonadCont m => MonadCont (LoggingT m) where callCC f = LoggingT $ \i -> callCC $ \c -> runLoggingT (f (LoggingT . const . c)) i @@ -534,12 +860,24 @@ throwError = Trans.lift . throwError catchError r h = LoggingT $ \i -> runLoggingT r i `catchError` \e -> runLoggingT (h e) i +instance MonadError e m => MonadError e (NoLoggingT m) where + throwError = Trans.lift . throwError + catchError r h = NoLoggingT $ runNoLoggingT r `catchError` \e -> runNoLoggingT (h e) + instance MonadRWS r w s m => MonadRWS r w s (LoggingT m) instance MonadReader r m => MonadReader r (LoggingT m) where ask = Trans.lift ask local = mapLoggingT . local +-- | @since 0.3.24 +instance MonadReader r m => MonadReader r (NoLoggingT m) where + ask = Trans.lift ask + local = mapNoLoggingT . local + +-- | Map the unwrapped computation using the given function. +-- +-- @since 0.3.29 mapLoggingT :: (m a -> n b) -> LoggingT m a -> LoggingT n b mapLoggingT f = LoggingT . (f .) . runLoggingT @@ -552,9 +890,44 @@ listen = mapLoggingT listen pass = mapLoggingT pass +-- | Map the unwrapped computation using the given function. +-- +-- @since 0.3.29 +mapNoLoggingT :: (m a -> n b) -> NoLoggingT m a -> NoLoggingT n b +mapNoLoggingT f = NoLoggingT . f . runNoLoggingT + +instance MonadState s m => MonadState s (NoLoggingT m) where + get = Trans.lift get + put = Trans.lift . put + +instance MonadWriter w m => MonadWriter w (NoLoggingT m) where + tell = Trans.lift . tell + listen = mapNoLoggingT listen + pass = mapNoLoggingT pass + +#if MIN_VERSION_mtl(2, 3, 1) +-- | @since 0.3.41 +instance MonadAccum w m => MonadAccum w (LoggingT m) where + accum = Trans.lift . accum + +-- | @since 0.3.41 +instance MonadAccum w m => MonadAccum w (NoLoggingT m) where + accum = Trans.lift . accum +#endif + +-- | dummy location, used with 'logWithoutLoc' +-- +-- @since 0.3.23 defaultLoc :: Loc defaultLoc = Loc "" "" "" (0,0) (0,0) +isDefaultLoc :: Loc -> Bool +isDefaultLoc (Loc "" "" "" (0,0) (0,0)) = True +isDefaultLoc _ = False + +-- | +-- +-- @since 0.3.23 logWithoutLoc :: (MonadLogger m, ToLogStr msg) => LogSource -> LogLevel -> msg -> m () logWithoutLoc = monadLoggerLog defaultLoc @@ -573,17 +946,79 @@ logOtherN :: MonadLogger m => LogLevel -> Text -> m () logOtherN = logWithoutLoc "" -logDebugNS :: MonadLogger m => Text -> Text -> m () +logDebugNS :: MonadLogger m => LogSource -> Text -> m () logDebugNS src = logWithoutLoc src LevelDebug -logInfoNS :: MonadLogger m => Text -> Text -> m () +logInfoNS :: MonadLogger m => LogSource -> Text -> m () logInfoNS src = logWithoutLoc src LevelInfo -logWarnNS :: MonadLogger m => Text -> Text -> m () +logWarnNS :: MonadLogger m => LogSource -> Text -> m () logWarnNS src = logWithoutLoc src LevelWarn -logErrorNS :: MonadLogger m => Text -> Text -> m () +logErrorNS :: MonadLogger m => LogSource -> Text -> m () logErrorNS src = logWithoutLoc src LevelError -logOtherNS :: MonadLogger m => Text -> LogLevel -> Text -> m () +logOtherNS :: MonadLogger m => LogSource -> LogLevel -> Text -> m () logOtherNS = logWithoutLoc + +#if WITH_CALLSTACK +-- Callstack based logging + +mkLoggerLoc :: GHC.SrcLoc -> Loc +mkLoggerLoc loc = + Loc { loc_filename = GHC.srcLocFile loc + , loc_package = GHC.srcLocPackage loc + , loc_module = GHC.srcLocModule loc + , loc_start = ( GHC.srcLocStartLine loc + , GHC.srcLocStartCol loc) + , loc_end = ( GHC.srcLocEndLine loc + , GHC.srcLocEndCol loc) + } + +locFromCS :: GHC.CallStack -> Loc +locFromCS cs = case getCallStack cs of + ((_, loc):_) -> mkLoggerLoc loc + _ -> defaultLoc + +logCS :: (MonadLogger m, ToLogStr msg) + => GHC.CallStack + -> LogSource + -> LogLevel + -> msg + -> m () +logCS cs src lvl msg = + monadLoggerLog (locFromCS cs) src lvl msg + +-- | Logs a message with location given by 'CallStack'. +-- See 'Control.Monad.Logger.CallStack' for more convenient +-- functions for 'CallStack' based logging. +-- +-- @since 0.3.19 +logDebugCS :: MonadLogger m => GHC.CallStack -> Text -> m () +logDebugCS cs msg = logCS cs "" LevelDebug msg + +-- | See 'logDebugCS' +-- +-- @since 0.3.19 +logInfoCS :: MonadLogger m => GHC.CallStack -> Text -> m () +logInfoCS cs msg = logCS cs "" LevelInfo msg + +-- | See 'logDebugCS' +-- +-- @since 0.3.19 +logWarnCS :: MonadLogger m => GHC.CallStack -> Text -> m () +logWarnCS cs msg = logCS cs "" LevelWarn msg + +-- | See 'logDebugCS' +-- +-- @since 0.3.19 +logErrorCS :: MonadLogger m => GHC.CallStack -> Text -> m () +logErrorCS cs msg = logCS cs "" LevelError msg + +-- | See 'logDebugCS' +-- +-- @since 0.3.19 +logOtherCS :: MonadLogger m => GHC.CallStack -> LogLevel -> Text -> m () +logOtherCS cs lvl msg = logCS cs "" lvl msg + +#endif diff --git a/Control/Monad/Logger/CallStack.hs b/Control/Monad/Logger/CallStack.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Logger/CallStack.hs @@ -0,0 +1,86 @@ +-- | Log functions using CallStack support in place of Template Haskell +-- +-- @since 0.3.19 +module Control.Monad.Logger.CallStack ( + module Log + , logDebug + , logInfo + , logWarn + , logError + , logOther + , logDebugSH + , logInfoSH + , logWarnSH + , logErrorSH + , logOtherSH + ) where + +import Control.Monad.Logger as Log hiding (logDebug, logDebugSH, + logError, logErrorSH, logInfo, + logInfoSH, logOther, logOtherSH, + logWarn, logWarnSH) +import Data.Text (Text) +import qualified Data.Text as Text +import GHC.Stack + +-- | Logs a message with the location provided by +-- an implicit 'CallStack'. +-- +-- @since 0.3.19 +logDebug :: (HasCallStack, Log.MonadLogger m) => Text -> m () +logDebug = Log.logDebugCS callStack + +-- | See 'logDebug' +-- +-- @since 0.3.19 +logInfo :: (HasCallStack, Log.MonadLogger m) => Text -> m () +logInfo = Log.logInfoCS callStack + +-- | See 'logDebug' +-- +-- @since 0.3.19 +logWarn :: (HasCallStack, Log.MonadLogger m) => Text -> m () +logWarn = Log.logWarnCS callStack + +-- | See 'logDebug' +-- +-- @since 0.3.19 +logError :: (HasCallStack, Log.MonadLogger m) => Text -> m () +logError = Log.logErrorCS callStack + +-- | See 'logDebug' +-- +-- @since 0.3.25 +logOther :: (HasCallStack, Log.MonadLogger m) => Log.LogLevel -> Text -> m () +logOther = Log.logOtherCS callStack + +-- | Logs a showable value with the location provided by +-- an implicit 'CallStack'. +-- +-- @since 0.3.25 +logDebugSH :: (HasCallStack, Log.MonadLogger m, Show a) => a -> m () +logDebugSH = Log.logDebugCS callStack . Text.pack . show + +-- | See 'logDebugSH' +-- +-- @since 0.3.25 +logInfoSH :: (HasCallStack, Log.MonadLogger m, Show a) => a -> m () +logInfoSH = Log.logInfoCS callStack . Text.pack . show + +-- | See 'logDebugSH' +-- +-- @since 0.3.25 +logWarnSH :: (HasCallStack, Log.MonadLogger m, Show a) => a -> m () +logWarnSH = Log.logWarnCS callStack . Text.pack . show + +-- | See 'logDebugSH' +-- +-- @since 0.3.25 +logErrorSH :: (HasCallStack, Log.MonadLogger m, Show a) => a -> m () +logErrorSH = Log.logErrorCS callStack . Text.pack . show + +-- | See 'logDebugSH' +-- +-- @since 0.3.25 +logOtherSH :: (HasCallStack, Log.MonadLogger m, Show a) => Log.LogLevel -> a -> m () +logOtherSH lvl = Log.logOtherCS callStack lvl . Text.pack . show diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +## monad-logger + +[![Build Status](https://travis-ci.org/snoyberg/monad-logger.svg?branch=master)](https://travis-ci.org/snoyberg/monad-logger) +[![Build status](https://ci.appveyor.com/api/projects/status/egsp4r31t54ak4i5/branch/master?svg=true)](https://ci.appveyor.com/project/snoyberg/monad-logger/branch/master) +[![Hackage](https://img.shields.io/hackage/v/monad-logger)](https://hackage.haskell.org/package/monad-logger) + +A monad transformer approach for logging. + +This package provides Template Haskell functions for determining source code locations of messages. diff --git a/monad-logger.cabal b/monad-logger.cabal --- a/monad-logger.cabal +++ b/monad-logger.cabal @@ -1,44 +1,65 @@ -name: monad-logger -version: 0.3.7.1 -synopsis: A class of monads which can log messages. -description: This package uses template-haskell for determining source code locations of messages. -homepage: https://github.com/kazu-yamamoto/logger -license: MIT -license-file: LICENSE -author: Michael Snoyman -maintainer: michael@snoyman.com -category: System -build-type: Simple -cabal-version: >=1.8 +cabal-version: 1.12 +-- This file has been generated from package.yaml by hpack version 0.37.0. +-- +-- see: https://github.com/sol/hpack -flag template_haskell { - Description: Enable Template Haskell support - Default: True - Manual: True -} +name: monad-logger +version: 0.3.42 +synopsis: A class of monads which can log messages. +description: See README and Haddocks at +category: System +homepage: https://github.com/snoyberg/monad-logger#readme +bug-reports: https://github.com/snoyberg/monad-logger/issues +author: Michael Snoyman +maintainer: michael@snoyman.com +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + ChangeLog.md + README.md +source-repository head + type: git + location: https://github.com/snoyberg/monad-logger + +flag template_haskell + description: Enable Template Haskell support + manual: True + default: True + library - exposed-modules: Control.Monad.Logger - build-depends: base >= 4 && < 5 - , transformers - , text - , stm - , stm-chans - , lifted-base - , resourcet >= 0.4 && < 1.2 - , conduit >= 1.0 && < 1.2 - , conduit-extra >= 1.0 && < 1.2 - , fast-logger >= 2.0 && < 2.3 - , transformers-base - , monad-control - , monad-loops - , mtl - , bytestring - , blaze-builder - , exceptions + exposed-modules: + Control.Monad.Logger + other-modules: + Paths_monad_logger + build-depends: + base >=4.11 && <5 + , bytestring >=0.10.2 + , conduit >=1.0 && <1.4 + , conduit-extra >=1.1 && <1.4 + , exceptions >=0.6 && <0.11 + , fast-logger >=2.1 && <3.3 + , lifted-base + , monad-control >=1.0 + , monad-loops + , mtl + , resourcet >=1.1 && <1.4 + , stm + , stm-chans + , text + , transformers + , transformers-base + , transformers-compat >=0.3 + , unliftio-core + default-language: Haskell2010 + if impl(ghc >=8.0.1) + exposed-modules: + Control.Monad.Logger.CallStack + cpp-options: -DWITH_CALLSTACK if flag(template_haskell) - build-depends: template-haskell - + build-depends: + template-haskell if flag(template_haskell) - cpp-options: -DWITH_TEMPLATE_HASKELL + cpp-options: -DWITH_TEMPLATE_HASKELL