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