{-# LANGUAGE TypeFamilies, PatternGuards, RankNTypes #-}
-- | An adapter to create graphs with labeled vertices and unlabeled edges.
--
-- See 'LabeledGraph' for an overview.  The only significant difference
-- is that this graph only supports adding unlabeled edges, and thus you
-- must use 'addEdge' instead of 'addLabeledEdge'.
module Data.Graph.Haggle.VertexLabelAdapter (
  VertexLabeledMGraph,
  VertexLabeledGraph,
  -- * Mutable Graph API
  newVertexLabeledGraph,
  newSizedVertexLabeledGraph,
  -- * Immutable Graph API
  mapVertexLabel,
  fromEdgeList
  ) where

import qualified Control.DeepSeq as DS
import qualified Control.Monad.Primitive as P
import qualified Control.Monad.Ref as R
import Control.Monad.ST ( ST, runST )

import qualified Data.Graph.Haggle.Classes as I
import qualified Data.Graph.Haggle.VertexMap as VM
import qualified Data.Graph.Haggle.Internal.Adapter as A

newtype VertexLabeledMGraph g nl m = VLMG { VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG :: A.LabeledMGraph g nl () m }
newtype VertexLabeledGraph g nl = VLG { VertexLabeledGraph g nl -> LabeledGraph g nl ()
unVLG :: A.LabeledGraph g nl () }

instance (DS.NFData g, DS.NFData nl) => DS.NFData (VertexLabeledGraph g nl) where
  rnf :: VertexLabeledGraph g nl -> ()
rnf (VLG LabeledGraph g nl ()
g) = LabeledGraph g nl ()
g LabeledGraph g nl () -> () -> ()
forall a b. NFData a => a -> b -> b
`DS.deepseq` ()

mapVertexLabel :: VertexLabeledGraph g nl -> (nl -> nl') -> VertexLabeledGraph g nl'
mapVertexLabel :: VertexLabeledGraph g nl -> (nl -> nl') -> VertexLabeledGraph g nl'
mapVertexLabel VertexLabeledGraph g nl
g = LabeledGraph g nl' () -> VertexLabeledGraph g nl'
forall g nl. LabeledGraph g nl () -> VertexLabeledGraph g nl
VLG (LabeledGraph g nl' () -> VertexLabeledGraph g nl')
-> ((nl -> nl') -> LabeledGraph g nl' ())
-> (nl -> nl')
-> VertexLabeledGraph g nl'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabeledGraph g nl () -> (nl -> nl') -> LabeledGraph g nl' ()
forall g nl el nl'.
LabeledGraph g nl el -> (nl -> nl') -> LabeledGraph g nl' el
A.mapVertexLabel (VertexLabeledGraph g nl -> LabeledGraph g nl ()
forall g nl. VertexLabeledGraph g nl -> LabeledGraph g nl ()
unVLG VertexLabeledGraph g nl
g)
{-# INLINE mapVertexLabel #-}

vertices :: (I.Graph g) => VertexLabeledGraph g nl -> [I.Vertex]
vertices :: VertexLabeledGraph g nl -> [Vertex]
vertices = LabeledGraph g nl () -> [Vertex]
forall g. Graph g => g -> [Vertex]
I.vertices (LabeledGraph g nl () -> [Vertex])
-> (VertexLabeledGraph g nl -> LabeledGraph g nl ())
-> VertexLabeledGraph g nl
-> [Vertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexLabeledGraph g nl -> LabeledGraph g nl ()
forall g nl. VertexLabeledGraph g nl -> LabeledGraph g nl ()
unVLG
{-# INLINE vertices #-}

edges :: (I.Graph g) => VertexLabeledGraph g nl -> [I.Edge]
edges :: VertexLabeledGraph g nl -> [Edge]
edges = LabeledGraph g nl () -> [Edge]
forall g. Graph g => g -> [Edge]
I.edges (LabeledGraph g nl () -> [Edge])
-> (VertexLabeledGraph g nl -> LabeledGraph g nl ())
-> VertexLabeledGraph g nl
-> [Edge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexLabeledGraph g nl -> LabeledGraph g nl ()
forall g nl. VertexLabeledGraph g nl -> LabeledGraph g nl ()
unVLG
{-# INLINE edges #-}

successors :: (I.Graph g) => VertexLabeledGraph g nl -> I.Vertex -> [I.Vertex]
successors :: VertexLabeledGraph g nl -> Vertex -> [Vertex]
successors (VLG LabeledGraph g nl ()
lg) = LabeledGraph g nl () -> Vertex -> [Vertex]
forall g. Graph g => g -> Vertex -> [Vertex]
I.successors LabeledGraph g nl ()
lg
{-# INLINE successors #-}

outEdges :: (I.Graph g) => VertexLabeledGraph g nl -> I.Vertex -> [I.Edge]
outEdges :: VertexLabeledGraph g nl -> Vertex -> [Edge]
outEdges (VLG LabeledGraph g nl ()
lg) = LabeledGraph g nl () -> Vertex -> [Edge]
forall g. Graph g => g -> Vertex -> [Edge]
I.outEdges LabeledGraph g nl ()
lg
{-# INLINE outEdges #-}

edgesBetween :: (I.Graph g) => VertexLabeledGraph g nl -> I.Vertex -> I.Vertex -> [I.Edge]
edgesBetween :: VertexLabeledGraph g nl -> Vertex -> Vertex -> [Edge]
edgesBetween (VLG LabeledGraph g nl ()
lg) = LabeledGraph g nl () -> Vertex -> Vertex -> [Edge]
forall g. Graph g => g -> Vertex -> Vertex -> [Edge]
I.edgesBetween LabeledGraph g nl ()
lg
{-# INLINE edgesBetween #-}

maxVertexId :: (I.Graph g) => VertexLabeledGraph g nl -> Int
maxVertexId :: VertexLabeledGraph g nl -> Int
maxVertexId = LabeledGraph g nl () -> Int
forall g. Graph g => g -> Int
I.maxVertexId (LabeledGraph g nl () -> Int)
-> (VertexLabeledGraph g nl -> LabeledGraph g nl ())
-> VertexLabeledGraph g nl
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexLabeledGraph g nl -> LabeledGraph g nl ()
forall g nl. VertexLabeledGraph g nl -> LabeledGraph g nl ()
unVLG
{-# INLINE maxVertexId #-}

isEmpty :: (I.Graph g) => VertexLabeledGraph g nl -> Bool
isEmpty :: VertexLabeledGraph g nl -> Bool
isEmpty = LabeledGraph g nl () -> Bool
forall g. Graph g => g -> Bool
I.isEmpty (LabeledGraph g nl () -> Bool)
-> (VertexLabeledGraph g nl -> LabeledGraph g nl ())
-> VertexLabeledGraph g nl
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexLabeledGraph g nl -> LabeledGraph g nl ()
forall g nl. VertexLabeledGraph g nl -> LabeledGraph g nl ()
unVLG
{-# INLINE isEmpty #-}

instance (I.Graph g) => I.Graph (VertexLabeledGraph g nl) where
  vertices :: VertexLabeledGraph g nl -> [Vertex]
vertices = VertexLabeledGraph g nl -> [Vertex]
forall g nl. Graph g => VertexLabeledGraph g nl -> [Vertex]
vertices
  edges :: VertexLabeledGraph g nl -> [Edge]
edges = VertexLabeledGraph g nl -> [Edge]
forall g nl. Graph g => VertexLabeledGraph g nl -> [Edge]
edges
  successors :: VertexLabeledGraph g nl -> Vertex -> [Vertex]
successors = VertexLabeledGraph g nl -> Vertex -> [Vertex]
forall g nl.
Graph g =>
VertexLabeledGraph g nl -> Vertex -> [Vertex]
successors
  outEdges :: VertexLabeledGraph g nl -> Vertex -> [Edge]
outEdges = VertexLabeledGraph g nl -> Vertex -> [Edge]
forall g nl. Graph g => VertexLabeledGraph g nl -> Vertex -> [Edge]
outEdges
  edgesBetween :: VertexLabeledGraph g nl -> Vertex -> Vertex -> [Edge]
edgesBetween = VertexLabeledGraph g nl -> Vertex -> Vertex -> [Edge]
forall g nl.
Graph g =>
VertexLabeledGraph g nl -> Vertex -> Vertex -> [Edge]
edgesBetween
  maxVertexId :: VertexLabeledGraph g nl -> Int
maxVertexId = VertexLabeledGraph g nl -> Int
forall g nl. Graph g => VertexLabeledGraph g nl -> Int
maxVertexId
  isEmpty :: VertexLabeledGraph g nl -> Bool
isEmpty = VertexLabeledGraph g nl -> Bool
forall g nl. Graph g => VertexLabeledGraph g nl -> Bool
isEmpty

instance (I.Thawable g) => I.Thawable (VertexLabeledGraph g nl) where
  type MutableGraph (VertexLabeledGraph g nl) =
    VertexLabeledMGraph (I.MutableGraph g) nl
  thaw :: VertexLabeledGraph g nl
-> m (MutableGraph (VertexLabeledGraph g nl) m)
thaw (VLG LabeledGraph g nl ()
lg) = do
    LabeledMGraph (MutableGraph g) nl () m
g' <- LabeledGraph g nl () -> m (MutableGraph (LabeledGraph g nl ()) m)
forall g (m :: * -> *).
(Thawable g, PrimMonad m, MonadRef m) =>
g -> m (MutableGraph g m)
I.thaw LabeledGraph g nl ()
lg
    VertexLabeledMGraph (MutableGraph g) nl m
-> m (VertexLabeledMGraph (MutableGraph g) nl m)
forall (m :: * -> *) a. Monad m => a -> m a
return (VertexLabeledMGraph (MutableGraph g) nl m
 -> m (VertexLabeledMGraph (MutableGraph g) nl m))
-> VertexLabeledMGraph (MutableGraph g) nl m
-> m (VertexLabeledMGraph (MutableGraph g) nl m)
forall a b. (a -> b) -> a -> b
$ LabeledMGraph (MutableGraph g) nl () m
-> VertexLabeledMGraph (MutableGraph g) nl m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
LabeledMGraph g nl () m -> VertexLabeledMGraph g nl m
VLMG LabeledMGraph (MutableGraph g) nl () m
g'


predecessors :: (I.Bidirectional g) => VertexLabeledGraph g nl -> I.Vertex -> [I.Vertex]
predecessors :: VertexLabeledGraph g nl -> Vertex -> [Vertex]
predecessors (VLG LabeledGraph g nl ()
lg) = LabeledGraph g nl () -> Vertex -> [Vertex]
forall g. Bidirectional g => g -> Vertex -> [Vertex]
I.predecessors LabeledGraph g nl ()
lg
{-# INLINE predecessors #-}

inEdges :: (I.Bidirectional g) => VertexLabeledGraph g nl -> I.Vertex -> [I.Edge]
inEdges :: VertexLabeledGraph g nl -> Vertex -> [Edge]
inEdges (VLG LabeledGraph g nl ()
lg) = LabeledGraph g nl () -> Vertex -> [Edge]
forall g. Bidirectional g => g -> Vertex -> [Edge]
I.inEdges LabeledGraph g nl ()
lg
{-# INLINE inEdges #-}

instance (I.Bidirectional g) => I.Bidirectional (VertexLabeledGraph g nl) where
  predecessors :: VertexLabeledGraph g nl -> Vertex -> [Vertex]
predecessors = VertexLabeledGraph g nl -> Vertex -> [Vertex]
forall g nl.
Bidirectional g =>
VertexLabeledGraph g nl -> Vertex -> [Vertex]
predecessors
  inEdges :: VertexLabeledGraph g nl -> Vertex -> [Edge]
inEdges = VertexLabeledGraph g nl -> Vertex -> [Edge]
forall g nl.
Bidirectional g =>
VertexLabeledGraph g nl -> Vertex -> [Edge]
inEdges

vertexLabel :: (I.Graph g) => VertexLabeledGraph g nl -> I.Vertex -> Maybe nl
vertexLabel :: VertexLabeledGraph g nl -> Vertex -> Maybe nl
vertexLabel (VLG LabeledGraph g nl ()
g) = LabeledGraph g nl ()
-> Vertex -> Maybe (VertexLabel (LabeledGraph g nl ()))
forall g. HasVertexLabel g => g -> Vertex -> Maybe (VertexLabel g)
I.vertexLabel LabeledGraph g nl ()
g
{-# INLINE vertexLabel #-}

instance (I.Graph g) => I.HasVertexLabel (VertexLabeledGraph g nl) where
  type VertexLabel (VertexLabeledGraph g nl) = nl
  vertexLabel :: VertexLabeledGraph g nl
-> Vertex -> Maybe (VertexLabel (VertexLabeledGraph g nl))
vertexLabel = VertexLabeledGraph g nl
-> Vertex -> Maybe (VertexLabel (VertexLabeledGraph g nl))
forall g nl.
Graph g =>
VertexLabeledGraph g nl -> Vertex -> Maybe nl
vertexLabel
  labeledVertices :: VertexLabeledGraph g nl
-> [(Vertex, VertexLabel (VertexLabeledGraph g nl))]
labeledVertices = VertexLabeledGraph g nl
-> [(Vertex, VertexLabel (VertexLabeledGraph g nl))]
forall g nl. Graph g => VertexLabeledGraph g nl -> [(Vertex, nl)]
labeledVertices

labeledVertices :: (I.Graph g) => VertexLabeledGraph g nl -> [(I.Vertex, nl)]
labeledVertices :: VertexLabeledGraph g nl -> [(Vertex, nl)]
labeledVertices = LabeledGraph g nl () -> [(Vertex, nl)]
forall g. HasVertexLabel g => g -> [(Vertex, VertexLabel g)]
I.labeledVertices (LabeledGraph g nl () -> [(Vertex, nl)])
-> (VertexLabeledGraph g nl -> LabeledGraph g nl ())
-> VertexLabeledGraph g nl
-> [(Vertex, nl)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexLabeledGraph g nl -> LabeledGraph g nl ()
forall g nl. VertexLabeledGraph g nl -> LabeledGraph g nl ()
unVLG
{-# INLINE labeledVertices #-}

newVertexLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
                      => m (g m)
                      -> m (VertexLabeledMGraph g nl m)
newVertexLabeledGraph :: m (g m) -> m (VertexLabeledMGraph g nl m)
newVertexLabeledGraph m (g m)
newG = do
  LabeledMGraph g nl () m
g <- m (g m) -> m (LabeledMGraph g nl () m)
forall (g :: (* -> *) -> *) (m :: * -> *) nl el.
(MGraph g, PrimMonad m, MonadRef m) =>
m (g m) -> m (LabeledMGraph g nl el m)
A.newLabeledGraph m (g m)
newG
  VertexLabeledMGraph g nl m -> m (VertexLabeledMGraph g nl m)
forall (m :: * -> *) a. Monad m => a -> m a
return (VertexLabeledMGraph g nl m -> m (VertexLabeledMGraph g nl m))
-> VertexLabeledMGraph g nl m -> m (VertexLabeledMGraph g nl m)
forall a b. (a -> b) -> a -> b
$ LabeledMGraph g nl () m -> VertexLabeledMGraph g nl m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
LabeledMGraph g nl () m -> VertexLabeledMGraph g nl m
VLMG LabeledMGraph g nl () m
g
{-# INLINE newVertexLabeledGraph #-}

newSizedVertexLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
                           => (Int -> Int -> m (g m))
                           -> Int
                           -> Int
                           -> m (VertexLabeledMGraph g nl m)
newSizedVertexLabeledGraph :: (Int -> Int -> m (g m))
-> Int -> Int -> m (VertexLabeledMGraph g nl m)
newSizedVertexLabeledGraph Int -> Int -> m (g m)
newG Int
szV Int
szE = do
  LabeledMGraph g nl () m
g <- (Int -> Int -> m (g m))
-> Int -> Int -> m (LabeledMGraph g nl () m)
forall (g :: (* -> *) -> *) (m :: * -> *) nl el.
(MGraph g, PrimMonad m, MonadRef m) =>
(Int -> Int -> m (g m))
-> Int -> Int -> m (LabeledMGraph g nl el m)
A.newSizedLabeledGraph Int -> Int -> m (g m)
newG Int
szV Int
szE
  VertexLabeledMGraph g nl m -> m (VertexLabeledMGraph g nl m)
forall (m :: * -> *) a. Monad m => a -> m a
return (VertexLabeledMGraph g nl m -> m (VertexLabeledMGraph g nl m))
-> VertexLabeledMGraph g nl m -> m (VertexLabeledMGraph g nl m)
forall a b. (a -> b) -> a -> b
$ LabeledMGraph g nl () m -> VertexLabeledMGraph g nl m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
LabeledMGraph g nl () m -> VertexLabeledMGraph g nl m
VLMG LabeledMGraph g nl () m
g
{-# INLINE newSizedVertexLabeledGraph #-}

addEdge :: (I.MGraph g, I.MAddEdge g, P.PrimMonad m, R.MonadRef m)
        => VertexLabeledMGraph g nl m
        -> I.Vertex
        -> I.Vertex
        -> m (Maybe I.Edge)
addEdge :: VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m (Maybe Edge)
addEdge VertexLabeledMGraph g nl m
lg = g m -> Vertex -> Vertex -> m (Maybe Edge)
forall (g :: (* -> *) -> *) (m :: * -> *).
(MAddEdge g, PrimMonad m, MonadRef m) =>
g m -> Vertex -> Vertex -> m (Maybe Edge)
I.addEdge (LabeledMGraph g nl () m -> g m
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> g m
A.rawMGraph (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG VertexLabeledMGraph g nl m
lg))
{-# INLINE addEdge #-}

addLabeledVertex :: (I.MGraph g, I.MAddVertex g, P.PrimMonad m, R.MonadRef m)
                 => VertexLabeledMGraph g nl m
                 -> nl
                 -> m I.Vertex
addLabeledVertex :: VertexLabeledMGraph g nl m -> nl -> m Vertex
addLabeledVertex VertexLabeledMGraph g nl m
lg = LabeledMGraph g nl () m
-> MVertexLabel (LabeledMGraph g nl ()) -> m Vertex
forall (g :: (* -> *) -> *) (m :: * -> *).
(MLabeledVertex g, PrimMonad m, MonadRef m) =>
g m -> MVertexLabel g -> m Vertex
I.addLabeledVertex (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG VertexLabeledMGraph g nl m
lg)
{-# INLINE addLabeledVertex #-}

getVertexLabel :: (I.MGraph g, I.MAddVertex g, P.PrimMonad m, R.MonadRef m)
               => VertexLabeledMGraph g nl m
               -> I.Vertex
               -> m (Maybe nl)
getVertexLabel :: VertexLabeledMGraph g nl m -> Vertex -> m (Maybe nl)
getVertexLabel VertexLabeledMGraph g nl m
lg = LabeledMGraph g nl () m
-> Vertex -> m (Maybe (MVertexLabel (LabeledMGraph g nl ())))
forall (g :: (* -> *) -> *) (m :: * -> *).
(MLabeledVertex g, PrimMonad m, MonadRef m) =>
g m -> Vertex -> m (Maybe (MVertexLabel g))
I.getVertexLabel (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG VertexLabeledMGraph g nl m
lg)
{-# INLINE getVertexLabel #-}

getSuccessors :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
              => VertexLabeledMGraph g nl m
              -> I.Vertex
              -> m [I.Vertex]
getSuccessors :: VertexLabeledMGraph g nl m -> Vertex -> m [Vertex]
getSuccessors VertexLabeledMGraph g nl m
lg = LabeledMGraph g nl () m -> Vertex -> m [Vertex]
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> Vertex -> m [Vertex]
I.getSuccessors (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG VertexLabeledMGraph g nl m
lg)
{-# INLINE getSuccessors #-}

getOutEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
            => VertexLabeledMGraph g nl m -> I.Vertex -> m [I.Edge]
getOutEdges :: VertexLabeledMGraph g nl m -> Vertex -> m [Edge]
getOutEdges VertexLabeledMGraph g nl m
lg = LabeledMGraph g nl () m -> Vertex -> m [Edge]
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> Vertex -> m [Edge]
I.getOutEdges (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG VertexLabeledMGraph g nl m
lg)
{-# INLINE getOutEdges #-}

countVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => VertexLabeledMGraph g nl m -> m Int
countVertices :: VertexLabeledMGraph g nl m -> m Int
countVertices = LabeledMGraph g nl () m -> m Int
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m Int
I.countVertices (LabeledMGraph g nl () m -> m Int)
-> (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m)
-> VertexLabeledMGraph g nl m
-> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG
{-# INLINE countVertices #-}

getVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => VertexLabeledMGraph g nl m -> m [I.Vertex]
getVertices :: VertexLabeledMGraph g nl m -> m [Vertex]
getVertices = LabeledMGraph g nl () m -> m [Vertex]
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m [Vertex]
I.getVertices (LabeledMGraph g nl () m -> m [Vertex])
-> (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m)
-> VertexLabeledMGraph g nl m
-> m [Vertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG
{-# INLINE getVertices #-}

countEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => VertexLabeledMGraph g nl m -> m Int
countEdges :: VertexLabeledMGraph g nl m -> m Int
countEdges = LabeledMGraph g nl () m -> m Int
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m Int
I.countEdges (LabeledMGraph g nl () m -> m Int)
-> (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m)
-> VertexLabeledMGraph g nl m
-> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG
{-# INLINE countEdges #-}

getPredecessors :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m)
                => VertexLabeledMGraph g nl m -> I.Vertex -> m [I.Vertex]
getPredecessors :: VertexLabeledMGraph g nl m -> Vertex -> m [Vertex]
getPredecessors VertexLabeledMGraph g nl m
lg = LabeledMGraph g nl () m -> Vertex -> m [Vertex]
forall (g :: (* -> *) -> *) (m :: * -> *).
(MBidirectional g, PrimMonad m, MonadRef m) =>
g m -> Vertex -> m [Vertex]
I.getPredecessors (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG VertexLabeledMGraph g nl m
lg)
{-# INLINE getPredecessors #-}

getInEdges :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m)
           => VertexLabeledMGraph g nl m -> I.Vertex -> m [I.Edge]
getInEdges :: VertexLabeledMGraph g nl m -> Vertex -> m [Edge]
getInEdges VertexLabeledMGraph g nl m
lg = LabeledMGraph g nl () m -> Vertex -> m [Edge]
forall (g :: (* -> *) -> *) (m :: * -> *).
(MBidirectional g, PrimMonad m, MonadRef m) =>
g m -> Vertex -> m [Edge]
I.getInEdges (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG VertexLabeledMGraph g nl m
lg)
{-# INLINE getInEdges #-}

checkEdgeExists :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
                => VertexLabeledMGraph g nl m
                -> I.Vertex
                -> I.Vertex
                -> m Bool
checkEdgeExists :: VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m Bool
checkEdgeExists VertexLabeledMGraph g nl m
lg = LabeledMGraph g nl () m -> Vertex -> Vertex -> m Bool
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> Vertex -> Vertex -> m Bool
I.checkEdgeExists (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG VertexLabeledMGraph g nl m
lg)
{-# INLINE checkEdgeExists #-}

freeze :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
       => VertexLabeledMGraph g nl m
       -> m (VertexLabeledGraph (I.ImmutableGraph g) nl)
freeze :: VertexLabeledMGraph g nl m
-> m (VertexLabeledGraph (ImmutableGraph g) nl)
freeze VertexLabeledMGraph g nl m
lg = do
  LabeledGraph (ImmutableGraph g) nl ()
g' <- LabeledMGraph g nl () m
-> m (ImmutableGraph (LabeledMGraph g nl ()))
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m (ImmutableGraph g)
I.freeze (VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
forall (g :: (* -> *) -> *) nl (m :: * -> *).
VertexLabeledMGraph g nl m -> LabeledMGraph g nl () m
unVLMG VertexLabeledMGraph g nl m
lg)
  VertexLabeledGraph (ImmutableGraph g) nl
-> m (VertexLabeledGraph (ImmutableGraph g) nl)
forall (m :: * -> *) a. Monad m => a -> m a
return (VertexLabeledGraph (ImmutableGraph g) nl
 -> m (VertexLabeledGraph (ImmutableGraph g) nl))
-> VertexLabeledGraph (ImmutableGraph g) nl
-> m (VertexLabeledGraph (ImmutableGraph g) nl)
forall a b. (a -> b) -> a -> b
$ LabeledGraph (ImmutableGraph g) nl ()
-> VertexLabeledGraph (ImmutableGraph g) nl
forall g nl. LabeledGraph g nl () -> VertexLabeledGraph g nl
VLG LabeledGraph (ImmutableGraph g) nl ()
g'
{-# INLINE freeze #-}

instance (I.MGraph g) => I.MGraph (VertexLabeledMGraph g nl) where
  type ImmutableGraph (VertexLabeledMGraph g nl) =
    VertexLabeledGraph (I.ImmutableGraph g) nl
  getVertices :: VertexLabeledMGraph g nl m -> m [Vertex]
getVertices = VertexLabeledMGraph g nl m -> m [Vertex]
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> m [Vertex]
getVertices
  getSuccessors :: VertexLabeledMGraph g nl m -> Vertex -> m [Vertex]
getSuccessors = VertexLabeledMGraph g nl m -> Vertex -> m [Vertex]
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> Vertex -> m [Vertex]
getSuccessors
  getOutEdges :: VertexLabeledMGraph g nl m -> Vertex -> m [Edge]
getOutEdges = VertexLabeledMGraph g nl m -> Vertex -> m [Edge]
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> Vertex -> m [Edge]
getOutEdges
  countVertices :: VertexLabeledMGraph g nl m -> m Int
countVertices = VertexLabeledMGraph g nl m -> m Int
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> m Int
countVertices
  countEdges :: VertexLabeledMGraph g nl m -> m Int
countEdges = VertexLabeledMGraph g nl m -> m Int
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> m Int
countEdges
  checkEdgeExists :: VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m Bool
checkEdgeExists = VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m Bool
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m Bool
checkEdgeExists
  freeze :: VertexLabeledMGraph g nl m
-> m (ImmutableGraph (VertexLabeledMGraph g nl))
freeze = VertexLabeledMGraph g nl m
-> m (ImmutableGraph (VertexLabeledMGraph g nl))
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m
-> m (VertexLabeledGraph (ImmutableGraph g) nl)
freeze

instance (I.MAddVertex g) => I.MLabeledVertex (VertexLabeledMGraph g nl) where
  type MVertexLabel (VertexLabeledMGraph g nl) = nl
  getVertexLabel :: VertexLabeledMGraph g nl m
-> Vertex -> m (Maybe (MVertexLabel (VertexLabeledMGraph g nl)))
getVertexLabel = VertexLabeledMGraph g nl m
-> Vertex -> m (Maybe (MVertexLabel (VertexLabeledMGraph g nl)))
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, MAddVertex g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> Vertex -> m (Maybe nl)
getVertexLabel
  addLabeledVertex :: VertexLabeledMGraph g nl m
-> MVertexLabel (VertexLabeledMGraph g nl) -> m Vertex
addLabeledVertex = VertexLabeledMGraph g nl m
-> MVertexLabel (VertexLabeledMGraph g nl) -> m Vertex
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, MAddVertex g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> nl -> m Vertex
addLabeledVertex

instance (I.MBidirectional g) => I.MBidirectional (VertexLabeledMGraph g nl) where
  getPredecessors :: VertexLabeledMGraph g nl m -> Vertex -> m [Vertex]
getPredecessors = VertexLabeledMGraph g nl m -> Vertex -> m [Vertex]
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MBidirectional g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> Vertex -> m [Vertex]
getPredecessors
  getInEdges :: VertexLabeledMGraph g nl m -> Vertex -> m [Edge]
getInEdges = VertexLabeledMGraph g nl m -> Vertex -> m [Edge]
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MBidirectional g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> Vertex -> m [Edge]
getInEdges

instance (I.MAddEdge g) => I.MAddEdge (VertexLabeledMGraph g nl) where
  addEdge :: VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m (Maybe Edge)
addEdge = VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m (Maybe Edge)
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, MAddEdge g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m (Maybe Edge)
addEdge

-- | Build a new (immutable) graph from a list of edges.  Edges are defined
-- by pairs of /node labels/.  A new 'Vertex' will be allocated for each
-- node label.
--
-- The type of the constructed graph is controlled by the first argument,
-- which is a constructor for a mutable graph.
--
-- Example:
--
-- > import Data.Graph.Haggle.VertexLabelAdapter
-- > import Data.Graph.Haggle.SimpleBiDigraph
-- >
-- > let g = fromEdgeList newMSimpleBiDigraph [(0,1), (1,2), (2,3), (3,0)]
--
-- @g@ has type SimpleBiDigraph.
--
-- An alternative that is fully polymorphic in the return type would be
-- possible, but it would require type annotations on the result of
-- 'fromEdgeList', which could be very annoying.
fromEdgeList :: (I.MGraph g, I.MAddEdge g, I.MAddVertex g, Ord nl)
             => (forall s . ST s (g (ST s)))
             -> [(nl, nl)]
             -> (VertexLabeledGraph (I.ImmutableGraph g) nl, VM.VertexMap nl)
fromEdgeList :: (forall s. ST s (g (ST s)))
-> [(nl, nl)]
-> (VertexLabeledGraph (ImmutableGraph g) nl, VertexMap nl)
fromEdgeList forall s. ST s (g (ST s))
con [(nl, nl)]
es = (forall s.
 ST s (VertexLabeledGraph (ImmutableGraph g) nl, VertexMap nl))
-> (VertexLabeledGraph (ImmutableGraph g) nl, VertexMap nl)
forall a. (forall s. ST s a) -> a
runST ((forall s.
  ST s (VertexLabeledGraph (ImmutableGraph g) nl, VertexMap nl))
 -> (VertexLabeledGraph (ImmutableGraph g) nl, VertexMap nl))
-> (forall s.
    ST s (VertexLabeledGraph (ImmutableGraph g) nl, VertexMap nl))
-> (VertexLabeledGraph (ImmutableGraph g) nl, VertexMap nl)
forall a b. (a -> b) -> a -> b
$ do
  VertexLabeledMGraph g nl (ST s)
g <- ST s (g (ST s)) -> ST s (VertexLabeledMGraph g nl (ST s))
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, PrimMonad m, MonadRef m) =>
m (g m) -> m (VertexLabeledMGraph g nl m)
newVertexLabeledGraph ST s (g (ST s))
forall s. ST s (g (ST s))
con
  VertexMapRef nl (ST s)
vm <- ST s (VertexMapRef nl (ST s))
forall (m :: * -> *) nl.
(PrimMonad m, MonadRef m) =>
m (VertexMapRef nl m)
VM.newVertexMapRef
  ((nl, nl) -> ST s ()) -> [(nl, nl)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (VertexLabeledMGraph g nl (ST s)
-> VertexMapRef nl (ST s) -> (nl, nl) -> ST s ()
forall (g :: (* -> *) -> *) nl (m :: * -> *).
(MAddVertex g, MAddEdge g, Ord nl, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> VertexMapRef nl m -> (nl, nl) -> m ()
fromListAddEdge VertexLabeledMGraph g nl (ST s)
g VertexMapRef nl (ST s)
vm) [(nl, nl)]
es
  VertexLabeledGraph (ImmutableGraph g) nl
g' <- VertexLabeledMGraph g nl (ST s)
-> ST s (ImmutableGraph (VertexLabeledMGraph g nl))
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m (ImmutableGraph g)
I.freeze VertexLabeledMGraph g nl (ST s)
g
  VertexMap nl
vm' <- VertexMapRef nl (ST s) -> ST s (VertexMap nl)
forall (m :: * -> *) nl.
(PrimMonad m, MonadRef m) =>
VertexMapRef nl m -> m (VertexMap nl)
VM.vertexMapFromRef VertexMapRef nl (ST s)
vm
  (VertexLabeledGraph (ImmutableGraph g) nl, VertexMap nl)
-> ST s (VertexLabeledGraph (ImmutableGraph g) nl, VertexMap nl)
forall (m :: * -> *) a. Monad m => a -> m a
return (VertexLabeledGraph (ImmutableGraph g) nl
g', VertexMap nl
vm')

fromListAddEdge :: (I.MAddVertex g, I.MAddEdge g, Ord nl, P.PrimMonad m, R.MonadRef m)
                => VertexLabeledMGraph g nl m
                -> VM.VertexMapRef nl m
                -> (nl, nl)
                -> m ()
fromListAddEdge :: VertexLabeledMGraph g nl m -> VertexMapRef nl m -> (nl, nl) -> m ()
fromListAddEdge VertexLabeledMGraph g nl m
g VertexMapRef nl m
vm (nl
src, nl
dst) = do
  Vertex
vsrc <- VertexLabeledMGraph g nl m
-> VertexMapRef (MVertexLabel (VertexLabeledMGraph g nl)) m
-> MVertexLabel (VertexLabeledMGraph g nl)
-> m Vertex
forall (g :: (* -> *) -> *) (m :: * -> *).
(MLabeledVertex g, Ord (MVertexLabel g), PrimMonad m,
 MonadRef m) =>
g m
-> VertexMapRef (MVertexLabel g) m -> MVertexLabel g -> m Vertex
VM.vertexForLabelRef VertexLabeledMGraph g nl m
g VertexMapRef nl m
VertexMapRef (MVertexLabel (VertexLabeledMGraph g nl)) m
vm nl
MVertexLabel (VertexLabeledMGraph g nl)
src
  Vertex
vdst <- VertexLabeledMGraph g nl m
-> VertexMapRef (MVertexLabel (VertexLabeledMGraph g nl)) m
-> MVertexLabel (VertexLabeledMGraph g nl)
-> m Vertex
forall (g :: (* -> *) -> *) (m :: * -> *).
(MLabeledVertex g, Ord (MVertexLabel g), PrimMonad m,
 MonadRef m) =>
g m
-> VertexMapRef (MVertexLabel g) m -> MVertexLabel g -> m Vertex
VM.vertexForLabelRef VertexLabeledMGraph g nl m
g VertexMapRef nl m
VertexMapRef (MVertexLabel (VertexLabeledMGraph g nl)) m
vm nl
MVertexLabel (VertexLabeledMGraph g nl)
dst
  Maybe Edge
_ <- VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m (Maybe Edge)
forall (g :: (* -> *) -> *) (m :: * -> *) nl.
(MGraph g, MAddEdge g, PrimMonad m, MonadRef m) =>
VertexLabeledMGraph g nl m -> Vertex -> Vertex -> m (Maybe Edge)
addEdge VertexLabeledMGraph g nl m
g Vertex
vsrc Vertex
vdst
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()