{-# 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 ]