module Hix.Log where

import Control.Monad.Trans.Reader (ask)
import Exon (exon)
import Text.PrettyPrint (Doc)

import Hix.Console (color, withChevrons)
import qualified Hix.Data.Monad
import Hix.Data.Monad (LogLevel (..), M (M))

log :: LogLevel -> Text -> M ()
log :: LogLevel -> Text -> M ()
log LogLevel
level Text
msg = do
  AppResources
env <- ReaderT AppResources (ExceptT Error IO) AppResources
-> M AppResources
forall a. ReaderT AppResources (ExceptT Error IO) a -> M a
M ReaderT AppResources (ExceptT Error IO) AppResources
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  AppResources
env.logger LogLevel
level Text
msg

verbose :: Text -> M ()
verbose :: Text -> M ()
verbose Text
msg =
  LogLevel -> Text -> M ()
log LogLevel
LogVerbose (Int -> Text -> Text
withChevrons Int
4 Text
msg)

debug :: Text -> M ()
debug :: Text -> M ()
debug Text
msg =
  LogLevel -> Text -> M ()
log LogLevel
LogDebug [exon|[#{color 6 "debug"}] #{msg}|]

debugP :: Doc -> M ()
debugP :: Doc -> M ()
debugP = Text -> M ()
debug (Text -> M ()) -> (Doc -> Text) -> Doc -> M ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall b a. (Show a, IsString b) => a -> b
show

info :: Text -> M ()
info :: Text -> M ()
info Text
msg =
  LogLevel -> Text -> M ()
log LogLevel
LogInfo (Int -> Text -> Text
withChevrons Int
5 Text
msg)

infoPlain :: Text -> M ()
infoPlain :: Text -> M ()
infoPlain Text
msg =
  LogLevel -> Text -> M ()
log LogLevel
LogInfo Text
msg

warn :: Text -> M ()
warn :: Text -> M ()
warn Text
msg =
  LogLevel -> Text -> M ()
log LogLevel
LogWarn (Int -> Text -> Text
withChevrons Int
3 Text
msg)

infoCont :: Text -> M ()
infoCont :: Text -> M ()
infoCont Text
msg =
  LogLevel -> Text -> M ()
log LogLevel
LogInfo [exon|    #{msg}|]

error :: Text -> M ()
error :: Text -> M ()
error Text
msg =
  LogLevel -> Text -> M ()
log LogLevel
LogError (Int -> Text -> Text
withChevrons Int
1 [exon|Error: #{msg}|])

logWith :: (LogLevel -> Text -> IO ()) -> LogLevel -> Text -> M ()
logWith :: (LogLevel -> Text -> IO ()) -> LogLevel -> Text -> M ()
logWith LogLevel -> Text -> IO ()
handler LogLevel
level Text
msg = do
  AppResources
env <- ReaderT AppResources (ExceptT Error IO) AppResources
-> M AppResources
forall a. ReaderT AppResources (ExceptT Error IO) a -> M a
M ReaderT AppResources (ExceptT Error IO) AppResources
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let
    minVerbose :: Bool
minVerbose = AppResources
env.verbose Bool -> Bool -> Bool
|| AppResources
env.debug
    minInfo :: Bool
minInfo = Bool
minVerbose Bool -> Bool -> Bool
|| Bool -> Bool
not AppResources
env.quiet
  case LogLevel
level of
    LogLevel
LogDebug | AppResources
env.debug -> M ()
accept
    LogLevel
LogVerbose | Bool
minVerbose -> M ()
accept
    LogLevel
LogInfo | Bool
minInfo -> M ()
accept
    LogLevel
LogWarn | Bool
minInfo -> M ()
accept
    LogLevel
LogError -> M ()
accept
    LogLevel
_ -> M ()
forall (f :: * -> *). Applicative f => f ()
unit
  where
    accept :: M ()
accept = IO () -> M ()
forall a. IO a -> M a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (LogLevel -> Text -> IO ()
handler LogLevel
level Text
msg)