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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
module ICurry.DependencyResolution(
ModuleDep(..),
buildDepGraph
) where
import FilePath
import Either
import List
import ICurry.Files
import ICurry.FindAllImports
data ModuleDep = ModuleDep
{ moduleName :: String
, modulePath :: FilePath
, moduleDeps :: [String]}
deriving (Show)
loadModuleFileDeps :: FilePath -> IO ModuleDep
loadModuleFileDeps fname = do
fileContents <- readFile fname
let imports = findAllImports fileContents
let moduleName = maybe "" id $ findModuleName fileContents
return $ ModuleDep moduleName fname imports
loadModuleDeps :: [FilePath] -> String -> IO ModuleDep
loadModuleDeps paths modname = do
filename <- lookupCurryFile paths modname
if modname == "Prelude"
then return $
ModuleDep modname
(maybe (error "Prelude not found. Something is fishy.")
id
filename)
[]
else do
mdep <- loadModuleFileDeps $ maybe (error "Module not found") id filename
return $ mdep{moduleName = modname}
buildDepGraph :: [FilePath] -> [(Either FilePath String)] -> IO [ModuleDep]
buildDepGraph paths initials = do
modDeps <- mapM (loadModuleDeps paths) modInitials
fileDeps <- mapM loadModuleFileDeps fileInitials
let deps = nubBy samePath $ modDeps ++ fileDeps
res <- bdg deps $ nub $ concatMap moduleDeps deps
return $ nubBy samePath res
where
fileInitials = nub $ map fromLeft $ filter isLeft initials
modInitials = nub $ map fromRight $ filter isRight initials
bdg :: [ModuleDep] -> [String] -> IO [ModuleDep]
bdg ds [] = return ds
bdg ds (m:ms) = if any (isMod m) ds then bdg ds ms else do
nd <- loadModuleDeps paths m
bdg (nd:ds) (ms ++ filter (not . (`elem` ms)) (moduleDeps nd))
samePath :: ModuleDep -> ModuleDep -> Bool
samePath a b = modulePath a == modulePath b
sameModname :: ModuleDep -> ModuleDep -> Bool
sameModname a b = moduleName a == moduleName b
isMod :: String -> ModuleDep -> Bool
isMod m d = m == moduleName d
|