94 lines
3.2 KiB
Haskell
94 lines
3.2 KiB
Haskell
module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo, componentInfo) where
|
|
|
|
import Control.Arrow (first)
|
|
import Control.Applicative ((<$>))
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Set as Set
|
|
import Data.Char
|
|
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
|
|
crdl@Cradle {..} <- cradle
|
|
mcs <- resolveGmComponents Nothing =<< mapM (resolveEntrypoint crdl) =<< 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)
|
|
]
|
|
|
|
componentInfo :: IOish m => [String] -> GhcModT m String
|
|
componentInfo ts = do
|
|
crdl <- cradle
|
|
opts <- targetGhcOptions crdl $ Set.fromList $ map guessModuleFile ts
|
|
|
|
return $ unlines $
|
|
[ "GHC Cabal options:\n" ++ render (nest 4 $ fsep $ map text opts)
|
|
]
|
|
|
|
guessModuleFile :: String -> Either FilePath ModuleName
|
|
guessModuleFile mn@(h:r)
|
|
| isUpper h && all isAlphaNum r = Right $ mkModuleName mn
|
|
guessModuleFile str = Left str
|
|
|
|
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
|