From d0ea69b61ba7a5701ce65a9e9290e4cd4ed2a39d Mon Sep 17 00:00:00 2001
From: Nicolas Rolland <nicolas.rolland@gmail.com>
Date: Sat, 31 Oct 2015 12:34:30 +0100
Subject: [PATCH] handling logging level

---
 Language/Haskell/GhcMod/Cradle.hs  |  2 +-
 Language/Haskell/GhcMod/Logging.hs | 11 +++++++++++
 Language/Haskell/GhcMod/Monad.hs   |  6 +++---
 3 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs
index 6dc744b..27cf164 100644
--- a/Language/Haskell/GhcMod/Cradle.hs
+++ b/Language/Haskell/GhcMod/Cradle.hs
@@ -94,7 +94,7 @@ stackCradle wdir = do
     -- If dist/setup-config already exists the user probably wants to use cabal
     -- rather than stack, or maybe that's just me ;)
     whenM (liftIO $ doesFileExist $ setupConfigPath "dist") $ do
-                      gmLog GmDebug "" $ (text
+                      gmLog GmWarning "" $ (text
                             "'dist/setup-config' exists, ignoring Stack and using cabal-install instead.") 
                       mzero
 
diff --git a/Language/Haskell/GhcMod/Logging.hs b/Language/Haskell/GhcMod/Logging.hs
index 86df113..edc4135 100644
--- a/Language/Haskell/GhcMod/Logging.hs
+++ b/Language/Haskell/GhcMod/Logging.hs
@@ -78,6 +78,17 @@ gmLog level loc' doc = do
 
   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 filename doc content = do
   gmLog GmVomit "" $ doc <+>: text content
diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs
index 91ee122..8d5f9cc 100644
--- a/Language/Haskell/GhcMod/Monad.hs
+++ b/Language/Haskell/GhcMod/Monad.hs
@@ -99,9 +99,9 @@ runGhcModT opt action = liftIO (getCurrentDirectory >>= canonicalizePath) >>= \d
     runGmOutT opt $
       withGhcModEnv dir' opt $ \(env,lg) ->
         first (fst <$>) <$> runGhcModT' env defaultGhcModState
-          ( gmlJournal lg >>
-            gmSetLogLevel (ooptLogLevel $ optOutput opt) >>
-            action)
+          (gmSetLogLevel (ooptLogLevel $ optOutput opt) >>
+           gmLog' lg >>
+           action)
 
 -- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
 -- computation. Note that if the computation that returned @result@ modified the