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

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


import           Control.Concurrent.MVar
import           Control.Exception                       (Exception)
import           Data.Aeson
import           Data.Aeson.Default
import           Data.Aeson.Default.HKD
import           Data.Aeson.Default.Map.Strict
import           Data.Functor.Identity
import           Data.IORef
import           Data.Map.Lazy
import           Data.Maybe
import           Data.String
import           Data.Time.Clock
import           Data.Time.LocalTime
import           GHC.Generics
import           Prelude                                 hiding (map)
import qualified Prelude                                 as P
import           System.IO
import           Text.Format                             hiding (defaultOptions)

import qualified Logging.Class                           as T
import qualified Logging.Filter                          as T
import qualified Logging.Handler.FileHandler             as T
import qualified Logging.Handler.RotatingFileHandler     as T
import qualified Logging.Handler.StreamHandler           as T
import qualified Logging.Handler.TimeRotatingFileHandler as T
import qualified Logging.Level                           as T
import qualified Logging.Manager                         as T
import           Logging.Prelude
import qualified Logging.Sink                            as T


{-| A datatype used to decode json or yaml into 'Handler' datatypes.

All 'HKD' wrapped and 'Maybe' fields are optional fields, they can be omitted.

There are tow config file templates in "Logging.Config.Json" and
"Logging.Config.Yaml".

Note: When decoding from json or yaml, use 'type' field to specify handler type.
-}
data HandlerH f = StreamHandler { level     :: HKD T.Level f
                                -- ^ Default is @NOTSET@.
                                , filterer  :: HKD T.Filterer f
                                -- ^ Default is [].
                                , formatter :: HKD String f
                                -- ^ It represents key of 'ConfigH''s
                                -- formatters.
                                , stream    :: HKD String f
                                -- ^ Only support 'stderr' and 'stdout',
                                -- default is 'stderr'.
                                }

                | FileHandler { level     :: HKD T.Level f
                              -- ^ Default is @NOTSET@.
                              , filterer  :: HKD T.Filterer f
                              -- ^ Default is [].
                              , formatter :: HKD String f
                              -- ^ It represents key of 'ConfigH''s
                              -- formatters.
                              , file      :: FilePath
                              , encoding  :: HKD String f
                              -- ^ See 'System.IO.mkTextEncoding',
                              -- default is utf8.
                              }
                | RotatingFileHandler { level       :: HKD T.Level f
                                      -- ^ Default is @NOTSET@.
                                      , filterer    :: HKD T.Filterer f
                                      -- ^ Default is [].
                                      , formatter   :: HKD String f
                                      -- ^ It represents key of 'ConfigH''s
                                      -- formatters.
                                      , file        :: FilePath
                                      , encoding    :: HKD String f
                                      -- ^ See 'System.IO.mkTextEncoding',
                                      -- default is utf8.
                                      , maxBytes    :: HKD Int f
                                      -- ^ Default is 100 MB.
                                      , backupCount :: HKD Int f
                                      -- ^ Default is 10.
                                      }
                | TimeRotatingFileHandler { level       :: HKD T.Level f
                                          -- ^ Default is @NOTSET@.
                                          , filterer    :: HKD T.Filterer f
                                          -- ^ Default is [].
                                          , formatter   :: HKD String f
                                          -- ^ It represents key of 'ConfigH''s
                                          -- formatters.
                                          , file        :: FilePath
                                          , encoding    :: HKD String f
                                          , timezone    :: Maybe String
                                          -- ^ If not set, same as 'Manager''s
                                          -- timezone.
                                          , rotateTime  :: HKD T.RotateTime f
                                          -- ^ Indicates when to rotate file,
                                          -- e.g. @D3@ means every 3 days,
                                          -- @W4@ means at 0 clock of 'Thursday',
                                          -- try reading and showing
                                          -- 'RotateTime'.
                                          , backupCount :: HKD Int f
                                          }
                 -- ^ @since 0.7.0
                 deriving Generic

instance FromJSON (HandlerH Maybe) where
  parseJSON = genericParseJSON option
    where
      sumEncoding = defaultTaggedObject { tagFieldName = "type" }
      option = defaultOptions { sumEncoding = sumEncoding }

instance Default HandlerH where
  constrDef constr
      | constr == "StreamHandler" = StreamHandler{..}
      | constr == "FileHandler" = FileHandler{..}
      | constr == "RotatingFileHandler" = RotatingFileHandler{..}
      | constr == "TimeRotatingFileHandler" = TimeRotatingFileHandler{..}
    where
      (level, filterer, formatter) = ("NOTSET", [], "{message}")
      (stream, file, encoding) = ("stderr", "./logging.log", "UTF-8")
      (maxBytes, backupCount) = (104857600, 10)
      (timezone, rotateTime) = (Nothing, T.Day 1)

type Handler = HandlerH Identity


--------------------------------------------------------------------------------
data SinkH f = Sink { level     :: HKD T.Level f
                    -- Default is "NOTSET"
                    , filterer  :: HKD T.Filterer f
                    -- Default is []
                    , handlers  :: HKD [String] f
                    -- ^ A list of key of 'ConfigH''s handlers
                    , propagate :: HKD Bool f
                    , disabled  :: HKD Bool f
                    } deriving Generic

instance FromJSON (SinkH Maybe)

instance Default SinkH where
  constrDef _ = Sink "NOTSET" [] [] True False

type Sink = SinkH Identity


--------------------------------------------------------------------------------
data ConfigH f = Config { sinks      :: HKD (MapH String SinkH f) f
                        , handlers   :: HKD (MapH String HandlerH f) f
                        , formatters :: HKD (Map String String) f
                        -- See "Format1" to learn how to write format string.
                        , timezone   :: Maybe String -- ^ @since 0.7.0
                        -- Default is the result of 'getCurrentTimeZone'.
                        , disabled   :: HKD Bool f
                        } deriving Generic

instance FromJSON (ConfigH Maybe)

instance Default ConfigH where
  constrDef _ = Config mempty mempty mempty Nothing False

type Config = ConfigH Identity


--------------------------------------------------------------------------------
newtype ConfigException = ConfigException { message :: String }

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

instance Exception ConfigException


--------------------------------------------------------------------------------
{-| Create "Logging.Manager.Manager" from 'Config'.

This function is only used by "Logging.Config.Json" and "Logging.Config.Yaml",
use functions provided in these two modules directly.
-}
createManager :: Config -> IO T.Manager
createManager Config{..} = do
    hs <- mapM (createHandler $ map fromString formatters) $ unMapH handlers
    ss <- sequence $ mapWithKey (createSink hs) $ unMapH sinks
    timezone <- maybe getCurrentTimeZone (pure . read) timezone
    let root = findWithDefault defaultRoot "root" ss
        sinks = delete "root" ss
        catchUncaughtException = False -- TODO remove
    return $ T.Manager{..}
  where
    stderrHandler :: T.SomeHandler
    stderrHandler = T.toHandler $ T.StreamHandler "NOTSET" [] "{message}" stderr

    defaultRoot :: T.Sink
    defaultRoot = T.Sink "" "DEBUG" [] [stderrHandler] False False

    createSink :: Map String T.SomeHandler -> String -> Sink -> IO T.Sink
    createSink hs logger Sink{..} = do
      logger <- pure $ if logger == "root" then "" else logger
      handlers <- pure [hs ! h | h <- handlers]
      return $ T.Sink{..}

    createHandler :: Map String Format1 -> Handler -> IO T.SomeHandler
    createHandler fs StreamHandler{..} = do
      formatter <- pure $ fs ! formatter
      stream <- pure $ mkStdHandle stream
      return $ T.toHandler $ T.StreamHandler{..}
    createHandler fs FileHandler{..} = do
      formatter <- pure $ fs ! formatter
      encoding <- mkTextEncoding encoding
      stream <- newIORef undefined
      return $ T.toHandler $ T.FileHandler{..}
    createHandler fs RotatingFileHandler{..} = do
      formatter <- return $ fs ! formatter
      encoding <- mkTextEncoding encoding
      stream <- newEmptyMVar
      return $ T.toHandler $ T.RotatingFileHandler{..}
    createHandler fs TimeRotatingFileHandler{timezone=tz, ..} = do
      formatter <- pure $ fs ! formatter
      timezone <- maybe getCurrentTimeZone (pure . read) $ mappend tz timezone
      encoding <- mkTextEncoding encoding
      rotateAt <- newIORef =<< getCurrentTime
      stream <- newEmptyMVar
      return $ T.toHandler $ T.TimeRotatingFileHandler{..}