{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Common.MonadLogger
-- License     : BSD3
-- Maintainer  : tbidne@gmail.com
-- Provides logging typeclass and functions.
module Common.MonadLogger
  ( MonadLogger (..),
    clearLine,
    logEmpty,
    resetCR,
    logError,
    logDebug,
    logInfo,
    logInfoBlue,
    logInfoCyan,
    logInfoSuccess,
    logWarn,
  )
where

import App
import qualified Control.Monad.Trans as MTL
import qualified Data.Text as T
import qualified System.Console.Pretty as P
import qualified System.IO as IO

-- | Represents a monad that can log 'T.Text'.
class Monad m => MonadLogger m where
  -- | Logs without a newline character.
  logNoLine :: T.Text -> m ()

  -- | Logs with a newline character.
  logLine :: T.Text -> m ()
  logLine = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logNoLine (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "\n"

instance MonadLogger IO where
  logNoLine :: Text -> IO ()
logNoLine txt :: Text
txt = String -> IO ()
putStr (Text -> String
T.unpack Text
txt) IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> IO ()
IO.hFlush Handle
IO.stdout
  logLine :: Text -> IO ()
logLine = String -> IO ()
putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

instance MonadLogger m => MonadLogger (AppT env m) where
  logNoLine :: Text -> AppT env m ()
logNoLine = m () -> AppT env m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MTL.lift (m () -> AppT env m ()) -> (Text -> m ()) -> Text -> AppT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logNoLine
  logLine :: Text -> AppT env m ()
logLine = m () -> AppT env m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MTL.lift (m () -> AppT env m ()) -> (Text -> m ()) -> Text -> AppT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine

-- | 'resetCR' then `logLine` with 60 spaces.
clearLine :: MonadLogger m => m ()
clearLine :: m ()
clearLine = do
  m ()
forall (m :: * -> *). MonadLogger m => m ()
resetCR
  Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine "                                                            "

-- | 'logLine' with the empty string.
logEmpty :: MonadLogger m => m ()
logEmpty :: m ()
logEmpty = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine ""

-- | 'logNoLine' with a carriage return.
resetCR :: MonadLogger m => m ()
resetCR :: m ()
resetCR = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logNoLine "\r"

-- | Debug formatted 'logLine'.
logDebug :: MonadLogger m => T.Text -> m ()
logDebug :: Text -> m ()
logDebug = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "[Debug] "

-- | Info formatted 'logLine'.
logInfo :: MonadLogger m => T.Text -> m ()
logInfo :: Text -> m ()
logInfo = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "[Info] "

-- | Blue Info formatted 'logLine'.
logInfoBlue :: MonadLogger m => T.Text -> m ()
logInfoBlue :: Text -> m ()
logInfoBlue = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
forall a. Pretty a => Color -> a -> a
P.color Color
P.Blue (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "[Info] "

-- | Cyan Info formatted 'logLine'.
logInfoCyan :: MonadLogger m => T.Text -> m ()
logInfoCyan :: Text -> m ()
logInfoCyan = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
forall a. Pretty a => Color -> a -> a
P.color Color
P.Cyan (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "[Info] "

-- | Success Info formatted 'logLine'.
logInfoSuccess :: MonadLogger m => T.Text -> m ()
logInfoSuccess :: Text -> m ()
logInfoSuccess = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
forall a. Pretty a => Color -> a -> a
P.color Color
P.Green (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "[Info] "

-- | Warn formatted 'logLine'.
logWarn :: MonadLogger m => T.Text -> m ()
logWarn :: Text -> m ()
logWarn = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
forall a. Pretty a => Color -> a -> a
P.color Color
P.Magenta (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "[Warn] "

-- | Error formatted 'logLine'.
logError :: MonadLogger m => T.Text -> m ()
logError :: Text -> m ()
logError = Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logLine (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
forall a. Pretty a => Color -> a -> a
P.color Color
P.Red (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "[Error] "