git.iko.soy/rowtype-yoga/purescript-native
on 7296802 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/ModuleDependencies.hs
77 lines 2.5 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-----------------------------------------------------------------------------
15{-# LANGUAGE FlexibleContexts #-}
17module Language.PureScript.ModuleDependencies (
18 sortModules,
19 ModuleGraph
20) where
22import Control.Monad.Except
24import Data.Graph
25import Data.List (nub)
26import Data.Maybe (mapMaybe)
28import Language.PureScript.AST
29import Language.PureScript.Names
30import Language.PureScript.Types
31import Language.PureScript.Errors
33-- |
34-- A list of modules with their dependencies
35--
36type ModuleGraph = [(ModuleName, [ModuleName])]
38-- |
39-- Sort a collection of modules based on module dependencies.
40--
41-- Reports an error if the module graph contains a cycle.
42--
43sortModules :: (MonadError MultipleErrors m) => [Module] -> m ([Module], ModuleGraph)
44sortModules ms = do
45 let verts = map (\m@(Module _ _ ds _) -> (m, getModuleName m, nub (concatMap usedModules ds))) ms
46 ms' <- mapM toModule $ stronglyConnComp verts
47 let moduleGraph = map (\(_, mn, deps) -> (mn, deps)) verts
48 return (ms', moduleGraph)
50-- |
51-- Calculate a list of used modules based on explicit imports and qualified names
52--
53usedModules :: Declaration -> [ModuleName]
54usedModules = let (f, _, _, _, _) = everythingOnValues (++) forDecls forValues (const []) (const []) (const []) in nub . f
55 where
56 forDecls :: Declaration -> [ModuleName]
57 forDecls (ImportDeclaration mn _ _) = [mn]
58 forDecls _ = []
60 forValues :: Expr -> [ModuleName]
61 forValues (Var (Qualified (Just mn) _)) = [mn]
62 forValues (Constructor (Qualified (Just mn) _)) = [mn]
63 forValues (TypedValue _ _ ty) = forTypes ty
64 forValues _ = []
66 forTypes :: Type -> [ModuleName]
67 forTypes (TypeConstructor (Qualified (Just mn) _)) = [mn]
68 forTypes (ConstrainedType cs _) = mapMaybe (\(Qualified mn _, _) -> mn) cs
69 forTypes _ = []
71-- |
72-- Convert a strongly connected component of the module graph to a module
73--
74toModule :: (MonadError MultipleErrors m) => SCC Module -> m Module
75toModule (AcyclicSCC m) = return m
76toModule (CyclicSCC [m]) = return m
77toModule (CyclicSCC ms) = throwError . errorMessage $ CycleInModules (map getModuleName ms)