moonlight-triangulation 1.4.0.2 → 1.4.0.3

raw patch · 86 files changed

+3445/−2768 lines, 86 filesdep ~basedep ~moonlight-triangulationPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: base, moonlight-triangulation

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• README.md +25/−6
• bench/build/Moonlight/Triangulation/BuildBench.hs +2/−2
• bench/region/Moonlight/Triangulation/RegionBench.hs +1/−1
• bench/spade-compare/hs/Main.hs +1/−1
• bench/spade-compare/hs/Moonlight/Triangulation/Bench/SpadeCompare/Constraint.hs +1/−1
• bench/spade-compare/hs/Moonlight/Triangulation/Bench/SpadeCompare/Removal.hs +1/−1
• bench/support/BenchSupport.hs +1/−1
• docs/README.md +1/−0
• docs/category-observatory/Moonlight/Triangulation/Exhibit/CategoryObservatory/Geometry.hs +1/−1
• docs/category-observatory/Moonlight/Triangulation/Exhibit/CategoryObservatory/Identifier.hs +1/−1
• docs/category-observatory/Moonlight/Triangulation/Exhibit/CategoryObservatory/Model.hs +1/−1
• docs/persistence-rose/Moonlight/Triangulation/Exhibit/PersistenceRose.hs +1/−1
• ffi/abi/Moonlight/Triangulation/Foreign/Mesh.hs +1/−1
• moonlight-triangulation.cabal +157/−53
• src-build/Moonlight/Triangulation/BulkLoad.hs +2/−930
• src-build/Moonlight/Triangulation/Insertion.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/BulkLoad.hs +942/−0
• src-build/Moonlight/Triangulation/Internal/Cdt/Admission.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Batch.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Build.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Combinators.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Corridor.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Corridor/Trace.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Query.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Recovery.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Region.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Segment.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Site.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Split.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Types.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Cdt/Union.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/CircleSweep.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Excision.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Join.hs +2/−2
• src-build/Moonlight/Triangulation/Internal/Join/Seam.hs +2/−2
• src-build/Moonlight/Triangulation/Internal/Join/SiteSet.hs +2/−2
• src-build/Moonlight/Triangulation/Internal/Location.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Refinement.hs +1/−1
• src-build/Moonlight/Triangulation/Internal/Session.hs +377/−0
• src-build/Moonlight/Triangulation/Refinement.hs +4/−2
• src-build/Moonlight/Triangulation/Removal.hs +2/−2
• src-build/Moonlight/Triangulation/Session.hs +2/−363
• src-build/Moonlight/Triangulation/SetAlgebra.hs +2/−2
• src-cell-complex/Moonlight/Triangulation/CellComplex.hs +1/−1
• src-dcel/Moonlight/Triangulation/Alpha.hs +1/−1
• src-dcel/Moonlight/Triangulation/Canonical.hs +6/−0
• src-dcel/Moonlight/Triangulation/Dcel.hs +1/−1
• src-dcel/Moonlight/Triangulation/FloodFillIterator.hs +2/−703
• src-dcel/Moonlight/Triangulation/Handles/Dynamic.hs +1/−1
• src-dcel/Moonlight/Triangulation/Handles/HandleDefs.hs +14/−61
• src-dcel/Moonlight/Triangulation/Handles/Iterators/FixedIterators.hs +1/−1
• src-dcel/Moonlight/Triangulation/Handles/Iterators/HullIterator.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/Canonical.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/CellSet.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/DcelOperations/Chain.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/DcelOperations/FlipRewrite.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/DcelOperations/Hull.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/DcelOperations/Subdivide.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/FloodFillIterator.hs +739/−0
• src-dcel/Moonlight/Triangulation/Internal/HandleDefs.hs +70/−0
• src-dcel/Moonlight/Triangulation/Internal/Mutable.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/Region/Publication.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/Region/Types.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/Representation.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/Types.hs +1/−1
• src-dcel/Moonlight/Triangulation/Internal/Validation.hs +528/−0
• src-dcel/Moonlight/Triangulation/IntersectionIterator.hs +1/−1
• src-dcel/Moonlight/Triangulation/PointLocation.hs +1/−1
• src-dcel/Moonlight/Triangulation/Validation.hs +2/−519
• src-dcel/Moonlight/Triangulation/Valuation.hs +1/−1
• src-dual/Moonlight/Triangulation/Interpolation.hs +1/−1
• src-dual/Moonlight/Triangulation/Voronoi.hs +1/−1
• src-public/Moonlight/Triangulation.hs +371/−58
• src-public/Moonlight/Triangulation/HintGenerator.hs +1/−1
• src-public/Moonlight/Triangulation/Internal/Minkowski/Types.hs +1/−1
• src-public/Moonlight/Triangulation/Internal/Overlay/Resident.hs +1/−1
• src-public/Moonlight/Triangulation/Internal/Overlay/Types.hs +1/−1
• src-public/Moonlight/Triangulation/Minkowski.hs +1/−1
• src-public/Moonlight/Triangulation/Overlay.hs +1/−1
• src-serialize/Moonlight/Triangulation/Serialization.hs +1/−1
• test/cell-complex/Main.hs +1/−1
• test/examples/Main.hs +3/−0
• test/native/Moonlight/Triangulation/NativeSpec.hs +3/−1
• test/public-components/Main.hs +112/−0
• test/serialization/Moonlight/Triangulation/SerializationSpec.hs +1/−1

@@ -10,6 +10,19 @@ The serialization format carries its own version tag, independent of the package version; any change to it is recorded here explicitly. +## 1.4.0.3 - 2026-08-28++* Restore public `dcel` and `build` sublibraries as safe restrictions of their+  private implementation owners. The default library reexports the same lawful+  modules, so consumers may choose the broad surface or a smaller dependency+  cone without receiving a second implementation.+* Publish incremental insertion/removal, sealed edit sessions, typed point and+  shape queries, owning handles, payload traversals, dynamic constraint+  operations, and whole-mesh diagnostics through the canonical Haskell facade.+* Keep raw identifier constructors, resident representation, admitted-input+  construction, local transaction scheduling, seam witnesses, and local+  validation closures private.+ ## 1.4.0.2 - 2026-08-28  * Consolidate usage guidance behind one operation index and exact set-operation

@@ -30,11 +30,15 @@ | --- | --- | --- | --- | | `delaunayGeometry` | Coordinates own the input | `Vector Point` | Geometry-only mesh / `BuildError` | | `delaunayFromCoordinates` | Payloads have a separate plane | Defaults, points, payloads, duplicate policy | `BuildResult` / `BuildError` |+| `insert` / `insertAt` / `insertMany` | An immutable mesh gains sites or payload replacements | Mesh plus payloads or explicit points | `InsertionResult` / `BuildResult` / `BuildError` |+| `withSession` | Many inserts and removals should publish once | Mesh, peak added-site count, composed `Session` | Result, mesh, and `BuildStats` / `BuildError` |+| `removeVertex` / `locateAndRemove` | A resident handle or exact position must be removed | Mesh plus `VertexId` / `Point` | `RemovalResult` / optional result / `BuildError` | | `siteRelation` | Supports need exact classification | Two meshes | `SiteRelation` | | `union` / `unions` | Unconstrained supports must join | Two meshes / mesh list | Union mesh / `BuildError` | | `intersection` / `intersectionWith` | Shared support is required | Two meshes; optional payload combiner | Common-site mesh / `BuildError` | | `difference` / `symmetricDifference` | Left-only / exclusive support is required | Source and mask / two meshes | Result mesh / `BuildError` | | `constrainedDelaunay` | Segments author topology | Defaults, positioned vertices, index pairs | `BuildResult` / `CdtError` |+| `addConstraintEdge(s)` / `removeConstraintEdge` | Constraints change on a resident mesh | Mesh plus vertex pair(s) / edge | Constraint receipt or mesh / `CdtError` | | `unionConstrained` / `unionConstrainedWith` | Arbitrary constrained meshes must join | Two meshes; optional payload combiner | Constrained mesh / `ConstrainedUnionError` | | `extendConstrainedWith` | One constrained mesh owns identity | Combiner, base, extension | `ConstrainedExtensionResult` / `ConstrainedUnionError` | | `joinSeparatedConstrained` | Inputs are strictly x-separated | Face predicate, refinement parameters, two meshes | `ConstrainedSeamResult` / `ConstrainedUnionError` |@@ -42,6 +46,9 @@ | `refineWithinDomain` | Quality applies to admitted faces | Vertex constructor, parameters, face set, mesh | `RefinementDomainResult` / `BuildError` | | `faceComponents` | Bounded faces must descend by label | Mesh, `FaceId -> label` | `[(label, FaceComponent)]` | | `componentBoundary` | One component must publish as loops | Mesh, `FaceComponent` | `RegionBoundary` / `BoundaryObstruction` |+| `locatePoint` / `locatePointWithHint` | An admitted point needs an exact cell classification | Mesh, `QueryPoint`, optional hint | `Location`, optionally with `LocationStats` |+| `lineIntersections` | A segment needs its ordered mesh crossings | Mesh and admitted endpoints | `[Intersection]` |+| `verticesInCircle` / `verticesInRectangle` | A metric window selects resident sites | Mesh and circle / rectangle | Handles / typed metric error | | `overlayLayers` | Layers need one exact arrangement | Two `PlanarLayer`s | `OverlayResult` / `OverlayError` | | `overlayClosedUnion` / `overlayClosedIntersection` / `overlayRegularizedDifference` | Boolean output may retain lower cells | Two label predicates, `OverlayResult` | `ExactCellSet` / `OverlaySelectionError` | | `overlaySelectedRegion` | Selected faces must publish as polygons | Label-pair predicate, `OverlayResult` | `PlanarRegion` / `RegionPublicationError` |@@ -112,8 +119,9 @@  ## Use -Use the main facade with explicit `Vector` inputs. Construction and set algebra-retain their typed obstruction in `Either`:+Use the broad default library with explicit `Vector` inputs. It exposes the+facade and the safe leaf modules; construction and set algebra retain their+typed obstruction in `Either`:  ```cabal build-depends:@@ -127,6 +135,15 @@ [example index](docs/examples/README.md) adds constrained interiors, alpha-boundary descent, exact overlay and valuations, and polygonal morphology. +For a smaller compile/dependency cone, depend on only the component modules you+import:++```cabal+build-depends:+  moonlight-triangulation:dcel >= 1.4.1 && < 1.5,+  moonlight-triangulation:build >= 1.4.1 && < 1.5+```+ ## Architecture  The resident DCEL is immutable structure-of-arrays over paged copy-on-write@@ -137,14 +154,16 @@ ## Consumer libraries  The Cabal manifest owns component visibility and dependencies; this is its-consumer-facing projection. External packages normally use the main library-and add only the public sublibraries whose modules they import. The finite DCEL-and construction kernel remain private behind the main facade.+consumer-facing projection. The default library reexports the complete safe+geometry surface. Use a public sublibrary directly when its smaller dependency+cone matters; the trusted implementation units remain private.  | Dependency | Imports | Purpose | | --- | --- | --- |-| `moonlight-triangulation` | `Moonlight.Triangulation`, `.HintGenerator`, `.Overlay`, `.Minkowski` | Construction, observations, set algebra, CDT, refinement, alpha geometry, and exact planar operations. |+| `moonlight-triangulation` | `Moonlight.Triangulation` and every safe `dcel`, `build`, and `dual` module | Broad construction, observation, set algebra, CDT, refinement, alpha, Voronoi, interpolation, and exact planar surface. | | `moonlight-triangulation:core` | `.Scalar`, `.LineSideInfo` | Low-level exact scalars and paged storage primitives. |+| `moonlight-triangulation:dcel` | `.Types`, `.Dcel`, `.Handles.*`, `.PointLocation`, `.FloodFillIterator`, `.IntersectionIterator`, `.Alpha`, `.Exact`, `.Region`, `.Valuation` | Immutable mesh vocabulary, observations, typed spatial queries, exact geometry, and owning handles; no construction kernel. |+| `moonlight-triangulation:build` | `.BulkLoad`, `.Session`, `.Removal`, `.Cdt`, `.Refinement`, `.SetAlgebra` | Construction and persistent editing over the DCEL; no dual, serialization, concurrency, or Homology dependency. | | `moonlight-triangulation:dual` | `.Voronoi`, `.Voronoi.Handles`, `.Interpolation` | Voronoi observations and natural-neighbour interpolation. | | `moonlight-triangulation:parallel` | `.Parallel` | Bounded concurrent union; adds `async`. | | `moonlight-triangulation:serialize` | `.Serialization` | Versioned binary envelopes; adds `binary`, `bytestring`, and `transformers`. |

@@ -23,8 +23,8 @@ -- The facade withholds this constructor. The benchmark indexes the builder's -- own input mapping, so every handle it forges is one the builder issued, and -- it owns that obligation explicitly by naming the module that grants it.-import Moonlight.Triangulation.Handles.HandleDefs (VertexId (VertexId))-import Moonlight.Triangulation.Session (insertVertex, insertVertexAt, withLocalSession, withSession)+import Moonlight.Triangulation.Internal.HandleDefs (VertexId (VertexId))+import Moonlight.Triangulation.Internal.Session (insertVertex, insertVertexAt, withLocalSession, withSession) import Moonlight.Triangulation.Types   ( InsertionResult (insertionTriangulation)   , refinementStats

@@ -28,7 +28,7 @@   ) import Moonlight.Triangulation.Dcel (numInnerFaces) import Moonlight.Triangulation.Exact (ExactPoint, exactPoint)-import Moonlight.Triangulation.Handles.HandleDefs (VertexId (..))+import Moonlight.Triangulation.Internal.HandleDefs (VertexId (..)) import Moonlight.Triangulation.Overlay   ( OverlayReceipt (..)   , overlayClosedIntersection

@@ -24,7 +24,7 @@ import Moonlight.Triangulation import Moonlight.Triangulation.BulkLoad import Moonlight.Triangulation.Cdt-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.HintGenerator import Moonlight.Triangulation.Interpolation import Moonlight.Triangulation.PointLocation

@@ -8,7 +8,7 @@ import qualified Data.Vector as V import Moonlight.Triangulation import Moonlight.Triangulation.Cdt-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Bench.SpadeCompare.Support import Moonlight.Triangulation.Bench.SpadeCompare.Input (randomPoints) 

@@ -12,7 +12,7 @@ import qualified Data.Vector as V import Moonlight.Triangulation import Moonlight.Triangulation.Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Math import Moonlight.Triangulation.PointLocation import Moonlight.Triangulation.Removal

@@ -29,7 +29,7 @@   ( faceVertices   , vertexPoint   )-import Moonlight.Triangulation.Handles.HandleDefs (FaceId)+import Moonlight.Triangulation.Internal.HandleDefs (FaceId) import Moonlight.Triangulation.Types   ( Point (Point)   , Triangulation

@@ -6,6 +6,7 @@ | Question | Canonical owner | | --- | --- | | Which public operation should I call? | [Package operation index](../README.md#operations) |+| Which library token should I depend on? | [Consumer libraries](../README.md#consumer-libraries) | | What algebraic laws do meshes satisfy? | [Package algebraic contract](../README.md#algebraic-contract) | | What are the set-operation types? | [Package type signatures](../README.md#set-operation-types) | | Which execution schedule publishes each result? | [Mesh publication guide](./mesh-publication.md) |

@@ -29,7 +29,7 @@     MeshVertex (..),     Position (..),   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId,     UndirectedEdgeId,     VertexId,

@@ -21,7 +21,7 @@   ( CategoryMorphismKind (..),     CategoryObjectKind (..),   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId,     UndirectedEdgeId,     VertexId,

@@ -26,7 +26,7 @@ import Data.Aeson (ToJSON) import GHC.Generics (Generic) import Moonlight.Triangulation.CellSet (CellSelectionError)-import Moonlight.Triangulation.Handles.HandleDefs (FaceId)+import Moonlight.Triangulation.Internal.HandleDefs (FaceId) import Moonlight.Triangulation.Types (BuildError) import Numeric.Natural (Natural) 

@@ -116,7 +116,7 @@     faceComponentsBy,     outerFaceFloodFill,   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId (..),     UndirectedEdgeId,     VertexId,

@@ -36,7 +36,7 @@ import Moonlight.Triangulation.Foreign.Contract (CMesh, CObstruction) import Moonlight.Triangulation.Foreign.Obstruction (buildFailure) import Moonlight.Triangulation.Math (validatePoint)-import qualified Moonlight.Triangulation.Session as Session+import qualified Moonlight.Triangulation.Internal.Session as Session  delaunayF64 :: Ptr CDouble -> CSize -> Ptr (Ptr CMesh) -> Ptr CObstruction -> IO CUInt delaunayF64 coordinates rawCount output obstructionPointer =

@@ -1,6 +1,6 @@ cabal-version:       3.4 name:                moonlight-triangulation-version:             1.4.0.2+version:             1.4.0.3 synopsis:            Delaunay meshes and exact planar-region algebra. description:         Delaunay and constrained Delaunay triangulation as a lawful                      finite-set algebra, together with exact rational planar@@ -10,13 +10,16 @@                      union, intersection and difference return triangulations                      and refinement composes after them rather than replacing                      them. One structure-of-arrays half-edge mesh carries the-                     constrained and unconstrained layers. A private finite-DCEL-                     and construction tower owns its handles, iterators,-                     circle-sweep build, incremental edits, constraint recovery,-                     and refinement. Public opt-in sublibraries expose the exact-                     scalar core, Voronoi and natural-neighbour dual, bounded-                     concurrent join interpreter, and versioned serialization-                     surface beside the main construction facade.+                     constrained and unconstrained layers. Private finite-DCEL+                     and construction kernels own trusted representations and+                     admitted fast paths. Public dcel and build sublibraries+                     expose their lawful immutable observations, typed queries,+                     construction, incremental edits, constraint recovery, and+                     refinement without duplicating those owners. Further opt-in+                     sublibraries expose the exact scalar core, Voronoi and+                     natural-neighbour dual, bounded concurrent join interpreter,+                     and versioned serialization surface beside the broad main+                     facade.                      On GHC 9.14, a public cell-complex component interprets                      admitted exact cell selections for Homology and Category                      and lowers exact Delaunay alpha filtrations into persistent@@ -103,7 +106,7 @@ source-repository this   type:     git   location: https://github.com/PaleRoses/moonlight.git-  tag:      moonlight-triangulation-1.4.0.2+  tag:      moonlight-triangulation-1.4.0.3   subdir:   moonlight-triangulation  flag warnings-as-errors@@ -134,11 +137,11 @@     ghc-options: -optlo-enable-new-pm=0  -- ── the tower ────────────────────────────────────────────────────────────────--- The main construction tower is core <- dcel <- build.  Dual branches directly--- from dcel; the apex owns only the genuine overlaps: planar algebra descends--- through build, while hierarchy hints glue build and dual. Serialize branches--- from dcel and parallel branches from build, keeping their effect dependencies--- out of the tower. The graph is acyclic and uses no @.hs-boot@ files.+-- The implementation tower is core <- dcel-internal <- build-internal. Public+-- dcel and build components are restrictions of those owners: they reexport+-- lawful modules without copying implementations or publishing trusted+-- constructors. Dual branches directly from the DCEL owner; the apex owns only+-- the genuine overlaps. The graph is acyclic and uses no @.hs-boot@ files.  library core   import: shared-properties@@ -162,7 +165,7 @@     , vector >= 0.13 && < 0.14   ghc-options: -fexpose-all-unfoldings -library dcel+library dcel-internal   import: shared-properties   visibility: private   hs-source-dirs: src-dcel@@ -176,9 +179,11 @@     Moonlight.Triangulation.Valuation     Moonlight.Triangulation.Interop     Moonlight.Triangulation.Dcel+    Moonlight.Triangulation.Canonical     Moonlight.Triangulation.Payload     Moonlight.Triangulation.JoinSemilattice     Moonlight.Triangulation.Handles.HandleDefs+    Moonlight.Triangulation.Internal.HandleDefs     Moonlight.Triangulation.Handles.Dynamic     Moonlight.Triangulation.Handles.Iterators.CircularIterator     Moonlight.Triangulation.Handles.Iterators.DynamicIterators@@ -186,7 +191,9 @@     Moonlight.Triangulation.Handles.Iterators.HullIterator     Moonlight.Triangulation.PointLocation     Moonlight.Triangulation.Validation+    Moonlight.Triangulation.Internal.Validation     Moonlight.Triangulation.FloodFillIterator+    Moonlight.Triangulation.Internal.FloodFillIterator     Moonlight.Triangulation.IntersectionIterator     Moonlight.Triangulation.Internal.FaceProbe     Moonlight.Triangulation.Internal.CellSet@@ -223,6 +230,37 @@     , moonlight-triangulation:core   ghc-options: -fexpose-all-unfoldings +-- Public immutable-DCEL and exact-geometry surface. Every module is the module+-- compiled by dcel-internal; reexporting preserves one type and implementation+-- identity while leaving representation modules hidden.+library dcel+  import: shared-properties+  visibility: public+  reexported-modules:+    Moonlight.Triangulation.Alpha+    , Moonlight.Triangulation.Types+    , Moonlight.Triangulation.Math+    , Moonlight.Triangulation.Exact+    , Moonlight.Triangulation.CellSet+    , Moonlight.Triangulation.Region+    , Moonlight.Triangulation.Valuation+    , Moonlight.Triangulation.Interop+    , Moonlight.Triangulation.Dcel+    , Moonlight.Triangulation.Canonical+    , Moonlight.Triangulation.Payload+    , Moonlight.Triangulation.JoinSemilattice+    , Moonlight.Triangulation.Handles.HandleDefs+    , Moonlight.Triangulation.Handles.Dynamic+    , Moonlight.Triangulation.Handles.Iterators.DynamicIterators+    , Moonlight.Triangulation.Handles.Iterators.FixedIterators+    , Moonlight.Triangulation.Handles.Iterators.HullIterator+    , Moonlight.Triangulation.PointLocation+    , Moonlight.Triangulation.Validation+    , Moonlight.Triangulation.FloodFillIterator+    , Moonlight.Triangulation.IntersectionIterator+  build-depends:+    moonlight-triangulation:dcel-internal+ -- An ExactCellSet already carries every handle and closure witness needed to -- interpret it as a generic finite cell complex. This component is the -- canonical owner of that interpretation and of the alpha-birth lowering into@@ -244,17 +282,19 @@     , moonlight-algebra:abstract >= 0.1 && < 0.2     , moonlight-homology >= 0.1.0.2 && < 0.2     , moonlight-homology:cell-complex >= 0.1.0.2 && < 0.2-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal     , vector >= 0.13 && < 0.14 -library build+library build-internal   import: shared-properties   visibility: private   hs-source-dirs: src-build   exposed-modules:     Moonlight.Triangulation.BulkLoad+    Moonlight.Triangulation.Internal.BulkLoad     Moonlight.Triangulation.Removal     Moonlight.Triangulation.Session+    Moonlight.Triangulation.Internal.Session     Moonlight.Triangulation.Cdt     Moonlight.Triangulation.Refinement     Moonlight.Triangulation.SetAlgebra@@ -292,9 +332,25 @@     , vector >= 0.13 && < 0.14     , vector-algorithms >= 0.9 && < 0.10     , moonlight-triangulation:core-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal   ghc-options: -fexpose-all-unfoldings +-- Public construction surface over the private kernel. Trusted admitted-input+-- and local-transaction entries live only in build-internal; the modules below+-- are their typed, immutable restrictions.+library build+  import: shared-properties+  visibility: public+  reexported-modules:+    Moonlight.Triangulation.BulkLoad+    , Moonlight.Triangulation.Removal+    , Moonlight.Triangulation.Session+    , Moonlight.Triangulation.Cdt+    , Moonlight.Triangulation.Refinement+    , Moonlight.Triangulation.SetAlgebra+  build-depends:+    moonlight-triangulation:build-internal+ -- Concurrency is an effect boundary over the pure build planner. Keeping it in -- its own sublibrary prevents @async@ from infecting the geometry core. library parallel@@ -307,8 +363,8 @@     base >= 4.19 && < 5     , async >= 2.2 && < 2.3     , deepseq >= 1.5 && < 1.6-    , moonlight-triangulation:build-    , moonlight-triangulation:dcel+    , moonlight-triangulation:build-internal+    , moonlight-triangulation:dcel-internal   ghc-options: -fexpose-all-unfoldings  -- Its own sublibrary so that @binary@ and @bytestring@ stay out of the minimal@@ -328,7 +384,7 @@     , transformers >= 0.6 && < 0.7     , vector >= 0.13 && < 0.14     , moonlight-triangulation:core-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal   -- The @Binary@ instances for the identifier and point types are orphans by   -- construction: the types belong to @dcel@ and the class to @binary@, and the   -- whole purpose of this component is that neither one has to know about the@@ -351,7 +407,7 @@     , primitive >= 0.9 && < 0.10     , vector >= 0.13 && < 0.14     , moonlight-triangulation:core-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal   ghc-options: -fexpose-all-unfoldings  library@@ -366,6 +422,40 @@     Moonlight.Triangulation.Internal.Overlay.Arrangement     Moonlight.Triangulation.Internal.Overlay.Embedding     Moonlight.Triangulation.Internal.Overlay.Resident+  -- The default library is the broad safe surface. These are the exact modules+  -- compiled by the focused components, not facade copies; consumers that want+  -- a smaller dependency cone can name :dcel, :build, or :dual directly.+  reexported-modules:+    Moonlight.Triangulation.Alpha+    , Moonlight.Triangulation.Types+    , Moonlight.Triangulation.Math+    , Moonlight.Triangulation.Exact+    , Moonlight.Triangulation.CellSet+    , Moonlight.Triangulation.Region+    , Moonlight.Triangulation.Valuation+    , Moonlight.Triangulation.Interop+    , Moonlight.Triangulation.Dcel+    , Moonlight.Triangulation.Canonical+    , Moonlight.Triangulation.Payload+    , Moonlight.Triangulation.JoinSemilattice+    , Moonlight.Triangulation.Handles.HandleDefs+    , Moonlight.Triangulation.Handles.Dynamic+    , Moonlight.Triangulation.Handles.Iterators.DynamicIterators+    , Moonlight.Triangulation.Handles.Iterators.FixedIterators+    , Moonlight.Triangulation.Handles.Iterators.HullIterator+    , Moonlight.Triangulation.PointLocation+    , Moonlight.Triangulation.Validation+    , Moonlight.Triangulation.FloodFillIterator+    , Moonlight.Triangulation.IntersectionIterator+    , Moonlight.Triangulation.BulkLoad+    , Moonlight.Triangulation.Removal+    , Moonlight.Triangulation.Session+    , Moonlight.Triangulation.Cdt+    , Moonlight.Triangulation.Refinement+    , Moonlight.Triangulation.SetAlgebra+    , Moonlight.Triangulation.Voronoi+    , Moonlight.Triangulation.Voronoi.Handles+    , Moonlight.Triangulation.Interpolation   other-modules:     Moonlight.Triangulation.Internal.Minkowski.Convex     Moonlight.Triangulation.Internal.Minkowski.Types@@ -376,8 +466,8 @@     , deepseq >= 1.5 && < 1.6     , vector >= 0.13 && < 0.14     , moonlight-triangulation:core-    , moonlight-triangulation:dcel-    , moonlight-triangulation:build+    , moonlight-triangulation:dcel-internal+    , moonlight-triangulation:build-internal     , moonlight-triangulation:dual   ghc-options: -fexpose-all-unfoldings @@ -398,8 +488,8 @@     , containers >= 0.8 && < 0.9     , vector >= 0.13 && < 0.14     , moonlight-triangulation-    , moonlight-triangulation:build-    , moonlight-triangulation:dcel+    , moonlight-triangulation:build-internal+    , moonlight-triangulation:dcel-internal  foreign-library moonlight-triangulation-c   import: shared-properties@@ -474,8 +564,8 @@     , deepseq >= 1.5 && < 1.6     , primitive >= 0.9 && < 0.10     , moonlight-triangulation:core-    , moonlight-triangulation:dcel-    , moonlight-triangulation:build+    , moonlight-triangulation:dcel-internal+    , moonlight-triangulation:build-internal     , moonlight-triangulation:dual  common triangulation-serialization-test-slice@@ -484,7 +574,7 @@     binary >= 0.8 && < 0.9     , bytestring >= 0.12 && < 0.13     , deepseq >= 1.5 && < 1.6-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal     , moonlight-triangulation:serialize  -- The operand meshes both algebra slices are stated over.  It sits at the@@ -511,20 +601,20 @@   build-depends:     containers >= 0.8 && < 0.9     , moonlight-triangulation:core-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal  common triangulation-minkowski-law-slice   other-modules: Moonlight.Triangulation.MinkowskiSpec   build-depends:     moonlight-triangulation:core-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal  -- The agreement between the seam schedule and the reference rebuild.  It names -- an internal schedule, so it reaches below the wall and travels with the -- schedule it names: a replacement kernel carries its own copy of this. common triangulation-algebra-schedule-slice   other-modules: Moonlight.Triangulation.ScheduleAgreementSpec-  build-depends: moonlight-triangulation:build+  build-depends: moonlight-triangulation:build-internal  common triangulation-parallel-test-slice   other-modules: Moonlight.Triangulation.ParallelSpec@@ -546,9 +636,9 @@     , moonlight-homology >= 0.1.0.2 && < 0.2     , moonlight-homology:cell-complex >= 0.1.0.2 && < 0.2     , moonlight-triangulation:core-    , moonlight-triangulation:build+    , moonlight-triangulation:build-internal     , moonlight-triangulation:cell-complex-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal     , tasty >= 1.4 && < 1.6     , tasty-hunit >= 0.10 && < 0.11     , vector >= 0.13 && < 0.14@@ -569,6 +659,20 @@     Moonlight.Triangulation.Example.SetAlgebra   build-depends: containers >= 0.8 && < 0.9 +-- A real external shape over only the two focused public components. It proves+-- that immutable observation and construction/editing compose without either+-- the broad facade or a private implementation token.+test-suite moonlight-triangulation-public-components-test+  import: shared-properties+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test/public-components+  build-depends:+    base >= 4.19 && < 5+    , vector >= 0.13 && < 0.14+    , moonlight-triangulation:dcel+    , moonlight-triangulation:build+ -- One pure, source-grounded projection of the alpha, dual, interpolation, -- planar-algebra, and persistence owners. The test shares the internal exhibit -- module; neither component creates a public visualization API.@@ -590,7 +694,7 @@     , moonlight-homology >= 0.1.0.2 && < 0.2     , moonlight-triangulation     , moonlight-triangulation:cell-complex-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal     , moonlight-triangulation:dual     , tasty >= 1.4 && < 1.6     , tasty-hunit >= 0.10 && < 0.11@@ -719,19 +823,19 @@  common triangulation-benchmark-support-slice   other-modules: BenchSupport-  build-depends: moonlight-triangulation:dcel+  build-depends: moonlight-triangulation:dcel-internal  common triangulation-build-benchmark-slice   other-modules: Moonlight.Triangulation.BuildBench   build-depends:     primitive >= 0.9 && < 0.10-    , moonlight-triangulation:dcel-    , moonlight-triangulation:build+    , moonlight-triangulation:dcel-internal+    , moonlight-triangulation:build-internal     , moonlight-triangulation:ffi  common triangulation-dcel-benchmark-slice   other-modules: Moonlight.Triangulation.DcelBench-  build-depends: moonlight-triangulation:dcel+  build-depends: moonlight-triangulation:dcel-internal  common triangulation-dual-benchmark-slice   other-modules: Moonlight.Triangulation.DualBench@@ -742,15 +846,15 @@   build-depends:     containers >= 0.8 && < 0.9     , moonlight-triangulation:core-    , moonlight-triangulation:dcel-    , moonlight-triangulation:build+    , moonlight-triangulation:dcel-internal+    , moonlight-triangulation:build-internal  common triangulation-region-benchmark-slice   other-modules: Moonlight.Triangulation.RegionBench   build-depends:     containers >= 0.8 && < 0.9     , moonlight-triangulation:core-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal  -- The package-owned external construction board deliberately uses tasty-bench: -- unlike the native work-counter slices above, its only lawful common metric@@ -763,8 +867,8 @@   build-depends:     base >= 4.19 && < 5     , deepseq >= 1.5 && < 1.6-    , moonlight-triangulation:build-    , moonlight-triangulation:dcel+    , moonlight-triangulation:build-internal+    , moonlight-triangulation:dcel-internal  executable moonlight-triangulation-delaunay-compare   import: triangulation-delaunay-compare-properties@@ -825,9 +929,9 @@     , moonlight-category:simplicial >= 1.1.0.0 && < 1.2     , moonlight-homology:cell-category >= 0.1.0.2 && < 0.2     , moonlight-homology:cell-complex >= 0.1.0.2 && < 0.2-    , moonlight-triangulation:build+    , moonlight-triangulation:build-internal     , moonlight-triangulation:cell-complex-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal     , transformers >= 0.5 && < 0.7     , vector >= 0.13 && < 0.14 @@ -848,7 +952,7 @@     , moonlight-homology >= 0.1.0.2 && < 0.2     , moonlight-triangulation     , moonlight-triangulation:cell-complex-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal     , moonlight-triangulation:dual     , text >= 2.0 && < 2.2     , transformers >= 0.5 && < 0.7@@ -900,8 +1004,8 @@     , vector >= 0.13 && < 0.14     , primitive >= 0.9 && < 0.10     , moonlight-triangulation-    , moonlight-triangulation:dcel-    , moonlight-triangulation:build+    , moonlight-triangulation:dcel-internal+    , moonlight-triangulation:build-internal     , moonlight-triangulation:dual  -- The alpha comparison is deliberately opt-in: ordinary scorecard listing and@@ -937,9 +1041,9 @@     , deepseq >= 1.4 && < 1.6     , vector >= 0.13 && < 0.14     , moonlight-homology >= 0.1 && < 0.2-    , moonlight-triangulation:build+    , moonlight-triangulation:build-internal     , moonlight-triangulation:cell-complex-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal  -- One exact Delaunay alpha filtration versus independently restricting and -- reducing the same chain complex at every critical radius. Construction of@@ -961,9 +1065,9 @@     , containers >= 0.6 && < 0.9     , deepseq >= 1.5 && < 1.6     , moonlight-homology >= 0.1.0.2 && < 0.2-    , moonlight-triangulation:build+    , moonlight-triangulation:build-internal     , moonlight-triangulation:cell-complex-    , moonlight-triangulation:dcel+    , moonlight-triangulation:dcel-internal     , vector >= 0.13 && < 0.14  benchmark moonlight-triangulation-build-bench

@@ -1,12 +1,4 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -O3 -fllvm -optlo-O3 -optlc-O3 #-}---- | Generation. @delaunay@ builds a mesh from a whole site set by circle sweep;--- the insertion verbs extend an existing mesh one site at a time.+-- | Whole-support construction and persistent incremental insertion. module Moonlight.Triangulation.BulkLoad   ( empty   , clear@@ -14,929 +6,9 @@   , delaunayGeometry   , DuplicatePayloadPolicy (..)   , delaunayFromCoordinates-  , delaunayFromAdmittedDistinctAscending   , insert   , insertAt   , insertMany   ) where -import Control.Monad (forM_)-import Control.Monad.ST (ST, runST)-import qualified Data.IntSet as IntSet-import Data.Primitive.PrimArray-  ( MutablePrimArray-  , newPrimArray-  , readPrimArray-  , unsafeFreezePrimArray-  , writePrimArray-  )-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as MUV-import Data.Word (Word32)-import Moonlight.Triangulation.Dcel (numInnerFaces, numVertices)-import Moonlight.Triangulation.Handles.HandleDefs (DirectedEdgeId (..), FaceId (..), VertexId (..))-import Moonlight.Triangulation.Internal.BoxedPaged (boxedFromVector, boxedUpdate, emptyBoxedPaged)-import Moonlight.Triangulation.Internal.Capacity (ensureCapacity)-import Moonlight.Triangulation.Insertion (insertExistingVertexAtLocation, insertVertexAtPoint)-import Moonlight.Triangulation.Internal.Location (MutableLocation (..))-import Moonlight.Triangulation.Internal.Mutable-import Moonlight.Triangulation.Internal.OperationState-  ( Counter (..)-  , OperationState-  , addCounter-  , freezeBuildStats-  , newOperationState-  , setCounter-  )-import Moonlight.Triangulation.Internal.CircleSweep-  ( RadiallyOrderedArena-  , circleSweepInsert-  , radiallyOrderArena-  , radiallyOrderGeometry-  )-import Moonlight.Triangulation.Internal.PointIndex-  ( MutablePointIndex-  , emptyPointIndex-  , newMutablePointIndex-  , resolveMutablePoint-  , seedMutablePointIndex-  )-import Moonlight.Triangulation.Math (canonicalCoordinate, validatePoint)-import Moonlight.Triangulation.PointLocation (locatePointWithHint)-import Moonlight.Triangulation.Internal.Probe (Probe (..))-import Moonlight.Triangulation.Internal.Representation (Triangulation (..))-import Moonlight.Triangulation.Internal.PackedIndex (noIndex)-import Moonlight.Triangulation.Internal.Paged (TransactionShape (DenseTransaction, LocalTransaction), emptyPaged, fromVector)-import Moonlight.Triangulation.Internal.Transaction (runTransaction)-import Moonlight.Triangulation.Types---- | The vertexless triangulation: the outer face and nothing else. This is the--- canonical origin of the type — bulk loading, incremental insertion and--- refinement all agree with growing this value.-empty-  :: ElementDefaults directed undirected face-  -> Triangulation mode vertex directed undirected face-empty defaults@ElementDefaults{defaultDirectedEdgeData, defaultUndirectedEdgeData, defaultFaceData} =-  Triangulation-    { triPointX = emptyPaged-    , triPointY = emptyPaged-    , triPointIndex = emptyPointIndex-    , triVertexOut = emptyPaged-    , triVertexData = emptyBoxedPaged Nothing-    , triHalfTopology = emptyPaged-    , triDirectedData = emptyBoxedPaged (Just defaultDirectedEdgeData)-    , triUndirectedData = emptyBoxedPaged (Just defaultUndirectedEdgeData)-    , triFaceEdge = fromVector noIndex (U.singleton noIndex)-    , triFaceData = boxedFromVector (Just defaultFaceData) (V.singleton defaultFaceData)-    , triConstraint = emptyPaged-    , triConstraintCount = 0-    , triConstraintEdges = IntSet.empty-    , triSeamFrontier = Nothing-    , triElementDefaults = defaults-    }---- | Discard every vertex while retaining the element defaults the--- triangulation was built with.-clear-  :: Triangulation mode vertex directed undirected face-  -> Triangulation mode vertex directed undirected face-clear = empty . triElementDefaults---- | How a canonical bulk source combines payloads whose exact coordinates--- coincide. Geometry identity is settled independently by the point index.-data DuplicatePayloadPolicy vertex-  = KeepFirstPayload-  | CombineDuplicatePayload !(vertex -> vertex -> vertex)---- | The two lawful ingress sections for the one bulk construction engine.--- Raw callers need coordinate admission and duplicate classification; an exact--- SiteSet has already established canonical, distinct, lexicographically--- ascending 'QueryPoint's. The latter remains package-internal through the--- private build component, rather than becoming a second constructor.-data BulkInput vertex-  = RawPossiblyDuplicate-      !(Int -> Point)-      !(DuplicatePayloadPolicy vertex)-  | AdmittedDistinctAscending !(Int -> QueryPoint)---- | The local identity verdict for one input position. A fresh verdict carries--- the canonical coordinates already admitted to the mutable DCEL, so ingress--- never rereads its own writes merely to accumulate the sweep centre.-data PositionClaim-  = ResidentPosition !Int-  | FreshPosition !Int !Double !Double---- | Build a finite Delaunay DCEL while preserving the first input payload at--- every duplicate position. The returned mapping relates every input slot to--- the canonical stored vertex.-delaunay-  :: forall vertex directed undirected face-   . HasPosition vertex-  => ElementDefaults directed undirected face-  -> V.Vector vertex-  -> Either BuildError (BuildResult 'Unconstrained vertex directed undirected face)-delaunay defaults input =-  buildDelaunayFromSource-    defaults-    (V.length input)-    (RawPossiblyDuplicate (position . (input V.!)) KeepFirstPayload)-    (input V.!)---- | Build the geometry-only Delaunay triangulation of a coordinate vector.--- Exact duplicate positions collapse to one site. Use 'delaunay' or--- 'delaunayFromCoordinates' when vertex annotations or the input-to-vertex--- mapping are part of the result.-delaunayGeometry-  :: V.Vector Point-  -> Either BuildError (DelaunayTriangulation ())-delaunayGeometry coordinates-  | inputCount == 0 = Right (empty unitElementDefaults)-  | otherwise = do-    V.iforM_ coordinates (\index point -> () <$ validatePoint (Just index) point)-    ensureCapacity inputCount-    let !canonicalArena =-          U.generate inputCount $ \index ->-            case coordinates V.! index of-              Point rawX rawY ->-                ( 0-                , canonicalCoordinate rawX-                , canonicalCoordinate rawY-                , fromIntegral index-                )-        (!inputSumX, !inputSumY) =-          U.foldl'-            (\(!sumX, !sumY) (_, x, y, _) -> (sumX + x, sumY + y))-            (0, 0)-            canonicalArena-    runST $ do-      inputArena <- U.unsafeThaw canonicalArena-      let !inputScale = recip (fromIntegral inputCount)-          !inputCenterX = inputSumX * inputScale-          !inputCenterY = inputSumY * inputScale-          (distanceArena, pointXMutable, pointYMutable, inputOrder) =-            MUV.unzip4 inputArena-      assignGeometryRadialDistances-        distanceArena-        pointXMutable-        pointYMutable-        inputCenterX-        inputCenterY-      distances <- U.unsafeFreeze distanceArena-      pointXs <- U.unsafeFreeze pointXMutable-      pointYs <- U.unsafeFreeze pointYMutable-      orderedInputArena <--        radiallyOrderGeometry distances pointXs pointYs inputOrder-      defaultedOutcome <--        newMutableDcelWithVertexDefault-          ()-          unitElementDefaults-          (planarDcelCapacity inputCount)-      case defaultedOutcome of-        Left failure -> pure (Left failure)-        Right defaultedMutable -> do-          let !mutable = defaultedVertexDcel defaultedMutable-              !dense = defaultedDenseVertexDcel defaultedMutable-          operation <- newOperationState (halfEdgeCapacity mutable)-          unique <- appendSortedGeometry defaultedMutable pointXs pointYs inputOrder-          orderedArena <--            if unique == inputCount-              then pure orderedInputArena-              else do-                let !scale = recip (fromIntegral unique)-                    !uniqueOrder = MUV.unsafeSlice 0 unique inputOrder-                (sumX, sumY) <- sumGeometryVertices dense uniqueOrder-                uniqueArena <--                  fillRadialArena-                    mutable-                    (sumX * scale)-                    (sumY * scale)-                    (MUV.unsafeRead uniqueOrder)-                    unique-                radiallyOrderArena uniqueArena-          inserted <- circleSweepInsert mutable operation orderedArena-          case inserted of-            Left failure -> pure (Left failure)-            Right _ -> freezeTriangulation mutable- where-  !inputCount = V.length coordinates--  assignGeometryRadialDistances-    :: forall s-     . MUV.MVector s Double-    -> MUV.MVector s Double-    -> MUV.MVector s Double-    -> Double-    -> Double-    -> ST s ()-  assignGeometryRadialDistances distances pointXs pointYs centerX centerY =-    MUV.imapM_-      (\index _ -> do-        x <- MUV.unsafeRead pointXs index-        y <- MUV.unsafeRead pointYs index-        let !deltaX = centerX - x-            !deltaY = centerY - y-        MUV.unsafeWrite distances index (deltaX * deltaX + deltaY * deltaY)-      )-      distances--  appendSortedGeometry-    :: forall s-     . DefaultedVertexDcel s () () () ()-    -> U.Vector Double-    -> U.Vector Double-    -> MUV.MVector s Word32-    -> ST s Int-  appendSortedGeometry defaultedMutable pointXs pointYs order-    | inputCount == 0 = pure 0-    | otherwise = do-        firstInput <- MUV.unsafeRead order 0-        let !x = U.unsafeIndex pointXs (fromIntegral firstInput)-            !y = U.unsafeIndex pointYs (fromIntegral firstInput)-        denseWriteFreshDefaultPoint defaultedMutable 0 x y-        MUV.unsafeWrite order 0 0-        (_, _, unique) <--          MUV.foldM'-            (\(!previousX, !previousY, !uniqueCount) nextInput ->-               let !nextX = U.unsafeIndex pointXs (fromIntegral nextInput)-                   !nextY = U.unsafeIndex pointYs (fromIntegral nextInput)-                in if nextX == previousX && nextY == previousY-                     then pure (previousX, previousY, uniqueCount)-                     else do-                       denseWriteFreshDefaultPoint defaultedMutable uniqueCount nextX nextY-                       MUV.unsafeWrite order uniqueCount (fromIntegral uniqueCount)-                       pure (nextX, nextY, uniqueCount + 1)-            )-            (x, y, 1)-            (MUV.unsafeSlice 1 (inputCount - 1) order)-        unique <$ denseCommitFreshDefaultPoints defaultedMutable unique--  sumGeometryVertices-    :: forall s-     . DenseMutableDcel s () () () ()-    -> MUV.MVector s Word32-    -> ST s (Double, Double)-  sumGeometryVertices dense vertices =-    MUV.foldM'-      (\(!sumX, !sumY) raw -> do-         x <- denseReadPointX dense (fromIntegral raw)-         y <- denseReadPointY dense (fromIntegral raw)-         pure (sumX + x, sumY + y)-      )-      (0, 0)-      vertices---- | Canonical construction from separate geometry and annotation sources.--- The coordinate vector remains the only geometry in ingress; payloads never--- acquire a fabricated 'HasPosition' instance merely to reach the loader.-delaunayFromCoordinates-  :: forall vertex directed undirected face-   . ElementDefaults directed undirected face-  -> V.Vector (Point)-  -> V.Vector vertex-  -> DuplicatePayloadPolicy vertex-  -> Either BuildError (BuildResult 'Unconstrained vertex directed undirected face)-delaunayFromCoordinates defaults coordinates payloads duplicatePolicy-  | coordinateCount /= payloadCount =-      Left (CoordinatePayloadCountMismatch coordinateCount payloadCount)-  | otherwise =-      buildDelaunayFromSource-        defaults-        coordinateCount-        (RawPossiblyDuplicate (coordinates V.!) duplicatePolicy)-        (payloads V.!)- where-  !coordinateCount = V.length coordinates-  !payloadCount = V.length payloads---- | Construction from an already-admitted exact site section. The caller--- supplies Map-ascending, distinct 'QueryPoint's; this skips only raw--- admission, duplicate classification, and unique-site recentering. It still--- derives the radial execution order and runs the one circle sweep.-delaunayFromAdmittedDistinctAscending-  :: forall vertex directed undirected face-   . ElementDefaults directed undirected face-  -> V.Vector (QueryPoint, vertex)-  -> Either BuildError (BuildResult 'Unconstrained vertex directed undirected face)-delaunayFromAdmittedDistinctAscending defaults input =-  buildDelaunayFromSource-    defaults-    (V.length input)-    (AdmittedDistinctAscending (\index -> fst (input V.! index)))-    (\index -> snd (input V.! index))-{-# INLINE delaunayFromAdmittedDistinctAscending #-}--buildDelaunayFromSource-  :: forall vertex directed undirected face-   . ElementDefaults directed undirected face-  -> Int-  -> BulkInput vertex-  -> (Int -> vertex)-  -> Either BuildError (BuildResult 'Unconstrained vertex directed undirected face)-buildDelaunayFromSource defaults inputCount input payloadAtInput = do-  ensureCapacity inputCount-  runST $ do-    inputArena <- MUV.new inputCount-    admitted <- initializeInputArena inputArena-    case admitted of-      Left failure -> pure (Left failure)-      Right (inputSumX, inputSumY) -> do-        mutable <- newMutableDcel defaults (planarDcelCapacity inputCount)-        operation <- newOperationState (halfEdgeCapacity mutable)-        (mapping, unique, orderedArena) <--          case input of-            RawPossiblyDuplicate pointAtInput duplicatePolicy ->-              prepareRawInput-                inputArena-                mutable-                pointAtInput-                duplicatePolicy-                inputSumX-                inputSumY-            AdmittedDistinctAscending _ ->-              prepareAdmittedDistinctInput inputArena mutable inputSumX inputSumY-        setCounter operation CounterInputPoints inputCount-        setCounter operation CounterUniquePoints unique-        setCounter operation CounterDuplicatePoints (inputCount - unique)-        inserted <--          if unique == 0-            then pure (Right 0)-            else circleSweepInsert mutable operation orderedArena-        case inserted of-          Left failure -> pure (Left failure)-          Right seedCount -> do-            setCounter operation CounterSpatialSeedPoints seedCount-            frozenOutcome <- freezeTriangulation mutable-            case frozenOutcome of-              Left failure -> pure (Left failure)-              Right frozen -> do-                mapped <- unsafeFreezePrimArray mapping-                stats <- freezeBuildStats operation-                pure-                  ( Right-                      BuildResult-                        { buildTriangulation = frozen-                        , buildInputVertices = mapped-                        , buildStats = stats-                        }-                  )- where-  -- Raw sources validate and canonicalize at this one ingress. Admitted-  -- sources merely project their retained QueryPoint evidence into the sweep-  -- arena; neither route reconstructs coordinate identity downstream.-  initializeInputArena-    :: forall s-     . MUV.MVector s (Double, Double, Double, Word32)-    -> ST s (Either BuildError (Double, Double))-  initializeInputArena arena =-    case input of-      RawPossiblyDuplicate pointAtInput _ ->-        initializeRawInputArena arena pointAtInput 0 0 0-      AdmittedDistinctAscending pointAtInput ->-        initializeAdmittedInputArena arena pointAtInput--  initializeRawInputArena-    :: forall s-     . MUV.MVector s (Double, Double, Double, Word32)-    -> (Int -> Point)-    -> Int-    -> Double-    -> Double-    -> ST s (Either BuildError (Double, Double))-  initializeRawInputArena arena pointAtInput !index !sumX !sumY-    | index >= inputCount = pure (Right (sumX, sumY))-    | otherwise =-        case validatePoint (Just index) (pointAtInput index) of-          Left failure -> pure (Left failure)-          Right admitted ->-            case queryPointValue admitted of-              Point x y -> do-                MUV.unsafeWrite arena index (0, x, y, fromIntegral index)-                initializeRawInputArena-                  arena-                  pointAtInput-                  (index + 1)-                  (sumX + x)-                  (sumY + y)--  initializeAdmittedInputArena-    :: forall s-     . MUV.MVector s (Double, Double, Double, Word32)-    -> (Int -> QueryPoint)-    -> ST s (Either BuildError (Double, Double))-  initializeAdmittedInputArena arena pointAtInput =-    Right-      <$> MUV.ifoldM'-        (\(!sumX, !sumY) index _ ->-           case queryPointValue (pointAtInput index) of-             Point x y -> do-               MUV.unsafeWrite arena index (0, x, y, fromIntegral index)-               pure (sumX + x, sumY + y)-        )-        (0, 0)-        arena--  prepareRawInput-    :: forall s-     . MUV.MVector s (Double, Double, Double, Word32)-    -> MutableDcel s vertex directed undirected face-    -> (Int -> Point)-    -> DuplicatePayloadPolicy vertex-    -> Double-    -> Double-    -> ST s (MutablePrimArray s Word32, Int, RadiallyOrderedArena s)-  prepareRawInput inputArena mutable pointAtInput duplicatePolicy inputSumX inputSumY = do-    let !inputScale = if inputCount == 0 then 0 else recip (fromIntegral inputCount)-        !inputCenterX = inputSumX * inputScale-        !inputCenterY = inputSumY * inputScale-    assignRadialDistances inputArena inputCenterX inputCenterY 0-    orderedInputArena <- radiallyOrderArena inputArena-    mapping <- newPrimArray inputCount-    unique <- classifySortedInputs mapping inputArena-    (sumX, sumY) <--      appendClassifiedInputs mutable mapping pointAtInput duplicatePolicy 0 0 0-    orderedArena <--      if unique == inputCount-        then pure orderedInputArena-        else do-          let !scale = recip (fromIntegral unique)-              !uniqueArena = MUV.unsafeSlice 0 unique inputArena-          rewriteCompactedArena-            mapping-            (sumX * scale)-            (sumY * scale)-            uniqueArena-            0-          radiallyOrderArena uniqueArena-    pure (mapping, unique, orderedArena)--  prepareAdmittedDistinctInput-    :: forall s-     . MUV.MVector s (Double, Double, Double, Word32)-    -> MutableDcel s vertex directed undirected face-    -> Double-    -> Double-    -> ST s (MutablePrimArray s Word32, Int, RadiallyOrderedArena s)-  prepareAdmittedDistinctInput inputArena mutable inputSumX inputSumY = do-    mapping <- newPrimArray inputCount-    appendAdmittedDistinctInputs mutable mapping inputArena-    let !inputScale = if inputCount == 0 then 0 else recip (fromIntegral inputCount)-        !inputCenterX = inputSumX * inputScale-        !inputCenterY = inputSumY * inputScale-    assignRadialDistances inputArena inputCenterX inputCenterY 0-    orderedArena <- radiallyOrderArena inputArena-    pure (mapping, inputCount, orderedArena)--  -- An admitted SiteSet is already distinct. Sequential append therefore-  -- transports the identity class map directly into authoritative vertex ids,-  -- without reopening duplicate policy or recentering a compacted arena.-  appendAdmittedDistinctInputs-    :: forall s-     . MutableDcel s vertex directed undirected face-    -> MutablePrimArray s Word32-    -> MUV.MVector s (Double, Double, Double, Word32)-    -> ST s ()-  appendAdmittedDistinctInputs mutable mapping arena =-    MUV.imapM_-      (\index (_, x, y, _) -> do-         vertex <- appendVertexCoordinates mutable x y (payloadAtInput index)-         writePrimArray mapping index (fromIntegral vertex)-         MUV.unsafeWrite arena index (0, x, y, fromIntegral vertex)-      )-      arena--  -- The all-input centre seeds the first radial ordering. Duplicate-  -- equivalence classes become adjacent in that total order; after descent,-  -- the compacted section is recentered over unique sites and ordered once-  -- more only when required.-  assignRadialDistances-    :: forall s-     . MUV.MVector s (Double, Double, Double, Word32)-    -> Double-    -> Double-    -> Int-    -> ST s ()-  assignRadialDistances arena centerX centerY !index-    | index >= inputCount = pure ()-    | otherwise = do-        (_, x, y, inputOrdinal) <- MUV.unsafeRead arena index-        let !deltaX = centerX - x-            !deltaY = centerY - y-        MUV.unsafeWrite arena index (deltaX * deltaX + deltaY * deltaY, x, y, inputOrdinal)-        assignRadialDistances arena centerX centerY (index + 1)--  -- Classify the sorted local sections by exact canonical position. The-  -- mapping first names each class by its earliest input slot. Compacting the-  -- unique radial representatives in place cannot overwrite an unread slot.-  classifySortedInputs-    :: forall s-     . MutablePrimArray s Word32-    -> MUV.MVector s (Double, Double, Double, Word32)-    -> ST s Int-  classifySortedInputs mapping arena-    | inputCount == 0 = pure 0-    | otherwise = do-        first@(_, firstX, firstY, firstInput) <- MUV.unsafeRead arena 0-        writePrimArray mapping (fromIntegral firstInput) firstInput-        classifyFrom first firstX firstY firstInput 1 1-   where-    classifyFrom-      :: (Double, Double, Double, Word32)-      -> Double-      -> Double-      -> Word32-      -> Int-      -> Int-      -> ST s Int-    classifyFrom !_ !previousX !previousY !classInput !readIndex !uniqueCount-      | readIndex >= inputCount = pure uniqueCount-      | otherwise = do-          record@(_, x, y, inputOrdinal) <- MUV.unsafeRead arena readIndex-          if x == previousX && y == previousY-            then do-              writePrimArray mapping (fromIntegral inputOrdinal) classInput-              classifyFrom record previousX previousY classInput (readIndex + 1) uniqueCount-            else do-              writePrimArray mapping (fromIntegral inputOrdinal) inputOrdinal-              if uniqueCount == readIndex-                then pure ()-                else MUV.unsafeWrite arena uniqueCount record-              classifyFrom record x y inputOrdinal (readIndex + 1) (uniqueCount + 1)--  -- Materialize in original order, preserving the established handle-  -- assignment and duplicate-payload law. The equivalence mapping for a-  -- duplicate always points backward to an already materialized class owner.-  appendClassifiedInputs-    :: forall s-     . MutableDcel s vertex directed undirected face-    -> MutablePrimArray s Word32-    -> (Int -> Point)-    -> DuplicatePayloadPolicy vertex-    -> Int-    -> Double-    -> Double-    -> ST s (Double, Double)-  appendClassifiedInputs mutable mapping pointAtInput duplicatePolicy !index !sumX !sumY-    | index >= inputCount = pure (sumX, sumY)-    | otherwise = do-        classInput <- readPrimArray mapping index-        let !vertexData = payloadAtInput index-        if fromIntegral classInput == index-          then case pointAtInput index of-            Point x y -> do-              let !canonicalX = canonicalCoordinate x-                  !canonicalY = canonicalCoordinate y-              vertex <- appendVertexCoordinates mutable canonicalX canonicalY vertexData-              writePrimArray mapping index (fromIntegral vertex)-              appendClassifiedInputs-                mutable-                mapping-                pointAtInput-                duplicatePolicy-                (index + 1)-                (sumX + canonicalX)-                (sumY + canonicalY)-          else do-            resident <- fromIntegral <$> readPrimArray mapping (fromIntegral classInput)-            writePrimArray mapping index (fromIntegral resident)-            case duplicatePolicy of-              KeepFirstPayload -> pure ()-              CombineDuplicatePayload combine -> do-                residentData <- vertexDataAt mutable resident-                writeVertexData mutable resident (combine residentData vertexData)-            appendClassifiedInputs-              mutable-              mapping-              pointAtInput-              duplicatePolicy-              (index + 1)-              sumX-              sumY--  -- Once duplicates have shortened the vertex arena, translate each compacted-  -- representative from its input-class name to its authoritative vertex and-  -- restate its radial key around the exact unique-site centre.-  rewriteCompactedArena-    :: forall s-     . MutablePrimArray s Word32-    -> Double-    -> Double-    -> MUV.MVector s (Double, Double, Double, Word32)-    -> Int-    -> ST s ()-  rewriteCompactedArena mapping centerX centerY arena !index-    | index >= MUV.length arena = pure ()-    | otherwise = do-        (_, x, y, classInput) <- MUV.unsafeRead arena index-        vertex <- readPrimArray mapping (fromIntegral classInput)-        let !deltaX = centerX - x-            !deltaY = centerY - y-        MUV.unsafeWrite arena index (deltaX * deltaX + deltaY * deltaY, x, y, vertex)-        rewriteCompactedArena mapping centerX centerY arena (index + 1)---- | Insert or replace a vertex payload. A payload at an existing position is--- overwritten without changing topology.------ The published mesh is independent of the one passed in. A singleton below--- ten thousand resident sites copies densely; larger bases publish through--- copy-on-write pages. A caller inserting a sequence wants one--- 'Moonlight.Triangulation.Session.withSession' over--- 'Moonlight.Triangulation.Session.insertVertex' instead — see 'insertAt'.-insert-  :: HasPosition vertex-  => Triangulation mode vertex directed undirected face-  -> vertex-  -> Either BuildError (InsertionResult mode vertex directed undirected face)-insert triangulation vertexData = insertAt triangulation (position vertexData) vertexData---- | Insert at a stated point. 'insert' is this with the point read out of the--- payload, which is what a caller holding only a payload wants; a caller that--- computed the point — a constraint split, a Steiner refinement — wants to say--- so rather than build a payload and hope the round trip through 'HasPosition'--- returns what it started with.------ This is one shaped transaction over a single insertion. Replacing a fold of--- it with one session is sound because the two agree on every mesh and differ--- only in how many intermediate meshes they publish. A fold publishes @k@--- meshes and pays a thaw for each, so it runs in Θ(n·k); the session pays one--- thaw and runs in O(k·log n) expected.-insertAt-  :: Triangulation mode vertex directed undirected face-  -> Point-  -> vertex-  -> Either BuildError (InsertionResult mode vertex directed undirected face)-insertAt triangulation rawPoint vertexData = do-  queryPoint <- validatePoint Nothing rawPoint-  case locatePointWithHint triangulation Nothing queryPoint of-    (OnVertex resident, walked) ->-      Right (replaceResidentPayload triangulation resident walked vertexData)-    (located, walked) -> do-      let transactionShape =-            if numVertices triangulation < 10_000-              then DenseTransaction-              else LocalTransaction-      ((vertex, disposition), frozen, stats) <--        runTransaction-          id-          transactionShape-          triangulation-          1-          (\mutable operation -> do-             addCounter operation CounterInputPoints 1-             inserted <--               case located of-                 -- A frozen degenerate-line location points at an arbitrary visible-                 -- segment, while the line extension interpreter requires a terminal-                 -- edge. The frozen section carries no terminal witness, so retain-                 -- the existing mutable line locator for this one non-lawful case.-                 OutsideConvexHull (Just _)-                   | numInnerFaces triangulation == 0 ->-                       insertVertexAtPoint @'ProbeOff mutable operation Nothing (queryPointValue queryPoint) vertexData-                 _ -> do-                   capacityOutcome <- ensurePointCapacity mutable 1-                   case capacityOutcome of-                     Left failure -> pure (Left failure)-                     Right () -> do-                       vertex <- appendVertex mutable (queryPointValue queryPoint) vertexData-                       let thawedLocation =-                             case located of-                               EmptyTriangulation -> MutableEmpty-                               OnEdge (DirectedEdgeId raw) -> MutableOnEdge (fromIntegral raw)-                               InFace (FaceId raw) -> MutableInFace (fromIntegral raw)-                               -- The frozen locator emits no edge only for a-                               -- singleton mesh. Its mutable interpreter ignores-                               -- this sentinel while constructing the second vertex.-                               OutsideConvexHull Nothing -> MutableOutsideHull 0-                               OutsideConvexHull (Just (DirectedEdgeId raw)) -> MutableOutsideHull (fromIntegral raw)-                       ((vertex, Inserted) <$) <$> insertExistingVertexAtLocation @'ProbeOff mutable operation vertex thawedLocation-             case inserted of-               Left failure -> pure (Left failure)-               Right (vertex, disposition) -> do-                 case disposition of-                   Inserted -> addCounter operation CounterUniquePoints 1-                   AlreadyPresent -> do-                     writeVertexData mutable vertex vertexData-                     addCounter operation CounterExistingPoints 1-                     addCounter operation CounterDuplicatePoints 1-                 pure (Right (vertex, disposition))-          )-      pure-        InsertionResult-          { insertionTriangulation = frozen-          , insertionVertex = VertexId (fromIntegral vertex)-          , insertionDisposition = disposition-          , insertionStats = withFrozenLocationStats walked stats-          }---- | Publish a payload replacement without opening a transaction.------ A position already resident changes exactly one thing: the payload slot the--- vertex already occupies. No coordinate, no half-edge, no constraint flag and--- no face record differs, so the five unboxed planes are the ones the argument--- already holds rather than copies taken out of it — which is what a thaw costs--- and what this exists to refuse. They are immutable values; nothing reached--- from here is a mutable buffer, and 'boxedUpdate' materializes a fresh page--- for the one it rewrites, leaving the argument's own directory intact.------ The location counters are the frozen walk's, not a thawed walk's. They--- describe the walk that actually ran.-replaceResidentPayload-  :: Triangulation mode vertex directed undirected face-  -> VertexId-  -> LocationStats-  -> vertex-  -> InsertionResult mode vertex directed undirected face-replaceResidentPayload triangulation resident@(VertexId raw) walked vertexData =-  InsertionResult-    { insertionTriangulation =-        triangulation-          { triVertexData =-              boxedUpdate (fromIntegral raw) vertexData (triVertexData triangulation)-          }-    , insertionVertex = resident-    , insertionDisposition = AlreadyPresent-    , insertionStats =-        withFrozenLocationStats-          walked-          emptyBuildStats-            { statInputPoints = 1-            , statExistingPoints = 1-            , statDuplicatePoints = 1-            }-    }---- | Add the frozen locator's observation to the local topology interpreter's--- operation-owned counters. Direct frozen-site insertion contributes no mutable--- walk; the degenerate fallback contributes its real mutable walk rather than--- having it erased from the published result.-withFrozenLocationStats :: LocationStats -> BuildStats -> BuildStats-withFrozenLocationStats walked stats =-  stats-    { statLocationWalkSteps = locationWalkSteps walked + statLocationWalkSteps stats-    , statLocationMaxWalk = max (locationWalkSteps walked) (statLocationMaxWalk stats)-    , statLocationFallbacks = (if locationUsedFallback walked then 1 else 0) + statLocationFallbacks stats-    }---- | Apply a batch in one page transaction. Duplicate positions are processed--- in input order, so their last payload wins exactly as repeated 'insert'--- calls would, while topology is inserted only once per new position.-insertMany-  :: forall mode vertex directed undirected face-   . HasPosition vertex-  => Triangulation mode vertex directed undirected face-  -> V.Vector vertex-  -> Either BuildError (BuildResult mode vertex directed undirected face)-insertMany triangulation input = do-  validateVertices input-  (mapped, frozen, stats) <--    runTransaction id DenseTransaction triangulation (V.length input) $ \mutable operation -> do-      table <- newMutablePointIndex (pointCapacity mutable)-      seeded <- seedPointTable mutable table-      case seeded of-        Left failure -> pure (Left failure)-        Right () -> do-          mapping <- newPrimArray (V.length input)-          freshBuffer <- MUV.new (V.length input)-          filled <- fill mutable operation table mapping freshBuffer 0 0 0 0-          case filled of-            Left failure -> pure (Left failure)-            Right (sumX, sumY, freshCount) -> do-              let !existingCount = V.length input - freshCount-              setCounter operation CounterInputPoints (V.length input)-              setCounter operation CounterUniquePoints freshCount-              setCounter operation CounterExistingPoints existingCount-              setCounter operation CounterDuplicatePoints existingCount-              inserted <--                if freshCount == 0-                  then pure (Right 0)-                  else do-                    let !scale = recip (fromIntegral freshCount)-                    arena <--                      fillRadialArena-                        mutable-                        (sumX * scale)-                        (sumY * scale)-                        (MUV.unsafeRead freshBuffer)-                        freshCount-                    orderedArena <- radiallyOrderArena arena-                    circleSweepInsert mutable operation orderedArena-              case inserted of-                Left failure -> pure (Left failure)-                Right seedCount -> do-                  setCounter operation CounterSpatialSeedPoints seedCount-                  Right <$> unsafeFreezePrimArray mapping-  pure-    BuildResult-      { buildTriangulation = frozen-      , buildInputVertices = mapped-      , buildStats = stats-      }- where-  fill-    :: forall s-     . MutableDcel s vertex directed undirected face-    -> OperationState s-    -> MutablePointIndex s-    -> MutablePrimArray s Word32-    -> MUV.MVector s Word32-    -> Int-    -> Double-    -> Double-    -> Int-    -> ST s (Either BuildError (Double, Double, Int))-  fill mutable operation table mapping freshBuffer !index !sumX !sumY !freshCount-    | index >= V.length input = pure (Right (sumX, sumY, freshCount))-    | otherwise = do-        let !vertexData = input V.! index-        claimed <- claimPosition mutable table (position vertexData) vertexData-        case claimed of-          Left failure -> pure (Left failure)-          Right (FreshPosition vertex canonicalX canonicalY) -> do-            writePrimArray mapping index (fromIntegral vertex)-            MUV.unsafeWrite freshBuffer freshCount (fromIntegral vertex)-            fill-              mutable-              operation-              table-              mapping-              freshBuffer-              (index + 1)-              (sumX + canonicalX)-              (sumY + canonicalY)-              (freshCount + 1)-          Right (ResidentPosition vertex) -> do-            writePrimArray mapping index (fromIntegral vertex)-            writeVertexData mutable vertex vertexData-            fill mutable operation table mapping freshBuffer (index + 1) sumX sumY freshCount---- | One packed radial record per swept vertex — the derived sort fields and--- the vertex handle, nothing else — filled straight from the coordinate--- arenas and consumed in place by the sweep. The squared distance is stated--- against the ingress-accumulated centre, in the widened comparison format.-fillRadialArena-  :: MutableDcel s vertex directed undirected face-  -> Double-  -> Double-  -> (Int -> ST s Word32)-  -> Int-  -> ST s (MUV.MVector s (Double, Double, Double, Word32))-fillRadialArena mutable centerX centerY lookupId count = do-  arena <- MUV.new count-  forM_ [0 .. count - 1] $ \index -> do-    raw <- lookupId index-    x <- readPointX mutable (fromIntegral raw)-    y <- readPointY mutable (fromIntegral raw)-    let !wideX = x-        !wideY = y-        !deltaX = centerX - wideX-        !deltaY = centerY - wideY-    MUV.unsafeWrite arena index (deltaX * deltaX + deltaY * deltaY, wideX, wideY, raw)-  pure arena---- | Claim a position for the vertex the arena would append next, or answer the--- vertex already holding it. The claim is written before the append, so the two--- must stay adjacent: nothing may consume a vertex slot in between.-claimPosition-  :: MutableDcel s vertex directed undirected face-  -> MutablePointIndex s-  -> Point-  -> vertex-  -> ST s (Either BuildError PositionClaim)-claimPosition mutable table rawPoint vertexData =-  case rawPoint of-    Point x y -> do-      let !canonicalX = canonicalCoordinate x-          !canonicalY = canonicalCoordinate y-      slot <- nextVertexSlot mutable-      let !candidate = nextVertexSlotIndex slot-      owner <--        resolveMutablePoint-          table-          (readPointX mutable)-          (readPointY mutable)-          canonicalX-          canonicalY-          candidate-      case owner of-        Left failure -> pure (Left failure)-        Right (Just existing) -> pure (Right (ResidentPosition existing))-        Right Nothing -> do-          vertex <- appendVertexCoordinatesAtSlot mutable slot canonicalX canonicalY vertexData-          pure (Right (FreshPosition vertex canonicalX canonicalY))--- | Enter the positions a batch inherits from the triangulation it extends, so--- that an input repeating one of them maps to the vertex already there.-seedPointTable-  :: MutableDcel s vertex directed undirected face-  -> MutablePointIndex s-  -> ST s (Either BuildError ())-seedPointTable mutable table = do-  existing <- pointCount mutable-  seedMutablePointIndex-    table-    existing-    (readPointX mutable)-    (readPointY mutable)--validateVertices :: HasPosition vertex => V.Vector vertex -> Either BuildError ()-validateVertices vertices =-  V.iforM_ vertices (\index vertexData -> validatePoint (Just index) (position vertexData))+import Moonlight.Triangulation.Internal.BulkLoad

@@ -14,7 +14,7 @@   ) where  import Control.Monad.ST (ST)-import Moonlight.Triangulation.Handles.HandleDefs (VertexId (..))+import Moonlight.Triangulation.Internal.HandleDefs (VertexId (..)) import Moonlight.Triangulation.Internal.DcelOperations.Chain   ( extendLine   , lineToArea

@@ -0,0 +1,942 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -O3 -fllvm -optlo-O3 -optlc-O3 #-}++-- | Generation. @delaunay@ builds a mesh from a whole site set by circle sweep;+-- the insertion verbs extend an existing mesh one site at a time.+module Moonlight.Triangulation.Internal.BulkLoad+  ( empty+  , clear+  , delaunay+  , delaunayGeometry+  , DuplicatePayloadPolicy (..)+  , delaunayFromCoordinates+  , delaunayFromAdmittedDistinctAscending+  , insert+  , insertAt+  , insertMany+  ) where++import Control.Monad (forM_)+import Control.Monad.ST (ST, runST)+import qualified Data.IntSet as IntSet+import Data.Primitive.PrimArray+  ( MutablePrimArray+  , newPrimArray+  , readPrimArray+  , unsafeFreezePrimArray+  , writePrimArray+  )+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as MUV+import Data.Word (Word32)+import Moonlight.Triangulation.Dcel (numInnerFaces, numVertices)+import Moonlight.Triangulation.Internal.HandleDefs (DirectedEdgeId (..), FaceId (..), VertexId (..))+import Moonlight.Triangulation.Internal.BoxedPaged (boxedFromVector, boxedUpdate, emptyBoxedPaged)+import Moonlight.Triangulation.Internal.Capacity (ensureCapacity)+import Moonlight.Triangulation.Insertion (insertExistingVertexAtLocation, insertVertexAtPoint)+import Moonlight.Triangulation.Internal.Location (MutableLocation (..))+import Moonlight.Triangulation.Internal.Mutable+import Moonlight.Triangulation.Internal.OperationState+  ( Counter (..)+  , OperationState+  , addCounter+  , freezeBuildStats+  , newOperationState+  , setCounter+  )+import Moonlight.Triangulation.Internal.CircleSweep+  ( RadiallyOrderedArena+  , circleSweepInsert+  , radiallyOrderArena+  , radiallyOrderGeometry+  )+import Moonlight.Triangulation.Internal.PointIndex+  ( MutablePointIndex+  , emptyPointIndex+  , newMutablePointIndex+  , resolveMutablePoint+  , seedMutablePointIndex+  )+import Moonlight.Triangulation.Math (canonicalCoordinate, validatePoint)+import Moonlight.Triangulation.PointLocation (locatePointWithHint)+import Moonlight.Triangulation.Internal.Probe (Probe (..))+import Moonlight.Triangulation.Internal.Representation (Triangulation (..))+import Moonlight.Triangulation.Internal.PackedIndex (noIndex)+import Moonlight.Triangulation.Internal.Paged (TransactionShape (DenseTransaction, LocalTransaction), emptyPaged, fromVector)+import Moonlight.Triangulation.Internal.Transaction (runTransaction)+import Moonlight.Triangulation.Types++-- | The vertexless triangulation: the outer face and nothing else. This is the+-- canonical origin of the type — bulk loading, incremental insertion and+-- refinement all agree with growing this value.+empty+  :: ElementDefaults directed undirected face+  -> Triangulation mode vertex directed undirected face+empty defaults@ElementDefaults{defaultDirectedEdgeData, defaultUndirectedEdgeData, defaultFaceData} =+  Triangulation+    { triPointX = emptyPaged+    , triPointY = emptyPaged+    , triPointIndex = emptyPointIndex+    , triVertexOut = emptyPaged+    , triVertexData = emptyBoxedPaged Nothing+    , triHalfTopology = emptyPaged+    , triDirectedData = emptyBoxedPaged (Just defaultDirectedEdgeData)+    , triUndirectedData = emptyBoxedPaged (Just defaultUndirectedEdgeData)+    , triFaceEdge = fromVector noIndex (U.singleton noIndex)+    , triFaceData = boxedFromVector (Just defaultFaceData) (V.singleton defaultFaceData)+    , triConstraint = emptyPaged+    , triConstraintCount = 0+    , triConstraintEdges = IntSet.empty+    , triSeamFrontier = Nothing+    , triElementDefaults = defaults+    }++-- | Discard every vertex while retaining the element defaults the+-- triangulation was built with.+clear+  :: Triangulation mode vertex directed undirected face+  -> Triangulation mode vertex directed undirected face+clear = empty . triElementDefaults++-- | How a canonical bulk source combines payloads whose exact coordinates+-- coincide. Geometry identity is settled independently by the point index.+data DuplicatePayloadPolicy vertex+  = KeepFirstPayload+  | CombineDuplicatePayload !(vertex -> vertex -> vertex)++-- | The two lawful ingress sections for the one bulk construction engine.+-- Raw callers need coordinate admission and duplicate classification; an exact+-- SiteSet has already established canonical, distinct, lexicographically+-- ascending 'QueryPoint's. The latter remains package-internal through the+-- private build component, rather than becoming a second constructor.+data BulkInput vertex+  = RawPossiblyDuplicate+      !(Int -> Point)+      !(DuplicatePayloadPolicy vertex)+  | AdmittedDistinctAscending !(Int -> QueryPoint)++-- | The local identity verdict for one input position. A fresh verdict carries+-- the canonical coordinates already admitted to the mutable DCEL, so ingress+-- never rereads its own writes merely to accumulate the sweep centre.+data PositionClaim+  = ResidentPosition !Int+  | FreshPosition !Int !Double !Double++-- | Build a finite Delaunay DCEL while preserving the first input payload at+-- every duplicate position. The returned mapping relates every input slot to+-- the canonical stored vertex.+delaunay+  :: forall vertex directed undirected face+   . HasPosition vertex+  => ElementDefaults directed undirected face+  -> V.Vector vertex+  -> Either BuildError (BuildResult 'Unconstrained vertex directed undirected face)+delaunay defaults input =+  buildDelaunayFromSource+    defaults+    (V.length input)+    (RawPossiblyDuplicate (position . (input V.!)) KeepFirstPayload)+    (input V.!)++-- | Build the geometry-only Delaunay triangulation of a coordinate vector.+-- Exact duplicate positions collapse to one site. Use 'delaunay' or+-- 'delaunayFromCoordinates' when vertex annotations or the input-to-vertex+-- mapping are part of the result.+delaunayGeometry+  :: V.Vector Point+  -> Either BuildError (DelaunayTriangulation ())+delaunayGeometry coordinates+  | inputCount == 0 = Right (empty unitElementDefaults)+  | otherwise = do+    V.iforM_ coordinates (\index point -> () <$ validatePoint (Just index) point)+    ensureCapacity inputCount+    let !canonicalArena =+          U.generate inputCount $ \index ->+            case coordinates V.! index of+              Point rawX rawY ->+                ( 0+                , canonicalCoordinate rawX+                , canonicalCoordinate rawY+                , fromIntegral index+                )+        (!inputSumX, !inputSumY) =+          U.foldl'+            (\(!sumX, !sumY) (_, x, y, _) -> (sumX + x, sumY + y))+            (0, 0)+            canonicalArena+    runST $ do+      inputArena <- U.unsafeThaw canonicalArena+      let !inputScale = recip (fromIntegral inputCount)+          !inputCenterX = inputSumX * inputScale+          !inputCenterY = inputSumY * inputScale+          (distanceArena, pointXMutable, pointYMutable, inputOrder) =+            MUV.unzip4 inputArena+      assignGeometryRadialDistances+        distanceArena+        pointXMutable+        pointYMutable+        inputCenterX+        inputCenterY+      distances <- U.unsafeFreeze distanceArena+      pointXs <- U.unsafeFreeze pointXMutable+      pointYs <- U.unsafeFreeze pointYMutable+      orderedInputArena <-+        radiallyOrderGeometry distances pointXs pointYs inputOrder+      defaultedOutcome <-+        newMutableDcelWithVertexDefault+          ()+          unitElementDefaults+          (planarDcelCapacity inputCount)+      case defaultedOutcome of+        Left failure -> pure (Left failure)+        Right defaultedMutable -> do+          let !mutable = defaultedVertexDcel defaultedMutable+              !dense = defaultedDenseVertexDcel defaultedMutable+          operation <- newOperationState (halfEdgeCapacity mutable)+          unique <- appendSortedGeometry defaultedMutable pointXs pointYs inputOrder+          orderedArena <-+            if unique == inputCount+              then pure orderedInputArena+              else do+                let !scale = recip (fromIntegral unique)+                    !uniqueOrder = MUV.unsafeSlice 0 unique inputOrder+                (sumX, sumY) <- sumGeometryVertices dense uniqueOrder+                uniqueArena <-+                  fillRadialArena+                    mutable+                    (sumX * scale)+                    (sumY * scale)+                    (MUV.unsafeRead uniqueOrder)+                    unique+                radiallyOrderArena uniqueArena+          inserted <- circleSweepInsert mutable operation orderedArena+          case inserted of+            Left failure -> pure (Left failure)+            Right _ -> freezeTriangulation mutable+ where+  !inputCount = V.length coordinates++  assignGeometryRadialDistances+    :: forall s+     . MUV.MVector s Double+    -> MUV.MVector s Double+    -> MUV.MVector s Double+    -> Double+    -> Double+    -> ST s ()+  assignGeometryRadialDistances distances pointXs pointYs centerX centerY =+    MUV.imapM_+      (\index _ -> do+        x <- MUV.unsafeRead pointXs index+        y <- MUV.unsafeRead pointYs index+        let !deltaX = centerX - x+            !deltaY = centerY - y+        MUV.unsafeWrite distances index (deltaX * deltaX + deltaY * deltaY)+      )+      distances++  appendSortedGeometry+    :: forall s+     . DefaultedVertexDcel s () () () ()+    -> U.Vector Double+    -> U.Vector Double+    -> MUV.MVector s Word32+    -> ST s Int+  appendSortedGeometry defaultedMutable pointXs pointYs order+    | inputCount == 0 = pure 0+    | otherwise = do+        firstInput <- MUV.unsafeRead order 0+        let !x = U.unsafeIndex pointXs (fromIntegral firstInput)+            !y = U.unsafeIndex pointYs (fromIntegral firstInput)+        denseWriteFreshDefaultPoint defaultedMutable 0 x y+        MUV.unsafeWrite order 0 0+        (_, _, unique) <-+          MUV.foldM'+            (\(!previousX, !previousY, !uniqueCount) nextInput ->+               let !nextX = U.unsafeIndex pointXs (fromIntegral nextInput)+                   !nextY = U.unsafeIndex pointYs (fromIntegral nextInput)+                in if nextX == previousX && nextY == previousY+                     then pure (previousX, previousY, uniqueCount)+                     else do+                       denseWriteFreshDefaultPoint defaultedMutable uniqueCount nextX nextY+                       MUV.unsafeWrite order uniqueCount (fromIntegral uniqueCount)+                       pure (nextX, nextY, uniqueCount + 1)+            )+            (x, y, 1)+            (MUV.unsafeSlice 1 (inputCount - 1) order)+        unique <$ denseCommitFreshDefaultPoints defaultedMutable unique++  sumGeometryVertices+    :: forall s+     . DenseMutableDcel s () () () ()+    -> MUV.MVector s Word32+    -> ST s (Double, Double)+  sumGeometryVertices dense vertices =+    MUV.foldM'+      (\(!sumX, !sumY) raw -> do+         x <- denseReadPointX dense (fromIntegral raw)+         y <- denseReadPointY dense (fromIntegral raw)+         pure (sumX + x, sumY + y)+      )+      (0, 0)+      vertices++-- | Canonical construction from separate geometry and annotation sources.+-- The coordinate vector remains the only geometry in ingress; payloads never+-- acquire a fabricated 'HasPosition' instance merely to reach the loader.+delaunayFromCoordinates+  :: forall vertex directed undirected face+   . ElementDefaults directed undirected face+  -> V.Vector (Point)+  -> V.Vector vertex+  -> DuplicatePayloadPolicy vertex+  -> Either BuildError (BuildResult 'Unconstrained vertex directed undirected face)+delaunayFromCoordinates defaults coordinates payloads duplicatePolicy+  | coordinateCount /= payloadCount =+      Left (CoordinatePayloadCountMismatch coordinateCount payloadCount)+  | otherwise =+      buildDelaunayFromSource+        defaults+        coordinateCount+        (RawPossiblyDuplicate (coordinates V.!) duplicatePolicy)+        (payloads V.!)+ where+  !coordinateCount = V.length coordinates+  !payloadCount = V.length payloads++-- | Construction from an already-admitted exact site section. The caller+-- supplies Map-ascending, distinct 'QueryPoint's; this skips only raw+-- admission, duplicate classification, and unique-site recentering. It still+-- derives the radial execution order and runs the one circle sweep.+delaunayFromAdmittedDistinctAscending+  :: forall vertex directed undirected face+   . ElementDefaults directed undirected face+  -> V.Vector (QueryPoint, vertex)+  -> Either BuildError (BuildResult 'Unconstrained vertex directed undirected face)+delaunayFromAdmittedDistinctAscending defaults input =+  buildDelaunayFromSource+    defaults+    (V.length input)+    (AdmittedDistinctAscending (\index -> fst (input V.! index)))+    (\index -> snd (input V.! index))+{-# INLINE delaunayFromAdmittedDistinctAscending #-}++buildDelaunayFromSource+  :: forall vertex directed undirected face+   . ElementDefaults directed undirected face+  -> Int+  -> BulkInput vertex+  -> (Int -> vertex)+  -> Either BuildError (BuildResult 'Unconstrained vertex directed undirected face)+buildDelaunayFromSource defaults inputCount input payloadAtInput = do+  ensureCapacity inputCount+  runST $ do+    inputArena <- MUV.new inputCount+    admitted <- initializeInputArena inputArena+    case admitted of+      Left failure -> pure (Left failure)+      Right (inputSumX, inputSumY) -> do+        mutable <- newMutableDcel defaults (planarDcelCapacity inputCount)+        operation <- newOperationState (halfEdgeCapacity mutable)+        (mapping, unique, orderedArena) <-+          case input of+            RawPossiblyDuplicate pointAtInput duplicatePolicy ->+              prepareRawInput+                inputArena+                mutable+                pointAtInput+                duplicatePolicy+                inputSumX+                inputSumY+            AdmittedDistinctAscending _ ->+              prepareAdmittedDistinctInput inputArena mutable inputSumX inputSumY+        setCounter operation CounterInputPoints inputCount+        setCounter operation CounterUniquePoints unique+        setCounter operation CounterDuplicatePoints (inputCount - unique)+        inserted <-+          if unique == 0+            then pure (Right 0)+            else circleSweepInsert mutable operation orderedArena+        case inserted of+          Left failure -> pure (Left failure)+          Right seedCount -> do+            setCounter operation CounterSpatialSeedPoints seedCount+            frozenOutcome <- freezeTriangulation mutable+            case frozenOutcome of+              Left failure -> pure (Left failure)+              Right frozen -> do+                mapped <- unsafeFreezePrimArray mapping+                stats <- freezeBuildStats operation+                pure+                  ( Right+                      BuildResult+                        { buildTriangulation = frozen+                        , buildInputVertices = mapped+                        , buildStats = stats+                        }+                  )+ where+  -- Raw sources validate and canonicalize at this one ingress. Admitted+  -- sources merely project their retained QueryPoint evidence into the sweep+  -- arena; neither route reconstructs coordinate identity downstream.+  initializeInputArena+    :: forall s+     . MUV.MVector s (Double, Double, Double, Word32)+    -> ST s (Either BuildError (Double, Double))+  initializeInputArena arena =+    case input of+      RawPossiblyDuplicate pointAtInput _ ->+        initializeRawInputArena arena pointAtInput 0 0 0+      AdmittedDistinctAscending pointAtInput ->+        initializeAdmittedInputArena arena pointAtInput++  initializeRawInputArena+    :: forall s+     . MUV.MVector s (Double, Double, Double, Word32)+    -> (Int -> Point)+    -> Int+    -> Double+    -> Double+    -> ST s (Either BuildError (Double, Double))+  initializeRawInputArena arena pointAtInput !index !sumX !sumY+    | index >= inputCount = pure (Right (sumX, sumY))+    | otherwise =+        case validatePoint (Just index) (pointAtInput index) of+          Left failure -> pure (Left failure)+          Right admitted ->+            case queryPointValue admitted of+              Point x y -> do+                MUV.unsafeWrite arena index (0, x, y, fromIntegral index)+                initializeRawInputArena+                  arena+                  pointAtInput+                  (index + 1)+                  (sumX + x)+                  (sumY + y)++  initializeAdmittedInputArena+    :: forall s+     . MUV.MVector s (Double, Double, Double, Word32)+    -> (Int -> QueryPoint)+    -> ST s (Either BuildError (Double, Double))+  initializeAdmittedInputArena arena pointAtInput =+    Right+      <$> MUV.ifoldM'+        (\(!sumX, !sumY) index _ ->+           case queryPointValue (pointAtInput index) of+             Point x y -> do+               MUV.unsafeWrite arena index (0, x, y, fromIntegral index)+               pure (sumX + x, sumY + y)+        )+        (0, 0)+        arena++  prepareRawInput+    :: forall s+     . MUV.MVector s (Double, Double, Double, Word32)+    -> MutableDcel s vertex directed undirected face+    -> (Int -> Point)+    -> DuplicatePayloadPolicy vertex+    -> Double+    -> Double+    -> ST s (MutablePrimArray s Word32, Int, RadiallyOrderedArena s)+  prepareRawInput inputArena mutable pointAtInput duplicatePolicy inputSumX inputSumY = do+    let !inputScale = if inputCount == 0 then 0 else recip (fromIntegral inputCount)+        !inputCenterX = inputSumX * inputScale+        !inputCenterY = inputSumY * inputScale+    assignRadialDistances inputArena inputCenterX inputCenterY 0+    orderedInputArena <- radiallyOrderArena inputArena+    mapping <- newPrimArray inputCount+    unique <- classifySortedInputs mapping inputArena+    (sumX, sumY) <-+      appendClassifiedInputs mutable mapping pointAtInput duplicatePolicy 0 0 0+    orderedArena <-+      if unique == inputCount+        then pure orderedInputArena+        else do+          let !scale = recip (fromIntegral unique)+              !uniqueArena = MUV.unsafeSlice 0 unique inputArena+          rewriteCompactedArena+            mapping+            (sumX * scale)+            (sumY * scale)+            uniqueArena+            0+          radiallyOrderArena uniqueArena+    pure (mapping, unique, orderedArena)++  prepareAdmittedDistinctInput+    :: forall s+     . MUV.MVector s (Double, Double, Double, Word32)+    -> MutableDcel s vertex directed undirected face+    -> Double+    -> Double+    -> ST s (MutablePrimArray s Word32, Int, RadiallyOrderedArena s)+  prepareAdmittedDistinctInput inputArena mutable inputSumX inputSumY = do+    mapping <- newPrimArray inputCount+    appendAdmittedDistinctInputs mutable mapping inputArena+    let !inputScale = if inputCount == 0 then 0 else recip (fromIntegral inputCount)+        !inputCenterX = inputSumX * inputScale+        !inputCenterY = inputSumY * inputScale+    assignRadialDistances inputArena inputCenterX inputCenterY 0+    orderedArena <- radiallyOrderArena inputArena+    pure (mapping, inputCount, orderedArena)++  -- An admitted SiteSet is already distinct. Sequential append therefore+  -- transports the identity class map directly into authoritative vertex ids,+  -- without reopening duplicate policy or recentering a compacted arena.+  appendAdmittedDistinctInputs+    :: forall s+     . MutableDcel s vertex directed undirected face+    -> MutablePrimArray s Word32+    -> MUV.MVector s (Double, Double, Double, Word32)+    -> ST s ()+  appendAdmittedDistinctInputs mutable mapping arena =+    MUV.imapM_+      (\index (_, x, y, _) -> do+         vertex <- appendVertexCoordinates mutable x y (payloadAtInput index)+         writePrimArray mapping index (fromIntegral vertex)+         MUV.unsafeWrite arena index (0, x, y, fromIntegral vertex)+      )+      arena++  -- The all-input centre seeds the first radial ordering. Duplicate+  -- equivalence classes become adjacent in that total order; after descent,+  -- the compacted section is recentered over unique sites and ordered once+  -- more only when required.+  assignRadialDistances+    :: forall s+     . MUV.MVector s (Double, Double, Double, Word32)+    -> Double+    -> Double+    -> Int+    -> ST s ()+  assignRadialDistances arena centerX centerY !index+    | index >= inputCount = pure ()+    | otherwise = do+        (_, x, y, inputOrdinal) <- MUV.unsafeRead arena index+        let !deltaX = centerX - x+            !deltaY = centerY - y+        MUV.unsafeWrite arena index (deltaX * deltaX + deltaY * deltaY, x, y, inputOrdinal)+        assignRadialDistances arena centerX centerY (index + 1)++  -- Classify the sorted local sections by exact canonical position. The+  -- mapping first names each class by its earliest input slot. Compacting the+  -- unique radial representatives in place cannot overwrite an unread slot.+  classifySortedInputs+    :: forall s+     . MutablePrimArray s Word32+    -> MUV.MVector s (Double, Double, Double, Word32)+    -> ST s Int+  classifySortedInputs mapping arena+    | inputCount == 0 = pure 0+    | otherwise = do+        first@(_, firstX, firstY, firstInput) <- MUV.unsafeRead arena 0+        writePrimArray mapping (fromIntegral firstInput) firstInput+        classifyFrom first firstX firstY firstInput 1 1+   where+    classifyFrom+      :: (Double, Double, Double, Word32)+      -> Double+      -> Double+      -> Word32+      -> Int+      -> Int+      -> ST s Int+    classifyFrom !_ !previousX !previousY !classInput !readIndex !uniqueCount+      | readIndex >= inputCount = pure uniqueCount+      | otherwise = do+          record@(_, x, y, inputOrdinal) <- MUV.unsafeRead arena readIndex+          if x == previousX && y == previousY+            then do+              writePrimArray mapping (fromIntegral inputOrdinal) classInput+              classifyFrom record previousX previousY classInput (readIndex + 1) uniqueCount+            else do+              writePrimArray mapping (fromIntegral inputOrdinal) inputOrdinal+              if uniqueCount == readIndex+                then pure ()+                else MUV.unsafeWrite arena uniqueCount record+              classifyFrom record x y inputOrdinal (readIndex + 1) (uniqueCount + 1)++  -- Materialize in original order, preserving the established handle+  -- assignment and duplicate-payload law. The equivalence mapping for a+  -- duplicate always points backward to an already materialized class owner.+  appendClassifiedInputs+    :: forall s+     . MutableDcel s vertex directed undirected face+    -> MutablePrimArray s Word32+    -> (Int -> Point)+    -> DuplicatePayloadPolicy vertex+    -> Int+    -> Double+    -> Double+    -> ST s (Double, Double)+  appendClassifiedInputs mutable mapping pointAtInput duplicatePolicy !index !sumX !sumY+    | index >= inputCount = pure (sumX, sumY)+    | otherwise = do+        classInput <- readPrimArray mapping index+        let !vertexData = payloadAtInput index+        if fromIntegral classInput == index+          then case pointAtInput index of+            Point x y -> do+              let !canonicalX = canonicalCoordinate x+                  !canonicalY = canonicalCoordinate y+              vertex <- appendVertexCoordinates mutable canonicalX canonicalY vertexData+              writePrimArray mapping index (fromIntegral vertex)+              appendClassifiedInputs+                mutable+                mapping+                pointAtInput+                duplicatePolicy+                (index + 1)+                (sumX + canonicalX)+                (sumY + canonicalY)+          else do+            resident <- fromIntegral <$> readPrimArray mapping (fromIntegral classInput)+            writePrimArray mapping index (fromIntegral resident)+            case duplicatePolicy of+              KeepFirstPayload -> pure ()+              CombineDuplicatePayload combine -> do+                residentData <- vertexDataAt mutable resident+                writeVertexData mutable resident (combine residentData vertexData)+            appendClassifiedInputs+              mutable+              mapping+              pointAtInput+              duplicatePolicy+              (index + 1)+              sumX+              sumY++  -- Once duplicates have shortened the vertex arena, translate each compacted+  -- representative from its input-class name to its authoritative vertex and+  -- restate its radial key around the exact unique-site centre.+  rewriteCompactedArena+    :: forall s+     . MutablePrimArray s Word32+    -> Double+    -> Double+    -> MUV.MVector s (Double, Double, Double, Word32)+    -> Int+    -> ST s ()+  rewriteCompactedArena mapping centerX centerY arena !index+    | index >= MUV.length arena = pure ()+    | otherwise = do+        (_, x, y, classInput) <- MUV.unsafeRead arena index+        vertex <- readPrimArray mapping (fromIntegral classInput)+        let !deltaX = centerX - x+            !deltaY = centerY - y+        MUV.unsafeWrite arena index (deltaX * deltaX + deltaY * deltaY, x, y, vertex)+        rewriteCompactedArena mapping centerX centerY arena (index + 1)++-- | Insert or replace a vertex payload. A payload at an existing position is+-- overwritten without changing topology.+--+-- The published mesh is independent of the one passed in. A singleton below+-- ten thousand resident sites copies densely; larger bases publish through+-- copy-on-write pages. A caller inserting a sequence wants one+-- 'Moonlight.Triangulation.Session.withSession' over+-- 'Moonlight.Triangulation.Session.insertVertex' instead — see 'insertAt'.+insert+  :: HasPosition vertex+  => Triangulation mode vertex directed undirected face+  -> vertex+  -> Either BuildError (InsertionResult mode vertex directed undirected face)+insert triangulation vertexData = insertAt triangulation (position vertexData) vertexData++-- | Insert at a stated point. 'insert' is this with the point read out of the+-- payload, which is what a caller holding only a payload wants; a caller that+-- computed the point — a constraint split, a Steiner refinement — wants to say+-- so rather than build a payload and hope the round trip through 'HasPosition'+-- returns what it started with.+--+-- This is one shaped transaction over a single insertion. Replacing a fold of+-- it with one session is sound because the two agree on every mesh and differ+-- only in how many intermediate meshes they publish. A fold publishes @k@+-- meshes and pays a thaw for each, so it runs in Θ(n·k); the session pays one+-- thaw and runs in O(k·log n) expected.+insertAt+  :: Triangulation mode vertex directed undirected face+  -> Point+  -> vertex+  -> Either BuildError (InsertionResult mode vertex directed undirected face)+insertAt triangulation rawPoint vertexData = do+  queryPoint <- validatePoint Nothing rawPoint+  case locatePointWithHint triangulation Nothing queryPoint of+    (OnVertex resident, walked) ->+      Right (replaceResidentPayload triangulation resident walked vertexData)+    (located, walked) -> do+      let transactionShape =+            if numVertices triangulation < 10_000+              then DenseTransaction+              else LocalTransaction+      ((vertex, disposition), frozen, stats) <-+        runTransaction+          id+          transactionShape+          triangulation+          1+          (\mutable operation -> do+             addCounter operation CounterInputPoints 1+             inserted <-+               case located of+                 -- A frozen degenerate-line location points at an arbitrary visible+                 -- segment, while the line extension interpreter requires a terminal+                 -- edge. The frozen section carries no terminal witness, so retain+                 -- the existing mutable line locator for this one non-lawful case.+                 OutsideConvexHull (Just _)+                   | numInnerFaces triangulation == 0 ->+                       insertVertexAtPoint @'ProbeOff mutable operation Nothing (queryPointValue queryPoint) vertexData+                 _ -> do+                   capacityOutcome <- ensurePointCapacity mutable 1+                   case capacityOutcome of+                     Left failure -> pure (Left failure)+                     Right () -> do+                       vertex <- appendVertex mutable (queryPointValue queryPoint) vertexData+                       let thawedLocation =+                             case located of+                               EmptyTriangulation -> MutableEmpty+                               OnEdge (DirectedEdgeId raw) -> MutableOnEdge (fromIntegral raw)+                               InFace (FaceId raw) -> MutableInFace (fromIntegral raw)+                               -- The frozen locator emits no edge only for a+                               -- singleton mesh. Its mutable interpreter ignores+                               -- this sentinel while constructing the second vertex.+                               OutsideConvexHull Nothing -> MutableOutsideHull 0+                               OutsideConvexHull (Just (DirectedEdgeId raw)) -> MutableOutsideHull (fromIntegral raw)+                       ((vertex, Inserted) <$) <$> insertExistingVertexAtLocation @'ProbeOff mutable operation vertex thawedLocation+             case inserted of+               Left failure -> pure (Left failure)+               Right (vertex, disposition) -> do+                 case disposition of+                   Inserted -> addCounter operation CounterUniquePoints 1+                   AlreadyPresent -> do+                     writeVertexData mutable vertex vertexData+                     addCounter operation CounterExistingPoints 1+                     addCounter operation CounterDuplicatePoints 1+                 pure (Right (vertex, disposition))+          )+      pure+        InsertionResult+          { insertionTriangulation = frozen+          , insertionVertex = VertexId (fromIntegral vertex)+          , insertionDisposition = disposition+          , insertionStats = withFrozenLocationStats walked stats+          }++-- | Publish a payload replacement without opening a transaction.+--+-- A position already resident changes exactly one thing: the payload slot the+-- vertex already occupies. No coordinate, no half-edge, no constraint flag and+-- no face record differs, so the five unboxed planes are the ones the argument+-- already holds rather than copies taken out of it — which is what a thaw costs+-- and what this exists to refuse. They are immutable values; nothing reached+-- from here is a mutable buffer, and 'boxedUpdate' materializes a fresh page+-- for the one it rewrites, leaving the argument's own directory intact.+--+-- The location counters are the frozen walk's, not a thawed walk's. They+-- describe the walk that actually ran.+replaceResidentPayload+  :: Triangulation mode vertex directed undirected face+  -> VertexId+  -> LocationStats+  -> vertex+  -> InsertionResult mode vertex directed undirected face+replaceResidentPayload triangulation resident@(VertexId raw) walked vertexData =+  InsertionResult+    { insertionTriangulation =+        triangulation+          { triVertexData =+              boxedUpdate (fromIntegral raw) vertexData (triVertexData triangulation)+          }+    , insertionVertex = resident+    , insertionDisposition = AlreadyPresent+    , insertionStats =+        withFrozenLocationStats+          walked+          emptyBuildStats+            { statInputPoints = 1+            , statExistingPoints = 1+            , statDuplicatePoints = 1+            }+    }++-- | Add the frozen locator's observation to the local topology interpreter's+-- operation-owned counters. Direct frozen-site insertion contributes no mutable+-- walk; the degenerate fallback contributes its real mutable walk rather than+-- having it erased from the published result.+withFrozenLocationStats :: LocationStats -> BuildStats -> BuildStats+withFrozenLocationStats walked stats =+  stats+    { statLocationWalkSteps = locationWalkSteps walked + statLocationWalkSteps stats+    , statLocationMaxWalk = max (locationWalkSteps walked) (statLocationMaxWalk stats)+    , statLocationFallbacks = (if locationUsedFallback walked then 1 else 0) + statLocationFallbacks stats+    }++-- | Apply a batch in one page transaction. Duplicate positions are processed+-- in input order, so their last payload wins exactly as repeated 'insert'+-- calls would, while topology is inserted only once per new position.+insertMany+  :: forall mode vertex directed undirected face+   . HasPosition vertex+  => Triangulation mode vertex directed undirected face+  -> V.Vector vertex+  -> Either BuildError (BuildResult mode vertex directed undirected face)+insertMany triangulation input = do+  validateVertices input+  (mapped, frozen, stats) <-+    runTransaction id DenseTransaction triangulation (V.length input) $ \mutable operation -> do+      table <- newMutablePointIndex (pointCapacity mutable)+      seeded <- seedPointTable mutable table+      case seeded of+        Left failure -> pure (Left failure)+        Right () -> do+          mapping <- newPrimArray (V.length input)+          freshBuffer <- MUV.new (V.length input)+          filled <- fill mutable operation table mapping freshBuffer 0 0 0 0+          case filled of+            Left failure -> pure (Left failure)+            Right (sumX, sumY, freshCount) -> do+              let !existingCount = V.length input - freshCount+              setCounter operation CounterInputPoints (V.length input)+              setCounter operation CounterUniquePoints freshCount+              setCounter operation CounterExistingPoints existingCount+              setCounter operation CounterDuplicatePoints existingCount+              inserted <-+                if freshCount == 0+                  then pure (Right 0)+                  else do+                    let !scale = recip (fromIntegral freshCount)+                    arena <-+                      fillRadialArena+                        mutable+                        (sumX * scale)+                        (sumY * scale)+                        (MUV.unsafeRead freshBuffer)+                        freshCount+                    orderedArena <- radiallyOrderArena arena+                    circleSweepInsert mutable operation orderedArena+              case inserted of+                Left failure -> pure (Left failure)+                Right seedCount -> do+                  setCounter operation CounterSpatialSeedPoints seedCount+                  Right <$> unsafeFreezePrimArray mapping+  pure+    BuildResult+      { buildTriangulation = frozen+      , buildInputVertices = mapped+      , buildStats = stats+      }+ where+  fill+    :: forall s+     . MutableDcel s vertex directed undirected face+    -> OperationState s+    -> MutablePointIndex s+    -> MutablePrimArray s Word32+    -> MUV.MVector s Word32+    -> Int+    -> Double+    -> Double+    -> Int+    -> ST s (Either BuildError (Double, Double, Int))+  fill mutable operation table mapping freshBuffer !index !sumX !sumY !freshCount+    | index >= V.length input = pure (Right (sumX, sumY, freshCount))+    | otherwise = do+        let !vertexData = input V.! index+        claimed <- claimPosition mutable table (position vertexData) vertexData+        case claimed of+          Left failure -> pure (Left failure)+          Right (FreshPosition vertex canonicalX canonicalY) -> do+            writePrimArray mapping index (fromIntegral vertex)+            MUV.unsafeWrite freshBuffer freshCount (fromIntegral vertex)+            fill+              mutable+              operation+              table+              mapping+              freshBuffer+              (index + 1)+              (sumX + canonicalX)+              (sumY + canonicalY)+              (freshCount + 1)+          Right (ResidentPosition vertex) -> do+            writePrimArray mapping index (fromIntegral vertex)+            writeVertexData mutable vertex vertexData+            fill mutable operation table mapping freshBuffer (index + 1) sumX sumY freshCount++-- | One packed radial record per swept vertex — the derived sort fields and+-- the vertex handle, nothing else — filled straight from the coordinate+-- arenas and consumed in place by the sweep. The squared distance is stated+-- against the ingress-accumulated centre, in the widened comparison format.+fillRadialArena+  :: MutableDcel s vertex directed undirected face+  -> Double+  -> Double+  -> (Int -> ST s Word32)+  -> Int+  -> ST s (MUV.MVector s (Double, Double, Double, Word32))+fillRadialArena mutable centerX centerY lookupId count = do+  arena <- MUV.new count+  forM_ [0 .. count - 1] $ \index -> do+    raw <- lookupId index+    x <- readPointX mutable (fromIntegral raw)+    y <- readPointY mutable (fromIntegral raw)+    let !wideX = x+        !wideY = y+        !deltaX = centerX - wideX+        !deltaY = centerY - wideY+    MUV.unsafeWrite arena index (deltaX * deltaX + deltaY * deltaY, wideX, wideY, raw)+  pure arena++-- | Claim a position for the vertex the arena would append next, or answer the+-- vertex already holding it. The claim is written before the append, so the two+-- must stay adjacent: nothing may consume a vertex slot in between.+claimPosition+  :: MutableDcel s vertex directed undirected face+  -> MutablePointIndex s+  -> Point+  -> vertex+  -> ST s (Either BuildError PositionClaim)+claimPosition mutable table rawPoint vertexData =+  case rawPoint of+    Point x y -> do+      let !canonicalX = canonicalCoordinate x+          !canonicalY = canonicalCoordinate y+      slot <- nextVertexSlot mutable+      let !candidate = nextVertexSlotIndex slot+      owner <-+        resolveMutablePoint+          table+          (readPointX mutable)+          (readPointY mutable)+          canonicalX+          canonicalY+          candidate+      case owner of+        Left failure -> pure (Left failure)+        Right (Just existing) -> pure (Right (ResidentPosition existing))+        Right Nothing -> do+          vertex <- appendVertexCoordinatesAtSlot mutable slot canonicalX canonicalY vertexData+          pure (Right (FreshPosition vertex canonicalX canonicalY))+-- | Enter the positions a batch inherits from the triangulation it extends, so+-- that an input repeating one of them maps to the vertex already there.+seedPointTable+  :: MutableDcel s vertex directed undirected face+  -> MutablePointIndex s+  -> ST s (Either BuildError ())+seedPointTable mutable table = do+  existing <- pointCount mutable+  seedMutablePointIndex+    table+    existing+    (readPointX mutable)+    (readPointY mutable)++validateVertices :: HasPosition vertex => V.Vector vertex -> Either BuildError ()+validateVertices vertices =+  V.iforM_ vertices (\index vertexData -> validatePoint (Just index) (position vertexData))

@@ -11,7 +11,7 @@  import qualified Data.IntSet as IntSet import qualified Moonlight.Triangulation.Dcel as Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.Representation import Moonlight.Triangulation.Internal.Types import Moonlight.Triangulation.Math

@@ -15,7 +15,7 @@ import Control.Monad.ST (ST) import Data.Either (isRight) import qualified Data.Vector as V-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.Cdt.Combinators (foldWhileM) import Moonlight.Triangulation.Internal.Cdt.Query (validateEndpoints) import Moonlight.Triangulation.Internal.Cdt.Recovery (applyMutableConstraint)

@@ -14,7 +14,7 @@ import Data.Primitive.PrimArray (PrimArray, indexPrimArray, sizeofPrimArray) import Data.Word (Word32) import Moonlight.Triangulation.BulkLoad (delaunay)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.Cdt.Batch (recoverConstraints) import Moonlight.Triangulation.Internal.Cdt.Types import Moonlight.Triangulation.Internal.Representation

@@ -11,7 +11,7 @@   , directedInt   ) where -import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( DirectedEdgeId (..)   , VertexId (..)   )

@@ -20,7 +20,7 @@  import Control.Monad.ST (ST) import Data.Bits (xor)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.IntersectionIterator (Intersection (..)) import Moonlight.Triangulation.Internal.Cdt.Combinators   ( directedInt

@@ -17,7 +17,7 @@  import Control.Monad.ST (ST) import Data.Bits (xor)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.IntersectionIterator import Moonlight.Triangulation.Internal.Cdt.Combinators   ( directedInt

@@ -21,7 +21,7 @@ import Data.Bits (xor) import qualified Data.IntSet as IntSet import qualified Moonlight.Triangulation.Dcel as Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.IntersectionIterator import Moonlight.Triangulation.Internal.Cdt.Admission   ( ConstraintAdmission (..)

@@ -18,7 +18,7 @@ import Data.Bits (xor) import Data.Either (isRight) import Data.Foldable (traverse_)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.Cdt.Combinators   ( foldWhileM   , vertexInt

@@ -10,7 +10,7 @@ import qualified Data.IntSet as IntSet import qualified Moonlight.Triangulation.Dcel as Dcel import Moonlight.Triangulation.FloodFillIterator (facesAtEvenBarrierDepth)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Handles.Iterators.FixedIterators (innerFaces) import Moonlight.Triangulation.Internal.Representation import Moonlight.Triangulation.Internal.Types

@@ -17,7 +17,7 @@ import Data.Primitive.PrimArray (indexPrimArray, sizeofPrimArray) import Moonlight.Triangulation.BulkLoad (insertMany) import qualified Moonlight.Triangulation.Dcel as Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.Cdt.Admission   ( ConstraintAdmission (..)   , constraintAdmission

@@ -9,7 +9,7 @@   ) where  import Control.Monad.ST (ST)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Insertion (insertVertexAtPoint) import Moonlight.Triangulation.Internal.Mutable import Moonlight.Triangulation.Internal.OperationState

@@ -14,7 +14,7 @@ import qualified Data.List as List import qualified Data.Vector as V import qualified Moonlight.Triangulation.Dcel as Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.Cdt.Combinators   ( asConstraintStep   , bindMutable

@@ -37,7 +37,7 @@ import Control.DeepSeq (NFData) import Data.List.NonEmpty (NonEmpty) import qualified Data.Vector as V-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( DirectedEdgeId   , FaceId   , UndirectedEdgeId

@@ -27,7 +27,7 @@ import qualified Data.Set as Set import qualified Data.Vector as V import qualified Moonlight.Triangulation.Dcel as Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.Canonical (canonicalize) import Moonlight.Triangulation.Insertion (insertAdmittedPointCombining) import Moonlight.Triangulation.Refinement (validateRefinementParameters)

@@ -20,7 +20,7 @@ import qualified Data.Vector.Unboxed.Mutable as MUV import Data.Word (Word32, Word64) import GHC.Float (castDoubleToWord64)-import Moonlight.Triangulation.Handles.HandleDefs (DirectedEdgeId (..))+import Moonlight.Triangulation.Internal.HandleDefs (DirectedEdgeId (..)) import Moonlight.Triangulation.Insertion (insertExistingVertex) import Moonlight.Triangulation.Internal.DcelOperations.Hull   ( ReservedSweepCells

@@ -16,7 +16,7 @@   ( legalizeCavityFanScratch   , legalizeEdges   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.Mutable import Moonlight.Triangulation.Internal.OperationState   ( Counter (..)

@@ -31,7 +31,7 @@ import Moonlight.Triangulation.JoinSemilattice   ( JoinSemilattice (joinAnnotations)   )-import Moonlight.Triangulation.Session+import Moonlight.Triangulation.Internal.Session   ( insertAdmittedVertexAtCombining   , withLocalSession   )@@ -43,7 +43,7 @@ -- the larger operand's vertex handles and untouched pages survive. Comparable -- operands may merge along a separating seam or rebuild from their combined -- site set. Every schedule returns valid topology;--- 'Moonlight.Triangulation.Dcel.canonicalize' is the+-- 'Moonlight.Triangulation.Canonical.canonicalize' is the -- separate physical observation when construction-independent numbering is -- required. --

@@ -44,8 +44,8 @@   , vertexOutEdge   , vertexData   )-import Moonlight.Triangulation.FloodFillIterator (floodFillFacesWithRejectedEdges)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.FloodFillIterator (floodFillFacesWithRejectedEdges)+import Moonlight.Triangulation.Internal.HandleDefs   ( DirectedEdgeId (..)   , FaceId (..)   , UndirectedEdgeId (..)

@@ -31,9 +31,9 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MUV-import Moonlight.Triangulation.BulkLoad (delaunayFromAdmittedDistinctAscending)+import Moonlight.Triangulation.Internal.BulkLoad (delaunayFromAdmittedDistinctAscending) import Moonlight.Triangulation.Dcel (numVertices, vertexData, vertexPoint)-import Moonlight.Triangulation.Handles.HandleDefs (VertexId (..))+import Moonlight.Triangulation.Internal.HandleDefs (VertexId (..)) import Moonlight.Triangulation.Internal.Canonical (canonicalizeKnownAscending) import Moonlight.Triangulation.Handles.Iterators.FixedIterators   ( foldVertices'

@@ -22,7 +22,7 @@   , addCounter   , maxCounter   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId (..)   , UndirectedEdgeId (..)   )

@@ -27,7 +27,7 @@ import Data.STRef (STRef, modifySTRef', newSTRef, readSTRef, writeSTRef) import qualified Data.Vector.Unboxed.Mutable as MUV import Data.Word (Word32)-import Moonlight.Triangulation.Handles.HandleDefs (FaceId (..), UndirectedEdgeId (..))+import Moonlight.Triangulation.Internal.HandleDefs (FaceId (..), UndirectedEdgeId (..)) import Moonlight.Triangulation.Internal.DcelOperations.Legalize (legalizeEdges) import Moonlight.Triangulation.Internal.DcelOperations.Subdivide (insertOnEdge) import Moonlight.Triangulation.Internal.DcelOperations.Twin (reverseIndex)

@@ -0,0 +1,377 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}++-- | One owned editing transaction over a triangulation: thaw once, edit, publish once.+module Moonlight.Triangulation.Internal.Session+  ( RemovalOutcome (..)+  , Session+  , withSession+  , withLocalSession+  , insertVertex+  , insertVertexAt+  , insertVertexAtNear+  , insertAdmittedVertexAtCombining+  , removeAt+  , removeAtNear+  , removeManyAt+  , removeManyAtNear+  , excise+  , refuse+  ) where++import Control.DeepSeq (NFData)+import Control.Monad.ST (ST)+import Data.Bits (xor)+import qualified Data.Vector as V+import Moonlight.Triangulation.Internal.HandleDefs+import Moonlight.Triangulation.Insertion+  ( insertAdmittedPointCombining+  , insertPointCombining+  )+import Moonlight.Triangulation.Internal.Excision (removeMutable)+import Moonlight.Triangulation.Internal.Location (MutableLocation (..), locateMutable)+import Moonlight.Triangulation.Internal.Mutable+import Moonlight.Triangulation.Internal.OperationState (OperationState)+import Moonlight.Triangulation.Internal.Paged (TransactionShape (..))+import Moonlight.Triangulation.Math (canonicalPoint)+import Moonlight.Triangulation.Internal.Representation+import Moonlight.Triangulation.Internal.Transaction (runTransaction)+import Moonlight.Triangulation.Internal.Types+import GHC.Generics (Generic)++-- | What a single removal produced: the removed position and payload, plus the+-- slot and position changed by swap compaction when another vertex moved.+data RemovalOutcome vertex = RemovalOutcome+  { removalOutcomePoint :: !(Point)+  , removalOutcomeData :: !vertex+  , removalOutcomeSwap :: !(Maybe (VertexId, Point))+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)++-- | An edit sequence against one thawed mesh.+--+-- The two published entry points before this one — an insertion session and a+-- removal session — each handed the caller a function and could not compose,+-- so a caller who wanted to remove a hundred vertices and insert fifty thawed+-- twice and paid the O(n) publication a session exists to delete. They are the+-- same transaction; only the verb differed. This is that transaction, and the+-- verbs are its primitives.+--+-- The public session algebra and the private exact-site single-insertion+-- interpreter cross the same hidden transaction boundary. Sessions provide+-- composition; the private interpreter reaches that boundary only with+-- evidence from the immediately preceding frozen read. A fold of persistent+-- verbs and a session over the same verbs therefore differ only in which+-- intermediate meshes they publish.+--+-- Refusal short-circuits: the first 'BuildError' abandons the rest of the+-- sequence, and 'withSession' freezes nothing. A partly edited arena cannot+-- reach a caller as a published triangulation.+newtype Session s vertex directed undirected face a = Session+  { stepSession+      :: MutableDcel s vertex directed undirected face+      -> OperationState s+      -> ST s (Either BuildError a)+  }++instance Functor (Session s vertex directed undirected face) where+  fmap f (Session step) = Session $ \mesh operation -> fmap (fmap f) (step mesh operation)+  {-# INLINE fmap #-}++instance Applicative (Session s vertex directed undirected face) where+  pure a = Session $ \_ _ -> pure (Right a)+  {-# INLINE pure #-}+  Session left <*> Session right = Session $ \mesh operation -> do+    outcome <- left mesh operation+    case outcome of+      Left refusal -> pure (Left refusal)+      Right f -> fmap (fmap f) (right mesh operation)+  {-# INLINE (<*>) #-}++instance Monad (Session s vertex directed undirected face) where+  Session step >>= f = Session $ \mesh operation -> do+    outcome <- step mesh operation+    case outcome of+      Left refusal -> pure (Left refusal)+      Right a -> stepSession (f a) mesh operation+  {-# INLINE (>>=) #-}++-- | Abandon the transaction. Nothing is published.+refuse :: BuildError -> Session s vertex directed undirected face a+refuse failure = Session $ \_ _ -> pure (Left failure)+{-# INLINE refuse #-}++-- | Insert a vertex, answering the handle it was given. A point already+-- present keeps its handle and takes the new payload.+insertVertex+  :: HasPosition vertex+  => vertex+  -> Session s vertex directed undirected face VertexId+insertVertex payload = Session $ \mesh operation ->+  fmap+    (fmap (VertexId . fromIntegral . fst))+    (insertPointCombining (\_ replacement -> replacement) Nothing mesh operation (position payload) payload)++-- | Insert at a stated point, answering the handle and whether a site was+-- created. 'insertVertex' is this with the point read out of the payload; a+-- caller that computed the point — a constraint split, a Steiner refinement —+-- states it rather than round-tripping through 'HasPosition'.+insertVertexAt+  :: Point+  -> vertex+  -> Session s vertex directed undirected face (VertexId, InsertionDisposition)+insertVertexAt point payload = Session $ \mesh operation ->+  fmap+    (fmap (\(vertex, disposition) -> (VertexId (fromIntegral vertex), disposition)))+    (insertPointCombining (\_ replacement -> replacement) Nothing mesh operation point payload)++-- | 'insertVertexAt' with the walk seeded at a face the caller vouches for --+-- typically the face a locate on the just-published value settled on, which+-- is exact on the mesh this transaction thawed. The seed is a hint, not an+-- authority: an out-of-range face degrades to the unhinted descent, and the+-- walk corrects.+insertVertexAtNear+  :: FaceId+  -> Point+  -> vertex+  -> Session s vertex directed undirected face (VertexId, InsertionDisposition)+insertVertexAtNear (FaceId rawSeed) point payload = Session $ \mesh operation ->+  fmap+    (fmap (\(vertex, disposition) -> (VertexId (fromIntegral vertex), disposition)))+    (insertPointCombining+       (\_ replacement -> replacement)+       (Just (fromIntegral rawSeed))+       mesh+       operation+       point+       payload+    )++-- | Insert an admitted site while combining an occupied annotation. This is+-- package-internal descent from a boundary that already owns coordinate+-- admission; only location and annotation gluing remain here.+insertAdmittedVertexAtCombining+  :: (vertex -> vertex -> vertex)+  -> QueryPoint+  -> vertex+  -> Session s vertex directed undirected face (VertexId, InsertionDisposition)+insertAdmittedVertexAtCombining combine queryPoint payload = Session $ \mesh operation ->+  fmap+    (fmap (\(vertex, disposition) -> (VertexId (fromIntegral vertex), disposition)))+    (insertAdmittedPointCombining combine Nothing mesh operation queryPoint payload)++-- | Remove the vertex standing at a point, answering 'Nothing' when no vertex+-- stands there.+--+-- Keyed by position rather than by handle because removal swap-compacts the+-- arenas: every outstanding t'VertexId' may relocate, and over a sequence of+-- removals a handle-keyed verb would force the caller to thread every+-- relocation by hand. A position is invariant under compaction. The relocation+-- is still reported, in the 'RemovalOutcome', for callers holding handles.+-- The question is an identity question -- which vertex stands at this exact+-- position. A session that has committed to identity work ('removeManyAt',+-- 'excise') answers it through the identity index in O(1); one that has not+-- answers it with a single walk, because a published index is a lazy rebuild+-- and forcing a whole-mesh build to answer one question is the wrong trade.+removeAt+  :: Point+  -> Session s vertex directed undirected face (Maybe (RemovalOutcome vertex))+removeAt point = Session $ \mesh operation -> do+  indexed <- identityIndexActive mesh+  if indexed+    then removeIndexed mesh operation point+    else walkAndRemove mesh operation Nothing point++removeIndexed+  :: MutableDcel s vertex directed undirected face+  -> OperationState s+  -> Point+  -> ST s (Either BuildError (Maybe (RemovalOutcome vertex)))+removeIndexed mesh operation point = do+  located <- lookupPointVertex mesh point+  case located of+    Just vertex -> fmap (fmap Just) (removeMutableOutcome mesh operation vertex)+    Nothing -> pure (Right Nothing)++-- | Remove the vertex standing at a point, starting from a caller-supplied+-- near vertex -- a locate hint from an external structure such as the+-- Delaunay hierarchy. The guess is a hint, not an authority: a slot renamed+-- by swap-compaction or out of range degrades to a walk hinted by the+-- guess's incident face, and the walk corrects.+removeAtNear+  :: VertexId+  -> Point+  -> Session s vertex directed undirected face (Maybe (RemovalOutcome vertex))+removeAtNear (VertexId rawGuess) point = Session $ \mesh operation -> do+  indexed <- identityIndexActive mesh+  let !guess = fromIntegral rawGuess+      !query = canonicalPoint point+  if indexed+    then removeIndexed mesh operation query+    else do+      vertices <- pointCount mesh+      if guess < 0 || guess >= vertices+        then walkAndRemove mesh operation Nothing query+        else do+          stored <- pointAt mesh guess+          if stored == query+            then fmap (fmap Just) (removeMutableOutcome mesh operation guess)+            else do+              outgoing <- readVertexOut mesh guess+              let interiorFace edge fallback = do+                    face <- readFace mesh edge+                    if face > 0 then pure (Just face) else fallback+              hint <-+                if outgoing < 0+                  then pure Nothing+                  else interiorFace outgoing (interiorFace (outgoing `xor` 1) (pure Nothing))+              walkAndRemove mesh operation hint query++walkAndRemove+  :: MutableDcel s vertex directed undirected face+  -> OperationState s+  -> Maybe Int+  -> Point+  -> ST s (Either BuildError (Maybe (RemovalOutcome vertex)))+walkAndRemove mesh operation hint query = do+  located <- locateMutable mesh operation hint query+  case located of+    Left obstruction -> pure (Left obstruction)+    Right (MutableOnVertex vertex) ->+      fmap (fmap Just) (removeMutableOutcome mesh operation vertex)+    Right _ -> pure (Right Nothing)++-- | Remove the vertex standing at each point, answering per point in order.+-- One session-level decision buys the locate strategy: few removals walk the+-- mesh, each a ~O(sqrt n) descent, while many seed the existing mutable+-- open-addressed identity section once from coordinate authority and answer+-- each question by hash. The guard squares the crossover to avoid a root.+removeManyAt+  :: V.Vector (Point)+  -> Session s vertex directed undirected face (V.Vector (Maybe (RemovalOutcome vertex)))+removeManyAt points =+  withBatchIdentityForLoad (V.length points) (V.mapM removeAt points)++-- | Install the mutable identity section only around a dense removal program.+-- It is a local section over the coordinate arenas, not a new published cache:+-- on every result path it is discarded and freeze glues a lazy @PointIndex@+-- back from those arenas. Sparse loads retain the existing locate walk.+withBatchIdentityForLoad+  :: Int+  -> Session s vertex directed undirected face result+  -> Session s vertex directed undirected face result+withBatchIdentityForLoad count (Session action) = Session $ \mesh operation -> do+  vertices <- pointCount mesh+  if count * count > 10 * vertices+    then do+      activated <- activateBatchPointIndex mesh+      case activated of+        Left failure -> pure (Left failure)+        Right () -> do+          outcome <- action mesh operation+          discardBatchPointIndex mesh+          pure outcome+    else action mesh operation++identityCommitted :: Session s vertex directed undirected face Bool+identityCommitted = Session $ \mesh _ -> fmap Right (identityIndexActive mesh)+{-# INLINE identityCommitted #-}++-- | 'removeManyAt' with a near vertex per point where the caller has one — a+-- hierarchy sample, a previous answer. The batch commits to its load first,+-- so the identity-index crossover decides the regime once: a dense batch buys+-- its local mutable table and never examines a guess, a sparse one walks from+-- its guesses.+removeManyAtNear+  :: V.Vector (Maybe VertexId)+  -> V.Vector (Point)+  -> Session s vertex directed undirected face (V.Vector (Maybe (RemovalOutcome vertex)))+removeManyAtNear guesses points =+  withBatchIdentityForLoad (V.length points) $ do+    indexed <- identityCommitted+    if indexed+      then V.mapM removeAt points+      else+        V.zipWithM+          (\guess point -> maybe (removeAt point) (\vertex -> removeAtNear vertex point) guess)+          guesses+          points++-- | Remove a stated vertex. Sound only while the handle still denotes what the+-- caller means: the first removal in a sequence compacts the arenas, so a+-- handle taken before it may name a different vertex after. @removeAt@ is the+-- verb for a sequence; this is the verb for a handle the caller has just been+-- given and has not yet let a removal run underneath.+excise+  :: VertexId+  -> Session s vertex directed undirected face (RemovalOutcome vertex)+excise requested@(VertexId raw) = Session $ \mesh operation -> do+  vertices <- pointCount mesh+  if toInteger raw >= toInteger vertices+    then pure (Left (RemovalVertexOutOfRange requested vertices))+    else do+      activatePointIndex mesh+      removeMutableOutcome mesh operation (fromIntegral raw)++removeMutableOutcome+  :: MutableDcel s vertex directed undirected face+  -> OperationState s+  -> Int+  -> ST s (Either BuildError (RemovalOutcome vertex))+removeMutableOutcome mesh operation vertex =+  fmap (fmap removalOutcomeOf) (removeMutable mesh operation vertex)++removalOutcomeOf+  :: (Point, vertex, Maybe (Int, Point))+  -> RemovalOutcome vertex+removalOutcomeOf (point, payload, swapped) =+  RemovalOutcome+    { removalOutcomePoint = point+    , removalOutcomeData = payload+    , removalOutcomeSwap =+        (\(slot, standing) -> (VertexId (fromIntegral slot), standing)) <$> swapped+    }++-- | Run an edit sequence: thaw once, edit, freeze once, and publish the+-- counters the whole transaction charged.+--+-- The reservation is taken for the peak vertex count, so it is the insertion+-- count that sizes it; removals only shrink the mesh and a mixed sequence+-- cannot exceed the peak an insert-only sequence of the same count reaches.+--+-- The session cannot escape its callback: the state token is universally+-- quantified, so the mesh it addresses is dead by the time the frozen+-- triangulation is returned.+withSession+  :: forall mode vertex directed undirected face result+   . Triangulation mode vertex directed undirected face+  -> Int+  -> (forall s. Session s vertex directed undirected face result)+  -> Either BuildError (result, Triangulation mode vertex directed undirected face, BuildStats)+withSession triangulation additional session =+  runTransaction+    id+    DenseTransaction+    triangulation+    additional+    (\mesh operation -> stepSession session mesh operation)++-- | The local-edit transaction: copy-on-write pages, publication proportional+-- to what the edit dirtied. This is the section for singleton persistent+-- verbs, whose one edit cannot amortize a dense copy of the whole mesh.+withLocalSession+  :: forall mode vertex directed undirected face result+   . Triangulation mode vertex directed undirected face+  -> Int+  -> (forall s. Session s vertex directed undirected face result)+  -> Either BuildError (result, Triangulation mode vertex directed undirected face, BuildStats)+withLocalSession triangulation additional session =+  runTransaction+    id+    LocalTransaction+    triangulation+    additional+    (\mesh operation -> stepSession session mesh operation)

@@ -32,7 +32,7 @@   , vertexPoint   ) import Moonlight.Triangulation.FloodFillIterator (facesAtEvenBarrierDepth)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId (..)   , UndirectedEdgeId (..)   , asUndirected@@ -47,10 +47,12 @@ import Moonlight.Triangulation.Internal.Refinement import Moonlight.Triangulation.Internal.Representation (Triangulation (..)) import Moonlight.Triangulation.Internal.Transaction (runTransactionWithPublication)+import Moonlight.Triangulation.Internal.Validation+  ( validateTopologyClosureWithStats+  ) import Moonlight.Triangulation.Types import Moonlight.Triangulation.Validation   ( validateTopology-  , validateTopologyClosureWithStats   )  data RefinementExecution mode vertex directed undirected face = RefinementExecution

@@ -11,12 +11,12 @@   ) where  import Control.DeepSeq (NFData)-import Moonlight.Triangulation.Handles.HandleDefs (VertexId (..))+import Moonlight.Triangulation.Internal.HandleDefs (VertexId (..)) import Moonlight.Triangulation.Internal.PointIndex (lookupPointIndex) import Moonlight.Triangulation.Internal.Representation (Triangulation (..)) import Moonlight.Triangulation.Internal.Types (BuildError, BuildStats, Point, queryPointValue) import Moonlight.Triangulation.Math (validatePoint)-import Moonlight.Triangulation.Session (RemovalOutcome (..), excise, withLocalSession)+import Moonlight.Triangulation.Internal.Session (RemovalOutcome (..), excise, withLocalSession) import GHC.Generics (Generic)  -- | One removal and its publication: the frozen triangulation, the outcome

@@ -1,377 +1,16 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}---- | One owned editing transaction over a triangulation: thaw once, edit, publish once.+-- | One sealed editing transaction: thaw once, compose edits, publish once. module Moonlight.Triangulation.Session   ( RemovalOutcome (..)   , Session   , withSession-  , withLocalSession   , insertVertex   , insertVertexAt   , insertVertexAtNear-  , insertAdmittedVertexAtCombining   , removeAt   , removeAtNear   , removeManyAt   , removeManyAtNear-  , excise   , refuse   ) where -import Control.DeepSeq (NFData)-import Control.Monad.ST (ST)-import Data.Bits (xor)-import qualified Data.Vector as V-import Moonlight.Triangulation.Handles.HandleDefs-import Moonlight.Triangulation.Insertion-  ( insertAdmittedPointCombining-  , insertPointCombining-  )-import Moonlight.Triangulation.Internal.Excision (removeMutable)-import Moonlight.Triangulation.Internal.Location (MutableLocation (..), locateMutable)-import Moonlight.Triangulation.Internal.Mutable-import Moonlight.Triangulation.Internal.OperationState (OperationState)-import Moonlight.Triangulation.Internal.Paged (TransactionShape (..))-import Moonlight.Triangulation.Math (canonicalPoint)-import Moonlight.Triangulation.Internal.Representation-import Moonlight.Triangulation.Internal.Transaction (runTransaction)-import Moonlight.Triangulation.Internal.Types-import GHC.Generics (Generic)---- | What a single removal produced: the removed position and payload, plus the--- slot and position changed by swap compaction when another vertex moved.-data RemovalOutcome vertex = RemovalOutcome-  { removalOutcomePoint :: !(Point)-  , removalOutcomeData :: !vertex-  , removalOutcomeSwap :: !(Maybe (VertexId, Point))-  }-  deriving stock (Eq, Show, Generic)-  deriving anyclass (NFData)---- | An edit sequence against one thawed mesh.------ The two published entry points before this one — an insertion session and a--- removal session — each handed the caller a function and could not compose,--- so a caller who wanted to remove a hundred vertices and insert fifty thawed--- twice and paid the O(n) publication a session exists to delete. They are the--- same transaction; only the verb differed. This is that transaction, and the--- verbs are its primitives.------ The public session algebra and the private exact-site single-insertion--- interpreter cross the same hidden transaction boundary. Sessions provide--- composition; the private interpreter reaches that boundary only with--- evidence from the immediately preceding frozen read. A fold of persistent--- verbs and a session over the same verbs therefore differ only in which--- intermediate meshes they publish.------ Refusal short-circuits: the first 'BuildError' abandons the rest of the--- sequence, and 'withSession' freezes nothing. A partly edited arena cannot--- reach a caller as a published triangulation.-newtype Session s vertex directed undirected face a = Session-  { stepSession-      :: MutableDcel s vertex directed undirected face-      -> OperationState s-      -> ST s (Either BuildError a)-  }--instance Functor (Session s vertex directed undirected face) where-  fmap f (Session step) = Session $ \mesh operation -> fmap (fmap f) (step mesh operation)-  {-# INLINE fmap #-}--instance Applicative (Session s vertex directed undirected face) where-  pure a = Session $ \_ _ -> pure (Right a)-  {-# INLINE pure #-}-  Session left <*> Session right = Session $ \mesh operation -> do-    outcome <- left mesh operation-    case outcome of-      Left refusal -> pure (Left refusal)-      Right f -> fmap (fmap f) (right mesh operation)-  {-# INLINE (<*>) #-}--instance Monad (Session s vertex directed undirected face) where-  Session step >>= f = Session $ \mesh operation -> do-    outcome <- step mesh operation-    case outcome of-      Left refusal -> pure (Left refusal)-      Right a -> stepSession (f a) mesh operation-  {-# INLINE (>>=) #-}---- | Abandon the transaction. Nothing is published.-refuse :: BuildError -> Session s vertex directed undirected face a-refuse failure = Session $ \_ _ -> pure (Left failure)-{-# INLINE refuse #-}---- | Insert a vertex, answering the handle it was given. A point already--- present keeps its handle and takes the new payload.-insertVertex-  :: HasPosition vertex-  => vertex-  -> Session s vertex directed undirected face VertexId-insertVertex payload = Session $ \mesh operation ->-  fmap-    (fmap (VertexId . fromIntegral . fst))-    (insertPointCombining (\_ replacement -> replacement) Nothing mesh operation (position payload) payload)---- | Insert at a stated point, answering the handle and whether a site was--- created. 'insertVertex' is this with the point read out of the payload; a--- caller that computed the point — a constraint split, a Steiner refinement —--- states it rather than round-tripping through 'HasPosition'.-insertVertexAt-  :: Point-  -> vertex-  -> Session s vertex directed undirected face (VertexId, InsertionDisposition)-insertVertexAt point payload = Session $ \mesh operation ->-  fmap-    (fmap (\(vertex, disposition) -> (VertexId (fromIntegral vertex), disposition)))-    (insertPointCombining (\_ replacement -> replacement) Nothing mesh operation point payload)---- | 'insertVertexAt' with the walk seeded at a face the caller vouches for ----- typically the face a locate on the just-published value settled on, which--- is exact on the mesh this transaction thawed. The seed is a hint, not an--- authority: an out-of-range face degrades to the unhinted descent, and the--- walk corrects.-insertVertexAtNear-  :: FaceId-  -> Point-  -> vertex-  -> Session s vertex directed undirected face (VertexId, InsertionDisposition)-insertVertexAtNear (FaceId rawSeed) point payload = Session $ \mesh operation ->-  fmap-    (fmap (\(vertex, disposition) -> (VertexId (fromIntegral vertex), disposition)))-    (insertPointCombining-       (\_ replacement -> replacement)-       (Just (fromIntegral rawSeed))-       mesh-       operation-       point-       payload-    )---- | Insert an admitted site while combining an occupied annotation. This is--- package-internal descent from a boundary that already owns coordinate--- admission; only location and annotation gluing remain here.-insertAdmittedVertexAtCombining-  :: (vertex -> vertex -> vertex)-  -> QueryPoint-  -> vertex-  -> Session s vertex directed undirected face (VertexId, InsertionDisposition)-insertAdmittedVertexAtCombining combine queryPoint payload = Session $ \mesh operation ->-  fmap-    (fmap (\(vertex, disposition) -> (VertexId (fromIntegral vertex), disposition)))-    (insertAdmittedPointCombining combine Nothing mesh operation queryPoint payload)---- | Remove the vertex standing at a point, answering 'Nothing' when no vertex--- stands there.------ Keyed by position rather than by handle because removal swap-compacts the--- arenas: every outstanding t'VertexId' may relocate, and over a sequence of--- removals a handle-keyed verb would force the caller to thread every--- relocation by hand. A position is invariant under compaction. The relocation--- is still reported, in the 'RemovalOutcome', for callers holding handles.--- The question is an identity question -- which vertex stands at this exact--- position. A session that has committed to identity work ('removeManyAt',--- 'excise') answers it through the identity index in O(1); one that has not--- answers it with a single walk, because a published index is a lazy rebuild--- and forcing a whole-mesh build to answer one question is the wrong trade.-removeAt-  :: Point-  -> Session s vertex directed undirected face (Maybe (RemovalOutcome vertex))-removeAt point = Session $ \mesh operation -> do-  indexed <- identityIndexActive mesh-  if indexed-    then removeIndexed mesh operation point-    else walkAndRemove mesh operation Nothing point--removeIndexed-  :: MutableDcel s vertex directed undirected face-  -> OperationState s-  -> Point-  -> ST s (Either BuildError (Maybe (RemovalOutcome vertex)))-removeIndexed mesh operation point = do-  located <- lookupPointVertex mesh point-  case located of-    Just vertex -> fmap (fmap Just) (removeMutableOutcome mesh operation vertex)-    Nothing -> pure (Right Nothing)---- | Remove the vertex standing at a point, starting from a caller-supplied--- near vertex -- a locate hint from an external structure such as the--- Delaunay hierarchy. The guess is a hint, not an authority: a slot renamed--- by swap-compaction or out of range degrades to a walk hinted by the--- guess's incident face, and the walk corrects.-removeAtNear-  :: VertexId-  -> Point-  -> Session s vertex directed undirected face (Maybe (RemovalOutcome vertex))-removeAtNear (VertexId rawGuess) point = Session $ \mesh operation -> do-  indexed <- identityIndexActive mesh-  let !guess = fromIntegral rawGuess-      !query = canonicalPoint point-  if indexed-    then removeIndexed mesh operation query-    else do-      vertices <- pointCount mesh-      if guess < 0 || guess >= vertices-        then walkAndRemove mesh operation Nothing query-        else do-          stored <- pointAt mesh guess-          if stored == query-            then fmap (fmap Just) (removeMutableOutcome mesh operation guess)-            else do-              outgoing <- readVertexOut mesh guess-              let interiorFace edge fallback = do-                    face <- readFace mesh edge-                    if face > 0 then pure (Just face) else fallback-              hint <--                if outgoing < 0-                  then pure Nothing-                  else interiorFace outgoing (interiorFace (outgoing `xor` 1) (pure Nothing))-              walkAndRemove mesh operation hint query--walkAndRemove-  :: MutableDcel s vertex directed undirected face-  -> OperationState s-  -> Maybe Int-  -> Point-  -> ST s (Either BuildError (Maybe (RemovalOutcome vertex)))-walkAndRemove mesh operation hint query = do-  located <- locateMutable mesh operation hint query-  case located of-    Left obstruction -> pure (Left obstruction)-    Right (MutableOnVertex vertex) ->-      fmap (fmap Just) (removeMutableOutcome mesh operation vertex)-    Right _ -> pure (Right Nothing)---- | Remove the vertex standing at each point, answering per point in order.--- One session-level decision buys the locate strategy: few removals walk the--- mesh, each a ~O(sqrt n) descent, while many seed the existing mutable--- open-addressed identity section once from coordinate authority and answer--- each question by hash. The guard squares the crossover to avoid a root.-removeManyAt-  :: V.Vector (Point)-  -> Session s vertex directed undirected face (V.Vector (Maybe (RemovalOutcome vertex)))-removeManyAt points =-  withBatchIdentityForLoad (V.length points) (V.mapM removeAt points)---- | Install the mutable identity section only around a dense removal program.--- It is a local section over the coordinate arenas, not a new published cache:--- on every result path it is discarded and freeze glues a lazy @PointIndex@--- back from those arenas. Sparse loads retain the existing locate walk.-withBatchIdentityForLoad-  :: Int-  -> Session s vertex directed undirected face result-  -> Session s vertex directed undirected face result-withBatchIdentityForLoad count (Session action) = Session $ \mesh operation -> do-  vertices <- pointCount mesh-  if count * count > 10 * vertices-    then do-      activated <- activateBatchPointIndex mesh-      case activated of-        Left failure -> pure (Left failure)-        Right () -> do-          outcome <- action mesh operation-          discardBatchPointIndex mesh-          pure outcome-    else action mesh operation--identityCommitted :: Session s vertex directed undirected face Bool-identityCommitted = Session $ \mesh _ -> fmap Right (identityIndexActive mesh)-{-# INLINE identityCommitted #-}---- | 'removeManyAt' with a near vertex per point where the caller has one — a--- hierarchy sample, a previous answer. The batch commits to its load first,--- so the identity-index crossover decides the regime once: a dense batch buys--- its local mutable table and never examines a guess, a sparse one walks from--- its guesses.-removeManyAtNear-  :: V.Vector (Maybe VertexId)-  -> V.Vector (Point)-  -> Session s vertex directed undirected face (V.Vector (Maybe (RemovalOutcome vertex)))-removeManyAtNear guesses points =-  withBatchIdentityForLoad (V.length points) $ do-    indexed <- identityCommitted-    if indexed-      then V.mapM removeAt points-      else-        V.zipWithM-          (\guess point -> maybe (removeAt point) (\vertex -> removeAtNear vertex point) guess)-          guesses-          points---- | Remove a stated vertex. Sound only while the handle still denotes what the--- caller means: the first removal in a sequence compacts the arenas, so a--- handle taken before it may name a different vertex after. @removeAt@ is the--- verb for a sequence; this is the verb for a handle the caller has just been--- given and has not yet let a removal run underneath.-excise-  :: VertexId-  -> Session s vertex directed undirected face (RemovalOutcome vertex)-excise requested@(VertexId raw) = Session $ \mesh operation -> do-  vertices <- pointCount mesh-  if toInteger raw >= toInteger vertices-    then pure (Left (RemovalVertexOutOfRange requested vertices))-    else do-      activatePointIndex mesh-      removeMutableOutcome mesh operation (fromIntegral raw)--removeMutableOutcome-  :: MutableDcel s vertex directed undirected face-  -> OperationState s-  -> Int-  -> ST s (Either BuildError (RemovalOutcome vertex))-removeMutableOutcome mesh operation vertex =-  fmap (fmap removalOutcomeOf) (removeMutable mesh operation vertex)--removalOutcomeOf-  :: (Point, vertex, Maybe (Int, Point))-  -> RemovalOutcome vertex-removalOutcomeOf (point, payload, swapped) =-  RemovalOutcome-    { removalOutcomePoint = point-    , removalOutcomeData = payload-    , removalOutcomeSwap =-        (\(slot, standing) -> (VertexId (fromIntegral slot), standing)) <$> swapped-    }---- | Run an edit sequence: thaw once, edit, freeze once, and publish the--- counters the whole transaction charged.------ The reservation is taken for the peak vertex count, so it is the insertion--- count that sizes it; removals only shrink the mesh and a mixed sequence--- cannot exceed the peak an insert-only sequence of the same count reaches.------ The session cannot escape its callback: the state token is universally--- quantified, so the mesh it addresses is dead by the time the frozen--- triangulation is returned.-withSession-  :: forall mode vertex directed undirected face result-   . Triangulation mode vertex directed undirected face-  -> Int-  -> (forall s. Session s vertex directed undirected face result)-  -> Either BuildError (result, Triangulation mode vertex directed undirected face, BuildStats)-withSession triangulation additional session =-  runTransaction-    id-    DenseTransaction-    triangulation-    additional-    (\mesh operation -> stepSession session mesh operation)---- | The local-edit transaction: copy-on-write pages, publication proportional--- to what the edit dirtied. This is the section for singleton persistent--- verbs, whose one edit cannot amortize a dense copy of the whole mesh.-withLocalSession-  :: forall mode vertex directed undirected face result-   . Triangulation mode vertex directed undirected face-  -> Int-  -> (forall s. Session s vertex directed undirected face result)-  -> Either BuildError (result, Triangulation mode vertex directed undirected face, BuildStats)-withLocalSession triangulation additional session =-  runTransaction-    id-    LocalTransaction-    triangulation-    additional-    (\mesh operation -> stepSession session mesh operation)+import Moonlight.Triangulation.Internal.Session

@@ -40,7 +40,7 @@   , unitElementDefaults   ) import Moonlight.Triangulation.JoinSemilattice (JoinSemilattice)-import Moonlight.Triangulation.Session+import Moonlight.Triangulation.Internal.Session   ( Session   , insertVertexAt   , refuse@@ -61,7 +61,7 @@ {-# INLINE siteRelation #-}  -- | A valid Delaunay representative of both site sets. Use--- 'Moonlight.Triangulation.Dcel.canonicalize'+-- 'Moonlight.Triangulation.Canonical.canonicalize' -- when construction-independent dense numbering is required. union   :: JoinSemilattice annotation

@@ -60,7 +60,7 @@   , alphaVertexBirth   ) import Moonlight.Triangulation.Dcel qualified as Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( DirectedEdgeId,     FaceId (..),     UndirectedEdgeId (..),

@@ -39,7 +39,7 @@   , exactCellSet   ) import Moonlight.Triangulation.Dcel qualified as Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId (..)   , UndirectedEdgeId (..)   , VertexId (..)

@@ -0,0 +1,6 @@+-- | Construction-independent resident numbering for explicit global comparison.+module Moonlight.Triangulation.Canonical+  ( canonicalize+  ) where++import Moonlight.Triangulation.Internal.Canonical (canonicalize)

@@ -58,7 +58,7 @@ import GHC.Exts (build) import Moonlight.Triangulation.Internal.BoxedPaged (boxedUnsafeIndex, boxedUpdate) import Moonlight.Triangulation.Internal.Paged (pagedLength, pagedUnsafeIndex)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.PackedIndex (unpackOptionalIndex) import Moonlight.Triangulation.Internal.Representation import Moonlight.Triangulation.Internal.Types

@@ -1,9 +1,4 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleInstances #-}---- | Shape queries and face flood fills over immutable triangulations.+-- | Shape queries, face descent, and boundary gluing over an immutable mesh. module Moonlight.Triangulation.FloodFillIterator   ( DistanceMetric (..)   , CircleMetric@@ -19,7 +14,6 @@   , edgesInRectangle   , verticesInRectangle   , floodFillFaces-  , floodFillFacesWithRejectedEdges   , outerFaceFloodFill   , facesAtEvenBarrierDepth   , FaceComponent@@ -41,699 +35,4 @@   , componentBoundaryForFaces   ) where -import Control.DeepSeq (NFData)-import Data.Bifunctor (first)-import qualified Data.IntMap.Strict as IntMap-import qualified Data.IntSet as IntSet-import Data.List (partition, unfoldr)-import qualified Data.List as List-import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Map.Strict as Map-import qualified Data.Sequence as Seq-import qualified Data.Set as Set-import qualified Data.Vector as V-import GHC.Generics (Generic)-import Moonlight.Triangulation.Dcel-import Moonlight.Triangulation.Handles.HandleDefs-import Moonlight.Triangulation.Handles.Iterators.FixedIterators (undirectedEdges)-import Moonlight.Triangulation.Internal.BoundaryCycle-  ( simplifyBoundaryCycle-  , traceOrientedBoundaryCircuits-  )-import Moonlight.Triangulation.Math-import Moonlight.Triangulation.PointLocation-import Moonlight.Triangulation.Types---- | One non-empty connected set of equally labelled bounded face indices.-newtype FaceComponent = FaceComponent IntSet.IntSet-  deriving stock (Eq, Show, Generic)-  deriving anyclass (NFData)---- | Component faces in ascending DCEL order.-faceComponentFaces :: FaceComponent -> [FaceId]-faceComponentFaces (FaceComponent faces) =-  fmap (FaceId . fromIntegral) (IntSet.toAscList faces)---- | Winding carried explicitly by a simple boundary loop.-data BoundaryOrientation-  = BoundaryCounterClockwise-  | BoundaryClockwise-  deriving stock (Eq, Ord, Show, Generic)-  deriving anyclass (NFData)---- | One non-empty simple boundary loop. Counter-clockwise loops contribute--- filled area under nonzero winding; clockwise loops subtract holes.-data BoundaryLoop = BoundaryLoop-  { boundaryLoopOrientation :: !BoundaryOrientation-  -- | Exact resident DCEL boundary chain. Consecutive vertices, including-  -- the closing pair, are endpoints of one boundary half-edge.-  , boundaryLoopResidentVertices :: !(NonEmpty VertexId)-  -- | Collinearity-reduced polygon observation of the same resident chain.-  , boundaryLoopVertices :: !(NonEmpty VertexId)-  }-  deriving stock (Eq, Show, Generic)-  deriving anyclass (NFData)---- | The authoritative boundary of one face component.-data RegionBoundary = RegionBoundary-  { regionBoundaryOuterLoop :: !BoundaryLoop-  , regionBoundaryHoleLoops :: ![BoundaryLoop]-  }-  deriving stock (Eq, Show, Generic)-  deriving anyclass (NFData)---- | Typed failure to descend boundary half-edges or project their oriented--- loops into one strict polygon component.-data BoundaryObstruction-  = BoundaryComponentFaceOutOfRange !FaceId {-# UNPACK #-} !Int-  | BoundaryPinch !VertexId !DirectedEdgeId !DirectedEdgeId-  | BoundaryCycleDidNotClose !DirectedEdgeId !DirectedEdgeId-  | BoundaryLoopDegenerate ![VertexId]-  | BoundaryOuterLoopCardinality !Int-  deriving stock (Eq, Show, Generic)-  deriving anyclass (NFData)---- | Complete boundary edges refined by whether each vertex has one successor.-data BoundaryGraph-  = SimpleBoundaryGraph !IntSet.IntSet !(IntMap.IntMap DirectedEdgeId)-  | PinchedBoundaryGraph-      !IntSet.IntSet-      !VertexId-      !DirectedEdgeId-      !DirectedEdgeId---- | A query shape that can admit points, test edges, and supply a location--- seed.-class DistanceMetric metric where-  metricContainsPoint :: metric -> Point -> Bool-  metricIntersectsEdge :: metric -> Point -> Point -> Bool-  metricStartPoint :: metric -> QueryPoint---- | An admitted center and squared radius.-data CircleMetric = CircleMetric !QueryPoint !RadiusSquared-  deriving stock (Eq, Ord, Show)---- | Typed refusal for an invalid circle query.-data CircleMetricError-  = InvalidCircleCenter !PointValidationError-  | InvalidCircleRadius !RadiusSquaredError-  deriving stock (Eq, Ord, Show)---- | Admitted lower corner, upper corner, and center of an axis-aligned box.-data RectangleMetric = RectangleMetric !(QueryPoint) !(QueryPoint) !(QueryPoint)-  deriving stock (Eq, Ord, Show)---- | Typed refusal for an invalid rectangle query.-data RectangleMetricError-  = InvalidRectangleLower !PointValidationError-  | InvalidRectangleUpper !PointValidationError-  | InvalidRectangleCenter !PointValidationError-  deriving stock (Eq, Ord, Show)---- | A circle metric, or why the radius is unusable.-circleMetric :: Point -> Double -> Either CircleMetricError CircleMetric-circleMetric center radiusSquared =-  CircleMetric-    <$> first InvalidCircleCenter (mkQueryPoint center)-    <*> first InvalidCircleRadius (mkRadiusSquared radiusSquared)---- | An axis-aligned rectangle metric, or why the corners are unusable.-rectangleMetric :: Point -> Point -> Either RectangleMetricError RectangleMetric-rectangleMetric lower@(Point lowerX lowerY) upper@(Point upperX upperY) = do-  queryLower <- either (Left . InvalidRectangleLower) Right (mkQueryPoint lower)-  queryUpper <- either (Left . InvalidRectangleUpper) Right (mkQueryPoint upper)-  queryCenter <--    either-      (Left . InvalidRectangleCenter)-      Right-      (mkQueryPoint (Point ((lowerX + upperX) * 0.5) ((lowerY + upperY) * 0.5)))-  Right (RectangleMetric queryLower queryUpper queryCenter)--instance DistanceMetric CircleMetric where-  metricContainsPoint (CircleMetric center radius) point =-    squaredDistanceWide (queryPointValue center) point <= radiusSquaredValue radius-  metricIntersectsEdge (CircleMetric center radius) from to =-    segmentDistanceSquaredWide from to (queryPointValue center) <= radiusSquaredValue radius-  metricStartPoint (CircleMetric center _) = center--instance DistanceMetric RectangleMetric where-  metricContainsPoint (RectangleMetric lower upper _) (Point x y) =-    lowerX <= upperX && lowerY <= upperY && x >= lowerX && x <= upperX && y >= lowerY && y <= upperY-   where-    Point lowerX lowerY = queryPointValue lower-    Point upperX upperY = queryPointValue upper-  metricIntersectsEdge rectangle from to =-    metricContainsPoint rectangle from-      || metricContainsPoint rectangle to-      || segmentRectangleIntersection rectangle from to-  metricStartPoint (RectangleMetric _ _ center) = center---- | Edges meeting a circle.-edgesInCircle :: Triangulation mode vertex directed undirected face -> Point -> Double -> Either CircleMetricError [UndirectedEdgeId]-edgesInCircle triangulation center radiusSquared =-  edgesInShape triangulation <$> circleMetric center radiusSquared---- | Vertices inside a circle.-verticesInCircle :: Triangulation mode vertex directed undirected face -> Point -> Double -> Either CircleMetricError [VertexId]-verticesInCircle triangulation center radiusSquared =-  verticesInShape triangulation <$> circleMetric center radiusSquared---- | Edges meeting an axis-aligned rectangle.-edgesInRectangle :: Triangulation mode vertex directed undirected face -> Point -> Point -> Either RectangleMetricError [UndirectedEdgeId]-edgesInRectangle triangulation lower upper = edgesInShape triangulation <$> rectangleMetric lower upper---- | Vertices inside an axis-aligned rectangle.-verticesInRectangle :: Triangulation mode vertex directed undirected face -> Point -> Point -> Either RectangleMetricError [VertexId]-verticesInRectangle triangulation lower upper = verticesInShape triangulation <$> rectangleMetric lower upper---- | Edges meeting any metric shape.-edgesInShape :: DistanceMetric metric => Triangulation mode vertex directed undirected face -> metric -> [UndirectedEdgeId]-edgesInShape triangulation metric-  | numVertices triangulation <= 1 = []-  | numInnerFaces triangulation == 0 =-      [edge | edge <- undirectedEdges triangulation, edgeInside edge]-  | otherwise =-      let starts = shapeStartFaces triangulation metric-          (_, accepted, _) = floodFillFacesWithEdges triangulation starts edgeInside-       in map (UndirectedEdgeId . fromIntegral) (IntSet.toAscList accepted)- where-  edgeInside edge =-    let (fromVertex, toVertex) = undirectedEndpoints triangulation edge-     in metricIntersectsEdge metric (vertexPoint triangulation fromVertex) (vertexPoint triangulation toVertex)---- | Vertices inside any metric shape.-verticesInShape :: DistanceMetric metric => Triangulation mode vertex directed undirected face -> metric -> [VertexId]-verticesInShape triangulation metric =-  [ vertex-  | vertex <- candidateVertices-  , metricContainsPoint metric (vertexPoint triangulation vertex)-  ]- where-  edges = edgesInShape triangulation metric-  set = List.foldl' addEndpoints IntSet.empty edges-  addEndpoints acc edge =-    let (VertexId from, VertexId to) = undirectedEndpoints triangulation edge-     in IntSet.insert (fromIntegral from) (IntSet.insert (fromIntegral to) acc)-  candidateVertices-    | numVertices triangulation == 1 = [VertexId 0]-    | otherwise = map (VertexId . fromIntegral) (IntSet.toAscList set)---- | Reach inner faces from the supplied seeds by crossing only admitted edges.-floodFillFaces-  :: Triangulation mode vertex directed undirected face -> [FaceId]-  -> (UndirectedEdgeId -> Bool)-  -> [FaceId]-floodFillFaces triangulation starts canCross =-  let (faces, _, _) = floodFillFacesWithEdges triangulation starts canCross-   in faces---- | The reached section and the edge pairs whose crossing was rejected while--- descending it. This package-internal observation retains the boundary--- witness instead of requiring a later face-wide rediscovery.-floodFillFacesWithRejectedEdges-  :: Triangulation mode vertex directed undirected face -> [FaceId]-  -> (UndirectedEdgeId -> Bool)-  -> ([FaceId], [UndirectedEdgeId])-floodFillFacesWithRejectedEdges triangulation starts canCross =-  let (faces, _, rejected) = floodFillFacesWithEdges triangulation starts canCross-   in (faces, fmap (UndirectedEdgeId . fromIntegral) (IntSet.toAscList rejected))--floodFillFacesWithEdges-  :: Triangulation mode vertex directed undirected face -> [FaceId]-  -> (UndirectedEdgeId -> Bool)-  -> ([FaceId], IntSet.IntSet, IntSet.IntSet)-floodFillFacesWithEdges triangulation starts canCross =-  let (faces, accepted, rejected) = go initialStack initialVisited IntSet.empty IntSet.empty []-   in (reverse faces, accepted, rejected)- where-  valid face@(FaceId value) = face /= outerFace && fromIntegral value < numFaces triangulation-  (initialStack, initialVisited) = List.foldl' enqueueStart ([], IntSet.empty) starts--  enqueueStart state face-    | valid face = enqueue face state-    | otherwise = state--  go [] _ accepted rejected result = (result, accepted, rejected)-  go (face : stack) visited accepted rejected result =-    let (stack', visited', accepted', rejected') =-          foldFaceDirectedEdges'-            triangulation-            face-            expand-            (stack, visited, accepted, rejected)-     in go stack' visited' accepted' rejected' (face : result)--  expand (stack, visited, accepted, rejected) edge =-    let undirected@(UndirectedEdgeId raw) = asUndirected edge-        edgeIndex = fromIntegral raw-        adjacent = incidentFace triangulation (reverseEdge edge)-        edgeAdmission-          | IntSet.member edgeIndex accepted = (True, accepted, rejected)-          | IntSet.member edgeIndex rejected = (False, accepted, rejected)-          | canCross undirected = (True, IntSet.insert edgeIndex accepted, rejected)-          | otherwise = (False, accepted, IntSet.insert edgeIndex rejected)-        (crosses, accepted', rejected') = edgeAdmission-        (stack', visited') =-          if crosses && valid adjacent-            then enqueue adjacent (stack, visited)-            else (stack, visited)-     in (stack', visited', accepted', rejected')--  enqueue face@(FaceId value) (stack, visited)-    | IntSet.member index visited = (stack, visited)-    | otherwise = (face : stack, IntSet.insert index visited)-   where-    index = fromIntegral value---- | Connected components of equally labelled bounded faces. Labels are--- evaluated once; the component carrier is the same 'IntSet' used by descent.-faceComponents-  :: Eq label-  => Triangulation mode vertex directed undirected face-  -> (FaceId -> label)-  -> [(label, FaceComponent)]-faceComponents triangulation labelFace =-  faceComponentsFromLabels triangulation labelAt (const True)- where-  labels =-    V.generate-      (numInnerFaces triangulation)-      (\index -> labelFace (FaceId (fromIntegral (index + 1))))-  labelAt faceIndex = labels V.!? (faceIndex - 1)---- | Connected components over a selected face section and admitted adjacency.--- A missing label removes a face from the section; the edge predicate states--- which overlaps glue. This is the common descent used by ordinary labelled--- regions and exact-overlay charts whose representation diagonals alone may--- connect collapsed resident faces.-faceComponentsBy-  :: Eq label-  => Triangulation mode vertex directed undirected face-  -> (FaceId -> Maybe label)-  -> (UndirectedEdgeId -> Bool)-  -> [(label, FaceComponent)]-faceComponentsBy triangulation labelFace =-  faceComponentsFromLabels triangulation labelAt- where-  labels =-    V.generate-      (numInnerFaces triangulation)-      (\index -> labelFace (FaceId (fromIntegral (index + 1))))-  labelAt faceIndex = labels V.!? (faceIndex - 1) >>= id--faceComponentsFromLabels-  :: Eq label-  => Triangulation mode vertex directed undirected face-  -> (Int -> Maybe label)-  -> (UndirectedEdgeId -> Bool)-  -> [(label, FaceComponent)]-faceComponentsFromLabels triangulation labelAt canCross =-  unfoldr descend initialUnvisited- where-  initialUnvisited =-    IntSet.fromRange (1, numFaces triangulation - 1)--  descend remaining =-    case IntSet.minView remaining of-      Nothing -> Nothing-      Just (seedIndex, unseeded) ->-        case labelAt seedIndex of-          Nothing -> descend unseeded-          Just componentLabel ->-            let unvisited =-                  collectComponent componentLabel (Seq.singleton seedIndex) unseeded-                componentFaces = IntSet.difference remaining unvisited-             in Just ((componentLabel, FaceComponent componentFaces), unvisited)--  collectComponent componentLabel queued unvisited =-    case Seq.viewl queued of-      Seq.EmptyL -> unvisited-      faceIndex Seq.:< remainingQueue ->-        let face = FaceId (fromIntegral faceIndex)-            (expandedQueue, remainingUnvisited) =-              foldFaceDirectedEdges'-                triangulation-                face-                (admitAdjacent componentLabel)-                (remainingQueue, unvisited)-         in collectComponent-              componentLabel-              expandedQueue-              remainingUnvisited--  admitAdjacent componentLabel (queued, unvisited) edge =-    if-      canCross (asUndirected edge)-        && adjacent /= outerFace-        && IntSet.member adjacentIndex unvisited-        && labelAt adjacentIndex == Just componentLabel-      then-        ( queued Seq.|> adjacentIndex-        , IntSet.delete adjacentIndex unvisited-        )-      else (queued, unvisited)-   where-    adjacent@(FaceId adjacentRaw) =-      incidentFace triangulation (reverseEdge edge)-    adjacentIndex = fromIntegral adjacentRaw-{-# INLINE faceComponentsFromLabels #-}---- | Descend every equally labelled bounded-face component through the one--- authoritative boundary tracer. Components are converted independently;--- callers may group equal labels only after this descent has succeeded.-labelledRegionBoundaries-  :: Eq label-  => Triangulation mode vertex directed undirected face-  -> (FaceId -> label)-  -> Either BoundaryObstruction [(label, RegionBoundary)]-labelledRegionBoundaries triangulation labelFace =-  traverse-    (\(label, component) -> (label,) <$> componentBoundary triangulation component)-    (faceComponents triangulation labelFace)---- | Extract the non-empty oriented boundary chain of one component. Boundary--- half-edges retain their incident component face on the left. If several--- boundary arms meet at one vertex, Euler descent consumes every half-edge--- once and repeated-vertex splitting publishes finitely many simple loops.-componentBoundaryLoops-  :: Triangulation mode vertex directed undirected face-  -> FaceComponent-  -> Either BoundaryObstruction (NonEmpty BoundaryLoop)-componentBoundaryLoops triangulation component = do-  graph <- componentBoundaryGraph triangulation component-  loops <--    case graph of-      SimpleBoundaryGraph edges outgoing ->-        traceBoundaryLoops triangulation outgoing edges-      PinchedBoundaryGraph edges _ _ _ ->-        tracePinchedBoundaryLoops triangulation edges-  case NonEmpty.nonEmpty loops of-    Just nonEmptyLoops -> Right nonEmptyLoops-    Nothing -> Left (BoundaryOuterLoopCardinality 0)---- | Project one component into a strict polygon boundary. A pinched oriented--- chain remains available through 'componentBoundaryLoops', but it is not one--- lawful 'RegionBoundary' and is refused here with its first pinch witness.-componentBoundary-  :: Triangulation mode vertex directed undirected face-  -> FaceComponent-  -> Either BoundaryObstruction RegionBoundary-componentBoundary triangulation component = do-  graph <- componentBoundaryGraph triangulation component-  case graph of-    PinchedBoundaryGraph _ vertex firstEdge secondEdge ->-      Left (BoundaryPinch vertex firstEdge secondEdge)-    SimpleBoundaryGraph edges outgoing ->-      traceBoundaryLoops triangulation outgoing edges-        >>= regionBoundaryFromLoops---- | Project exactly the supplied face section into one boundary. This is the--- selected-section descent used by local extension: it does not label or--- flood the complement, and therefore its work is proportional to the faces--- named by the caller plus their constant-degree boundary edges.-componentBoundaryForFaces-  :: Triangulation mode vertex directed undirected face-  -> Set.Set FaceId-  -> Either BoundaryObstruction RegionBoundary-componentBoundaryForFaces triangulation selectedFaces = do-  component <- selectedFaceComponent triangulation selectedFaces-  componentBoundary triangulation component--selectedFaceComponent-  :: Triangulation mode vertex directed undirected face-  -> Set.Set FaceId-  -> Either BoundaryObstruction FaceComponent-selectedFaceComponent triangulation selectedFaces =-  case IntSet.lookupMin indices of-    Just 0 -> Left (BoundaryComponentFaceOutOfRange (FaceId 0) (numFaces triangulation))-    _ ->-      case IntSet.lookupGE (numFaces triangulation) indices of-        Just invalid ->-          Left-            ( BoundaryComponentFaceOutOfRange-                (FaceId (fromIntegral invalid))-                (numFaces triangulation)-            )-        Nothing -> Right (FaceComponent indices)- where-  indices = IntSet.fromList (fmap faceIndex (Set.toAscList selectedFaces))-  faceIndex (FaceId raw) = fromIntegral raw--componentBoundaryGraph-  :: Triangulation mode vertex directed undirected face-  -> FaceComponent-  -> Either BoundaryObstruction BoundaryGraph-componentBoundaryGraph triangulation (FaceComponent componentFaces) =-  case IntSet.lookupGE (numFaces triangulation) componentFaces of-    Just invalid ->-      Left-        ( BoundaryComponentFaceOutOfRange-            (FaceId (fromIntegral invalid))-            (numFaces triangulation)-        )-    Nothing ->-      Right-        ( IntSet.foldl'-            collectFace-            (SimpleBoundaryGraph IntSet.empty IntMap.empty)-            componentFaces-        )- where-  collectFace graph (face :: Int) =-    foldFaceDirectedEdges'-      triangulation-      (FaceId (fromIntegral face))-      insertBoundaryEdge-      graph--  insertBoundaryEdge graph edge-    | IntSet.member adjacentIndex componentFaces = graph-    | otherwise =-        case graph of-          PinchedBoundaryGraph edges pinchVertex firstEdge secondEdge ->-            PinchedBoundaryGraph-              (insertEdge edges)-              pinchVertex-              firstEdge-              secondEdge-          SimpleBoundaryGraph edges outgoing ->-            case IntMap.lookup vertexIndex outgoing of-              Nothing ->-                SimpleBoundaryGraph-                  (insertEdge edges)-                  (IntMap.insert vertexIndex edge outgoing)-              Just previousEdge ->-                PinchedBoundaryGraph-                  (insertEdge edges)-                  vertex-                  previousEdge-                  edge-   where-    FaceId adjacent = incidentFace triangulation (reverseEdge edge)-    adjacentIndex = fromIntegral adjacent-    vertex@(VertexId rawVertex) = origin triangulation edge-    vertexIndex = fromIntegral rawVertex-    DirectedEdgeId rawEdge = edge-    insertEdge = IntSet.insert (fromIntegral rawEdge)--regionBoundaryFromLoops-  :: [BoundaryLoop]-  -> Either BoundaryObstruction RegionBoundary-regionBoundaryFromLoops loops =-  case outerLoops of-    [outerLoop] ->-      Right-        RegionBoundary-          { regionBoundaryOuterLoop = outerLoop-          , regionBoundaryHoleLoops = holeLoops-          }-    _ -> Left (BoundaryOuterLoopCardinality (length outerLoops))- where-  (outerLoops, holeLoops) =-    partition-      ((== BoundaryCounterClockwise) . boundaryLoopOrientation)-      loops--tracePinchedBoundaryLoops-  :: Triangulation mode vertex directed undirected face-  -> IntSet.IntSet-  -> Either BoundaryObstruction [BoundaryLoop]-tracePinchedBoundaryLoops triangulation boundaryEdges = do-  cycles <--    traceOrientedBoundaryCircuits-      (origin triangulation)-      (destination triangulation)-      BoundaryCycleDidNotClose-      outgoingByVertex-      orientedEdges-  traverse-    (simplifyBoundaryLoop triangulation . NonEmpty.toList)-    cycles- where-  orientedEdges =-    Set.fromDistinctAscList-      ( fmap-          (DirectedEdgeId . fromIntegral)-          (IntSet.toAscList boundaryEdges)-      )-  outgoingByVertex =-    Set.foldr-      (\edge -> Map.insertWith (<>) (origin triangulation edge) [edge])-      Map.empty-      orientedEdges--traceBoundaryLoops-  :: Triangulation mode vertex directed undirected face-  -> IntMap.IntMap DirectedEdgeId-  -> IntSet.IntSet-  -> Either BoundaryObstruction [BoundaryLoop]-traceBoundaryLoops triangulation outgoingByVertex = descend []- where-  descend loops unvisited =-    case IntSet.minView unvisited of-      Nothing -> Right (reverse loops)-      Just (rawStart, _) -> do-        let start = DirectedEdgeId (fromIntegral rawStart)-        (vertices, remaining) <- traceCycle start start unvisited []-        loop <- simplifyBoundaryLoop triangulation vertices-        descend (loop : loops) remaining--  traceCycle start current unvisited reversedVertices =-    let DirectedEdgeId rawCurrent = current-        remaining = IntSet.delete (fromIntegral rawCurrent) unvisited-        accumulated = origin triangulation current : reversedVertices-        VertexId rawTarget = destination triangulation current-     in case IntMap.lookup (fromIntegral rawTarget) outgoingByVertex of-          Just successor-            | successor == start -> Right (reverse accumulated, remaining)-            | let DirectedEdgeId rawSuccessor = successor-            , IntSet.member (fromIntegral rawSuccessor) remaining ->-                traceCycle start successor remaining accumulated-            | otherwise -> Left (BoundaryCycleDidNotClose start successor)-          Nothing -> Left (BoundaryCycleDidNotClose start current)--simplifyBoundaryLoop-  :: Triangulation mode vertex directed undirected face-  -> [VertexId]-  -> Either BoundaryObstruction BoundaryLoop-simplifyBoundaryLoop triangulation vertices = do-  (windingOrder, simplifiedVertices) <--    simplifyBoundaryCycle-      BoundaryLoopDegenerate-      redundant-      winding-      key-      vertices-  residentVertices <--    maybe-      (Left (BoundaryLoopDegenerate vertices))-      Right-      (NonEmpty.nonEmpty vertices)-  case windingOrder of-    GT -> Right (BoundaryLoop BoundaryCounterClockwise residentVertices simplifiedVertices)-    LT -> Right (BoundaryLoop BoundaryClockwise residentVertices simplifiedVertices)-    EQ -> Left (BoundaryLoopDegenerate (NonEmpty.toList simplifiedVertices))- where-  point vertex = vertexPoint triangulation vertex-  redundant previousVertex current nextVertex =-    orient2d (point previousVertex) (point current) (point nextVertex) == EQ-      && onClosedSegment (point previousVertex) (point nextVertex) (point current)-  winding previousVertex current nextVertex =-    orient2d (point previousVertex) (point current) (point nextVertex)-  key vertex = (point vertex, vertex)---- | Inner faces separated from the outer face by an even minimum number of--- barriers. A 0–1 BFS floods freely within one depth before crossing a barrier,--- so a free-ended barrier can be walked around at depth zero while nested--- closed barriers alternate outside and inside.-facesAtEvenBarrierDepth-  :: Triangulation mode vertex directed undirected face-  -> (UndirectedEdgeId -> Bool)-  -> [FaceId]-facesAtEvenBarrierDepth triangulation isBarrier =-  concat (evenLayers (barrierDepthLayers triangulation isBarrier))- where-  evenLayers :: [[FaceId]] -> [[FaceId]]-  evenLayers (outsideLayer : _insideLayer : deeper) =-    outsideLayer : evenLayers deeper-  evenLayers shallow = shallow--barrierDepthLayers-  :: Triangulation mode vertex directed undirected face-  -> (UndirectedEdgeId -> Bool)-  -> [[FaceId]]-barrierDepthLayers triangulation isBarrier =-  map (filter (/= outerFace)) (layers IntSet.empty [outerFace])- where-  known (FaceId value) = fromIntegral value < numFaces triangulation-  key :: FaceId -> Int-  key (FaceId value) = fromIntegral value--  layers visited frontier = case flood visited [] frontier of-    ([], _) -> []-    (layer, visited') -> layer : layers visited' (concatMap (neighbours isBarrier) layer)--  flood visited acc [] = (reverse acc, visited)-  flood visited acc (face : rest)-    | not (known face) || IntSet.member (key face) visited = flood visited acc rest-    | otherwise =-        flood-          (IntSet.insert (key face) visited)-          (face : acc)-          (neighbours (not . isBarrier) face <> rest)--  neighbours admit face =-    [ incidentFace triangulation (reverseEdge edge)-    | edge <- faceDirectedEdges triangulation face-    , admit (asUndirected edge)-    ]---- | Faces reachable from the outer face without crossing a barrier edge.-outerFaceFloodFill :: Triangulation mode vertex directed undirected face -> (UndirectedEdgeId -> Bool) -> [FaceId]-outerFaceFloodFill triangulation canCross = floodFillFaces triangulation starts canCross- where-  starts =-    [ face-    | outerEdge <- faceDirectedEdges triangulation outerFace-    , let edge = asUndirected outerEdge-    , canCross edge-    , let face = incidentFace triangulation (reverseEdge outerEdge)-    , face /= outerFace-    ]---- | The faces a shape's start point lands in.-shapeStartFaces :: DistanceMetric metric => Triangulation mode vertex directed undirected face -> metric -> [FaceId]-shapeStartFaces triangulation metric =-  case locatePoint triangulation (metricStartPoint metric) of-    InFace face -> [face]-    OnEdge edge -> filter (/= outerFace) [incidentFace triangulation edge, incidentFace triangulation (reverseEdge edge)]-    OnVertex vertex ->-      intSetToFaces-        (List.foldl' (\set edge -> let FaceId value = incidentFace triangulation edge in if value == 0 then set else IntSet.insert (fromIntegral value) set) IntSet.empty (vertexOutgoingEdges triangulation vertex))-    OutsideConvexHull _ ->-      [ incidentFace triangulation (reverseEdge edge)-      | edge <- faceDirectedEdges triangulation outerFace-      , let from = vertexPoint triangulation (origin triangulation edge)-      , let to = vertexPoint triangulation (destination triangulation edge)-      , metricIntersectsEdge metric from to-      , incidentFace triangulation (reverseEdge edge) /= outerFace-      ]-    EmptyTriangulation -> []- where-  intSetToFaces = map (FaceId . fromIntegral) . IntSet.toAscList--segmentRectangleIntersection :: RectangleMetric -> Point -> Point -> Bool-segmentRectangleIntersection (RectangleMetric lowerQuery upperQuery _) from to-  | lx > ux || ly > uy = False-  | lower == upper = onClosedSegment from to lower-  | otherwise = any (uncurry (segmentsIntersect from to)) boundaries- where-  lower@(Point lx ly) = queryPointValue lowerQuery-  upper@(Point ux uy) = queryPointValue upperQuery-  boundaries =-    [ (Point lx ly, Point lx uy)-    , (Point lx uy, Point ux uy)-    , (Point ux uy, Point ux ly)-    , (Point ux ly, Point lx ly)-    ]+import Moonlight.Triangulation.Internal.FloodFillIterator

@@ -65,7 +65,7 @@   ) where  import Moonlight.Triangulation.Dcel qualified as Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.LineSideInfo (LineSideInfo) import Moonlight.Triangulation.Math qualified as Math import Moonlight.Triangulation.Types

@@ -1,12 +1,17 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | The identifier family and the arithmetic on it: a directed edge's twin is--- its index complement, so orientation is a bit rather than a lookup.+-- | Opaque resident identifiers and lawful orientation operations.+--+-- Identifiers can only be obtained from a triangulation. Their numeric+-- projections support serialization and diagnostics without allowing a caller+-- to manufacture a handle that belongs to no mesh. module Moonlight.Triangulation.Handles.HandleDefs-  ( VertexId (..)-  , FaceId (..)-  , DirectedEdgeId (..)-  , UndirectedEdgeId (..)+  ( VertexId+  , unVertexId+  , FaceId+  , unFaceId+  , DirectedEdgeId+  , unDirectedEdgeId+  , UndirectedEdgeId+  , unUndirectedEdgeId   , reverseEdge   , asUndirected   , normalizedDirected@@ -15,56 +20,4 @@   , isNormalized   ) where -import Control.DeepSeq (NFData)-import Data.Bits (shiftL, shiftR, xor, (.&.))-import Data.Word (Word32)---- | Index of a vertex in the immutable DCEL.-newtype VertexId = VertexId { unVertexId :: Word32 }-  deriving stock (Show)-  deriving newtype (Eq, Ord, NFData)---- | Index of a face in the immutable DCEL; zero denotes the outer face.-newtype FaceId = FaceId { unFaceId :: Word32 }-  deriving stock (Show)-  deriving newtype (Eq, Ord, NFData)---- | Oriented half-edge index. Twin orientations differ only in the low bit.-newtype DirectedEdgeId = DirectedEdgeId { unDirectedEdgeId :: Word32 }-  deriving stock (Show)-  deriving newtype (Eq, Ord, NFData)---- | Index of a twin pair, with orientation forgotten.-newtype UndirectedEdgeId = UndirectedEdgeId { unUndirectedEdgeId :: Word32 }-  deriving stock (Show)-  deriving newtype (Eq, Ord, NFData)---- | Select the opposite orientation of the same undirected edge.-reverseEdge :: DirectedEdgeId -> DirectedEdgeId-reverseEdge (DirectedEdgeId edge) = DirectedEdgeId (edge `xor` 1)-{-# INLINE reverseEdge #-}---- | Forget a directed edge's orientation.-asUndirected :: DirectedEdgeId -> UndirectedEdgeId-asUndirected (DirectedEdgeId edge) = UndirectedEdgeId (edge `shiftR` 1)-{-# INLINE asUndirected #-}---- | Select the even-indexed orientation of an undirected edge.-normalizedDirected :: UndirectedEdgeId -> DirectedEdgeId-normalizedDirected (UndirectedEdgeId edge) = DirectedEdgeId (edge `shiftL` 1)-{-# INLINE normalizedDirected #-}---- | Select the odd-indexed orientation of an undirected edge.-reversedDirected :: UndirectedEdgeId -> DirectedEdgeId-reversedDirected edge = reverseEdge (normalizedDirected edge)-{-# INLINE reversedDirected #-}---- | Both orientations, normalized first and reversed second.-directedPair :: UndirectedEdgeId -> (DirectedEdgeId, DirectedEdgeId)-directedPair edge = (normalizedDirected edge, reversedDirected edge)-{-# INLINE directedPair #-}---- | Whether a directed edge is the normalized orientation of its pair.-isNormalized :: DirectedEdgeId -> Bool-isNormalized (DirectedEdgeId edge) = edge .&. 1 == 0-{-# INLINE isNormalized #-}+import Moonlight.Triangulation.Internal.HandleDefs

@@ -16,7 +16,7 @@   ) where  import Moonlight.Triangulation.Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Types  -- | Every vertex identifier, ascending.

@@ -7,7 +7,7 @@   ) where  import Moonlight.Triangulation.Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Types  -- | The convex hull as directed edges, in order.

@@ -15,7 +15,7 @@ import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as MUV import Moonlight.Triangulation.Dcel (numFaces, numUndirectedEdges, numVertices, vertexData)-import Moonlight.Triangulation.Handles.HandleDefs (VertexId (..))+import Moonlight.Triangulation.Internal.HandleDefs (VertexId (..)) import Moonlight.Triangulation.Internal.Mutable import Moonlight.Triangulation.Internal.Paged (Paged, pagedUnsafeIndex) import Moonlight.Triangulation.Internal.Representation (Triangulation (..))

@@ -37,7 +37,7 @@   , vertexPoint   ) import Moonlight.Triangulation.Exact (ExactPoint, exactPointFromPoint)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId (..)   , UndirectedEdgeId (..)   , VertexId (..)

@@ -18,7 +18,7 @@ import Control.Monad (forM_, when) import Control.Monad.ST (ST) import Data.STRef (writeSTRef)-import Moonlight.Triangulation.Handles.HandleDefs (VertexId (..))+import Moonlight.Triangulation.Internal.HandleDefs (VertexId (..)) import Moonlight.Triangulation.Internal.DcelOperations.Legalize (legalizeScratch) import Moonlight.Triangulation.Internal.DcelOperations.Twin (reverseIndex) import Moonlight.Triangulation.Internal.Mutable

@@ -13,7 +13,7 @@  import Control.Monad (unless) import Control.Monad.ST (ST)-import Moonlight.Triangulation.Handles.HandleDefs (UndirectedEdgeId (..))+import Moonlight.Triangulation.Internal.HandleDefs (UndirectedEdgeId (..)) import Moonlight.Triangulation.Internal.DcelOperations.Twin (reverseIndex) import Moonlight.Triangulation.Internal.Mutable   ( MutableDcel

@@ -24,7 +24,7 @@ import Control.Monad (forM_, when) import Control.Monad.ST (ST) import Data.STRef (writeSTRef)-import Moonlight.Triangulation.Handles.HandleDefs (DirectedEdgeId (..), FaceId (..))+import Moonlight.Triangulation.Internal.HandleDefs (DirectedEdgeId (..), FaceId (..)) import Moonlight.Triangulation.Internal.DcelOperations.CandidateArena   ( seedGenericPairInArena   )

@@ -13,7 +13,7 @@  import Control.Monad (unless, void, when) import Control.Monad.ST (ST)-import Moonlight.Triangulation.Handles.HandleDefs (UndirectedEdgeId (..))+import Moonlight.Triangulation.Internal.HandleDefs (UndirectedEdgeId (..)) import Moonlight.Triangulation.Internal.DcelOperations.Legalize (legalizeScratch) import Moonlight.Triangulation.Internal.DcelOperations.Twin (reverseIndex) import Moonlight.Triangulation.Internal.Mutable

@@ -0,0 +1,739 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}++-- | Shape queries and face flood fills over immutable triangulations.+module Moonlight.Triangulation.Internal.FloodFillIterator+  ( DistanceMetric (..)+  , CircleMetric+  , CircleMetricError (..)+  , RectangleMetric+  , RectangleMetricError (..)+  , circleMetric+  , rectangleMetric+  , edgesInShape+  , verticesInShape+  , edgesInCircle+  , verticesInCircle+  , edgesInRectangle+  , verticesInRectangle+  , floodFillFaces+  , floodFillFacesWithRejectedEdges+  , outerFaceFloodFill+  , facesAtEvenBarrierDepth+  , FaceComponent+  , faceComponentFaces+  , BoundaryOrientation (..)+  , BoundaryLoop+  , boundaryLoopOrientation+  , boundaryLoopResidentVertices+  , boundaryLoopVertices+  , RegionBoundary+  , regionBoundaryOuterLoop+  , regionBoundaryHoleLoops+  , BoundaryObstruction (..)+  , faceComponents+  , faceComponentsBy+  , labelledRegionBoundaries+  , componentBoundaryLoops+  , componentBoundary+  , componentBoundaryForFaces+  ) where++import Control.DeepSeq (NFData)+import Data.Bifunctor (first)+import qualified Data.IntMap.Strict as IntMap+import qualified Data.IntSet as IntSet+import Data.List (partition, unfoldr)+import qualified Data.List as List+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Map.Strict as Map+import qualified Data.Sequence as Seq+import qualified Data.Set as Set+import qualified Data.Vector as V+import GHC.Generics (Generic)+import Moonlight.Triangulation.Dcel+import Moonlight.Triangulation.Internal.HandleDefs+import Moonlight.Triangulation.Handles.Iterators.FixedIterators (undirectedEdges)+import Moonlight.Triangulation.Internal.BoundaryCycle+  ( simplifyBoundaryCycle+  , traceOrientedBoundaryCircuits+  )+import Moonlight.Triangulation.Math+import Moonlight.Triangulation.PointLocation+import Moonlight.Triangulation.Types++-- | One non-empty connected set of equally labelled bounded face indices.+newtype FaceComponent = FaceComponent IntSet.IntSet+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)++-- | Component faces in ascending DCEL order.+faceComponentFaces :: FaceComponent -> [FaceId]+faceComponentFaces (FaceComponent faces) =+  fmap (FaceId . fromIntegral) (IntSet.toAscList faces)++-- | Winding carried explicitly by a simple boundary loop.+data BoundaryOrientation+  = BoundaryCounterClockwise+  | BoundaryClockwise+  deriving stock (Eq, Ord, Show, Generic)+  deriving anyclass (NFData)++-- | One non-empty simple boundary loop. Counter-clockwise loops contribute+-- filled area under nonzero winding; clockwise loops subtract holes.+data BoundaryLoop = BoundaryLoop+  { boundaryLoopOrientation :: !BoundaryOrientation+  -- | Exact resident DCEL boundary chain. Consecutive vertices, including+  -- the closing pair, are endpoints of one boundary half-edge.+  , boundaryLoopResidentVertices :: !(NonEmpty VertexId)+  -- | Collinearity-reduced polygon observation of the same resident chain.+  , boundaryLoopVertices :: !(NonEmpty VertexId)+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)++-- | The authoritative boundary of one face component.+data RegionBoundary = RegionBoundary+  { regionBoundaryOuterLoop :: !BoundaryLoop+  , regionBoundaryHoleLoops :: ![BoundaryLoop]+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)++-- | Typed failure to descend boundary half-edges or project their oriented+-- loops into one strict polygon component.+data BoundaryObstruction+  = BoundaryComponentFaceOutOfRange !FaceId {-# UNPACK #-} !Int+  | BoundaryPinch !VertexId !DirectedEdgeId !DirectedEdgeId+  | BoundaryCycleDidNotClose !DirectedEdgeId !DirectedEdgeId+  | BoundaryLoopDegenerate ![VertexId]+  | BoundaryOuterLoopCardinality !Int+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)++-- | Complete boundary edges refined by whether each vertex has one successor.+data BoundaryGraph+  = SimpleBoundaryGraph !IntSet.IntSet !(IntMap.IntMap DirectedEdgeId)+  | PinchedBoundaryGraph+      !IntSet.IntSet+      !VertexId+      !DirectedEdgeId+      !DirectedEdgeId++-- | A query shape that can admit points, test edges, and supply a location+-- seed.+class DistanceMetric metric where+  metricContainsPoint :: metric -> Point -> Bool+  metricIntersectsEdge :: metric -> Point -> Point -> Bool+  metricStartPoint :: metric -> QueryPoint++-- | An admitted center and squared radius.+data CircleMetric = CircleMetric !QueryPoint !RadiusSquared+  deriving stock (Eq, Ord, Show)++-- | Typed refusal for an invalid circle query.+data CircleMetricError+  = InvalidCircleCenter !PointValidationError+  | InvalidCircleRadius !RadiusSquaredError+  deriving stock (Eq, Ord, Show)++-- | Admitted lower corner, upper corner, and center of an axis-aligned box.+data RectangleMetric = RectangleMetric !(QueryPoint) !(QueryPoint) !(QueryPoint)+  deriving stock (Eq, Ord, Show)++-- | Typed refusal for an invalid rectangle query.+data RectangleMetricError+  = InvalidRectangleLower !PointValidationError+  | InvalidRectangleUpper !PointValidationError+  | InvalidRectangleCenter !PointValidationError+  deriving stock (Eq, Ord, Show)++-- | A circle metric, or why the radius is unusable.+circleMetric :: Point -> Double -> Either CircleMetricError CircleMetric+circleMetric center radiusSquared =+  CircleMetric+    <$> first InvalidCircleCenter (mkQueryPoint center)+    <*> first InvalidCircleRadius (mkRadiusSquared radiusSquared)++-- | An axis-aligned rectangle metric, or why the corners are unusable.+rectangleMetric :: Point -> Point -> Either RectangleMetricError RectangleMetric+rectangleMetric lower@(Point lowerX lowerY) upper@(Point upperX upperY) = do+  queryLower <- either (Left . InvalidRectangleLower) Right (mkQueryPoint lower)+  queryUpper <- either (Left . InvalidRectangleUpper) Right (mkQueryPoint upper)+  queryCenter <-+    either+      (Left . InvalidRectangleCenter)+      Right+      (mkQueryPoint (Point ((lowerX + upperX) * 0.5) ((lowerY + upperY) * 0.5)))+  Right (RectangleMetric queryLower queryUpper queryCenter)++instance DistanceMetric CircleMetric where+  metricContainsPoint (CircleMetric center radius) point =+    squaredDistanceWide (queryPointValue center) point <= radiusSquaredValue radius+  metricIntersectsEdge (CircleMetric center radius) from to =+    segmentDistanceSquaredWide from to (queryPointValue center) <= radiusSquaredValue radius+  metricStartPoint (CircleMetric center _) = center++instance DistanceMetric RectangleMetric where+  metricContainsPoint (RectangleMetric lower upper _) (Point x y) =+    lowerX <= upperX && lowerY <= upperY && x >= lowerX && x <= upperX && y >= lowerY && y <= upperY+   where+    Point lowerX lowerY = queryPointValue lower+    Point upperX upperY = queryPointValue upper+  metricIntersectsEdge rectangle from to =+    metricContainsPoint rectangle from+      || metricContainsPoint rectangle to+      || segmentRectangleIntersection rectangle from to+  metricStartPoint (RectangleMetric _ _ center) = center++-- | Edges meeting a circle.+edgesInCircle :: Triangulation mode vertex directed undirected face -> Point -> Double -> Either CircleMetricError [UndirectedEdgeId]+edgesInCircle triangulation center radiusSquared =+  edgesInShape triangulation <$> circleMetric center radiusSquared++-- | Vertices inside a circle.+verticesInCircle :: Triangulation mode vertex directed undirected face -> Point -> Double -> Either CircleMetricError [VertexId]+verticesInCircle triangulation center radiusSquared =+  verticesInShape triangulation <$> circleMetric center radiusSquared++-- | Edges meeting an axis-aligned rectangle.+edgesInRectangle :: Triangulation mode vertex directed undirected face -> Point -> Point -> Either RectangleMetricError [UndirectedEdgeId]+edgesInRectangle triangulation lower upper = edgesInShape triangulation <$> rectangleMetric lower upper++-- | Vertices inside an axis-aligned rectangle.+verticesInRectangle :: Triangulation mode vertex directed undirected face -> Point -> Point -> Either RectangleMetricError [VertexId]+verticesInRectangle triangulation lower upper = verticesInShape triangulation <$> rectangleMetric lower upper++-- | Edges meeting any metric shape.+edgesInShape :: DistanceMetric metric => Triangulation mode vertex directed undirected face -> metric -> [UndirectedEdgeId]+edgesInShape triangulation metric+  | numVertices triangulation <= 1 = []+  | numInnerFaces triangulation == 0 =+      [edge | edge <- undirectedEdges triangulation, edgeInside edge]+  | otherwise =+      let starts = shapeStartFaces triangulation metric+          (_, accepted, _) = floodFillFacesWithEdges triangulation starts edgeInside+       in map (UndirectedEdgeId . fromIntegral) (IntSet.toAscList accepted)+ where+  edgeInside edge =+    let (fromVertex, toVertex) = undirectedEndpoints triangulation edge+     in metricIntersectsEdge metric (vertexPoint triangulation fromVertex) (vertexPoint triangulation toVertex)++-- | Vertices inside any metric shape.+verticesInShape :: DistanceMetric metric => Triangulation mode vertex directed undirected face -> metric -> [VertexId]+verticesInShape triangulation metric =+  [ vertex+  | vertex <- candidateVertices+  , metricContainsPoint metric (vertexPoint triangulation vertex)+  ]+ where+  edges = edgesInShape triangulation metric+  set = List.foldl' addEndpoints IntSet.empty edges+  addEndpoints acc edge =+    let (VertexId from, VertexId to) = undirectedEndpoints triangulation edge+     in IntSet.insert (fromIntegral from) (IntSet.insert (fromIntegral to) acc)+  candidateVertices+    | numVertices triangulation == 1 = [VertexId 0]+    | otherwise = map (VertexId . fromIntegral) (IntSet.toAscList set)++-- | Reach inner faces from the supplied seeds by crossing only admitted edges.+floodFillFaces+  :: Triangulation mode vertex directed undirected face -> [FaceId]+  -> (UndirectedEdgeId -> Bool)+  -> [FaceId]+floodFillFaces triangulation starts canCross =+  let (faces, _, _) = floodFillFacesWithEdges triangulation starts canCross+   in faces++-- | The reached section and the edge pairs whose crossing was rejected while+-- descending it. This package-internal observation retains the boundary+-- witness instead of requiring a later face-wide rediscovery.+floodFillFacesWithRejectedEdges+  :: Triangulation mode vertex directed undirected face -> [FaceId]+  -> (UndirectedEdgeId -> Bool)+  -> ([FaceId], [UndirectedEdgeId])+floodFillFacesWithRejectedEdges triangulation starts canCross =+  let (faces, _, rejected) = floodFillFacesWithEdges triangulation starts canCross+   in (faces, fmap (UndirectedEdgeId . fromIntegral) (IntSet.toAscList rejected))++floodFillFacesWithEdges+  :: Triangulation mode vertex directed undirected face -> [FaceId]+  -> (UndirectedEdgeId -> Bool)+  -> ([FaceId], IntSet.IntSet, IntSet.IntSet)+floodFillFacesWithEdges triangulation starts canCross =+  let (faces, accepted, rejected) = go initialStack initialVisited IntSet.empty IntSet.empty []+   in (reverse faces, accepted, rejected)+ where+  valid face@(FaceId value) = face /= outerFace && fromIntegral value < numFaces triangulation+  (initialStack, initialVisited) = List.foldl' enqueueStart ([], IntSet.empty) starts++  enqueueStart state face+    | valid face = enqueue face state+    | otherwise = state++  go [] _ accepted rejected result = (result, accepted, rejected)+  go (face : stack) visited accepted rejected result =+    let (stack', visited', accepted', rejected') =+          foldFaceDirectedEdges'+            triangulation+            face+            expand+            (stack, visited, accepted, rejected)+     in go stack' visited' accepted' rejected' (face : result)++  expand (stack, visited, accepted, rejected) edge =+    let undirected@(UndirectedEdgeId raw) = asUndirected edge+        edgeIndex = fromIntegral raw+        adjacent = incidentFace triangulation (reverseEdge edge)+        edgeAdmission+          | IntSet.member edgeIndex accepted = (True, accepted, rejected)+          | IntSet.member edgeIndex rejected = (False, accepted, rejected)+          | canCross undirected = (True, IntSet.insert edgeIndex accepted, rejected)+          | otherwise = (False, accepted, IntSet.insert edgeIndex rejected)+        (crosses, accepted', rejected') = edgeAdmission+        (stack', visited') =+          if crosses && valid adjacent+            then enqueue adjacent (stack, visited)+            else (stack, visited)+     in (stack', visited', accepted', rejected')++  enqueue face@(FaceId value) (stack, visited)+    | IntSet.member index visited = (stack, visited)+    | otherwise = (face : stack, IntSet.insert index visited)+   where+    index = fromIntegral value++-- | Connected components of equally labelled bounded faces. Labels are+-- evaluated once; the component carrier is the same 'IntSet' used by descent.+faceComponents+  :: Eq label+  => Triangulation mode vertex directed undirected face+  -> (FaceId -> label)+  -> [(label, FaceComponent)]+faceComponents triangulation labelFace =+  faceComponentsFromLabels triangulation labelAt (const True)+ where+  labels =+    V.generate+      (numInnerFaces triangulation)+      (\index -> labelFace (FaceId (fromIntegral (index + 1))))+  labelAt faceIndex = labels V.!? (faceIndex - 1)++-- | Connected components over a selected face section and admitted adjacency.+-- A missing label removes a face from the section; the edge predicate states+-- which overlaps glue. This is the common descent used by ordinary labelled+-- regions and exact-overlay charts whose representation diagonals alone may+-- connect collapsed resident faces.+faceComponentsBy+  :: Eq label+  => Triangulation mode vertex directed undirected face+  -> (FaceId -> Maybe label)+  -> (UndirectedEdgeId -> Bool)+  -> [(label, FaceComponent)]+faceComponentsBy triangulation labelFace =+  faceComponentsFromLabels triangulation labelAt+ where+  labels =+    V.generate+      (numInnerFaces triangulation)+      (\index -> labelFace (FaceId (fromIntegral (index + 1))))+  labelAt faceIndex = labels V.!? (faceIndex - 1) >>= id++faceComponentsFromLabels+  :: Eq label+  => Triangulation mode vertex directed undirected face+  -> (Int -> Maybe label)+  -> (UndirectedEdgeId -> Bool)+  -> [(label, FaceComponent)]+faceComponentsFromLabels triangulation labelAt canCross =+  unfoldr descend initialUnvisited+ where+  initialUnvisited =+    IntSet.fromRange (1, numFaces triangulation - 1)++  descend remaining =+    case IntSet.minView remaining of+      Nothing -> Nothing+      Just (seedIndex, unseeded) ->+        case labelAt seedIndex of+          Nothing -> descend unseeded+          Just componentLabel ->+            let unvisited =+                  collectComponent componentLabel (Seq.singleton seedIndex) unseeded+                componentFaces = IntSet.difference remaining unvisited+             in Just ((componentLabel, FaceComponent componentFaces), unvisited)++  collectComponent componentLabel queued unvisited =+    case Seq.viewl queued of+      Seq.EmptyL -> unvisited+      faceIndex Seq.:< remainingQueue ->+        let face = FaceId (fromIntegral faceIndex)+            (expandedQueue, remainingUnvisited) =+              foldFaceDirectedEdges'+                triangulation+                face+                (admitAdjacent componentLabel)+                (remainingQueue, unvisited)+         in collectComponent+              componentLabel+              expandedQueue+              remainingUnvisited++  admitAdjacent componentLabel (queued, unvisited) edge =+    if+      canCross (asUndirected edge)+        && adjacent /= outerFace+        && IntSet.member adjacentIndex unvisited+        && labelAt adjacentIndex == Just componentLabel+      then+        ( queued Seq.|> adjacentIndex+        , IntSet.delete adjacentIndex unvisited+        )+      else (queued, unvisited)+   where+    adjacent@(FaceId adjacentRaw) =+      incidentFace triangulation (reverseEdge edge)+    adjacentIndex = fromIntegral adjacentRaw+{-# INLINE faceComponentsFromLabels #-}++-- | Descend every equally labelled bounded-face component through the one+-- authoritative boundary tracer. Components are converted independently;+-- callers may group equal labels only after this descent has succeeded.+labelledRegionBoundaries+  :: Eq label+  => Triangulation mode vertex directed undirected face+  -> (FaceId -> label)+  -> Either BoundaryObstruction [(label, RegionBoundary)]+labelledRegionBoundaries triangulation labelFace =+  traverse+    (\(label, component) -> (label,) <$> componentBoundary triangulation component)+    (faceComponents triangulation labelFace)++-- | Extract the non-empty oriented boundary chain of one component. Boundary+-- half-edges retain their incident component face on the left. If several+-- boundary arms meet at one vertex, Euler descent consumes every half-edge+-- once and repeated-vertex splitting publishes finitely many simple loops.+componentBoundaryLoops+  :: Triangulation mode vertex directed undirected face+  -> FaceComponent+  -> Either BoundaryObstruction (NonEmpty BoundaryLoop)+componentBoundaryLoops triangulation component = do+  graph <- componentBoundaryGraph triangulation component+  loops <-+    case graph of+      SimpleBoundaryGraph edges outgoing ->+        traceBoundaryLoops triangulation outgoing edges+      PinchedBoundaryGraph edges _ _ _ ->+        tracePinchedBoundaryLoops triangulation edges+  case NonEmpty.nonEmpty loops of+    Just nonEmptyLoops -> Right nonEmptyLoops+    Nothing -> Left (BoundaryOuterLoopCardinality 0)++-- | Project one component into a strict polygon boundary. A pinched oriented+-- chain remains available through 'componentBoundaryLoops', but it is not one+-- lawful 'RegionBoundary' and is refused here with its first pinch witness.+componentBoundary+  :: Triangulation mode vertex directed undirected face+  -> FaceComponent+  -> Either BoundaryObstruction RegionBoundary+componentBoundary triangulation component = do+  graph <- componentBoundaryGraph triangulation component+  case graph of+    PinchedBoundaryGraph _ vertex firstEdge secondEdge ->+      Left (BoundaryPinch vertex firstEdge secondEdge)+    SimpleBoundaryGraph edges outgoing ->+      traceBoundaryLoops triangulation outgoing edges+        >>= regionBoundaryFromLoops++-- | Project exactly the supplied face section into one boundary. This is the+-- selected-section descent used by local extension: it does not label or+-- flood the complement, and therefore its work is proportional to the faces+-- named by the caller plus their constant-degree boundary edges.+componentBoundaryForFaces+  :: Triangulation mode vertex directed undirected face+  -> Set.Set FaceId+  -> Either BoundaryObstruction RegionBoundary+componentBoundaryForFaces triangulation selectedFaces = do+  component <- selectedFaceComponent triangulation selectedFaces+  componentBoundary triangulation component++selectedFaceComponent+  :: Triangulation mode vertex directed undirected face+  -> Set.Set FaceId+  -> Either BoundaryObstruction FaceComponent+selectedFaceComponent triangulation selectedFaces =+  case IntSet.lookupMin indices of+    Just 0 -> Left (BoundaryComponentFaceOutOfRange (FaceId 0) (numFaces triangulation))+    _ ->+      case IntSet.lookupGE (numFaces triangulation) indices of+        Just invalid ->+          Left+            ( BoundaryComponentFaceOutOfRange+                (FaceId (fromIntegral invalid))+                (numFaces triangulation)+            )+        Nothing -> Right (FaceComponent indices)+ where+  indices = IntSet.fromList (fmap faceIndex (Set.toAscList selectedFaces))+  faceIndex (FaceId raw) = fromIntegral raw++componentBoundaryGraph+  :: Triangulation mode vertex directed undirected face+  -> FaceComponent+  -> Either BoundaryObstruction BoundaryGraph+componentBoundaryGraph triangulation (FaceComponent componentFaces) =+  case IntSet.lookupGE (numFaces triangulation) componentFaces of+    Just invalid ->+      Left+        ( BoundaryComponentFaceOutOfRange+            (FaceId (fromIntegral invalid))+            (numFaces triangulation)+        )+    Nothing ->+      Right+        ( IntSet.foldl'+            collectFace+            (SimpleBoundaryGraph IntSet.empty IntMap.empty)+            componentFaces+        )+ where+  collectFace graph (face :: Int) =+    foldFaceDirectedEdges'+      triangulation+      (FaceId (fromIntegral face))+      insertBoundaryEdge+      graph++  insertBoundaryEdge graph edge+    | IntSet.member adjacentIndex componentFaces = graph+    | otherwise =+        case graph of+          PinchedBoundaryGraph edges pinchVertex firstEdge secondEdge ->+            PinchedBoundaryGraph+              (insertEdge edges)+              pinchVertex+              firstEdge+              secondEdge+          SimpleBoundaryGraph edges outgoing ->+            case IntMap.lookup vertexIndex outgoing of+              Nothing ->+                SimpleBoundaryGraph+                  (insertEdge edges)+                  (IntMap.insert vertexIndex edge outgoing)+              Just previousEdge ->+                PinchedBoundaryGraph+                  (insertEdge edges)+                  vertex+                  previousEdge+                  edge+   where+    FaceId adjacent = incidentFace triangulation (reverseEdge edge)+    adjacentIndex = fromIntegral adjacent+    vertex@(VertexId rawVertex) = origin triangulation edge+    vertexIndex = fromIntegral rawVertex+    DirectedEdgeId rawEdge = edge+    insertEdge = IntSet.insert (fromIntegral rawEdge)++regionBoundaryFromLoops+  :: [BoundaryLoop]+  -> Either BoundaryObstruction RegionBoundary+regionBoundaryFromLoops loops =+  case outerLoops of+    [outerLoop] ->+      Right+        RegionBoundary+          { regionBoundaryOuterLoop = outerLoop+          , regionBoundaryHoleLoops = holeLoops+          }+    _ -> Left (BoundaryOuterLoopCardinality (length outerLoops))+ where+  (outerLoops, holeLoops) =+    partition+      ((== BoundaryCounterClockwise) . boundaryLoopOrientation)+      loops++tracePinchedBoundaryLoops+  :: Triangulation mode vertex directed undirected face+  -> IntSet.IntSet+  -> Either BoundaryObstruction [BoundaryLoop]+tracePinchedBoundaryLoops triangulation boundaryEdges = do+  cycles <-+    traceOrientedBoundaryCircuits+      (origin triangulation)+      (destination triangulation)+      BoundaryCycleDidNotClose+      outgoingByVertex+      orientedEdges+  traverse+    (simplifyBoundaryLoop triangulation . NonEmpty.toList)+    cycles+ where+  orientedEdges =+    Set.fromDistinctAscList+      ( fmap+          (DirectedEdgeId . fromIntegral)+          (IntSet.toAscList boundaryEdges)+      )+  outgoingByVertex =+    Set.foldr+      (\edge -> Map.insertWith (<>) (origin triangulation edge) [edge])+      Map.empty+      orientedEdges++traceBoundaryLoops+  :: Triangulation mode vertex directed undirected face+  -> IntMap.IntMap DirectedEdgeId+  -> IntSet.IntSet+  -> Either BoundaryObstruction [BoundaryLoop]+traceBoundaryLoops triangulation outgoingByVertex = descend []+ where+  descend loops unvisited =+    case IntSet.minView unvisited of+      Nothing -> Right (reverse loops)+      Just (rawStart, _) -> do+        let start = DirectedEdgeId (fromIntegral rawStart)+        (vertices, remaining) <- traceCycle start start unvisited []+        loop <- simplifyBoundaryLoop triangulation vertices+        descend (loop : loops) remaining++  traceCycle start current unvisited reversedVertices =+    let DirectedEdgeId rawCurrent = current+        remaining = IntSet.delete (fromIntegral rawCurrent) unvisited+        accumulated = origin triangulation current : reversedVertices+        VertexId rawTarget = destination triangulation current+     in case IntMap.lookup (fromIntegral rawTarget) outgoingByVertex of+          Just successor+            | successor == start -> Right (reverse accumulated, remaining)+            | let DirectedEdgeId rawSuccessor = successor+            , IntSet.member (fromIntegral rawSuccessor) remaining ->+                traceCycle start successor remaining accumulated+            | otherwise -> Left (BoundaryCycleDidNotClose start successor)+          Nothing -> Left (BoundaryCycleDidNotClose start current)++simplifyBoundaryLoop+  :: Triangulation mode vertex directed undirected face+  -> [VertexId]+  -> Either BoundaryObstruction BoundaryLoop+simplifyBoundaryLoop triangulation vertices = do+  (windingOrder, simplifiedVertices) <-+    simplifyBoundaryCycle+      BoundaryLoopDegenerate+      redundant+      winding+      key+      vertices+  residentVertices <-+    maybe+      (Left (BoundaryLoopDegenerate vertices))+      Right+      (NonEmpty.nonEmpty vertices)+  case windingOrder of+    GT -> Right (BoundaryLoop BoundaryCounterClockwise residentVertices simplifiedVertices)+    LT -> Right (BoundaryLoop BoundaryClockwise residentVertices simplifiedVertices)+    EQ -> Left (BoundaryLoopDegenerate (NonEmpty.toList simplifiedVertices))+ where+  point vertex = vertexPoint triangulation vertex+  redundant previousVertex current nextVertex =+    orient2d (point previousVertex) (point current) (point nextVertex) == EQ+      && onClosedSegment (point previousVertex) (point nextVertex) (point current)+  winding previousVertex current nextVertex =+    orient2d (point previousVertex) (point current) (point nextVertex)+  key vertex = (point vertex, vertex)++-- | Inner faces separated from the outer face by an even minimum number of+-- barriers. A 0–1 BFS floods freely within one depth before crossing a barrier,+-- so a free-ended barrier can be walked around at depth zero while nested+-- closed barriers alternate outside and inside.+facesAtEvenBarrierDepth+  :: Triangulation mode vertex directed undirected face+  -> (UndirectedEdgeId -> Bool)+  -> [FaceId]+facesAtEvenBarrierDepth triangulation isBarrier =+  concat (evenLayers (barrierDepthLayers triangulation isBarrier))+ where+  evenLayers :: [[FaceId]] -> [[FaceId]]+  evenLayers (outsideLayer : _insideLayer : deeper) =+    outsideLayer : evenLayers deeper+  evenLayers shallow = shallow++barrierDepthLayers+  :: Triangulation mode vertex directed undirected face+  -> (UndirectedEdgeId -> Bool)+  -> [[FaceId]]+barrierDepthLayers triangulation isBarrier =+  map (filter (/= outerFace)) (layers IntSet.empty [outerFace])+ where+  known (FaceId value) = fromIntegral value < numFaces triangulation+  key :: FaceId -> Int+  key (FaceId value) = fromIntegral value++  layers visited frontier = case flood visited [] frontier of+    ([], _) -> []+    (layer, visited') -> layer : layers visited' (concatMap (neighbours isBarrier) layer)++  flood visited acc [] = (reverse acc, visited)+  flood visited acc (face : rest)+    | not (known face) || IntSet.member (key face) visited = flood visited acc rest+    | otherwise =+        flood+          (IntSet.insert (key face) visited)+          (face : acc)+          (neighbours (not . isBarrier) face <> rest)++  neighbours admit face =+    [ incidentFace triangulation (reverseEdge edge)+    | edge <- faceDirectedEdges triangulation face+    , admit (asUndirected edge)+    ]++-- | Faces reachable from the outer face without crossing a barrier edge.+outerFaceFloodFill :: Triangulation mode vertex directed undirected face -> (UndirectedEdgeId -> Bool) -> [FaceId]+outerFaceFloodFill triangulation canCross = floodFillFaces triangulation starts canCross+ where+  starts =+    [ face+    | outerEdge <- faceDirectedEdges triangulation outerFace+    , let edge = asUndirected outerEdge+    , canCross edge+    , let face = incidentFace triangulation (reverseEdge outerEdge)+    , face /= outerFace+    ]++-- | The faces a shape's start point lands in.+shapeStartFaces :: DistanceMetric metric => Triangulation mode vertex directed undirected face -> metric -> [FaceId]+shapeStartFaces triangulation metric =+  case locatePoint triangulation (metricStartPoint metric) of+    InFace face -> [face]+    OnEdge edge -> filter (/= outerFace) [incidentFace triangulation edge, incidentFace triangulation (reverseEdge edge)]+    OnVertex vertex ->+      intSetToFaces+        (List.foldl' (\set edge -> let FaceId value = incidentFace triangulation edge in if value == 0 then set else IntSet.insert (fromIntegral value) set) IntSet.empty (vertexOutgoingEdges triangulation vertex))+    OutsideConvexHull _ ->+      [ incidentFace triangulation (reverseEdge edge)+      | edge <- faceDirectedEdges triangulation outerFace+      , let from = vertexPoint triangulation (origin triangulation edge)+      , let to = vertexPoint triangulation (destination triangulation edge)+      , metricIntersectsEdge metric from to+      , incidentFace triangulation (reverseEdge edge) /= outerFace+      ]+    EmptyTriangulation -> []+ where+  intSetToFaces = map (FaceId . fromIntegral) . IntSet.toAscList++segmentRectangleIntersection :: RectangleMetric -> Point -> Point -> Bool+segmentRectangleIntersection (RectangleMetric lowerQuery upperQuery _) from to+  | lx > ux || ly > uy = False+  | lower == upper = onClosedSegment from to lower+  | otherwise = any (uncurry (segmentsIntersect from to)) boundaries+ where+  lower@(Point lx ly) = queryPointValue lowerQuery+  upper@(Point ux uy) = queryPointValue upperQuery+  boundaries =+    [ (Point lx ly, Point lx uy)+    , (Point lx uy, Point ux uy)+    , (Point ux uy, Point ux ly)+    , (Point ux ly, Point lx ly)+    ]

@@ -0,0 +1,70 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | The identifier family and the arithmetic on it: a directed edge's twin is+-- its index complement, so orientation is a bit rather than a lookup.+module Moonlight.Triangulation.Internal.HandleDefs+  ( VertexId (..)+  , FaceId (..)+  , DirectedEdgeId (..)+  , UndirectedEdgeId (..)+  , reverseEdge+  , asUndirected+  , normalizedDirected+  , reversedDirected+  , directedPair+  , isNormalized+  ) where++import Control.DeepSeq (NFData)+import Data.Bits (shiftL, shiftR, xor, (.&.))+import Data.Word (Word32)++-- | Index of a vertex in the immutable DCEL.+newtype VertexId = VertexId { unVertexId :: Word32 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, NFData)++-- | Index of a face in the immutable DCEL; zero denotes the outer face.+newtype FaceId = FaceId { unFaceId :: Word32 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, NFData)++-- | Oriented half-edge index. Twin orientations differ only in the low bit.+newtype DirectedEdgeId = DirectedEdgeId { unDirectedEdgeId :: Word32 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, NFData)++-- | Index of a twin pair, with orientation forgotten.+newtype UndirectedEdgeId = UndirectedEdgeId { unUndirectedEdgeId :: Word32 }+  deriving stock (Show)+  deriving newtype (Eq, Ord, NFData)++-- | Select the opposite orientation of the same undirected edge.+reverseEdge :: DirectedEdgeId -> DirectedEdgeId+reverseEdge (DirectedEdgeId edge) = DirectedEdgeId (edge `xor` 1)+{-# INLINE reverseEdge #-}++-- | Forget a directed edge's orientation.+asUndirected :: DirectedEdgeId -> UndirectedEdgeId+asUndirected (DirectedEdgeId edge) = UndirectedEdgeId (edge `shiftR` 1)+{-# INLINE asUndirected #-}++-- | Select the even-indexed orientation of an undirected edge.+normalizedDirected :: UndirectedEdgeId -> DirectedEdgeId+normalizedDirected (UndirectedEdgeId edge) = DirectedEdgeId (edge `shiftL` 1)+{-# INLINE normalizedDirected #-}++-- | Select the odd-indexed orientation of an undirected edge.+reversedDirected :: UndirectedEdgeId -> DirectedEdgeId+reversedDirected edge = reverseEdge (normalizedDirected edge)+{-# INLINE reversedDirected #-}++-- | Both orientations, normalized first and reversed second.+directedPair :: UndirectedEdgeId -> (DirectedEdgeId, DirectedEdgeId)+directedPair edge = (normalizedDirected edge, reversedDirected edge)+{-# INLINE directedPair #-}++-- | Whether a directed edge is the normalized orientation of its pair.+isNormalized :: DirectedEdgeId -> Bool+isNormalized (DirectedEdgeId edge) = edge .&. 1 == 0+{-# INLINE isNormalized #-}

@@ -121,7 +121,7 @@   , writeSTRef   ) import Data.Word (Word8, Word32)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( DirectedEdgeId (..)   , FaceId (..)   , UndirectedEdgeId (..)

@@ -31,7 +31,7 @@   , regionBoundaryHoleLoops   , regionBoundaryOuterLoop   )-import Moonlight.Triangulation.Handles.HandleDefs (FaceId, VertexId)+import Moonlight.Triangulation.Internal.HandleDefs (FaceId, VertexId) import Moonlight.Triangulation.Internal.BoundaryCycle   ( rotateCycleLeast   , simplifyBoundaryCycle

@@ -25,7 +25,7 @@   , SegmentRelation   ) import Moonlight.Triangulation.FloodFillIterator (BoundaryObstruction)-import Moonlight.Triangulation.Handles.HandleDefs (FaceId, VertexId)+import Moonlight.Triangulation.Internal.HandleDefs (FaceId, VertexId) import Moonlight.Triangulation.Internal.ExactSegmentEvents   ( ExactSegmentEventObstruction   )

@@ -49,7 +49,7 @@ import Data.Traversable (foldMapDefault) import qualified Data.Vector as V import Data.Word (Word8, Word32)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId (..)   , UndirectedEdgeId (..)   , VertexId (..)

@@ -48,7 +48,7 @@   ) where  import Control.DeepSeq (NFData)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( DirectedEdgeId   , FaceId   , UndirectedEdgeId

@@ -0,0 +1,528 @@+{-# LANGUAGE BangPatterns #-}++-- | Discharge: the invariants the constructors guarantee, checkable on a value+-- built by any route.+module Moonlight.Triangulation.Internal.Validation+  ( validateTopology+  , ValidationClosureStats (..)+  , validateTopologyClosure+  , validateTopologyClosureWithStats+  , validateDelaunay+  , validateTriangulation+  , triangulationIsValid+  , faceArea+  , faceMinimumAngleDegrees+  ) where++import Data.List (nub)+import qualified Data.IntSet as IntSet+import Moonlight.Triangulation.Internal.BoxedPaged (boxedPagedLength)+import Moonlight.Triangulation.Internal.BoundaryCycle (orderedPair)+import Moonlight.Triangulation.Internal.Paged (pagedFoldl', pagedLength, pagedUnsafeIndex)+import Moonlight.Triangulation.Dcel+import Moonlight.Triangulation.Internal.HandleDefs+import Moonlight.Triangulation.Handles.Iterators.FixedIterators (allFaces, directedEdges, undirectedEdges, vertices)+import Moonlight.Triangulation.Internal.PackedIndex (noIndex)+import Moonlight.Triangulation.Math+import Moonlight.Triangulation.Internal.Representation+import Moonlight.Triangulation.Internal.Types++-- | Every structural invariant violated, not the first.+validateTopology :: Triangulation mode vertex directed undirected face -> [InvariantViolation]+validateTopology triangulation =+  structuralViolations ++ orientationViolations+ where+  verticesCount = numVertices triangulation+  halfCount = numDirectedEdges triangulation+  edgeCount = numUndirectedEdges triangulation+  facesCount = numFaces triangulation++  -- Geometry descends only after the finite DCEL has glued structurally.+  -- Reading triangle coordinates through malformed links would turn a typed+  -- validation failure into an indexing crash.+  structuralViolations =+    cardinalityViolations+      ++ rangeViolations+      ++ edgeViolations+      ++ faceViolations+      ++ vertexViolations+      ++ eulerViolations++  orientationViolations+    | not (null structuralViolations) = []+    | otherwise =+        [ InnerFaceNotCounterClockwise face+        | face <- allFaces triangulation+        , face /= outerFace+        , Just (first, second, third) <- [innerFaceVertices triangulation face]+        , orient2d+            (vertexPoint triangulation first)+            (vertexPoint triangulation second)+            (vertexPoint triangulation third)+            /= GT+        ]++  cardinalityViolations =+    [ CoordinatePlaneLengthMismatch pointXCount pointYCount+    | pointXCount /= pointYCount+    ]+      ++ [VertexOutgoingLengthMismatch vertexOutCount verticesCount | vertexOutCount /= verticesCount]+      ++ [VertexPayloadLengthMismatch vertexPayloadCount verticesCount | vertexPayloadCount /= verticesCount]+      ++ [TopologyArenaLengthMismatch topologyLength (4 * halfCount) | not halfArraysEqual]+      ++ [DirectedPayloadLengthMismatch directedPayloadCount halfCount | directedPayloadCount /= halfCount]+      ++ [UndirectedPayloadLengthMismatch undirectedPayloadCount edgeCount | undirectedPayloadCount /= edgeCount]+      ++ [DirectedEdgeCountOdd halfCount | odd halfCount]+      ++ [ConstraintLengthMismatch constraintLength edgeCount | constraintLength /= edgeCount]+      ++ [ NonCanonicalConstraintFlag (UndirectedEdgeId (fromIntegral index)) flag+         | index <- [0 .. pagedLength (triConstraint triangulation) - 1]+         , let flag = pagedUnsafeIndex (triConstraint triangulation) index+         , flag /= 0 && flag /= 1+         ]+      ++ [CachedConstraintCountMismatch (triConstraintCount triangulation) actualConstraintCount | triConstraintCount triangulation /= actualConstraintCount]+      ++ [ CachedConstraintIndexMismatch+         | constraintLength == edgeCount+         , triConstraintEdges triangulation /= indexedConstraintEdges+         ]+      ++ [MissingOuterFace | facesCount == 0]+      ++ [FacePayloadLengthMismatch facePayloadCount facesCount | facePayloadCount /= facesCount]++  pointXCount = pagedLength (triPointX triangulation)+  pointYCount = pagedLength (triPointY triangulation)+  vertexOutCount = pagedLength (triVertexOut triangulation)+  vertexPayloadCount = boxedPagedLength (triVertexData triangulation)+  topologyLength = pagedLength (triHalfTopology triangulation)+  directedPayloadCount = boxedPagedLength (triDirectedData triangulation)+  undirectedPayloadCount = boxedPagedLength (triUndirectedData triangulation)+  constraintLength = pagedLength (triConstraint triangulation)+  facePayloadCount = boxedPagedLength (triFaceData triangulation)+  actualConstraintCount = pagedFoldl' (\count flag -> if flag == 1 then count + 1 else count) 0 (triConstraint triangulation)+  halfArraysEqual = topologyLength == 4 * halfCount++  indexedConstraintEdges =+    IntSet.fromAscList+      [ index+      | index <- [0 .. edgeCount - 1]+      , pagedUnsafeIndex (triConstraint triangulation) index == 1+      ]++  rangeViolations =+    [ EdgeOriginOutOfRange (DirectedEdgeId (fromIntegral index)) (VertexId value) verticesCount+    | index <- [0 .. halfCount - 1]+    , let value = pagedUnsafeIndex (triHalfTopology triangulation) (4 * index)+    , fromIntegral value >= verticesCount+    ]+      ++ [ EdgeNextOutOfRange (DirectedEdgeId (fromIntegral index)) (DirectedEdgeId value) halfCount+         | index <- [0 .. halfCount - 1]+         , let value = pagedUnsafeIndex (triHalfTopology triangulation) (4 * index + 1)+         , fromIntegral value >= halfCount+         ]+      ++ [ EdgePreviousOutOfRange (DirectedEdgeId (fromIntegral index)) (DirectedEdgeId value) halfCount+         | index <- [0 .. halfCount - 1]+         , let value = pagedUnsafeIndex (triHalfTopology triangulation) (4 * index + 2)+         , fromIntegral value >= halfCount+         ]+      ++ [ EdgeFaceOutOfRange (DirectedEdgeId (fromIntegral index)) (FaceId value) facesCount+         | index <- [0 .. halfCount - 1]+         , let value = pagedUnsafeIndex (triHalfTopology triangulation) (4 * index + 3)+         , fromIntegral value >= facesCount+         ]+      ++ [ VertexOutgoingOutOfRange (VertexId (fromIntegral index)) (DirectedEdgeId value) halfCount+         | index <- [0 .. pagedLength (triVertexOut triangulation) - 1]+         , let value = pagedUnsafeIndex (triVertexOut triangulation) index+         , value /= noIndex+         , fromIntegral value >= halfCount+         ]+      ++ [ FaceAdjacentOutOfRange (FaceId (fromIntegral index)) (DirectedEdgeId value) halfCount+         | index <- [0 .. facesCount - 1]+         , let value = pagedUnsafeIndex (triFaceEdge triangulation) index+         , value /= noIndex+         , fromIntegral value >= halfCount+         ]++  edgeViolations+    | not halfArraysEqual || odd halfCount || not (null rangeViolations) = []+    | otherwise = concatMap validateEdge (directedEdges triangulation)++  validateEdge edge@(DirectedEdgeId raw) =+    let index = fromIntegral raw+        nextEdge = next triangulation edge+        previousEdge = previous triangulation edge+        twinEdge = reverseEdge edge+        local =+          [ EdgeNextPreviousMismatch edge nextEdge+          | validEdge nextEdge && previous triangulation nextEdge /= edge+          ]+            ++ [ EdgePreviousNextMismatch edge previousEdge+               | validEdge previousEdge && next triangulation previousEdge /= edge+               ]+            ++ [EdgeDoubleReversalMismatch edge | reverseEdge twinEdge /= edge]+            ++ [EdgeSelfLinkedNext edge | nextEdge == edge && halfCount > 2]+            ++ [EdgeSelfLinkedPrevious edge | previousEdge == edge && halfCount > 2]+        innerCycle =+          if incidentFace triangulation edge /= outerFace && validEdge nextEdge && validEdge previousEdge+            then+              [ InnerFaceNotTriangularAtEdge edge+              | next triangulation (next triangulation nextEdge) /= edge+              ]+            else []+     in if index < halfCount then local ++ innerCycle else []++  validEdge (DirectedEdgeId value) = fromIntegral value < halfCount++  faceViolations+    | not (null rangeViolations) = []+    | otherwise = concatMap validateFace (allFaces triangulation)+  validateFace face@(FaceId _) =+    case adjacentEdge triangulation face of+      Nothing+        | face == outerFace && halfCount == 0 -> []+        | otherwise -> [FaceMissingAdjacentEdge face]+      Just edge ->+        [ FaceRepresentativeMismatch face edge representedFace+        | let representedFace = incidentFace triangulation edge+        , representedFace /= face+        ]+          ++ [ InnerFaceVertexCardinalityMismatch face (length faceVertexIds) (length (nub faceVertexIds))+             | face /= outerFace+             , let faceVertexIds = faceVertices triangulation face+             , length faceVertexIds /= 3 || length (nub faceVertexIds) /= 3+             ]++  vertexViolations+    | vertexOutCount /= verticesCount || not (null rangeViolations) = []+    | otherwise = concatMap validateVertex (vertices triangulation)+  validateVertex vertex = case vertexOutEdge triangulation vertex of+    Nothing+      | verticesCount <= 1 -> []+      | otherwise -> [ConnectedVertexMissingOutgoing vertex]+    Just edge ->+      [ VertexOutgoingOriginMismatch vertex edge actualOrigin+      | let actualOrigin = origin triangulation edge+      , actualOrigin /= vertex+      ]++  eulerViolations+    | not (null cardinalityViolations) || verticesCount < 2 = []+    | numInnerFaces triangulation == 0 =+        [ CollinearEdgeCountMismatch (verticesCount - 1) edgeCount+        | edgeCount /= verticesCount - 1+        ]+    | otherwise =+        [ EulerCharacteristicMismatch eulerCharacteristic+        | eulerCharacteristic /= 2+        ]+   where+    eulerCharacteristic = verticesCount - edgeCount + facesCount++-- | Apply the same DCEL edge, face, vertex, and orientation laws as+-- 'validateTopology', but only to a certified local closure.  The caller+-- supplies the admitted inner faces and the interface pairs; the collar faces+-- on the other side of those pairs are included here so a protected source+-- cannot be changed behind the local transaction.  Cardinality and Euler+-- observations remain global scalar invariants and are deliberately not+-- rebuilt from the resident mesh.+validateTopologyClosure+  :: IntSet.IntSet+  -> IntSet.IntSet+  -> Triangulation mode vertex directed undirected face+  -> [InvariantViolation]+validateTopologyClosure admittedFaces interfacePairs triangulation =+  snd (validateTopologyClosureWithStats admittedFaces interfacePairs triangulation)++validateTopologyClosureWithStats+  :: IntSet.IntSet+  -> IntSet.IntSet+  -> Triangulation mode vertex directed undirected face+  -> (ValidationClosureStats, [InvariantViolation])+validateTopologyClosureWithStats admittedFaces interfacePairs triangulation =+  ( ValidationClosureStats+      { validationClosureFaces = IntSet.size selectedFaces+      , validationClosureDirectedEdges = IntSet.size selectedEdges+      , validationClosureVertices = IntSet.size selectedVertices+      , validationClosureInterfacePairs = IntSet.size interfacePairs+      , validationClosureConstraintPairs = IntSet.size selectedPairs+      }+  , rangeViolations ++ edgeViolations ++ faceViolations ++ vertexViolations ++ orientationViolations ++ constraintViolations+  )+ where+  verticesCount = numVertices triangulation+  halfCount = numDirectedEdges triangulation+  facesCount = numFaces triangulation++  collarFaces =+    IntSet.fromList+      [ rawFace+      | rawPair <- IntSet.toAscList interfacePairs+      , rawPair >= 0+      , rawPair < numUndirectedEdges triangulation+      , let edge = UndirectedEdgeId (fromIntegral rawPair)+      , let (forward, backward) = directedPair edge+      , rawFace <- fmap faceRaw [incidentFace triangulation forward, incidentFace triangulation backward]+      , rawFace > 0+      ]+  selectedFaces = IntSet.union admittedFaces collarFaces++  selectedFaceEdges =+    IntSet.fromList+      [ rawEdge+      | rawFace <- IntSet.toAscList selectedFaces+      , edge <- faceEdgesBounded (FaceId (fromIntegral rawFace))+      , rawEdge <- [edgeRaw edge, edgeRaw (reverseEdge edge)]+      ]+  selectedInterfaceEdges =+    IntSet.fromList+      [ rawEdge+      | rawPair <- IntSet.toAscList interfacePairs+      , rawPair >= 0+      , rawPair <= (maxBound - 1) `quot` 2+      , rawEdge <- [2 * rawPair, 2 * rawPair + 1]+      ]+  selectedEdges = IntSet.union selectedFaceEdges selectedInterfaceEdges+  selectedVertices =+    IntSet.fromList+      [ rawVertex+      | rawEdge <- IntSet.toAscList selectedEdges+      , rawEdge >= 0+      , rawEdge < halfCount+      , edgeRaw (reverseEdge (DirectedEdgeId (fromIntegral rawEdge))) < halfCount+      , rawVertex <-+          [ vertexRaw (origin triangulation (DirectedEdgeId (fromIntegral rawEdge)))+          , vertexRaw (destination triangulation (DirectedEdgeId (fromIntegral rawEdge)))+          ]+      , rawVertex < verticesCount+      ]++  rangeViolations =+    [ EdgeOriginOutOfRange edge vertex verticesCount+    | rawEdge <- IntSet.toAscList selectedEdges+    , rawEdge >= 0+    , let edge = DirectedEdgeId (fromIntegral rawEdge)+    , rawEdge < halfCount+    , let vertex = origin triangulation edge+    , vertexRaw vertex >= verticesCount+    ]+      ++ [ EdgeNextOutOfRange edge nextEdge halfCount+         | rawEdge <- IntSet.toAscList selectedEdges+         , rawEdge >= 0+         , rawEdge < halfCount+         , let edge = DirectedEdgeId (fromIntegral rawEdge)+         , let nextEdge = next triangulation edge+         , edgeRaw nextEdge >= halfCount+         ]+      ++ [ EdgePreviousOutOfRange edge previousEdge halfCount+         | rawEdge <- IntSet.toAscList selectedEdges+         , rawEdge >= 0+         , rawEdge < halfCount+         , let edge = DirectedEdgeId (fromIntegral rawEdge)+         , let previousEdge = previous triangulation edge+         , edgeRaw previousEdge >= halfCount+         ]+      ++ [ EdgeFaceOutOfRange edge face facesCount+         | rawEdge <- IntSet.toAscList selectedEdges+         , rawEdge >= 0+         , rawEdge < halfCount+         , let edge = DirectedEdgeId (fromIntegral rawEdge)+         , let face = incidentFace triangulation edge+         , faceRaw face >= facesCount+         ]+      ++ [ FaceAdjacentOutOfRange face edge halfCount+         | rawFace <- IntSet.toAscList selectedFaces+         , rawFace > 0+         , rawFace < facesCount+         , let face = FaceId (fromIntegral rawFace)+         , Just edge <- [adjacentEdge triangulation face]+         , edgeRaw edge >= halfCount+         ]++  edgeViolations =+    concatMap validateEdge (IntSet.toAscList selectedEdges)++  validateEdge rawEdge+    | rawEdge < 0 || rawEdge >= halfCount = []+    | otherwise =+        let edge = DirectedEdgeId (fromIntegral rawEdge)+            nextEdge = next triangulation edge+            previousEdge = previous triangulation edge+            twinEdge = reverseEdge edge+            nextValid = edgeRaw nextEdge < halfCount+            previousValid = edgeRaw previousEdge < halfCount+            nextNextValid = nextValid && edgeRaw (next triangulation nextEdge) < halfCount+            innerCycle =+              if incidentFace triangulation edge /= outerFace && nextValid && previousValid && nextNextValid+                then [InnerFaceNotTriangularAtEdge edge | next triangulation (next triangulation nextEdge) /= edge]+                else []+         in [ EdgeNextPreviousMismatch edge nextEdge+            | nextValid && previous triangulation nextEdge /= edge+            ]+              ++ [ EdgePreviousNextMismatch edge previousEdge+                 | previousValid && next triangulation previousEdge /= edge+                 ]+              ++ [EdgeDoubleReversalMismatch edge | reverseEdge twinEdge /= edge]+              ++ [EdgeSelfLinkedNext edge | nextEdge == edge && halfCount > 2]+              ++ [EdgeSelfLinkedPrevious edge | previousEdge == edge && halfCount > 2]+              ++ innerCycle++  faceViolations = concatMap validateFace (IntSet.toAscList selectedFaces)++  validateFace rawFace+    | rawFace <= 0 || rawFace >= facesCount = []+    | otherwise =+      let face = FaceId (fromIntegral rawFace)+       in case adjacentEdge triangulation face of+          Nothing -> [FaceMissingAdjacentEdge face]+          Just edge+            | edgeRaw edge >= halfCount -> []+            | otherwise ->+                let representedFace = incidentFace triangulation edge+                    (faceEdges, faceVertices') = triangleEdgesAndVertices face+                 in [FaceRepresentativeMismatch face edge representedFace | representedFace /= face]+                      ++ [ InnerFaceVertexCardinalityMismatch face (length faceVertices') (length (nub faceVertices'))+                         | rawFace > 0+                         , length faceVertices' /= 3 || length (nub faceVertices') /= 3+                         ]+                      ++ [InnerFaceNotTriangularAtEdge edge+                         | rawFace > 0+                         , not (triangleClosed faceEdges)+                         ]++  triangleEdgesAndVertices face =+    let edges = faceEdgesBounded face+        vertices' = fmap (vertexRaw . origin triangulation) edges+     in (edges, vertices')++  triangleClosed edges =+    case edges of+      [first, _, third] -> next triangulation third == first+      _ -> False++  vertexViolations = concatMap validateVertex (IntSet.toAscList selectedVertices)++  validateVertex rawVertex =+    let vertex = VertexId (fromIntegral rawVertex)+     in case vertexOutEdge triangulation vertex of+          Nothing+            | verticesCount > 1 -> [ConnectedVertexMissingOutgoing vertex]+            | otherwise -> []+          Just edge+            | edgeRaw edge >= halfCount ->+                [VertexOutgoingOutOfRange vertex edge halfCount]+            | otherwise ->+                [ VertexOutgoingOriginMismatch vertex edge actualOrigin+                | let actualOrigin = origin triangulation edge+                , actualOrigin /= vertex+                ]++  orientationViolations =+    [ InnerFaceNotCounterClockwise face+    | rawFace <- IntSet.toAscList selectedFaces+    , rawFace > 0+    , let face = FaceId (fromIntegral rawFace)+    , let (_, vertices') = triangleEdgesAndVertices face+    , all (< verticesCount) vertices'+    , [first, second, third] <- [fmap (VertexId . fromIntegral) vertices']+    , orient2d (vertexPoint triangulation first) (vertexPoint triangulation second) (vertexPoint triangulation third) /= GT+    ]++  constraintViolations =+    [ NonCanonicalConstraintFlag edge flag+    | rawPair <- IntSet.toAscList selectedPairs+    , rawPair >= 0+    , let edge = UndirectedEdgeId (fromIntegral rawPair)+    , rawPair < numUndirectedEdges triangulation+    , let flag = pagedUnsafeIndex (triConstraint triangulation) rawPair+    , flag /= 0 && flag /= 1+    ]+      ++ [ CachedConstraintIndexMismatch+         | rawPair <- IntSet.toAscList selectedPairs+         , rawPair >= 0+         , rawPair < numUndirectedEdges triangulation+         , let flag = pagedUnsafeIndex (triConstraint triangulation) rawPair+         , (flag == 1) /= IntSet.member rawPair (triConstraintEdges triangulation)+         ]++  selectedPairs = IntSet.fromList [rawEdge `quot` 2 | rawEdge <- IntSet.toAscList selectedEdges]++  faceEdgesBounded face =+    case face of+      FaceId raw+        | toInteger raw <= 0 || toInteger raw >= toInteger facesCount -> []+      _ -> adjacentEdges+   where+    adjacentEdges = case adjacentEdge triangulation face of+      Nothing -> []+      Just start+        | edgeRaw start >= halfCount -> []+        | otherwise ->+            let second = next triangulation start+             in if edgeRaw second >= halfCount+                  then [start]+                  else+                    let third = next triangulation second+                     in if edgeRaw third >= halfCount+                          then [start, second]+                          else [start, second, third]++  edgeRaw (DirectedEdgeId raw) = fromIntegral raw+  vertexRaw (VertexId raw) = fromIntegral raw+  faceRaw (FaceId raw) = fromIntegral raw++-- | Every edge whose circumcircle is not empty.+validateDelaunay :: Triangulation mode vertex directed undirected face -> [InvariantViolation]+validateDelaunay triangulation = concatMap validateEdge (undirectedEdges triangulation)+ where+  validateEdge edge+    | isConstraintEdge triangulation edge = []+    | isBoundaryEdge triangulation edge = []+    | otherwise =+        let directed = normalizedDirected edge+            twin = reverseEdge directed+         in case (innerFaceDirectedEdges triangulation (incidentFace triangulation directed), innerFaceDirectedEdges triangulation (incidentFace triangulation twin)) of+              (Just _, Just _) ->+                let a = vertexPoint triangulation (origin triangulation directed)+                    b = vertexPoint triangulation (destination triangulation directed)+                    c = vertexPoint triangulation (origin triangulation (previous triangulation directed))+                    d = vertexPoint triangulation (origin triangulation (previous triangulation twin))+                    convex = orient2d c d b == GT && orient2d d c a == GT+                    circle = inCircle a b c d+                    illegal = convex && (circle == GT || (circle == EQ && orderedPair c d < orderedPair a b))+                 in [LocallyIllegalDelaunayEdge edge | illegal]+              _ -> [DelaunayIncidentFaceNotTriangular edge]++-- | Topology first; the Delaunay property only if the topology holds.+validateTriangulation+  :: Triangulation mode vertex directed undirected face+  -> [InvariantViolation]+validateTriangulation triangulation =+  let topology = validateTopology triangulation+   in if null topology+        then validateDelaunay triangulation+        else topology++-- | Whether 'validateTriangulation' is empty.+triangulationIsValid+  :: Triangulation mode vertex directed undirected face+  -> Bool+triangulationIsValid = null . validateTriangulation++-- | Signed area, or 'Nothing' where the face is not a triangle.+faceArea :: Triangulation mode vertex directed undirected face -> FaceId -> Maybe Double+faceArea triangulation face = do+  (v0, v1, v2) <- innerFaceVertices triangulation face+  pure (triangleArea (vertexPoint triangulation v0) (vertexPoint triangulation v1) (vertexPoint triangulation v2))++-- | Smallest interior angle, in degrees.+faceMinimumAngleDegrees :: Triangulation mode vertex directed undirected face -> FaceId -> Maybe Double+faceMinimumAngleDegrees triangulation face = do+  (v0, v1, v2) <- innerFaceVertices triangulation face+  let p0 = vertexPoint triangulation v0+      p1 = vertexPoint triangulation v1+      p2 = vertexPoint triangulation v2+      a = sqrt (squaredDistance p1 p2)+      b = sqrt (squaredDistance p2 p0)+      c = sqrt (squaredDistance p0 p1)+  if min a (min b c) <= 0+    then Nothing+    else Just (minimum [angle b c a, angle c a b, angle a b c])+ where+  angle left right opposite = acos (clamp ((left * left + right * right - opposite * opposite) / (2 * left * right))) * 180 / pi+  clamp = max (-1) . min 1

@@ -16,7 +16,7 @@ import Data.Ord (comparing) import Data.Void (Void, absurd) import Moonlight.Triangulation.Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Handles.Iterators.FixedIterators (undirectedEdges, vertices) import Moonlight.Triangulation.Math import Moonlight.Triangulation.PointLocation

@@ -9,7 +9,7 @@  import Data.List (find) import Moonlight.Triangulation.Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Handles.Iterators.FixedIterators import Moonlight.Triangulation.Internal.FaceProbe import Moonlight.Triangulation.Math

@@ -1,12 +1,6 @@-{-# LANGUAGE BangPatterns #-}---- | Discharge: the invariants the constructors guarantee, checkable on a value--- built by any route.+-- | Whole-value DCEL validation and face-quality observations. module Moonlight.Triangulation.Validation   ( validateTopology-  , ValidationClosureStats (..)-  , validateTopologyClosure-  , validateTopologyClosureWithStats   , validateDelaunay   , validateTriangulation   , triangulationIsValid@@ -14,515 +8,4 @@   , faceMinimumAngleDegrees   ) where -import Data.List (nub)-import qualified Data.IntSet as IntSet-import Moonlight.Triangulation.Internal.BoxedPaged (boxedPagedLength)-import Moonlight.Triangulation.Internal.BoundaryCycle (orderedPair)-import Moonlight.Triangulation.Internal.Paged (pagedFoldl', pagedLength, pagedUnsafeIndex)-import Moonlight.Triangulation.Dcel-import Moonlight.Triangulation.Handles.HandleDefs-import Moonlight.Triangulation.Handles.Iterators.FixedIterators (allFaces, directedEdges, undirectedEdges, vertices)-import Moonlight.Triangulation.Internal.PackedIndex (noIndex)-import Moonlight.Triangulation.Math-import Moonlight.Triangulation.Internal.Representation-import Moonlight.Triangulation.Internal.Types---- | Every structural invariant violated, not the first.-validateTopology :: Triangulation mode vertex directed undirected face -> [InvariantViolation]-validateTopology triangulation =-  structuralViolations ++ orientationViolations- where-  verticesCount = numVertices triangulation-  halfCount = numDirectedEdges triangulation-  edgeCount = numUndirectedEdges triangulation-  facesCount = numFaces triangulation--  -- Geometry descends only after the finite DCEL has glued structurally.-  -- Reading triangle coordinates through malformed links would turn a typed-  -- validation failure into an indexing crash.-  structuralViolations =-    cardinalityViolations-      ++ rangeViolations-      ++ edgeViolations-      ++ faceViolations-      ++ vertexViolations-      ++ eulerViolations--  orientationViolations-    | not (null structuralViolations) = []-    | otherwise =-        [ InnerFaceNotCounterClockwise face-        | face <- allFaces triangulation-        , face /= outerFace-        , Just (first, second, third) <- [innerFaceVertices triangulation face]-        , orient2d-            (vertexPoint triangulation first)-            (vertexPoint triangulation second)-            (vertexPoint triangulation third)-            /= GT-        ]--  cardinalityViolations =-    [ CoordinatePlaneLengthMismatch pointXCount pointYCount-    | pointXCount /= pointYCount-    ]-      ++ [VertexOutgoingLengthMismatch vertexOutCount verticesCount | vertexOutCount /= verticesCount]-      ++ [VertexPayloadLengthMismatch vertexPayloadCount verticesCount | vertexPayloadCount /= verticesCount]-      ++ [TopologyArenaLengthMismatch topologyLength (4 * halfCount) | not halfArraysEqual]-      ++ [DirectedPayloadLengthMismatch directedPayloadCount halfCount | directedPayloadCount /= halfCount]-      ++ [UndirectedPayloadLengthMismatch undirectedPayloadCount edgeCount | undirectedPayloadCount /= edgeCount]-      ++ [DirectedEdgeCountOdd halfCount | odd halfCount]-      ++ [ConstraintLengthMismatch constraintLength edgeCount | constraintLength /= edgeCount]-      ++ [ NonCanonicalConstraintFlag (UndirectedEdgeId (fromIntegral index)) flag-         | index <- [0 .. pagedLength (triConstraint triangulation) - 1]-         , let flag = pagedUnsafeIndex (triConstraint triangulation) index-         , flag /= 0 && flag /= 1-         ]-      ++ [CachedConstraintCountMismatch (triConstraintCount triangulation) actualConstraintCount | triConstraintCount triangulation /= actualConstraintCount]-      ++ [ CachedConstraintIndexMismatch-         | constraintLength == edgeCount-         , triConstraintEdges triangulation /= indexedConstraintEdges-         ]-      ++ [MissingOuterFace | facesCount == 0]-      ++ [FacePayloadLengthMismatch facePayloadCount facesCount | facePayloadCount /= facesCount]--  pointXCount = pagedLength (triPointX triangulation)-  pointYCount = pagedLength (triPointY triangulation)-  vertexOutCount = pagedLength (triVertexOut triangulation)-  vertexPayloadCount = boxedPagedLength (triVertexData triangulation)-  topologyLength = pagedLength (triHalfTopology triangulation)-  directedPayloadCount = boxedPagedLength (triDirectedData triangulation)-  undirectedPayloadCount = boxedPagedLength (triUndirectedData triangulation)-  constraintLength = pagedLength (triConstraint triangulation)-  facePayloadCount = boxedPagedLength (triFaceData triangulation)-  actualConstraintCount = pagedFoldl' (\count flag -> if flag == 1 then count + 1 else count) 0 (triConstraint triangulation)-  halfArraysEqual = topologyLength == 4 * halfCount--  indexedConstraintEdges =-    IntSet.fromAscList-      [ index-      | index <- [0 .. edgeCount - 1]-      , pagedUnsafeIndex (triConstraint triangulation) index == 1-      ]--  rangeViolations =-    [ EdgeOriginOutOfRange (DirectedEdgeId (fromIntegral index)) (VertexId value) verticesCount-    | index <- [0 .. halfCount - 1]-    , let value = pagedUnsafeIndex (triHalfTopology triangulation) (4 * index)-    , fromIntegral value >= verticesCount-    ]-      ++ [ EdgeNextOutOfRange (DirectedEdgeId (fromIntegral index)) (DirectedEdgeId value) halfCount-         | index <- [0 .. halfCount - 1]-         , let value = pagedUnsafeIndex (triHalfTopology triangulation) (4 * index + 1)-         , fromIntegral value >= halfCount-         ]-      ++ [ EdgePreviousOutOfRange (DirectedEdgeId (fromIntegral index)) (DirectedEdgeId value) halfCount-         | index <- [0 .. halfCount - 1]-         , let value = pagedUnsafeIndex (triHalfTopology triangulation) (4 * index + 2)-         , fromIntegral value >= halfCount-         ]-      ++ [ EdgeFaceOutOfRange (DirectedEdgeId (fromIntegral index)) (FaceId value) facesCount-         | index <- [0 .. halfCount - 1]-         , let value = pagedUnsafeIndex (triHalfTopology triangulation) (4 * index + 3)-         , fromIntegral value >= facesCount-         ]-      ++ [ VertexOutgoingOutOfRange (VertexId (fromIntegral index)) (DirectedEdgeId value) halfCount-         | index <- [0 .. pagedLength (triVertexOut triangulation) - 1]-         , let value = pagedUnsafeIndex (triVertexOut triangulation) index-         , value /= noIndex-         , fromIntegral value >= halfCount-         ]-      ++ [ FaceAdjacentOutOfRange (FaceId (fromIntegral index)) (DirectedEdgeId value) halfCount-         | index <- [0 .. facesCount - 1]-         , let value = pagedUnsafeIndex (triFaceEdge triangulation) index-         , value /= noIndex-         , fromIntegral value >= halfCount-         ]--  edgeViolations-    | not halfArraysEqual || odd halfCount || not (null rangeViolations) = []-    | otherwise = concatMap validateEdge (directedEdges triangulation)--  validateEdge edge@(DirectedEdgeId raw) =-    let index = fromIntegral raw-        nextEdge = next triangulation edge-        previousEdge = previous triangulation edge-        twinEdge = reverseEdge edge-        local =-          [ EdgeNextPreviousMismatch edge nextEdge-          | validEdge nextEdge && previous triangulation nextEdge /= edge-          ]-            ++ [ EdgePreviousNextMismatch edge previousEdge-               | validEdge previousEdge && next triangulation previousEdge /= edge-               ]-            ++ [EdgeDoubleReversalMismatch edge | reverseEdge twinEdge /= edge]-            ++ [EdgeSelfLinkedNext edge | nextEdge == edge && halfCount > 2]-            ++ [EdgeSelfLinkedPrevious edge | previousEdge == edge && halfCount > 2]-        innerCycle =-          if incidentFace triangulation edge /= outerFace && validEdge nextEdge && validEdge previousEdge-            then-              [ InnerFaceNotTriangularAtEdge edge-              | next triangulation (next triangulation nextEdge) /= edge-              ]-            else []-     in if index < halfCount then local ++ innerCycle else []--  validEdge (DirectedEdgeId value) = fromIntegral value < halfCount--  faceViolations-    | not (null rangeViolations) = []-    | otherwise = concatMap validateFace (allFaces triangulation)-  validateFace face@(FaceId _) =-    case adjacentEdge triangulation face of-      Nothing-        | face == outerFace && halfCount == 0 -> []-        | otherwise -> [FaceMissingAdjacentEdge face]-      Just edge ->-        [ FaceRepresentativeMismatch face edge representedFace-        | let representedFace = incidentFace triangulation edge-        , representedFace /= face-        ]-          ++ [ InnerFaceVertexCardinalityMismatch face (length faceVertexIds) (length (nub faceVertexIds))-             | face /= outerFace-             , let faceVertexIds = faceVertices triangulation face-             , length faceVertexIds /= 3 || length (nub faceVertexIds) /= 3-             ]--  vertexViolations-    | vertexOutCount /= verticesCount || not (null rangeViolations) = []-    | otherwise = concatMap validateVertex (vertices triangulation)-  validateVertex vertex = case vertexOutEdge triangulation vertex of-    Nothing-      | verticesCount <= 1 -> []-      | otherwise -> [ConnectedVertexMissingOutgoing vertex]-    Just edge ->-      [ VertexOutgoingOriginMismatch vertex edge actualOrigin-      | let actualOrigin = origin triangulation edge-      , actualOrigin /= vertex-      ]--  eulerViolations-    | not (null cardinalityViolations) || verticesCount < 2 = []-    | numInnerFaces triangulation == 0 =-        [ CollinearEdgeCountMismatch (verticesCount - 1) edgeCount-        | edgeCount /= verticesCount - 1-        ]-    | otherwise =-        [ EulerCharacteristicMismatch eulerCharacteristic-        | eulerCharacteristic /= 2-        ]-   where-    eulerCharacteristic = verticesCount - edgeCount + facesCount---- | Apply the same DCEL edge, face, vertex, and orientation laws as--- 'validateTopology', but only to a certified local closure.  The caller--- supplies the admitted inner faces and the interface pairs; the collar faces--- on the other side of those pairs are included here so a protected source--- cannot be changed behind the local transaction.  Cardinality and Euler--- observations remain global scalar invariants and are deliberately not--- rebuilt from the resident mesh.-validateTopologyClosure-  :: IntSet.IntSet-  -> IntSet.IntSet-  -> Triangulation mode vertex directed undirected face-  -> [InvariantViolation]-validateTopologyClosure admittedFaces interfacePairs triangulation =-  snd (validateTopologyClosureWithStats admittedFaces interfacePairs triangulation)--validateTopologyClosureWithStats-  :: IntSet.IntSet-  -> IntSet.IntSet-  -> Triangulation mode vertex directed undirected face-  -> (ValidationClosureStats, [InvariantViolation])-validateTopologyClosureWithStats admittedFaces interfacePairs triangulation =-  ( ValidationClosureStats-      { validationClosureFaces = IntSet.size selectedFaces-      , validationClosureDirectedEdges = IntSet.size selectedEdges-      , validationClosureVertices = IntSet.size selectedVertices-      , validationClosureInterfacePairs = IntSet.size interfacePairs-      , validationClosureConstraintPairs = IntSet.size selectedPairs-      }-  , rangeViolations ++ edgeViolations ++ faceViolations ++ vertexViolations ++ orientationViolations ++ constraintViolations-  )- where-  verticesCount = numVertices triangulation-  halfCount = numDirectedEdges triangulation-  facesCount = numFaces triangulation--  collarFaces =-    IntSet.fromList-      [ rawFace-      | rawPair <- IntSet.toAscList interfacePairs-      , rawPair >= 0-      , rawPair < numUndirectedEdges triangulation-      , let edge = UndirectedEdgeId (fromIntegral rawPair)-      , let (forward, backward) = directedPair edge-      , rawFace <- fmap faceRaw [incidentFace triangulation forward, incidentFace triangulation backward]-      , rawFace > 0-      ]-  selectedFaces = IntSet.union admittedFaces collarFaces--  selectedFaceEdges =-    IntSet.fromList-      [ rawEdge-      | rawFace <- IntSet.toAscList selectedFaces-      , edge <- faceEdgesBounded (FaceId (fromIntegral rawFace))-      , rawEdge <- [edgeRaw edge, edgeRaw (reverseEdge edge)]-      ]-  selectedInterfaceEdges =-    IntSet.fromList-      [ rawEdge-      | rawPair <- IntSet.toAscList interfacePairs-      , rawPair >= 0-      , rawPair <= (maxBound - 1) `quot` 2-      , rawEdge <- [2 * rawPair, 2 * rawPair + 1]-      ]-  selectedEdges = IntSet.union selectedFaceEdges selectedInterfaceEdges-  selectedVertices =-    IntSet.fromList-      [ rawVertex-      | rawEdge <- IntSet.toAscList selectedEdges-      , rawEdge >= 0-      , rawEdge < halfCount-      , edgeRaw (reverseEdge (DirectedEdgeId (fromIntegral rawEdge))) < halfCount-      , rawVertex <--          [ vertexRaw (origin triangulation (DirectedEdgeId (fromIntegral rawEdge)))-          , vertexRaw (destination triangulation (DirectedEdgeId (fromIntegral rawEdge)))-          ]-      , rawVertex < verticesCount-      ]--  rangeViolations =-    [ EdgeOriginOutOfRange edge vertex verticesCount-    | rawEdge <- IntSet.toAscList selectedEdges-    , rawEdge >= 0-    , let edge = DirectedEdgeId (fromIntegral rawEdge)-    , rawEdge < halfCount-    , let vertex = origin triangulation edge-    , vertexRaw vertex >= verticesCount-    ]-      ++ [ EdgeNextOutOfRange edge nextEdge halfCount-         | rawEdge <- IntSet.toAscList selectedEdges-         , rawEdge >= 0-         , rawEdge < halfCount-         , let edge = DirectedEdgeId (fromIntegral rawEdge)-         , let nextEdge = next triangulation edge-         , edgeRaw nextEdge >= halfCount-         ]-      ++ [ EdgePreviousOutOfRange edge previousEdge halfCount-         | rawEdge <- IntSet.toAscList selectedEdges-         , rawEdge >= 0-         , rawEdge < halfCount-         , let edge = DirectedEdgeId (fromIntegral rawEdge)-         , let previousEdge = previous triangulation edge-         , edgeRaw previousEdge >= halfCount-         ]-      ++ [ EdgeFaceOutOfRange edge face facesCount-         | rawEdge <- IntSet.toAscList selectedEdges-         , rawEdge >= 0-         , rawEdge < halfCount-         , let edge = DirectedEdgeId (fromIntegral rawEdge)-         , let face = incidentFace triangulation edge-         , faceRaw face >= facesCount-         ]-      ++ [ FaceAdjacentOutOfRange face edge halfCount-         | rawFace <- IntSet.toAscList selectedFaces-         , rawFace > 0-         , rawFace < facesCount-         , let face = FaceId (fromIntegral rawFace)-         , Just edge <- [adjacentEdge triangulation face]-         , edgeRaw edge >= halfCount-         ]--  edgeViolations =-    concatMap validateEdge (IntSet.toAscList selectedEdges)--  validateEdge rawEdge-    | rawEdge < 0 || rawEdge >= halfCount = []-    | otherwise =-        let edge = DirectedEdgeId (fromIntegral rawEdge)-            nextEdge = next triangulation edge-            previousEdge = previous triangulation edge-            twinEdge = reverseEdge edge-            nextValid = edgeRaw nextEdge < halfCount-            previousValid = edgeRaw previousEdge < halfCount-            nextNextValid = nextValid && edgeRaw (next triangulation nextEdge) < halfCount-            innerCycle =-              if incidentFace triangulation edge /= outerFace && nextValid && previousValid && nextNextValid-                then [InnerFaceNotTriangularAtEdge edge | next triangulation (next triangulation nextEdge) /= edge]-                else []-         in [ EdgeNextPreviousMismatch edge nextEdge-            | nextValid && previous triangulation nextEdge /= edge-            ]-              ++ [ EdgePreviousNextMismatch edge previousEdge-                 | previousValid && next triangulation previousEdge /= edge-                 ]-              ++ [EdgeDoubleReversalMismatch edge | reverseEdge twinEdge /= edge]-              ++ [EdgeSelfLinkedNext edge | nextEdge == edge && halfCount > 2]-              ++ [EdgeSelfLinkedPrevious edge | previousEdge == edge && halfCount > 2]-              ++ innerCycle--  faceViolations = concatMap validateFace (IntSet.toAscList selectedFaces)--  validateFace rawFace-    | rawFace <= 0 || rawFace >= facesCount = []-    | otherwise =-      let face = FaceId (fromIntegral rawFace)-       in case adjacentEdge triangulation face of-          Nothing -> [FaceMissingAdjacentEdge face]-          Just edge-            | edgeRaw edge >= halfCount -> []-            | otherwise ->-                let representedFace = incidentFace triangulation edge-                    (faceEdges, faceVertices') = triangleEdgesAndVertices face-                 in [FaceRepresentativeMismatch face edge representedFace | representedFace /= face]-                      ++ [ InnerFaceVertexCardinalityMismatch face (length faceVertices') (length (nub faceVertices'))-                         | rawFace > 0-                         , length faceVertices' /= 3 || length (nub faceVertices') /= 3-                         ]-                      ++ [InnerFaceNotTriangularAtEdge edge-                         | rawFace > 0-                         , not (triangleClosed faceEdges)-                         ]--  triangleEdgesAndVertices face =-    let edges = faceEdgesBounded face-        vertices' = fmap (vertexRaw . origin triangulation) edges-     in (edges, vertices')--  triangleClosed edges =-    case edges of-      [first, _, third] -> next triangulation third == first-      _ -> False--  vertexViolations = concatMap validateVertex (IntSet.toAscList selectedVertices)--  validateVertex rawVertex =-    let vertex = VertexId (fromIntegral rawVertex)-     in case vertexOutEdge triangulation vertex of-          Nothing-            | verticesCount > 1 -> [ConnectedVertexMissingOutgoing vertex]-            | otherwise -> []-          Just edge-            | edgeRaw edge >= halfCount ->-                [VertexOutgoingOutOfRange vertex edge halfCount]-            | otherwise ->-                [ VertexOutgoingOriginMismatch vertex edge actualOrigin-                | let actualOrigin = origin triangulation edge-                , actualOrigin /= vertex-                ]--  orientationViolations =-    [ InnerFaceNotCounterClockwise face-    | rawFace <- IntSet.toAscList selectedFaces-    , rawFace > 0-    , let face = FaceId (fromIntegral rawFace)-    , let (_, vertices') = triangleEdgesAndVertices face-    , all (< verticesCount) vertices'-    , [first, second, third] <- [fmap (VertexId . fromIntegral) vertices']-    , orient2d (vertexPoint triangulation first) (vertexPoint triangulation second) (vertexPoint triangulation third) /= GT-    ]--  constraintViolations =-    [ NonCanonicalConstraintFlag edge flag-    | rawPair <- IntSet.toAscList selectedPairs-    , rawPair >= 0-    , let edge = UndirectedEdgeId (fromIntegral rawPair)-    , rawPair < numUndirectedEdges triangulation-    , let flag = pagedUnsafeIndex (triConstraint triangulation) rawPair-    , flag /= 0 && flag /= 1-    ]-      ++ [ CachedConstraintIndexMismatch-         | rawPair <- IntSet.toAscList selectedPairs-         , rawPair >= 0-         , rawPair < numUndirectedEdges triangulation-         , let flag = pagedUnsafeIndex (triConstraint triangulation) rawPair-         , (flag == 1) /= IntSet.member rawPair (triConstraintEdges triangulation)-         ]--  selectedPairs = IntSet.fromList [rawEdge `quot` 2 | rawEdge <- IntSet.toAscList selectedEdges]--  faceEdgesBounded face =-    case face of-      FaceId raw-        | toInteger raw <= 0 || toInteger raw >= toInteger facesCount -> []-      _ -> adjacentEdges-   where-    adjacentEdges = case adjacentEdge triangulation face of-      Nothing -> []-      Just start-        | edgeRaw start >= halfCount -> []-        | otherwise ->-            let second = next triangulation start-             in if edgeRaw second >= halfCount-                  then [start]-                  else-                    let third = next triangulation second-                     in if edgeRaw third >= halfCount-                          then [start, second]-                          else [start, second, third]--  edgeRaw (DirectedEdgeId raw) = fromIntegral raw-  vertexRaw (VertexId raw) = fromIntegral raw-  faceRaw (FaceId raw) = fromIntegral raw---- | Every edge whose circumcircle is not empty.-validateDelaunay :: Triangulation mode vertex directed undirected face -> [InvariantViolation]-validateDelaunay triangulation = concatMap validateEdge (undirectedEdges triangulation)- where-  validateEdge edge-    | isConstraintEdge triangulation edge = []-    | isBoundaryEdge triangulation edge = []-    | otherwise =-        let directed = normalizedDirected edge-            twin = reverseEdge directed-         in case (innerFaceDirectedEdges triangulation (incidentFace triangulation directed), innerFaceDirectedEdges triangulation (incidentFace triangulation twin)) of-              (Just _, Just _) ->-                let a = vertexPoint triangulation (origin triangulation directed)-                    b = vertexPoint triangulation (destination triangulation directed)-                    c = vertexPoint triangulation (origin triangulation (previous triangulation directed))-                    d = vertexPoint triangulation (origin triangulation (previous triangulation twin))-                    convex = orient2d c d b == GT && orient2d d c a == GT-                    circle = inCircle a b c d-                    illegal = convex && (circle == GT || (circle == EQ && orderedPair c d < orderedPair a b))-                 in [LocallyIllegalDelaunayEdge edge | illegal]-              _ -> [DelaunayIncidentFaceNotTriangular edge]---- | Topology first; the Delaunay property only if the topology holds.-validateTriangulation-  :: Triangulation mode vertex directed undirected face-  -> [InvariantViolation]-validateTriangulation triangulation =-  let topology = validateTopology triangulation-   in if null topology-        then validateDelaunay triangulation-        else topology---- | Whether 'validateTriangulation' is empty.-triangulationIsValid-  :: Triangulation mode vertex directed undirected face-  -> Bool-triangulationIsValid = null . validateTriangulation---- | Signed area, or 'Nothing' where the face is not a triangle.-faceArea :: Triangulation mode vertex directed undirected face -> FaceId -> Maybe Double-faceArea triangulation face = do-  (v0, v1, v2) <- innerFaceVertices triangulation face-  pure (triangleArea (vertexPoint triangulation v0) (vertexPoint triangulation v1) (vertexPoint triangulation v2))---- | Smallest interior angle, in degrees.-faceMinimumAngleDegrees :: Triangulation mode vertex directed undirected face -> FaceId -> Maybe Double-faceMinimumAngleDegrees triangulation face = do-  (v0, v1, v2) <- innerFaceVertices triangulation face-  let p0 = vertexPoint triangulation v0-      p1 = vertexPoint triangulation v1-      p2 = vertexPoint triangulation v2-      a = sqrt (squaredDistance p1 p2)-      b = sqrt (squaredDistance p2 p0)-      c = sqrt (squaredDistance p0 p1)-  if min a (min b c) <= 0-    then Nothing-    else Just (minimum [angle b c a, angle c a b, angle a b c])- where-  angle left right opposite = acos (clamp ((left * left + right * right - opposite * opposite) / (2 * left * right))) * 180 / pi-  clamp = max (-1) . min 1+import Moonlight.Triangulation.Internal.Validation

@@ -62,7 +62,7 @@   , exactSegment   , exactSegmentEndpoints   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId (..)   , UndirectedEdgeId (..)   , VertexId (..)

@@ -50,7 +50,7 @@   , vertexOutEdge   , vertexPoint   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( DirectedEdgeId (..)   , asUndirected   , FaceId (..)

@@ -33,7 +33,7 @@  import Control.DeepSeq (NFData) import Moonlight.Triangulation.Dcel-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Handles.Iterators.FixedIterators (directedEdges, undirectedEdges, vertices) import Moonlight.Triangulation.Math import Moonlight.Triangulation.Types

@@ -30,12 +30,12 @@   , ElementDefaults (..)   , unitElementDefaults   , JoinSemilattice (..)+  , Coordinate2 (..)+  , mapCoordinate2     -- | An identifier is admitted by the triangulation that issued it. The     -- observations below index without a second bounds check, so the-    -- constructors are withheld here and the projections are not: an-    -- identifier can be read, compared and carried, and can only be obtained-    -- from a mesh. "Moonlight.Triangulation.Handles.HandleDefs" exports the-    -- constructors for a caller who is willing to own that obligation.+    -- constructors are withheld and the projections are not: an identifier+    -- can be read, compared and carried, and can only be obtained from a mesh.   , VertexId   , unVertexId   , FaceId@@ -51,7 +51,10 @@   , directedPair   , isNormalized -    -- * Generation — @delaunay@; canonical observation factors through the site set+    -- * Generation and editing — persistent verbs publish one new value;+    -- sessions compose many edits behind one sealed thaw/freeze boundary+  , empty+  , clear   , delaunay   , delaunayGeometry   , DuplicatePayloadPolicy (..)@@ -59,6 +62,32 @@   , BuildResult   , buildTriangulation   , buildInputVertices+  , buildStats+  , BuildStats (..)+  , emptyBuildStats+  , InsertionDisposition (..)+  , InsertionResult+  , insertionTriangulation+  , insertionVertex+  , insertionDisposition+  , insertionStats+  , insert+  , insertAt+  , insertMany+  , RemovalOutcome (..)+  , RemovalResult (..)+  , removeVertex+  , locateAndRemove+  , Session+  , withSession+  , insertVertex+  , insertVertexAt+  , insertVertexAtNear+  , removeAt+  , removeAtNear+  , removeManyAt+  , removeManyAtNear+  , refuse   , BuildError (..)   , PublicationStats (..)   , ValidationClosureStats (..)@@ -68,9 +97,28 @@     -- * The annotation functor — payloads annotate geometry, never author it;     -- the mesh is the same mesh before and after   , mapVertices+  , mapDirectedEdges+  , mapUndirectedEdges+  , mapFaces+  , imapUndirectedEdges+  , imapFaces+  , PayloadTraversal+  , vertexPayloads+  , directedPayloads+  , undirectedPayloads+  , facePayloads+  , overPayloads+  , foldPayloads+  , payloadList   , geometryOnlyPublication   , vertexData+  , directedEdgeData+  , undirectedEdgeData+  , faceData   , setVertexData+  , setDirectedEdgeData+  , setUndirectedEdgeData+  , setFaceData      -- * Finite-set algebra and its normal form — support order is observable,     -- intersection can combine heterogeneous annotations, and each@@ -89,6 +137,7 @@     -- (sites, segments), defined exactly on realizable segment sets and     -- naming the corridor that blocked it where it is not   , constrainedDelaunay+  , constrainedDelaunayMaximal   , fromDelaunay   , constraintEdges   , isConstraintEdge@@ -109,6 +158,12 @@   , ConstrainedExtensionResult   , constrainedExtensionConstraintBatch   , constrainedExtensionBuildStats+  , ConstraintRecoveryResult (..)+  , ConstraintResult+  , ConstraintOutcome (..)+  , ConstraintBatchStats (..)+  , ConstraintSplitBatchResult+  , CdtBuildResult (..)   , ConstrainedSeamSide (..)   , ConstrainedSeamFaceEvidence   , constrainedSeamSourceFace@@ -131,6 +186,19 @@   , unionConstrained   , joinSeparatedConstrained   , extendConstrainedWith+  , constraintStorageBytes+  , existsConstraint+  , canAddConstraint+  , intersectsConstraint+  , getConflictingEdgesBetweenPoints+  , getConflictingEdgesBetweenVertices+  , recoverConstraints+  , addConstraintEdge+  , addConstraintEdges+  , addConstraintAndSplit+  , addConstraintsAndSplit+  , removeConstraintEdge+  , outerRegionFaces      -- * Refinement — budget-bounded, composed after any operation above rather     -- than configured into it; 'refinementComplete' reports sufficiency, not@@ -146,6 +214,7 @@   , refinementDomainResult   , refinementDomainReceipt   , refinedTriangulation+  , refinementStats   , refinementVisitedJoinFaces   , refinementVisitedProtectedFaces   , refinementCreatedFaces@@ -167,31 +236,95 @@     -- interpolation and barrier parity, none of which build a second mesh   , numVertices   , vertices+  , foldVertices'   , vertexPoint   , vertexPoints   , numFaces+  , numInnerFaces+  , allFaces   , innerFaces+  , foldAllFaces'+  , foldInnerFaces'   , outerFace+  , adjacentEdge   , faceDirectedEdges   , faceVertices+  , innerFaceDirectedEdges+  , innerFaceVertices   , innerFaceDirectedEdgeTriples   , innerFaceVertexTriples+  , foldFaceDirectedEdges'+  , vertexOutEdge   , vertexOutgoingEdges+  , foldVertexOutgoingEdges'+  , numDirectedEdges+  , directedEdges+  , foldDirectedEdges'   , numUndirectedEdges   , undirectedEdges+  , foldUndirectedEdges'+  , hullEdges+  , hullVertices   , undirectedEndpoints   , origin   , destination+  , next+  , previous+  , clockwise+  , counterClockwise   , incidentFace+  , isOuterDirectedEdge   , isBoundaryEdge+  , numConstraints+  , locatePoint+  , locatePointWithHint+  , Location (..)   , nearestNeighbor   , NearestStats (..)   , interpolateNearest   , interpolateBarycentric   , LocationHint (..)+  , LocationStats (..)+  , emptyLocationStats+  , Intersection (..)+  , lineIntersections+  , lineIntersectionsBetweenVertices+  , foldCorridorBetweenPoints+  , foldCorridorBetweenVertices+  , conflictingEdges+  , segmentIntersectsNonCollinear+  , DistanceMetric (..)+  , CircleMetric+  , CircleMetricError (..)+  , RectangleMetric+  , RectangleMetricError (..)+  , circleMetric+  , rectangleMetric+  , edgesInShape+  , verticesInShape+  , edgesInCircle+  , verticesInCircle+  , edgesInRectangle+  , verticesInRectangle   , floodFillFaces+  , outerFaceFloodFill   , facesAtEvenBarrierDepth +    -- ** Robust planar predicates and constructions+  , orient2d+  , sideQuery+  , inCircle+  , segmentRelation+  , segmentsProperlyCross+  , segmentsIntersect+  , squaredDistance+  , distance+  , midpoint+  , centroid+  , triangleArea+  , circumcenter+  , barycentricCoordinates+     -- ** Face regions and alpha filtration   , FaceComponent   , faceComponentFaces@@ -205,6 +338,8 @@   , regionBoundaryHoleLoops   , BoundaryObstruction (..)   , faceComponents+  , faceComponentsBy+  , labelledRegionBoundaries   , componentBoundaryLoops   , componentBoundary   , componentBoundaryForFaces@@ -239,6 +374,13 @@   , ExactPoint   , exactPoint   , exactPointCoordinates+  , exactPointCross+  , ExactVector (..)+  , exactVectorFromPoints+  , addExactVectors+  , exactCross+  , compareExactVectorAngle+  , translateExactPoint   , ExactSegment   , ExactGeometryError (..)   , exactSegment@@ -249,9 +391,11 @@   , exactOrient2d   , exactOnClosedSegment   , SegmentRelation (..)+  , allSegmentRelations   , exactSegmentRelation   , ExactIntersectionError (..)   , exactLineIntersection+  , exactSupportingLineIntersection   , ExactLoop   , exactLoop   , exactLoopPoints@@ -340,15 +484,25 @@      -- * Discharge — the invariants the constructors guarantee, checkable on a     -- value built by any route; every violation is a value carrying its witness+  , validateTopology+  , validateDelaunay   , validateTriangulation+  , triangulationIsValid+  , faceArea+  , faceMinimumAngleDegrees   , InvariantViolation (..)   ) where  import Moonlight.Triangulation.BulkLoad   ( DuplicatePayloadPolicy (..)+  , clear   , delaunay   , delaunayFromCoordinates   , delaunayGeometry+  , empty+  , insert+  , insertAt+  , insertMany   ) import Moonlight.Triangulation.CellSet   ( CellSelectionError (..)@@ -363,22 +517,44 @@   , foldExactCellVertices   ) import Moonlight.Triangulation.Dcel-  ( destination+  ( adjacentEdge+  , clockwise+  , counterClockwise+  , destination+  , directedEdgeData+  , faceData   , faceDirectedEdges   , faceVertices+  , foldFaceDirectedEdges'+  , foldVertexOutgoingEdges'+  , imapFaces+  , imapUndirectedEdges+  , innerFaceDirectedEdges   , innerFaceDirectedEdgeTriples+  , innerFaceVertices   , innerFaceVertexTriples   , incidentFace   , isBoundaryEdge   , isConstraintEdge+  , isOuterDirectedEdge+  , next+  , numConstraints+  , numDirectedEdges   , numFaces+  , numInnerFaces   , numUndirectedEdges   , numVertices   , origin   , outerFace+  , previous+  , setDirectedEdgeData+  , setFaceData+  , setUndirectedEdgeData   , setVertexData+  , undirectedEdgeData   , undirectedEndpoints   , vertexData+  , vertexOutEdge   , vertexOutgoingEdges   , vertexPoint   , vertexPoints@@ -405,79 +581,130 @@   ( BoundaryLoop   , BoundaryObstruction (..)   , BoundaryOrientation (..)+  , CircleMetric+  , CircleMetricError (..)+  , DistanceMetric (..)   , FaceComponent+  , RectangleMetric+  , RectangleMetricError (..)   , RegionBoundary   , boundaryLoopOrientation   , boundaryLoopResidentVertices   , boundaryLoopVertices+  , circleMetric   , componentBoundary   , componentBoundaryLoops   , componentBoundaryForFaces+  , edgesInCircle+  , edgesInRectangle+  , edgesInShape   , faceComponentFaces   , faceComponents+  , faceComponentsBy   , facesAtEvenBarrierDepth   , floodFillFaces+  , labelledRegionBoundaries+  , outerFaceFloodFill+  , rectangleMetric   , regionBoundaryHoleLoops   , regionBoundaryOuterLoop+  , verticesInCircle+  , verticesInRectangle+  , verticesInShape   ) import Moonlight.Triangulation.Exact   ( ExactGeometryError (..)   , ExactIntersectionError (..)   , ExactPoint   , ExactSegment+  , ExactVector (..)   , SegmentRelation (..)+  , addExactVectors+  , allSegmentRelations+  , compareExactVectorAngle+  , exactCross   , exactLineIntersection   , exactOnClosedSegment   , exactOrient2d   , exactPoint   , exactPointCoordinates+  , exactPointCross   , exactPointFromPoint   , exactPointFromQueryPoint   , exactPointToEmbeddingCandidate   , exactSegment   , exactSegmentEndpoints   , exactSegmentRelation+  , exactSupportingLineIntersection+  , exactVectorFromPoints+  , translateExactPoint   ) import Moonlight.Triangulation.Handles.HandleDefs-  ( DirectedEdgeId (..)-  , FaceId (..)-  , UndirectedEdgeId (..)-  , VertexId (..)+  ( DirectedEdgeId+  , FaceId+  , UndirectedEdgeId+  , VertexId   , asUndirected   , directedPair   , isNormalized   , normalizedDirected   , reverseEdge   , reversedDirected+  , unDirectedEdgeId+  , unFaceId+  , unUndirectedEdgeId+  , unVertexId   ) import Moonlight.Triangulation.Handles.Iterators.FixedIterators-  ( innerFaces+  ( allFaces+  , directedEdges+  , foldAllFaces'+  , foldDirectedEdges'+  , foldInnerFaces'+  , foldUndirectedEdges'+  , foldVertices'+  , innerFaces   , undirectedEdges   , vertices   )-import Moonlight.Triangulation.Internal.Canonical (canonicalize)-import Moonlight.Triangulation.Cdt (boundedRegionFaces)-import Moonlight.Triangulation.Internal.Cdt.Build-  ( constrainedDelaunay-  , fromDelaunay+import Moonlight.Triangulation.Handles.Iterators.HullIterator+  ( hullEdges+  , hullVertices   )-import Moonlight.Triangulation.Internal.Cdt.Query (constraintEdges)-import Moonlight.Triangulation.Internal.Cdt.Types+import Moonlight.Triangulation.Canonical (canonicalize)+import Moonlight.Triangulation.Cdt   ( CanonicalSegment+  , CdtBuildResult (..)   , CdtError (..)-  , ConstrainedUnionError (..)   , ConstrainedExtensionResult-  , ConstrainedSeamSide (..)   , ConstrainedSeamFaceEvidence   , ConstrainedSeamResult+  , ConstrainedSeamSide (..)+  , ConstrainedUnionError (..)+  , ConstraintBatchStats (..)   , ConstraintBatchResult   , ConstraintConflict+  , ConstraintOutcome (..)+  , ConstraintRecoveryResult (..)+  , ConstraintResult+  , ConstraintSplitBatchResult   , CorridorObstruction (..)+  , addConstraintAndSplit+  , addConstraintEdge+  , addConstraintEdges+  , addConstraintsAndSplit+  , boundedRegionFaces+  , canAddConstraint+  , constrainedDelaunay+  , constrainedDelaunayMaximal   , constrainedExtensionBuildStats   , constrainedExtensionConstraintBatch+  , constraintEdges   , constraintBatchOutcomes   , constraintBatchStats   , constraintBatchTriangulation+  , constraintSegments+  , constraintStorageBytes   , constrainedSeamBuildStats   , constrainedSeamConstraintStats   , constrainedSeamCachedFrontierPointReads@@ -494,13 +721,18 @@   , constrainedSeamTargetFace   , conflictFirstSegment   , conflictSecondSegment-  , segmentEnd-  , segmentStart-  )-import Moonlight.Triangulation.Internal.Cdt.Union-  ( constraintSegments+  , existsConstraint   , extendConstrainedWith+  , fromDelaunay+  , getConflictingEdgesBetweenPoints+  , getConflictingEdgesBetweenVertices+  , intersectsConstraint   , joinSeparatedConstrained+  , outerRegionFaces+  , recoverConstraints+  , removeConstraintEdge+  , segmentEnd+  , segmentStart   , unionConstrained   , unionConstrainedWith   )@@ -512,43 +744,36 @@   , exactRationalDenominator   , exactRationalNumerator   )-import Moonlight.Triangulation.Internal.Representation-  ( BuildResult-  , ConstrainedDelaunayTriangulation-  , DelaunayTriangulation-  , RefinementDomainResult-  , RefinementReceipt-  , RefinementResult-  , Triangulation-  , buildInputVertices-  , buildTriangulation-  , geometryOnlyPublication-  , refinementPublicationStats-  , refinementValidationClosureStats-  , refinementDomainReceipt-  , refinementDomainResult-  , refinedTriangulation-  , refinementInterfaceBoundaryReads-  , refinementAttemptedBoundaryCrossings-  , refinementAddedVertices-  , refinementComplete-  , refinementCreatedFaces-  , refinementFinalPermittedFaces-  , refinementFinalInterfaceIncidence-  , refinementExcludedFaces-  , refinementRemovedEdges-  , refinementTouchedEdges-  , refinementVisitedJoinFaces-  , refinementVisitedProtectedFaces+import Moonlight.Triangulation.Internal.Representation (geometryOnlyPublication)+import Moonlight.Triangulation.Interop+  ( Coordinate2 (..)+  , mapCoordinate2   )-import Moonlight.Triangulation.Internal.Types+import Moonlight.Triangulation.IntersectionIterator+  ( Intersection (..)+  , conflictingEdges+  , foldCorridorBetweenPoints+  , foldCorridorBetweenVertices+  , lineIntersections+  , lineIntersectionsBetweenVertices+  , segmentIntersectsNonCollinear+  )+import Moonlight.Triangulation.Types   ( BuildError (..)+  , BuildResult+  , BuildStats (..)+  , ConstrainedDelaunayTriangulation   , ConstraintMode (..)   , CoordinateError (..)+  , DelaunayTriangulation   , ElementDefaults (..)   , HasPosition (..)+  , InsertionDisposition (..)+  , InsertionResult   , InvariantViolation (..)+  , Location (..)   , LocationHint (..)+  , LocationStats (..)   , NearestStats (..)   , NonFiniteValue (..)   , Point (..)@@ -556,13 +781,44 @@   , QueryPoint   , RadiusSquared   , RadiusSquaredError (..)+  , RefinementDomainResult   , RefinementParameters (..)-  , ValidationClosureStats (..)+  , RefinementReceipt+  , RefinementResult   , SiteRelation (..)+  , Triangulation+  , ValidationClosureStats (..)+  , buildInputVertices+  , buildStats+  , buildTriangulation   , defaultRefinementParameters+  , emptyBuildStats+  , emptyLocationStats+  , insertionDisposition+  , insertionStats+  , insertionTriangulation+  , insertionVertex   , mkRadiusSquared   , queryPointValue   , radiusSquaredValue+  , refinedTriangulation+  , refinementAddedVertices+  , refinementAttemptedBoundaryCrossings+  , refinementComplete+  , refinementCreatedFaces+  , refinementDomainReceipt+  , refinementDomainResult+  , refinementExcludedFaces+  , refinementFinalInterfaceIncidence+  , refinementFinalPermittedFaces+  , refinementInterfaceBoundaryReads+  , refinementPublicationStats+  , refinementRemovedEdges+  , refinementStats+  , refinementTouchedEdges+  , refinementValidationClosureStats+  , refinementVisitedJoinFaces+  , refinementVisitedProtectedFaces   , unitElementDefaults   ) import Moonlight.Triangulation.Interpolation@@ -587,7 +843,22 @@   , polygonOffset   , structuringElement   )-import Moonlight.Triangulation.Math (mkQueryPoint)+import Moonlight.Triangulation.Math+  ( barycentricCoordinates+  , centroid+  , circumcenter+  , distance+  , inCircle+  , midpoint+  , mkQueryPoint+  , orient2d+  , segmentRelation+  , segmentsIntersect+  , segmentsProperlyCross+  , sideQuery+  , squaredDistance+  , triangleArea+  ) import Moonlight.Triangulation.Overlay   ( OverlayError (..)   , OverlayReceipt (..)@@ -606,7 +877,30 @@   , overlayRegularizedDifference   , overlaySelectedRegion   )-import Moonlight.Triangulation.Payload (mapVertices)+import Moonlight.Triangulation.Payload+  ( PayloadTraversal+  , directedPayloads+  , facePayloads+  , foldPayloads+  , mapDirectedEdges+  , mapFaces+  , mapUndirectedEdges+  , mapVertices+  , overPayloads+  , payloadList+  , undirectedPayloads+  , vertexPayloads+  )+import Moonlight.Triangulation.PointLocation+  ( locatePoint+  , locatePointWithHint+  )+import Moonlight.Triangulation.Removal+  ( RemovalOutcome (..)+  , RemovalResult (..)+  , locateAndRemove+  , removeVertex+  ) import Moonlight.Triangulation.JoinSemilattice (JoinSemilattice (..)) import Moonlight.Triangulation.Refinement   ( radiusEdgeRatioForAngle@@ -647,7 +941,26 @@   , union   , unions   )-import Moonlight.Triangulation.Validation (validateTriangulation)+import Moonlight.Triangulation.Session+  ( Session+  , insertVertex+  , insertVertexAt+  , insertVertexAtNear+  , refuse+  , removeAt+  , removeAtNear+  , removeManyAt+  , removeManyAtNear+  , withSession+  )+import Moonlight.Triangulation.Validation+  ( faceArea+  , faceMinimumAngleDegrees+  , triangulationIsValid+  , validateDelaunay+  , validateTopology+  , validateTriangulation+  ) import Moonlight.Triangulation.Valuation   ( CertifiedInterval (..)   , EulerCharacteristic

@@ -32,7 +32,7 @@ import Data.Word (Word32) import Moonlight.Triangulation.BulkLoad (delaunay, insert) import Moonlight.Triangulation.Dcel (numUndirectedEdges, numVertices, undirectedEndpoints, vertexPoint)-import Moonlight.Triangulation.Handles.HandleDefs (UndirectedEdgeId (..), VertexId (..))+import Moonlight.Triangulation.Internal.HandleDefs (UndirectedEdgeId (..), VertexId (..)) import Moonlight.Triangulation.Interpolation (nearestNeighbor) import Moonlight.Triangulation.Math (canonicalPoint, validatePoint) import Moonlight.Triangulation.Removal (RemovalOutcome, removalTriangulation, removeVertex)

@@ -18,7 +18,7 @@   , ExactIntersectionError   , ExactPoint   )-import Moonlight.Triangulation.Handles.HandleDefs (FaceId)+import Moonlight.Triangulation.Internal.HandleDefs (FaceId) import Moonlight.Triangulation.Internal.ExactRational (ExactArithmeticError) import Moonlight.Triangulation.Internal.Overlay.Types   ( OverlayCellId

@@ -49,7 +49,7 @@   , faceComponentFaces   , faceComponentsBy   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( DirectedEdgeId   , FaceId   , UndirectedEdgeId

@@ -41,7 +41,7 @@ import Moonlight.Triangulation.Exact   ( ExactPoint   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId   , UndirectedEdgeId   , VertexId

@@ -43,7 +43,7 @@   ( ExactPoint   , exactPointCoordinates   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( FaceId   ) import Moonlight.Triangulation.Handles.Iterators.FixedIterators (innerFaces)

@@ -58,7 +58,7 @@ import Moonlight.Triangulation.CellSet (ExactCellSet) import qualified Moonlight.Triangulation.Dcel as Dcel import Moonlight.Triangulation.Dcel (vertexData)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( UndirectedEdgeId   , VertexId   )

@@ -57,7 +57,7 @@ import Moonlight.Triangulation.Internal.Paged (fromLocalVector, fromVector, toVector) import Moonlight.Triangulation.Internal.PackedIndex (indexLimit) import Moonlight.Triangulation.Internal.PointIndex (buildPointIndex)-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Internal.Representation import Moonlight.Triangulation.Internal.Types import Moonlight.Triangulation.Math (canonicalCoordinate, mkQueryPoint)

@@ -68,7 +68,7 @@   ( undirectedEndpoints   , vertexPoint   )-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs   ( UndirectedEdgeId   ) import Moonlight.Triangulation.Handles.Iterators.FixedIterators

@@ -4,6 +4,9 @@ import Moonlight.Triangulation.Example.ConstrainedRegion import Moonlight.Triangulation.Example.PlanarRegion import Moonlight.Triangulation.Example.SetAlgebra+import Moonlight.Triangulation.Handles.Dynamic ()+import Moonlight.Triangulation.Session ()+import Moonlight.Triangulation.Voronoi () import System.Exit (die)  main :: IO ()

@@ -38,11 +38,13 @@ import Moonlight.Triangulation.Dcel import qualified Moonlight.Triangulation.Dcel as Dcel import Moonlight.Triangulation.FloodFillIterator-import Moonlight.Triangulation.Handles.HandleDefs+import Moonlight.Triangulation.Internal.HandleDefs import Moonlight.Triangulation.Handles.Iterators.FixedIterators import Moonlight.Triangulation.HintGenerator import Moonlight.Triangulation.Interpolation import Moonlight.Triangulation.IntersectionIterator+import Moonlight.Triangulation.Internal.Session (excise)+import Moonlight.Triangulation.Internal.Validation (validateTopologyClosure) import Moonlight.Triangulation.Math import Moonlight.Triangulation.Payload import Moonlight.Triangulation.FilteredPredicateOptimizationSpec