{-|  This module is used internally in log4hs.

Note: don't use this module in your own projects, it may be changed at any time.
-}

module Logging.Prelude
  ( addZonedTime
  , diffZonedTime
  , zonedTimeToPOSIXSeconds
  , timestamp
  , seconds
  , milliseconds
  , microseconds
  , openLogFile
  , tryRenameFile
  , lastModifyTime
  , modifyBaseName
  , appendBaseName
  , mkStdHandle
  ) where

import           Control.Concurrent
import           Control.Monad
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
import           Data.Time.LocalTime
import           System.Directory
import           System.Environment
import           System.FilePath
import           System.IO
import           Text.Format


instance Eq TextEncoding where
  e1 == e2 = show e1 == show e2


instance FormatArg ThreadId where
  formatArg x = formatArg (show x)


addZonedTime :: NominalDiffTime -> ZonedTime -> ZonedTime
addZonedTime ndt zt@(ZonedTime _ tz) =
  utcToZonedTime tz $ addUTCTime ndt $ zonedTimeToUTC zt


diffZonedTime :: ZonedTime -> ZonedTime -> NominalDiffTime
diffZonedTime zt1 zt2 = diffUTCTime (zonedTimeToUTC zt1) (zonedTimeToUTC zt2)


zonedTimeToPOSIXSeconds :: ZonedTime -> NominalDiffTime
zonedTimeToPOSIXSeconds = utcTimeToPOSIXSeconds . zonedTimeToUTC


timestamp :: NominalDiffTime -> Double
timestamp = fromRational . toRational


seconds :: NominalDiffTime -> Integer
seconds = truncate


milliseconds :: NominalDiffTime -> Integer
milliseconds = truncate . (* 1000)


microseconds :: NominalDiffTime -> Integer
microseconds = truncate . (* 1000000)


openLogFile :: FilePath -> TextEncoding -> IO Handle
openLogFile path encoding = do
  absPath <- makeAbsolute path
  progName <- getProgName
  let dir = takeDirectory absPath
      file = if dir == absPath then dir </> (progName ++ ".log") else absPath
  createDirectoryIfMissing True dir
  stream <- openFile file ReadWriteMode
  hSeek stream SeekFromEnd 0
  hSetEncoding stream encoding
  hSetBuffering stream LineBuffering
  return stream


tryRenameFile :: FilePath -> FilePath -> IO ()
tryRenameFile src dest = doesFileExist src >>= (flip when $ renameFile src dest)


lastModifyTime :: FilePath -> IO UTCTime
lastModifyTime file = do
  exist <- doesFileExist file
  if exist then getModificationTime file else getCurrentTime


modifyBaseName :: FilePath -> (String -> String) -> FilePath
modifyBaseName file modify = replaceBaseName file $ modify $ takeBaseName file


appendBaseName :: FilePath -> String -> FilePath
appendBaseName file suffix = modifyBaseName file (++ suffix)


mkStdHandle :: String -> Handle
mkStdHandle "stderr" = stderr
mkStdHandle "stdout" = stdout
mkStdHandle _        = error "unknown std handle name"