{-# LANGUAGE GADTs #-}

module HGraph.Directed
       ( DirectedGraph(..)
       , Adjacency(..)
       , Mutable(..)
       )
where

import qualified Data.Map as M
import qualified Data.Set as S

class DirectedGraph t where
  empty :: t a -> t a
  vertices :: t a -> [a]
  numVertices :: Integral b => t a -> b
  numVertices d = fromIntegral $ length $ vertices d
  arcs :: t a -> [(a,a)]
  numArcs :: Integral b => t a -> b
  numArcs d = fromIntegral $ length $ arcs d
  linearizeVertices :: t a -> (t Int, [(Int, a)])
  isVertex :: t a -> a -> Bool

class Adjacency t where
  outneighbors :: t a -> a -> [a]
  inneighbors  :: t a -> a -> [a]
  outdegree :: Integral b => t a -> a -> b
  outdegree d v = fromIntegral $ length $ outneighbors d v
  indegree :: Integral b => t a -> a -> b
  indegree d v = fromIntegral $ length $ inneighbors d v
  arcExists :: t a -> (a,a) -> Bool
  metaBfs :: Ord a => t a -> a -> ([a] -> [a]) -> ([a] -> [a]) -> [a]
  metaBfs d v inFilter outFilter =
    metaBfs' S.empty (S.fromList $ (inFilter $ inneighbors d v) ++ (outFilter $ outneighbors d v))
    where
      metaBfs' visited toVisit = 
        let vs = S.toList toVisit
            newToVisit =
              (S.unions $ map
                (S.fromList . 
                  (\v -> (inFilter $ inneighbors d v) ++ (outFilter $ outneighbors d v)))
                vs
              )
              `S.difference` visited
        in if S.null newToVisit then vs else vs ++ metaBfs' (S.union (S.fromList vs) visited) newToVisit

class Mutable t where
  addVertex    :: a -> t a -> t a
  removeVertex :: a -> t a -> t a
  addArc    :: (a,a) -> t a -> t a
  removeArc :: (a,a) -> t a -> t a