{-# LANGUAGE CPP, TypeFamilies, TypeOperators, 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
#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error
#endif
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import Data.Functor.Identity
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
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 :: a -> t g (VertexMap (t g) a)
liftVertexMap = g (PropertyMap (t g) (Vertex g) a)
-> t g (PropertyMap (t g) (Vertex g) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g (PropertyMap (t g) (Vertex g) a)
 -> t g (PropertyMap (t g) (Vertex g) a))
-> (a -> g (PropertyMap (t g) (Vertex g) a))
-> a
-> t g (PropertyMap (t g) (Vertex g) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PropertyMap g (Vertex g) a -> PropertyMap (t g) (Vertex g) a)
-> g (PropertyMap g (Vertex g) a)
-> g (PropertyMap (t g) (Vertex g) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PropertyMap g (Vertex g) a -> PropertyMap (t 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 (t g) (Vertex g) a))
-> (a -> g (PropertyMap g (Vertex g) a))
-> a
-> g (PropertyMap (t 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
{-# INLINE liftVertexMap #-}

liftEdgeMap :: (MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g)
            => a -> t g (EdgeMap (t g) a)
liftEdgeMap :: a -> t g (EdgeMap (t g) a)
liftEdgeMap = g (PropertyMap (t g) (Edge g) a)
-> t g (PropertyMap (t g) (Edge g) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (g (PropertyMap (t g) (Edge g) a)
 -> t g (PropertyMap (t g) (Edge g) a))
-> (a -> g (PropertyMap (t g) (Edge g) a))
-> a
-> t g (PropertyMap (t g) (Edge g) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PropertyMap g (Edge g) a -> PropertyMap (t g) (Edge g) a)
-> g (PropertyMap g (Edge g) a) -> g (PropertyMap (t g) (Edge g) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PropertyMap g (Edge g) a -> PropertyMap (t 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 (t g) (Edge g) a))
-> (a -> g (PropertyMap g (Edge g) a))
-> a
-> g (PropertyMap (t 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
{-# 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 :: a -> StateT s g (VertexMap (StateT s g) a)
vertexMap = a -> StateT s g (VertexMap (StateT s g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> StateT s g (EdgeMap (StateT s g) a)
edgeMap = a -> StateT s g (EdgeMap (StateT s g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
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 :: a -> StateT s g (VertexMap (StateT s g) a)
vertexMap = a -> StateT s g (VertexMap (StateT s g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> StateT s g (EdgeMap (StateT s g) a)
edgeMap = a -> StateT s g (EdgeMap (StateT s g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
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 :: a -> WriterT m g (VertexMap (WriterT m g) a)
vertexMap = a -> WriterT m g (VertexMap (WriterT m g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> WriterT m g (EdgeMap (WriterT m g) a)
edgeMap = a -> WriterT m g (EdgeMap (WriterT m g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
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 :: a -> WriterT m g (VertexMap (WriterT m g) a)
vertexMap = a -> WriterT m g (VertexMap (WriterT m g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> WriterT m g (EdgeMap (WriterT m g) a)
edgeMap = a -> WriterT m g (EdgeMap (WriterT m g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
liftEdgeMap

instance Graph g => Graph (ReaderT m g) where
  type Vertex (ReaderT m g) = Vertex g
  type Edge (ReaderT m g) = Edge g
  vertexMap :: a -> ReaderT m g (VertexMap (ReaderT m g) a)
vertexMap = a -> ReaderT m g (VertexMap (ReaderT m g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> ReaderT m g (EdgeMap (ReaderT m g) a)
edgeMap = a -> ReaderT m g (EdgeMap (ReaderT m g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
liftEdgeMap

instance Graph g => Graph (IdentityT g) where
  type Vertex (IdentityT g) = Vertex g
  type Edge (IdentityT g) = Edge g
  vertexMap :: a -> IdentityT g (VertexMap (IdentityT g) a)
vertexMap = a -> IdentityT g (VertexMap (IdentityT g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> IdentityT g (EdgeMap (IdentityT g) a)
edgeMap = a -> IdentityT g (EdgeMap (IdentityT g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
liftEdgeMap

instance Graph g => Graph (MaybeT g) where
  type Vertex (MaybeT g) = Vertex g
  type Edge (MaybeT g) = Edge g
  vertexMap :: a -> MaybeT g (VertexMap (MaybeT g) a)
vertexMap = a -> MaybeT g (VertexMap (MaybeT g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> MaybeT g (EdgeMap (MaybeT g) a)
edgeMap = a -> MaybeT g (EdgeMap (MaybeT g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
liftEdgeMap

#if !(MIN_VERSION_transformers(0,6,0))
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 :: a -> ErrorT e g (VertexMap (ErrorT e g) a)
vertexMap = a -> ErrorT e g (VertexMap (ErrorT e g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> ErrorT e g (EdgeMap (ErrorT e g) a)
edgeMap = a -> ErrorT e g (EdgeMap (ErrorT e g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
liftEdgeMap
#endif

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 :: a -> RWST r w s g (VertexMap (RWST r w s g) a)
vertexMap = a -> RWST r w s g (VertexMap (RWST r w s g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> RWST r w s g (EdgeMap (RWST r w s g) a)
edgeMap = a -> RWST r w s g (EdgeMap (RWST r w s g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
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 :: a -> RWST r w s g (VertexMap (RWST r w s g) a)
vertexMap = a -> RWST r w s g (VertexMap (RWST r w s g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) =>
a -> t g (VertexMap (t g) a)
liftVertexMap
  edgeMap :: a -> RWST r w s g (EdgeMap (RWST r w s g) a)
edgeMap = a -> RWST r w s g (EdgeMap (RWST r w s g) a)
forall (t :: (* -> *) -> * -> *) (g :: * -> *) a.
(MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) =>
a -> t g (EdgeMap (t g) a)
liftEdgeMap

voidMap :: PropertyMap Identity Void a
voidMap :: PropertyMap Identity Void a
voidMap = (Void -> Identity a)
-> (Void -> a -> Identity (PropertyMap Identity Void a))
-> PropertyMap Identity Void a
forall (m :: * -> *) k v.
(k -> m v)
-> (k -> v -> m (PropertyMap m k v)) -> PropertyMap m k v
PropertyMap (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (Void -> a) -> Void -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Void -> a
forall a. Void -> a
absurd) ((Void -> a -> Identity (PropertyMap Identity Void a))
 -> PropertyMap Identity Void a)
-> (Void -> a -> Identity (PropertyMap Identity Void a))
-> PropertyMap Identity Void a
forall a b. (a -> b) -> a -> b
$ \Void
_ a
_ -> PropertyMap Identity Void a
-> Identity (PropertyMap Identity Void a)
forall a. a -> Identity a
Identity PropertyMap Identity Void a
forall a. PropertyMap Identity Void a
voidMap

-- | The empty graph
instance Graph Identity where
  type Vertex Identity = Void
  type Edge Identity = Void
  vertexMap :: a -> Identity (VertexMap Identity a)
vertexMap a
_ = PropertyMap Identity Void a
-> Identity (PropertyMap Identity Void a)
forall a. a -> Identity a
Identity PropertyMap Identity Void a
forall a. PropertyMap Identity Void a
voidMap
  edgeMap :: a -> Identity (EdgeMap Identity a)
edgeMap   a
_ = PropertyMap Identity Void a
-> Identity (PropertyMap Identity Void a)
forall a. a -> Identity a
Identity PropertyMap Identity Void a
forall a. PropertyMap Identity Void a
voidMap