module Data.PlanarGraph.Mutable
  ( -- * Planar graphs
    PlanarGraph
  , pgFromFaces   -- :: [[VertexId]] -> ST s (PlanarGraph s)
  , pgFromFacesCV -- :: [CircularVector VertexId] -> ST s (PlanarGraph s)
  , pgClone       -- :: PlanarGraph s -> ST s (PlanarGraph s)
  , pgHash        -- :: PlanarGraph s -> ST s Int

    -- * Elements
    -- ** Vertices
  , Vertex, VertexId
  , vertexFromId                -- :: VertexId -> PlanarGraph s -> Vertex s
  , vertexToId                  -- :: Vertex s -> VertexId
  , vertexHalfEdge              -- :: Vertex s -> ST s (HalfEdge s)
  , vertexIsBoundary            -- :: Vertex s -> ST s Bool
  , vertexOutgoingHalfEdges     -- :: Vertex s -> ST s (CircularVector (HalfEdge s))
  , vertexWithOutgoingHalfEdges -- :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
  , vertexIncomingHalfEdges     -- :: Vertex s -> ST s (CircularVector (HalfEdge s))
  , vertexWithIncomingHalfEdges -- :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
  , vertexNeighbours            -- :: Vertex s -> ST s (CircularVector (Vertex s))
  -- , vertexNew -- :: PlanarGraph s -> ST s (Vertex s)
  -- , vertexSetHalfEdge -- :: Vertex s -> HalfEdge s -> ST s ()

    -- ** Edges
  , Edge, EdgeId
  , edgeFromId           -- :: EdgeId -> PlanarGraph s -> Edge s
  , edgeToId             -- :: Edge s -> EdgeId
  , edgeFromHalfEdge     -- :: HalfEdge s -> Edge s

    -- ** Half-edges
  , HalfEdge, HalfEdgeId
  , halfEdgeFromId       -- :: HalfEdgeId -> PlanarGraph s -> HalfEdge s
  , halfEdgeToId         -- :: HalfEdge s -> HalfEdgeId
  , halfEdgeNext         -- :: HalfEdge s -> ST s (HalfEdge s)
  , halfEdgePrev         -- :: HalfEdge s -> ST s (HalfEdge s)
  , halfEdgeNextOutgoing -- :: HalfEdge s -> ST s (HalfEdge s)
  , halfEdgeNextIncoming -- :: HalfEdge s -> ST s (HalfEdge s)
  , halfEdgeVertex       -- :: HalfEdge s -> ST s (Vertex s)
  , halfEdgeTwin         -- :: HalfEdge s -> HalfEdge s
  , halfEdgeTailVertex   -- :: HalfEdge s -> ST s (Vertex s)
  , halfEdgeTipVertex    -- :: HalfEdge s -> ST s (Vertex s)
  , halfEdgeFace         -- :: HalfEdge s -> ST s (Face s)
  , halfEdgeIsInterior   -- :: HalfEdge s -> ST s Bool
  -- , halfEdgeNew          -- :: PlanarGraph s -> ST s (HalfEdge s)
  -- , halfEdgeSetNext      -- :: HalfEdge s -> HalfEdge s -> ST s ()
  -- , halfEdgeSetPrev      -- :: HalfEdge s -> HalfEdge s -> ST s ()
  -- , halfEdgeSetFace      -- :: HalfEdge s -> Face s -> ST s ()
  -- , halfEdgeSetVertex    -- :: HalfEdge s -> Vertex s -> ST s ()

    -- ** Faces
  , Face, FaceId
  , faceInvalid    -- :: PlanarGraph s -> Face s
  , faceIsValid    -- :: Face s -> Bool
  , faceIsInvalid  -- :: Face s -> Bool
  , faceFromId     -- :: FaceId -> PlanarGraph s -> Face s
  , faceToId       -- :: Face s -> FaceId
  , faceHalfEdge   -- :: Face s -> ST s (HalfEdge s)
  , faceIsInterior -- :: Face s -> Bool
  , faceIsBoundary -- :: Face s -> Bool
  , faceHalfEdges  -- :: Face s -> ST s (CircularVector (HalfEdge s))
  , faceBoundary   -- :: Face s -> ST s (CircularVector (Vertex s))
  -- , faceNew :: PlanarGraph s -> ST s (Face s)
  -- , faceNewBoundary :: PlanarGraph s -> ST s (Face s)
  -- , faceSetHalfEdge :: Face s -> HalfEdge s -> ST s ()

    -- * Mutation
  , pgConnectVertices -- :: HalfEdge s -> HalfEdge s -> ST s (Edge s)
-- pgSplitHalfEdge :: HalfEdge s -> ST s (Vertex s)

-- pgRemoveFace :: Face s -> ST s ()
-- pgRemoveHalfEdge :: HalfEdge s -> ST s ()
-- pgRemoveVertex :: Vertex s -> ST s ()
    -- * Misc
  -- , tutteEmbedding -- :: PlanarGraph s -> ST s (Vector.Vector (Double, Double))
  )
  where

import           Control.Monad             (forM_, unless, when)
import           Control.Monad.ST          (ST)
import           Data.Bits                 (Bits (xor))
import qualified Data.HashMap.Strict       as HM
import           Data.Hashable             (Hashable (hashWithSalt))
import           Data.PlanarGraph.Internal
import           Data.STRef                (modifySTRef', newSTRef, readSTRef, writeSTRef)
import           Data.Vector.Circular      (CircularVector)
import qualified Data.Vector.Circular      as CV

import Debug.Trace

-------------------------------------------------------------------------------
-- Elements: Half-edges, vertices, faces.

data HalfEdge s = HalfEdge HalfEdgeId (PlanarGraph s)
  deriving Eq
instance Show (HalfEdge s) where
  showsPrec d (HalfEdge s _) = showsPrec d s
instance Hashable (HalfEdge s) where
  hashWithSalt salt (HalfEdge eId _) = hashWithSalt salt eId


data Edge s = Edge EdgeId (PlanarGraph s)
  deriving Eq

data Vertex s = Vertex VertexId (PlanarGraph s)
  deriving Eq
instance Show (Vertex s) where
  showsPrec d (Vertex v _) = showsPrec d v
instance Hashable (Vertex s) where
  hashWithSalt salt (Vertex vId _) = hashWithSalt salt vId

data Face s = Face FaceId (PlanarGraph s) | Boundary FaceId (PlanarGraph s)
  deriving Eq
instance Show (Face s) where
  showsPrec _ (Face fId _)     = showString "Face " . shows fId
  showsPrec _ (Boundary fId _) = showString "Boundary " . shows fId

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

panic :: String -> String -> a
panic tag msg = error $ "Data.PlanarGraph.Mutable." ++ tag ++ ": " ++ msg

eqCheck :: String -> PlanarGraph s -> PlanarGraph s -> a -> a
eqCheck tag pg1 pg2 v
  | pg1 == pg2 = v
  | otherwise = panic tag "Invalid cross reference."

empty :: Int -> Int -> Int -> ST s (PlanarGraph s)
empty nFaces nVertices nEdges = PlanarGraph
  <$> newSTRef 0
  <*> newSTRef 0
  <*> newSTRef 0
  <*> newSTRef 0
  <*> newVector (nEdges*2)
  <*> newVector (nEdges*2)
  <*> newVector (nEdges*2)
  <*> newVector (nEdges*2)
  <*> newVector nVertices
  <*> newVector nFaces
  <*> newVector 0

-- {-
--   For all boundary vertices:
--     vertex.half-edge.face == interior
--     vertex.half-edge.twin.face == exterior
--   Boundary face: 0

--   create N
-- -}
-- -- | O(n)
-- --   Create a planar graph with N boundary vertices.
-- new :: Int -> ST s (PlanarGraph s)
-- new n | n < 0 = panic "new" "Cannot contain negative vertices."
-- new 0 = empty 0 0 0
-- new 1 = undefined
-- new 2 = undefined
-- new n = pgFromFaces [[0..n-1]]

-- $setup
--
-- >>> import Control.Monad.ST

-- Disabled since hashes are not stable across different versions of hashable.
-- >>> runST $ pgFromFaces [[0,1,2]] >>= pgHash
-- 2959979592048325618
-- >>> runST $ pgFromFaces [[0,1,2,3]] >>= pgHash
-- 2506803680640023584
-- >>> runST $ pgFromFaces [[0,1,2,3],[4,3,2,1]] >>= pgHash
-- 1711135548958680232

-- | \( O(n \log n) \)
--
--
--
-- ==== __Examples:__
-- @
-- 'pgFromFaces' [[0,1,2]]
-- @
-- <<docs/Data/PlanarGraph/planargraph-2959979592048325618.svg>>
--
-- @
-- 'pgFromFaces' [[0,1,2,3]]
-- @
-- <<docs/Data/PlanarGraph/planargraph-2506803680640023584.svg>>
pgFromFaces :: [[VertexId]] -> ST s (PlanarGraph s)
pgFromFaces = pgFromFacesCV . map CV.unsafeFromList

pgFromFacesCV :: [CircularVector VertexId] -> ST s (PlanarGraph s)
pgFromFacesCV [] = empty 0 0 0
pgFromFacesCV faces = do
  let maxVertexId = maximum (map CV.maximum faces)
      nFaces = length faces
      nHalfEdges = sum (map length faces)
  pg <- empty nFaces (maxVertexId+1) (nHalfEdges `div` 2)
  setVector (pgVertexEdges pg) (-1)
  writeSTRef (pgNextVertexId pg) (maxVertexId+1)
  edgeMap <- newSTRef HM.empty
  let getHalfEdge (vTail, vTip) = do
        hm <- readSTRef edgeMap
        case HM.lookup (vTail, vTip) hm of
          Just{} -> panic "fromFaces" "Duplicate half-edge."
          Nothing ->
            case HM.lookup (vTip, vTail) hm of
              Just twin -> pure (halfEdgeTwin twin)
              Nothing   -> {-trace ("Creating new half-edge: " ++ show (vTip, vTail)) $ -} do
                halfEdge <- halfEdgeNew pg
                halfEdgeSetFace (halfEdgeTwin halfEdge) (faceInvalid pg)
                vertexSetHalfEdge (vertexFromId vTip pg) halfEdge
                writeSTRef edgeMap $ HM.insert (vTail, vTip) halfEdge hm
                halfEdgeSetVertex halfEdge (vertexFromId vTip pg)
                halfEdgeSetVertex (halfEdgeTwin halfEdge) (vertexFromId vTail pg)
                pure halfEdge
      addFace face | length face < 3 = panic "fromFaces" "Faces must have at least 3 vertices."
      addFace face = {- trace "Adding face" $ -} do
        fId <- faceNew pg
        let edges = CV.zip face (CV.rotateRight 1 face)
        halfEdges <- {- trace ("getHalfEdge") $ -} mapM getHalfEdge edges
        faceSetHalfEdge fId (CV.head halfEdges)
        setNextPrevFace fId (CV.reverse halfEdges)
  forM_ faces addFace

  maxHalfEdgeId <- readSTRef (pgNextHalfEdgeId pg)
  -- For each half-edge:
  --   If face is invalid:
  --     Find loop and add it as a boundary.
  forM_ (map (`halfEdgeFromId` pg) [0..maxHalfEdgeId*2-1]) $ \he -> {- trace ("Scan halfedge: " ++ show he) $ -} do
    -- f <- halfEdgeFace he
    validFace <- faceIsValid <$> halfEdgeFace he
    unless validFace $ {- trace ("Found invalid face: " ++ show f) $ -} do
      face <- faceNewBoundary pg
      boundary <- halfEdgeConstructBoundary he
      -- trace ("Boundary: " ++ show (face, boundary)) $ return ()
      faceSetHalfEdge face (CV.head boundary)
      setNextPrevFace face boundary
  pure pg
  where
    setNextPrevFace fId halfEdges = do
      let edgeTriples = CV.zip3 (CV.rotateLeft 1 halfEdges) halfEdges (CV.rotateRight 1 halfEdges)
      forM_ (edgeTriples) $ \(prev, edge, next) -> do
          halfEdgeSetNext edge next
          halfEdgeSetPrev edge prev
          halfEdgeSetFace edge fId

-- fromFaces' :: Int -> Int -> Int -> [CircularVector VertexId] -> ST s (PlanarGraph s)
-- fromFaces' nFaces nHalfEdges maxVertexId faces = do
--   undefined

-- | \( O(n) \)
pgClone :: PlanarGraph s -> ST s (PlanarGraph s)
pgClone = undefined

-- dualTree :: Face s -> ST s (Tree (Face s))
-- dualTree = undefined

pgHash :: PlanarGraph s -> ST s Int
pgHash pg = do
  eMax <- readSTRef (pgNextHalfEdgeId pg)
  let loop [] salt = pure salt
      loop (edgeId:rest) salt = do
        let he = halfEdgeFromId (edgeId*2) pg
        vTail <- halfEdgeTailVertex he
        vTip <- halfEdgeTipVertex he
        loop rest (hashWithSalt salt (vTail, vTip))
  abs <$> loop [0..eMax-1] 0

-------------------------------------------------------------------------------
-- Vertices

-- | \( O(1) \)
vertexFromId :: VertexId -> PlanarGraph s -> Vertex s
vertexFromId vId pg = Vertex vId pg

-- | \( O(1) \)
vertexToId :: Vertex s -> VertexId
vertexToId (Vertex vId _pg) = vId

-- | \( O(1) \)
vertexHalfEdge :: Vertex s -> ST s (HalfEdge s)
vertexHalfEdge (Vertex vId pg) = do
  eId <- readVector (pgVertexEdges pg) vId
  pure $ HalfEdge eId pg

-- | \( O(1) \)
vertexIsBoundary :: Vertex s -> ST s Bool
vertexIsBoundary vertex = faceIsBoundary <$> (halfEdgeFace =<< (halfEdgeTwin <$> vertexHalfEdge vertex))

-- | O(k)
vertexOutgoingHalfEdges :: Vertex s -> ST s (CircularVector (HalfEdge s))
vertexOutgoingHalfEdges vertex = do
  tmp <- newVector 10
  iRef <- newSTRef 0
  vertexWithOutgoingHalfEdges vertex $ \edge -> do
    i <- readSTRef iRef
    modifySTRef' iRef succ
    writeVector tmp i edge
  i <- readSTRef iRef
  freezeCircularVector i tmp

-- | O(k), more efficient than 'vertexOutgoingHalfEdges'.
vertexWithOutgoingHalfEdges :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
vertexWithOutgoingHalfEdges vertex cb = do
  first <- vertexHalfEdge vertex
  cb first
  let loop edge | edge == first = return ()
      loop edge = trace ("At edge: "++ show (first, edge)) $ do
        cb edge
        loop =<< halfEdgeNext (halfEdgeTwin edge)
  loop =<< halfEdgeNext (halfEdgeTwin first)

-- | O(k)
vertexIncomingHalfEdges :: Vertex s -> ST s (CircularVector (HalfEdge s))
vertexIncomingHalfEdges vertex = CV.map halfEdgeTwin <$> vertexOutgoingHalfEdges vertex

-- | O(k)
vertexWithIncomingHalfEdges :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
vertexWithIncomingHalfEdges = undefined

-- | O(k)
vertexNeighbours :: Vertex s -> ST s (CircularVector (Vertex s))
vertexNeighbours vertex = CV.mapM halfEdgeVertex =<< vertexIncomingHalfEdges vertex

-- vertexAdjacentVertices :: Vertex -> PlanarGraph -> [Vertex]
-- vertexAdjacentFaces :: Vertex -> PlanarGraph -> [Face]

-- -- O(1), internal function.
-- vertexNew :: PlanarGraph s -> ST s (Vertex s)
-- vertexNew pg = do
--   vId <- readSTRef (pgNextVertexId pg)
--   writeSTRef (pgNextVertexId pg) (vId+1)
--   return (Vertex vId pg)

vertexSetHalfEdge :: Vertex s -> HalfEdge s -> ST s ()
vertexSetHalfEdge (Vertex vId pg) (HalfEdge eId pg') = eqCheck "vertexSetHalfEdge" pg pg' $
  writeVector (pgVertexEdges pg) vId eId

-------------------------------------------------------------------------------
-- Edges

-- | O(1)
edgeFromId :: EdgeId -> PlanarGraph s -> Edge s
edgeFromId = Edge

-- | O(1)
edgeToId :: Edge s -> EdgeId
edgeToId (Edge e _) = e

-- | O(1)
edgeFromHalfEdge :: HalfEdge s -> Edge s
edgeFromHalfEdge (HalfEdge he pg) = Edge (he `div` 2) pg

-- -- | O(1)
-- edgeToHalfEdges :: Edge s -> (HalfEdge s, HalfEdge s)
-- edgeToHalfEdges (Edge e pg) = (HalfEdge (e*2) pg, HalfEdge (e*2+1) pg)

-------------------------------------------------------------------------------
-- Half-edges

-- | O(1)
halfEdgePlanarGraph :: HalfEdge s -> PlanarGraph s
halfEdgePlanarGraph (HalfEdge _ pg) = pg

-- -- | O(1)
-- halfEdgeIsValid :: HalfEdge s -> Bool
-- halfEdgeIsValid (HalfEdge eId _) = eId >= 0

-- | O(1)
halfEdgeFromId :: HalfEdgeId -> PlanarGraph s -> HalfEdge s
halfEdgeFromId eId pg = HalfEdge eId pg

-- | O(1)
halfEdgeToId :: HalfEdge s -> HalfEdgeId
halfEdgeToId (HalfEdge eId _pg) = eId

-- | O(1)
halfEdgeNext :: HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext (HalfEdge eId pg) = do
  next <- readVector (pgHalfEdgeNext pg) eId
  pure $ HalfEdge next pg

-- | O(1)
halfEdgePrev :: HalfEdge s -> ST s (HalfEdge s)
halfEdgePrev (HalfEdge eId pg) = do
  prev <- readVector (pgHalfEdgePrev pg) eId
  pure $ HalfEdge prev pg

-- | O(1)
--   Next half-edge with the same vertex.
halfEdgeNextOutgoing :: HalfEdge s -> ST s (HalfEdge s)
halfEdgeNextOutgoing = halfEdgeNext . halfEdgeTwin

-- | O(1)
--   Next half-edge with the same vertex.
halfEdgeNextIncoming :: HalfEdge s -> ST s (HalfEdge s)
halfEdgeNextIncoming = halfEdgePrev . halfEdgeTwin

-- | O(1)
halfEdgeVertex     :: HalfEdge s -> ST s (Vertex s)
halfEdgeVertex (HalfEdge idx pg) = do
  v <- readVector (pgHalfEdgeVertex pg) idx
  pure $ Vertex v pg

-- | O(1)
halfEdgeTwin       :: HalfEdge s -> HalfEdge s
halfEdgeTwin (HalfEdge idx graph) = HalfEdge (idx `xor` 1) graph

-- | O(1)
--   Tail vertex. IE. the vertex of the twin edge.
halfEdgeTailVertex :: HalfEdge s -> ST s (Vertex s)
halfEdgeTailVertex = halfEdgeVertex

-- | O(1)
--   Synonym of `halfEdgeVertex`.
halfEdgeTipVertex  :: HalfEdge s -> ST s (Vertex s)
halfEdgeTipVertex = halfEdgeVertex . halfEdgeTwin

-- | \( O(1) \)
--
-- ==== __Examples:__
-- @
-- 'pgFromFaces' [[0,1,2]]
-- @
--
-- <<docs/Data/PlanarGraph/planargraph-2959979592048325618.svg>>
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; show <$> halfEdgeFace (halfEdgeFromId 0 pg)
-- "Face 0"
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; show <$> halfEdgeFace (halfEdgeFromId 1 pg)
-- "Boundary 0"
--
halfEdgeFace       :: HalfEdge s -> ST s (Face s)
halfEdgeFace (HalfEdge eId pg) = do
  fId <- readVector (pgHalfEdgeFace pg) eId
  pure $ faceFromId fId pg

-- | O(n)
--   Scan boundary half-edges without using 'next' or 'prev'.
halfEdgeConstructBoundary :: HalfEdge s -> ST s (CircularVector (HalfEdge s))
halfEdgeConstructBoundary halfEdge = {- trace ("mkBoundary from: " ++ show halfEdge) $ -} do
  tmp <- newVector 10
  writeVector tmp 0 halfEdge
  let loop i edge | edge == halfEdge = {- trace "Done" $ -} return i
      loop i edge = {- trace ("Going to: " ++ show edge) $ -} do
        face <- halfEdgeFace edge
        if faceIsInvalid face
          then do
            writeVector tmp i edge
            loop (i+1) =<< (halfEdgeTwin <$> halfEdgeNextIncoming edge)
          else
            loop i =<< (halfEdgeTwin <$> halfEdgePrev edge)
  i <- loop 1 =<< (halfEdgeTwin <$> halfEdgeNextIncoming halfEdge)
  cv <- freezeCircularVector i tmp
  -- trace ("Boundary: " ++ show cv) $ pure cv
  pure cv

-- | O(k)
halfEdgeWithLoop        :: HalfEdge s -> (HalfEdge s -> ST s ()) -> ST s ()
halfEdgeWithLoop he cb = worker =<< halfEdgeNext he
  where
    worker edge
      | edge == he = return ()
      | otherwise  = do cb edge; worker =<< halfEdgeNext edge

-- $setup
-- >>> let genPG = pgFromFaces [[0,1,2]]

-- | \( O(1) \)
--   Check if a half-edge's face is interior or exterior.
--
-- ==== __Examples:__
-- @
-- 'pgFromFaces' [[0,1,2]]
-- @
--
-- <<docs/Data/PlanarGraph/planargraph-2959979592048325618.svg>>
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; halfEdgeIsInterior (halfEdgeFromId 0 pg)
-- True
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; halfEdgeIsInterior (halfEdgeFromId 1 pg)
-- False
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; halfEdgeIsInterior (halfEdgeFromId 2 pg)
-- True
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; halfEdgeIsInterior (halfEdgeFromId 3 pg)
-- False
halfEdgeIsInterior :: HalfEdge s -> ST s Bool
halfEdgeIsInterior edge = faceIsInterior <$> halfEdgeFace edge

-- O(1) Allocate new half-edge pair.
halfEdgeNew :: PlanarGraph s -> ST s (HalfEdge s)
halfEdgeNew pg = do
  eId <- readSTRef (pgNextHalfEdgeId pg)
  writeSTRef (pgNextHalfEdgeId pg) (eId+1)
  return (HalfEdge (eId*2) pg)

halfEdgeSetNext :: HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetNext (HalfEdge e pg) (HalfEdge next pg') = eqCheck "halfEdgeSetNext" pg pg' $
  -- trace ("Set next: " ++ show (e, next)) $
  writeVector (pgHalfEdgeNext pg) e next

halfEdgeSetPrev :: HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetPrev (HalfEdge e pg) (HalfEdge prev pg') = eqCheck "halfEdgeSetPrev" pg pg' $
  -- trace ("Set prev: " ++ show (e, prev)) $
  writeVector (pgHalfEdgePrev pg) e prev

halfEdgeSetFace :: HalfEdge s -> Face s -> ST s ()
halfEdgeSetFace (HalfEdge e pg) face =
  -- trace ("Set face: " ++ show (e, face)) $
  writeVector (pgHalfEdgeFace pg) e (faceToId face)

halfEdgeSetVertex :: HalfEdge s -> Vertex s -> ST s ()
halfEdgeSetVertex (HalfEdge e pg) vertex =
  -- trace ("Set vertex: " ++ show (e, vertex)) $
  writeVector (pgHalfEdgeVertex pg) e (vertexToId vertex)

-------------------------------------------------------------------------------
-- Faces

-- | O(1)
faceInvalid :: PlanarGraph s -> Face s
faceInvalid = faceFromId maxBound

-- | O(1)
faceIsValid :: Face s -> Bool
faceIsValid = not . faceIsInvalid

-- | O(1)
faceIsInvalid :: Face s -> Bool
faceIsInvalid (Face fId _)     = fId == maxBound
faceIsInvalid (Boundary fId _) = fId == maxBound

-- | O(1)
faceFromId :: FaceId -> PlanarGraph s -> Face s
faceFromId fId pg | fId < 0 = Boundary (negate fId - 1) pg
faceFromId fId pg = Face fId pg

-- | O(1)
faceToId :: Face s -> FaceId
faceToId (Face fId _)     = fId
faceToId (Boundary fId _) = negate fId - 1

-- | O(1)
faceHalfEdge         :: Face s -> ST s (HalfEdge s)
faceHalfEdge (Face fId pg) = do
  eId <- readVector (pgFaceEdges pg) fId
  pure $ HalfEdge eId pg
faceHalfEdge (Boundary fId pg) = do
  eId <- readVector (pgBoundaryEdges pg) fId
  pure $ HalfEdge eId pg

-- | O(1)
faceIsInterior       :: Face s -> Bool
faceIsInterior = not . faceIsBoundary

-- | O(1)
faceIsBoundary       :: Face s -> Bool
faceIsBoundary Face{}     = False
faceIsBoundary Boundary{} = True

-- faceVertices         :: Face s -> ST s (CircularVector (Vertex s))

-- | O(k)
--   Counterclockwise vector of edges.
faceHalfEdges        :: Face s -> ST s (CircularVector (HalfEdge s))
faceHalfEdges face
  | faceIsBoundary face = worker halfEdgeNext
  | otherwise           = worker halfEdgePrev
  where
    worker advance = do
      first <- faceHalfEdge face
      tmp <- newVector 10
      writeVector tmp 0 first
      let loop i edge | edge == first = return i
          loop i edge = do
            writeVector tmp i edge
            loop (i+1) =<< advance edge
      i <- loop 1 =<< advance first
      freezeCircularVector i tmp

-- | O(k)
faceBoundary :: Face s -> ST s (CircularVector (Vertex s))
faceBoundary face = CV.mapM halfEdgeVertex =<< faceHalfEdges face

-- faceAdjacentFaces    :: Face s -> ST s (CircularVector (Face s))

faceNew :: PlanarGraph s -> ST s (Face s)
faceNew pg = do
  fId <- readSTRef (pgNextFaceId pg)
  writeSTRef (pgNextFaceId pg) (fId+1)
  return (Face fId pg)

faceNewBoundary :: PlanarGraph s -> ST s (Face s)
faceNewBoundary pg = do
  fId <- readSTRef (pgNextBoundaryId pg)
  writeSTRef (pgNextBoundaryId pg) (fId+1)
  return (Boundary fId pg)

faceSetHalfEdge :: Face s -> HalfEdge s -> ST s ()
faceSetHalfEdge (Boundary fId pg) (HalfEdge eId pg') = eqCheck "faceSetHalfEdge" pg pg' $
  -- trace ("faceSetHalfEdge: " ++ show (fId, eId)) $
  writeVector (pgBoundaryEdges pg) fId eId
faceSetHalfEdge (Face fId pg) (HalfEdge eId pg') = eqCheck "faceSetHalfEdge" pg pg' $
  writeVector (pgFaceEdges pg) fId eId

-------------------------------------------------------------------------------
-- Mutation

-- | O(k) where @k@ is the number of edges in new face.
--
--   The two half-edges must be different, must have the same face, and may not be
--   consecutive. The first half-edge will stay in the original face. The second
--   half-edge will be in the newly created face.
--
-- ==== __Examples:__
--
-- @
-- 'pgFromFaces' [[0,1,2,3]]
-- @
--
-- <<docs/Data/PlanarGraph/planargraph-2506803680640023584.svg>>
--
-- @
-- do pg <- 'pgFromFaces' [[0,1,2,3]]
--    let he0 = 'halfEdgeFromId' 0 pg'
--        he4 = 'halfEdgeFromId' 4 pg'
--    'pgConnectVertices' he0 he4
-- @
--
-- <<docs/Data/PlanarGraph/planargraph-1902492848341357096.svg>>
pgConnectVertices :: HalfEdge s -> HalfEdge s -> ST s (Edge s)
pgConnectVertices e1 e2 =
  eqCheck "pgConnectVertices" (halfEdgePlanarGraph e1) (halfEdgePlanarGraph e2) $ do
    let pg = halfEdgePlanarGraph e1
    when (e1 == e2) $ fail "Edges must be different"
    f1 <- halfEdgeFace e1
    f2 <- halfEdgeFace e2
    unless (f1==f2) $ fail "Faces must be the same"
    e1' <- halfEdgeNext e1
    e2' <- halfEdgeNext e2
    when (e1' == e2 || e2' == e1) $ fail "Edges must not be consecutive"

    e1_prev <- halfEdgePrev e1
    e2_prev <- halfEdgePrev e2

    he <- halfEdgeNew pg
    halfEdgeSetFace he f1
    let he' = halfEdgeTwin he
    
    halfEdgeSetVertex he =<< halfEdgeVertex e2
    halfEdgeSetVertex he' =<< halfEdgeVertex e1

    halfEdgeSetNext he e1
    halfEdgeSetPrev he e2_prev

    halfEdgeSetNext he' e2
    halfEdgeSetPrev he' =<< halfEdgePrev e1

    halfEdgeSetPrev e1 he
    halfEdgeSetNext e2_prev he

    halfEdgeSetNext e1_prev he'
    halfEdgeSetPrev e2 he'

    face <- faceNew pg
    faceSetHalfEdge face he'
    halfEdgeWithLoop he' (`halfEdgeSetFace` face)

    pure $ Edge (halfEdgeToId he `div` 2) pg

-- pgInsertVertex :: HalfEdge s -> ST s (Vertex s)

-- pgRemoveEdge :: Edge s -> ST s ()
-- pgRemoveEdges :: [Edge s] -> ST s ()
-- pgRemoveVertex :: Vertex s -> ST s ()
-- pgRemoveBorder :: Edge s -> ST s ()

-------------------------------------------------------------------------------
-- Use cases

-- Use cases:
--   Triangulate polygon.
--     Create PlanarGraph from polygon. Holes have unique faces.
--     Update with [LineSegment 2 Vertex r]
--     Update Face ids at the end.
--   Cut planar graph in two.
--   Re-triangulate part of graph.
--   Mesh smoothing.
--     1. Keep vertex positions separate. Can update without changing the graph.
--     2. Swap edges. HalfEdge+Twin. Find next of each. Delete original half-edges.
--        Then insert half-edges to next.