82bb0090c0
This turned out to be quite involved but save for this huge commit it's actually quite awesome and squashes quite a few bugs and nasty problems (hopefully). Most importantly we now have native cabal component support without the user having to do anything to get it! To do this we traverse imports starting from each component's entrypoints (library modules or Main source file for executables) and use this information to find which component's options each module will build with. Under the assumption that these modules have to build with every component they're used in we can now just pick one. Quite a few internal assumptions have been invalidated by this change. Most importantly the runGhcModT* family of cuntions now change the current working directory to `cradleRootDir`.
79 lines
2.7 KiB
Haskell
79 lines
2.7 KiB
Haskell
module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo) where
|
|
|
|
import Control.Arrow (first)
|
|
import Control.Applicative ((<$>))
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Set as Set
|
|
import Text.PrettyPrint
|
|
import Language.Haskell.GhcMod.Convert
|
|
import Language.Haskell.GhcMod.Monad
|
|
import Language.Haskell.GhcMod.Types
|
|
import Language.Haskell.GhcMod.Internal
|
|
import Language.Haskell.GhcMod.CabalHelper
|
|
import Language.Haskell.GhcMod.Target
|
|
import Language.Haskell.GhcMod.Pretty
|
|
|
|
----------------------------------------------------------------
|
|
|
|
-- | Obtaining debug information.
|
|
debugInfo :: IOish m => GhcModT m String
|
|
debugInfo = do
|
|
Options {..} <- options
|
|
Cradle {..} <- cradle
|
|
|
|
cabal <-
|
|
case cradleCabalFile of
|
|
Just _ -> cabalDebug
|
|
Nothing -> return []
|
|
|
|
return $ unlines $
|
|
[ "Root directory: " ++ cradleRootDir
|
|
, "Current directory: " ++ cradleCurrentDir
|
|
, "GHC System libraries: " ++ ghcLibDir
|
|
, "GHC user options: " ++ render (fsep $ map text ghcUserOptions)
|
|
] ++ cabal
|
|
|
|
cabalDebug :: IOish m => GhcModT m [String]
|
|
cabalDebug = do
|
|
Cradle {..} <- cradle
|
|
mcs <- resolveGmComponents Nothing =<< getComponents
|
|
let entrypoints = Map.map gmcEntrypoints mcs
|
|
graphs = Map.map gmcHomeModuleGraph mcs
|
|
opts = Map.map gmcGhcOpts mcs
|
|
srcOpts = Map.map gmcGhcSrcOpts mcs
|
|
|
|
return $
|
|
[ "Cabal file: " ++ show cradleCabalFile
|
|
, "Cabal entrypoints:\n" ++ render (nest 4 $
|
|
mapDoc gmComponentNameDoc smpDoc entrypoints)
|
|
, "Cabal components:\n" ++ render (nest 4 $
|
|
mapDoc gmComponentNameDoc graphDoc graphs)
|
|
, "GHC Cabal options:\n" ++ render (nest 4 $
|
|
mapDoc gmComponentNameDoc (fsep . map text) opts)
|
|
, "GHC search path options:\n" ++ render (nest 4 $
|
|
mapDoc gmComponentNameDoc (fsep . map text) srcOpts)
|
|
]
|
|
|
|
graphDoc :: GmModuleGraph -> Doc
|
|
graphDoc GmModuleGraph{..} =
|
|
mapDoc mpDoc' smpDoc' gmgGraph
|
|
where
|
|
smpDoc' smp = vcat $ map mpDoc' $ Set.toList smp
|
|
mpDoc' = text . moduleNameString . mpModule
|
|
|
|
smpDoc :: Set.Set ModulePath -> Doc
|
|
smpDoc smp = vcat $ map mpDoc $ Set.toList smp
|
|
|
|
mpDoc :: ModulePath -> Doc
|
|
mpDoc (ModulePath mn fn) = text (moduleNameString mn) <+> parens (text fn)
|
|
|
|
|
|
mapDoc :: (k -> Doc) -> (a -> Doc) -> Map.Map k a -> Doc
|
|
mapDoc kd ad m = vcat $
|
|
map (uncurry ($+$)) $ map (first kd) $ Map.toList $ Map.map (nest 4 . ad) m
|
|
----------------------------------------------------------------
|
|
|
|
-- | Obtaining root information.
|
|
rootInfo :: IOish m => GhcModT m String
|
|
rootInfo = convert' =<< cradleRootDir <$> cradle
|