{-# LANGUAGE TypeFamilies, PatternGuards, RankNTypes #-}
-- | This internal module implements code shared between all of the
-- adapter interfaces.  The adapters add support for vertex and edge
-- labels without modifications to the underlying graph.  Any graph
-- implementing the 'MGraph' interface can have labels added with
-- these adapters.
--
-- Analogous adapters will be added for the pure graph interface, too.
module Data.Graph.Haggle.Internal.Adapter (
  -- * Types
  LabeledMGraph(..),
  LabeledGraph(..),
  -- * Mutable graph API
  newLabeledGraph,
  newSizedLabeledGraph,
  -- * Immutable graph API
  mapVertexLabel,
  mapEdgeLabel,
  fromLabeledEdgeList,
  -- * Helpers
  ensureEdgeLabelStorage,
  ensureNodeLabelStorage,
  unsafeGetEdgeLabel
  ) where

import qualified Control.DeepSeq as DS
import Control.Monad ( liftM )
import qualified Control.Monad.Primitive as P
import qualified Control.Monad.Ref as R
import Control.Monad.ST ( ST, runST )
import Data.Vector ( Vector )
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import qualified Data.Graph.Haggle.Classes as I
import qualified Data.Graph.Haggle.VertexMap as VM
import qualified Data.Graph.Haggle.Internal.Basic as I

-- | An adapter adding support for both vertex and edge labels for mutable
-- graphs.
data LabeledMGraph g nl el m =
  LMG { LabeledMGraph g nl el m -> g m
rawMGraph :: g m
      , LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
nodeLabelStorage :: R.Ref m (MV.MVector (P.PrimState m) nl)
      , LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) el)
edgeLabelStorage :: R.Ref m (MV.MVector (P.PrimState m) el)
      }

-- | An adapter adding support for both vertex and edge labels for immutable
-- graphs.
data LabeledGraph g nl el =
  LG { LabeledGraph g nl el -> g
rawGraph :: g
     , LabeledGraph g nl el -> Vector nl
nodeLabelStore :: Vector nl
     , LabeledGraph g nl el -> Vector el
edgeLabelStore :: Vector el
     }

instance (DS.NFData g, DS.NFData nl, DS.NFData el) => DS.NFData (LabeledGraph g nl el) where
  rnf :: LabeledGraph g nl el -> ()
rnf LabeledGraph g nl el
gr = LabeledGraph g nl el -> g
forall g nl el. LabeledGraph g nl el -> g
rawGraph LabeledGraph g nl el
gr g -> Vector nl -> Vector nl
forall a b. NFData a => a -> b -> b
`DS.deepseq` LabeledGraph g nl el -> Vector nl
forall g nl el. LabeledGraph g nl el -> Vector nl
nodeLabelStore LabeledGraph g nl el
gr Vector nl -> Vector el -> Vector el
forall a b. NFData a => a -> b -> b
`DS.deepseq` LabeledGraph g nl el -> Vector el
forall g nl el. LabeledGraph g nl el -> Vector el
edgeLabelStore LabeledGraph g nl el
gr Vector el -> () -> ()
forall a b. NFData a => a -> b -> b
`DS.deepseq` ()

newLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
                => m (g m)
                -> m (LabeledMGraph g nl el m)
newLabeledGraph :: m (g m) -> m (LabeledMGraph g nl el m)
newLabeledGraph m (g m)
newG = do
  g m
g <- m (g m)
newG
  MVector (PrimState m) nl
nstore <- Int -> m (MVector (PrimState m) nl)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
128
  Ref m (MVector (PrimState m) nl)
nref <- MVector (PrimState m) nl -> m (Ref m (MVector (PrimState m) nl))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) nl
nstore
  MVector (PrimState m) el
estore <- Int -> m (MVector (PrimState m) el)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
128
  Ref m (MVector (PrimState m) el)
eref <- MVector (PrimState m) el -> m (Ref m (MVector (PrimState m) el))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) el
estore
  LabeledMGraph g nl el m -> m (LabeledMGraph g nl el m)
forall (m :: * -> *) a. Monad m => a -> m a
return LMG :: forall (g :: (* -> *) -> *) nl el (m :: * -> *).
g m
-> Ref m (MVector (PrimState m) nl)
-> Ref m (MVector (PrimState m) el)
-> LabeledMGraph g nl el m
LMG { rawMGraph :: g m
rawMGraph = g m
g
             , nodeLabelStorage :: Ref m (MVector (PrimState m) nl)
nodeLabelStorage = Ref m (MVector (PrimState m) nl)
nref
             , edgeLabelStorage :: Ref m (MVector (PrimState m) el)
edgeLabelStorage = Ref m (MVector (PrimState m) el)
eref
             }

newSizedLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
                     => (Int -> Int -> m (g m))
                     -> Int
                     -> Int
                     -> m (LabeledMGraph g nl el m)
newSizedLabeledGraph :: (Int -> Int -> m (g m))
-> Int -> Int -> m (LabeledMGraph g nl el m)
newSizedLabeledGraph Int -> Int -> m (g m)
newG Int
szVertices Int
szEdges = do
  g m
g <- Int -> Int -> m (g m)
newG Int
szVertices Int
szEdges
  MVector (PrimState m) nl
nstore <- Int -> m (MVector (PrimState m) nl)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
szVertices
  Ref m (MVector (PrimState m) nl)
nref <- MVector (PrimState m) nl -> m (Ref m (MVector (PrimState m) nl))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) nl
nstore
  MVector (PrimState m) el
estore <- Int -> m (MVector (PrimState m) el)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
szEdges
  Ref m (MVector (PrimState m) el)
eref <- MVector (PrimState m) el -> m (Ref m (MVector (PrimState m) el))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) el
estore
  LabeledMGraph g nl el m -> m (LabeledMGraph g nl el m)
forall (m :: * -> *) a. Monad m => a -> m a
return LMG :: forall (g :: (* -> *) -> *) nl el (m :: * -> *).
g m
-> Ref m (MVector (PrimState m) nl)
-> Ref m (MVector (PrimState m) el)
-> LabeledMGraph g nl el m
LMG { rawMGraph :: g m
rawMGraph = g m
g
             , nodeLabelStorage :: Ref m (MVector (PrimState m) nl)
nodeLabelStorage = Ref m (MVector (PrimState m) nl)
nref
             , edgeLabelStorage :: Ref m (MVector (PrimState m) el)
edgeLabelStorage = Ref m (MVector (PrimState m) el)
eref
             }

addLabeledVertex :: (I.MGraph g, I.MAddVertex g, P.PrimMonad m, R.MonadRef m)
                 => LabeledMGraph g nl el m
                 -> nl
                 -> m I.Vertex
addLabeledVertex :: LabeledMGraph g nl el m -> nl -> m Vertex
addLabeledVertex LabeledMGraph g nl el m
lg nl
nl = do
  Vertex
v <- g m -> m Vertex
forall (g :: (* -> *) -> *) (m :: * -> *).
(MAddVertex g, PrimMonad m, MonadRef m) =>
g m -> m Vertex
I.addVertex (LabeledMGraph g nl el m -> g m
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> g m
rawMGraph LabeledMGraph g nl el m
lg)
  LabeledMGraph g nl el m -> m ()
forall (g :: (* -> *) -> *) (m :: * -> *) nl el.
(MGraph g, PrimMonad m, MonadRef m) =>
LabeledMGraph g nl el m -> m ()
ensureNodeLabelStorage LabeledMGraph g nl el m
lg
  MVector (PrimState m) nl
nlVec <- Ref m (MVector (PrimState m) nl) -> m (MVector (PrimState m) nl)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
nodeLabelStorage LabeledMGraph g nl el m
lg)
  MVector (PrimState m) nl -> Int -> nl -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) nl
nlVec (Vertex -> Int
I.vertexId Vertex
v) nl
nl
  Vertex -> m Vertex
forall (m :: * -> *) a. Monad m => a -> m a
return Vertex
v
--
-- getEdgeLabel :: (PrimMonad m, I.MGraph g)
--              => LabeledMGraph g nl el m
--              -> I.Edge
--              -> m (Maybe el)
-- getEdgeLabel lg e = do
--   nEs <- I.countEdges (rawMGraph lg)
--   case I.edgeId e >= nEs of
--     True -> return Nothing
--     False -> do
--       elVec <- readSTRef (edgeLabelStorage lg)
--       Just `liftM` MV.read elVec (I.edgeId e)

-- FIXME: Just implement this one and push the safe version to have the default
-- impl
unsafeGetEdgeLabel :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
                   => LabeledMGraph g nl el m
                   -> I.Edge
                   -> m el
unsafeGetEdgeLabel :: LabeledMGraph g nl el m -> Edge -> m el
unsafeGetEdgeLabel (LMG g m
_ Ref m (MVector (PrimState m) nl)
_ Ref m (MVector (PrimState m) el)
stor) (I.E Int
eid Int
_ Int
_) = do
  MVector (PrimState m) el
elVec <- Ref m (MVector (PrimState m) el) -> m (MVector (PrimState m) el)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef Ref m (MVector (PrimState m) el)
stor
  MVector (PrimState m) el -> Int -> m el
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) el
elVec Int
eid
{-# INLINE unsafeGetEdgeLabel #-}

getVertexLabel :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
               => LabeledMGraph g nl el m
               -> I.Vertex
               -> m (Maybe nl)
getVertexLabel :: LabeledMGraph g nl el m -> Vertex -> m (Maybe nl)
getVertexLabel LabeledMGraph g nl el m
lg Vertex
v = do
  Int
nNs <- g m -> m Int
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m Int
I.countVertices (LabeledMGraph g nl el m -> g m
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> g m
rawMGraph LabeledMGraph g nl el m
lg)
  case Vertex -> Int
I.vertexId Vertex
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nNs of
    Bool
True -> Maybe nl -> m (Maybe nl)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe nl
forall a. Maybe a
Nothing
    Bool
False -> do
      MVector (PrimState m) nl
nlVec <- Ref m (MVector (PrimState m) nl) -> m (MVector (PrimState m) nl)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
nodeLabelStorage LabeledMGraph g nl el m
lg)
      nl -> Maybe nl
forall a. a -> Maybe a
Just (nl -> Maybe nl) -> m nl -> m (Maybe nl)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) nl -> Int -> m nl
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.read MVector (PrimState m) nl
nlVec (Vertex -> Int
I.vertexId Vertex
v)

addLabeledEdge :: (I.MGraph g, I.MAddEdge g, P.PrimMonad m, R.MonadRef m)
               => LabeledMGraph g nl el m
               -> I.Vertex
               -> I.Vertex
               -> el
               -> m (Maybe I.Edge)
addLabeledEdge :: LabeledMGraph g nl el m -> Vertex -> Vertex -> el -> m (Maybe Edge)
addLabeledEdge LabeledMGraph g nl el m
lg Vertex
src Vertex
dst el
el = do
  Maybe Edge
e <- 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 el m -> g m
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> g m
rawMGraph LabeledMGraph g nl el m
lg) Vertex
src Vertex
dst
  case Maybe Edge
e of
    Maybe Edge
Nothing -> Maybe Edge -> m (Maybe Edge)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Edge
e
    Just Edge
e' -> do
      LabeledMGraph g nl el m -> m ()
forall (g :: (* -> *) -> *) (m :: * -> *) nl el.
(MGraph g, PrimMonad m, MonadRef m) =>
LabeledMGraph g nl el m -> m ()
ensureEdgeLabelStorage LabeledMGraph g nl el m
lg
      MVector (PrimState m) el
elVec <- Ref m (MVector (PrimState m) el) -> m (MVector (PrimState m) el)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) el)
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) el)
edgeLabelStorage LabeledMGraph g nl el m
lg)
      MVector (PrimState m) el -> Int -> el -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) el
elVec (Edge -> Int
I.edgeId Edge
e') el
el
      Maybe Edge -> m (Maybe Edge)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Edge
e

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

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

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

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

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

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

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

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

freeze :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
       => LabeledMGraph g nl el m
       -> m (LabeledGraph (I.ImmutableGraph g) nl el)
freeze :: LabeledMGraph g nl el m
-> m (LabeledGraph (ImmutableGraph g) nl el)
freeze LabeledMGraph g nl el m
lg = do
  ImmutableGraph g
g' <- g m -> m (ImmutableGraph g)
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m (ImmutableGraph g)
I.freeze (LabeledMGraph g nl el m -> g m
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> g m
rawMGraph LabeledMGraph g nl el m
lg)
  Int
nc <- g m -> m Int
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m Int
I.countVertices (LabeledMGraph g nl el m -> g m
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> g m
rawMGraph LabeledMGraph g nl el m
lg)
  Int
ec <- g m -> m Int
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m Int
I.countEdges (LabeledMGraph g nl el m -> g m
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> g m
rawMGraph LabeledMGraph g nl el m
lg)
  MVector (PrimState m) nl
ns <- Ref m (MVector (PrimState m) nl) -> m (MVector (PrimState m) nl)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
nodeLabelStorage LabeledMGraph g nl el m
lg)
  MVector (PrimState m) el
es <- Ref m (MVector (PrimState m) el) -> m (MVector (PrimState m) el)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) el)
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) el)
edgeLabelStorage LabeledMGraph g nl el m
lg)
  Vector nl
ns' <- MVector (PrimState m) nl -> m (Vector nl)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze (Int -> MVector (PrimState m) nl -> MVector (PrimState m) nl
forall s a. Int -> MVector s a -> MVector s a
MV.take Int
nc MVector (PrimState m) nl
ns)
  Vector el
es' <- MVector (PrimState m) el -> m (Vector el)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze (Int -> MVector (PrimState m) el -> MVector (PrimState m) el
forall s a. Int -> MVector s a -> MVector s a
MV.take Int
ec MVector (PrimState m) el
es)
  LabeledGraph (ImmutableGraph g) nl el
-> m (LabeledGraph (ImmutableGraph g) nl el)
forall (m :: * -> *) a. Monad m => a -> m a
return LG :: forall g nl el. g -> Vector nl -> Vector el -> LabeledGraph g nl el
LG { rawGraph :: ImmutableGraph g
rawGraph = ImmutableGraph g
g'
            , nodeLabelStore :: Vector nl
nodeLabelStore = Vector nl
ns'
            , edgeLabelStore :: Vector el
edgeLabelStore = Vector el
es'
            }

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

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

instance (I.MAddEdge g) => I.MLabeledEdge (LabeledMGraph g nl el) where
  type MEdgeLabel (LabeledMGraph g nl el) = el
  -- getEdgeLabel = getEdgeLabel
  unsafeGetEdgeLabel :: LabeledMGraph g nl el m
-> Edge -> m (MEdgeLabel (LabeledMGraph g nl el))
unsafeGetEdgeLabel = LabeledMGraph g nl el m
-> Edge -> m (MEdgeLabel (LabeledMGraph g nl el))
forall (g :: (* -> *) -> *) (m :: * -> *) nl el.
(MGraph g, PrimMonad m, MonadRef m) =>
LabeledMGraph g nl el m -> Edge -> m el
unsafeGetEdgeLabel
  addLabeledEdge :: LabeledMGraph g nl el m
-> Vertex
-> Vertex
-> MEdgeLabel (LabeledMGraph g nl el)
-> m (Maybe Edge)
addLabeledEdge = LabeledMGraph g nl el m
-> Vertex
-> Vertex
-> MEdgeLabel (LabeledMGraph g nl el)
-> m (Maybe Edge)
forall (g :: (* -> *) -> *) (m :: * -> *) nl el.
(MGraph g, MAddEdge g, PrimMonad m, MonadRef m) =>
LabeledMGraph g nl el m -> Vertex -> Vertex -> el -> m (Maybe Edge)
addLabeledEdge

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

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

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

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

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

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

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

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

thaw :: (I.Thawable g, P.PrimMonad m, R.MonadRef m)
     => LabeledGraph g nl el
     -> m (LabeledMGraph (I.MutableGraph g) nl el m)
thaw :: LabeledGraph g nl el -> m (LabeledMGraph (MutableGraph g) nl el m)
thaw LabeledGraph g nl el
lg = do
  MutableGraph g m
g' <- g -> m (MutableGraph g m)
forall g (m :: * -> *).
(Thawable g, PrimMonad m, MonadRef m) =>
g -> m (MutableGraph g m)
I.thaw (LabeledGraph g nl el -> g
forall g nl el. LabeledGraph g nl el -> g
rawGraph LabeledGraph g nl el
lg)
  MVector (PrimState m) nl
nlVec <- Vector nl -> m (MVector (PrimState m) nl)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw (LabeledGraph g nl el -> Vector nl
forall g nl el. LabeledGraph g nl el -> Vector nl
nodeLabelStore LabeledGraph g nl el
lg)
  MVector (PrimState m) el
elVec <- Vector el -> m (MVector (PrimState m) el)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw (LabeledGraph g nl el -> Vector el
forall g nl el. LabeledGraph g nl el -> Vector el
edgeLabelStore LabeledGraph g nl el
lg)
  Ref m (MVector (PrimState m) nl)
nref <- MVector (PrimState m) nl -> m (Ref m (MVector (PrimState m) nl))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) nl
nlVec
  Ref m (MVector (PrimState m) el)
eref <- MVector (PrimState m) el -> m (Ref m (MVector (PrimState m) el))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) el
elVec
  LabeledMGraph (MutableGraph g) nl el m
-> m (LabeledMGraph (MutableGraph g) nl el m)
forall (m :: * -> *) a. Monad m => a -> m a
return LMG :: forall (g :: (* -> *) -> *) nl el (m :: * -> *).
g m
-> Ref m (MVector (PrimState m) nl)
-> Ref m (MVector (PrimState m) el)
-> LabeledMGraph g nl el m
LMG { rawMGraph :: MutableGraph g m
rawMGraph = MutableGraph g m
g'
             , nodeLabelStorage :: Ref m (MVector (PrimState m) nl)
nodeLabelStorage = Ref m (MVector (PrimState m) nl)
nref
             , edgeLabelStorage :: Ref m (MVector (PrimState m) el)
edgeLabelStorage = Ref m (MVector (PrimState m) el)
eref
             }

instance (I.Thawable g) => I.Thawable (LabeledGraph g nl el) where
  type MutableGraph (LabeledGraph g nl el) = LabeledMGraph (I.MutableGraph g) nl el
  thaw :: LabeledGraph g nl el -> m (MutableGraph (LabeledGraph g nl el) m)
thaw = LabeledGraph g nl el -> m (MutableGraph (LabeledGraph g nl el) m)
forall g (m :: * -> *) nl el.
(Thawable g, PrimMonad m, MonadRef m) =>
LabeledGraph g nl el -> m (LabeledMGraph (MutableGraph g) nl el m)
thaw

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

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

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

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

instance (I.Bidirectional g) => I.BidirectionalEdgeLabel (LabeledGraph g nl el)

edgeLabel :: LabeledGraph g nl el -> I.Edge -> Maybe el
edgeLabel :: LabeledGraph g nl el -> Edge -> Maybe el
edgeLabel LabeledGraph g nl el
lg Edge
e = LabeledGraph g nl el -> Vector el
forall g nl el. LabeledGraph g nl el -> Vector el
edgeLabelStore LabeledGraph g nl el
lg Vector el -> Int -> Maybe el
forall a. Vector a -> Int -> Maybe a
V.!? Edge -> Int
I.edgeId Edge
e
{-# INLINE edgeLabel #-}

instance (I.Graph g) => I.HasEdgeLabel (LabeledGraph g nl el) where
  type EdgeLabel (LabeledGraph g nl el) = el
  edgeLabel :: LabeledGraph g nl el
-> Edge -> Maybe (EdgeLabel (LabeledGraph g nl el))
edgeLabel = LabeledGraph g nl el
-> Edge -> Maybe (EdgeLabel (LabeledGraph g nl el))
forall g nl el. LabeledGraph g nl el -> Edge -> Maybe el
edgeLabel
  labeledEdges :: LabeledGraph g nl el -> [(Edge, EdgeLabel (LabeledGraph g nl el))]
labeledEdges = LabeledGraph g nl el -> [(Edge, EdgeLabel (LabeledGraph g nl el))]
forall g nl el. Graph g => LabeledGraph g nl el -> [(Edge, el)]
labeledEdges

vertexLabel :: LabeledGraph g nl el -> I.Vertex -> Maybe nl
vertexLabel :: LabeledGraph g nl el -> Vertex -> Maybe nl
vertexLabel LabeledGraph g nl el
lg Vertex
v = LabeledGraph g nl el -> Vector nl
forall g nl el. LabeledGraph g nl el -> Vector nl
nodeLabelStore LabeledGraph g nl el
lg Vector nl -> Int -> Maybe nl
forall a. Vector a -> Int -> Maybe a
V.!? Vertex -> Int
I.vertexId Vertex
v
{-# INLINE vertexLabel #-}

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

-- | Note that we are not just using the @nodeLabelStore@ directly.  In
-- graphs that support vertex removal, we do not want to include removed
-- vertices, so we go through the public accessor.  This is slower but easier
-- to see as correct.
labeledVertices :: (I.Graph g) => LabeledGraph g nl el -> [(I.Vertex, nl)]
labeledVertices :: LabeledGraph g nl el -> [(Vertex, nl)]
labeledVertices LabeledGraph g nl el
g = (Vertex -> (Vertex, nl)) -> [Vertex] -> [(Vertex, nl)]
forall a b. (a -> b) -> [a] -> [b]
map Vertex -> (Vertex, nl)
toLabVert ([Vertex] -> [(Vertex, nl)]) -> [Vertex] -> [(Vertex, nl)]
forall a b. (a -> b) -> a -> b
$ g -> [Vertex]
forall g. Graph g => g -> [Vertex]
I.vertices (LabeledGraph g nl el -> g
forall g nl el. LabeledGraph g nl el -> g
rawGraph LabeledGraph g nl el
g)
  where
    toLabVert :: Vertex -> (Vertex, nl)
toLabVert Vertex
v =
      let Just nl
lab = LabeledGraph g nl el -> Vertex -> Maybe nl
forall g nl el. LabeledGraph g nl el -> Vertex -> Maybe nl
vertexLabel LabeledGraph g nl el
g Vertex
v
      in (Vertex
v, nl
lab)

-- | Likewise, we use 'edges' here instead of directly reading from the edge
-- label storage array.
labeledEdges :: (I.Graph g) => LabeledGraph g nl el -> [(I.Edge, el)]
labeledEdges :: LabeledGraph g nl el -> [(Edge, el)]
labeledEdges LabeledGraph g nl el
g = (Edge -> (Edge, el)) -> [Edge] -> [(Edge, el)]
forall a b. (a -> b) -> [a] -> [b]
map Edge -> (Edge, el)
toLabEdge ([Edge] -> [(Edge, el)]) -> [Edge] -> [(Edge, el)]
forall a b. (a -> b) -> a -> b
$ g -> [Edge]
forall g. Graph g => g -> [Edge]
I.edges (LabeledGraph g nl el -> g
forall g nl el. LabeledGraph g nl el -> g
rawGraph LabeledGraph g nl el
g)
  where
    toLabEdge :: Edge -> (Edge, el)
toLabEdge Edge
e =
      let Just el
lab = LabeledGraph g nl el -> Edge -> Maybe el
forall g nl el. LabeledGraph g nl el -> Edge -> Maybe el
edgeLabel LabeledGraph g nl el
g Edge
e
      in (Edge
e, el
lab)

mapEdgeLabel :: LabeledGraph g nl el -> (el -> el') -> LabeledGraph g nl el'
mapEdgeLabel :: LabeledGraph g nl el -> (el -> el') -> LabeledGraph g nl el'
mapEdgeLabel LabeledGraph g nl el
g el -> el'
f = LabeledGraph g nl el
g { edgeLabelStore :: Vector el'
edgeLabelStore = (el -> el') -> Vector el -> Vector el'
forall a b. (a -> b) -> Vector a -> Vector b
V.map el -> el'
f (LabeledGraph g nl el -> Vector el
forall g nl el. LabeledGraph g nl el -> Vector el
edgeLabelStore LabeledGraph g nl el
g) }

mapVertexLabel :: LabeledGraph g nl el -> (nl -> nl') -> LabeledGraph g nl' el
mapVertexLabel :: LabeledGraph g nl el -> (nl -> nl') -> LabeledGraph g nl' el
mapVertexLabel LabeledGraph g nl el
g nl -> nl'
f = LabeledGraph g nl el
g { nodeLabelStore :: Vector nl'
nodeLabelStore = (nl -> nl') -> Vector nl -> Vector nl'
forall a b. (a -> b) -> Vector a -> Vector b
V.map nl -> nl'
f (LabeledGraph g nl el -> Vector nl
forall g nl el. LabeledGraph g nl el -> Vector nl
nodeLabelStore LabeledGraph g nl el
g) }

-- | Construct a graph from a labeled list of edges.  The node endpoint values
-- are used as vertex labels, and the last element of the triple is used as an
-- edge label.
fromLabeledEdgeList :: (Ord nl, I.MGraph g, I.MAddVertex g, I.MAddEdge g)
                    => (forall s . ST s (g (ST s)))
                    -> [(nl, nl, el)]
                    -> (LabeledGraph (I.ImmutableGraph g) nl el, VM.VertexMap nl)
fromLabeledEdgeList :: (forall s. ST s (g (ST s)))
-> [(nl, nl, el)]
-> (LabeledGraph (ImmutableGraph g) nl el, VertexMap nl)
fromLabeledEdgeList forall s. ST s (g (ST s))
con [(nl, nl, el)]
es = (forall s.
 ST s (LabeledGraph (ImmutableGraph g) nl el, VertexMap nl))
-> (LabeledGraph (ImmutableGraph g) nl el, VertexMap nl)
forall a. (forall s. ST s a) -> a
runST ((forall s.
  ST s (LabeledGraph (ImmutableGraph g) nl el, VertexMap nl))
 -> (LabeledGraph (ImmutableGraph g) nl el, VertexMap nl))
-> (forall s.
    ST s (LabeledGraph (ImmutableGraph g) nl el, VertexMap nl))
-> (LabeledGraph (ImmutableGraph g) nl el, VertexMap nl)
forall a b. (a -> b) -> a -> b
$ do
  LabeledMGraph g nl el (ST s)
g <- ST s (g (ST s)) -> ST s (LabeledMGraph g nl el (ST s))
forall (g :: (* -> *) -> *) (m :: * -> *) nl el.
(MGraph g, PrimMonad m, MonadRef m) =>
m (g m) -> m (LabeledMGraph g nl el m)
newLabeledGraph 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, el) -> ST s ()) -> [(nl, nl, el)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LabeledMGraph g nl el (ST s)
-> VertexMapRef nl (ST s) -> (nl, nl, el) -> ST s ()
forall (g :: (* -> *) -> *) nl (m :: * -> *) el.
(MAddVertex g, MAddEdge g, Ord nl, PrimMonad m, MonadRef m) =>
LabeledMGraph g nl el m
-> VertexMapRef nl m -> (nl, nl, el) -> m ()
fromListAddEdge LabeledMGraph g nl el (ST s)
g VertexMapRef nl (ST s)
vm) [(nl, nl, el)]
es
  LabeledGraph (ImmutableGraph g) nl el
g' <- LabeledMGraph g nl el (ST s)
-> ST s (ImmutableGraph (LabeledMGraph g nl el))
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m (ImmutableGraph g)
I.freeze LabeledMGraph g nl el (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
  (LabeledGraph (ImmutableGraph g) nl el, VertexMap nl)
-> ST s (LabeledGraph (ImmutableGraph g) nl el, VertexMap nl)
forall (m :: * -> *) a. Monad m => a -> m a
return (LabeledGraph (ImmutableGraph g) nl el
g', VertexMap nl
vm')

fromListAddEdge :: (I.MAddVertex g, I.MAddEdge g, Ord nl, P.PrimMonad m, R.MonadRef m)
                => LabeledMGraph g nl el m
                -> VM.VertexMapRef nl m
                -> (nl, nl, el)
                -> m ()
fromListAddEdge :: LabeledMGraph g nl el m
-> VertexMapRef nl m -> (nl, nl, el) -> m ()
fromListAddEdge LabeledMGraph g nl el m
g VertexMapRef nl m
vm (nl
src, nl
dst, el
lbl) = do
  Vertex
vsrc <- LabeledMGraph g nl el m
-> VertexMapRef (MVertexLabel (LabeledMGraph g nl el)) m
-> MVertexLabel (LabeledMGraph g nl el)
-> 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 LabeledMGraph g nl el m
g VertexMapRef nl m
VertexMapRef (MVertexLabel (LabeledMGraph g nl el)) m
vm nl
MVertexLabel (LabeledMGraph g nl el)
src
  Vertex
vdst <- LabeledMGraph g nl el m
-> VertexMapRef (MVertexLabel (LabeledMGraph g nl el)) m
-> MVertexLabel (LabeledMGraph g nl el)
-> 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 LabeledMGraph g nl el m
g VertexMapRef nl m
VertexMapRef (MVertexLabel (LabeledMGraph g nl el)) m
vm nl
MVertexLabel (LabeledMGraph g nl el)
dst
  Maybe Edge
_ <- LabeledMGraph g nl el m -> Vertex -> Vertex -> el -> m (Maybe Edge)
forall (g :: (* -> *) -> *) (m :: * -> *) nl el.
(MGraph g, MAddEdge g, PrimMonad m, MonadRef m) =>
LabeledMGraph g nl el m -> Vertex -> Vertex -> el -> m (Maybe Edge)
addLabeledEdge LabeledMGraph g nl el m
g Vertex
vsrc Vertex
vdst el
lbl
  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Helpers

ensureEdgeLabelStorage :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
                       => LabeledMGraph g nl el m -> m ()
ensureEdgeLabelStorage :: LabeledMGraph g nl el m -> m ()
ensureEdgeLabelStorage LabeledMGraph g nl el m
lg = do
  MVector (PrimState m) el
elVec <- Ref m (MVector (PrimState m) el) -> m (MVector (PrimState m) el)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) el)
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) el)
edgeLabelStorage LabeledMGraph g nl el m
lg)
  Int
edgeCount <- g m -> m Int
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m Int
I.countEdges (LabeledMGraph g nl el m -> g m
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> g m
rawMGraph LabeledMGraph g nl el m
lg)
  let cap :: Int
cap = MVector (PrimState m) el -> Int
forall s a. MVector s a -> Int
MV.length MVector (PrimState m) el
elVec
  case Int
cap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
edgeCount of
    Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Bool
False -> do
      MVector (PrimState m) el
elVec' <- MVector (PrimState m) el -> Int -> m (MVector (PrimState m) el)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MV.grow MVector (PrimState m) el
elVec Int
cap
      Ref m (MVector (PrimState m) el)
-> MVector (PrimState m) el -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
R.writeRef (LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) el)
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) el)
edgeLabelStorage LabeledMGraph g nl el m
lg) MVector (PrimState m) el
elVec'

ensureNodeLabelStorage :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
                       => LabeledMGraph g nl el m -> m ()
ensureNodeLabelStorage :: LabeledMGraph g nl el m -> m ()
ensureNodeLabelStorage LabeledMGraph g nl el m
lg = do
  MVector (PrimState m) nl
nlVec <- Ref m (MVector (PrimState m) nl) -> m (MVector (PrimState m) nl)
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
nodeLabelStorage LabeledMGraph g nl el m
lg)
  Int
vertCount <- g m -> m Int
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> m Int
I.countVertices (LabeledMGraph g nl el m -> g m
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> g m
rawMGraph LabeledMGraph g nl el m
lg)
  let cap :: Int
cap = MVector (PrimState m) nl -> Int
forall s a. MVector s a -> Int
MV.length MVector (PrimState m) nl
nlVec
  case Int
cap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
vertCount of
    Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Bool
False -> do
      MVector (PrimState m) nl
nlVec' <- MVector (PrimState m) nl -> Int -> m (MVector (PrimState m) nl)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MV.grow MVector (PrimState m) nl
nlVec Int
cap
      Ref m (MVector (PrimState m) nl)
-> MVector (PrimState m) nl -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
R.writeRef (LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
forall (g :: (* -> *) -> *) nl el (m :: * -> *).
LabeledMGraph g nl el m -> Ref m (MVector (PrimState m) nl)
nodeLabelStorage LabeledMGraph g nl el m
lg) MVector (PrimState m) nl
nlVec'