{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}

module Logging.Config.Type
  ( Handler(..)
  , Sink(..)
  , Config(..)
  , ConfigException(..)
  , createManager
  ) where


import           Control.Exception (Exception)
import           Data.Aeson
import           Data.Default
import           Data.IORef
import           Data.Map.Lazy
import           Data.Maybe
import           Data.String
import           GHC.Generics
import           System.IO

import           Prelude           hiding (map)
import qualified Prelude           as P
import           Text.Format

import           Logging.Internal
import qualified Logging.Types     as T
import           Logging.Utils


data Handler = StreamHandler { level     :: Maybe String
                             , filterer  :: Maybe [String]
                             , formatter :: Maybe String
                             , stream    :: Maybe String
                             }
             | FileHandler { level     :: Maybe String
                           , filterer  :: Maybe [String]
                           , formatter :: Maybe String
                           , file      :: FilePath
                           , encoding  :: Maybe String
                           }
             | RotatingFileHandler { level       :: Maybe String
                                   , filterer    :: Maybe [String]
                                   , formatter   :: Maybe String
                                   , file        :: FilePath
                                   , encoding    :: Maybe String
                                   , maxBytes    :: Maybe Int
                                   , backupCount :: Maybe Int
                                   }
              deriving (Generic, Show)

instance FromJSON Handler where
  parseJSON = genericParseJSON option
    where
      sumEncoding = defaultTaggedObject { tagFieldName = "type" }
      option = defaultOptions { sumEncoding = sumEncoding }


data Sink = Sink { level     :: Maybe String
                 , filterer  :: Maybe [String]
                 , handlers  :: Maybe [String]
                 , propagate :: Maybe Bool
                 , disabled  :: Maybe Bool
                 } deriving (Generic, Show)

instance FromJSON Sink


data Config = Config { sinks                  :: Maybe (Map String Sink)
                     , handlers               :: Maybe (Map String Handler)
                     , formatters             :: Maybe (Map String String)
                     , disabled               :: Maybe Bool
                     , catchUncaughtException :: Maybe Bool
                     } deriving (Generic, Show)

instance FromJSON Config


newtype ConfigException = ConfigException { message :: String }

instance Show ConfigException where
  show e = "Logging Config Exception: " ++ (message e)

instance Exception ConfigException


createManager :: Config -> IO T.Manager
createManager Config{..} = do
    handlers <- mapM (createHandler formatters') $ fromMaybe empty handlers
    sinks <- sequence $ mapWithKey (createSink handlers) $ fromMaybe empty sinks

    let root = findWithDefault defaultRoot "root" sinks
        sinks' = delete "root" sinks
        disabled' = fromMaybe False disabled
        catchUncaughtException' = fromMaybe False catchUncaughtException
    return $ T.Manager root sinks' disabled' catchUncaughtException'
  where
    formatters' :: Map String Format1
    formatters' = maybe (singleton "" "{message}") (map fromString) formatters

    createSink :: Map String T.SomeHandler -> String -> Sink -> IO T.Sink
    createSink hs logger Sink{..} = do
      let logger' = if logger == "root" then "" else logger
          level' = maybe def read level
          filterer' = maybe [] (P.map fromString) filterer
          handlers' = [hs ! h | h <- fromMaybe [] handlers]
          disabled' = fromMaybe False disabled
          propagate' = fromMaybe False propagate
      return $ T.Sink logger' level' filterer' handlers' disabled' propagate'

    getStream :: String -> Handle
    getStream "stderr" = stderr
    getStream "stdout" = stdout
    getStream _        = error "Logging.Config: no parse (stream)"

    createHandler :: Map String Format1 -> Handler -> IO T.SomeHandler
    createHandler fs StreamHandler{..} = do
      let level' = maybe def read level
          filterer' = maybe [] (P.map fromString) filterer
          formatter' = maybe "{message}" ((!) fs) formatter
          stream' = getStream $ fromMaybe "stderr" stream
      return $ T.toHandler $ T.StreamHandler level' filterer' formatter' stream'
    createHandler fs FileHandler{..} = do
      let level' = maybe def read level
          filterer' = maybe [] (P.map fromString) filterer
          formatter' = maybe "{message}" ((!) fs) formatter
      encoding' <- mkTextEncoding $ fromMaybe "utf8" encoding
      stream <- newIORef undefined
      return $ T.toHandler $
        T.FileHandler level' filterer' formatter' file encoding' stream
    createHandler fs RotatingFileHandler{..} = do
      let level' = maybe def read level
          filterer' = maybe [] (P.map fromString) filterer
          formatter' = maybe "{message}" ((!) fs) formatter
          maxBytes' = fromMaybe 104857600 maxBytes
          backupCount' = fromMaybe 10 backupCount
      encoding' <- mkTextEncoding $ fromMaybe "utf8" encoding
      stream <- newIORef undefined
      return $ T.toHandler $
        T.RotatingFileHandler level' filterer' formatter' file encoding'
                              maxBytes' backupCount' stream