handling logging level
This commit is contained in:
parent
06323ac20f
commit
d0ea69b61b
@ -94,7 +94,7 @@ stackCradle wdir = do
|
|||||||
-- If dist/setup-config already exists the user probably wants to use cabal
|
-- If dist/setup-config already exists the user probably wants to use cabal
|
||||||
-- rather than stack, or maybe that's just me ;)
|
-- rather than stack, or maybe that's just me ;)
|
||||||
whenM (liftIO $ doesFileExist $ setupConfigPath "dist") $ do
|
whenM (liftIO $ doesFileExist $ setupConfigPath "dist") $ do
|
||||||
gmLog GmDebug "" $ (text
|
gmLog GmWarning "" $ (text
|
||||||
"'dist/setup-config' exists, ignoring Stack and using cabal-install instead.")
|
"'dist/setup-config' exists, ignoring Stack and using cabal-install instead.")
|
||||||
mzero
|
mzero
|
||||||
|
|
||||||
|
@ -78,6 +78,17 @@ gmLog level loc' doc = do
|
|||||||
|
|
||||||
gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc', msgDoc)])
|
gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc', msgDoc)])
|
||||||
|
|
||||||
|
-- | Appends a collection of logs to the logging environment, with effects
|
||||||
|
-- | if their log level specifies it should
|
||||||
|
gmLog' :: (MonadIO m, GmLog m, GmOut m) => GhcModLog -> m ()
|
||||||
|
gmLog' newLog@ GhcModLog { gmLogMessages } = do
|
||||||
|
GhcModLog { gmLogLevel = Just level' } <- gmlHistory
|
||||||
|
mapM_ (\(level, _, msgDoc) -> when (level <= level') $ gmErrStrLn (docToString msgDoc)) gmLogMessages
|
||||||
|
-- instance Monoid GhcModLog takes the second debug level for some reason, so we need to force this to nothing
|
||||||
|
gmlJournal (GhcModLog Nothing (Last Nothing) gmLogMessages)
|
||||||
|
where
|
||||||
|
docToString msgDoc = dropWhileEnd isSpace $ gmRenderDoc msgDoc
|
||||||
|
|
||||||
gmVomit :: (MonadIO m, GmLog m, GmOut m, GmEnv m) => String -> Doc -> String -> m ()
|
gmVomit :: (MonadIO m, GmLog m, GmOut m, GmEnv m) => String -> Doc -> String -> m ()
|
||||||
gmVomit filename doc content = do
|
gmVomit filename doc content = do
|
||||||
gmLog GmVomit "" $ doc <+>: text content
|
gmLog GmVomit "" $ doc <+>: text content
|
||||||
|
@ -99,8 +99,8 @@ runGhcModT opt action = liftIO (getCurrentDirectory >>= canonicalizePath) >>= \d
|
|||||||
runGmOutT opt $
|
runGmOutT opt $
|
||||||
withGhcModEnv dir' opt $ \(env,lg) ->
|
withGhcModEnv dir' opt $ \(env,lg) ->
|
||||||
first (fst <$>) <$> runGhcModT' env defaultGhcModState
|
first (fst <$>) <$> runGhcModT' env defaultGhcModState
|
||||||
( gmlJournal lg >>
|
(gmSetLogLevel (ooptLogLevel $ optOutput opt) >>
|
||||||
gmSetLogLevel (ooptLogLevel $ optOutput opt) >>
|
gmLog' lg >>
|
||||||
action)
|
action)
|
||||||
|
|
||||||
-- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
|
-- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
|
||||||
|
Loading…
Reference in New Issue
Block a user