{-# LANGUAGE TypeFamilies #-}
-- | This is a simple graph (it does not allow parallel edges).  To support
-- this efficiently, it is less compact than 'Digraph' or 'BiDigraph'.  As
-- a consequence, edge existence tests are efficient (logarithmic in the
-- number of edges leaving the source vertex).
module Data.Graph.Haggle.SimpleBiDigraph (
  MSimpleBiDigraph,
  SimpleBiDigraph,
  newMSimpleBiDigraph,
  newSizedMSimpleBiDigraph
  ) where

import qualified Control.DeepSeq as DS
import Control.Monad ( when )
import qualified Control.Monad.Primitive as P
import qualified Control.Monad.Ref as R
import Data.Foldable ( toList )
import Data.IntMap ( IntMap )
import qualified Data.IntMap as IM
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector as V

import Data.Graph.Haggle.Classes
import Data.Graph.Haggle.Internal.Basic

data MSimpleBiDigraph m = -- See Note [Graph Representation]
  MBiDigraph { MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount :: R.Ref m Int
             , MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount :: R.Ref m Int
             , MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds :: R.Ref m (MV.MVector (P.PrimState m) (IntMap Edge))
             , MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs :: R.Ref m (MV.MVector (P.PrimState m) (IntMap Edge))
             }

data SimpleBiDigraph =
  BiDigraph { SimpleBiDigraph -> Int
vertexCount :: {-# UNPACK #-} !Int
            , SimpleBiDigraph -> Int
edgeCount :: {-# UNPACK #-} !Int
            , SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds :: V.Vector (IntMap Edge)
            , SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs :: V.Vector (IntMap Edge)
            }

instance DS.NFData SimpleBiDigraph where
  rnf :: SimpleBiDigraph -> ()
rnf SimpleBiDigraph
bdg = SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds SimpleBiDigraph
bdg Vector (IntMap Edge)
-> Vector (IntMap Edge) -> Vector (IntMap Edge)
forall a b. NFData a => a -> b -> b
`DS.deepseq` SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
bdg Vector (IntMap Edge) -> () -> ()
forall a b. NFData a => a -> b -> b
`DS.deepseq` ()

defaultSize :: Int
defaultSize :: Int
defaultSize = Int
128

newMSimpleBiDigraph :: (P.PrimMonad m, R.MonadRef m) => m (MSimpleBiDigraph m)
newMSimpleBiDigraph :: m (MSimpleBiDigraph m)
newMSimpleBiDigraph = Int -> Int -> m (MSimpleBiDigraph m)
forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
Int -> Int -> m (MSimpleBiDigraph m)
newSizedMSimpleBiDigraph Int
defaultSize Int
0

newSizedMSimpleBiDigraph :: (P.PrimMonad m, R.MonadRef m) => Int -> Int -> m (MSimpleBiDigraph m)
newSizedMSimpleBiDigraph :: Int -> Int -> m (MSimpleBiDigraph m)
newSizedMSimpleBiDigraph Int
szNodes Int
_ = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
szNodes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Negative size (newSized)"
  Ref m Int
nn <- Int -> m (Ref m Int)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef Int
0
  Ref m Int
en <- Int -> m (Ref m Int)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef Int
0
  MVector (PrimState m) (IntMap Edge)
pvec <- Int -> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
szNodes
  MVector (PrimState m) (IntMap Edge)
svec <- Int -> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
szNodes
  Ref m (MVector (PrimState m) (IntMap Edge))
pref <- MVector (PrimState m) (IntMap Edge)
-> m (Ref m (MVector (PrimState m) (IntMap Edge)))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) (IntMap Edge)
pvec
  Ref m (MVector (PrimState m) (IntMap Edge))
sref <- MVector (PrimState m) (IntMap Edge)
-> m (Ref m (MVector (PrimState m) (IntMap Edge)))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) (IntMap Edge)
svec
  MSimpleBiDigraph m -> m (MSimpleBiDigraph m)
forall (m :: * -> *) a. Monad m => a -> m a
return (MSimpleBiDigraph m -> m (MSimpleBiDigraph m))
-> MSimpleBiDigraph m -> m (MSimpleBiDigraph m)
forall a b. (a -> b) -> a -> b
$! MBiDigraph :: forall (m :: * -> *).
Ref m Int
-> Ref m Int
-> Ref m (MVector (PrimState m) (IntMap Edge))
-> Ref m (MVector (PrimState m) (IntMap Edge))
-> MSimpleBiDigraph m
MBiDigraph { mgraphVertexCount :: Ref m Int
mgraphVertexCount = Ref m Int
nn
                       , mgraphEdgeCount :: Ref m Int
mgraphEdgeCount = Ref m Int
en
                       , mgraphPreds :: Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds = Ref m (MVector (PrimState m) (IntMap Edge))
pref
                       , mgraphSuccs :: Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs = Ref m (MVector (PrimState m) (IntMap Edge))
sref
                       }

instance MGraph MSimpleBiDigraph where
  type ImmutableGraph MSimpleBiDigraph = SimpleBiDigraph
  getVertices :: MSimpleBiDigraph m -> m [Vertex]
getVertices MSimpleBiDigraph m
g = do
    Int
nVerts <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    [Vertex] -> m [Vertex]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> Vertex
V Int
v | Int
v <- [Int
0..Int
nVerts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

  getOutEdges :: MSimpleBiDigraph m -> Vertex -> m [Edge]
getOutEdges MSimpleBiDigraph m
g (V Int
src) = do
    Int
nVerts <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    case Int
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nVerts of
      Bool
True -> [Edge] -> m [Edge]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      Bool
False -> do
        MVector (PrimState m) (IntMap Edge)
svec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph m
g)
        IntMap Edge
succs <- MVector (PrimState m) (IntMap Edge) -> Int -> m (IntMap Edge)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap Edge)
svec Int
src
        [Edge] -> m [Edge]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Edge] -> m [Edge]) -> [Edge] -> m [Edge]
forall a b. (a -> b) -> a -> b
$ IntMap Edge -> [Edge]
forall a. IntMap a -> [a]
IM.elems IntMap Edge
succs

  countVertices :: MSimpleBiDigraph m -> m Int
countVertices = Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (Ref m Int -> m Int)
-> (MSimpleBiDigraph m -> Ref m Int) -> MSimpleBiDigraph m -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount
  countEdges :: MSimpleBiDigraph m -> m Int
countEdges = Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (Ref m Int -> m Int)
-> (MSimpleBiDigraph m -> Ref m Int) -> MSimpleBiDigraph m -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount

  getSuccessors :: MSimpleBiDigraph m -> Vertex -> m [Vertex]
getSuccessors MSimpleBiDigraph m
g (V Int
src) = do
    Int
nVerts <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    case Int
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nVerts of
      Bool
True -> [Vertex] -> m [Vertex]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      Bool
False -> do
        MVector (PrimState m) (IntMap Edge)
svec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph m
g)
        IntMap Edge
succs <- MVector (PrimState m) (IntMap Edge) -> Int -> m (IntMap Edge)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap Edge)
svec Int
src
        [Vertex] -> m [Vertex]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Vertex] -> m [Vertex]) -> [Vertex] -> m [Vertex]
forall a b. (a -> b) -> a -> b
$ (Int -> Vertex) -> [Int] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V ([Int] -> [Vertex]) -> [Int] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ IntMap Edge -> [Int]
forall a. IntMap a -> [Int]
IM.keys IntMap Edge
succs

  checkEdgeExists :: MSimpleBiDigraph m -> Vertex -> Vertex -> m Bool
checkEdgeExists MSimpleBiDigraph m
g (V Int
src) (V Int
dst) = do
    Int
nVerts <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    case Int
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nVerts Bool -> Bool -> Bool
|| Int
dst Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nVerts of
      Bool
True -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      Bool
False -> do
        MVector (PrimState m) (IntMap Edge)
svec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph m
g)
        IntMap Edge
succs <- MVector (PrimState m) (IntMap Edge) -> Int -> m (IntMap Edge)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap Edge)
svec Int
src
        Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Edge -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
dst IntMap Edge
succs

  freeze :: MSimpleBiDigraph m -> m (ImmutableGraph MSimpleBiDigraph)
freeze MSimpleBiDigraph m
g = do
    Int
nVerts <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    Int
nEdges <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount MSimpleBiDigraph m
g)
    MVector (PrimState m) (IntMap Edge)
pvec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g)
    MVector (PrimState m) (IntMap Edge)
svec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph m
g)
    Vector (IntMap Edge)
pvec' <- MVector (PrimState m) (IntMap Edge) -> m (Vector (IntMap Edge))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze (Int
-> MVector (PrimState m) (IntMap Edge)
-> MVector (PrimState m) (IntMap Edge)
forall s a. Int -> MVector s a -> MVector s a
MV.take Int
nVerts MVector (PrimState m) (IntMap Edge)
pvec)
    Vector (IntMap Edge)
svec' <- MVector (PrimState m) (IntMap Edge) -> m (Vector (IntMap Edge))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze (Int
-> MVector (PrimState m) (IntMap Edge)
-> MVector (PrimState m) (IntMap Edge)
forall s a. Int -> MVector s a -> MVector s a
MV.take Int
nVerts MVector (PrimState m) (IntMap Edge)
svec)
    SimpleBiDigraph -> m SimpleBiDigraph
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleBiDigraph -> m SimpleBiDigraph)
-> SimpleBiDigraph -> m SimpleBiDigraph
forall a b. (a -> b) -> a -> b
$! BiDigraph :: Int
-> Int
-> Vector (IntMap Edge)
-> Vector (IntMap Edge)
-> SimpleBiDigraph
BiDigraph { vertexCount :: Int
vertexCount = Int
nVerts
                        , edgeCount :: Int
edgeCount = Int
nEdges
                        , graphPreds :: Vector (IntMap Edge)
graphPreds = Vector (IntMap Edge)
pvec'
                        , graphSuccs :: Vector (IntMap Edge)
graphSuccs = Vector (IntMap Edge)
svec'
                        }

instance MAddVertex MSimpleBiDigraph where
  addVertex :: MSimpleBiDigraph m -> m Vertex
addVertex MSimpleBiDigraph m
g = do
    MSimpleBiDigraph m -> m ()
forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph m -> m ()
ensureNodeSpace MSimpleBiDigraph m
g
    Int
vid <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef Ref m Int
r
    Ref m Int -> (Int -> Int) -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> (a -> a) -> m ()
R.modifyRef' Ref m Int
r (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    MVector (PrimState m) (IntMap Edge)
pvec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g)
    MVector (PrimState m) (IntMap Edge)
svec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph m
g)
    MVector (PrimState m) (IntMap Edge) -> Int -> IntMap Edge -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) (IntMap Edge)
pvec Int
vid IntMap Edge
forall a. IntMap a
IM.empty
    MVector (PrimState m) (IntMap Edge) -> Int -> IntMap Edge -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) (IntMap Edge)
svec Int
vid IntMap Edge
forall a. IntMap a
IM.empty
    Vertex -> m Vertex
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Vertex
V Int
vid)
    where
      r :: Ref m Int
r = MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g

instance MAddEdge MSimpleBiDigraph where
  addEdge :: MSimpleBiDigraph m -> Vertex -> Vertex -> m (Maybe Edge)
addEdge MSimpleBiDigraph m
g v1 :: Vertex
v1@(V Int
src) v2 :: Vertex
v2@(V Int
dst) = do
    Int
nVerts <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    Bool
exists <- MSimpleBiDigraph m -> Vertex -> Vertex -> m Bool
forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> Vertex -> Vertex -> m Bool
checkEdgeExists MSimpleBiDigraph m
g Vertex
v1 Vertex
v2
    case Bool
exists Bool -> Bool -> Bool
|| Int
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nVerts Bool -> Bool -> Bool
|| Int
dst Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
nVerts of
      Bool
True -> Maybe Edge -> m (Maybe Edge)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Edge
forall a. Maybe a
Nothing
      Bool
False -> do
        Int
eid <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount MSimpleBiDigraph m
g)
        let e :: Edge
e = Int -> Int -> Int -> Edge
E Int
eid Int
src Int
dst
        Ref m Int -> (Int -> Int) -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> (a -> a) -> m ()
R.modifyRef' (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount MSimpleBiDigraph m
g) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

        MVector (PrimState m) (IntMap Edge)
pvec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g)
        IntMap Edge
preds <- MVector (PrimState m) (IntMap Edge) -> Int -> m (IntMap Edge)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap Edge)
pvec Int
dst
        MVector (PrimState m) (IntMap Edge) -> Int -> IntMap Edge -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector (PrimState m) (IntMap Edge)
pvec Int
dst (Int -> Edge -> IntMap Edge -> IntMap Edge
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
src Edge
e IntMap Edge
preds)

        MVector (PrimState m) (IntMap Edge)
svec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph m
g)
        IntMap Edge
succs <- MVector (PrimState m) (IntMap Edge) -> Int -> m (IntMap Edge)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap Edge)
svec Int
src
        MVector (PrimState m) (IntMap Edge) -> Int -> IntMap Edge -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector (PrimState m) (IntMap Edge)
svec Int
src (Int -> Edge -> IntMap Edge -> IntMap Edge
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
dst Edge
e IntMap Edge
succs)

        Maybe Edge -> m (Maybe Edge)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Edge -> m (Maybe Edge)) -> Maybe Edge -> m (Maybe Edge)
forall a b. (a -> b) -> a -> b
$ Edge -> Maybe Edge
forall a. a -> Maybe a
Just Edge
e

instance MBidirectional MSimpleBiDigraph where
  getPredecessors :: MSimpleBiDigraph m -> Vertex -> m [Vertex]
getPredecessors MSimpleBiDigraph m
g (V Int
vid) = do
    Int
nVerts <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    case Int
vid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nVerts of
      Bool
False -> [Vertex] -> m [Vertex]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      Bool
True -> do
        MVector (PrimState m) (IntMap Edge)
pvec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g)
        IntMap Edge
preds <- MVector (PrimState m) (IntMap Edge) -> Int -> m (IntMap Edge)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap Edge)
pvec Int
vid
        [Vertex] -> m [Vertex]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Vertex] -> m [Vertex]) -> [Vertex] -> m [Vertex]
forall a b. (a -> b) -> a -> b
$ (Int -> Vertex) -> [Int] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V ([Int] -> [Vertex]) -> [Int] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ IntMap Edge -> [Int]
forall a. IntMap a -> [Int]
IM.keys IntMap Edge
preds

  getInEdges :: MSimpleBiDigraph m -> Vertex -> m [Edge]
getInEdges MSimpleBiDigraph m
g (V Int
vid) = do
    Int
nVerts <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    case Int
vid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nVerts of
      Bool
False -> [Edge] -> m [Edge]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      Bool
True -> do
        MVector (PrimState m) (IntMap Edge)
pvec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g)
        IntMap Edge
preds <- MVector (PrimState m) (IntMap Edge) -> Int -> m (IntMap Edge)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap Edge)
pvec Int
vid
        [Edge] -> m [Edge]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Edge] -> m [Edge]) -> [Edge] -> m [Edge]
forall a b. (a -> b) -> a -> b
$ IntMap Edge -> [Edge]
forall a. IntMap a -> [a]
IM.elems IntMap Edge
preds

instance Thawable SimpleBiDigraph where
  type MutableGraph SimpleBiDigraph = MSimpleBiDigraph
  thaw :: SimpleBiDigraph -> m (MutableGraph SimpleBiDigraph m)
thaw SimpleBiDigraph
g = do
    Ref m Int
vc <- Int -> m (Ref m Int)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef (SimpleBiDigraph -> Int
vertexCount SimpleBiDigraph
g)
    Ref m Int
ec <- Int -> m (Ref m Int)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef (SimpleBiDigraph -> Int
edgeCount SimpleBiDigraph
g)
    MVector (PrimState m) (IntMap Edge)
pvec <- Vector (IntMap Edge) -> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw (SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds SimpleBiDigraph
g)
    MVector (PrimState m) (IntMap Edge)
svec <- Vector (IntMap Edge) -> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
g)
    Ref m (MVector (PrimState m) (IntMap Edge))
pref <- MVector (PrimState m) (IntMap Edge)
-> m (Ref m (MVector (PrimState m) (IntMap Edge)))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) (IntMap Edge)
pvec
    Ref m (MVector (PrimState m) (IntMap Edge))
sref <- MVector (PrimState m) (IntMap Edge)
-> m (Ref m (MVector (PrimState m) (IntMap Edge)))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) (IntMap Edge)
svec
    MSimpleBiDigraph m -> m (MSimpleBiDigraph m)
forall (m :: * -> *) a. Monad m => a -> m a
return MBiDigraph :: forall (m :: * -> *).
Ref m Int
-> Ref m Int
-> Ref m (MVector (PrimState m) (IntMap Edge))
-> Ref m (MVector (PrimState m) (IntMap Edge))
-> MSimpleBiDigraph m
MBiDigraph { mgraphVertexCount :: Ref m Int
mgraphVertexCount = Ref m Int
vc
                      , mgraphEdgeCount :: Ref m Int
mgraphEdgeCount = Ref m Int
ec
                      , mgraphPreds :: Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds = Ref m (MVector (PrimState m) (IntMap Edge))
pref
                      , mgraphSuccs :: Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs = Ref m (MVector (PrimState m) (IntMap Edge))
sref
                      }

instance Graph SimpleBiDigraph where
  -- FIXME: This will be more complicated if we support removing vertices
  vertices :: SimpleBiDigraph -> [Vertex]
vertices SimpleBiDigraph
g = (Int -> Vertex) -> [Int] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V [Int
0 .. SimpleBiDigraph -> Int
vertexCount SimpleBiDigraph
g Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  edges :: SimpleBiDigraph -> [Edge]
edges SimpleBiDigraph
g = (Vertex -> [Edge]) -> [Vertex] -> [Edge]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SimpleBiDigraph -> Vertex -> [Edge]
forall g. Graph g => g -> Vertex -> [Edge]
outEdges SimpleBiDigraph
g) (SimpleBiDigraph -> [Vertex]
forall g. Graph g => g -> [Vertex]
vertices SimpleBiDigraph
g)
  successors :: SimpleBiDigraph -> Vertex -> [Vertex]
successors SimpleBiDigraph
g (V Int
v)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
v = []
    | Bool
otherwise = (Int -> Vertex) -> [Int] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V ([Int] -> [Vertex]) -> [Int] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ IntMap Edge -> [Int]
forall a. IntMap a -> [Int]
IM.keys (IntMap Edge -> [Int]) -> IntMap Edge -> [Int]
forall a b. (a -> b) -> a -> b
$ Vector (IntMap Edge) -> Int -> IntMap Edge
forall a. Vector a -> Int -> a
V.unsafeIndex (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
g) Int
v
  outEdges :: SimpleBiDigraph -> Vertex -> [Edge]
outEdges SimpleBiDigraph
g (V Int
v)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
v = []
    | Bool
otherwise =
      let succs :: IntMap Edge
succs = Vector (IntMap Edge) -> Int -> IntMap Edge
forall a. Vector a -> Int -> a
V.unsafeIndex (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
g) Int
v
      in IntMap Edge -> [Edge]
forall a. IntMap a -> [a]
IM.elems IntMap Edge
succs
  edgesBetween :: SimpleBiDigraph -> Vertex -> Vertex -> [Edge]
edgesBetween SimpleBiDigraph
g (V Int
src) (V Int
dst)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
src Bool -> Bool -> Bool
|| SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
dst = []
    | Bool
otherwise = Maybe Edge -> [Edge]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe Edge -> [Edge]) -> Maybe Edge -> [Edge]
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Edge -> Maybe Edge
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
dst (Vector (IntMap Edge) -> Int -> IntMap Edge
forall a. Vector a -> Int -> a
V.unsafeIndex (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
g) Int
src)
  maxVertexId :: SimpleBiDigraph -> Int
maxVertexId SimpleBiDigraph
g = Vector (IntMap Edge) -> Int
forall a. Vector a -> Int
V.length (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
g) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  isEmpty :: SimpleBiDigraph -> Bool
isEmpty = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (Int -> Bool)
-> (SimpleBiDigraph -> Int) -> SimpleBiDigraph -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleBiDigraph -> Int
vertexCount


instance Bidirectional SimpleBiDigraph  where
  predecessors :: SimpleBiDigraph -> Vertex -> [Vertex]
predecessors SimpleBiDigraph
g (V Int
v)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
v = []
    | Bool
otherwise = (Int -> Vertex) -> [Int] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V ([Int] -> [Vertex]) -> [Int] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ IntMap Edge -> [Int]
forall a. IntMap a -> [Int]
IM.keys (IntMap Edge -> [Int]) -> IntMap Edge -> [Int]
forall a b. (a -> b) -> a -> b
$ Vector (IntMap Edge) -> Int -> IntMap Edge
forall a. Vector a -> Int -> a
V.unsafeIndex (SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds SimpleBiDigraph
g) Int
v
  inEdges :: SimpleBiDigraph -> Vertex -> [Edge]
inEdges SimpleBiDigraph
g (V Int
v)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
v = []
    | Bool
otherwise =
      let preds :: IntMap Edge
preds = Vector (IntMap Edge) -> Int -> IntMap Edge
forall a. Vector a -> Int -> a
V.unsafeIndex (SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds SimpleBiDigraph
g) Int
v
      in IntMap Edge -> [Edge]
forall a. IntMap a -> [a]
IM.elems IntMap Edge
preds

-- Helpers

outOfRange :: SimpleBiDigraph -> Int -> Bool
outOfRange :: SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SimpleBiDigraph -> Int
vertexCount SimpleBiDigraph
g)

-- | Given a graph, ensure that there is space in the vertex vector
-- for a new vertex.  If there is not, double the capacity.
ensureNodeSpace :: (P.PrimMonad m, R.MonadRef m) => MSimpleBiDigraph m -> m ()
ensureNodeSpace :: MSimpleBiDigraph m -> m ()
ensureNodeSpace MSimpleBiDigraph m
g = do
  MVector (PrimState m) (IntMap Edge)
pvec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g)
  MVector (PrimState m) (IntMap Edge)
svec <- Ref m (MVector (PrimState m) (IntMap Edge))
-> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph m
g)
  let cap :: Int
cap = MVector (PrimState m) (IntMap Edge) -> Int
forall s a. MVector s a -> Int
MV.length MVector (PrimState m) (IntMap Edge)
pvec
  Int
cnt <- Ref m Int -> m Int
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (MSimpleBiDigraph m -> Ref m Int
forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
  case Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cap of
    Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Bool
False -> do
      MVector (PrimState m) (IntMap Edge)
pvec' <- MVector (PrimState m) (IntMap Edge)
-> Int -> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MV.grow MVector (PrimState m) (IntMap Edge)
pvec Int
cap
      MVector (PrimState m) (IntMap Edge)
svec' <- MVector (PrimState m) (IntMap Edge)
-> Int -> m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MV.grow MVector (PrimState m) (IntMap Edge)
svec Int
cap
      Ref m (MVector (PrimState m) (IntMap Edge))
-> MVector (PrimState m) (IntMap Edge) -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
R.writeRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g) MVector (PrimState m) (IntMap Edge)
pvec'
      Ref m (MVector (PrimState m) (IntMap Edge))
-> MVector (PrimState m) (IntMap Edge) -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
R.writeRef (MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph m
g) MVector (PrimState m) (IntMap Edge)
svec'


{- Note [Graph Representation]

Each of the IntMaps in the vectors maps the edge *destination* node id to the
*edge id*.  We need to store the edge IDs to reconstruct an Edge.  Other graph
representations use the edge IDs to maintain lists, but here we don't have
that.  The destination is the key of the map for fast edgeExists tests.

-}