module Data.PlanarGraph.Internal where

import           Control.Monad.ST
import           Data.STRef
import qualified Data.Vector          as V (unsafeFreeze)
import qualified Data.Vector          as Vector
import           Data.Vector.Circular (CircularVector)
import qualified Data.Vector.Circular as CV
import           Data.Vector.Mutable  (STVector)
import qualified Data.Vector.Mutable  as V

-------------------------------------------------------------------------------
-- Resizeable vector

type GrowVector s v = STRef s (STVector s v)

newVector :: Int -> ST s (GrowVector s v)
newVector :: Int -> ST s (GrowVector s v)
newVector Int
n = STVector s v -> ST s (GrowVector s v)
forall a s. a -> ST s (STRef s a)
newSTRef (STVector s v -> ST s (GrowVector s v))
-> ST s (STVector s v) -> ST s (GrowVector s v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ST s (MVector (PrimState (ST s)) v)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
V.new Int
n

setVector :: GrowVector s v -> v -> ST s ()
setVector :: GrowVector s v -> v -> ST s ()
setVector GrowVector s v
ref v
val = do
  STVector s v
vec <- GrowVector s v -> ST s (STVector s v)
forall s a. STRef s a -> ST s a
readSTRef GrowVector s v
ref
  MVector (PrimState (ST s)) v -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> a -> m ()
V.set STVector s v
MVector (PrimState (ST s)) v
vec v
val

readVector :: GrowVector s v -> Int -> ST s v
readVector :: GrowVector s v -> Int -> ST s v
readVector GrowVector s v
ref Int
idx = do
  STVector s v
v <- GrowVector s v -> ST s (STVector s v)
forall s a. STRef s a -> ST s a
readSTRef GrowVector s v
ref
  MVector (PrimState (ST s)) v -> Int -> ST s v
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
V.read STVector s v
MVector (PrimState (ST s)) v
v Int
idx

writeVector :: GrowVector s v -> Int -> v -> ST s ()
writeVector :: GrowVector s v -> Int -> v -> ST s ()
writeVector GrowVector s v
ref Int
idx v
val = do
  STVector s v
v <- GrowVector s v -> ST s (STVector s v)
forall s a. STRef s a -> ST s a
readSTRef GrowVector s v
ref
  let l :: Int
l = STVector s v -> Int
forall s a. MVector s a -> Int
V.length STVector s v
v
  if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l
    then {-trace ("Growing: " ++ show (idx, l)) $ -} do
      STVector s v
v' <- MVector (PrimState (ST s)) v
-> Int -> ST s (MVector (PrimState (ST s)) v)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
V.grow STVector s v
MVector (PrimState (ST s)) v
v ((Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)
      MVector (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
V.write STVector s v
MVector (PrimState (ST s)) v
v' Int
idx v
val
      GrowVector s v -> STVector s v -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef GrowVector s v
ref STVector s v
v'
    else -- trace ("Writing: " ++ show (idx, l)) $
      MVector (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
V.write STVector s v
MVector (PrimState (ST s)) v
v Int
idx v
val

freezeVector :: GrowVector s v -> ST s (Vector.Vector v)
freezeVector :: GrowVector s v -> ST s (Vector v)
freezeVector GrowVector s v
ref = MVector s v -> ST s (Vector v)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.freeze (MVector s v -> ST s (Vector v))
-> ST s (MVector s v) -> ST s (Vector v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GrowVector s v -> ST s (MVector s v)
forall s a. STRef s a -> ST s a
readSTRef GrowVector s v
ref

unsafeFreezeVector :: GrowVector s v -> ST s (Vector.Vector v)
unsafeFreezeVector :: GrowVector s v -> ST s (Vector v)
unsafeFreezeVector GrowVector s v
ref = MVector s v -> ST s (Vector v)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.unsafeFreeze (MVector s v -> ST s (Vector v))
-> ST s (MVector s v) -> ST s (Vector v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GrowVector s v -> ST s (MVector s v)
forall s a. STRef s a -> ST s a
readSTRef GrowVector s v
ref

thawVector :: Vector.Vector v -> ST s (GrowVector s v)
thawVector :: Vector v -> ST s (GrowVector s v)
thawVector Vector v
v = STVector s v -> ST s (GrowVector s v)
forall a s. a -> ST s (STRef s a)
newSTRef (STVector s v -> ST s (GrowVector s v))
-> ST s (STVector s v) -> ST s (GrowVector s v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vector v -> ST s (MVector (PrimState (ST s)) v)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
Vector.thaw Vector v
v

unsafeThawVector :: Vector.Vector v -> ST s (GrowVector s v)
unsafeThawVector :: Vector v -> ST s (GrowVector s v)
unsafeThawVector Vector v
v = STVector s v -> ST s (GrowVector s v)
forall a s. a -> ST s (STRef s a)
newSTRef (STVector s v -> ST s (GrowVector s v))
-> ST s (STVector s v) -> ST s (GrowVector s v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vector v -> ST s (MVector (PrimState (ST s)) v)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
Vector.unsafeThaw Vector v
v


freezeCircularVector :: Int -> GrowVector s v -> ST s (CircularVector v)
freezeCircularVector :: Int -> GrowVector s v -> ST s (CircularVector v)
freezeCircularVector Int
n GrowVector s v
ref =
  (Vector v -> CircularVector v
forall a. Vector a -> CircularVector a
CV.unsafeFromVector (Vector v -> CircularVector v)
-> (Vector v -> Vector v) -> Vector v -> CircularVector v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector v -> Vector v
forall a. Int -> Vector a -> Vector a
Vector.take Int
n) (Vector v -> CircularVector v)
-> ST s (Vector v) -> ST s (CircularVector v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MVector s v -> ST s (Vector v)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze (MVector s v -> ST s (Vector v))
-> ST s (MVector s v) -> ST s (Vector v)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GrowVector s v -> ST s (MVector s v)
forall s a. STRef s a -> ST s a
readSTRef GrowVector s v
ref)


-------------------------------------------------------------------------------
-- Planar graph

type EdgeId = Int
type HalfEdgeId = Int
type VertexId = Int

-- | Numerical face identifier. Negative numbers indicate boundaries, non-negative numbers
--   are internal faces.
type FaceId = Int

-- PlanarGraphs have vertices, edges, and faces.
-- Invariant: The half-edge of a boundary vertex is interior, twin is exterior.

-- FIXME: Use STRefU ?
-- PlanarGraph with 0 vertices: No edges, no vertices, no faces.
-- PlanarGraph with 1 vertex: No edges, no interior faces.
-- PlanarGraph with 2 vertices: One edge, no interior faces.
-- PlanarGraph with 3+ vertices: Usual properties hold.
data PlanarGraph s = PlanarGraph
  { PlanarGraph s -> STRef s Int
pgNextHalfEdgeId :: !(STRef s HalfEdgeId)
  , PlanarGraph s -> STRef s Int
pgNextVertexId   :: !(STRef s VertexId)
  , PlanarGraph s -> STRef s Int
pgNextFaceId     :: !(STRef s FaceId)
  , PlanarGraph s -> STRef s Int
pgNextBoundaryId :: !(STRef s FaceId)
  , PlanarGraph s -> GrowVector s Int
pgHalfEdgeNext   :: !(GrowVector s HalfEdgeId) -- HalfEdge indexed
  , PlanarGraph s -> GrowVector s Int
pgHalfEdgePrev   :: !(GrowVector s HalfEdgeId) -- HalfEdge indexed
  , PlanarGraph s -> GrowVector s Int
pgHalfEdgeVertex :: !(GrowVector s VertexId)   -- HalfEdge indexed
  , PlanarGraph s -> GrowVector s Int
pgHalfEdgeFace   :: !(GrowVector s FaceId)     -- HalfEdge indexed
  , PlanarGraph s -> GrowVector s Int
pgVertexEdges    :: !(GrowVector s HalfEdgeId) -- Vertex indexed
  , PlanarGraph s -> GrowVector s Int
pgFaceEdges      :: !(GrowVector s HalfEdgeId) -- Face indexed
  , PlanarGraph s -> GrowVector s Int
pgBoundaryEdges  :: !(GrowVector s HalfEdgeId) -- Boundary faces
  } deriving PlanarGraph s -> PlanarGraph s -> Bool
(PlanarGraph s -> PlanarGraph s -> Bool)
-> (PlanarGraph s -> PlanarGraph s -> Bool) -> Eq (PlanarGraph s)
forall s. PlanarGraph s -> PlanarGraph s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlanarGraph s -> PlanarGraph s -> Bool
$c/= :: forall s. PlanarGraph s -> PlanarGraph s -> Bool
== :: PlanarGraph s -> PlanarGraph s -> Bool
$c== :: forall s. PlanarGraph s -> PlanarGraph s -> Bool
Eq