Build Order

In [1]:

    

import qualified Data.Map as Map


    

In [2]:

    

type DependencyGraph a = Map.Map a [a]


    

In [3]:

    

dependencyGraph :: (Ord a) => [a] -> [(a, a)] -> DependencyGraph a
dependencyGraph ps ds =
    Map.fromList [ (p, map snd $ filter ((p ==) . fst) ds) | p <- ps]


    

In [4]:

    

example = dependencyGraph
    ["a", "b", "c", "d", "e", "f"]
    [("d", "a"), ("b", "f"), ("d", "b"), ("a", "f"), ("c", "d")]
    
example


    

    






fromList [("a",["f"]),("b",["f"]),("c",["d"]),("d",["a","b"]),("e",[]),("f",[])]

In [5]:

    

import Data.List
import Data.Maybe


    

In [6]:

    

{-# LANGUAGE ScopedTypeVariables #-}


    

In [7]:

    

buildOrder :: forall a. (Ord a, Show a) => DependencyGraph a -> Either String [a]
buildOrder ds =
    let
        computeState :: (Either String [a], [a]) -> a -> (Either String [a], [a])
        computeState (Left message, _) _ = (Left message, [])
        computeState (Right done, visited) key
            | key `elem` done = (Right done, visited)
            | key `elem` visited = (Left ("Cycle detected: " ++ show key), visited)
            | otherwise =
                let
                    tbd = filter (not . (`elem` done)) $ fromJust $ Map.lookup key ds -- !
                    (done', visited') = foldl' computeState (Right done, key:visited) tbd
                in
                    (fmap (++ [key]) done', visited')
    in
        fst $ foldl' computeState (Right [], []) $ Map.keys ds

buildOrder example
buildOrder $ Map.fromList [("a",["b"]),("b",["a"])]


    

    






Right ["f","a","b","d","c","e"]






    






Left "Cycle detected: \"a\""

In [8]:

    

import Test.QuickCheck


    

In [9]:

    

hasCycles :: forall a. (Ord a) => DependencyGraph a -> Bool
hasCycles ds =
    let
        hasCyclesFrom :: [a] -> a -> Bool
        hasCyclesFrom visited key
            | key `elem` visited = True
            | otherwise =
                maybe False (any (hasCyclesFrom (key:visited))) (Map.lookup key ds)
    in
        any (hasCyclesFrom []) (Map.keys ds)


    

In [10]:

    

checkOrder :: forall a. (Ord a) => DependencyGraph a -> [a] -> Bool
checkOrder ds order =
    let
        computeState :: Maybe [a] -> a -> Maybe [a]
        computeState Nothing _ = Nothing
        computeState (Just done) key
            | maybe False (all (`elem` done)) (Map.lookup key ds) = Just (key:done)
            | otherwise = Nothing
    in
        length order == length (Map.keys ds) &&
            isJust (foldl' computeState (Just []) order)


    

In [11]:

    

either (const False) (checkOrder example) $ buildOrder example
checkOrder example $ Map.keys example


    

    






True






    






False

In [12]:

    

hasCycles example
hasCycles $ Map.fromList [("a",["b"]),("b",["a"])]


    

    






False






    






True

In [13]:

    

data GenericDependencyGraph a = GenericDependencyGraph (DependencyGraph a) deriving (Show)

instance (Ord a, Arbitrary a) => Arbitrary (GenericDependencyGraph a) where
    arbitrary = do
        keys <- fmap nub $ listOf arbitrary
        values <- sequence $ replicate (length keys) (sublistOf keys)
        return $ GenericDependencyGraph (Map.fromList $ zip keys values)


    

In [14]:

    

import Control.Applicative


    

In [15]:

    

testGeneric :: GenericDependencyGraph Int -> Bool
testGeneric (GenericDependencyGraph ds) =
    let
        isCyclicGraph = hasCycles ds
    in
        either 
            (const isCyclicGraph)
            (not isCyclicGraph &&)
                (checkOrder ds <$> buildOrder ds)


    

In [16]:

    

quickCheck testGeneric
--verboseCheckWith stdArgs { maxSize = 5 } testGeneric


    

    






+++ OK, passed 100 tests.

In [17]:

    

data AcyclicDependencyGraph a = AcyclicDependencyGraph (DependencyGraph a) deriving (Show)

instance (Ord a, Arbitrary a) => Arbitrary (AcyclicDependencyGraph a) where
    arbitrary = do
        keys <- fmap nub $ listOf arbitrary
        deps <- sequence $ map sublistOf $ map tail $ init . tails $ keys
        return $ AcyclicDependencyGraph (Map.fromList $ zip keys deps)


    

In [18]:

    

generate arbitrary :: IO (AcyclicDependencyGraph Int)


    

    






AcyclicDependencyGraph (fromList [(-27,[]),(-25,[-27,-17]),(-19,[-17]),(-17,[]),(-13,[-25,-27]),(16,[-25,-27])])

In [19]:

    

testAcyclic :: AcyclicDependencyGraph Int -> Bool
testAcyclic (AcyclicDependencyGraph ds) =
        either (const False) id $ checkOrder ds <$> buildOrder ds


    

In [20]:

    

quickCheckWith stdArgs { maxSize = 5 } testAcyclic


    

    






+++ OK, passed 100 tests.