git.iko.soy/rowtype-yoga/purescript-native
on af90fd5 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/ModuleDependencies.hs
84 lines 3.1 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.ModuleDependencies
4-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5-- License : MIT (http://opensource.org/licenses/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-----------------------------------------------------------------------------
15{-# LANGUAGE FlexibleContexts #-}
17module Language.PureScript.ModuleDependencies (
18 sortModules,
19 ModuleGraph
20) where
22import Control.Monad.Error.Class (MonadError(..))
24import Data.Graph
25import Data.List (nub)
26import Data.Maybe (fromMaybe)
28import Language.PureScript.Crash
29import Language.PureScript.AST
30import Language.PureScript.Names
31import Language.PureScript.Types
32import Language.PureScript.Errors
34-- | A list of modules with their transitive dependencies
35type ModuleGraph = [(ModuleName, [ModuleName])]
37-- | Sort a collection of modules based on module dependencies.
38--
39-- Reports an error if the module graph contains a cycle.
40--
41sortModules :: (MonadError MultipleErrors m) => [Module] -> m ([Module], ModuleGraph)
42sortModules ms = do
43 let verts = map (\m@(Module _ _ _ ds _) -> (m, getModuleName m, nub (concatMap usedModules ds))) ms
44 ms' <- mapM toModule $ stronglyConnComp verts
45 let (graph, fromVertex, toVertex) = graphFromEdges verts
46 moduleGraph = do (_, mn, _) <- verts
47 let v = fromMaybe (internalError "sortModules: vertex not found") (toVertex mn)
48 deps = reachable graph v
49 toKey i = case fromVertex i of (_, key, _) -> key
50 return (mn, filter (/= mn) (map toKey deps))
51 return (ms', moduleGraph)
53-- |
54-- Calculate a list of used modules based on explicit imports and qualified names
55--
56usedModules :: Declaration -> [ModuleName]
57usedModules d =
58 let (f, _, _, _, _) = everythingOnValues (++) forDecls forValues (const []) (const []) (const [])
59 (g, _, _, _, _) = accumTypes (everythingOnTypes (++) forTypes)
60 in nub (f d ++ g d)
61 where
62 forDecls :: Declaration -> [ModuleName]
63 forDecls (ImportDeclaration mn _ _ _) = [mn]
64 forDecls (FixityDeclaration _ _ (Just (Left (Qualified (Just mn) _)))) = [mn]
65 forDecls (FixityDeclaration _ _ (Just (Right (Qualified (Just mn) _)))) = [mn]
66 forDecls (TypeInstanceDeclaration _ _ (Qualified (Just mn) _) _ _) = [mn]
67 forDecls _ = []
69 forValues :: Expr -> [ModuleName]
70 forValues (Var (Qualified (Just mn) _)) = [mn]
71 forValues (Constructor (Qualified (Just mn) _)) = [mn]
72 forValues _ = []
74 forTypes :: Type -> [ModuleName]
75 forTypes (TypeConstructor (Qualified (Just mn) _)) = [mn]
76 forTypes _ = []
78-- |
79-- Convert a strongly connected component of the module graph to a module
80--
81toModule :: (MonadError MultipleErrors m) => SCC Module -> m Module
82toModule (AcyclicSCC m) = return m
83toModule (CyclicSCC [m]) = return m
84toModule (CyclicSCC ms) = throwError . errorMessage $ CycleInModules (map getModuleName ms)