{-# LANGUAGE OverloadedStrings #-}

module Logger (Logger (logError, logWarning, logInfo, logDebug, logCallStack)) where

import Control.Monad.Trans.Class (MonadTrans (lift))
import Control.Monad.Trans.State (StateT, modify)
import Control.Monad.Trans.Writer (WriterT, tell)
import Data.Functor.Identity (Identity)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import GHC.Stack (HasCallStack, callStack, popCallStack, prettyCallStack)

class (Monad m) => Logger m where
  logError :: T.Text -> m ()
  logWarning :: T.Text -> m ()
  logInfo :: T.Text -> m ()
  logDebug :: T.Text -> m ()
  logCallStack :: (HasCallStack) => m ()
  logCallStack = logDebug . T.pack $ prettyCallStack $ popCallStack $ popCallStack callStack

logIO :: T.Text -> T.Text -> IO ()
logIO kind msg = TIO.putStrLn $ kind <> ": " <> msg

instance Logger IO where
  logError = logIO "error"
  logWarning = logIO "warning"
  logInfo = logIO "info"
  logDebug = logIO "debug"

instance {-# OVERLAPPING #-} (Monad m) => Logger (WriterT T.Text m) where
  logError = tell . (<> "\n")
  logWarning = tell . (<> "\n")
  logInfo = tell . (<> "\n")
  logDebug = tell . (<> "\n")

instance {-# OVERLAPPING #-} (Monad m) => Logger (WriterT String m) where
  logError = tell . T.unpack . (<> "\n")
  logWarning = tell . T.unpack . (<> "\n")
  logInfo = tell . T.unpack . (<> "\n")
  logDebug = tell . T.unpack . (<> "\n")

instance Logger Identity where
  logError = const $ pure ()
  logWarning = const $ pure ()
  logInfo = const $ pure ()
  logDebug = const $ pure ()

-- this isn't strictly correct but it's only used for ParsecT so it is practically correct
instance {-# OVERLAPPABLE #-} (MonadTrans mt, Logger m) => Logger (mt m) where
  logError = lift . logError
  logWarning = lift . logWarning
  logInfo = lift . logInfo
  logDebug = lift . logDebug