{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}

import           Control.Concurrent.MVar
import           Control.Monad
import           Data.Aeson.QQ.Simple       (aesonQQ)
import           Data.Default               (def)
import           Data.List                  (intercalate, lines)
import qualified Data.Map                   as M
import           Data.String                (fromString)
import           Data.Time.LocalTime        (ZonedTime)
import           System.FilePath
import           System.IO
import           System.Process             (createPipe)
import           Test.Hspec
import           Test.Hspec.Core.QuickCheck (modifyMaxSize)
import           Test.QuickCheck
import qualified Test.QuickCheck.Monadic    as QC

import           Logging

main :: IO ()
main = hspec $ do
  describe "Level" $
    modifyMaxSize (const 1000) $ do
      it "read is reverse to show" $
        property $ \x -> (read . show) (Level x) == (Level x)
      it "overload string is equivalent to read" $
        property $ \x -> fromString (show (Level x)) == (Level x)

  describe "Formatter" $ do
    modifyMaxSize (const 1000) $ do
      it "format \"%(logger)s\" to LogRecord's logger record" $
        testFormatter (def {fmt = "%(logger)s"}) $ \LogRecord{..} -> logger
      it "format \"%(level)s\" to LogRecord's level record" $
        testFormatter (def {fmt = "%(level)s"}) $ \LogRecord{..} -> show level
      it "format \"%(message)s\" to LogRecord's message record" $
        testFormatter (def {fmt = "%(message)s"}) message
      it "format \"%(pathname)s\" to LogRecord's filename record's directory" $
        testFormatter (def {fmt = "%(pathname)s"}) $
          \LogRecord{..} -> takeDirectory filename
      it "format \"%(filename)s\" to LogRecord's filename record's base filename" $
        testFormatter (def {fmt = "%(filename)s"}) $
          \LogRecord{..} -> takeFileName filename
      it "format \"%(module)s\" to LogRecord's modulename record" $
        testFormatter (def {fmt = "%(module)s"}) modulename

    it "format \"%(lineno)d\" to LogRecord's lineno record" $
      testFormatter (def {fmt = "%(lineno)d"}) (show . lineno)

    it "format \"%(created)f\" to LogRecord's create time (second timestamp)" $
      testFormatter (def {fmt = "%(created)f"}) (const (show (1 :: Double)))

    it "format \"%(asctime)f\" to LogRecord's create time (human readdable)" $
      testFormatter
        (def {fmt = "%(asctime)s", datefmt="%Y-%m-%dT%H:%M:%S"})
        (const "1970-01-01T00:00:01")

    it "format \"%(msecs)d\" to LogRecord's create time (millisecond timestamp)" $
      testFormatter (def {fmt = "%(msecs)d"}) (const "1000" )

  describe "Manager" $
    modifyMaxSize (const 1000) $ do
      it "parse json to Manager" testJsonToManager
      it "run logging environment && logging THs" testRunLogging


makeRecord :: (Logger, Int, String, FilePath, String, String, Int) -> LogRecord
makeRecord (logger, level, message, file, package, modulename, line) =
  LogRecord { logger = replaceLine logger
            , level = Level level
            , message = replaceLine message
            , filename = replaceLine file
            , packagename = replaceLine package
            , modulename = replaceLine modulename
            , lineno = line
            , created = created
            }
  where
    created :: ZonedTime
    created = read "1970-01-01 00:00:01"
    -- replace '\n' with "<newline>" flag, or it will affect test,
    -- it works fine in normal situation.
    replaceLine :: String -> String
    replaceLine = intercalate "<newline>" . lines



testFormatter :: Formatter -> (LogRecord -> String) -> Property
testFormatter formatter format = property $ \x -> QC.monadicIO $ do
  (readEnd, writeEnd) <- QC.run $ createPipe
  QC.run $ hSetEncoding writeEnd utf8
  QC.run $ hSetEncoding readEnd utf8
  let rcd = makeRecord x
      handler = stderrHandler {formatter = formatter, stream = writeEnd }
  QC.run $ handle handler rcd
  msg <- QC.run $ hGetLine readEnd
  QC.assert (msg == format rcd)

testJsonToManager :: IO ()
testJsonToManager = do
    mgr@Manager{..} <- jsonToManager managerJson
    -- root
    testSink "root" root
    -- sinks
    length sinks `shouldBe` 1
    M.member "MyLogger" sinks `shouldBe` True
    testSink "MyLogger" $ sinks M.! "MyLogger"
  where
    testSink :: Logger -> Sink -> IO ()
    testSink "root" Sink{..} = do
      logger `shouldBe` ""
      level `shouldBe` "DEBUG"
      propagate `shouldBe` False
      disabled `shouldBe` False
      length filterer `shouldBe` 0
      length handlers `shouldBe` 1
      void $ forM_ handlers testHandler
    testSink "MyLogger" Sink{..} = do
      logger `shouldBe` "MyLogger"
      level `shouldBe` "INFO"
      propagate `shouldBe` False
      disabled `shouldBe` False
      length filterer `shouldBe` 1
      filterer == [Filter "MyLogger.Main" 13] `shouldBe` True
      length handlers `shouldBe` 2
      void $ forM_ handlers testHandler

    testHandler :: HandlerT -> IO ()
    testHandler (HandlerT hdl) = do
      let fmt = "%(asctime)s - %(level)s - %(logger)s - %(pathname)s/%(filename)s:%(lineno)d] %(message)s"
      getFilterer hdl == [] `shouldBe` True
      getFormatter hdl == def {fmt = fmt} `shouldBe` True
      getLevel hdl `elem` ["DEBUG", "INFO"] `shouldBe` True

    managerJson = [aesonQQ|{
      "loggers": {
          "root": {
            "level": "DEBUG",
            "handlers": ["console"],
            "propagate": false
          },
          "MyLogger": {
            "level": "INFO",
            "filterer": ["MyLogger.Main"],
            "handlers": ["console", "file"],
            "propagate": false
          }
        },
        "handlers": {
          "console": {
            "type": "StreamHandler",
            "stream": "stderr",
            "level": "DEBUG",
            "formatter": "defaultFormatter"
          },
          "file": {
            "type": "FileHandler",
            "level": "INFO",
            "formatter": "defaultFormatter",
            "file": "./default.log"
          }
        },
        "formatters": {
          "defaultFormatter": {
            "fmt": "%(asctime)s - %(level)s - %(logger)s - %(pathname)s/%(filename)s:%(lineno)d] %(message)s"
          }
        }
    }|]


testRunLogging :: IO ()
testRunLogging = do
    (mgr, consoleReadEnd, fileReadEnd) <- prepare
    let msg = "this is a test msg"
    run mgr $ do
      -- root
      forM ["debug", "info", "warn", "error", "fatal"] $ \logx -> do
        runLog logx "" msg [(consoleReadEnd, msg), (fileReadEnd, "")]

      -- MyLogger (filter)
      forM ["debug", "info", "warn", "error", "fatal"] $ \logx -> do
        runLog logx "MyLogger" msg [(consoleReadEnd, ""), (fileReadEnd, "")]

      -- debug MyLogger.Main
      runLog "debug" "MyLogger.Main" msg [(consoleReadEnd, ""), (fileReadEnd, "") ]
      -- the rest logs of MyLogger.Main
      forM ["info", "warn", "error", "fatal"] $ \logx -> do
        runLog logx "MyLogger.Main" msg [(consoleReadEnd, msg), (fileReadEnd, msg)]

      return ()
  where
    prepare :: IO (Manager, Handle, Handle)
    prepare = do
      (consoleReadEnd, consoleWriteEnd) <- createPipe
      hSetEncoding consoleReadEnd utf8
      hSetEncoding consoleWriteEnd utf8

      (fileReadEnd, fileWriteEnd) <- createPipe
      hSetEncoding fileReadEnd utf8
      hSetEncoding fileWriteEnd utf8

      console <- StreamHandler consoleWriteEnd "DEBUG" [] def <$> newMVar ()
      file <- StreamHandler fileWriteEnd "INFO" [] def <$> newMVar ()

      let root = Sink "" "DEBUG" [] [HandlerT console] False False
          myLogger = Sink "MyLogger" "INFO" ["MyLogger.Main"] [HandlerT console, HandlerT file] False False
          sinks = M.fromList [("MyLogger", myLogger)]
      return (Manager root sinks False True, consoleReadEnd, fileReadEnd)

    runLog :: String -> String -> String -> [(Handle, String)] -> IO ()
    runLog logx logger msg asserts = do
      case logx of
        "debug" -> $(debug) logger msg
        "info"  -> $(info) logger msg
        "warn"  -> $(warn) logger msg
        "error" -> $(Logging.error) logger msg
        "fatal" -> $(fatal) logger msg
        _       -> expectationFailure "unknown log function"

      void $ forM_ asserts $ \(handle, value) -> do
        ready <- hReady handle -- pipe read end will wait until write end has been written
        real <- if ready then hGetLine handle else return ""
        real `shouldBe` value