{-# 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 Text.Format import Logging import Logging.Aeson spec :: Spec spec = levelSpec >> filterSpec >> 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) 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 == "{message}" `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 == "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 == "default" `shouldBe` True it "decode (formatters -> SomeHandler)" $ do let simple = "{logger}: {message}" 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 @Format1) 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": "{asctime} - {level} - {logger}:{lineno}] {message}" } }|]