git.iko.soy/rowtype-yoga/purescript-native
on 12c18ae help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/ModuleDependencies.hs
64 lines 2.7 kB history raw
1-- | Provides the ability to sort modules based on module dependencies
2module Language.PureScript.ModuleDependencies
3 ( sortModules
4 , ModuleGraph
5 ) where
7import Protolude
9import Data.Graph
10import qualified Data.Set as S
11import Language.PureScript.AST
12import qualified Language.PureScript.Constants as C
13import Language.PureScript.Crash
14import Language.PureScript.Errors
15import Language.PureScript.Names
17-- | A list of modules with their transitive dependencies
18type ModuleGraph = [(ModuleName, [ModuleName])]
20-- | Sort a collection of modules based on module dependencies.
21--
22-- Reports an error if the module graph contains a cycle.
23sortModules
24 :: forall m
25 . MonadError MultipleErrors m
26 => [Module]
27 -> m ([Module], ModuleGraph)
28sortModules ms = do
29 let mns = S.fromList $ map getModuleName ms
30 verts <- mapM (toGraphNode mns) ms
31 ms' <- mapM toModule $ stronglyConnComp verts
32 let (graph, fromVertex, toVertex) = graphFromEdges verts
33 moduleGraph = do (_, mn, _) <- verts
34 let v = fromMaybe (internalError "sortModules: vertex not found") (toVertex mn)
35 deps = reachable graph v
36 toKey i = case fromVertex i of (_, key, _) -> key
37 return (mn, filter (/= mn) (map toKey deps))
38 return (ms', moduleGraph)
39 where
40 toGraphNode :: S.Set ModuleName -> Module -> m (Module, ModuleName, [ModuleName])
41 toGraphNode mns m@(Module _ _ mn ds _) = do
42 let deps = ordNub (concatMap usedModules ds)
43 forM_ deps $ \dep ->
44 when (dep /= C.Prim && S.notMember dep mns) $
45 throwError . addHint (ErrorInModule mn) . errorMessage $ ModuleNotFound dep
46 pure (m, getModuleName m, deps)
48-- | Calculate a list of used modules based on explicit imports and qualified names.
49usedModules :: Declaration -> [ModuleName]
50usedModules d = f d where
51 f :: Declaration -> [ModuleName]
52 (f, _, _, _, _) = everythingOnValues (++) forDecls (const []) (const []) (const []) (const [])
54 forDecls :: Declaration -> [ModuleName]
55 -- Regardless of whether an imported module is qualified we still need to
56 -- take into account its import to build an accurate list of dependencies.
57 forDecls (ImportDeclaration mn _ _) = [mn]
58 forDecls _ = []
60-- | Convert a strongly connected component of the module graph to a module
61toModule :: MonadError MultipleErrors m => SCC Module -> m Module
62toModule (AcyclicSCC m) = return m
63toModule (CyclicSCC [m]) = return m
64toModule (CyclicSCC ms) = throwError . errorMessage $ CycleInModules (map getModuleName ms)