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

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

import           Control.Concurrent.MVar
import           Control.Exception       (SomeException, bracket_)
import           Control.Monad           (forM_, void, when)
import           Control.Monad.IO.Class  (MonadIO (..))
import           Data.Default
import           Data.IORef
import           Data.List               (dropWhileEnd)
import           Data.Map.Lazy           ((!?))
import           Data.Time.Clock
import           Data.Time.LocalTime
import           GHC.Conc                (setUncaughtExceptionHandler)
import           Prelude                 hiding (filter, log)
import           System.IO               (Handle, stderr, stdout)
import           System.IO.Unsafe        (unsafePerformIO)

import           Logging.Types

{-# 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) shutdown io
  where
    unknownLoc = ("unknown file", "unknown package", "unknown module", 0)

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

    shutdown :: IO ()
    shutdown = closeHandlers root >> forM_ sinks closeHandlers

    closeHandlers :: Sink -> IO ()
    closeHandlers Sink{..} = forM_ handlers $ \(HandlerT hdl) -> close hdl


-- |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
    created <- getZonedTime

    let (file, package, modulename, lineno) = location

    when (not disabled) $ process logger mgr $
      LogRecord logger level message file package modulename lineno created
  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 :: [HandlerT] -> LogRecord -> IO ()
    callHandlers handlers rcd = forM_ handlers $ \hdlt@(HandlerT hdl) ->
      when (isHandlerEnableFor hdlt 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 :: HandlerT -> LogRecord -> Bool
    isHandlerEnableFor (HandlerT hdl) rcd@LogRecord{level=level'}
      | level' < getLevel hdl = False
      | otherwise = filter (getFilterer hdl) rcd


-- |A ultility function for creating 'StreamHandler'
makeStreamHandler :: Handle -> IO StreamHandler
makeStreamHandler stream = StreamHandler stream def [] def <$> newMVar ()


{-# NOINLINE stderrHandler #-}
-- |A 'StreamHandler' bound to 'stderr'
stderrHandler :: StreamHandler
stderrHandler = unsafePerformIO $ makeStreamHandler stderr

{-# NOINLINE stdoutHandler #-}
-- |A 'StreamHandler' bound to 'stdout'
stdoutHandler :: StreamHandler
stdoutHandler = unsafePerformIO $ makeStreamHandler 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" [] [HandlerT stderrHandler] False False