module Language.PureScript.ModuleDependencies (
sortModules,
ModuleGraph
) where
import Data.Graph
import Data.List (nub)
import Data.Maybe (mapMaybe)
import Language.PureScript.Declarations
import Language.PureScript.Names
import Language.PureScript.Types
type ModuleGraph = [(ModuleName, [ModuleName])]
sortModules :: [Module] -> Either String ([Module], ModuleGraph)
sortModules ms = do
let verts = map (\m@(Module _ ds _) -> (m, getModuleName m, nub (concatMap usedModules ds))) ms
ms' <- mapM toModule $ stronglyConnComp verts
let moduleGraph = map (\(_, mn, deps) -> (mn, deps)) verts
return (ms', moduleGraph)
usedModules :: Declaration -> [ModuleName]
usedModules = let (f, _, _, _, _) = everythingOnValues (++) forDecls forValues (const []) (const []) (const []) in nub . f
where
forDecls :: Declaration -> [ModuleName]
forDecls (ImportDeclaration mn _ _) = [mn]
forDecls _ = []
forValues :: Value -> [ModuleName]
forValues (Var (Qualified (Just mn) _)) = [mn]
forValues (BinaryNoParens (Qualified (Just mn) _) _ _) = [mn]
forValues (Constructor (Qualified (Just mn) _)) = [mn]
forValues (TypedValue _ _ ty) = forTypes ty
forValues _ = []
forTypes :: Type -> [ModuleName]
forTypes (TypeConstructor (Qualified (Just mn) _)) = [mn]
forTypes (ConstrainedType cs _) = mapMaybe (\(Qualified mn _, _) -> mn) cs
forTypes _ = []
getModuleName :: Module -> ModuleName
getModuleName (Module mn _ _) = mn
toModule :: SCC Module -> Either String Module
toModule (AcyclicSCC m) = return m
toModule (CyclicSCC [m]) = return m
toModule (CyclicSCC ms) = Left $ "Cycle in module dependencies: " ++ show (map getModuleName ms)