{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}

module Logging.Internal
  ( run
  , log
  , stderrHandler
  , stdoutHandler
  , defaultRoot
  ) where

import           Control.Exception           (SomeException, bracket_)
import           Control.Lens                (view)
import           Control.Monad               (forM_, void, when)
import           Control.Monad.IO.Class      (MonadIO (..))
import           Data.Default
import           Data.Generics.Product.Typed
import           Data.IORef
import           Data.List                   (dropWhileEnd, group)
import           Data.Map.Lazy               (elems, (!?))
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
import           Data.Time.LocalTime
import           GHC.Conc                    (setUncaughtExceptionHandler)
import           Prelude                     hiding (filter, log)
import           System.FilePath
import           System.IO                   (stderr, stdout)
import           System.IO.Unsafe            (unsafePerformIO)

import           Logging.Types
import           Logging.Utils

{-# NOINLINE _mgr #-}
_mgr :: IORef Manager
_mgr = unsafePerformIO $ newIORef undefined


-- |Run a logging environment.
--
-- You should always write you application inside a logging environment.
--
-- 1. rename "main" function to "originMain" (or whatever you call it)
-- 2. write "main" as below
--
-- > main :: IO ()
-- > main = run manager originMain
-- > ...
--
run :: Manager -> IO a -> IO a
run mgr@Manager{..} io = do
    when catchUncaughtException $ setUncaughtExceptionHandler uceHandler
    bracket_ (atomicWriteIORef _mgr mgr >> start) shutdown io
  where
    unknownLoc = ("unknown file", "unknown package", "unknown module", 0)

    uceHandler :: SomeException -> IO ()
    uceHandler e = log "" "ERROR" (show e) unknownLoc

    allHandlers = map head $ group $
      concat [ handlers s | s <- (root : (elems sinks)) ]

    start :: IO ()
    start = forM_ allHandlers open

    shutdown :: IO ()
    shutdown = forM_ allHandlers close


-- |Low-level logging routine which creates a LogRecord and then calls
-- all the handlers of this logger to handle the record.
log :: MonadIO m
     => Logger -> Level -> String -> (String, String, String, Int) -> m ()
log logger level message location = liftIO $ do
    mgr@Manager{..} <- readIORef _mgr
    asctime <- getZonedTime

    let (pathname, pkgname, modulename, lineno) = location
        filename = takeFileName pathname
        utctime = zonedTimeToUTC asctime
        diffTime = utcTimeToPOSIXSeconds utctime
        created = timestamp diffTime
        msecs = microseconds diffTime

    when (not disabled) $ process logger mgr $
      LogRecord logger level message pathname filename pkgname modulename
                lineno asctime utctime created msecs
  where
    process :: Logger -> Manager -> LogRecord -> IO ()
    process logger mgr rcd =
      case lookupSink logger mgr of
        Just sink@Sink{..} -> do
          when (isSinkEnabledFor sink rcd) $ callHandlers handlers rcd
          let parentLogger = parent logger
              shouldPropagate = propagate && logger /= parentLogger
          when shouldPropagate $ process parentLogger mgr rcd
        Nothing -> process (parent logger) mgr rcd

    parent :: Logger -> Logger
    parent = dropWhileEnd (== '.') . dropWhileEnd (/= '.')

    lookupSink :: Logger -> Manager -> Maybe Sink
    lookupSink logger mgr@Manager{root=root@Sink{logger=rootLogger}, ..}
      | logger `elem` ["", rootLogger] = Just root
      | otherwise = sinks !? logger

    callHandlers :: [SomeHandler] -> LogRecord -> IO ()
    callHandlers handlers rcd = forM_ handlers $ \hdl ->
      when (isHandlerEnableFor hdl rcd) $ void $ Logging.Types.handle hdl rcd

    isSinkEnabledFor :: Sink -> LogRecord -> Bool
    isSinkEnabledFor sink@Sink{..} rcd@LogRecord{level=level'}
      | disabled = False
      | level' < level = False
      | otherwise = filter sink rcd

    isHandlerEnableFor :: SomeHandler -> LogRecord -> Bool
    isHandlerEnableFor hdl rcd@LogRecord{level=level'}
      | level' < (view (typed @Level) hdl) = False
      | otherwise = filter (view (typed @Filterer) hdl) rcd


-- |A 'StreamHandler' bound to 'stderr'
stderrHandler :: StreamHandler
stderrHandler = StreamHandler def [] "{message}" stderr

-- |A 'StreamHandler' bound to 'stdout'
stdoutHandler :: StreamHandler
stdoutHandler = StreamHandler def [] "{message}" stdout

{-# NOINLINE defaultRoot #-}
-- |Default root sink which is used by 'jsonToManager' when __root__ is missed.
--
-- You can use it when you make 'Manager' manually.
defaultRoot :: Sink
defaultRoot = Sink "" "DEBUG" [] [toHandler stderrHandler] False False