{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} module LoggingTest.TypesSpec ( spec ) where import Control.Lens hiding (Level (..)) import Control.Monad import Data.Default (def) import Data.Generics.Product.Typed import Data.IORef import Data.String (fromString) import Prelude hiding (filter) import System.IO import System.Process (createPipe) import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck import Test.QuickCheck.Monadic import Logging.Prelude import Logging.Types import LoggingTest.Prelude spec :: Spec spec = do levelSpec filterSpec handlerSpec levelSpec :: Spec levelSpec = describe "Level" $ do prop "read & show" $ \v -> let level = Level v in read (show level) == level prop "overload string" $ \v -> let level = Level v in fromString (show level) == level filterSpec :: Spec filterSpec = describe "Filter" $ do prop "pass" $ \rcd@LogRecord{..} -> let filterer = map fromString $ [logger, parent logger, parent $ parent logger, ""] in filter (filterer :: Filterer) rcd prop "reject" $ \rcd@LogRecord{..} -> let filters = map (fromString . (++ "Test")) $ [logger, parent logger, parent $ parent logger, ""] in all (== False) [filter (f :: Filter) rcd | f <- filters] handlerSpec :: Spec handlerSpec = describe "Handler" $ do (read, write) <- runIO createPipe fileRef <- runIO $ newIORef undefined rotateFileRef <- runIO $ newIORef undefined runIO $ hSetEncoding read utf8 >> hSetEncoding write utf8 let handler = toHandler $ StreamHandler def [] "{message}" write fileHandler = toHandler $ FileHandler def [] "{message}" "/tmp/log4hs/file.log" utf8 fileRef rotateHandler = toHandler $ RotatingFileHandler def [] "{message}" "/tmp/log4hs/rotate.log" utf8 1000 5 rotateFileRef runIO $ open handler >> open fileHandler >> open rotateHandler prop "filter" $ \(rcd@LogRecord{..}) -> monadicIO $ do let loggers = [logger, parent logger, parent $ parent logger, ""] -- level reject forM_ logger $ \logger -> do let handler' = handler & typed @Level .~ (succ level) res <- run $ handle handler' rcd assert $ not res -- filterer reject forM_ loggers $ \logger -> do let handler' = handler & typed @Filterer .~ [fromString $ logger ++ "Test"] res <- run $ handle handler' rcd assert $ not res -- filterer pass forM_ loggers $ \logger -> do let handler' = handler & typed @Filterer .~ [fromString logger] res <- run $ handle handler' rcd msg <- run $ hTryGetLine read assert res assert (msg == message) -- empty filterer res <- run $ handle handler rcd msg <- run $ hTryGetLine read assert res assert (msg == message) prop "file" $ \(rcd@LogRecord{..}) -> monadicIO $ do file <- run $ readIORef fileRef run $ hSetFileSize file 0 >> hSeek file AbsoluteSeek 0 run $ handle fileHandler rcd run $ hSeek file AbsoluteSeek 0 msg <- run $ hTryGetLine file assert (msg == message) prop "rotate" $ \(rcd, Alphabet c) -> monadicIO $ do file <- run $ readIORef rotateFileRef run $ hSetFileSize file 0 >> hSeek file AbsoluteSeek 0 let message = replicate 99 c rcd' = rcd { message = message } -- not rollover yet run $ forM [1..9] $ \_ -> handle rotateHandler rcd' run $ hSeek file AbsoluteSeek 0 msgs <- run $ forM [1..9] $ \_ -> hTryGetLine file assert $ all (== message) msgs -- rollover run $ handle rotateHandler rcd' closed <- run $ hIsClosed file assert closed pos <- run $ readIORef rotateFileRef >>= hTell assert (pos == 0) -- rotate.1.log file1 <- run $ openLogFile "/tmp/log4hs/rotate.1.log" utf8 run $ hSeek file1 AbsoluteSeek 0 msgs1 <- run $ forM [1..10] $ \_ -> hTryGetLine file1 run $ hClose file1 assert $ all (== message) msgs1 -- rollover again file' <- run $ readIORef rotateFileRef run $ forM [1..10] $ \_ -> handle rotateHandler rcd' closed1 <- run $ hIsClosed file' assert closed1 -- rotate.2.log file2 <- run $ openLogFile "/tmp/log4hs/rotate.2.log" utf8 run $ hSeek file2 AbsoluteSeek 0 msgs2 <- run $ forM [1..10] $ \_ -> hTryGetLine file2 run $ hClose file2 -- rotate.2.log assert $ all (== message) msgs2