AesonSpec.hs

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

module Logging.AesonSpec ( spec ) where

import           Control.Lens                (view)
import           Control.Monad
import           Data.Aeson
#if MIN_VERSION_aeson(1, 4, 3)
import           Data.Aeson.QQ.Simple        (aesonQQ)
#else
import           Data.Aeson.QQ               (aesonQQ)
#endif
import           Data.Default                (def)
import           Data.Generics.Product.Typed
import           Data.List                   (intercalate)
import qualified Data.Map                    as M
import           Data.Maybe                  (fromJust)
import           System.IO
import           System.IO.Unsafe
import           Test.Hspec
import           Test.Hspec.QuickCheck

import           Logging
import           Logging.Aeson

spec :: Spec
spec = levelSpec >> filterSpec >> formatterSpec >> handlerSpec >>
       sinkSpec >>  managerSpec


levelSpec :: Spec
levelSpec = describe "Level" $ modifyMaxSize (const 1000) $ do
  prop "decode" $ \x -> let v = Level x in (decode $ encode $ show v) == Just v


filterSpec :: Spec
filterSpec = describe "Filter" $ modifyMaxSize (const 1000) $ do
  prop "decode" $ \fs ->
    let logger = intercalate "." fs
    in (decode $ encode logger) == Just (Filter logger)


formatterSpec :: Spec
formatterSpec = describe "Formatter" $ modifyMaxSize (const 1000) $ do
  prop "decode standard" $ \(fmt, datefmt) ->
    let formatter = Formatter fmt datefmt
        obj = object [("fmt", toJSON fmt), ("datefmt", toJSON datefmt)]
    in (decode $ encode obj) == Just formatter

  prop "decode missing filed" $ \fmt ->
    decode (encode $ object [("fmt", toJSON fmt)]) == Just (def {fmt = fmt})

  prop "decode string" $ \fmt -> decode (encode fmt) == Just (def {fmt = fmt})


handlerSpec :: Spec
handlerSpec = describe "Handler" $ modifyMaxSize (const 1000) $ do
  it "decode StreamHandler simple" $ do
    let StreamHandler{..} = fromJust $ decode $ encode $
          [aesonQQ|{"type": "StreamHandler"}|]
    stream == stderr `shouldBe` True
    level == def `shouldBe` True
    filterer == [] `shouldBe` True
    formatter == def `shouldBe` True

  it "decode StreamHandler standard" $ do
    let StreamHandler{..} = fromJust $ decode $ encode $
          [aesonQQ|
            {
              "type": "StreamHandler",
              "stream": "stdout",
              "level": "DEBUG",
              "filterer": ["Module.Submodule"],
              "formatter": "default"
            }
          |]

    stream == stdout `shouldBe` True
    level == "DEBUG" `shouldBe` True
    filterer == [Filter "Module.Submodule"] `shouldBe` True
    formatter == def {fmt = "default"} `shouldBe` True

  it "decode FileHandler" $ do
    FileHandler{..} <- fromJust $ decode $ encode $
          [aesonQQ|
            {
              "type": "FileHandler",
              "file": "myapp.log",
              "encoding": "UTF-16",
              "level": "INFO",
              "filterer": ["Module.Submodule"],
              "formatter": "default"
            }
          |]

    file `shouldBe` "myapp.log"
    encoding `shouldBe` utf16
    level `shouldBe` "INFO"
    filterer == [Filter "Module.Submodule"] `shouldBe` True
    formatter == def {fmt = "default"} `shouldBe` True

  it "decode (formatters -> SomeHandler)" $ do
    let simple = def {fmt = "%(logger)s: %(message)s"}
        func = fromJust $ decode $ encode
          [aesonQQ|
            {
              "type": "StreamHandler",
              "level": "DEBUG",
              "filterer": ["Module.Submodule"],
              "formatter": "simple"
            }
          |]

    handler@(SomeHandler _) <- func $ M.singleton ("simple" :: String) simple
    view (typed @Level) handler == "DEBUG" `shouldBe` True
    view (typed @Filterer) handler == ["Module.Submodule"] `shouldBe` True
    view (typed @Formatter) handler == simple `shouldBe` True


sinkSpec :: Spec
sinkSpec = describe "Sink" $ modifyMaxSize (const 1000) $ do
  it "decode" $ do
    let Sink{..} = fromJust $ decode $ encode $
          [aesonQQ|
            {
              "level": "DEBUG",
              "filterer": ["Module.Submodule"],
              "handlers": ["console"],
              "disabled": false,
              "propagate": true
            }
          |]

    logger `shouldBe` "placeholder"
    level `shouldBe` "DEBUG"
    filterer == ["Module.Submodule"] `shouldBe` True
    length handlers `shouldBe` 0
    disabled `shouldBe` False
    propagate `shouldBe` True

  it "decode (logger -> handlers -> sink)" $ do
    let handlerMap = M.fromList [ ("console", toHandler stderrHandler)
                                , ("file" :: String, toHandler stderrHandler)
                                ]
        func = fromJust $ decode $ encode $
              [aesonQQ|
                {
                  "level": "INFO",
                  "filterer": ["Module.Submodule"],
                  "handlers": ["console", "file"]
                }
              |]
        Sink{..} = func ("MyLogger" :: String) handlerMap

    logger `shouldBe` "MyLogger"
    level `shouldBe` "INFO"
    filterer == ["Module.Submodule"] `shouldBe` True
    length handlers `shouldBe` 2 -- deep test handlers
    disabled `shouldBe` False
    propagate `shouldBe` False


managerSpec :: Spec
managerSpec = describe "Manager" $ modifyMaxSize (const 1000) $ do
  it "decode" $ do
    let Manager{..} = manager_

    length sinks `shouldBe` 1
    M.member "MyLogger" sinks `shouldBe` True
    disabled `shouldBe` False
    catchUncaughtException `shouldBe` True

  it "decode root" $ do
    let Sink{..} = root manager_

    logger `shouldBe` ""
    level `shouldBe` "DEBUG"
    disabled `shouldBe` False
    propagate `shouldBe` False
    length filterer `shouldBe` 0
    length handlers `shouldBe` 1

  it "decode sinks" $ do
    let Sink{..} = (sinks manager_) M.! "MyLogger"

    logger `shouldBe` "MyLogger"
    level `shouldBe` "INFO"
    propagate `shouldBe` False
    disabled `shouldBe` False
    length filterer `shouldBe` 1
    filterer == ["MyLogger.Main"] `shouldBe` True
    length handlers `shouldBe` 2


-- Decoding manager globally, or it will throw file resouse busy error
manager_ :: Manager
{-# NOINLINE manager_ #-}
manager_ = unsafePerformIO $ fromJust $ decode $ encode [aesonQQ|{
  "catchUncaughtException": true,
  "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": "default"
      },
      "file": {
        "type": "FileHandler",
        "level": "INFO",
        "formatter": "default",
        "file": "./default.log"
      }
    },
    "formatters": {
      "default": {
        "fmt": "%(asctime)s - %(level)s - %(logger)s:%(lineno)d] %(message)s"
      }
    }
}|]