little-logger-1.0.2: test/Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import Control.Exception (finally)
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import Data.Text (Text)
import LittleLogger
  ( LogAction (..)
  , LogActionM
  , LogLevel (..)
  , fileLogAction
  , filterActionSeverity
  , logDebugN
  , logErrorN
  , logInfoN
  , logWarnN
  , runLogActionM
  , textLogStr
  )
import System.Directory (removeFile)
import System.IO.Temp (emptySystemTempFile)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))

emitLogs :: LogActionM ()
emitLogs = do
  logDebugN "debug"
  logInfoN "info"
  logWarnN "warn"
  logErrorN "error"

refAction :: IORef [(LogLevel, Text)] -> LogAction
refAction ref = LogAction (\_ _ lvl msg -> modifyIORef' ref (++ [(lvl, textLogStr msg)]))

runWithRefAction :: (LogAction -> LogAction) -> LogActionM () -> IO [(LogLevel, Text)]
runWithRefAction f m = do
  ref <- newIORef []
  let action = f (refAction ref)
  runLogActionM m action
  readIORef ref

expectedFiltered :: [(LogLevel, Text)]
expectedFiltered =
  [ (LevelWarn, "warn")
  , (LevelError, "error")
  ]

expectedUnfiltered :: [(LogLevel, Text)]
expectedUnfiltered =
  [ (LevelDebug, "debug")
  , (LevelInfo, "info")
  ]
    ++ expectedFiltered

testUnfiltered :: TestTree
testUnfiltered = testCase "Unfiltered" $ do
  actual <- runWithRefAction id emitLogs
  actual @?= expectedUnfiltered

testFiltered :: TestTree
testFiltered = testCase "Filtered" $ do
  actual <- runWithRefAction (filterActionSeverity LevelWarn) emitLogs
  actual @?= expectedFiltered

testFile :: TestTree
testFile = testCase "File" $ do
  fp <- emptySystemTempFile "little-logger-test"
  flip finally (removeFile fp) $ do
    fileLogAction fp (runLogActionM emitLogs)
    firstContents <- readFile fp
    length (lines firstContents) @?= 4
    fileLogAction fp (runLogActionM emitLogs)
    secondContents <- readFile fp
    length (lines secondContents) @?= 8

main :: IO ()
main =
  defaultMain $
    testGroup
      "LittleLogger"
      [ testUnfiltered
      , testFiltered
      , testFile
      ]