I was looking around and liked some of the ways that Boost organizes its libraries. So it got me thinking that it might be easy to use the same for a Haskell graph library. This IS NOT FGL, but does include some elements of it at the end (InductiveGraph). Mostly what I like, is that it presents a (somewhat) logical sequence of operations for a graph writer to implement, getting a few freebies along the way. There aren't too many extensions or complications. The most odd thing is the way I arranged the types. A quick look at some typesigs should clear up confusion, but: Node g is the entire node, eg (Int,a) NodeIndex is just the index eg Int NodeLabel is just the label eg. a the same for edge. I'm just fishing for ideas and opinions, and whether or not this seems simpler to use. http://codepad.org/UXUL7LZv {-# LANGUAGE TypeFamilies ,FlexibleContexts #-} --TODO: Visitors? DFF searches import qualified Data.IntMap as I import Data.List (find,unfoldr,foldl') import Data.Maybe (fromJust) import Control.Arrow (second) class Graph g where type NodeIndex g type EdgeIndex g type Node g --The entire node, including index, any labels and/or data. type Edge g --ditto node_index :: g -> Node g -> NodeIndex g edge_index :: g -> Edge g -> EdgeIndex g empty :: g isEmpty :: g -> Bool mkGraph :: [Node g] -> [Edge g] -> g class Graph g => DirectionalGraph g where edges_out :: g -> NodeIndex g -> [Edge g] source , target :: g -> EdgeIndex g -> Node g degree_out :: g -> NodeIndex g -> Int degree_out = length ... edges_out class DirectionalGraph g => BidirectionalGraph g where edges_in :: g -> NodeIndex g -> [Edge g] edges_both :: g -> NodeIndex g -> [Edge g] edges_both g n = edges_out g n ++ edges_in g n degree_in :: g -> NodeIndex g -> Int degree_in = length ... edges_in degree :: g -> NodeIndex g -> Int degree g n = degree_out g n + degree_in g n class Graph g => AdjacencyGraph g where nodes_out,nodes_in,nodes_both :: g -> NodeIndex g -> [NodeIndex g] class Graph g => VertexGraph g where nodes :: g -> [Node g] node :: g -> NodeIndex g -> Maybe (Node g) hasNode :: g -> NodeIndex g -> Bool hasNode g n = maybe False (const True) (node g n) order :: g -> Int order = length . nodes class Graph g => EdgeGraph g where edges :: g -> [Edge g] edge :: g -> EdgeIndex g -> Maybe (Edge g) hasEdge :: g -> EdgeIndex g -> Bool hasEdge g e = maybe False (const True) (edge g e) size :: g -> Int size = length . edges class Graph g => MutableGraph g where insert_node :: Node g -> g -> g --if preexists, update remove_node :: NodeIndex g -> g -> g insert_edge :: Edge g -> g -> g --if preexists, update remove_edge :: EdgeIndex g -> g -> g class Graph g => PropertyGraph g where type NodeLabel g type EdgeLabel g node_label :: Node g -> NodeLabel g edge_label :: Edge g -> EdgeLabel g node_labelize :: NodeIndex g -> NodeLabel g -> Node g edge_labelize :: EdgeIndex g -> EdgeLabel g -> Edge g get_node_label :: g -> NodeIndex g -> NodeLabel g get_edge_label :: g -> EdgeIndex g -> EdgeLabel g class (VertexGraph g,BidirectionalGraph g,MutableGraph g) => InductiveGraph g where data Context g edgesInC :: Context g -> [Edge g] nodeC :: Context g -> Node g edgesOutC :: Context g -> [Edge g] make_context :: [Edge g] -> Node g -> [Edge g] -> Context g --minimum definition is match or context, but default works too context :: g -> NodeIndex g -> Maybe (Context g) --context = fmap fst ... match context g n = do foundNode <- node g n return $ make_context (edges_in g n) foundNode (edges_out g n) match :: g -> NodeIndex g -> Maybe (Context g,g) match g n = fmap (flip (,) $ remove_node n g) $ context g n insert :: Context g -> g -> g insert c g = foldr insert_edge g'' (edgesOutC c) where g' = insert_node (nodeC c) g g'' = foldr insert_edge g' (edgesInC c) toContexts :: g -> [Context g] toContexts g = unfoldr matchIt (g, map (node_index g) $ nodes g) where matchIt (_, []) = Nothing matchIt (g', (n:ns)) = fmap (second (flip (,) ns)) $ match g n fromContexts :: [Context g] -> g fromContexts = foldr insert empty adjust :: (Context g -> Context g) -> NodeIndex g -> g -> g adjust f n g = maybe g (uncurry (insert . f)) $ match g n gfoldr :: (Context g -> b -> b) -> b -> g -> b gfoldr f i = foldr f i . toContexts gfoldl' :: (b -> Context g -> b) -> b -> g -> b gfoldl' f i = foldl' f i . toContexts gfilter :: (Context g -> Bool) -> g -> g gfilter f = fromContexts . filter f . toContexts class (InductiveGraph g) => MappableGraph g where gmap :: InductiveGraph g' => (Context g -> Context g') -> g -> g' gmap f = fromContexts . map f . toContexts nmap :: (InductiveGraph g,Edge g ~ Edge g) => (Node g -> Node g) -> g -> g nmap f = gmap f' where f' c = make_context (edgesInC c) (f $ nodeC c) (edgesOutC c) emap :: ( InductiveGraph g', Node g ~ Node g') => (Edge g -> Edge g') -> g -> g' emap f = gmap f' where f' c = make_context (map f $ edgesInC c) (nodeC c) (map f $ edgesOutC c)