hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up L.H.GM.Target debug/vomit output a bit

Browse Source
This commit is contained in:
Daniel Gröber 2015-08-05 04:06:22 +02:00
parent c9b6e95a30
commit d270e92951
2 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Language/Haskell/GhcMod/Logging.hs
View File

@ -79,7 +79,7 @@ gmLog level loc' doc = do
gmVomit :: (MonadIO m, GmLog m, GmEnv m) => String -> Doc -> String -> m () gmVomit :: (MonadIO m, GmLog 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
GhcModLog { gmLogVomitDump = Last mdump } GhcModLog { gmLogVomitDump = Last mdump }
<- gmlHistory <- gmlHistory

17
Language/Haskell/GhcMod/Target.hs
View File

@ -43,9 +43,10 @@ import Language.Haskell.GhcMod.Utils
import Data.Maybe import Data.Maybe
import Data.Monoid as Monoid import Data.Monoid as Monoid
import Data.Either import Data.Either
import Data.Foldable (foldrM) import Data.Foldable as Foldable (foldrM, concat)
import Data.Traversable hiding (mapM, forM) import Data.Traversable hiding (mapM, forM)
import Data.IORef import Data.IORef
import Data.List
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Set (Set) import Data.Set (Set)
@ -152,8 +153,8 @@ runGmlTWith efnmns' mdf wrapper action = do
gmVomit gmVomit
"session-ghc-options" "session-ghc-options"
(strDoc "Initializing GHC session with following options") (text "Initializing GHC session with following options")
(show opts') (intercalate " " $ map (("\""++) . (++"\"")) opts')
initSession opts' $ initSession opts' $
setModeSimple >>> setEmptyLogger >>> mdf setModeSimple >>> setEmptyLogger >>> mdf
@ -207,6 +208,7 @@ resolvedComponentsCache = Cached {
cachedAction = \tcfs comps ma -> do cachedAction = \tcfs comps ma -> do
Cradle {..} <- cradle Cradle {..} <- cradle
let iifsM = invalidatingInputFiles tcfs let iifsM = invalidatingInputFiles tcfs
mums :: Maybe [Either FilePath ModuleName]
mums = mums =
case iifsM of case iifsM of
Nothing -> Nothing Nothing -> Nothing
@ -225,8 +227,15 @@ resolvedComponentsCache = Cached {
(False, Just mcs) -> gmsGet >>= \s -> gmsPut s { gmComponents = mcs } (False, Just mcs) -> gmsGet >>= \s -> gmsPut s { gmComponents = mcs }
_ -> return () _ -> return ()
let mdesc (Left f) = "file:" ++ f
mdesc (Right mn) = "module:" ++ moduleNameString mn
changed = map (text . mdesc) $ Foldable.concat mums
changedDoc | [] <- changed = text "none"
| otherwise = sep changed
gmLog GmDebug "resolvedComponentsCache" $ gmLog GmDebug "resolvedComponentsCache" $
strDoc "files changed" <+>: text (show (mums :: Maybe [Either FilePath ()])) text "files changed" <+>: changedDoc
mcs <- resolveGmComponents mums comps mcs <- resolveGmComponents mums comps
return (setupConfigPath:flatten mcs , mcs) return (setupConfigPath:flatten mcs , mcs)