{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      :  ELynx.Tools.Logger
-- Description :  Monad logger utility functions
-- Copyright   :  2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Fri Sep  6 14:43:19 2019.
module ELynx.Tools.Logger
  ( Verbosity (..),
    HasLock (..),
    HasLogHandles (..),
    HasStartingTime (..),
    HasVerbosity (..),
    Logger,
    logOutB,
    logDebugB,
    logDebugS,
    logWarnB,
    logWarnS,
    logInfoB,
    logInfoS,
    logHeader,
    logInfoHeader,
    logInfoFooter,
    logInfoNewSection,
  )
where

import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Aeson.TH
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.List
import Data.Time
import Data.Version
import GHC.Generics
import Language.Haskell.TH
import Paths_elynx_tools
import System.Environment
import System.IO

-- | Verbosity levels.
data Verbosity = Quiet | Warn | Info | Debug
  deriving (Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
$cminBound :: Verbosity
minBound :: Verbosity
$cmaxBound :: Verbosity
maxBound :: Verbosity
Bounded, Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
pred :: Verbosity -> Verbosity
$ctoEnum :: Int -> Verbosity
toEnum :: Int -> Verbosity
$cfromEnum :: Verbosity -> Int
fromEnum :: Verbosity -> Int
$cenumFrom :: Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
Enum, Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
/= :: Verbosity -> Verbosity -> Bool
Eq, (forall x. Verbosity -> Rep Verbosity x)
-> (forall x. Rep Verbosity x -> Verbosity) -> Generic Verbosity
forall x. Rep Verbosity x -> Verbosity
forall x. Verbosity -> Rep Verbosity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Verbosity -> Rep Verbosity x
from :: forall x. Verbosity -> Rep Verbosity x
$cto :: forall x. Rep Verbosity x -> Verbosity
to :: forall x. Rep Verbosity x -> Verbosity
Generic, Eq Verbosity
Eq Verbosity =>
(Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Verbosity -> Verbosity -> Ordering
compare :: Verbosity -> Verbosity -> Ordering
$c< :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
>= :: Verbosity -> Verbosity -> Bool
$cmax :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
min :: Verbosity -> Verbosity -> Verbosity
Ord, ReadPrec [Verbosity]
ReadPrec Verbosity
Int -> ReadS Verbosity
ReadS [Verbosity]
(Int -> ReadS Verbosity)
-> ReadS [Verbosity]
-> ReadPrec Verbosity
-> ReadPrec [Verbosity]
-> Read Verbosity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Verbosity
readsPrec :: Int -> ReadS Verbosity
$creadList :: ReadS [Verbosity]
readList :: ReadS [Verbosity]
$creadPrec :: ReadPrec Verbosity
readPrec :: ReadPrec Verbosity
$creadListPrec :: ReadPrec [Verbosity]
readListPrec :: ReadPrec [Verbosity]
Read, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> [Char]
(Int -> Verbosity -> ShowS)
-> (Verbosity -> [Char])
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verbosity -> ShowS
showsPrec :: Int -> Verbosity -> ShowS
$cshow :: Verbosity -> [Char]
show :: Verbosity -> [Char]
$cshowList :: [Verbosity] -> ShowS
showList :: [Verbosity] -> ShowS
Show)

$(deriveJSON defaultOptions ''Verbosity)

-- | Types with an output lock for concurrent output.
class HasLock e where
  getLock :: e -> MVar ()

-- | Types with logging information.
class HasLogHandles e where
  getLogHandles :: e -> [Handle]

-- | Types with starting time.
class HasStartingTime s where
  getStartingTime :: s -> UTCTime

-- | Types with verbosity.
class HasVerbosity s where
  getVerbosity :: s -> Verbosity

-- | Reader transformer used for logging to a file and to standard output.
type Logger e a = ReaderT e IO a

msgPrepare :: BL.ByteString -> BL.ByteString -> BL.ByteString
msgPrepare :: ByteString -> ByteString -> ByteString
msgPrepare ByteString
pref ByteString
msg = ByteString -> [ByteString] -> ByteString
BL.intercalate ByteString
"\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ByteString -> ByteString
BL.append ByteString
pref) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BL.lines ByteString
msg

-- Make sure that concurrent output is not scrambled.
atomicAction :: (HasLock e) => IO () -> Logger e ()
atomicAction :: forall e. HasLock e => IO () -> Logger e ()
atomicAction IO ()
a = do
  MVar ()
l <- (e -> MVar ()) -> ReaderT e IO (MVar ())
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader e -> MVar ()
forall e. HasLock e => e -> MVar ()
getLock
  IO () -> Logger e ()
forall a. IO a -> ReaderT e IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Logger e ()) -> IO () -> Logger e ()
forall a b. (a -> b) -> a -> b
$ MVar () -> (() -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
l (IO () -> () -> IO ()
forall a b. a -> b -> a
const IO ()
a)

-- | Write to standard output and maybe to log file.
logOutB ::
  (HasLogHandles e, HasLock e) =>
  -- | Prefix.
  BL.ByteString ->
  -- | Message.
  BL.ByteString ->
  Logger e ()
logOutB :: forall e.
(HasLogHandles e, HasLock e) =>
ByteString -> ByteString -> Logger e ()
logOutB ByteString
pref ByteString
msg = do
  [Handle]
hs <- (e -> [Handle]) -> ReaderT e IO [Handle]
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader e -> [Handle]
forall e. HasLogHandles e => e -> [Handle]
getLogHandles
  (Handle -> Logger e ()) -> [Handle] -> Logger e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> Logger e ()
forall e. HasLock e => IO () -> Logger e ()
atomicAction (IO () -> Logger e ())
-> (Handle -> IO ()) -> Handle -> Logger e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> ByteString -> IO ()
`BL.hPutStrLn` ByteString
msg')) [Handle]
hs
  where
    msg' :: ByteString
msg' = ByteString -> ByteString -> ByteString
msgPrepare ByteString
pref ByteString
msg

-- Perform debug action.
logDebugA :: (HasLock e, HasLogHandles e, HasVerbosity e) => Logger e () -> Logger e ()
logDebugA :: forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
Logger e () -> Logger e ()
logDebugA Logger e ()
a = (e -> Verbosity) -> ReaderT e IO Verbosity
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader e -> Verbosity
forall s. HasVerbosity s => s -> Verbosity
getVerbosity ReaderT e IO Verbosity -> (Verbosity -> Logger e ()) -> Logger e ()
forall a b.
ReaderT e IO a -> (a -> ReaderT e IO b) -> ReaderT e IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Verbosity
v -> Bool -> Logger e () -> Logger e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
v Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Debug) Logger e ()
a

-- | Log debug message.
logDebugB :: (HasLock e, HasLogHandles e, HasVerbosity e) => BL.ByteString -> Logger e ()
logDebugB :: forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB = Logger e () -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
Logger e () -> Logger e ()
logDebugA (Logger e () -> Logger e ())
-> (ByteString -> Logger e ()) -> ByteString -> Logger e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Logger e ()
forall e.
(HasLogHandles e, HasLock e) =>
ByteString -> ByteString -> Logger e ()
logOutB ByteString
"D: "

-- | Log debug message.
logDebugS :: (HasLock e, HasLogHandles e, HasVerbosity e) => String -> Logger e ()
logDebugS :: forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logDebugS = ByteString -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logDebugB (ByteString -> Logger e ())
-> ([Char] -> ByteString) -> [Char] -> Logger e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BL.pack

-- Perform warning action.
logWarnA :: (HasLogHandles e, HasVerbosity e) => Logger e () -> Logger e ()
logWarnA :: forall e.
(HasLogHandles e, HasVerbosity e) =>
Logger e () -> Logger e ()
logWarnA Logger e ()
a = (e -> Verbosity) -> ReaderT e IO Verbosity
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader e -> Verbosity
forall s. HasVerbosity s => s -> Verbosity
getVerbosity ReaderT e IO Verbosity -> (Verbosity -> Logger e ()) -> Logger e ()
forall a b.
ReaderT e IO a -> (a -> ReaderT e IO b) -> ReaderT e IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Verbosity
v -> Bool -> Logger e () -> Logger e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
v Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Warn) Logger e ()
a

-- | Log warning message.
logWarnB :: (HasLock e, HasLogHandles e, HasVerbosity e) => BL.ByteString -> Logger e ()
logWarnB :: forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logWarnB = Logger e () -> Logger e ()
forall e.
(HasLogHandles e, HasVerbosity e) =>
Logger e () -> Logger e ()
logWarnA (Logger e () -> Logger e ())
-> (ByteString -> Logger e ()) -> ByteString -> Logger e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Logger e ()
forall e.
(HasLogHandles e, HasLock e) =>
ByteString -> ByteString -> Logger e ()
logOutB ByteString
"W: "

-- | Log warning message.
logWarnS :: (HasLock e, HasLogHandles e, HasVerbosity e) => String -> Logger e ()
logWarnS :: forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logWarnS = ByteString -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logWarnB (ByteString -> Logger e ())
-> ([Char] -> ByteString) -> [Char] -> Logger e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BL.pack

-- Perform info action.
logInfoA :: (HasLogHandles e, HasVerbosity e) => Logger e () -> Logger e ()
logInfoA :: forall e.
(HasLogHandles e, HasVerbosity e) =>
Logger e () -> Logger e ()
logInfoA Logger e ()
a = (e -> Verbosity) -> ReaderT e IO Verbosity
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader e -> Verbosity
forall s. HasVerbosity s => s -> Verbosity
getVerbosity ReaderT e IO Verbosity -> (Verbosity -> Logger e ()) -> Logger e ()
forall a b.
ReaderT e IO a -> (a -> ReaderT e IO b) -> ReaderT e IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Verbosity
v -> Bool -> Logger e () -> Logger e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
v Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
Info) Logger e ()
a

-- | Log info message.
logInfoB :: (HasLock e, HasLogHandles e, HasVerbosity e) => BL.ByteString -> Logger e ()
logInfoB :: forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB = Logger e () -> Logger e ()
forall e.
(HasLogHandles e, HasVerbosity e) =>
Logger e () -> Logger e ()
logInfoA (Logger e () -> Logger e ())
-> (ByteString -> Logger e ()) -> ByteString -> Logger e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Logger e ()
forall e.
(HasLogHandles e, HasLock e) =>
ByteString -> ByteString -> Logger e ()
logOutB ByteString
"   "

-- | Log info message.
logInfoS :: (HasLock e, HasLogHandles e, HasVerbosity e) => String -> Logger e ()
logInfoS :: forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logInfoS = ByteString -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger e ())
-> ([Char] -> ByteString) -> [Char] -> Logger e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BL.pack

-- Be careful; it is necessary to synchronize the version numbers across packages.
versionString :: String
versionString :: [Char]
versionString = [Char]
"ELynx Suite version " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
showVersion Version
version [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."

copyrightString :: String
copyrightString :: [Char]
copyrightString = [Char]
"Developed by Dominik Schrempf."

compilationString :: String
compilationString :: [Char]
compilationString =
  [Char]
"Compiled on "
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ $( stringE
            =<< runIO
              ( formatTime defaultTimeLocale "%B %-e, %Y, at %H:%M %P, %Z."
                  `fmap` getCurrentTime
              )
        )

-- | A short header to be used in executables. 'unlines' doesn't work here
-- because it adds an additional newline at the end.
logHeader :: [String]
logHeader :: [[Char]]
logHeader = [[Char]
versionString, [Char]
copyrightString, [Char]
compilationString]

-- For a given width, align string to the right; use given fill character.
alignRightWithNoTrim :: Char -> Int -> BL.ByteString -> BL.ByteString
alignRightWithNoTrim :: Char -> Int -> ByteString -> ByteString
alignRightWithNoTrim Char
c Int
n ByteString
s = Int64 -> Char -> ByteString
BL.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
l) Char
c ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s
  where
    l :: Int64
l = ByteString -> Int64
BL.length ByteString
s

-- Adapted from System.ProgressBar.renderDuration of package
-- [terminal-progressbar-0.4.1](https://hackage.haskell.org/package/terminal-progress-bar-0.4.1).
renderDuration :: NominalDiffTime -> BL.ByteString
renderDuration :: NominalDiffTime -> ByteString
renderDuration NominalDiffTime
dt = ByteString
hTxt ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
mTxt ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sTxt
  where
    hTxt :: ByteString
hTxt = Int -> ByteString
renderDecimal Int
h ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":"
    mTxt :: ByteString
mTxt = Int -> ByteString
renderDecimal Int
m ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":"
    sTxt :: ByteString
sTxt = Int -> ByteString
renderDecimal Int
s
    (Int
h, Int
hRem) = Int
ts Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
3600
    (Int
m, Int
s) = Int
hRem Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60
    -- Total amount of seconds
    ts :: Int
    ts :: Int
ts = NominalDiffTime -> Int
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
dt
    renderDecimal :: Int -> ByteString
renderDecimal Int
n = Char -> Int -> ByteString -> ByteString
alignRightWithNoTrim Char
'0' Int
2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
BB.intDec Int
n

-- Render a time stamp.
renderTime :: (FormatTime t) => t -> String
renderTime :: forall t. FormatTime t => t -> [Char]
renderTime = TimeLocale -> [Char] -> t -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%B %-e, %Y, at %H:%M %P, %Z."

-- | Log header.
logInfoHeader :: (HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) => String -> [String] -> Logger e ()
logInfoHeader :: forall e.
(HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) =>
[Char] -> [[Char]] -> Logger e ()
logInfoHeader [Char]
cmdName [[Char]]
cmdDsc = do
  [Char] -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logInfoS [Char]
hline
  [Char] -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logInfoS ([Char] -> Logger e ()) -> [Char] -> Logger e ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
logHeader
  [Char]
t <- UTCTime -> [Char]
forall t. FormatTime t => t -> [Char]
renderTime (UTCTime -> [Char]) -> ReaderT e IO UTCTime -> ReaderT e IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (e -> UTCTime) -> ReaderT e IO UTCTime
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader e -> UTCTime
forall s. HasStartingTime s => s -> UTCTime
getStartingTime
  [Char]
p <- IO [Char] -> ReaderT e IO [Char]
forall a. IO a -> ReaderT e IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getProgName
  [[Char]]
as <- IO [[Char]] -> ReaderT e IO [[Char]]
forall a. IO a -> ReaderT e IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [[Char]]
getArgs
  [Char] -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logInfoS ([Char] -> Logger e ()) -> [Char] -> Logger e ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
      [Char]
hline
        [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([Char]
"Command name: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
cmdName)
        [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
cmdDsc
        [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"Starting time: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
t, [Char]
"Command line: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
p [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
as]
  [Char] -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logInfoS [Char]
hline
  where
    hline :: [Char]
hline = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
78 Char
'-'

-- | Log footer.
logInfoFooter :: (HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) => Logger e ()
logInfoFooter :: forall e.
(HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) =>
Logger e ()
logInfoFooter = do
  UTCTime
ti <- (e -> UTCTime) -> ReaderT e IO UTCTime
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader e -> UTCTime
forall s. HasStartingTime s => s -> UTCTime
getStartingTime
  UTCTime
te <- IO UTCTime -> ReaderT e IO UTCTime
forall a. IO a -> ReaderT e IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let dt :: NominalDiffTime
dt = UTCTime
te UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
ti
  ByteString -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
ByteString -> Logger e ()
logInfoB (ByteString -> Logger e ()) -> ByteString -> Logger e ()
forall a b. (a -> b) -> a -> b
$ ByteString
"Wall clock run time: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> ByteString
renderDuration NominalDiffTime
dt ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"."
  [Char] -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logInfoS ([Char] -> Logger e ()) -> [Char] -> Logger e ()
forall a b. (a -> b) -> a -> b
$ [Char]
"End time: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> UTCTime -> [Char]
forall t. FormatTime t => t -> [Char]
renderTime UTCTime
te

-- | Unified way of creating a new section in the log.
logInfoNewSection :: (HasLock e, HasLogHandles e, HasVerbosity e) => String -> Logger e ()
logInfoNewSection :: forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logInfoNewSection [Char]
s = [Char] -> Logger e ()
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
[Char] -> Logger e ()
logInfoS ([Char] -> Logger e ()) -> [Char] -> Logger e ()
forall a b. (a -> b) -> a -> b
$ [Char]
"== " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
s