TypesSpec.hs

{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE StandaloneDeriving #-}

module Logging.TypesSpec ( spec ) where

import           Data.Default
import           Data.String           (fromString)
import           Data.Time.Clock
import           Data.Time.Format      as TF
import           Data.Time.LocalTime
import           System.FilePath
import           Test.Hspec
import           Test.Hspec.QuickCheck
import           Test.QuickCheck
import           Text.Printf

import           Logging.Types

spec :: Spec
spec = levelSpec >> formatterSpec


levelSpec :: Spec
levelSpec = describe "Level" $ modifyMaxSize (const 1000) $ do
  prop "read and show" $ \x -> (read . show) (Level x) == (Level x)
  prop "overload string" $ \x -> fromString (show (Level x)) == (Level x)


formatterSpec :: Spec
formatterSpec = describe "Formatter" $ modifyMaxSize (const 1000) $ do
    -- one field only
    fmtProp "%(logger)s" "LogRecord's logger record" loggerFmt
    fmtProp "%(level)s" "LogRecord's level record" levelFmt
    fmtProp "%(message)s" "LogRecord's message record" message
    fmtProp "%(pathname)s" "LogRecord's filename (dir) record" pathnameFmt
    fmtProp "%(filename)s" "LogRecord's filename (no dir) record" filenameFmt
    fmtProp "%(module)s" "LogRecord's modulename record" modulename
    fmtProp "%(lineno)d" "LogRecord's lineno record" $ show . lineno
    fmtProp "%(created)f"
          "LogRecord's created (decimal second timestamp) record"
          createdFmt
    fmtProp "%(msecs)d"
          "LogRecord's created (millisecond timestamp) record"
          msecsFmt
    dateProp "%(asctime)s" "%Y-%m-%dT%H:%M:%S"
              "LogRecord's created (human friendly) record"
              asctimeFmt
    -- mixed fields
    dateProp
      "%(asctime)s - %(level)s - %(logger)s" "%Y-%m-%dT%H:%M:%S"
      "LogRecord's created (human friendly) - level - logger records"
      asctimeLevelLoggerFmt
    fmtProp "%(pathname)s/%(filename)s" "LogRecord's filename (/ split) record"
      pathnameFilenameFmt
    fmtProp "%(lineno)d] %(message)s" "LogRecord's lineno] message records"
      linenoMessageFmt
  where
    fmtProp :: String -> String -> (LogRecord -> String)
          -> SpecWith (Arg Property)
    fmtProp fmt desc manualFmt = prop (printf "format %s to %s" fmt desc) $
      \rcd -> format (def {fmt = fmt}) rcd == manualFmt rcd

    dateProp :: String -> String -> String -> (LogRecord -> String)
              -> SpecWith (Arg Property)
    dateProp fmt datefmt desc manualFmt =
      prop (printf "format %s(%s) to %s" fmt datefmt desc) $
        \rcd -> format (Formatter fmt datefmt) rcd == manualFmt rcd

    loggerFmt = \LogRecord{..} -> logger
    levelFmt = \LogRecord{..} -> show level
    pathnameFmt = takeDirectory . filename
    filenameFmt = takeFileName . filename
    createdFmt = (printf "%f") . zt2timestamp . created
    msecsFmt = show . zt2millisecs . created
    asctimeFmt = TF.formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" . created
    asctimeLevelLoggerFmt rcd =
      asctimeFmt rcd ++ " - " ++ (levelFmt rcd) ++ " - " ++(loggerFmt rcd)
    pathnameFilenameFmt rcd = pathnameFmt rcd ++ "/" ++ (filenameFmt rcd)
    linenoMessageFmt rcd = (show $ lineno rcd) ++ "] " ++ (message rcd)


deriving instance Show LogRecord


instance Arbitrary LogRecord where
  arbitrary = LogRecord
           <$> arbitrary
           <*> (Level <$> arbitrary)
           <*> arbitrary
           <*> arbitrary
           <*> arbitrary
           <*> arbitrary
           <*> arbitrary
           <*> (((`addZonedTime` zeroTime) . toEnum) <$> arbitrary)


addZonedTime :: NominalDiffTime -> ZonedTime -> ZonedTime
addZonedTime ndt zt@(ZonedTime _ tz) =
  utcToZonedTime tz $ addUTCTime ndt $ zonedTimeToUTC zt

diffZonedTime :: ZonedTime -> ZonedTime -> NominalDiffTime
diffZonedTime zt1 zt2 = diffUTCTime (zonedTimeToUTC zt1) (zonedTimeToUTC zt2)

zeroTime :: ZonedTime
zeroTime = read "1970-01-01 00:00:00"

zt2timestamp :: ZonedTime -> Double
zt2timestamp zt = fromRational $ toRational $ diffZonedTime zt zeroTime

zt2millisecs :: ZonedTime -> Integer
zt2millisecs zt = round $ zt2timestamp zt * 1000