packages feed

graphs 0.4.0.3 → 0.4.1

raw patch · 28 files changed

+1062/−1054 lines, 28 filesdep ~voidPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: void

API changes (from Hackage documentation)

Files

.travis.yml view
@@ -1,1 +1,8 @@ language: haskell+notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313graphs\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"
− Data/Graph/AdjacencyList.hs 
@@ -1,55 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Adjacency.List--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families----------------------------------------------------------------------------------module Data.Graph.AdjacencyList-  ( AdjacencyList(..)-  , ask-  ) where--import Control.Applicative-import Data.Ix-import Data.Array-import Data.Graph.PropertyMap-import Data.Graph.Class-import Data.Graph.Class.AdjacencyList--newtype AdjacencyList i a = AdjacencyList { runAdjacencyList :: Array i [i] -> a }  --ask :: AdjacencyList i (Array i [i])-ask = AdjacencyList id--instance Functor (AdjacencyList i) where-  fmap f (AdjacencyList g) = AdjacencyList (f . g)-  b <$ _ = pure b--instance Applicative (AdjacencyList i) where-  pure = AdjacencyList . const-  AdjacencyList f <*> AdjacencyList a = AdjacencyList $ \t -> f t (a t)--instance Monad (AdjacencyList i) where-  return = AdjacencyList . const-  AdjacencyList f >>= k = AdjacencyList $ \t -> runAdjacencyList (k (f t)) t--instance Ord i => Graph (AdjacencyList i) where-  type Vertex (AdjacencyList i) = i-  type Edge (AdjacencyList i) = (i, i)-  vertexMap = pure . propertyMap-  edgeMap = pure . propertyMap--instance Ix i => AdjacencyListGraph (AdjacencyList i) where-  adjacentVertices v = AdjacencyList $ \g -> if inRange (bounds g) v -                                     then g ! v -                                     else []-  source (a, _) = pure a-  target (_, b) = pure b-  outEdges = defaultOutEdges
− Data/Graph/AdjacencyMatrix.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Adjacency.Matrix--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families----------------------------------------------------------------------------------module Data.Graph.AdjacencyMatrix-  ( AdjacencyMatrix(..)-  , ask-  ) where--import Control.Applicative-import Data.Ix-import Data.Array.IArray-import Data.Graph.PropertyMap-import Data.Graph.Class-import Data.Graph.Class.AdjacencyMatrix--newtype AdjacencyMatrix arr i a = AdjacencyMatrix { runAdjacencyMatrix :: arr (i,i) Bool -> a } --ask :: AdjacencyMatrix arr i (arr (i, i) Bool)-ask = AdjacencyMatrix id--instance Functor (AdjacencyMatrix arr i) where-  fmap f (AdjacencyMatrix g) = AdjacencyMatrix (f . g)-  b <$ _ = pure b--instance Applicative (AdjacencyMatrix arr i) where-  pure = AdjacencyMatrix . const-  AdjacencyMatrix f <*> AdjacencyMatrix a = AdjacencyMatrix $ \t -> f t (a t)--instance Monad (AdjacencyMatrix arr i) where-  return = AdjacencyMatrix . const-  AdjacencyMatrix f >>= k = AdjacencyMatrix $ \t -> runAdjacencyMatrix (k (f t)) t--instance Ord i => Graph (AdjacencyMatrix arr i) where-  type Vertex (AdjacencyMatrix arr i) = i-  type Edge (AdjacencyMatrix arr i) = (i, i) -  vertexMap = pure . propertyMap-  edgeMap = pure . propertyMap--instance (IArray arr Bool, Ix i) => AdjacencyMatrixGraph (AdjacencyMatrix arr i) where-  edge i j = AdjacencyMatrix $ \a ->-    if inRange (bounds a) ix && (a ! ix) -    then Just ix-    else Nothing-    where ix = (i, j)--
− Data/Graph/Algorithm/BreadthFirstSearch.hs 
@@ -1,118 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Algorithm.BreadthFirstSearch--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families------ Breadth-first search-------------------------------------------------------------------------------module Data.Graph.Algorithm.BreadthFirstSearch-  ( bfs, Bfs(..)-  ) where--import Control.Applicative-import Control.Monad-import Control.Monad.Trans.Class-import Control.Monad.Trans.State.Strict-import Data.Foldable-import Data.Monoid-import Data.Sequence--import Data.Graph.Class-import Data.Graph.Class.AdjacencyList-import Data.Graph.PropertyMap-import Data.Graph.Internal.Color---- | Breadth first search visitor -data Bfs g m = Bfs -  { enterVertex :: Vertex g -> g m -- called the first time a vertex is discovered-  , grayTarget  :: Edge g   -> g m -- called when we encounter a back edge to a vertex we're still processing-  , exitVertex  :: Vertex g -> g m -- called once we have processed all descendants of a vertex-  , blackTarget :: Edge g   -> g m -- called when we encounter a cross edge to a vertex we've already finished-  } --instance Graph g => Functor (Bfs g) where-  fmap f (Bfs a b c d) = Bfs -    (liftM f . a)-    (liftM f . b)-    (liftM f . c)-    (liftM f . d)--instance Graph g => Applicative (Bfs g) where-  pure a = Bfs -    (const (return a))-    (const (return a))-    (const (return a))-    (const (return a))--  m <*> n = Bfs-    (\v -> enterVertex m v `ap` enterVertex n v)-    (\e -> grayTarget m e `ap`  grayTarget n e)-    (\v -> exitVertex m v `ap`  exitVertex n v)-    (\e -> blackTarget m e `ap` blackTarget n e)--instance Graph g => Monad (Bfs g) where-  return = pure-  m >>= f = Bfs-    (\v -> enterVertex m v >>= ($ v) . enterVertex . f)-    (\e -> grayTarget m e >>= ($ e) . grayTarget . f)-    (\v -> exitVertex m v >>= ($ v) . exitVertex . f)-    (\e -> blackTarget m e >>= ($ e) . blackTarget . f)--instance (Graph g, Monoid m) => Monoid (Bfs g m) where-  mempty = return mempty-  mappend = liftM2 mappend--getS :: Monad g => k -> StateT (Seq v, PropertyMap g k Color) g Color-getS k = do-  m <- gets snd -  lift (getP m k)--putS :: Monad g => k -> Color -> StateT (Seq v, PropertyMap g k Color) g ()-putS k v = do-  m <- gets snd -  m' <- lift $ putP m k v-  modify $ \(q,_) -> (q, m')--enqueue :: Graph g -        => Bfs g m -        -> Vertex g -        -> StateT (Seq (Vertex g), PropertyMap g (Vertex g) Color) g m-enqueue vis v = do-  m <- gets snd-  m' <- lift $ putP m v Grey-  modify $ \(q,_) -> (q |> v, m')-  lift $ enterVertex vis v--dequeue :: Monad g => StateT (Seq v, s) g r -> (v -> StateT (Seq v, s) g r) -> StateT (Seq v, s) g r-dequeue ke ks = do-  (q, m) <- get-  case viewl q of-    EmptyL -> ke-    (a :< q') -> put (q', m) >> ks a--bfs :: (AdjacencyListGraph g, Monoid m) => Bfs g m -> Vertex g -> g m-bfs vis v0 = do-  m <- vertexMap White -  evalStateT (enqueue vis v0 >>= pump) (mempty, m) -  where-  pump lhs = dequeue (return lhs) $ \ v -> do-    adjs <- lift $ outEdges v-    children <- foldrM -      (\e m -> do-        v' <- target e-        color <- getS v'-        liftM (`mappend` m) $ case color of-          White -> enqueue vis v' -          Grey -> lift $ grayTarget vis e-          Black -> lift $ blackTarget vis e-      ) mempty adjs-    putS v Black-    rhs <- lift $ exitVertex vis v -    pump $ lhs `mappend` children `mappend` rhs
− Data/Graph/Algorithm/DepthFirstSearch.hs 
@@ -1,103 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Algorithm.DepthFirstSearch--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families------ Depth-first search-------------------------------------------------------------------------------module Data.Graph.Algorithm.DepthFirstSearch-  ( dfs, Dfs(..)-  ) where--import Control.Applicative-import Control.Monad-import Control.Monad.Trans.Class-import Control.Monad.Trans.State.Strict-import Data.Foldable-import Data.Monoid--import Data.Graph.Class-import Data.Graph.Class.AdjacencyList-import Data.Graph.PropertyMap-import Data.Graph.Internal.Color--data Dfs g m = Dfs -  { enterVertex :: Vertex g -> g m -- called the first time a vertex is discovered-  , grayTarget  :: Edge g   -> g m -- called when we encounter a back edge to a vertex we're still processing-  , exitVertex  :: Vertex g -> g m -- called once we have processed all descendants of a vertex-  , blackTarget :: Edge g   -> g m -- called when we encounter a cross edge to a vertex we've already finished-  }--instance Graph g => Functor (Dfs g) where-  fmap f (Dfs a b c d) = Dfs -    (liftM f . a)-    (liftM f . b)-    (liftM f . c)-    (liftM f . d)--instance Graph g => Applicative (Dfs g) where-  pure a = Dfs -    (const (return a))-    (const (return a))-    (const (return a))-    (const (return a))--  m <*> n = Dfs-    (\v -> enterVertex m v `ap` enterVertex n v)-    (\e -> grayTarget m e `ap`  grayTarget n e)-    (\v -> exitVertex m v `ap`  exitVertex n v)-    (\e -> blackTarget m e `ap` blackTarget n e)--instance Graph g => Monad (Dfs g) where-  return = pure-  m >>= f = Dfs-    (\v -> enterVertex m v >>= ($ v) . enterVertex . f)-    (\e -> grayTarget m e >>= ($ e) . grayTarget . f)-    (\v -> exitVertex m v >>= ($ v) . exitVertex . f)-    (\e -> blackTarget m e >>= ($ e) . blackTarget . f)--instance (Graph g, Monoid m) => Monoid (Dfs g m) where-  mempty = return mempty-  mappend = liftM2 mappend--getS :: Monad g => k -> StateT (PropertyMap g k v) g v-getS k = do-  m <- get -  lift (getP m k)--putS :: Monad g => k -> v -> StateT (PropertyMap g k v) g ()-putS k v = do-  m <- get -  m' <- lift $ putP m k v-  put m'---- TODO: CPS transform?-dfs :: (AdjacencyListGraph g, Monoid m) => Dfs g m -> Vertex g -> g m-dfs vis v0 = do-  m <- vertexMap White -  evalStateT (go v0) m where-  go v = do-    putS v Grey-    lhs <- lift $ enterVertex vis v-    adjs <- lift $ outEdges v -    result <- foldrM -      (\e m -> do -        v' <- target e-        color <- getS v'-        liftM (`mappend` m) $ case color of-          White -> go v'-          Grey  -> lift $ grayTarget vis e-          Black -> lift $ blackTarget vis e-      ) -      mempty -      adjs-    putS v Black-    rhs <- lift $ exitVertex vis v-    return $ lhs `mappend` result `mappend` rhs
− Data/Graph/Class.hs 
@@ -1,127 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Class--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families----------------------------------------------------------------------------------module Data.Graph.Class -  ( Graph(..)-  , VertexMap-  , EdgeMap-  , liftVertexMap-  , liftEdgeMap-  ) where--import Control.Monad-import qualified Control.Monad.Trans.State.Strict as Strict-import qualified Control.Monad.Trans.State.Lazy as Lazy-import qualified Control.Monad.Trans.Writer.Strict as Strict-import qualified Control.Monad.Trans.Writer.Lazy as Lazy-import qualified Control.Monad.Trans.RWS.Strict as Strict-import qualified Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Error-import Control.Monad.Trans.Reader -import Control.Monad.Trans.Class-import Data.Functor.Identity-import Data.Monoid-import Data.Graph.PropertyMap-import Data.Void--type VertexMap g = PropertyMap g (Vertex g)-type EdgeMap g = PropertyMap g (Edge g)--class (Monad g, Eq (Vertex g), Eq (Edge g)) => Graph g where-  type Vertex g :: *-  type Edge g :: * -  vertexMap :: a -> g (VertexMap g a)-  edgeMap   :: a -> g (EdgeMap g a)--liftVertexMap :: (MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) -              => a -> t g (VertexMap (t g) a)-liftVertexMap = lift . liftM liftPropertyMap . vertexMap-{-# INLINE liftVertexMap #-}--liftEdgeMap :: (MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) -            => a -> t g (EdgeMap (t g) a)-liftEdgeMap = lift . liftM liftPropertyMap . edgeMap-{-# INLINE liftEdgeMap #-}--instance Graph g => Graph (Strict.StateT s g) where-  type Vertex (Strict.StateT s g) = Vertex g-  type Edge (Strict.StateT s g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--instance Graph g => Graph (Lazy.StateT s g) where-  type Vertex (Lazy.StateT s g) = Vertex g-  type Edge (Lazy.StateT s g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--instance (Graph g, Monoid m) => Graph (Strict.WriterT m g) where-  type Vertex (Strict.WriterT m g) = Vertex g-  type Edge (Strict.WriterT m g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--instance (Graph g, Monoid m) => Graph (Lazy.WriterT m g) where-  type Vertex (Lazy.WriterT m g) = Vertex g-  type Edge (Lazy.WriterT m g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--instance Graph g => Graph (ReaderT m g) where-  type Vertex (ReaderT m g) = Vertex g -  type Edge (ReaderT m g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--instance Graph g => Graph (IdentityT g) where-  type Vertex (IdentityT g) = Vertex g-  type Edge (IdentityT g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--instance Graph g => Graph (MaybeT g) where-  type Vertex (MaybeT g) = Vertex g-  type Edge (MaybeT g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--instance (Graph g, Error e) => Graph (ErrorT e g) where-  type Vertex (ErrorT e g) = Vertex g-  type Edge (ErrorT e g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--instance (Graph g, Monoid w) => Graph (Lazy.RWST r w s g) where-  type Vertex (Lazy.RWST r w s g) = Vertex g-  type Edge (Lazy.RWST r w s g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--instance (Graph g, Monoid w) => Graph (Strict.RWST r w s g) where-  type Vertex (Strict.RWST r w s g) = Vertex g-  type Edge (Strict.RWST r w s g) = Edge g-  vertexMap = liftVertexMap-  edgeMap = liftEdgeMap--voidMap :: PropertyMap Identity Void a-voidMap = PropertyMap (Identity . absurd) $ \_ _ -> Identity voidMap---- | The empty graph-instance Graph Identity where-  type Vertex Identity = Void-  type Edge Identity = Void-  vertexMap _ = Identity voidMap -  edgeMap   _ = Identity voidMap-
− Data/Graph/Class/AdjacencyList.hs 
@@ -1,129 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Class.AdjacencyList--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families----------------------------------------------------------------------------------module Data.Graph.Class.AdjacencyList-  ( AdjacencyListGraph(..)-  , defaultOutEdges-  , module Data.Graph.Class-  ) where--import Control.Monad-import Control.Monad.Trans.Class-import qualified Control.Monad.Trans.State.Strict as Strict-import qualified Control.Monad.Trans.State.Lazy as Lazy-import qualified Control.Monad.Trans.Writer.Strict as Strict-import qualified Control.Monad.Trans.Writer.Lazy as Lazy-import qualified Control.Monad.Trans.RWS.Strict as Strict-import qualified Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Error-import Control.Monad.Trans.Reader-import Data.Functor.Identity-import Data.Monoid-import Data.Graph.Class--defaultOutEdges :: AdjacencyListGraph g => Vertex g -> g [(Vertex g, Vertex g)]-defaultOutEdges v = liftM (map ((,) v)) (adjacentVertices v)---- | Minimal definition: 'source', 'target', and either 'adjacentVertices' with @'outEdges' = 'defaultOutEdges'@ or 'outEdges'-class Graph g => AdjacencyListGraph g where-  -- /O(1)/-  source :: Edge g -> g (Vertex g)-  -- /O(1)/-  target :: Edge g -> g (Vertex g)-  -- /O(e)/ in the number of out edges-  outEdges :: Vertex g -> g [Edge g]--  -- /O(e)/-  outDegree :: Vertex g -> g Int-  outDegree v = liftM length (outEdges v)--  adjacentVertices :: Vertex g -> g [Vertex g]-  adjacentVertices = outEdges >=> mapM target--instance AdjacencyListGraph g => AdjacencyListGraph (Strict.StateT s g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance AdjacencyListGraph g => AdjacencyListGraph (Lazy.StateT s g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Strict.WriterT m g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Lazy.WriterT m g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Strict.RWST r m s g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Lazy.RWST r m s g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance AdjacencyListGraph g => AdjacencyListGraph (ReaderT e g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance (AdjacencyListGraph g, Error e) => AdjacencyListGraph (ErrorT e g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance AdjacencyListGraph g => AdjacencyListGraph (MaybeT g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance AdjacencyListGraph g => AdjacencyListGraph (IdentityT g) where-  adjacentVertices = lift . adjacentVertices-  source = lift . source-  target = lift . target-  outEdges = lift . outEdges-  outDegree = lift . outDegree--instance AdjacencyListGraph Identity where-  source = Identity-  target = Identity-  outEdges _ = Identity []-  outDegree _ = Identity 0
− Data/Graph/Class/AdjacencyMatrix.hs 
@@ -1,68 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Class.AdjacencyMatrix--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families----------------------------------------------------------------------------------module Data.Graph.Class.AdjacencyMatrix-  ( AdjacencyMatrixGraph(..)-  , module Data.Graph.Class-  ) where--import qualified Control.Monad.Trans.State.Strict as Strict-import qualified Control.Monad.Trans.State.Lazy as Lazy-import qualified Control.Monad.Trans.Writer.Strict as Strict-import qualified Control.Monad.Trans.Writer.Lazy as Lazy-import qualified Control.Monad.Trans.RWS.Strict as Strict-import qualified Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Error-import Control.Monad.Trans.Class-import Data.Functor.Identity-import Data.Monoid-import Data.Graph.Class--class Graph g => AdjacencyMatrixGraph g where-  edge :: Vertex g -> Vertex g -> g (Maybe (Edge g))--instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Strict.StateT s g) where-  edge a b = lift (edge a b)--instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Lazy.StateT s g) where-  edge a b = lift (edge a b)--instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Strict.WriterT m g) where-  edge a b = lift (edge a b)--instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Lazy.WriterT m g) where-  edge a b = lift (edge a b)--instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Strict.RWST r m s g) where-  edge a b = lift (edge a b)--instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Lazy.RWST r m s g) where-  edge a b = lift (edge a b)--instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (MaybeT g) where-  edge a b = lift (edge a b)--instance (AdjacencyMatrixGraph g, Error e) => AdjacencyMatrixGraph (ErrorT e g) where-  edge a b = lift (edge a b)--instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (IdentityT g) where-  edge a b = lift (edge a b)--instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (ReaderT e g) where-  edge a b = lift (edge a b)--instance AdjacencyMatrixGraph Identity where-  edge _ _ = Identity Nothing
− Data/Graph/Class/Bidirectional.hs 
@@ -1,113 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Class.Bidirectional--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families----------------------------------------------------------------------------------module Data.Graph.Class.Bidirectional -  ( BidirectionalGraph(..)-  , module Data.Graph.Class.AdjacencyList-  ) where--import Control.Monad-import Control.Monad.Trans.Class-import qualified Control.Monad.Trans.State.Strict as Strict-import qualified Control.Monad.Trans.State.Lazy as Lazy-import qualified Control.Monad.Trans.Writer.Strict as Strict-import qualified Control.Monad.Trans.Writer.Lazy as Lazy-import qualified Control.Monad.Trans.RWS.Strict as Strict-import qualified Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Error-import Data.Functor.Identity-import Data.Monoid-import Data.Graph.Class.AdjacencyList--class AdjacencyListGraph g => BidirectionalGraph g where-  -- /O(e)/-  inEdges :: Vertex g -> g [Edge g]-  -- /O(e)/-  inDegree :: Vertex g -> g Int-  inDegree v = length `liftM` inEdges v-  -  incidentEdges :: Vertex g -> g [Edge g]-  incidentEdges v = liftM2 (++) (inEdges v) (outEdges v)--  degree :: Vertex g -> g Int-  degree v = liftM2 (+) (inDegree v) (outDegree v)--instance BidirectionalGraph g => BidirectionalGraph (Strict.StateT s g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance BidirectionalGraph g => BidirectionalGraph (Lazy.StateT s g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Strict.WriterT m g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Lazy.WriterT m g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Strict.RWST r m s g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Lazy.RWST r m s g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance BidirectionalGraph g => BidirectionalGraph (ReaderT e g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance BidirectionalGraph g => BidirectionalGraph (IdentityT g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance BidirectionalGraph g => BidirectionalGraph (MaybeT g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance (BidirectionalGraph g, Error e) => BidirectionalGraph (ErrorT e g) where-  inEdges  = lift . inEdges-  inDegree = lift . inDegree-  incidentEdges = lift . incidentEdges-  degree = lift . degree--instance BidirectionalGraph Identity where-  inEdges _ = Identity []-  inDegree _ = Identity 0-  incidentEdges _ = Identity []-  degree _  = Identity 0-
− Data/Graph/Class/EdgeEnumerable.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Class.EdgeEnumerable--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families----------------------------------------------------------------------------------module Data.Graph.Class.EdgeEnumerable-  ( EdgeEnumerableGraph(..)-  , module Data.Graph.Class-  ) where--import qualified Control.Monad.Trans.State.Strict as Strict-import qualified Control.Monad.Trans.State.Lazy as Lazy-import qualified Control.Monad.Trans.Writer.Strict as Strict-import qualified Control.Monad.Trans.Writer.Lazy as Lazy-import qualified Control.Monad.Trans.RWS.Strict as Strict-import qualified Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Error-import Control.Monad.Trans.Class-import Data.Functor.Identity-import Data.Monoid-import Data.Graph.Class--class Graph g => EdgeEnumerableGraph g where-  -- | /O(e)/-  edges :: g [Edge g]--instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Strict.StateT s g) where-  edges = lift edges--instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Lazy.StateT s g) where-  edges = lift edges--instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Strict.WriterT m g) where-  edges = lift edges--instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Lazy.WriterT m g) where-  edges = lift edges--instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Strict.RWST r m s g) where-  edges = lift edges--instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Lazy.RWST r m s g) where-  edges = lift edges--instance EdgeEnumerableGraph g => EdgeEnumerableGraph (MaybeT g) where-  edges = lift edges--instance EdgeEnumerableGraph g => EdgeEnumerableGraph (IdentityT g) where-  edges = lift edges--instance (EdgeEnumerableGraph g, Error e) => EdgeEnumerableGraph (ErrorT e g) where-  edges = lift edges--instance EdgeEnumerableGraph g => EdgeEnumerableGraph (ReaderT e g) where-  edges = lift edges--instance EdgeEnumerableGraph Identity where-  edges = Identity []
− Data/Graph/Class/VertexEnumerable.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Class.VertexEnumerable--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families----------------------------------------------------------------------------------module Data.Graph.Class.VertexEnumerable-  ( VertexEnumerableGraph(..)-  , module Data.Graph.Class-  ) where--import qualified Control.Monad.Trans.State.Strict as Strict-import qualified Control.Monad.Trans.State.Lazy as Lazy-import qualified Control.Monad.Trans.Writer.Strict as Strict-import qualified Control.Monad.Trans.Writer.Lazy as Lazy-import qualified Control.Monad.Trans.RWS.Strict as Strict-import qualified Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Error-import Control.Monad.Trans.Class-import Control.Monad.Trans.Reader-import Data.Monoid-import Data.Graph.Class-import Data.Functor.Identity--class Graph g => VertexEnumerableGraph g where-  -- | /O(v)/-  vertices :: g [Vertex g]--instance VertexEnumerableGraph g => VertexEnumerableGraph (Strict.StateT s g) where-  vertices = lift vertices--instance VertexEnumerableGraph g => VertexEnumerableGraph (Lazy.StateT s g) where-  vertices = lift vertices--instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Strict.WriterT m g) where-  vertices = lift vertices--instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Lazy.WriterT m g) where-  vertices = lift vertices--instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Strict.RWST r m s g) where-  vertices = lift vertices-  -instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Lazy.RWST r m s g) where-  vertices = lift vertices--instance VertexEnumerableGraph g => VertexEnumerableGraph (MaybeT g) where-  vertices = lift vertices--instance VertexEnumerableGraph g => VertexEnumerableGraph (IdentityT g) where-  vertices = lift vertices--instance (VertexEnumerableGraph g, Error e) => VertexEnumerableGraph (ErrorT e g) where-  vertices = lift vertices--instance VertexEnumerableGraph g => VertexEnumerableGraph (ReaderT m g) where-  vertices = lift vertices--instance VertexEnumerableGraph Identity where-  vertices = Identity []
− Data/Graph/Dual.hs 
@@ -1,73 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.Dual--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  type families----------------------------------------------------------------------------------module Data.Graph.Dual-  ( Dual(..)-  ) where--import Control.Applicative-import Control.Monad-import Control.Monad.Trans.Class-import Data.Graph.PropertyMap-import Data.Graph.Class.AdjacencyList-import Data.Graph.Class.AdjacencyMatrix-import Data.Graph.Class.EdgeEnumerable-import Data.Graph.Class.VertexEnumerable-import Data.Graph.Class.Bidirectional--newtype Dual g a = Dual { runDual :: g a }--instance MonadTrans Dual where-  lift = Dual--instance Functor g => Functor (Dual g) where-  fmap f (Dual g) = Dual $ fmap f g-  b <$ Dual g = Dual $ b <$ g--instance Applicative g => Applicative (Dual g) where-  pure = Dual . pure-  Dual f <*> Dual a = Dual (f <*> a)-  Dual f <*  Dual a = Dual (f <*  a)-  Dual f  *> Dual a = Dual (f  *> a)--instance Monad g => Monad (Dual g) where-  return = Dual . return-  Dual g >>= k = Dual (g >>= runDual . k)-  Dual g >> Dual h = Dual (g >> h)--instance Graph g => Graph (Dual g) where-  type Vertex (Dual g) = Vertex g-  type Edge (Dual g) = Edge g-  vertexMap = Dual . liftM liftPropertyMap . vertexMap-  edgeMap   = Dual . liftM liftPropertyMap . edgeMap--instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Dual g) where-  edge l r = Dual (edge r l)--instance BidirectionalGraph g => AdjacencyListGraph (Dual g) where-  source = Dual . target-  target = Dual . source-  outEdges = Dual . inEdges-  outDegree = Dual . inDegree--instance BidirectionalGraph g => BidirectionalGraph (Dual g) where-  inEdges = Dual . outEdges-  inDegree = Dual . inDegree-  incidentEdges = Dual . incidentEdges-  degree = Dual . degree--instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Dual g) where-  edges = Dual edges --instance VertexEnumerableGraph g => VertexEnumerableGraph (Dual g) where-  vertices = Dual vertices
− Data/Graph/Internal/Color.hs 
@@ -1,3 +0,0 @@-module Data.Graph.Internal.Color where--data Color = White | Grey | Black deriving (Eq,Ord,Show,Read)
− Data/Graph/PropertyMap.hs 
@@ -1,69 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Graph.PropertyMap--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  portable------ Total transient monadic maps, used to track information about vertices--- and edges in a graph-------------------------------------------------------------------------------module Data.Graph.PropertyMap -  ( PropertyMap(..)-  , modifyP-  , intPropertyMap-  , propertyMap-  , liftPropertyMap-  ) where--import Control.Monad-import Control.Monad.Trans.Class-import qualified Data.IntMap as IntMap-import qualified Data.Map as Map--data PropertyMap m k v = PropertyMap-  { getP :: k -> m v-  , putP :: k -> v -> m (PropertyMap m k v)-  }--modifyP :: Monad m => PropertyMap m k v -> k -> (v -> v) -> m (PropertyMap m k v)-modifyP m k f = do-  a <- getP m k-  putP m k (f a)---- A pure IntMap-backed vertex map-intPropertyMap :: Monad m => v -> PropertyMap m Int v-intPropertyMap v0 = go v0 IntMap.empty where-  go v m = PropertyMap -    { getP = \k -> return $ maybe v id (IntMap.lookup k m)-    , putP = \k v' -> return $ go v (IntMap.insert k v' m)-    }---- A pure Map-backed vertex map-propertyMap :: (Monad m, Ord k) => v -> PropertyMap m k v-propertyMap v0 = go v0 Map.empty where-  go v m = PropertyMap -    { getP = \k -> return $ maybe v id (Map.lookup k m)-    , putP = \k v' -> return $ go v (Map.insert k v' m)-    }--liftPropertyMap :: (MonadTrans t, Monad m, Monad (t m)) => PropertyMap m k v -> PropertyMap (t m) k v-liftPropertyMap (PropertyMap g p) = PropertyMap (lift . g) (\k v -> liftPropertyMap `liftM` lift (p k v))--{---- An impure STArray-backed vertex map-stAdjVertexMap :: (DenseAdjacencyMatrix g, MonadST s g) => a -> g (PropertyMap g (Vertex g) a)-stAdjVertexMap v0 = do-  range <- vertexRange -  arr <- newSTArray range v0-  return $ go arr-  where-    go arr = r where r = VertexMap-      { getP = readSTArray arr-      , putP = \k v -> writeSTArray arr k v >> return r-      } --}
graphs.cabal view
@@ -1,6 +1,6 @@ name:          graphs category:      Data Structures-version:       0.4.0.3+version:       0.4.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -30,7 +30,7 @@     array        >= 0.3     && < 0.5,     transformers >= 0.2.2   && < 0.4,     containers   >= 0.3     && < 0.6,-    void         >= 0.5.5.1 && < 0.6+    void         >= 0.5.5.1    exposed-modules:     Data.Graph.AdjacencyList@@ -49,3 +49,4 @@     Data.Graph.Internal.Color    ghc-options: -Wall+  hs-source-dirs: src
+ src/Data/Graph/AdjacencyList.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Adjacency.List+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+----------------------------------------------------------------------------++module Data.Graph.AdjacencyList+  ( AdjacencyList(..)+  , ask+  ) where++import Control.Applicative+import Data.Ix+import Data.Array+import Data.Graph.PropertyMap+import Data.Graph.Class+import Data.Graph.Class.AdjacencyList++newtype AdjacencyList i a = AdjacencyList { runAdjacencyList :: Array i [i] -> a }  ++ask :: AdjacencyList i (Array i [i])+ask = AdjacencyList id++instance Functor (AdjacencyList i) where+  fmap f (AdjacencyList g) = AdjacencyList (f . g)+  b <$ _ = pure b++instance Applicative (AdjacencyList i) where+  pure = AdjacencyList . const+  AdjacencyList f <*> AdjacencyList a = AdjacencyList $ \t -> f t (a t)++instance Monad (AdjacencyList i) where+  return = AdjacencyList . const+  AdjacencyList f >>= k = AdjacencyList $ \t -> runAdjacencyList (k (f t)) t++instance Ord i => Graph (AdjacencyList i) where+  type Vertex (AdjacencyList i) = i+  type Edge (AdjacencyList i) = (i, i)+  vertexMap = pure . propertyMap+  edgeMap = pure . propertyMap++instance Ix i => AdjacencyListGraph (AdjacencyList i) where+  adjacentVertices v = AdjacencyList $ \g -> if inRange (bounds g) v +                                     then g ! v +                                     else []+  source (a, _) = pure a+  target (_, b) = pure b+  outEdges = defaultOutEdges
+ src/Data/Graph/AdjacencyMatrix.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Adjacency.Matrix+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+----------------------------------------------------------------------------++module Data.Graph.AdjacencyMatrix+  ( AdjacencyMatrix(..)+  , ask+  ) where++import Control.Applicative+import Data.Ix+import Data.Array.IArray+import Data.Graph.PropertyMap+import Data.Graph.Class+import Data.Graph.Class.AdjacencyMatrix++newtype AdjacencyMatrix arr i a = AdjacencyMatrix { runAdjacencyMatrix :: arr (i,i) Bool -> a } ++ask :: AdjacencyMatrix arr i (arr (i, i) Bool)+ask = AdjacencyMatrix id++instance Functor (AdjacencyMatrix arr i) where+  fmap f (AdjacencyMatrix g) = AdjacencyMatrix (f . g)+  b <$ _ = pure b++instance Applicative (AdjacencyMatrix arr i) where+  pure = AdjacencyMatrix . const+  AdjacencyMatrix f <*> AdjacencyMatrix a = AdjacencyMatrix $ \t -> f t (a t)++instance Monad (AdjacencyMatrix arr i) where+  return = AdjacencyMatrix . const+  AdjacencyMatrix f >>= k = AdjacencyMatrix $ \t -> runAdjacencyMatrix (k (f t)) t++instance Ord i => Graph (AdjacencyMatrix arr i) where+  type Vertex (AdjacencyMatrix arr i) = i+  type Edge (AdjacencyMatrix arr i) = (i, i) +  vertexMap = pure . propertyMap+  edgeMap = pure . propertyMap++instance (IArray arr Bool, Ix i) => AdjacencyMatrixGraph (AdjacencyMatrix arr i) where+  edge i j = AdjacencyMatrix $ \a ->+    if inRange (bounds a) ix && (a ! ix) +    then Just ix+    else Nothing+    where ix = (i, j)++
+ src/Data/Graph/Algorithm/BreadthFirstSearch.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE TypeFamilies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Algorithm.BreadthFirstSearch+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+-- Breadth-first search+----------------------------------------------------------------------------++module Data.Graph.Algorithm.BreadthFirstSearch+  ( bfs, Bfs(..)+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.State.Strict+import Data.Foldable+import Data.Monoid+import Data.Sequence++import Data.Graph.Class+import Data.Graph.Class.AdjacencyList+import Data.Graph.PropertyMap+import Data.Graph.Internal.Color++-- | Breadth first search visitor +data Bfs g m = Bfs +  { enterVertex :: Vertex g -> g m -- called the first time a vertex is discovered+  , grayTarget  :: Edge g   -> g m -- called when we encounter a back edge to a vertex we're still processing+  , exitVertex  :: Vertex g -> g m -- called once we have processed all descendants of a vertex+  , blackTarget :: Edge g   -> g m -- called when we encounter a cross edge to a vertex we've already finished+  } ++instance Graph g => Functor (Bfs g) where+  fmap f (Bfs a b c d) = Bfs +    (liftM f . a)+    (liftM f . b)+    (liftM f . c)+    (liftM f . d)++instance Graph g => Applicative (Bfs g) where+  pure a = Bfs +    (const (return a))+    (const (return a))+    (const (return a))+    (const (return a))++  m <*> n = Bfs+    (\v -> enterVertex m v `ap` enterVertex n v)+    (\e -> grayTarget m e `ap`  grayTarget n e)+    (\v -> exitVertex m v `ap`  exitVertex n v)+    (\e -> blackTarget m e `ap` blackTarget n e)++instance Graph g => Monad (Bfs g) where+  return = pure+  m >>= f = Bfs+    (\v -> enterVertex m v >>= ($ v) . enterVertex . f)+    (\e -> grayTarget m e >>= ($ e) . grayTarget . f)+    (\v -> exitVertex m v >>= ($ v) . exitVertex . f)+    (\e -> blackTarget m e >>= ($ e) . blackTarget . f)++instance (Graph g, Monoid m) => Monoid (Bfs g m) where+  mempty = return mempty+  mappend = liftM2 mappend++getS :: Monad g => k -> StateT (Seq v, PropertyMap g k Color) g Color+getS k = do+  m <- gets snd +  lift (getP m k)++putS :: Monad g => k -> Color -> StateT (Seq v, PropertyMap g k Color) g ()+putS k v = do+  m <- gets snd +  m' <- lift $ putP m k v+  modify $ \(q,_) -> (q, m')++enqueue :: Graph g +        => Bfs g m +        -> Vertex g +        -> StateT (Seq (Vertex g), PropertyMap g (Vertex g) Color) g m+enqueue vis v = do+  m <- gets snd+  m' <- lift $ putP m v Grey+  modify $ \(q,_) -> (q |> v, m')+  lift $ enterVertex vis v++dequeue :: Monad g => StateT (Seq v, s) g r -> (v -> StateT (Seq v, s) g r) -> StateT (Seq v, s) g r+dequeue ke ks = do+  (q, m) <- get+  case viewl q of+    EmptyL -> ke+    (a :< q') -> put (q', m) >> ks a++bfs :: (AdjacencyListGraph g, Monoid m) => Bfs g m -> Vertex g -> g m+bfs vis v0 = do+  m <- vertexMap White +  evalStateT (enqueue vis v0 >>= pump) (mempty, m) +  where+  pump lhs = dequeue (return lhs) $ \ v -> do+    adjs <- lift $ outEdges v+    children <- foldrM +      (\e m -> do+        v' <- target e+        color <- getS v'+        liftM (`mappend` m) $ case color of+          White -> enqueue vis v' +          Grey -> lift $ grayTarget vis e+          Black -> lift $ blackTarget vis e+      ) mempty adjs+    putS v Black+    rhs <- lift $ exitVertex vis v +    pump $ lhs `mappend` children `mappend` rhs
+ src/Data/Graph/Algorithm/DepthFirstSearch.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE TypeFamilies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Algorithm.DepthFirstSearch+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+-- Depth-first search+----------------------------------------------------------------------------++module Data.Graph.Algorithm.DepthFirstSearch+  ( dfs, Dfs(..)+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.State.Strict+import Data.Foldable+import Data.Monoid++import Data.Graph.Class+import Data.Graph.Class.AdjacencyList+import Data.Graph.PropertyMap+import Data.Graph.Internal.Color++data Dfs g m = Dfs +  { enterVertex :: Vertex g -> g m -- called the first time a vertex is discovered+  , grayTarget  :: Edge g   -> g m -- called when we encounter a back edge to a vertex we're still processing+  , exitVertex  :: Vertex g -> g m -- called once we have processed all descendants of a vertex+  , blackTarget :: Edge g   -> g m -- called when we encounter a cross edge to a vertex we've already finished+  }++instance Graph g => Functor (Dfs g) where+  fmap f (Dfs a b c d) = Dfs +    (liftM f . a)+    (liftM f . b)+    (liftM f . c)+    (liftM f . d)++instance Graph g => Applicative (Dfs g) where+  pure a = Dfs +    (const (return a))+    (const (return a))+    (const (return a))+    (const (return a))++  m <*> n = Dfs+    (\v -> enterVertex m v `ap` enterVertex n v)+    (\e -> grayTarget m e `ap`  grayTarget n e)+    (\v -> exitVertex m v `ap`  exitVertex n v)+    (\e -> blackTarget m e `ap` blackTarget n e)++instance Graph g => Monad (Dfs g) where+  return = pure+  m >>= f = Dfs+    (\v -> enterVertex m v >>= ($ v) . enterVertex . f)+    (\e -> grayTarget m e >>= ($ e) . grayTarget . f)+    (\v -> exitVertex m v >>= ($ v) . exitVertex . f)+    (\e -> blackTarget m e >>= ($ e) . blackTarget . f)++instance (Graph g, Monoid m) => Monoid (Dfs g m) where+  mempty = return mempty+  mappend = liftM2 mappend++getS :: Monad g => k -> StateT (PropertyMap g k v) g v+getS k = do+  m <- get +  lift (getP m k)++putS :: Monad g => k -> v -> StateT (PropertyMap g k v) g ()+putS k v = do+  m <- get +  m' <- lift $ putP m k v+  put m'++-- TODO: CPS transform?+dfs :: (AdjacencyListGraph g, Monoid m) => Dfs g m -> Vertex g -> g m+dfs vis v0 = do+  m <- vertexMap White +  evalStateT (go v0) m where+  go v = do+    putS v Grey+    lhs <- lift $ enterVertex vis v+    adjs <- lift $ outEdges v +    result <- foldrM +      (\e m -> do +        v' <- target e+        color <- getS v'+        liftM (`mappend` m) $ case color of+          White -> go v'+          Grey  -> lift $ grayTarget vis e+          Black -> lift $ blackTarget vis e+      ) +      mempty +      adjs+    putS v Black+    rhs <- lift $ exitVertex vis v+    return $ lhs `mappend` result `mappend` rhs
+ src/Data/Graph/Class.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Class+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+----------------------------------------------------------------------------++module Data.Graph.Class +  ( Graph(..)+  , VertexMap+  , EdgeMap+  , liftVertexMap+  , liftEdgeMap+  ) where++import Control.Monad+import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Error+import Control.Monad.Trans.Reader +import Control.Monad.Trans.Class+import Data.Functor.Identity+import Data.Monoid+import Data.Graph.PropertyMap+import Data.Void++type VertexMap g = PropertyMap g (Vertex g)+type EdgeMap g = PropertyMap g (Edge g)++class (Monad g, Eq (Vertex g), Eq (Edge g)) => Graph g where+  type Vertex g :: *+  type Edge g :: * +  vertexMap :: a -> g (VertexMap g a)+  edgeMap   :: a -> g (EdgeMap g a)++liftVertexMap :: (MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) +              => a -> t g (VertexMap (t g) a)+liftVertexMap = lift . liftM liftPropertyMap . vertexMap+{-# INLINE liftVertexMap #-}++liftEdgeMap :: (MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) +            => a -> t g (EdgeMap (t g) a)+liftEdgeMap = lift . liftM liftPropertyMap . edgeMap+{-# INLINE liftEdgeMap #-}++instance Graph g => Graph (Strict.StateT s g) where+  type Vertex (Strict.StateT s g) = Vertex g+  type Edge (Strict.StateT s g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++instance Graph g => Graph (Lazy.StateT s g) where+  type Vertex (Lazy.StateT s g) = Vertex g+  type Edge (Lazy.StateT s g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++instance (Graph g, Monoid m) => Graph (Strict.WriterT m g) where+  type Vertex (Strict.WriterT m g) = Vertex g+  type Edge (Strict.WriterT m g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++instance (Graph g, Monoid m) => Graph (Lazy.WriterT m g) where+  type Vertex (Lazy.WriterT m g) = Vertex g+  type Edge (Lazy.WriterT m g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++instance Graph g => Graph (ReaderT m g) where+  type Vertex (ReaderT m g) = Vertex g +  type Edge (ReaderT m g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++instance Graph g => Graph (IdentityT g) where+  type Vertex (IdentityT g) = Vertex g+  type Edge (IdentityT g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++instance Graph g => Graph (MaybeT g) where+  type Vertex (MaybeT g) = Vertex g+  type Edge (MaybeT g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++instance (Graph g, Error e) => Graph (ErrorT e g) where+  type Vertex (ErrorT e g) = Vertex g+  type Edge (ErrorT e g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++instance (Graph g, Monoid w) => Graph (Lazy.RWST r w s g) where+  type Vertex (Lazy.RWST r w s g) = Vertex g+  type Edge (Lazy.RWST r w s g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++instance (Graph g, Monoid w) => Graph (Strict.RWST r w s g) where+  type Vertex (Strict.RWST r w s g) = Vertex g+  type Edge (Strict.RWST r w s g) = Edge g+  vertexMap = liftVertexMap+  edgeMap = liftEdgeMap++voidMap :: PropertyMap Identity Void a+voidMap = PropertyMap (Identity . absurd) $ \_ _ -> Identity voidMap++-- | The empty graph+instance Graph Identity where+  type Vertex Identity = Void+  type Edge Identity = Void+  vertexMap _ = Identity voidMap +  edgeMap   _ = Identity voidMap+
+ src/Data/Graph/Class/AdjacencyList.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Class.AdjacencyList+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+----------------------------------------------------------------------------++module Data.Graph.Class.AdjacencyList+  ( AdjacencyListGraph(..)+  , defaultOutEdges+  , module Data.Graph.Class+  ) where++import Control.Monad+import Control.Monad.Trans.Class+import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Error+import Control.Monad.Trans.Reader+import Data.Functor.Identity+import Data.Monoid+import Data.Graph.Class++defaultOutEdges :: AdjacencyListGraph g => Vertex g -> g [(Vertex g, Vertex g)]+defaultOutEdges v = liftM (map ((,) v)) (adjacentVertices v)++-- | Minimal definition: 'source', 'target', and either 'adjacentVertices' with @'outEdges' = 'defaultOutEdges'@ or 'outEdges'+class Graph g => AdjacencyListGraph g where+  -- /O(1)/+  source :: Edge g -> g (Vertex g)+  -- /O(1)/+  target :: Edge g -> g (Vertex g)+  -- /O(e)/ in the number of out edges+  outEdges :: Vertex g -> g [Edge g]++  -- /O(e)/+  outDegree :: Vertex g -> g Int+  outDegree v = liftM length (outEdges v)++  adjacentVertices :: Vertex g -> g [Vertex g]+  adjacentVertices = outEdges >=> mapM target++instance AdjacencyListGraph g => AdjacencyListGraph (Strict.StateT s g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance AdjacencyListGraph g => AdjacencyListGraph (Lazy.StateT s g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Strict.WriterT m g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Lazy.WriterT m g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Strict.RWST r m s g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance (AdjacencyListGraph g, Monoid m) => AdjacencyListGraph (Lazy.RWST r m s g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance AdjacencyListGraph g => AdjacencyListGraph (ReaderT e g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance (AdjacencyListGraph g, Error e) => AdjacencyListGraph (ErrorT e g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance AdjacencyListGraph g => AdjacencyListGraph (MaybeT g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance AdjacencyListGraph g => AdjacencyListGraph (IdentityT g) where+  adjacentVertices = lift . adjacentVertices+  source = lift . source+  target = lift . target+  outEdges = lift . outEdges+  outDegree = lift . outDegree++instance AdjacencyListGraph Identity where+  source = Identity+  target = Identity+  outEdges _ = Identity []+  outDegree _ = Identity 0
+ src/Data/Graph/Class/AdjacencyMatrix.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Class.AdjacencyMatrix+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+----------------------------------------------------------------------------++module Data.Graph.Class.AdjacencyMatrix+  ( AdjacencyMatrixGraph(..)+  , module Data.Graph.Class+  ) where++import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Error+import Control.Monad.Trans.Class+import Data.Functor.Identity+import Data.Monoid+import Data.Graph.Class++class Graph g => AdjacencyMatrixGraph g where+  edge :: Vertex g -> Vertex g -> g (Maybe (Edge g))++instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Strict.StateT s g) where+  edge a b = lift (edge a b)++instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Lazy.StateT s g) where+  edge a b = lift (edge a b)++instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Strict.WriterT m g) where+  edge a b = lift (edge a b)++instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Lazy.WriterT m g) where+  edge a b = lift (edge a b)++instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Strict.RWST r m s g) where+  edge a b = lift (edge a b)++instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Lazy.RWST r m s g) where+  edge a b = lift (edge a b)++instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (MaybeT g) where+  edge a b = lift (edge a b)++instance (AdjacencyMatrixGraph g, Error e) => AdjacencyMatrixGraph (ErrorT e g) where+  edge a b = lift (edge a b)++instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (IdentityT g) where+  edge a b = lift (edge a b)++instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (ReaderT e g) where+  edge a b = lift (edge a b)++instance AdjacencyMatrixGraph Identity where+  edge _ _ = Identity Nothing
+ src/Data/Graph/Class/Bidirectional.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Class.Bidirectional+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+----------------------------------------------------------------------------++module Data.Graph.Class.Bidirectional +  ( BidirectionalGraph(..)+  , module Data.Graph.Class.AdjacencyList+  ) where++import Control.Monad+import Control.Monad.Trans.Class+import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Error+import Data.Functor.Identity+import Data.Monoid+import Data.Graph.Class.AdjacencyList++class AdjacencyListGraph g => BidirectionalGraph g where+  -- /O(e)/+  inEdges :: Vertex g -> g [Edge g]+  -- /O(e)/+  inDegree :: Vertex g -> g Int+  inDegree v = length `liftM` inEdges v+  +  incidentEdges :: Vertex g -> g [Edge g]+  incidentEdges v = liftM2 (++) (inEdges v) (outEdges v)++  degree :: Vertex g -> g Int+  degree v = liftM2 (+) (inDegree v) (outDegree v)++instance BidirectionalGraph g => BidirectionalGraph (Strict.StateT s g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance BidirectionalGraph g => BidirectionalGraph (Lazy.StateT s g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Strict.WriterT m g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Lazy.WriterT m g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Strict.RWST r m s g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Lazy.RWST r m s g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance BidirectionalGraph g => BidirectionalGraph (ReaderT e g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance BidirectionalGraph g => BidirectionalGraph (IdentityT g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance BidirectionalGraph g => BidirectionalGraph (MaybeT g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance (BidirectionalGraph g, Error e) => BidirectionalGraph (ErrorT e g) where+  inEdges  = lift . inEdges+  inDegree = lift . inDegree+  incidentEdges = lift . incidentEdges+  degree = lift . degree++instance BidirectionalGraph Identity where+  inEdges _ = Identity []+  inDegree _ = Identity 0+  incidentEdges _ = Identity []+  degree _  = Identity 0+
+ src/Data/Graph/Class/EdgeEnumerable.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Class.EdgeEnumerable+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+----------------------------------------------------------------------------++module Data.Graph.Class.EdgeEnumerable+  ( EdgeEnumerableGraph(..)+  , module Data.Graph.Class+  ) where++import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Error+import Control.Monad.Trans.Class+import Data.Functor.Identity+import Data.Monoid+import Data.Graph.Class++class Graph g => EdgeEnumerableGraph g where+  -- | /O(e)/+  edges :: g [Edge g]++instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Strict.StateT s g) where+  edges = lift edges++instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Lazy.StateT s g) where+  edges = lift edges++instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Strict.WriterT m g) where+  edges = lift edges++instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Lazy.WriterT m g) where+  edges = lift edges++instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Strict.RWST r m s g) where+  edges = lift edges++instance (EdgeEnumerableGraph g, Monoid m) => EdgeEnumerableGraph (Lazy.RWST r m s g) where+  edges = lift edges++instance EdgeEnumerableGraph g => EdgeEnumerableGraph (MaybeT g) where+  edges = lift edges++instance EdgeEnumerableGraph g => EdgeEnumerableGraph (IdentityT g) where+  edges = lift edges++instance (EdgeEnumerableGraph g, Error e) => EdgeEnumerableGraph (ErrorT e g) where+  edges = lift edges++instance EdgeEnumerableGraph g => EdgeEnumerableGraph (ReaderT e g) where+  edges = lift edges++instance EdgeEnumerableGraph Identity where+  edges = Identity []
+ src/Data/Graph/Class/VertexEnumerable.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Class.VertexEnumerable+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+----------------------------------------------------------------------------++module Data.Graph.Class.VertexEnumerable+  ( VertexEnumerableGraph(..)+  , module Data.Graph.Class+  ) where++import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Error+import Control.Monad.Trans.Class+import Control.Monad.Trans.Reader+import Data.Monoid+import Data.Graph.Class+import Data.Functor.Identity++class Graph g => VertexEnumerableGraph g where+  -- | /O(v)/+  vertices :: g [Vertex g]++instance VertexEnumerableGraph g => VertexEnumerableGraph (Strict.StateT s g) where+  vertices = lift vertices++instance VertexEnumerableGraph g => VertexEnumerableGraph (Lazy.StateT s g) where+  vertices = lift vertices++instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Strict.WriterT m g) where+  vertices = lift vertices++instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Lazy.WriterT m g) where+  vertices = lift vertices++instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Strict.RWST r m s g) where+  vertices = lift vertices+  +instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Lazy.RWST r m s g) where+  vertices = lift vertices++instance VertexEnumerableGraph g => VertexEnumerableGraph (MaybeT g) where+  vertices = lift vertices++instance VertexEnumerableGraph g => VertexEnumerableGraph (IdentityT g) where+  vertices = lift vertices++instance (VertexEnumerableGraph g, Error e) => VertexEnumerableGraph (ErrorT e g) where+  vertices = lift vertices++instance VertexEnumerableGraph g => VertexEnumerableGraph (ReaderT m g) where+  vertices = lift vertices++instance VertexEnumerableGraph Identity where+  vertices = Identity []
+ src/Data/Graph/Dual.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.Dual+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  type families+--+----------------------------------------------------------------------------++module Data.Graph.Dual+  ( Dual(..)+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans.Class+import Data.Graph.PropertyMap+import Data.Graph.Class.AdjacencyList+import Data.Graph.Class.AdjacencyMatrix+import Data.Graph.Class.EdgeEnumerable+import Data.Graph.Class.VertexEnumerable+import Data.Graph.Class.Bidirectional++newtype Dual g a = Dual { runDual :: g a }++instance MonadTrans Dual where+  lift = Dual++instance Functor g => Functor (Dual g) where+  fmap f (Dual g) = Dual $ fmap f g+  b <$ Dual g = Dual $ b <$ g++instance Applicative g => Applicative (Dual g) where+  pure = Dual . pure+  Dual f <*> Dual a = Dual (f <*> a)+  Dual f <*  Dual a = Dual (f <*  a)+  Dual f  *> Dual a = Dual (f  *> a)++instance Monad g => Monad (Dual g) where+  return = Dual . return+  Dual g >>= k = Dual (g >>= runDual . k)+  Dual g >> Dual h = Dual (g >> h)++instance Graph g => Graph (Dual g) where+  type Vertex (Dual g) = Vertex g+  type Edge (Dual g) = Edge g+  vertexMap = Dual . liftM liftPropertyMap . vertexMap+  edgeMap   = Dual . liftM liftPropertyMap . edgeMap++instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Dual g) where+  edge l r = Dual (edge r l)++instance BidirectionalGraph g => AdjacencyListGraph (Dual g) where+  source = Dual . target+  target = Dual . source+  outEdges = Dual . inEdges+  outDegree = Dual . inDegree++instance BidirectionalGraph g => BidirectionalGraph (Dual g) where+  inEdges = Dual . outEdges+  inDegree = Dual . inDegree+  incidentEdges = Dual . incidentEdges+  degree = Dual . degree++instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Dual g) where+  edges = Dual edges ++instance VertexEnumerableGraph g => VertexEnumerableGraph (Dual g) where+  vertices = Dual vertices
+ src/Data/Graph/Internal/Color.hs view
@@ -0,0 +1,3 @@+module Data.Graph.Internal.Color where++data Color = White | Grey | Black deriving (Eq,Ord,Show,Read)
+ src/Data/Graph/PropertyMap.hs view
@@ -0,0 +1,69 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Graph.PropertyMap+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Total transient monadic maps, used to track information about vertices+-- and edges in a graph+----------------------------------------------------------------------------++module Data.Graph.PropertyMap +  ( PropertyMap(..)+  , modifyP+  , intPropertyMap+  , propertyMap+  , liftPropertyMap+  ) where++import Control.Monad+import Control.Monad.Trans.Class+import qualified Data.IntMap as IntMap+import qualified Data.Map as Map++data PropertyMap m k v = PropertyMap+  { getP :: k -> m v+  , putP :: k -> v -> m (PropertyMap m k v)+  }++modifyP :: Monad m => PropertyMap m k v -> k -> (v -> v) -> m (PropertyMap m k v)+modifyP m k f = do+  a <- getP m k+  putP m k (f a)++-- A pure IntMap-backed vertex map+intPropertyMap :: Monad m => v -> PropertyMap m Int v+intPropertyMap v0 = go v0 IntMap.empty where+  go v m = PropertyMap +    { getP = \k -> return $ maybe v id (IntMap.lookup k m)+    , putP = \k v' -> return $ go v (IntMap.insert k v' m)+    }++-- A pure Map-backed vertex map+propertyMap :: (Monad m, Ord k) => v -> PropertyMap m k v+propertyMap v0 = go v0 Map.empty where+  go v m = PropertyMap +    { getP = \k -> return $ maybe v id (Map.lookup k m)+    , putP = \k v' -> return $ go v (Map.insert k v' m)+    }++liftPropertyMap :: (MonadTrans t, Monad m, Monad (t m)) => PropertyMap m k v -> PropertyMap (t m) k v+liftPropertyMap (PropertyMap g p) = PropertyMap (lift . g) (\k v -> liftPropertyMap `liftM` lift (p k v))++{-+-- An impure STArray-backed vertex map+stAdjVertexMap :: (DenseAdjacencyMatrix g, MonadST s g) => a -> g (PropertyMap g (Vertex g) a)+stAdjVertexMap v0 = do+  range <- vertexRange +  arr <- newSTArray range v0+  return $ go arr+  where+    go arr = r where r = VertexMap+      { getP = readSTArray arr+      , putP = \k v -> writeSTArray arr k v >> return r+      } +-}