TypesSpec.hs

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