micrologger 0.4.0.1 → 0.5.0.0

raw patch · 7 files changed

+119/−88 lines, 7 filesdep +bytestringdep +lensPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, lens

API changes (from Hackage documentation)

Files

• micrologger.cabal +29/−17
• src/LuminescentDreams/Logger.hs +12/−11
• src/LuminescentDreams/Logger/Internal.hs +0/−31
• src/LuminescentDreams/Logger/JSON.hs +15/−11
• src/LuminescentDreams/Logger/Standard.hs +20/−14
• src/LuminescentDreams/Logger/Types.hs +38/−0
• test/LogSpec.hs +5/−4

@@ -1,35 +1,47 @@ name:                micrologger-version:             0.4.0.1-synopsis:            A super simple logging module. Only for use for very simple projects.-description:         A super simple logging module. Only for use for very simple projects.+version:             0.5.0.0+synopsis:            A super simple logging module.+description:         A super simple logging module that primarily outputs json-formatted messages. homepage:            https://github.com/savannidgerinel/micrologger#readme license:             BSD3 license-file:        LICENSE author:              Savanni D'Gerinel-maintainer:          savanni@savannidgerinel.com-copyright:           2016 Savanni D'Gerinel+maintainer:          savanni@luminescent-dreams.com+copyright:           2016 - 2017 Savanni D'Gerinel category:            Web build-type:          Simple -- extra-source-files: cabal-version:       >=1.10 +flag dev+    description:        Turn on development settings+    manual:             True+    default:            False++ library-  hs-source-dirs:       src-  default-language:     Haskell2010-  ghc-options:          -Wall+    hs-source-dirs:     src+    default-language:   Haskell2010 -  exposed-modules:      LuminescentDreams.Logger-                        LuminescentDreams.Logger.Internal+    if flag(dev)+        ghc-options:    -Wall+    else +        ghc-options:    -Wall -Werror++    exposed-modules:    LuminescentDreams.Logger                         LuminescentDreams.Logger.JSON                         LuminescentDreams.Logger.Standard+                        LuminescentDreams.Logger.Types -  build-depends:          base          >= 4.7    && < 5-                        , aeson         >= 1.0    && < 1.1-                        , containers    >= 0.5.6  && < 0.6-                        , text          >= 1.2    && < 1.3-                        , text-format   >= 0.3    && < 0.4-                        , time          >= 1.5    && < 1.7-                        , transformers  >= 0.4    && < 0.6+    build-depends:        base          >= 4.7      && < 5+                        , aeson         >= 1.0      && < 1.1+                        , bytestring    >= 0.10     && < 0.11+                        , containers    >= 0.5.6    && < 0.6+                        , lens          >= 4.15     && < 4.16+                        , text          >= 1.2      && < 1.3+                        , text-format   >= 0.3      && < 0.4+                        , time          >= 1.5      && < 1.7+                        , transformers  >= 0.4      && < 0.6  test-suite micrologger-test   type:               exitcode-stdio-1.0

@@ -11,27 +11,28 @@   )   where -import           LuminescentDreams.Logger.Internal+import           LuminescentDreams.Logger.Types import           LuminescentDreams.Logger.JSON        as X import           LuminescentDreams.Logger.Standard    as X  import           Data.Monoid import           Data.IORef                           (IORef, modifyIORef)-import qualified Data.Text.Lazy                       as T+import qualified Data.Text                            as T import           System.IO                            (IOMode(..), hPutStrLn, hFlush, withFile, stdout)  {- | Ordinary configurations for a file-based logger. -}-data LogConfig = Stdout LogLevel-               | Buffer (IORef T.Text) LogLevel-               | FileLog FilePath LogLevel+data LogConfig = Stdout LogLevel T.Text [T.Text]+               | Buffer (IORef T.Text) LogLevel T.Text [T.Text]+               | FileLog FilePath LogLevel T.Text [T.Text]   {- | Run an IO action with a log safely available. Logs will be properly closed in the case of an exception. Logging is meant to happen to a file, specified in LogConfig, so this may not be suitable if you want to log to a different resource. -} withLogger :: LogConfig -> (Logger -> IO a) -> IO a-withLogger (Stdout level) act =-  act (Logger (\m -> putStrLn (T.unpack m) >> hFlush stdout) level)-withLogger (Buffer ref level) act =-  act (Logger (\m -> modifyIORef ref (\buf -> buf <> m <> T.pack "\n")) level)-withLogger (FileLog path level) act =+withLogger (Stdout level app tags) act =+  act (Logger (\m -> putStrLn (T.unpack m) >> hFlush stdout) level app tags)+withLogger (Buffer ref level app tags) act =+  act (Logger (\m -> modifyIORef ref (\buf -> buf <> m <> T.pack "\n")) level app tags)+withLogger (FileLog path level app tags) act =   withFile path AppendMode $ \h ->-    act (Logger (\m -> hPutStrLn h (T.unpack m) >> hFlush h) level)+    act (Logger (\m -> hPutStrLn h (T.unpack m) >> hFlush h) level app tags)+

@@ -1,31 +0,0 @@-{- | Internal definitions. Do not import directly. -}-module LuminescentDreams.Logger.Internal where--import qualified Data.Text.Buildable      as TFB-import qualified Data.Text.Lazy           as T--{- | An ordinary hierarchy of logging priorities. -}-data LogLevel = LogDebug-              | LogInfo-              | LogWarning-              | LogError-              | LogEmergency-              deriving (Eq, Ord, Show)--tzFormat :: String-tzFormat = "%Y-%m-%dT%H:%M:%S%Q%z"--{- | The primary data structure to contain a logger of any kind. -}-data Logger = Logger { logCmd_ :: (T.Text -> IO ())-                       -- ^ Any IO action that accepts the log message-                     , lvl_ :: LogLevel-                       -- ^ The minimum level at which a log message should be accepted-                     }--{- | Generate standard text representations of a log level. This is useful to the Standard logger but may not be interesting to any others. -}-instance TFB.Buildable LogLevel where-  build LogDebug      = TFB.build ("DEBUG" :: String)-  build LogInfo       = TFB.build ("INFO" :: String)-  build LogWarning    = TFB.build ("WARNING" :: String)-  build LogError      = TFB.build ("ERROR" :: String)-  build LogEmergency  = TFB.build ("EMERGENCY" :: String)

@@ -6,28 +6,32 @@ module LuminescentDreams.Logger.JSON ( logMsgJs, formatMsgJs ) where  import           Control.Monad            (when)-import           Data.Monoid+import qualified Data.ByteString.Lazy     as BL import qualified Data.Aeson               as Aeson import qualified Data.Map                 as M+import           Data.Monoid import           Data.String import qualified Data.Text.Format         as TF-import qualified Data.Text.Lazy.Encoding  as TEnc+import qualified Data.Text                as T+import qualified Data.Text.Encoding       as TEnc+import qualified Data.Text.Lazy           as TL import qualified Data.Time                as Time-import qualified Data.Text.Lazy           as T -import           LuminescentDreams.Logger.Internal+import           LuminescentDreams.Logger.Types -{- | Log a message in LogZ format. This uses `formatMsgJs` to generate the actual format string. -} logMsgJs :: Logger -> LogLevel -> [(String, Aeson.Value)] -> IO ()-logMsgJs (Logger writer pri) lvl msg =+logMsgJs (Logger writer pri app_ tags_) lvl msg =     when (lvl >= pri) $ do         t <- Time.getCurrentTime-        writer $ formatMsgJs t lvl msg+        writer $ formatMsgJs app_ tags_ t lvl msg  {- | Format a message for LogZ JSON format. -}-formatMsgJs :: Time.UTCTime -> LogLevel -> [(String, Aeson.Value)] -> T.Text-formatMsgJs time level msg =+formatMsgJs :: T.Text -> [T.Text] -> Time.UTCTime -> LogLevel -> [(String, Aeson.Value)] -> T.Text+formatMsgJs application tags time level msg =   let msg_ = msg <> [ ("@timestamp", fromString $ Time.formatTime Time.defaultTimeLocale tzFormat time)-                    , ("@level", Aeson.String $ T.toStrict $ TF.format "{}" (TF.Only level))+                    , ("@level", Aeson.String $ TL.toStrict $ TF.format "{}" (TF.Only level))+                    , ("@tags", Aeson.toJSON tags)+                    , ("@app", Aeson.String application)                     ]-  in TEnc.decodeUtf8 $ Aeson.encode $ M.fromList msg_+  in TEnc.decodeUtf8 $ BL.toStrict $ Aeson.encode $ M.fromList msg_+

@@ -2,17 +2,18 @@ {-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE OverloadedStrings      #-} {-# OPTIONS_GHC -fno-warn-orphans   #-}-module LuminescentDreams.Logger.Standard ( logMsgStd, formatMsgStd ) where+module LuminescentDreams.Logger.Standard where  import           Control.Monad            (when) import           Data.Monoid import qualified Data.Text.Format         as TF-import qualified Data.Text.Lazy           as T+import qualified Data.Text                as T+import qualified Data.Text.Lazy           as TL import qualified Data.Text.Buildable      as TFB import qualified Data.Time                as Time import qualified Data.List                as List -import           LuminescentDreams.Logger.Internal+import           LuminescentDreams.Logger.Types   data LogMsg = LogMsg LogLevel [(String, String)] String@@ -21,23 +22,28 @@ logMsgStd l lvl tags text = logMsg_ l (LogMsg lvl tags text)  logMsg_ :: Logger -> LogMsg -> IO ()-logMsg_ (Logger writer pri) msg@(LogMsg lvl _ _) =+logMsg_ (Logger writer pri app tags) msg@(LogMsg lvl _ _) =     when (lvl >= pri) $ do         t <-  Time.getCurrentTime-        writer $ formatMsgStd t msg+        writer $ formatMsgStd app tags t msg  -formatMsgStd :: Time.UTCTime -> LogMsg -> T.Text-formatMsgStd t (LogMsg lvl tags text) =-  TF.format "{} {} {} {}" (Time.formatTime Time.defaultTimeLocale tzFormat t, lvl, tags, text)+formatMsgStd :: T.Text -> [T.Text] -> Time.UTCTime -> LogMsg -> T.Text+formatMsgStd _ _ t (LogMsg lvl tags text) =+    TL.toStrict $ TF.format "{} {} {} {}" ( Time.formatTime Time.defaultTimeLocale tzFormat t+                                          , lvl+                                          , tags+                                          , text+                                          )   instance TFB.Buildable (String, String) where-  build (name, value) = TFB.build $ "(" <> name <> ", " <> value <> ")"+    build (name, value) = TFB.build $ "(" <> name <> ", " <> value <> ")"  instance TFB.Buildable [(String, String)] where-  -- build lst = TFB.build "[" <> TFB.build `fmap` lst "]"-  build lst =-    mconcat $ [TFB.build ("[" :: String)]-           <> List.intersperse (TFB.build (", " :: String)) (TFB.build `fmap` lst)-           <> [TFB.build ("]" :: String)]+    -- build lst = TFB.build "[" <> TFB.build `fmap` lst "]"+    build lst =+        mconcat $ [TFB.build ("[" :: String)]+               <> List.intersperse (TFB.build (", " :: String)) (TFB.build `fmap` lst)+               <> [TFB.build ("]" :: String)]+

@@ -0,0 +1,38 @@+{-# LANGUAGE TemplateHaskell    #-}+{- | Logger type definitions -}+module LuminescentDreams.Logger.Types where++import           Control.Lens+import qualified Data.Text.Buildable      as TFB+import qualified Data.Text                as T++{- | An ordinary hierarchy of logging priorities. -}+data LogLevel = LogDebug+              | LogInfo+              | LogWarning+              | LogError+              | LogEmergency+              deriving (Eq, Ord, Show)++tzFormat :: String+tzFormat = "%Y-%m-%dT%H:%M:%S%Q%z"++{- | The primary data structure to contain a logger of any kind. -}+data Logger = Logger { _logCmd  :: (T.Text -> IO ())+                       -- ^ Any IO action that accepts the log message+                     , _logLvl  :: LogLevel+                     , _logApp  :: T.Text+                     , _logTags :: [T.Text]+                       -- ^ The minimum level at which a log message should be accepted+                     }++{- | Generate standard text representations of a log level. This is useful to the Standard logger but may not be interesting to any others. -}+instance TFB.Buildable LogLevel where+  build LogDebug      = TFB.build ("DEBUG" :: String)+  build LogInfo       = TFB.build ("INFO" :: String)+  build LogWarning    = TFB.build ("WARNING" :: String)+  build LogError      = TFB.build ("ERROR" :: String)+  build LogEmergency  = TFB.build ("EMERGENCY" :: String)++makeLenses ''Logger+

@@ -5,7 +5,7 @@ import           Data.Aeson       (Value(..), toJSON) import           Data.Monoid import qualified Data.IORef       as IORef-import qualified Data.Text.Lazy   as T+import qualified Data.Text        as T import           Test.Hspec  import           LuminescentDreams.Logger@@ -13,11 +13,12 @@ writeBuffer :: IORef.IORef [T.Text] -> T.Text -> IO () writeBuffer buffer text = IORef.modifyIORef' buffer (\lst -> lst <> [text]) + basicLogger :: Spec basicLogger = describe "demonstrate IO output" $ do   it "outputs in the standard format" $ do     logRef <- IORef.newIORef []-    let l = Logger (writeBuffer logRef) LogDebug+    let l = Logger (writeBuffer logRef) LogDebug "test" []     logMsgStd l LogInfo [("name", "value")] "message"     logMsgStd l LogInfo [("name", "value")] "message2"     IORef.readIORef logRef >>= flip forM_ (putStrLn . T.unpack)@@ -27,7 +28,7 @@ jsonLogger = describe "demonstrate the JSON logger with IO output" $ do   it "outputs in the JSON format" $ do     logRef <- IORef.newIORef []-    let l = Logger (writeBuffer logRef) LogDebug+    let l = Logger (writeBuffer logRef) LogDebug "test" []     logMsgJs l LogInfo [("name", String "value"), ("timing", toJSON (0.5 :: Float)), ("msg", String "message")]     logMsgJs l LogInfo [("name", String "value"), ("timing", toJSON (0.5 :: Float)), ("msg", String "message2")]     IORef.readIORef logRef >>= flip forM_ (putStrLn . T.unpack)@@ -39,7 +40,7 @@    it "outputs to a file buffer" $ do     logRef <- IORef.newIORef T.empty-    withLogger (Buffer logRef LogInfo) $ \l -> do+    withLogger (Buffer logRef LogInfo "test" []) $ \l -> do       logMsgStd l LogInfo [("name", "value")] "message"       logMsgStd l LogDebug [("name", "value")] "message2"       logMsgJs l LogDebug [("name", String "value"), ("timing", toJSON (0.5 :: Float)), ("msg", String "message")]