module Data.Graph.Wrapper.Internal where
import Control.Applicative (Applicative)
import Data.Array
import Data.Maybe (fromMaybe)
import qualified Data.Graph as G
import qualified Data.Foldable as Foldable
import qualified Data.Traversable as Traversable
type Edge i = (i, i)
data Graph i v = G {
graph :: G.Graph,
indexGVertexArray :: Array G.Vertex i,
gVertexVertexArray :: Array G.Vertex v
}
instance (Ord i, Show i, Show v) => Show (Graph i v) where
show g = "fromVerticesEdges " ++ show ([(i, vertex g i) | i <- vertices g]) ++ " " ++ show (edges g)
instance Functor (Graph i) where
fmap f g = g { gVertexVertexArray = fmap f (gVertexVertexArray g) }
instance Foldable.Foldable (Graph i) where
foldMap f g = Foldable.foldMap f (gVertexVertexArray g)
instance Traversable.Traversable (Graph i) where
traverse f g = fmap (\gvva -> g { gVertexVertexArray = gvva }) (Traversable.traverse f (gVertexVertexArray g))
traverseWithKey :: Applicative t => (i -> a -> t b) -> Graph i a -> t (Graph i b)
traverseWithKey f g = fmap (\gvva -> g { gVertexVertexArray = gvva }) (traverseWithIndex (\gv -> f (gVertexIndex g gv)) (gVertexVertexArray g))
where
traverseWithIndex :: Applicative t => (G.Vertex -> a -> t b) -> Array G.Vertex a -> t (Array G.Vertex b)
traverseWithIndex f a = fmap (array (bounds a)) $ flip Traversable.traverse (assocs a) $ \(k, v) -> fmap ((,) k) $ f k v
indexGVertex :: Ord i => Graph i v -> i -> G.Vertex
indexGVertex g i = indexGVertex' (indexGVertexArray g) i
gVertexIndex :: Graph i v -> G.Vertex -> i
gVertexIndex g gv = indexGVertexArray g ! gv
gVertexVertex :: Graph i v -> G.Vertex -> v
gVertexVertex g gv = gVertexVertexArray g ! gv
vertex :: Ord i => Graph i v -> i -> v
vertex g = gVertexVertex g . indexGVertex g
indexGVertex' :: Ord i => Array G.Vertex i -> i -> G.Vertex
indexGVertex' key_map k = fromMaybe (error "Data.Graph.Wrapper.fromList: one of the edges of a vertex pointed to a vertex that was not supplied in the input") (indexGVertex'_maybe key_map k)
indexGVertex'_maybe :: Ord i => Array G.Vertex i -> i -> Maybe G.Vertex
indexGVertex'_maybe key_map k = go 0 (snd (bounds key_map))
where
go a b | a > b = Nothing
| otherwise = case compare k (key_map ! mid) of
LT -> go a (mid 1)
EQ -> Just mid
GT -> go (mid + 1) b
where mid = (a + b) `div` 2
vertices :: Graph i v -> [i]
vertices g = map (gVertexIndex g) $ G.vertices (graph g)
edges :: Graph i v -> [Edge i]
edges g = map (\(x, y) -> (gVertexIndex g x, gVertexIndex g y)) $ G.edges (graph g)