git.iko.soy/rowtype-yoga/purescript-native
on b21773b help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/ModuleDependencies.hs
71 lines 2.3 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.ModuleDependencies
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- | Provides the ability to sort modules based on module dependencies
12--
13-----------------------------------------------------------------------------
15module Language.PureScript.ModuleDependencies (
16 sortModules,
17 ModuleGraph
18) where
20import Data.Data
21import Data.Graph
22import Data.Generics
23import Data.List (nub)
25import Language.PureScript.Declarations
26import Language.PureScript.Names
28-- |
29-- A list of modules with their dependencies
30--
31type ModuleGraph = [(ModuleName, [ModuleName])]
33-- |
34-- Sort a collection of modules based on module dependencies.
35--
36-- Reports an error if the module graph contains a cycle.
37--
38sortModules :: [Module] -> Either String ([Module], ModuleGraph)
39sortModules ms = do
40 let verts = map (\m -> (m, getModuleName m, usedModules m)) ms
41 ms' <- mapM toModule $ stronglyConnComp verts
42 let moduleGraph = map (\(_, mn, deps) -> (mn, deps)) verts
43 return (ms', moduleGraph)
45-- |
46-- Calculate a list of used modules based on explicit imports and qualified names
47--
48usedModules :: (Data d) => d -> [ModuleName]
49usedModules = nub . everything (++) (mkQ [] qualifiedIdents `extQ` qualifiedProperNames `extQ` imports)
50 where
51 qualifiedIdents :: Qualified Ident -> [ModuleName]
52 qualifiedIdents (Qualified (Just mn) _) = [mn]
53 qualifiedIdents _ = []
54 qualifiedProperNames :: Qualified ProperName -> [ModuleName]
55 qualifiedProperNames (Qualified (Just mn) _) = [mn]
56 qualifiedProperNames _ = []
57 imports :: Declaration -> [ModuleName]
58 imports (ImportDeclaration mn _ _) = [mn]
59 imports (PositionedDeclaration _ d) = imports d
60 imports _ = []
62getModuleName :: Module -> ModuleName
63getModuleName (Module mn _ _) = mn
65-- |
66-- Convert a strongly connected component of the module graph to a module
67--
68toModule :: SCC Module -> Either String Module
69toModule (AcyclicSCC m) = return m
70toModule (CyclicSCC [m]) = return m
71toModule (CyclicSCC ms) = Left $ "Cycle in module dependencies: " ++ show (map getModuleName ms)