Prelude.hs

{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE RecordWildCards #-}

module LoggingTest.Prelude
  ( Alphabet(..)
  , LoggerString(..)
  , MessageString(..)
  , hTryGetLine
  , parent
  , runLog
  , createFile
  ) where


import           Control.Monad
import           Data.Aeson
import           Data.List           (dropWhileEnd, intersperse)
import           Data.String
import           Data.Time.LocalTime
import           System.Directory
import           System.FilePath
import           System.IO
import           Test.QuickCheck

import qualified Logging.Global
import           Logging.Level
import           Logging.Logger
import           Logging.Manager
import           Logging.Prelude
import           Logging.Record


data Alphabet = Alphabet { getAlphabet :: Char } deriving Show

instance Arbitrary Alphabet where
  arbitrary = Alphabet <$> elements ['a'..'z']


instance Arbitrary Level where
  arbitrary = (Level . getNonNegative) <$> arbitrary


newtype LoggerString = LoggerString { getLoggerString :: Logger }

instance Arbitrary LoggerString where
  arbitrary = do
    ls <- listOf (elements ['A'..'Z'])
    return $ LoggerString $ intersperse '.' $ ls


newtype MessageString = MessageString { getMessageString :: String
                                      } deriving Show

instance Arbitrary MessageString where
  arbitrary = do
    ms <- forM [1..99] $ \_ -> arbitraryUnicodeChar `suchThat` (/= '\n')
    return $ MessageString ms


instance Arbitrary LogRecord where
  arbitrary = do
    logger <- getLoggerString <$> arbitrary
    level <- arbitrary
    message <- getMessageString <$> arbitrary
    pathname <- arbitrary
    filename <- arbitrary
    pkgname <- arbitrary
    modulename <- arbitrary
    lineno <- arbitrary
    let asctime = read "1970-01-01 00:00:00"
        utctime = zonedTimeToUTC asctime
        difftime = zonedTimeToPOSIXSeconds asctime
        created = timestamp difftime
        msecs   = milliseconds difftime
        thread = undefined
        context = Null
    return $ LogRecord{..}


hTryGetLine :: Handle -> IO String
hTryGetLine hdl = do
  ready <- hReady hdl
  if ready then hGetLine hdl else return ""


parent :: Logger -> Logger
parent = dropWhileEnd (== '.') . dropWhileEnd (/= '.')


runLog :: Manager -> IO a -> IO a
runLog = Logging.Global.run


createFile :: FilePath -> IO ()
createFile path = do
  file <- makeAbsolute path
  createDirectoryIfMissing True $ takeDirectory file
  openFile file ReadWriteMode >>= hClose