micrologger 0.2.0.1 → 0.5.0.0
raw patch · 7 files changed
Files
- micrologger.cabal +45/−27
- src/LuminescentDreams/Logger.hs +29/−68
- src/LuminescentDreams/Logger/JSON.hs +37/−0
- src/LuminescentDreams/Logger/Standard.hs +49/−0
- src/LuminescentDreams/Logger/Types.hs +38/−0
- test/LogSpec.hs +55/−0
- test/Spec.hs +1/−0
micrologger.cabal view
@@ -1,44 +1,62 @@ name: micrologger-version: 0.2.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+ if flag(dev)+ ghc-options: -Wall+ else + ghc-options: -Wall -Werror - build-depends: base >= 4.7 && < 5- , text >= 1.2 && < 1.3- , text-format >= 0.3 && < 0.4- , time >= 1.5 && < 1.6- , transformers >= 0.4 && < 0.5+ exposed-modules: LuminescentDreams.Logger+ LuminescentDreams.Logger.JSON+ LuminescentDreams.Logger.Standard+ LuminescentDreams.Logger.Types --- test-suite micrologger-test--- type: exitcode-stdio-1.0--- hs-source-dirs: test--- ghc-options: -threaded -rtsopts -with-rtsopts=-N--- default-language: Haskell2010--- main-is: Spec.hs------ other-modules: LogSpec------ build-depends: base--- , micrologger--- , hspec--- , text+ 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+ hs-source-dirs: test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010+ main-is: Spec.hs++ other-modules: LogSpec++ build-depends: base+ , micrologger+ , aeson+ , hspec+ , text source-repository head type: git
src/LuminescentDreams/Logger.hs view
@@ -1,77 +1,38 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module LuminescentDreams.Logger (- LogLevel(..), Logger(..), LogMsg, formatMsg, logMsg- )- where+{- | This is the main API module for the logger. You will generally want to import this directly. --- import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Monoid-import qualified Data.Text.Format as TF-import qualified Data.Text.Lazy as T-import qualified Data.Text.Buildable as TFB-import qualified Data.Time as Time-import qualified Data.List as List+Usage suggestions: -{--A writer monad running over a LogMsg. It can write to a variety of things. That has to be part of the structure. Pattern:--msg -> writer -> writer--writer -> writer is a data structure, specifically WriterM.--}------ class (Monoid w, Monad m) => MonadLogger w m where--- logMsg :: LogMsg -> w -> m a-------data LogLevel = LogDebug- | LogInfo- | LogWarning- | LogError- | LogEmergency- deriving (Eq, Ord)--data Logger = Logger (T.Text -> IO ()) LogLevel--data LogMsg = LogMsg LogLevel [(String, String)] String--logMsg :: Logger -> LogLevel -> [(String, String)] -> String -> IO ()-logMsg l lvl tags text = logMsg_ l (LogMsg lvl tags text)+ -}+module LuminescentDreams.Logger (+ module X+ , LogConfig(..), LogLevel(..), Logger(..)+ , withLogger+ )+ where -logMsg_ :: Logger -> LogMsg -> IO ()-logMsg_ (Logger writer pri) msg@(LogMsg lvl _ _) =- if lvl >= pri- then do- t <- Time.getCurrentTime- writer $ formatMsg t msg- else return ()+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 as T+import System.IO (IOMode(..), hPutStrLn, hFlush, withFile, stdout) -formatMsg :: Time.UTCTime -> LogMsg -> T.Text-formatMsg t (LogMsg lvl tags text) =- TF.format "{} {} {} {}" (Time.formatTime Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S" t, lvl, tags, text)+{- | Ordinary configurations for a file-based logger. -}+data LogConfig = Stdout LogLevel T.Text [T.Text]+ | Buffer (IORef T.Text) LogLevel T.Text [T.Text]+ | FileLog FilePath LogLevel T.Text [T.Text] -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)--instance TFB.Buildable (String, String) where- build (name, value) = TFB.build $ "(" <> name <> ", " <> value <> ")"+{- | 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 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 app tags) -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)]
+ src/LuminescentDreams/Logger/JSON.hs view
@@ -0,0 +1,37 @@+{- | Generate JSON logs compatible with LogZ.io. `logMsgJs` and `formatMsgJs` are both re-exported, so it should not be necessary to import this module directly.++TODO: Rename this to LogZ since it generates fields specific to that service.+-}+{-# LANGUAGE OverloadedStrings #-}+module LuminescentDreams.Logger.JSON ( logMsgJs, formatMsgJs ) where++import Control.Monad (when)+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 as T+import qualified Data.Text.Encoding as TEnc+import qualified Data.Text.Lazy as TL+import qualified Data.Time as Time++import LuminescentDreams.Logger.Types++logMsgJs :: Logger -> LogLevel -> [(String, Aeson.Value)] -> IO ()+logMsgJs (Logger writer pri app_ tags_) lvl msg =+ when (lvl >= pri) $ do+ t <- Time.getCurrentTime+ writer $ formatMsgJs app_ tags_ t lvl msg++{- | Format a message for LogZ JSON format. -}+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 $ TL.toStrict $ TF.format "{}" (TF.Only level))+ , ("@tags", Aeson.toJSON tags)+ , ("@app", Aeson.String application)+ ]+ in TEnc.decodeUtf8 $ BL.toStrict $ Aeson.encode $ M.fromList msg_+
+ src/LuminescentDreams/Logger/Standard.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module LuminescentDreams.Logger.Standard where++import Control.Monad (when)+import Data.Monoid+import qualified Data.Text.Format as TF+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.Types+++data LogMsg = LogMsg LogLevel [(String, String)] String++logMsgStd :: Logger -> LogLevel -> [(String, String)] -> String -> IO ()+logMsgStd l lvl tags text = logMsg_ l (LogMsg lvl tags text)++logMsg_ :: Logger -> LogMsg -> IO ()+logMsg_ (Logger writer pri app tags) msg@(LogMsg lvl _ _) =+ when (lvl >= pri) $ do+ t <- Time.getCurrentTime+ writer $ formatMsgStd app tags t msg+++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 <> ")"++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)]+
+ src/LuminescentDreams/Logger/Types.hs view
@@ -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+
+ test/LogSpec.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}+module LogSpec where++import Control.Monad (forM_)+import Data.Aeson (Value(..), toJSON)+import Data.Monoid+import qualified Data.IORef as IORef+import qualified Data.Text as T+import Test.Hspec++import LuminescentDreams.Logger++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 "test" []+ logMsgStd l LogInfo [("name", "value")] "message"+ logMsgStd l LogInfo [("name", "value")] "message2"+ IORef.readIORef logRef >>= flip forM_ (putStrLn . T.unpack)+++jsonLogger :: Spec+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 "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)+++loggerTypes :: Spec+loggerTypes = describe "verify that the built-in logger types work" $ do+ it "outputs to stdout" $ pendingWith "how does one even verify this?"++ it "outputs to a file buffer" $ do+ logRef <- IORef.newIORef T.empty+ 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")]+ logMsgJs l LogInfo [("name", String "value"), ("timing", toJSON (0.5 :: Float)), ("msg", String "message2")]+ IORef.readIORef logRef >>= putStrLn . T.unpack+++spec :: Spec+spec = do+ basicLogger+ jsonLogger+ loggerTypes
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}