micrologger 0.2.0.1 → 0.3.0.0
raw patch · 7 files changed
+165/−92 lines, 7 filesdep +aesondep +containersdep +hspecdep ~basedep ~text
Dependencies added: aeson, containers, hspec, micrologger
Dependency ranges changed: base, text
Files
- micrologger.cabal +25/−19
- src/LuminescentDreams/Logger.hs +5/−73
- src/LuminescentDreams/Logger/Internal.hs +20/−0
- src/LuminescentDreams/Logger/JSON.hs +28/−0
- src/LuminescentDreams/Logger/Standard.hs +47/−0
- test/LogSpec.hs +39/−0
- test/Spec.hs +1/−0
micrologger.cabal view
@@ -1,5 +1,5 @@ name: micrologger-version: 0.2.0.1+version: 0.3.0.0 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. homepage: https://github.com/savannidgerinel/micrologger#readme@@ -19,26 +19,32 @@ ghc-options: -Wall exposed-modules: LuminescentDreams.Logger+ LuminescentDreams.Logger.Internal+ LuminescentDreams.Logger.JSON+ LuminescentDreams.Logger.Standard - 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+ build-depends: base >= 4.7 && < 5+ , aeson >= 0.9 && < 0.12+ , containers >= 0.5.6 && < 0.6+ , text >= 1.2 && < 1.3+ , text-format >= 0.3 && < 0.4+ , time >= 1.5 && < 1.6+ , transformers >= 0.4 && < 0.5 --- 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+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,9 @@-{-# 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+ module X+ , LogLevel(..), Logger(..) ) where --- 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---{--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)--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 ()---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)---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 <> ")"--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)]+import LuminescentDreams.Logger.Internal+import LuminescentDreams.Logger.JSON as X+import LuminescentDreams.Logger.Standard as X
+ src/LuminescentDreams/Logger/Internal.hs view
@@ -0,0 +1,20 @@+module LuminescentDreams.Logger.Internal where++import qualified Data.Text.Buildable as TFB+import qualified Data.Text.Lazy as T++data LogLevel = LogDebug+ | LogInfo+ | LogWarning+ | LogError+ | LogEmergency+ deriving (Eq, Ord)++data Logger = Logger (T.Text -> IO ()) LogLevel++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)
+ src/LuminescentDreams/Logger/JSON.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+module LuminescentDreams.Logger.JSON ( logMsgJs, formatMsgJs ) where++import Data.Monoid+import qualified Data.Aeson as Aeson+import qualified Data.Map as M+import Data.String+import qualified Data.Text.Format as TF+import qualified Data.Text.Lazy.Encoding as TEnc+import qualified Data.Time as Time+import qualified Data.Text.Lazy as T++import LuminescentDreams.Logger.Internal++logMsgJs :: Logger -> LogLevel -> [(String, Aeson.Value)] -> IO ()+logMsgJs (Logger writer pri) lvl msg =+ if lvl >= pri+ then do+ t <- Time.getCurrentTime+ writer $ formatMsgJs t lvl msg+ else return ()++formatMsgJs :: Time.UTCTime -> LogLevel -> [(String, Aeson.Value)] -> T.Text+formatMsgJs time level msg =+ let msg_ = msg <> [ ("@timestamp", fromString $ Time.formatTime Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S" time)+ , ("@level", Aeson.String $ T.toStrict $ TF.format "{}" (TF.Only level))+ ]+ in TEnc.decodeUtf8 $ Aeson.encode $ M.fromList msg_
+ src/LuminescentDreams/Logger/Standard.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module LuminescentDreams.Logger.Standard ( logMsgStd, formatMsgStd ) where++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++import LuminescentDreams.Logger.Internal+++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) msg@(LogMsg lvl _ _) =+ if lvl >= pri+ then do+ t <- Time.getCurrentTime+ writer $ formatMsgStd t msg+ else return ()+++formatMsgStd :: Time.UTCTime -> LogMsg -> T.Text+formatMsgStd t (LogMsg lvl tags text) =+ TF.format "{} {} {} {}" (Time.formatTime Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S" 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)]
+ test/LogSpec.hs view
@@ -0,0 +1,39 @@+{-# 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.Lazy 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+ 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+ 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)+++spec :: Spec+spec = do+ basicLogger+ jsonLogger
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}