diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs --- a/Control/Monad/Logger.hs +++ b/Control/Monad/Logger.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} +#if WITH_TEMPLATE_HASKELL +{-# LANGUAGE TemplateHaskell #-} +#endif {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -30,6 +32,7 @@ , runStdoutLoggingT , withChannelLogger , NoLoggingT (..) +#if WITH_TEMPLATE_HASKELL -- * TH logging , logDebug , logInfo @@ -44,6 +47,7 @@ , logOtherS -- * TH util , liftLoc +#endif -- * Non-TH logging , logDebugN , logInfoN @@ -56,18 +60,14 @@ , logWarnNS , logErrorNS , logOtherNS + + -- * utilities for defining your own loggers + , defaultLogStr + , Loc ) where +#if WITH_TEMPLATE_HASKELL import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation) -#if MIN_VERSION_fast_logger(2, 0, 0) -import System.Log.FastLogger (LogStr, pushLogStr, ToLogStr (toLogStr), LoggerSet, newLoggerSet, defaultBufSize, flushLogStr) -import System.IO.Unsafe (unsafePerformIO) -#define Handle LoggerSet -import Data.Monoid (mempty, mappend) -import qualified GHC.IO.FD as FD -#else -import System.Log.FastLogger (ToLogStr (toLogStr), LogStr (..)) -import System.IO (stdout, stderr, Handle) #endif import Data.Monoid (Monoid) @@ -105,6 +105,10 @@ import qualified Data.Text as T import qualified Data.ByteString.Char8 as S8 +import Data.Monoid (mappend, mempty) +import System.Log.FastLogger +import System.IO (Handle, stdout, stderr) + import Control.Monad.Cont.Class ( MonadCont (..) ) import Control.Monad.Error.Class ( MonadError (..) ) import Control.Monad.RWS.Class ( MonadRWS ) @@ -112,9 +116,20 @@ import Control.Monad.State.Class ( MonadState (..) ) import Control.Monad.Writer.Class ( MonadWriter (..) ) +import Blaze.ByteString.Builder (toByteString) + +#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) +#endif + data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text deriving (Eq, Prelude.Show, Prelude.Read, Ord) +type LogSource = Text + +#if WITH_TEMPLATE_HASKELL + instance Lift LogLevel where lift LevelDebug = [|LevelDebug|] lift LevelInfo = [|LevelInfo|] @@ -122,11 +137,22 @@ lift LevelError = [|LevelError|] lift (LevelOther x) = [|LevelOther $ pack $(lift $ unpack x)|] -type LogSource = Text +#else +data Loc + = Loc { loc_filename :: String + , loc_package :: String + , loc_module :: String + , loc_start :: CharPos + , loc_end :: CharPos } +type CharPos = (Int, Int) + +#endif + class Monad m => MonadLogger m where monadLoggerLog :: ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> m () + {- instance MonadLogger IO where monadLoggerLog _ _ _ = return () instance MonadLogger Identity where monadLoggerLog _ _ _ = return () @@ -152,6 +178,7 @@ instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF #undef DEF +#if WITH_TEMPLATE_HASKELL logTH :: LogLevel -> Q Exp logTH level = [|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level) . (id :: Text -> Text)|] @@ -211,6 +238,7 @@ -- > $logOtherS "SomeSource" "My new level" "This is a log message" logOtherS :: Q Exp logOtherS = [|\src level msg -> monadLoggerLog $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|] +#endif -- | Monad transformer that disables logging. -- @@ -318,9 +346,36 @@ -> LogStr -> IO () defaultOutput h loc src level msg = + S8.hPutStrLn 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 + 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 + +defaultLogStr :: Loc + -> LogSource + -> LogLevel + -> LogStr #if MIN_VERSION_fast_logger(0, 2, 0) - do - pushLogStr h $ + -> LogStr +#else + -> S8.ByteString +#endif +defaultLogStr loc src level msg = +#if MIN_VERSION_fast_logger(0, 2, 0) "[" `mappend` (case level of LevelOther t -> toLogStr t @@ -333,12 +388,8 @@ " @(" `mappend` toLogStr (S8.pack fileLocStr) `mappend` ")\n" - flushLogStr h - where #else - S8.hPutStrLn h $ S8.concat bs - where - bs = + S8.concat [ S8.pack "[" , case level of LevelOther t -> encodeUtf8 t @@ -355,7 +406,7 @@ , S8.pack ")\n" ] #endif - + where -- taken from file-location package -- turn the TH Loc loaction information into a human readable string -- leaving out the loc_end parameter @@ -364,14 +415,6 @@ where line = show . fst . loc_start char = show . snd . loc_start - -#if MIN_VERSION_fast_logger(0, 2, 0) -stdout, stderr :: LoggerSet -stdout = unsafePerformIO $ newLoggerSet defaultBufSize FD.stdout -{-# NOINLINE stdout #-} -stderr = unsafePerformIO $ newLoggerSet defaultBufSize FD.stderr -{-# NOINLINE stderr #-} -#endif -- | Run a block using a @MonadLogger@ instance which prints to stderr. -- diff --git a/monad-logger.cabal b/monad-logger.cabal --- a/monad-logger.cabal +++ b/monad-logger.cabal @@ -1,5 +1,5 @@ name: monad-logger -version: 0.3.3.2 +version: 0.3.4.0 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 @@ -12,10 +12,15 @@ cabal-version: >=1.8 +flag template_haskell { + Description: Enable Template Haskell support + Default: True + Manual: True +} + library exposed-modules: Control.Monad.Logger build-depends: base >= 4 && < 5 - , template-haskell , transformers , text , stm @@ -23,9 +28,15 @@ , lifted-base , resourcet >= 0.4 && < 0.5 , conduit >= 1.0 && < 1.1 - , fast-logger >= 2.0 && < 2.1 + , fast-logger >= 2.0 && < 2.2 , transformers-base , monad-control , monad-loops , mtl , bytestring + , blaze-builder + if flag(template_haskell) + build-depends: template-haskell + + if flag(template_haskell) + cpp-options: -DWITH_TEMPLATE_HASKELL