53 lines
1.8 KiB
Haskell
53 lines
1.8 KiB
Haskell
{-# 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
|