DR.hs

module DR where

import           Control.Applicative
import           Data.Graph.Inductive.Graph
import           Data.Graph.Inductive.PatriciaTree
import           Data.Graph.Inductive.Query

import qualified Data.Map                          as M

newtype Task = Task Int deriving (Eq, Ord, Show)

example :: M.Map Task [Task]
example = M.fromList [
           (Task 1, [Task 2, Task 3, Task 4]),
           (Task 2, [Task 3]),
           (Task 3, []),
           (Task 4, [Task 2])
          ]

mdfs :: Graph gr => gr a b -> Maybe [Node]
mdfs g = mapM unique (scc g)
    where
      unique [x] = Just x
      unique _ = Nothing

depGraph :: M.Map Task [Task] -> Gr () ()
depGraph deps = mkUGraph nodes' edges'
    where
      nodes' = map ((\(Task p) -> p) . fst) (M.toList deps)
      edges' = concatMap (uncurry reverseDeps) (M.toList deps)
      reverseDeps (Task child) = map (\(Task p) -> (p, child))

-- input - task -> [list of parents]
dr :: M.Map Task [Task] -> Maybe [Task]
dr deps = map Task <$> mdfs (depGraph deps)

main :: IO ()
main = do
  prettyPrint (depGraph example)
  print $ dr example