Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

switched from type families to MPTCs, fundeps, its the wave of the er…

….. past.
  • Loading branch information...
commit 8962ee44c56d9b89f47ba7a65baece7870499595 1 parent 2d42574
@ekmett authored
View
10 Data/Graph/Adjacency/List.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Adjacency.List
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : type families
+-- Portability : MPTCs, fundeps
--
----------------------------------------------------------------------------
@@ -40,13 +40,11 @@ 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)
+instance Ord i => Graph (AdjacencyList i) i (i, i) where
vertexMap = pure . propertyMap
edgeMap = pure . propertyMap
-instance (Ix i, Ord i) => AdjacencyListGraph (AdjacencyList i) where
+instance (Ix i, Ord i) => AdjacencyListGraph (AdjacencyList i) i (i, i) where
adjacentVertices v = AdjacencyList $ \g -> if inRange (bounds g) v
then g ! v
else []
View
10 Data/Graph/Adjacency/Matrix.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Adjacency.Matrix
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : type families
+-- Portability : MPTCs, fundeps
--
----------------------------------------------------------------------------
@@ -41,13 +41,11 @@ 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)
+instance Ord i => Graph (AdjacencyMatrix arr i) i (i, i) where
vertexMap = pure . propertyMap
edgeMap = pure . propertyMap
-instance (IArray arr Bool, Ix i, Ord i) => AdjacencyMatrixGraph (AdjacencyMatrix arr i) where
+instance (IArray arr Bool, Ix i, Ord i) => AdjacencyMatrixGraph (AdjacencyMatrix arr i) i (i, i) where
edge i j = AdjacencyMatrix $ \a ->
if inRange (bounds a) ix && (a ! ix)
then Just ix
View
27 Data/Graph/Algorithm/DepthFirstSearch.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, DeriveFunctor #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Algorithm.DepthFirstSearch
@@ -28,14 +28,14 @@ import Data.Graph.PropertyMap
data Color = White | Gray | Black deriving (Eq,Ord,Show,Read)
-data Dfs g m = Dfs
- { enterVertex :: Vertex g -> m -- called the first time a vertex is discovered
- , backEdge :: Vertex g -> Vertex g -> m -- called when we encounter a back edge to a vertex we're still processing
- , exitVertex :: Vertex g -> m -- called once we have processed all descendants of a vertex
- , crossEdge :: Vertex g -> Vertex g -> m -- called when we encounter a cross edge to a vertex we've already finished
- }
+data Dfs v e m = Dfs
+ { enterVertex :: v -> m -- called the first time a vertex is discovered
+ , backEdge :: e -> m -- called when we encounter a back edge to a vertex we're still processing
+ , exitVertex :: v -> m -- called once we have processed all descendants of a vertex
+ , crossEdge :: e -> m -- called when we encounter a cross edge to a vertex we've already finished
+ } deriving (Functor)
-instance Monoid m => Default (Dfs g m) where
+instance Monoid m => Default (Dfs v e m) where
def = Dfs
(const mempty)
(const mempty)
@@ -54,20 +54,21 @@ putS k v = do
put m'
-- TODO: CPS transform?
-dfs :: (AdjacencyListGraph g, Monoid m) => Dfs g m -> Vertex g -> g m
+dfs :: (AdjacencyListGraph g v e, Monoid m) => Dfs v e m -> v -> g m
dfs vis v0 = do
m <- vertexMap White
evalStateT (go v0) m where
go v = do
putS v Gray
- adjs <- lift $ adjacentVertices v
+ adjs <- lift $ outEdges v
result <- foldrM
- (\v' m -> do
+ (\e m -> do
+ v' <- target e
color <- getS v'
liftM (`mappend` m) $ case color of
White -> go v'
- Gray -> return $ backEdge vis v v'
- Black -> return $ crossEdge vis v v'
+ Gray -> return $ backEdge vis e
+ Black -> return $ crossEdge vis e
)
mempty
adjs
View
33 Data/Graph/Class.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Class
@@ -7,14 +7,12 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : type families
+-- Portability : MPTCs, fundeps
--
----------------------------------------------------------------------------
module Data.Graph.Class
( Graph(..)
- , VertexMap
- , EdgeMap
) where
import Control.Monad
@@ -26,35 +24,22 @@ import Control.Monad.Trans.Class
import Data.Monoid
import Data.Graph.PropertyMap
-type VertexMap g = PropertyMap g (Vertex g)
-type EdgeMap g = PropertyMap g (Edge g)
+class (Monad g, Eq v, Eq e) => Graph g v e | g -> v e where
+ vertexMap :: a -> g (PropertyMap g v a)
+ edgeMap :: a -> g (PropertyMap g e a)
-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)
-
-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
+instance Graph g v e => Graph (Strict.StateT s g) v e where
vertexMap = lift . liftM liftPropertyMap . vertexMap
edgeMap = lift . liftM liftPropertyMap . edgeMap
-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
+instance Graph g v e => Graph (Lazy.StateT s g) v e where
vertexMap = lift . liftM liftPropertyMap . vertexMap
edgeMap = lift . liftM liftPropertyMap . edgeMap
-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
+instance (Graph g v e, Monoid m) => Graph (Strict.WriterT m g) v e where
vertexMap = lift . liftM liftPropertyMap . vertexMap
edgeMap = lift . liftM liftPropertyMap . edgeMap
-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
+instance (Graph g v e, Monoid m) => Graph (Lazy.WriterT m g) v e where
vertexMap = lift . liftM liftPropertyMap . vertexMap
edgeMap = lift . liftM liftPropertyMap . edgeMap
View
26 Data/Graph/Class/Adjacency/List.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Class.Adjacency.List
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : type families
+-- Portability : MPTCs, fundeps
--
----------------------------------------------------------------------------
@@ -26,47 +26,47 @@ import Control.Monad.Trans.Class
import Data.Monoid
import Data.Graph.Class
-defaultOutEdges :: AdjacencyListGraph g => Vertex g -> g [(Vertex g, Vertex g)]
+defaultOutEdges :: AdjacencyListGraph g v e => v -> g [(v, v)]
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
+class Graph g v e => AdjacencyListGraph g v e | g -> v e where
-- /O(1)/
- source :: Edge g -> g (Vertex g)
+ source :: e -> g v
-- /O(1)/
- target :: Edge g -> g (Vertex g)
+ target :: e -> g v
-- /O(e)/ in the number of out edges
- outEdges :: Vertex g -> g [Edge g]
+ outEdges :: v -> g [e]
-- /O(e)/
- outDegree :: Vertex g -> g Int
+ outDegree :: v -> g Int
outDegree v = liftM length (outEdges v)
- adjacentVertices :: Vertex g -> g [Vertex g]
+ adjacentVertices :: v -> g [v]
adjacentVertices = outEdges >=> mapM target
-instance AdjacencyListGraph g => AdjacencyListGraph (Strict.StateT s g) where
+instance AdjacencyListGraph g v e => AdjacencyListGraph (Strict.StateT s g) v e 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
+instance AdjacencyListGraph g v e => AdjacencyListGraph (Lazy.StateT s g) v e 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
+instance (AdjacencyListGraph g v e, Monoid m) => AdjacencyListGraph (Strict.WriterT m g) v e 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
+instance (AdjacencyListGraph g v e, Monoid m) => AdjacencyListGraph (Lazy.WriterT m g) v e where
adjacentVertices = lift . adjacentVertices
source = lift . source
target = lift . target
View
17 Data/Graph/Class/Adjacency/Matrix.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Class.Adjacency.Matrix
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : type families
+-- Portability : MPTCs, fundeps
--
----------------------------------------------------------------------------
@@ -24,18 +24,17 @@ import Control.Monad.Trans.Class
import Data.Monoid
import Data.Graph.Class
-class Graph g => AdjacencyMatrixGraph g where
- edge :: Vertex g -> Vertex g -> g (Maybe (Edge g))
+class Graph g v e => AdjacencyMatrixGraph g v e | g -> v e where
+ edge :: v -> v -> g (Maybe e)
-instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Strict.StateT s g) where
+instance AdjacencyMatrixGraph g v e => AdjacencyMatrixGraph (Strict.StateT s g) v e where
edge a b = lift (edge a b)
-instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Lazy.StateT s g) where
+instance AdjacencyMatrixGraph g v e => AdjacencyMatrixGraph (Lazy.StateT s g) v e where
edge a b = lift (edge a b)
-instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Strict.WriterT m g) where
+instance (AdjacencyMatrixGraph g v e, Monoid m) => AdjacencyMatrixGraph (Strict.WriterT m g) v e where
edge a b = lift (edge a b)
-instance (AdjacencyMatrixGraph g, Monoid m) => AdjacencyMatrixGraph (Lazy.WriterT m g) where
+instance (AdjacencyMatrixGraph g v e, Monoid m) => AdjacencyMatrixGraph (Lazy.WriterT m g) v e where
edge a b = lift (edge a b)
-
View
22 Data/Graph/Class/Bidirectional.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Graph.Class.Bidirectional
@@ -7,7 +7,7 @@
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : experimental
--- Portability : type families
+-- Portability : MPTCs, fundeps
--
----------------------------------------------------------------------------
@@ -25,38 +25,38 @@ import Control.Monad.Trans.Class
import Data.Monoid
import Data.Graph.Class.Adjacency.List
-class AdjacencyListGraph g => BidirectionalGraph g where
+class AdjacencyListGraph g v e => BidirectionalGraph g v e | g -> v e where
-- /O(e)/
- inEdges :: Vertex g -> g [Edge g]
+ inEdges :: v -> g [e]
-- /O(e)/
- inDegree :: Vertex g -> g Int
+ inDegree :: v -> g Int
inDegree v = length `liftM` inEdges v
- incidentEdges :: Vertex g -> g [Edge g]
+ incidentEdges :: v -> g [e]
incidentEdges v = liftM2 (++) (inEdges v) (outEdges v)
- degree :: Vertex g -> g Int
+ degree :: v -> g Int
degree v = liftM2 (+) (inDegree v) (outDegree v)
-instance BidirectionalGraph g => BidirectionalGraph (Strict.StateT s g) where
+instance BidirectionalGraph g v e => BidirectionalGraph (Strict.StateT s g) v e where
inEdges = lift . inEdges
inDegree = lift . inDegree
incidentEdges = lift . incidentEdges
degree = lift . degree
-instance BidirectionalGraph g => BidirectionalGraph (Lazy.StateT s g) where
+instance BidirectionalGraph g v e => BidirectionalGraph (Lazy.StateT s g) v e where
inEdges = lift . inEdges
inDegree = lift . inDegree
incidentEdges = lift . incidentEdges
degree = lift . degree
-instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Strict.WriterT m g) where
+instance (BidirectionalGraph g v e, Monoid m) => BidirectionalGraph (Strict.WriterT m g) v e where
inEdges = lift . inEdges
inDegree = lift . inDegree
incidentEdges = lift . incidentEdges
degree = lift . degree
-instance (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Lazy.WriterT m g) where
+instance (BidirectionalGraph g v e, Monoid m) => BidirectionalGraph (Lazy.WriterT m g) v e where
inEdges = lift . inEdges
inDegree = lift . inDegree
incidentEdges = lift . incidentEdges
Please sign in to comment.
Something went wrong with that request. Please try again.