{-# LANGUAGE CPP, 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
#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error
#endif
import Data.Functor.Identity
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
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 Vertex g
v = [Edge g] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Edge g] -> Int) -> g [Edge g] -> g Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vertex g -> g [Edge g]
forall (g :: * -> *).
BidirectionalGraph g =>
Vertex g -> g [Edge g]
inEdges Vertex g
v

  incidentEdges :: Vertex g -> g [Edge g]
  incidentEdges Vertex g
v = ([Edge g] -> [Edge g] -> [Edge g])
-> g [Edge g] -> g [Edge g] -> g [Edge g]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [Edge g] -> [Edge g] -> [Edge g]
forall a. [a] -> [a] -> [a]
(++) (Vertex g -> g [Edge g]
forall (g :: * -> *).
BidirectionalGraph g =>
Vertex g -> g [Edge g]
inEdges Vertex g
v) (Vertex g -> g [Edge g]
forall (g :: * -> *).
AdjacencyListGraph g =>
Vertex g -> g [Edge g]
outEdges Vertex g
v)

  degree :: Vertex g -> g Int
  degree Vertex g
v = (Int -> Int -> Int) -> g Int -> g Int -> g Int
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Vertex g -> g Int
forall (g :: * -> *). BidirectionalGraph g => Vertex g -> g Int
inDegree Vertex g
v) (Vertex g -> g Int
forall (g :: * -> *). AdjacencyListGraph g => Vertex g -> g Int
outDegree Vertex g
v)

instance BidirectionalGraph g => BidirectionalGraph (Strict.StateT s g) where
  inEdges :: Vertex (StateT s g) -> StateT s g [Edge (StateT s g)]
inEdges  = g [Edge g] -> StateT s g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> StateT s g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> StateT s 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
  inDegree :: Vertex (StateT s g) -> StateT s g Int
inDegree = g Int -> StateT s g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> StateT s g Int)
-> (Vertex g -> g Int) -> Vertex g -> StateT s 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 (StateT s g) -> StateT s g [Edge (StateT s g)]
incidentEdges = g [Edge g] -> StateT s g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> StateT s g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> StateT s 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 (StateT s g) -> StateT s g Int
degree = g Int -> StateT s g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> StateT s g Int)
-> (Vertex g -> g Int) -> Vertex g -> StateT s 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 BidirectionalGraph g => BidirectionalGraph (Lazy.StateT s g) where
  inEdges :: Vertex (StateT s g) -> StateT s g [Edge (StateT s g)]
inEdges  = g [Edge g] -> StateT s g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> StateT s g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> StateT s 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
  inDegree :: Vertex (StateT s g) -> StateT s g Int
inDegree = g Int -> StateT s g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> StateT s g Int)
-> (Vertex g -> g Int) -> Vertex g -> StateT s 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 (StateT s g) -> StateT s g [Edge (StateT s g)]
incidentEdges = g [Edge g] -> StateT s g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> StateT s g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> StateT s 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 (StateT s g) -> StateT s g Int
degree = g Int -> StateT s g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> StateT s g Int)
-> (Vertex g -> g Int) -> Vertex g -> StateT s 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 (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Strict.WriterT m g) where
  inEdges :: Vertex (WriterT m g) -> WriterT m g [Edge (WriterT m g)]
inEdges  = g [Edge g] -> WriterT m g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> WriterT m g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> WriterT m 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
  inDegree :: Vertex (WriterT m g) -> WriterT m g Int
inDegree = g Int -> WriterT m g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> WriterT m g Int)
-> (Vertex g -> g Int) -> Vertex g -> WriterT m 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 (WriterT m g) -> WriterT m g [Edge (WriterT m g)]
incidentEdges = g [Edge g] -> WriterT m g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> WriterT m g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> WriterT m 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 (WriterT m g) -> WriterT m g Int
degree = g Int -> WriterT m g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> WriterT m g Int)
-> (Vertex g -> g Int) -> Vertex g -> WriterT m 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 (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Lazy.WriterT m g) where
  inEdges :: Vertex (WriterT m g) -> WriterT m g [Edge (WriterT m g)]
inEdges  = g [Edge g] -> WriterT m g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> WriterT m g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> WriterT m 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
  inDegree :: Vertex (WriterT m g) -> WriterT m g Int
inDegree = g Int -> WriterT m g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> WriterT m g Int)
-> (Vertex g -> g Int) -> Vertex g -> WriterT m 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 (WriterT m g) -> WriterT m g [Edge (WriterT m g)]
incidentEdges = g [Edge g] -> WriterT m g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> WriterT m g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> WriterT m 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 (WriterT m g) -> WriterT m g Int
degree = g Int -> WriterT m g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> WriterT m g Int)
-> (Vertex g -> g Int) -> Vertex g -> WriterT m 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 (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Strict.RWST r m s g) where
  inEdges :: Vertex (RWST r m s g) -> RWST r m s g [Edge (RWST r m s g)]
inEdges  = g [Edge g] -> RWST r m s g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> RWST r m s g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> RWST r m s 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
  inDegree :: Vertex (RWST r m s g) -> RWST r m s g Int
inDegree = g Int -> RWST r m s g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> RWST r m s g Int)
-> (Vertex g -> g Int) -> Vertex g -> RWST r m s 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 (RWST r m s g) -> RWST r m s g [Edge (RWST r m s g)]
incidentEdges = g [Edge g] -> RWST r m s g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> RWST r m s g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> RWST r m s 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 (RWST r m s g) -> RWST r m s g Int
degree = g Int -> RWST r m s g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> RWST r m s g Int)
-> (Vertex g -> g Int) -> Vertex g -> RWST r m s 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 (BidirectionalGraph g, Monoid m) => BidirectionalGraph (Lazy.RWST r m s g) where
  inEdges :: Vertex (RWST r m s g) -> RWST r m s g [Edge (RWST r m s g)]
inEdges  = g [Edge g] -> RWST r m s g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> RWST r m s g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> RWST r m s 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
  inDegree :: Vertex (RWST r m s g) -> RWST r m s g Int
inDegree = g Int -> RWST r m s g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> RWST r m s g Int)
-> (Vertex g -> g Int) -> Vertex g -> RWST r m s 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 (RWST r m s g) -> RWST r m s g [Edge (RWST r m s g)]
incidentEdges = g [Edge g] -> RWST r m s g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> RWST r m s g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> RWST r m s 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 (RWST r m s g) -> RWST r m s g Int
degree = g Int -> RWST r m s g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> RWST r m s g Int)
-> (Vertex g -> g Int) -> Vertex g -> RWST r m s 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 BidirectionalGraph g => BidirectionalGraph (ReaderT e g) where
  inEdges :: Vertex (ReaderT e g) -> ReaderT e g [Edge (ReaderT e g)]
inEdges  = g [Edge g] -> ReaderT e g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> ReaderT e g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> ReaderT e 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
  inDegree :: Vertex (ReaderT e g) -> ReaderT e g Int
inDegree = g Int -> ReaderT e g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> ReaderT e g Int)
-> (Vertex g -> g Int) -> Vertex g -> ReaderT e 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 (ReaderT e g) -> ReaderT e g [Edge (ReaderT e g)]
incidentEdges = g [Edge g] -> ReaderT e g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> ReaderT e g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> ReaderT e 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 (ReaderT e g) -> ReaderT e g Int
degree = g Int -> ReaderT e g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> ReaderT e g Int)
-> (Vertex g -> g Int) -> Vertex g -> ReaderT e 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 BidirectionalGraph g => BidirectionalGraph (IdentityT g) where
  inEdges :: Vertex (IdentityT g) -> IdentityT g [Edge (IdentityT g)]
inEdges  = g [Edge g] -> IdentityT g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> IdentityT g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> IdentityT 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
  inDegree :: Vertex (IdentityT g) -> IdentityT g Int
inDegree = g Int -> IdentityT g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> IdentityT g Int)
-> (Vertex g -> g Int) -> Vertex g -> IdentityT 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 (IdentityT g) -> IdentityT g [Edge (IdentityT g)]
incidentEdges = g [Edge g] -> IdentityT g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> IdentityT g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> IdentityT 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 (IdentityT g) -> IdentityT g Int
degree = g Int -> IdentityT g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> IdentityT g Int)
-> (Vertex g -> g Int) -> Vertex g -> IdentityT 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 BidirectionalGraph g => BidirectionalGraph (MaybeT g) where
  inEdges :: Vertex (MaybeT g) -> MaybeT g [Edge (MaybeT g)]
inEdges  = g [Edge g] -> MaybeT g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> MaybeT g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> MaybeT 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
  inDegree :: Vertex (MaybeT g) -> MaybeT g Int
inDegree = g Int -> MaybeT g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> MaybeT g Int)
-> (Vertex g -> g Int) -> Vertex g -> MaybeT 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 (MaybeT g) -> MaybeT g [Edge (MaybeT g)]
incidentEdges = g [Edge g] -> MaybeT g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> MaybeT g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> MaybeT 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 (MaybeT g) -> MaybeT g Int
degree = g Int -> MaybeT g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> MaybeT g Int)
-> (Vertex g -> g Int) -> Vertex g -> MaybeT 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

#if !(MIN_VERSION_transformers(0,6,0))
instance (BidirectionalGraph g, Error e) => BidirectionalGraph (ErrorT e g) where
  inEdges :: Vertex (ErrorT e g) -> ErrorT e g [Edge (ErrorT e g)]
inEdges  = g [Edge g] -> ErrorT e g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> ErrorT e g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> ErrorT e 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
  inDegree :: Vertex (ErrorT e g) -> ErrorT e g Int
inDegree = g Int -> ErrorT e g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> ErrorT e g Int)
-> (Vertex g -> g Int) -> Vertex g -> ErrorT e 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 (ErrorT e g) -> ErrorT e g [Edge (ErrorT e g)]
incidentEdges = g [Edge g] -> ErrorT e g [Edge g]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g [Edge g] -> ErrorT e g [Edge g])
-> (Vertex g -> g [Edge g]) -> Vertex g -> ErrorT e 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 (ErrorT e g) -> ErrorT e g Int
degree = g Int -> ErrorT e g Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g Int -> ErrorT e g Int)
-> (Vertex g -> g Int) -> Vertex g -> ErrorT e 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
#endif

instance BidirectionalGraph Identity where
  inEdges :: Vertex Identity -> Identity [Edge Identity]
inEdges Vertex Identity
_ = [Void] -> Identity [Void]
forall a. a -> Identity a
Identity []
  inDegree :: Vertex Identity -> Identity Int
inDegree Vertex Identity
_ = Int -> Identity Int
forall a. a -> Identity a
Identity Int
0
  incidentEdges :: Vertex Identity -> Identity [Edge Identity]
incidentEdges Vertex Identity
_ = [Void] -> Identity [Void]
forall a. a -> Identity a
Identity []
  degree :: Vertex Identity -> Identity Int
degree Vertex Identity
_  = Int -> Identity Int
forall a. a -> Identity a
Identity Int
0