little-logger 0.3.1 → 0.3.2

raw patch · 3 files changed

+51/−7 lines, 3 filesdep +directorydep +temporary

Dependencies added: directory, temporary

Files

• little-logger.cabal +5/−3
• src/LittleLogger/Common.hs +29/−3
• test/Main.hs +17/−1

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: b0fef8080b3eeaf20d63bd78a5dd95fd681c385a40581ee6fb4821e795a0da4d+-- hash: 110790790f5c519685b242fae0c899af7c2e6b43e4528a46e120286c9f8410c0  name:           little-logger-version:        0.3.1+version:        0.3.2 synopsis:       Basic logging based on co-log description:    Please see the README on GitHub at <https://github.com/ejconlon/little-logger#readme> category:       Logging@@ -59,11 +59,13 @@       base >=4.12 && <5     , co-log >=0.4 && <1     , co-log-core >=0.2 && <1+    , directory >=1.3.6.0 && <1.4     , little-logger     , microlens >=0.4 && <1     , mtl >=2.2 && <3     , tasty >=1.2.3 && <2     , tasty-hunit >=0.10.0.2 && <1+    , temporary ==1.3.*     , text >=1.2 && <2     , unliftio-core >=0.1.2.0 && <2   default-language: Haskell2010

@@ -9,14 +9,20 @@   , newSimpleLogAction   , runLogAction   , runSimpleLogAction+  , handleSimpleLogAction+  , openLoggingHandle+  , closeLoggingHandle+  , fileSimpleLogAction   ) where -import Colog.Actions (richMessageAction)-import Colog.Core.Action (LogAction (..))+import Colog.Actions (logByteStringHandle, richMessageAction)+import Colog.Core.Action (LogAction (..), cmapM) import Colog.Core.Severity (Severity (..))-import Colog.Message (Message, Msg (..))+import Colog.Message (Message, Msg (..), defaultFieldMap, fmtRichMessageDefault, upgradeMessageAction) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.IO.Unlift (MonadUnliftIO, askRunInIO)+import Data.Text.Encoding (encodeUtf8)+import System.IO (BufferMode (LineBuffering), Handle, IOMode (AppendMode), hClose, hSetBuffering, openFile, withFile)  type SimpleLogAction = LogAction IO Message @@ -34,3 +40,23 @@  filterActionSeverity :: Severity -> SimpleLogAction -> SimpleLogAction filterActionSeverity lim (LogAction f) = LogAction (\msg -> if msgSeverity msg >= lim then f msg else pure ())++handleSimpleLogAction :: Handle -> SimpleLogAction+handleSimpleLogAction handle =  upgradeMessageAction defaultFieldMap $+    cmapM (fmap encodeUtf8 . fmtRichMessageDefault) (logByteStringHandle handle)++openLoggingHandle :: MonadIO m => FilePath -> m Handle+openLoggingHandle fp = do+  handle <- liftIO (openFile fp AppendMode)+  liftIO (hSetBuffering handle LineBuffering)+  pure handle++closeLoggingHandle :: MonadIO m => Handle -> m ()+closeLoggingHandle = liftIO . hClose++fileSimpleLogAction :: MonadUnliftIO m => FilePath -> (SimpleLogAction -> m a) -> m a+fileSimpleLogAction fp f = do+  run <- askRunInIO+  liftIO $ withFile fp AppendMode $ \handle -> do+    hSetBuffering handle LineBuffering+    run (f (handleSimpleLogAction handle))

@@ -3,10 +3,14 @@  module Main (main) where +import Control.Exception (finally) import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Data.Text (Text) import LittleLogger (LogAction (LogAction), Msg (msgSeverity, msgText), Severity (..), SimpleLogAction, WithSimpleLog,-                     filterActionSeverity, logDebug, logError, logInfo, logWarning, runWithSimpleLogAction)+                     fileSimpleLogAction, filterActionSeverity, logDebug, logError, logInfo, logWarning,+                     runWithSimpleLogAction)+import System.Directory (removeFile)+import System.IO.Temp (emptySystemTempFile) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (testCase, (@?=)) @@ -49,8 +53,20 @@   actual <- runWithRefAction (filterActionSeverity Warning) emitLogs   actual @?= expectedFiltered +testFile :: TestTree+testFile = testCase "File" $ do+  fp <- emptySystemTempFile "little-logger-test"+  flip finally (removeFile fp) $ do+    fileSimpleLogAction fp (`runWithSimpleLogAction` emitLogs)+    firstContents <- readFile fp+    length (lines firstContents) @?= 4+    fileSimpleLogAction fp (`runWithSimpleLogAction` emitLogs)+    secondContents <- readFile fp+    length (lines secondContents) @?= 8+ main :: IO () main = defaultMain $ testGroup "LittleLogger" $   [ testUnfiltered   , testFiltered+  , testFile   ]