forgot I added a file
This commit is contained in:
parent
b930a78f66
commit
42bc374d39
1 changed files with 76 additions and 0 deletions
76
app/Logger.hs
Normal file
76
app/Logger.hs
Normal file
|
|
@ -0,0 +1,76 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Logger (Logger (logError, logWarning, logInfo, logDebug)) 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 T
|
||||
import Development.Shake (Action)
|
||||
import qualified Development.Shake as Shake
|
||||
|
||||
class (Monad m) => Logger m where
|
||||
logError :: T.Text -> m ()
|
||||
logWarning :: T.Text -> m ()
|
||||
logInfo :: T.Text -> m ()
|
||||
logDebug :: T.Text -> m ()
|
||||
|
||||
logIO :: T.Text -> IO ()
|
||||
logIO = T.putStrLn
|
||||
|
||||
instance Logger IO where
|
||||
logError = logIO
|
||||
logWarning = logIO
|
||||
logInfo = logIO
|
||||
logDebug = logIO
|
||||
|
||||
logState :: (Monad m) => T.Text -> StateT T.Text m ()
|
||||
logState msg = modify (\log -> log <> msg <> "\n")
|
||||
|
||||
instance (Monad m) => Logger (StateT T.Text m) where
|
||||
logError = logState
|
||||
logWarning = logState
|
||||
logInfo = logState
|
||||
logDebug = logState
|
||||
|
||||
logStateStr :: (Monad m) => T.Text -> StateT String m ()
|
||||
logStateStr msg = modify (\log -> log <> T.unpack msg <> "\n")
|
||||
|
||||
instance (Monad m) => Logger (StateT String m) where
|
||||
logError = logStateStr
|
||||
logWarning = logStateStr
|
||||
logInfo = logStateStr
|
||||
logDebug = logStateStr
|
||||
|
||||
instance (Monad m) => Logger (WriterT T.Text m) where
|
||||
logError = tell . (<> "\n")
|
||||
logWarning = tell . (<> "\n")
|
||||
logInfo = tell . (<> "\n")
|
||||
logDebug = tell . (<> "\n")
|
||||
|
||||
instance (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 Action where
|
||||
logError = Shake.putError . T.unpack
|
||||
logWarning = Shake.putWarn . T.unpack
|
||||
logInfo = Shake.putInfo . T.unpack
|
||||
logDebug = Shake.putLoud . T.unpack
|
||||
|
||||
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 (MonadTrans mt, Logger m) => Logger (mt m) where
|
||||
logError = lift . logError
|
||||
logWarning = lift . logWarning
|
||||
logInfo = lift . logInfo
|
||||
logDebug = lift . logDebug
|
||||
Loading…
Reference in a new issue