moonlight-triangulation 1.2.0.0 → 1.2.0.1
raw patch · 21 files changed
+96/−62 lines, 21 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +7/−0
- bench/dcel/Moonlight/Triangulation/DcelBench.hs +2/−1
- bench/support/BenchSupport.hs +2/−1
- moonlight-triangulation.cabal +18/−15
- src-build/Moonlight/Triangulation/Internal/Cdt/Split.hs +2/−1
- src-build/Moonlight/Triangulation/Internal/Minkowski/Convex.hs +5/−4
- src-build/Moonlight/Triangulation/Internal/Overlay/Arrangement.hs +3/−2
- src-build/Moonlight/Triangulation/Internal/Overlay/Resident.hs +2/−1
- src-build/Moonlight/Triangulation/Minkowski.hs +5/−4
- src-core/Moonlight/Triangulation/Internal/Dyadic.hs +2/−1
- src-core/Moonlight/Triangulation/Internal/PageDirectory.hs +3/−2
- src-dcel/Moonlight/Triangulation/FloodFillIterator.hs +4/−3
- src-dcel/Moonlight/Triangulation/Internal/BoundaryCycle.hs +4/−3
- src-dcel/Moonlight/Triangulation/Internal/ExactSegmentEvents.hs +3/−2
- src-dcel/Moonlight/Triangulation/Internal/Region/Bounds.hs +3/−2
- src-dcel/Moonlight/Triangulation/Region.hs +2/−1
- src-dcel/Moonlight/Triangulation/Valuation.hs +6/−5
- src-embedding/Moonlight/Triangulation/Internal/Overlay/Embedding.hs +2/−1
- test/native/Moonlight/Triangulation/ExactEmbeddingSpec.hs +3/−2
- test/native/Moonlight/Triangulation/NativeSpec.hs +10/−9
- test/serialization/Moonlight/Triangulation/SerializationSpec.hs +8/−2
CHANGELOG.md view
@@ -6,6 +6,13 @@ The serialization format carries its own version tag, independent of the package version; any change to it is recorded here explicitly. +## 1.2.0.1++* Admit GHC 9.8 as a tested compiler by spelling the package language as+ `GHC2021` plus `DerivingStrategies`, accepting `base-4.19`, and qualifying+ strict list folds through `Data.List`. This restores Hackage build and+ documentation generation without changing the API or binary format.+ ## 1.2.0.0 * Add exact rational planar regions and labelled common refinement with one
bench/dcel/Moonlight/Triangulation/DcelBench.hs view
@@ -15,6 +15,7 @@ ) import Control.DeepSeq (force) import Control.Exception (evaluate)+import qualified Data.List as List import qualified Data.Vector as V import Moonlight.Triangulation import Moonlight.Triangulation.FloodFillIterator (edgesInCircle)@@ -122,7 +123,7 @@ "alpha-face-membership" ( evaluate ( force- ( foldl'+ ( List.foldl' (\count face -> if containsFace face then count + 1
bench/support/BenchSupport.hs view
@@ -14,6 +14,7 @@ import Control.DeepSeq (NFData, force) import Control.Exception (evaluate)+import qualified Data.List as List import Data.Word (Word64) import qualified Data.Vector as V import GHC.Clock (getMonotonicTimeNSec)@@ -95,7 +96,7 @@ -> Int latticeFaceBand triangulation face = let xSum =- foldl'+ List.foldl' (\accumulator vertex -> accumulator + pointX (vertexPoint triangulation vertex)) 0 (faceVertices triangulation face)
moonlight-triangulation.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: moonlight-triangulation-version: 1.2.0.0+version: 1.2.0.1 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@@ -29,7 +29,8 @@ homepage: https://github.com/PaleRoses/moonlight bug-reports: https://github.com/PaleRoses/moonlight/issues build-type: Simple-tested-with: GHC == 9.10.3+tested-with: GHC == 9.8.4+ GHC == 9.10.3 GHC == 9.12.4 GHC == 9.14.1 extra-doc-files:@@ -63,7 +64,9 @@ manual: True common shared-properties- default-language: GHC2024+ default-language: GHC2021+ default-extensions:+ DerivingStrategies ghc-options: -Wall -Wcompat@@ -97,7 +100,7 @@ Moonlight.Triangulation.Internal.PackedIndex Moonlight.Triangulation.Internal.FaceQueue build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , containers >= 0.8 && < 0.9 , deepseq >= 1.5 && < 1.6 , vector >= 0.13 && < 0.14@@ -157,7 +160,7 @@ other-modules: Moonlight.Triangulation.Internal.Region.Bounds build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , containers >= 0.8 && < 0.9 , deepseq >= 1.5 && < 1.6 , primitive >= 0.9 && < 0.10@@ -215,7 +218,7 @@ Moonlight.Triangulation.Internal.Minkowski.Convex Moonlight.Triangulation.Internal.Minkowski.Types build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , containers >= 0.8 && < 0.9 , deepseq >= 1.5 && < 1.6 , primitive >= 0.9 && < 0.10@@ -234,7 +237,7 @@ exposed-modules: Moonlight.Triangulation.Parallel build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , async >= 2.2 && < 2.3 , deepseq >= 1.5 && < 1.6 , moonlight-triangulation:core@@ -252,7 +255,7 @@ exposed-modules: Moonlight.Triangulation.Serialization build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , binary >= 0.8 && < 0.9 , bytestring >= 0.12 && < 0.13 , containers >= 0.8 && < 0.9@@ -278,7 +281,7 @@ other-modules: Moonlight.Triangulation.Internal.InterpolationWorkspace build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , deepseq >= 1.5 && < 1.6 , primitive >= 0.9 && < 0.10 , vector >= 0.13 && < 0.14@@ -293,7 +296,7 @@ exposed-modules: Moonlight.Triangulation build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , moonlight-triangulation:core , moonlight-triangulation:dcel , moonlight-triangulation:build@@ -307,7 +310,7 @@ exposed-modules: Moonlight.Triangulation.Foreign.ABI build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , vector >= 0.13 && < 0.14 , moonlight-triangulation , moonlight-triangulation:build@@ -326,7 +329,7 @@ install-includes: moonlight_triangulation.h build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , moonlight-triangulation:ffi >= 1.2 && < 1.3 ghc-options: -threaded if os(windows)@@ -348,7 +351,7 @@ common triangulation-test-properties import: shared-properties build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , deepseq >= 1.5 && < 1.6 , vector >= 0.13 && < 0.14 , primitive >= 0.9 && < 0.10@@ -508,7 +511,7 @@ main-is: Main.hs hs-source-dirs: test/ffi build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , moonlight-triangulation:ffi -- This component owns only cross-slice compile coherence. Behavioral ownership@@ -553,7 +556,7 @@ -- and no benchmark slice may name it again. ghc-options: -threaded -rtsopts "-with-rtsopts=-T" build-depends:- base >= 4.20 && < 5+ base >= 4.19 && < 5 , deepseq >= 1.5 && < 1.6 , vector >= 0.13 && < 0.14 , moonlight-triangulation
src-build/Moonlight/Triangulation/Internal/Cdt/Split.hs view
@@ -24,6 +24,7 @@ import Control.Monad.ST (ST, runST) import Data.Bits (xor)+import qualified Data.List as List import qualified Data.Vector as V import qualified Moonlight.Triangulation.Dcel as Dcel import Moonlight.Triangulation.Handles.HandleDefs@@ -171,7 +172,7 @@ splitCensus triangulation (from, to) | from == to = (0, Nothing) | otherwise =- foldl'+ List.foldl' countCrossing (0, Nothing) (getConflictingEdgesBetweenVertices triangulation from to)
src-build/Moonlight/Triangulation/Internal/Minkowski/Convex.hs view
@@ -19,6 +19,7 @@ import Control.Monad (foldM) import Data.Bifunctor (first)+import qualified Data.List as List import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Set as Set@@ -157,7 +158,7 @@ let points = convexPolygonPoints polygon count = fromIntegral (NonEmpty.length points) (sumX, sumY) =- foldl'+ List.foldl' (\(accumulatedX, accumulatedY) point -> let (x, y) = exactPointCoordinates point in (accumulatedX + x, accumulatedY + y))@@ -222,8 +223,8 @@ case Set.toAscList (Set.fromList submitted) of firstPoint : secondPoint : thirdPoint : remaining -> let ordered = firstPoint : secondPoint : thirdPoint : remaining- lower = dropFinal (reverse (foldl' hullStep [] ordered))- upper = dropFinal (reverse (foldl' hullStep [] (reverse ordered)))+ lower = dropFinal (reverse (List.foldl' hullStep [] ordered))+ upper = dropFinal (reverse (List.foldl' hullStep [] (reverse ordered))) in case lower <> upper of firstHullPoint : secondHullPoint : thirdHullPoint : hullTail -> Just (firstHullPoint :| (secondHullPoint : thirdHullPoint : hullTail))@@ -252,7 +253,7 @@ supportPoint = case kernelPoints of initial :| remaining ->- foldl'+ List.foldl' (\selected candidate -> if directionPointCross direction candidate < directionPointCross direction selected
src-build/Moonlight/Triangulation/Internal/Overlay/Arrangement.hs view
@@ -21,6 +21,7 @@ import Data.Bifunctor (first) import Data.List (sortBy)+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@@ -324,7 +325,7 @@ grouped = V.ifoldl' (\groups sourceIndex source ->- foldl'+ List.foldl' (insertAtomic source) groups (consecutivePairs (exactSegmentSplitPoints plan (ExactSweepSegmentId sourceIndex))))@@ -357,7 +358,7 @@ , leftSources , rightSources ) =- foldl'+ List.foldl' collectContribution (Set.empty, Set.empty, Set.empty, Set.empty, Set.empty, Set.empty) contributions
src-build/Moonlight/Triangulation/Internal/Overlay/Resident.hs view
@@ -16,6 +16,7 @@ import Data.Bifunctor (first) import Data.Foldable (traverse_) import Data.List (partition, sort, sortBy)+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@@ -802,7 +803,7 @@ -> Maybe (OverlayCellSupport leftLabel rightLabel) supportFromPairs pairs = do let (leftLabels, rightLabels) =- foldl'+ List.foldl' (\(left, right) (leftLabel, rightLabel) -> (Set.insert leftLabel left, Set.insert rightLabel right)) (Set.empty, Set.empty)
src-build/Moonlight/Triangulation/Minkowski.hs view
@@ -27,6 +27,7 @@ import Control.Monad (filterM) import Data.Bifunctor (first) import qualified Data.IntMap.Strict as IntMap+import qualified Data.List as List import qualified Data.Map.Strict as Map import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NonEmpty@@ -559,19 +560,19 @@ coordinateBitGrowth inputs output = max 0 ( regionCoordinateBits output- - foldl' (\maximumBits -> max maximumBits . regionCoordinateBits) 0 inputs+ - List.foldl' (\maximumBits -> max maximumBits . regionCoordinateBits) 0 inputs ) regionCoordinateBits :: PlanarRegion -> Int-regionCoordinateBits = foldl' componentBits 0 . planarRegionComponents+regionCoordinateBits = List.foldl' componentBits 0 . planarRegionComponents where componentBits maximumBits component =- foldl'+ List.foldl' loopBits maximumBits (polygonOuterLoop component : polygonHoleLoops component) loopBits maximumBits =- foldl' pointBits maximumBits . exactLoopPoints+ List.foldl' pointBits maximumBits . exactLoopPoints pointBits maximumBits point = let (x, y) = exactPointCoordinates point in max maximumBits (max (rationalBits x) (rationalBits y))
src-core/Moonlight/Triangulation/Internal/Dyadic.hs view
@@ -21,6 +21,7 @@ , shiftL , shiftR )+import qualified Data.List as List import Data.Word (Word64) #if WORD_SIZE_IN_BITS == 64 import GHC.Exts@@ -59,7 +60,7 @@ type Decoded = (Integer, Int) commonExponent :: [Decoded] -> Int-commonExponent = foldl' step 0+commonExponent = List.foldl' step 0 where step :: Int -> Decoded -> Int step !current (!mantissa, !power)
src-core/Moonlight/Triangulation/Internal/PageDirectory.hs view
@@ -19,6 +19,7 @@ import Control.DeepSeq (NFData) import Data.Bits (shiftL, shiftR, (.&.))+import qualified Data.List as List import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV import GHC.Generics (Generic)@@ -130,7 +131,7 @@ , directorySize = length entries } where- !largest = foldl' (\largestKey (key, _) -> max largestKey key) firstKey remainingEntries+ !largest = List.foldl' (\largestKey (key, _) -> max largestKey key) firstKey remainingEntries !height = heightFor 0 heightFor !candidate | largest < capacity candidate = candidate@@ -147,7 +148,7 @@ step (children, unconsumed) index = let (!child, !beyond) = build (level - 1) (base + index * childSpan) unconsumed in (child : children, beyond)- (!reversed, !left) = foldl' step ([], remaining) [0 .. fanout - 1]+ (!reversed, !left) = List.foldl' step ([], remaining) [0 .. fanout - 1] in (Fanout (V.fromListN fanout (reverse reversed)), left) directoryToAscList :: PageDirectory a -> [(Int, a)]
src-dcel/Moonlight/Triangulation/FloodFillIterator.hs view
@@ -44,6 +44,7 @@ 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.Sequence as Seq import qualified Data.Vector as V@@ -221,7 +222,7 @@ ] where edges = edgesInShape triangulation metric- set = foldl' addEndpoints IntSet.empty edges+ 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)@@ -246,7 +247,7 @@ in (reverse faces, accepted) where valid face@(FaceId value) = face /= outerFace && fromIntegral value < numFaces triangulation- (initialStack, initialVisited) = foldl' enqueueStart ([], IntSet.empty) starts+ (initialStack, initialVisited) = List.foldl' enqueueStart ([], IntSet.empty) starts enqueueStart state face | valid face = enqueue face state@@ -544,7 +545,7 @@ OnEdge edge -> filter (/= outerFace) [incidentFace triangulation edge, incidentFace triangulation (reverseEdge edge)] OnVertex vertex -> intSetToFaces- (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))+ (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
src-dcel/Moonlight/Triangulation/Internal/BoundaryCycle.hs view
@@ -15,6 +15,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.List (tails)+import qualified Data.List as List import qualified Data.List.NonEmpty as NonEmpty -- | Remove precisely the vertices admitted by @isRedundant@ until a fixed@@ -50,7 +51,7 @@ [] -> Left (obstruction values) firstTriple : remainingTriples -> let (previousValue, current, nextValue) =- foldl' chooseLeast firstTriple remainingTriples+ List.foldl' chooseLeast firstTriple remainingTriples winding = orientation previousValue current nextValue in case (winding, values) of (EQ, _) -> Left (obstruction values)@@ -82,7 +83,7 @@ where asList = NonEmpty.toList values minimumKey =- foldl'+ List.foldl' (\selected candidate -> min selected (key candidate)) (key (NonEmpty.head values)) (NonEmpty.tail values)@@ -128,7 +129,7 @@ cyclicTriples values = case values of initial : second : remaining ->- let final = foldl' (\_ current -> current) initial (second : remaining)+ let final = List.foldl' (\_ current -> current) initial (second : remaining) in zip3 (final : values) values
src-dcel/Moonlight/Triangulation/Internal/ExactSegmentEvents.hs view
@@ -23,6 +23,7 @@ import Control.Applicative ((<|>)) import Control.Monad (filterM, foldM) import Data.List (sortBy)+import qualified Data.List as List import qualified Data.IntMap.Strict as IntMap import qualified Data.Map.Strict as Map import Data.Map.Strict (Map)@@ -210,7 +211,7 @@ b = negate deltaX c = deltaX * fromY - deltaY * fromX denominators = map exactRationalDenominator [a, b, c]- commonDenominator = foldl' lcm 1 denominators+ commonDenominator = List.foldl' lcm 1 denominators integerCoefficient coefficient = exactRationalNumerator coefficient * (commonDenominator `quot` exactRationalDenominator coefficient)@@ -513,7 +514,7 @@ case ordered of [] -> Right state lowest : remaining ->- let highest = foldl' (\_ current -> current) lowest remaining+ let highest = List.foldl' (\_ current -> current) lowest remaining below = statusPredecessor currentX lowest status above = statusSuccessor currentX highest status in scheduleMaybePair metas currentX below (Just (metaId lowest)) state
src-dcel/Moonlight/Triangulation/Internal/Region/Bounds.hs view
@@ -14,6 +14,7 @@ ) where import Data.List (sortOn, tails)+import qualified Data.List as List import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.IntMap.Strict as IntMap import Moonlight.Triangulation.Exact@@ -35,7 +36,7 @@ exactLoopBounds :: ExactLoop -> ExactBounds exactLoopBounds (ExactLoop (firstPoint :| remaining)) =- foldl' extend (pointBounds firstPoint) remaining+ List.foldl' extend (pointBounds firstPoint) remaining where extend bounds point = boundsUnion bounds (pointBounds point) @@ -48,7 +49,7 @@ [] -> Nothing firstComponent : remaining -> Just- ( foldl'+ ( List.foldl' (\bounds component -> boundsUnion bounds (componentBounds component)) (componentBounds firstComponent) remaining
src-dcel/Moonlight/Triangulation/Region.hs view
@@ -28,6 +28,7 @@ import Data.Bifunctor (first) import Data.Foldable (traverse_) import Data.List (sort)+import qualified Data.List as List import qualified Data.Map.Strict as Map import Data.Map.Strict (Map) import Data.List.NonEmpty (NonEmpty (..))@@ -263,7 +264,7 @@ loopWinding :: ExactLoop -> Ordering loopWinding (ExactLoop points) = exactSignum- ( foldl'+ ( List.foldl' (\signedArea (from, to) -> signedArea + exactPointCross from to) 0
src-dcel/Moonlight/Triangulation/Valuation.hs view
@@ -35,6 +35,7 @@ import Data.Bifunctor (first) import Data.Bits (shiftL) import Data.Foldable (foldlM)+import qualified Data.List as List import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.IntMap.Strict as IntMap import qualified Data.IntSet as IntSet@@ -185,7 +186,7 @@ (IntSet.toAscList selectedEdges) assembleValuations (IntMap.size points - IntSet.size selectedEdges + IntSet.size selectedFaces)- (foldl' (+) 0 faceDoubleAreas)+ (List.foldl' (+) 0 faceDoubleAreas) (normalizeLengthContributions id edgeContributions) regionValuations :: PlanarRegion -> Either ValuationError PlanarValuations@@ -200,7 +201,7 @@ hasPotentialBoundaryContacts componentBoundaries let doubleArea =- foldl'+ List.foldl' (\area component -> area + componentDoubleArea component) 0 components@@ -292,14 +293,14 @@ componentDoubleArea :: PolygonComponent -> ExactRational componentDoubleArea component =- foldl'+ List.foldl' (\area loop -> area + loopDoubleArea loop) 0 (polygonOuterLoop component : polygonHoleLoops component) loopDoubleArea :: ExactLoop -> ExactRational loopDoubleArea (ExactLoop points) =- foldl'+ List.foldl' (\area (from, to) -> area + exactPointCross from to) 0 (cyclePairs points)@@ -325,7 +326,7 @@ ] where coefficientsBySquare =- foldl' accumulateContribution Map.empty contributions+ List.foldl' accumulateContribution Map.empty contributions accumulateContribution coefficients value = case contribution value of (coefficient, square)
src-embedding/Moonlight/Triangulation/Internal/Overlay/Embedding.hs view
@@ -23,6 +23,7 @@ import Control.DeepSeq (NFData) import Data.List (sort, tails)+import qualified Data.List as List import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Map.Strict (Map)@@ -389,7 +390,7 @@ case memberships of firstMembership : secondMembership : remainingMemberships -> let finalMembership =- foldl' (\_ current -> current) secondMembership remainingMemberships+ List.foldl' (\_ current -> current) secondMembership remainingMemberships sourceFrom = roundedMembershipPoint firstMembership sourceTo = roundedMembershipPoint finalMembership in [ SplitOrderNotPreserved
test/native/Moonlight/Triangulation/ExactEmbeddingSpec.hs view
@@ -9,6 +9,7 @@ import Data.Bits (xor) import Data.Foldable (traverse_) import Data.List (sort)+import qualified Data.List as List import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map.Strict as Map import Data.Word (Word64)@@ -349,7 +350,7 @@ checksum <- evaluate ( force- ( foldl'+ ( List.foldl' ( \accumulated value -> accumulated + fromEnum@@ -584,7 +585,7 @@ ] digest :: [SegmentRelation] -> Word64-digest = foldl' step 14_695_981_039_346_656_037+digest = List.foldl' step 14_695_981_039_346_656_037 where step :: Word64 -> SegmentRelation -> Word64 step hash relation =
test/native/Moonlight/Triangulation/NativeSpec.hs view
@@ -20,6 +20,7 @@ import Control.Monad.ST (runST, stToIO) import GHC.Float (castDoubleToWord64) import Data.Foldable (toList, traverse_)+import qualified Data.List as List import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isJust) import qualified Data.Map.Strict as Map@@ -929,9 +930,9 @@ let plain = buildTriangulation built -- Distinct payloads everywhere: a map that permuted its component would -- be invisible against uniform defaults.- withDirected = foldl' (\t (label, edge) -> setDirectedEdgeData t edge label) plain (zip [100 ..] (directedEdges plain))- withUndirected = foldl' (\t (label, edge) -> setUndirectedEdgeData t edge ("u-" <> show label)) withDirected (zip [(0 :: Int) ..] (undirectedEdges withDirected))- sample = foldl' (\t (label, face) -> setFaceData t face ("f-" <> show label)) withUndirected (zip [(0 :: Int) ..] (allFaces withUndirected))+ withDirected = List.foldl' (\t (label, edge) -> setDirectedEdgeData t edge label) plain (zip [100 ..] (directedEdges plain))+ withUndirected = List.foldl' (\t (label, edge) -> setUndirectedEdgeData t edge ("u-" <> show label)) withDirected (zip [(0 :: Int) ..] (undirectedEdges withDirected))+ sample = List.foldl' (\t (label, face) -> setFaceData t face ("f-" <> show label)) withUndirected (zip [(0 :: Int) ..] (allFaces withUndirected)) endpoints :: Triangulation mode vertex directed undirected face -> [(VertexId, VertexId)]@@ -1029,9 +1030,9 @@ ] built <- requireRight "payload traversal build" (delaunay defaults payloads) let plain = buildTriangulation built- withDirected = foldl' (\t (label, edge) -> setDirectedEdgeData t edge label) plain (zip [100 ..] (directedEdges plain))- withUndirected = foldl' (\t (label, edge) -> setUndirectedEdgeData t edge ("u-" <> show label)) withDirected (zip [(0 :: Int) ..] (undirectedEdges withDirected))- sample = foldl' (\t (label, face) -> setFaceData t face ("f-" <> show label)) withUndirected (zip [(0 :: Int) ..] (allFaces withUndirected))+ withDirected = List.foldl' (\t (label, edge) -> setDirectedEdgeData t edge label) plain (zip [100 ..] (directedEdges plain))+ withUndirected = List.foldl' (\t (label, edge) -> setUndirectedEdgeData t edge ("u-" <> show label)) withDirected (zip [(0 :: Int) ..] (undirectedEdges withDirected))+ sample = List.foldl' (\t (label, face) -> setFaceData t face ("f-" <> show label)) withUndirected (zip [(0 :: Int) ..] (allFaces withUndirected)) -- 'overPayloads' is the traversal under 'Identity', so this is the traversal -- identity law. It also says that rebuilding a payload store from its own@@ -1200,11 +1201,11 @@ assertEqual "face keys are unique" (length (innerFaces base)) (Map.size faceTable) let withDirected =- foldl' (\t e -> setDirectedEdgeData t e (directedTable Map.! directedKeyOf base e)) base (directedEdges base)+ List.foldl' (\t e -> setDirectedEdgeData t e (directedTable Map.! directedKeyOf base e)) base (directedEdges base) withUndirected =- foldl' (\t e -> setUndirectedEdgeData t e (undirectedTable Map.! undirectedKeyOf base e)) withDirected (undirectedEdges base)+ List.foldl' (\t e -> setUndirectedEdgeData t e (undirectedTable Map.! undirectedKeyOf base e)) withDirected (undirectedEdges base) labelled =- foldl' (\t f -> setFaceData t f (faceTable Map.! faceKeyOf base f)) withUndirected (innerFaces base)+ List.foldl' (\t f -> setFaceData t f (faceTable Map.! faceKeyOf base f)) withUndirected (innerFaces base) inserted <- requireRight "rewrite identity insert" (insert labelled target) let result = insertionTriangulation inserted assertValid "rewrite identity result" result
test/serialization/Moonlight/Triangulation/SerializationSpec.hs view
@@ -137,8 +137,14 @@ , Binary directed , Binary undirected , Binary face- , Eq (Triangulation mode vertex directed undirected face)- , Show (Triangulation mode vertex directed undirected face)+ , Eq vertex+ , Eq directed+ , Eq undirected+ , Eq face+ , Show vertex+ , Show directed+ , Show undirected+ , Show face ) => String -> Triangulation mode vertex directed undirected face