git.iko.soy/rowtype-yoga/purescript-native
on 5e3f09c help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/ModuleDependencies.hs
61 lines 2.0 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-- |
12--
13-----------------------------------------------------------------------------
15module Language.PureScript.ModuleDependencies (
16 sortModules
17) where
19import Data.Data
20import Data.Graph
21import Data.Generics
22import Data.List (nub, intersect)
23import Control.Applicative ((<$>))
25import Language.PureScript.Declarations
26import Language.PureScript.Names
27import Language.PureScript.Values
28import Language.PureScript.Types
30sortModules :: [Module] -> Either String [Module]
31sortModules ms = do
32 let verts = map (\m -> (m, getModuleName m, usedModules m)) ms
33 mapM toModule $ stronglyConnComp verts
35collapseBindingGroups :: [Declaration] -> [Declaration]
36collapseBindingGroups ds = concatMap go ds
37 where
38 go (DataBindingGroupDeclaration ds) = ds
39 go (BindingGroupDeclaration ds) = map (\(ident, val) -> ValueDeclaration ident [] Nothing val) ds
40 go other = [other]
42usedModules :: (Data d) => d -> [ProperName]
43usedModules = nub . everything (++) (mkQ [] qualifiedIdents `extQ` qualifiedProperNames `extQ` imports)
44 where
45 qualifiedIdents :: Qualified Ident -> [ProperName]
46 qualifiedIdents (Qualified (Just (ModuleName pn)) _) = [pn]
47 qualifiedIdents _ = []
48 qualifiedProperNames :: Qualified ProperName -> [ProperName]
49 qualifiedProperNames (Qualified (Just (ModuleName pn)) _) = [pn]
50 qualifiedProperNames _ = []
51 imports :: Declaration -> [ProperName]
52 imports (ImportDeclaration (ModuleName pn) _) = [pn]
53 imports _ = []
55getModuleName :: Module -> ProperName
56getModuleName (Module pn _) = pn
58toModule :: SCC Module -> Either String Module
59toModule (AcyclicSCC m) = return m
60toModule (CyclicSCC [m]) = return m
61toModule (CyclicSCC _) = Left "Cycle in module dependencies"