{-# LANGUAGE CPP, 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

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
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 { Dual g a -> g a
runDual :: g a }

instance MonadTrans Dual where
  lift :: m a -> Dual m a
lift = m a -> Dual m a
forall (g :: * -> *) a. g a -> Dual g a
Dual

instance Functor g => Functor (Dual g) where
  fmap :: (a -> b) -> Dual g a -> Dual g b
fmap a -> b
f (Dual g a
g) = g b -> Dual g b
forall (g :: * -> *) a. g a -> Dual g a
Dual (g b -> Dual g b) -> g b -> Dual g b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f g a
g
  a
b <$ :: a -> Dual g b -> Dual g a
<$ Dual g b
g = g a -> Dual g a
forall (g :: * -> *) a. g a -> Dual g a
Dual (g a -> Dual g a) -> g a -> Dual g a
forall a b. (a -> b) -> a -> b
$ a
b a -> g b -> g a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ g b
g

instance Applicative g => Applicative (Dual g) where
  pure :: a -> Dual g a
pure = g a -> Dual g a
forall (g :: * -> *) a. g a -> Dual g a
Dual (g a -> Dual g a) -> (a -> g a) -> a -> Dual g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> g a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Dual g (a -> b)
f <*> :: Dual g (a -> b) -> Dual g a -> Dual g b
<*> Dual g a
a = g b -> Dual g b
forall (g :: * -> *) a. g a -> Dual g a
Dual (g (a -> b)
f g (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g a
a)
  Dual g a
f <* :: Dual g a -> Dual g b -> Dual g a
<*  Dual g b
a = g a -> Dual g a
forall (g :: * -> *) a. g a -> Dual g a
Dual (g a
f g a -> g b -> g a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  g b
a)
  Dual g a
f  *> :: Dual g a -> Dual g b -> Dual g b
*> Dual g b
a = g b -> Dual g b
forall (g :: * -> *) a. g a -> Dual g a
Dual (g a
f  g a -> g b -> g b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> g b
a)

instance Monad g => Monad (Dual g) where
  Dual g a
g >>= :: Dual g a -> (a -> Dual g b) -> Dual g b
>>= a -> Dual g b
k = g b -> Dual g b
forall (g :: * -> *) a. g a -> Dual g a
Dual (g a
g g a -> (a -> g b) -> g b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Dual g b -> g b
forall (g :: * -> *) a. Dual g a -> g a
runDual (Dual g b -> g b) -> (a -> Dual g b) -> a -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Dual g b
k)
#if !(MIN_VERSION_base(4,11,0))
  return = Dual . return
  Dual g >> Dual h = Dual (g >> h)
#endif

instance Graph g => Graph (Dual g) where
  type Vertex (Dual g) = Vertex g
  type Edge (Dual g) = Edge g
  vertexMap :: a -> Dual g (VertexMap (Dual g) a)
vertexMap = g (PropertyMap (Dual g) (Vertex g) a)
-> Dual g (PropertyMap (Dual g) (Vertex g) a)
forall (g :: * -> *) a. g a -> Dual g a
Dual (g (PropertyMap (Dual g) (Vertex g) a)
 -> Dual g (PropertyMap (Dual g) (Vertex g) a))
-> (a -> g (PropertyMap (Dual g) (Vertex g) a))
-> a
-> Dual g (PropertyMap (Dual g) (Vertex g) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PropertyMap g (Vertex g) a -> PropertyMap (Dual g) (Vertex g) a)
-> g (PropertyMap g (Vertex g) a)
-> g (PropertyMap (Dual g) (Vertex g) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PropertyMap g (Vertex g) a -> PropertyMap (Dual g) (Vertex g) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) k v.
(MonadTrans t, Monad m, Monad (t m)) =>
PropertyMap m k v -> PropertyMap (t m) k v
liftPropertyMap (g (PropertyMap g (Vertex g) a)
 -> g (PropertyMap (Dual g) (Vertex g) a))
-> (a -> g (PropertyMap g (Vertex g) a))
-> a
-> g (PropertyMap (Dual g) (Vertex g) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> g (PropertyMap g (Vertex g) a)
forall (g :: * -> *) a. Graph g => a -> g (VertexMap g a)
vertexMap
  edgeMap :: a -> Dual g (EdgeMap (Dual g) a)
edgeMap   = g (PropertyMap (Dual g) (Edge g) a)
-> Dual g (PropertyMap (Dual g) (Edge g) a)
forall (g :: * -> *) a. g a -> Dual g a
Dual (g (PropertyMap (Dual g) (Edge g) a)
 -> Dual g (PropertyMap (Dual g) (Edge g) a))
-> (a -> g (PropertyMap (Dual g) (Edge g) a))
-> a
-> Dual g (PropertyMap (Dual g) (Edge g) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PropertyMap g (Edge g) a -> PropertyMap (Dual g) (Edge g) a)
-> g (PropertyMap g (Edge g) a)
-> g (PropertyMap (Dual g) (Edge g) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PropertyMap g (Edge g) a -> PropertyMap (Dual g) (Edge g) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) k v.
(MonadTrans t, Monad m, Monad (t m)) =>
PropertyMap m k v -> PropertyMap (t m) k v
liftPropertyMap (g (PropertyMap g (Edge g) a)
 -> g (PropertyMap (Dual g) (Edge g) a))
-> (a -> g (PropertyMap g (Edge g) a))
-> a
-> g (PropertyMap (Dual g) (Edge g) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> g (PropertyMap g (Edge g) a)
forall (g :: * -> *) a. Graph g => a -> g (EdgeMap g a)
edgeMap

instance AdjacencyMatrixGraph g => AdjacencyMatrixGraph (Dual g) where
  edge :: Vertex (Dual g)
-> Vertex (Dual g) -> Dual g (Maybe (Edge (Dual g)))
edge Vertex (Dual g)
l Vertex (Dual g)
r = g (Maybe (Edge g)) -> Dual g (Maybe (Edge g))
forall (g :: * -> *) a. g a -> Dual g a
Dual (Vertex g -> Vertex g -> g (Maybe (Edge g))
forall (g :: * -> *).
AdjacencyMatrixGraph g =>
Vertex g -> Vertex g -> g (Maybe (Edge g))
edge Vertex g
Vertex (Dual g)
r Vertex g
Vertex (Dual g)
l)

instance BidirectionalGraph g => AdjacencyListGraph (Dual g) where
  source :: Edge (Dual g) -> Dual g (Vertex (Dual g))
source = g (Vertex g) -> Dual g (Vertex g)
forall (g :: * -> *) a. g a -> Dual g a
Dual (g (Vertex g) -> Dual g (Vertex g))
-> (Edge g -> g (Vertex g)) -> Edge g -> Dual g (Vertex g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edge g -> g (Vertex g)
forall (g :: * -> *).
AdjacencyListGraph g =>
Edge g -> g (Vertex g)
target
  target :: Edge (Dual g) -> Dual g (Vertex (Dual g))
target = g (Vertex g) -> Dual g (Vertex g)
forall (g :: * -> *) a. g a -> Dual g a
Dual (g (Vertex g) -> Dual g (Vertex g))
-> (Edge g -> g (Vertex g)) -> Edge g -> Dual g (Vertex g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Edge g -> g (Vertex g)
forall (g :: * -> *).
AdjacencyListGraph g =>
Edge g -> g (Vertex g)
source
  outEdges :: Vertex (Dual g) -> Dual g [Edge (Dual g)]
outEdges = g [Edge g] -> Dual g [Edge g]
forall (g :: * -> *) a. g a -> Dual g a
Dual (g [Edge g] -> Dual g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> Dual g [Edge g]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex g -> g [Edge g]
forall (g :: * -> *).
BidirectionalGraph g =>
Vertex g -> g [Edge g]
inEdges
  outDegree :: Vertex (Dual g) -> Dual g Int
outDegree = g Int -> Dual g Int
forall (g :: * -> *) a. g a -> Dual g a
Dual (g Int -> Dual g Int)
-> (Vertex g -> g Int) -> Vertex g -> Dual g Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex g -> g Int
forall (g :: * -> *). BidirectionalGraph g => Vertex g -> g Int
inDegree

instance BidirectionalGraph g => BidirectionalGraph (Dual g) where
  inEdges :: Vertex (Dual g) -> Dual g [Edge (Dual g)]
inEdges = g [Edge g] -> Dual g [Edge g]
forall (g :: * -> *) a. g a -> Dual g a
Dual (g [Edge g] -> Dual g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> Dual g [Edge g]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex g -> g [Edge g]
forall (g :: * -> *).
AdjacencyListGraph g =>
Vertex g -> g [Edge g]
outEdges
  inDegree :: Vertex (Dual g) -> Dual g Int
inDegree = g Int -> Dual g Int
forall (g :: * -> *) a. g a -> Dual g a
Dual (g Int -> Dual g Int)
-> (Vertex g -> g Int) -> Vertex g -> Dual g Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex g -> g Int
forall (g :: * -> *). BidirectionalGraph g => Vertex g -> g Int
inDegree
  incidentEdges :: Vertex (Dual g) -> Dual g [Edge (Dual g)]
incidentEdges = g [Edge g] -> Dual g [Edge g]
forall (g :: * -> *) a. g a -> Dual g a
Dual (g [Edge g] -> Dual g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> Dual g [Edge g]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex g -> g [Edge g]
forall (g :: * -> *).
BidirectionalGraph g =>
Vertex g -> g [Edge g]
incidentEdges
  degree :: Vertex (Dual g) -> Dual g Int
degree = g Int -> Dual g Int
forall (g :: * -> *) a. g a -> Dual g a
Dual (g Int -> Dual g Int)
-> (Vertex g -> g Int) -> Vertex g -> Dual g Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vertex g -> g Int
forall (g :: * -> *). BidirectionalGraph g => Vertex g -> g Int
degree

instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Dual g) where
  edges :: Dual g [Edge (Dual g)]
edges = g [Edge g] -> Dual g [Edge g]
forall (g :: * -> *) a. g a -> Dual g a
Dual g [Edge g]
forall (g :: * -> *). EdgeEnumerableGraph g => g [Edge g]
edges

instance VertexEnumerableGraph g => VertexEnumerableGraph (Dual g) where
  vertices :: Dual g [Vertex (Dual g)]
vertices = g [Vertex g] -> Dual g [Vertex g]
forall (g :: * -> *) a. g a -> Dual g a
Dual g [Vertex g]
forall (g :: * -> *). VertexEnumerableGraph g => g [Vertex g]
vertices