From 0f1e653f7f89858eef2b2fc8ce7f9bd094332f6f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Wed, 6 May 2015 16:13:08 +0200
Subject: [PATCH] Change some logging stuff

---
 Language/Haskell/GhcMod/Info.hs        |  4 +++-
 Language/Haskell/GhcMod/Logging.hs     | 12 ++++++------
 Language/Haskell/GhcMod/Monad/Types.hs |  5 +++--
 test/TestUtils.hs                      |  2 +-
 4 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs
index 0fa74e2..d109f02 100644
--- a/Language/Haskell/GhcMod/Info.hs
+++ b/Language/Haskell/GhcMod/Info.hs
@@ -64,7 +64,9 @@ types file lineNo colNo =
 
         convert' $ map (toTup dflag st) $ sortBy (cmp `on` fst) srcSpanTypes
  where
-   handler (SomeException _) = return []
+   handler (SomeException ex) = do
+     gmLog GmException "types" $ showDoc ex
+     return []
 
 getSrcSpanType :: GhcMonad m => G.ModSummary -> Int -> Int -> m [(SrcSpan, Type)]
 getSrcSpanType modSum lineNo colNo = do
diff --git a/Language/Haskell/GhcMod/Logging.hs b/Language/Haskell/GhcMod/Logging.hs
index 142bd40..019c12b 100644
--- a/Language/Haskell/GhcMod/Logging.hs
+++ b/Language/Haskell/GhcMod/Logging.hs
@@ -57,16 +57,16 @@ decreaseLogLevel l = pred l
 -- False
 gmLog :: (MonadIO m, GmLog m) => GmLogLevel -> String -> Doc -> m ()
 gmLog level loc' doc = do
-  GhcModLog { gmLogLevel = level' } <- gmlHistory
+  GhcModLog { gmLogLevel = Just level' } <- gmlHistory
 
   let loc | loc' == "" = empty
           | otherwise = text loc' <+>: empty
-      msg = gmRenderDoc $ gmLogLevelDoc level <+>: sep [loc, doc]
-      msg' = dropWhileEnd isSpace msg
+      msgDoc = gmLogLevelDoc level <+>: sep [loc, doc]
+      msg = dropWhileEnd isSpace $ gmRenderDoc msgDoc
 
-  when (Just level <= level') $
-       liftIO $ hPutStrLn stderr msg'
-  gmlJournal (GhcModLog Nothing [(level, render loc, msg)])
+  when (level <= level') $ liftIO $ hPutStrLn stderr msg
+
+  gmlJournal (GhcModLog Nothing [(level, loc', msgDoc)])
 
 newtype LogDiscardT m a = LogDiscardT { runLogDiscard :: m a }
     deriving (Functor, Applicative, Monad)
diff --git a/Language/Haskell/GhcMod/Monad/Types.hs b/Language/Haskell/GhcMod/Monad/Types.hs
index ab644db..f769a5b 100644
--- a/Language/Haskell/GhcMod/Monad/Types.hs
+++ b/Language/Haskell/GhcMod/Monad/Types.hs
@@ -101,6 +101,7 @@ import Data.Maybe
 import Data.Monoid
 import Data.IORef
 import Distribution.Helper
+import Text.PrettyPrint (Doc)
 
 import qualified MonadUtils as GHC (MonadIO(..))
 
@@ -111,8 +112,8 @@ data GhcModEnv = GhcModEnv {
 
 data GhcModLog = GhcModLog {
       gmLogLevel    :: Maybe GmLogLevel,
-      gmLogMessages :: [(GmLogLevel, String, String)]
-    } deriving (Eq, Show, Read)
+      gmLogMessages :: [(GmLogLevel, String, Doc)]
+    } deriving (Show)
 
 instance Monoid GhcModLog where
     mempty = GhcModLog (Just GmPanic) mempty
diff --git a/test/TestUtils.hs b/test/TestUtils.hs
index 1f52a1d..877e229 100644
--- a/test/TestUtils.hs
+++ b/test/TestUtils.hs
@@ -78,7 +78,7 @@ runE = runErrorT
 runNullLog :: MonadIO m => JournalT GhcModLog m a -> m a
 runNullLog action = do
   (a,w) <- runJournalT action
-  when (w /= mempty) $ liftIO $ print w
+  liftIO $ print w
   return a
 
 shouldReturnError :: Show a