{-# LANGUAGE FlexibleContexts #-} {- | Module : $Header$ Description : Contains dependency resolution algorithms. Author : Nils 'bash0r' Jonsson Copyright : (c) 2015 Nils 'bash0r' Jonsson License : MIT Maintainer : aka.bash0r@gmail.com Stability : unstable Portability : non-portable (Portability is untested.) This module contains all dependency resolution algorithms. -} module Logic.Dependency.Resolution ( resolve ) where import Control.Applicative import Control.Monad import Control.Monad.State.Lazy import Data.List import Data.Model.Project import Data.Model.Utility resolve :: [Project] -> Maybe [Project] resolve = evalState resolver resolver = findRootProjects >>= (resolveProjects . reverse) findRootProjects :: State [Project] [Project] findRootProjects = do xs <- get let (rootProjects,remaining) = findRootProjects' xs [] [] put remaining return rootProjects where hasDependencies (Project _ _ []) = False hasDependencies (Project {} ) = True findRootProjects' [] rp rem = (reverse rp, reverse rem) findRootProjects' (x:xs) rp rem = if hasDependencies x then findRootProjects' xs rp (x:rem) else findRootProjects' xs (x:rp) rem resolveProjects :: [Project] -> State [Project] (Maybe [Project]) resolveProjects rs = resolveProjects' rs >>= \res -> return (fmap reverse res) where resolveProjects' :: [Project] -> State [Project] (Maybe [Project]) resolveProjects' rs = do xs <- get if null xs then (return . return) rs else do let (rs', xs') = traverse xs rs [] put xs' if genericLength xs == genericLength xs' then return empty else resolveProjects' rs' traverse [] rs rem = (rs, rem) traverse (x@(Project name _ ds):xs) rs rem = if rs `hasDependencies` ds then traverse xs (x:rs) rem else traverse xs rs (x:rem) hasDependencies _ [] = True hasDependencies rs (d:ds) = d `isContainedIn` rs && rs `hasDependencies` ds isContainedIn d [] = False isContainedIn d (Project name _ _ :xs) = d == name || d `isContainedIn` xs