{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

{- |
Module      :  ELynx.Tools.Logger
Description :  Monad logger utility functions
Copyright   :  (c) Dominik Schrempf 2019
License     :  GPL-3

Maintainer  :  dominik.schrempf@gmail.com
Stability   :  unstable
Portability :  portable

Creation date: Fri Sep  6 14:43:19 2019.

-}

module ELynx.Tools.Logger
  ( logNewSection
  , eLynxWrapper
  ) where

import           Control.Exception.Lifted
import           Control.Monad.Base
import           Control.Monad.IO.Class
import           Control.Monad.Logger
import           Control.Monad.Trans.Control
import qualified Data.ByteString.Char8       as B
import           Data.Text
import           System.IO
import           System.Log.FastLogger

import           ELynx.Tools.Options

-- | Unified way of creating a new section in the log.
logNewSection :: MonadLogger m => Text -> m ()
logNewSection s = $(logInfo) $ "-- " <> s

-- | The 'LoggingT' wrapper for ELynx. Prints a header and a footer, logs to
-- 'stderr' if no file is provided. If a log file is provided, log to the file
-- and to 'stderr'.
eLynxWrapper :: (MonadBaseControl IO m, MonadIO m)
             => LogLevel -> Maybe FilePath -> String -> LoggingT m () -> m ()
eLynxWrapper lvl logFile headerMsg worker = runELynxLoggingT lvl logFile $
  do
    h <- liftIO $ logHeader headerMsg
    $(logInfo) $ pack h
    worker
    f <- liftIO logFooter
    $(logInfo) $ pack f

runELynxLoggingT :: (MonadBaseControl IO m, MonadIO m)
                 => LogLevel -> Maybe FilePath -> LoggingT m a -> m a
runELynxLoggingT lvl f = case f of
  Nothing -> runELynxStderrLoggingT . filterLogger (\_ l -> l >= lvl)
  Just fn -> runELynxFileLoggingT fn . filterLogger (\_ l -> l >= lvl)

runELynxFileLoggingT :: MonadBaseControl IO m => FilePath -> LoggingT m a -> m a
runELynxFileLoggingT fp logger = bracket
    (liftBase $ openFile fp AppendMode)
    (liftBase . hClose)
    $ \h -> liftBase (hSetBuffering h LineBuffering) >> runLoggingT logger (output2H stderr h)

runELynxStderrLoggingT :: MonadIO m => LoggingT m a -> m a
runELynxStderrLoggingT = (`runLoggingT` output stderr)

output :: Handle
       -> Loc
       -> LogSource
       -> LogLevel
       -> LogStr
       -> IO ()
output h loc src lvl msg =
  B.hPutStr h ls
  where
    ls = logStrToBS loc src lvl msg

output2H :: Handle
         -> Handle
         -> Loc
         -> LogSource
         -> LogLevel
         -> LogStr
         -> IO ()
output2H h1 h2 loc src lvl msg = do
  B.hPutStr h1 ls
  B.hPutStr h2 ls
  where
    ls = logStrToBS loc src lvl msg

logStrToBS :: Loc
           -> LogSource
           -> LogLevel
           -> LogStr
           -> B.ByteString
logStrToBS _ _ _ msg = fromLogStr msg <> "\n"