-- | This helps to setup logging to a /file/.
module Control.Eff.LogWriter.File
  ( withFileLogging
  , withFileLogWriter
  )
where

import           Control.Eff                   as Eff
import           Control.Eff.Log
import           Control.Eff.LogWriter.Rich
import           GHC.Stack
import           Data.Text                     as T
import qualified System.IO                     as IO
import           System.Directory               ( canonicalizePath
                                                , createDirectoryIfMissing
                                                )
import           System.FilePath                ( takeDirectory )
import qualified Control.Exception.Safe        as Safe
import qualified Control.Monad.Catch           as Catch
import           Control.Monad.Trans.Control    ( MonadBaseControl
                                                , liftBaseOp
                                                )

-- | Enable logging to a file, with some 'LogMessage' fields preset
-- as described in 'withRichLogging'.
--
-- If the file or its directory does not exist, it will be created.
--
-- Example:
--
-- > exampleWithFileLogging :: IO ()
-- > exampleWithFileLogging =
-- >     runLift
-- >   $ withFileLogging "/var/log/my-app.log" "my-app" local7 allLogMessages renderLogMessageConsoleLog
-- >   $ logInfo "Oh, hi there"
--
-- To vary the 'LogWriter' use 'withRichLogging'.
withFileLogging
  :: (Lifted IO e, MonadBaseControl IO (Eff e), HasCallStack)
  => FilePath -- ^ Path to the log-file.
  -> Text -- ^ The default application name to put into the 'lmAppName' field.
  -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.
  -> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"
  -> LogMessageTextRenderer -- ^ The 'LogMessage' render function
  -> Eff (Logs : LogWriterReader : e) a
  -> Eff e a
withFileLogging fnIn a f p render e = do
  liftBaseOp (withOpenedLogFile fnIn render) (\lw -> withRichLogging lw a f p e)


-- | Enable logging to a file.
--
-- If the file or its directory does not exist, it will be created.
-- Example:
--
-- > exampleWithFileLogWriter :: IO ()
-- > exampleWithFileLogWriter =
-- >     runLift
-- >   $ withoutLogging
-- >   $ withFileLogWriter "test.log" renderLogMessageConsoleLog
-- >   $ logInfo "Oh, hi there"
withFileLogWriter
  :: (IoLogging e, MonadBaseControl IO (Eff e), HasCallStack)
  => FilePath -- ^ Path to the log-file.
  -> LogMessageTextRenderer
  -> Eff e b
  -> Eff e b
withFileLogWriter fnIn render e =
  liftBaseOp (withOpenedLogFile fnIn render) (`addLogWriter` e)

withOpenedLogFile
  :: HasCallStack
  => FilePath
  -> LogMessageTextRenderer
  -> (LogWriter -> IO a)
  -> IO a
withOpenedLogFile fnIn render ioE = Safe.bracket
  (do
    fnCanon <- canonicalizePath fnIn
    createDirectoryIfMissing True (takeDirectory fnCanon)
    h <- IO.openFile fnCanon IO.AppendMode
    IO.hSetBuffering h IO.LineBuffering
    return h
  )
  (\h -> Safe.try @IO @Catch.SomeException (IO.hFlush h) >> IO.hClose h)
  (\h -> ioE (ioHandleLogWriter h render))