module System.Wlog.LoggerConfig
( LoggerConfig (..)
, LoggerTree (..)
, LoggerMap
, RotationParameters (..)
, isValidRotation
) where
import Data.Aeson (withObject)
import Data.Default (Default (def))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM hiding (HashMap)
import Data.Text (Text)
import qualified Data.Text.Buildable as Buildable
import Data.Traversable (for)
import Data.Word (Word64)
import Data.Yaml (FromJSON (..), ToJSON, Value (Object), (.:), (.:?))
import Formatting (bprint, shown)
import GHC.Generics (Generic)
import System.Wlog.Wrapper (Severity)
filterObject :: [Text] -> HashMap Text a -> HashMap Text a
filterObject excluded = HM.filterWithKey $ \k _ -> k `notElem` excluded
type LoggerMap = HashMap Text LoggerTree
data LoggerTree = LoggerTree
{ ltSubloggers :: !LoggerMap
, ltFile :: !(Maybe FilePath)
, ltSeverity :: !(Maybe Severity)
} deriving (Generic, Show)
instance ToJSON LoggerTree
instance Default LoggerTree where
def = LoggerTree
{ ltFile = Nothing
, ltSeverity = Nothing
, ltSubloggers = mempty
}
nonLoggers :: [Text]
nonLoggers = ["file", "severity"]
instance FromJSON LoggerTree where
parseJSON = withObject "loggers tree" $ \o -> do
ltFile <- o .:? "file"
ltSeverity <- o .:? "severity"
ltSubloggers <- for (filterObject nonLoggers o) parseJSON
return LoggerTree{..}
data RotationParameters = RotationParameters
{ rpLogLimit :: !Word64
, rpKeepFiles :: !Word
} deriving (Generic, Show)
instance Buildable.Buildable RotationParameters where
build = bprint shown
instance ToJSON RotationParameters
instance FromJSON RotationParameters where
parseJSON = withObject "rotation params" $ \o -> do
rpLogLimit <- o .: "logLimit"
rpKeepFiles <- o .: "keepFiles"
return RotationParameters{..}
isValidRotation :: RotationParameters -> Bool
isValidRotation RotationParameters{..} = rpLogLimit > 0 && rpKeepFiles > 0
data LoggerConfig = LoggerConfig
{ lcRotation :: !(Maybe RotationParameters)
, lcTree :: !LoggerTree
} deriving (Generic, Show)
instance Default LoggerConfig where
def = LoggerConfig
{ lcRotation = Nothing
, lcTree = def
}
instance FromJSON LoggerConfig where
parseJSON = withObject "rotation params" $ \o -> do
lcRotation <- o .:? "rotation"
lcTree <- parseJSON $ Object $ filterObject ["rotation"] o
return LoggerConfig{..}
instance ToJSON LoggerConfig