blob: 0f0027d1bfc1d142c4783392922bf136211bd91d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
module CountDeps (printDeps) where
import GHC.Driver.Env
import GHC.Unit.Module
import GHC.Driver.Session
import GHC.Driver.Main
import GHC
import GHC.Utils.Misc
import Data.Maybe
import Control.Monad
import Control.Monad.IO.Class
import System.Environment
import System.Exit
import GHC.Types.Unique.Set
import GHC.Unit.Module.Deps
printDeps :: String -> IO ()
printDeps modName = do
[libdir] <- getArgs
modules <- calcDeps modName libdir
let num = sizeUniqSet modules
putStrLn $ "Found " ++ show num ++ " " ++ modName ++ " module dependencies"
forM_ (map moduleNameString $ nonDetEltsUniqSet modules) putStrLn
calcDeps :: String -> FilePath -> IO (UniqSet ModuleName)
calcDeps modName libdir =
defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
runGhc (Just libdir) $ do
df <- getSessionDynFlags
logger <- getLogger
(df, _, _) <- parseDynamicFlags logger df [noLoc "-package=ghc"]
setSessionDynFlags df
env <- getSession
loop env emptyUniqSet [mkModuleName modName]
where
-- Source imports are only guaranteed to show up in the 'mi_deps'
-- of modules that import them directly and don’t propagate
-- transitively so we loop.
loop :: HscEnv -> UniqSet ModuleName -> [ModuleName] -> Ghc (UniqSet ModuleName)
loop env modules (m : ms) =
if m `elementOfUniqSet` modules
then loop env modules ms
else do
modules <- return (addOneToUniqSet modules m)
mi <- liftIO $ hscGetModuleInterface env (mkModule m)
loop env modules (ms ++ filter (not . (`elementOfUniqSet` modules)) (modDeps mi))
loop _ modules [] = return modules
mkModule :: ModuleName -> Module
mkModule = Module (stringToUnit "ghc")
modDeps :: ModIface -> [ModuleName]
modDeps mi = map gwib_mod $ dep_direct_mods (mi_deps mi)
|
