arbor-monad-logger (empty) → 0.1.0.0

raw patch · 9 files changed

+299/−0 lines, 9 filesdep +arbor-monad-loggerdep +basedep +bytestringsetup-changed

Dependencies added: arbor-monad-logger, base, bytestring, fast-logger, hedgehog, hspec, hw-hspec-hedgehog, monad-logger, mtl, text

Files

• ChangeLog.md +3/−0
• LICENSE +21/−0
• README.md +15/−0
• Setup.hs +2/−0
• app/AppEnv.hs +17/−0
• app/Main.hs +29/−0
• arbor-monad-logger.cabal +70/−0
• src/Arbor/Monad/Logger.hs +141/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,3 @@+# Changelog for arbor-monad-logger++## Unreleased changes

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018-2019 Arbor Networks++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,15 @@+# arbor-monad-logger++Logging library that simplifies setting up an application to work with+[`monad-logger`](http://hackage.haskell.org/package/monad-logger)+API library using+[`fast-logger`](http://hackage.haskell.org/package/fast-logger)+as the underlying logger.++It also provides a useful non-overloaded API for logging against+`Control.Monad.Logger.MonadLogger`.++See the example app in the [`app`](https://github.com/packetloop/arbor-monad-logger/tree/master/app)+directory for more information.++The example app can be run with `cabal new-run arbor-monad-logger-example`

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,17 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DuplicateRecordFields #-}++module AppEnv where++import GHC.Generics++import qualified Arbor.Monad.Logger as L++data Logger = Logger+  { logger   :: L.TimedFastLogger+  , logLevel :: L.LogLevel+  } deriving (Generic)++newtype AppEnv = AppEnv+  { logger :: Logger+  } deriving (Generic)

@@ -0,0 +1,29 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Main where++import Arbor.Monad.Logger+import Control.Monad.Reader++import qualified AppEnv as E++newtype Service a = Service+  { unService :: ReaderT E.AppEnv (LoggingT IO) a+  }+  deriving  ( Functor+            , Applicative+            , Monad+            , MonadIO+            , MonadLogger+            , MonadReader E.AppEnv)++runServiceTimedFastLogger :: e -> LogLevel -> ReaderT e (LoggingT IO) a -> IO a+runServiceTimedFastLogger e lvl f = withStdOutTimedFastLogger $ \lgr -> runTimedLogT lvl lgr (runReaderT f e)++main :: IO ()+main = withStdOutTimedFastLogger $ \lgr -> do+  let appEnv = E.AppEnv (E.Logger lgr LevelInfo)+  runServiceTimedFastLogger appEnv LevelInfo . unService $ do+    logInfo "Hello world"+    return ()+  pushLogMessage lgr LevelError ("Exiting" :: String)

@@ -0,0 +1,70 @@+cabal-version:  2.2+name:           arbor-monad-logger+version:        0.1.0.0+description:    Please see the README on GitHub at <https://github.com/packetloop/arbor-monad-logger#readme>+homepage:       https://github.com/packetloop/arbor-monad-logger#readme+bug-reports:    https://github.com/packetloop/arbor-monad-logger/issues+author:         Arbor Networks+maintainer:     mayhem@arbor.net+copyright:      2018-2019 Arbor Networks+license:        MIT+license-file:   LICENSE+build-type:     Simple+synopsis:       Simple logging library+category:       Logging+extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/packetloop/arbor-monad-logger++common base               { build-depends: base               >= 4          && < 5      }++common bytestring         { build-depends: bytestring         >= 0.10.0.0   && < 0.11   }+common fast-logger        { build-depends: fast-logger        >= 2.4.11     && < 2.5    }+common hedgehog           { build-depends: hedgehog           >= 0.6.1      && < 0.7    }+common hspec              { build-depends: hspec              >= 2.6.1      && < 2.7    }+common hw-hspec-hedgehog  { build-depends: hw-hspec-hedgehog  >= 0.1.0.4    && < 0.2    }+common monad-logger       { build-depends: monad-logger       >= 0.3.28.5   && < 0.4    }+common mtl                { build-depends: mtl                >= 2.2        && < 2.3    }+common text               { build-depends: text               >= 1.2.3.0    && < 1.3    }++common common+  default-language: Haskell2010++library+  import:   base, common+          , bytestring+          , fast-logger+          , monad-logger+          , text+  hs-source-dirs:   src+  other-modules:    Paths_arbor_monad_logger+  autogen-modules:  Paths_arbor_monad_logger+  exposed-modules:+      Arbor.Monad.Logger++test-suite arbor-monad-logger-test+  import:   base, common+          , hedgehog+          , hspec+          , hw-hspec-hedgehog+  type:               exitcode-stdio-1.0+  main-is:            Spec.hs+  hs-source-dirs:     test+  default-extensions: BangPatterns FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings TupleSections+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N+  build-depends:      arbor-monad-logger++executable arbor-monad-logger-example+  import:   base, common+          , mtl+  main-is:            Main.hs+  other-modules:      AppEnv+                    , Paths_arbor_monad_logger+  autogen-modules:    Paths_arbor_monad_logger+  hs-source-dirs:     app+  ghc-options:        -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 -msse4.2 -rtsopts -threaded+  build-depends:      arbor-monad-logger

@@ -0,0 +1,141 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}++module Arbor.Monad.Logger+  ( logDebug+  , logInfo+  , logWarn+  , logError+  , logDebug'+  , logInfo'+  , logWarn'+  , logError'+  , pushLogMessage+  , withStdOutTimedFastLogger+  , runTimedLogT+  , runTimedFastLoggerLoggingT+  , LogLevel(..)+  , LoggingT(..)+  , MonadLogger(..)+  , TimedFastLogger(..)+  ) where++import Control.Monad.IO.Class+import Control.Monad.Logger   hiding (logDebug, logError, logInfo, logWarn)+import System.Log.FastLogger++import qualified Control.Monad.Logger  as L+import qualified Data.ByteString.Char8 as BS+import qualified Data.Text             as T++logDebug :: MonadLogger m => String -> m ()+logDebug = logDebug'+{-# INLINE logDebug #-}++logInfo :: MonadLogger m => String -> m ()+logInfo = logInfo'+{-# INLINE logInfo #-}++logWarn :: MonadLogger m => String -> m ()+logWarn = logWarn'+{-# INLINE logWarn #-}++logError :: MonadLogger m => String -> m ()+logError = logError'+{-# INLINE logError #-}++logDebug' :: (MonadLogger m, ToLogStr s) => s -> m ()+logDebug' = L.logWithoutLoc "" LevelDebug+{-# INLINE logDebug' #-}++logInfo' :: (MonadLogger m, ToLogStr s) => s -> m ()+logInfo' = L.logWithoutLoc "" LevelInfo+{-# INLINE logInfo' #-}++logWarn' :: (MonadLogger m, ToLogStr s) => s -> m ()+logWarn' = L.logWithoutLoc "" LevelWarn+{-# INLINE logWarn' #-}++logError' :: (MonadLogger m, ToLogStr s) => s -> m ()+logError' = L.logWithoutLoc "" LevelError+{-# INLINE logError' #-}++pushLogMessage :: (ToLogStr s) => TimedFastLogger -> LogLevel -> s -> IO ()+pushLogMessage t l s = t (defaultTimedLogStr defaultLoc "" l (toLogStr s))++defaultTimedLogStr :: Loc+              -> LogSource+              -> LogLevel+              -> LogStr+              -> FormattedTime+#if MIN_VERSION_fast_logger(0, 2, 0)+              -> LogStr+#else+              -> BS.ByteString+#endif+defaultTimedLogStr loc src level msg time =+#if MIN_VERSION_fast_logger(0, 2, 0)+    "[" `mappend` defaultLogLevelStr level `mappend`+    (if T.null src+        then mempty+        else "#" `mappend` toLogStr src) `mappend`+    "] " `mappend` "[" `mappend` toLogStr time `mappend` "] " `mappend`+    msg `mappend`+    (if isDefaultLoc loc+        then "\n"+        else+            " @(" `mappend`+            toLogStr (BS.pack (fileLocStr loc)) `mappend`+            ")\n")+#else+    BS.concat+        [ BS.pack "["+        , case level of+            LevelOther t -> encodeUtf8 t+            _            -> encodeUtf8 $ pack $ drop 5 $ show level+        , if T.null src+            then BS.empty+            else encodeUtf8 $ '#' `T.cons` src+        , BS.pack "] "+        , BS.pack "["+        , time+        , BS.pack "] "+        , case msg of+            LS s -> encodeUtf8 $ pack s+            LB b -> b+        , BS.pack " @("+        , encodeUtf8 $ pack (fileLocStr loc)+        , BS.pack ")\n"+        ]+#endif++-- taken from file-location package+-- turn the TH Loc loaction information into a human readable string+-- leaving out the loc_end parameter+fileLocStr :: Loc -> String+fileLocStr loc = loc_package loc ++ ':' : loc_module loc +++  ' ' : loc_filename loc ++ ':' : line loc ++ ':' : char loc+  where line = show . fst . loc_start+        char = show . snd . loc_start++defaultLogLevelStr :: LogLevel -> LogStr+defaultLogLevelStr level = case level of+    LevelOther t -> toLogStr t+    _            -> toLogStr $ BS.pack $ drop 5 $ show level++isDefaultLoc :: Loc -> Bool+isDefaultLoc (Loc "<unknown>" "<unknown>" "<unknown>" (0,0) (0,0)) = True+isDefaultLoc _                                                     = False++withStdOutTimedFastLogger :: (TimedFastLogger -> IO a) -> IO a+withStdOutTimedFastLogger f = do+  tc <- newTimeCache "%Y-%m-%d %T"+  withTimedFastLogger tc (LogStdout defaultBufSize) $ \logger -> f logger++runTimedLogT :: MonadIO m => LogLevel -> TimedFastLogger -> LoggingT m a -> m a+runTimedLogT logLevel logger =+  runTimedFastLoggerLoggingT logger . filterLogger (\_ lvl -> lvl >= logLevel)++-- | Run a block using a 'TimedFastLogger'.+runTimedFastLoggerLoggingT :: TimedFastLogger -> LoggingT m a -> m a+runTimedFastLoggerLoggingT tfl m = runLoggingT m $ \a b c d -> tfl (defaultTimedLogStr a b c d)

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}