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