-- | Compatibility between "Freckle.App" and "RIO" -- -- "Freckle.App" was created before "RIO" existed. We need to decide if we're -- going to move to using "RIO" without "Freckle.App" (and port the things -- we've added to be "RIO"-based), or not. -- -- As part of that decisions, some Apps are using "RIO". These should still be -- able to make use of "Freckle.App", by using this module. -- module Freckle.App.RIO ( toAppLogLevel , fromAppLogLevel , makeLogFunc ) where import Freckle.App.Prelude import Control.Monad.Logger (Loc(..), LogLevel(..)) import Freckle.App.Logging import GHC.Exception (CallStack, SrcLoc(..), getCallStack) import qualified RIO toAppLogLevel :: RIO.LogLevel -> LogLevel toAppLogLevel = \case RIO.LevelDebug -> LevelDebug RIO.LevelInfo -> LevelInfo RIO.LevelWarn -> LevelWarn RIO.LevelError -> LevelError RIO.LevelOther x -> LevelOther x fromAppLogLevel :: LogLevel -> RIO.LogLevel fromAppLogLevel = \case LevelDebug -> RIO.LevelDebug LevelInfo -> RIO.LevelInfo LevelWarn -> RIO.LevelWarn LevelError -> RIO.LevelError LevelOther x -> RIO.LevelOther x makeLogFunc :: HasLogging a => a -> IO RIO.LogFunc makeLogFunc app = do (putLogLine, isANSI) <- getLogBehaviors app pure $ RIO.mkLogFunc $ \cs src rioLevel builder -> do let level = toAppLogLevel rioLevel msg = RIO.utf8BuilderToText builder when (level >= getLogLevel app) $ putLogLine $ case getLogFormat app of FormatJSON -> formatJson (Just $ callStackToLoc cs) (Just src) level msg FormatTerminal -> formatTerminal isANSI (callStackToLoc cs) src level msg callStackToLoc :: CallStack -> Loc callStackToLoc cs = fromMaybe unknownLoc $ do (_, SrcLoc {..}) <- listToMaybe $ getCallStack cs pure $ Loc { loc_filename = srcLocFile , loc_package = srcLocPackage , loc_module = srcLocModule , loc_start = (srcLocStartLine, srcLocStartCol) , loc_end = (srcLocEndLine, srcLocEndCol) } unknownLoc :: Loc unknownLoc = Loc { loc_filename = "" , loc_package = "" , loc_module = "unknown" , loc_start = (0, 0) , loc_end = (0, 0) }