Centralize Sorting

.github/workflows/ci.yaml

@@ -1,3 +1,7 @@
+name: Haskell CI
+on:
+  - push
+
 jobs:
   build:
     runs-on: ubuntu-latest
@@ -18,16 +22,147 @@ jobs:
           fi
       - name: freeze
         run: cabal freeze
-      - uses: "actions/cache@v2"
+      - name: Restore build artifacts
+        id: build-hslice-restore
+        uses: "actions/cache/restore@v4"
         with:
           key: "${{ runner.os }}-${{ matrix.ghc }}-cabal-${{ hashFiles('cabal.project.freeze') }}"
-          path: "${{ steps.setup-haskell-cabal.outputs.cabal-store }} dist-newstyle"
+          path: |
+            "${{ steps.setup-haskell-cabal.outputs.cabal-store }}"
+            ~/.cabal/packages
+            ~/.cabal/store
+            ~/.cabal/bin
+            dist-newstyle
+            ~/.local/bin
       - name: Install dependencies
         run: cabal build all --enable-tests --enable-benchmarks --only-dependencies
       - name: build all
         run: cabal build all --enable-tests --enable-benchmarks
+      - name: Save build artifacts
+        uses: "actions/cache/save@v4"
+        with:
+          key: "${{ runner.os }}-${{ matrix.ghc }}-cabal-${{ hashFiles('cabal.project.freeze') }}"
+          path: |
+            "${{ steps.setup-haskell-cabal.outputs.cabal-store }}"
+            ~/.cabal/packages
+            ~/.cabal/store
+            ~/.cabal/bin
+            dist-newstyle
+            ~/.local/bin
+    strategy:
+      matrix:
+        cabal:
+          - '3.10'
+        ghc:
+          - '9.4.6'  
+          - '9.2.8'
+          - '9.0.2'
+          - '8.10.7'
+  test:
+    needs: build
+    runs-on: ubuntu-latest
+    steps:
+      - uses: "actions/checkout@v3"
+      - id: setup-haskell-cabal
+        uses: "haskell-actions/setup@v2"
+        with:
+          cabal-version: "${{ matrix.cabal }}"
+          enable-stack: false
+          ghc-version: "${{ matrix.ghc }}"
+      - name: Update Hackage repository
+        run: cabal update
+      - name: cabal.project.local.ci
+        run: |
+          if [ -e cabal.project.local.ci ]; then
+            cp cabal.project.local.ci cabal.project.local
+          fi
+      - name: freeze
+        run: cabal freeze
+      - name: Restore build artifacts
+        uses: "actions/cache/restore@v4"
+        id: build-hslice-restore
+        with:
+          key: "${{ runner.os }}-${{ matrix.ghc }}-cabal-${{ hashFiles('cabal.project.freeze') }}"
+          path: |
+            "${{ steps.setup-haskell-cabal.outputs.cabal-store }}"
+            ~/.cabal/packages
+            ~/.cabal/store
+            ~/.cabal/bin
+            dist-newstyle
+            ~/.local/bin
+      - name: Install dependencies
+        run: cabal build all --enable-tests --enable-benchmarks --only-dependencies
+      - name: build all
+        run: cabal build all --enable-tests --enable-benchmarks
+      - name: Save build artifacts
+        uses: "actions/cache/save@v4"
+        with:
+          key: "${{ runner.os }}-${{ matrix.ghc }}-cabal-${{ hashFiles('cabal.project.freeze') }}"
+          path: |
+            "${{ steps.setup-haskell-cabal.outputs.cabal-store }}"
+            ~/.cabal/packages
+            ~/.cabal/store
+            ~/.cabal/bin
+            dist-newstyle
+            ~/.local/bin
       - name: test all
         run: cabal test test-hslice --enable-tests
+    strategy:
+      matrix:
+        cabal:
+          - '3.10'
+        ghc:
+          - '9.4.6'  
+          - '9.2.8'
+          - '9.0.2'
+          - '8.10.7'
+  haddock:
+    needs: build
+    runs-on: ubuntu-latest
+    steps:
+      - uses: "actions/checkout@v3"
+      - id: setup-haskell-cabal
+        uses: "haskell-actions/setup@v2"
+        with:
+          cabal-version: "${{ matrix.cabal }}"
+          enable-stack: false
+          ghc-version: "${{ matrix.ghc }}"
+      - name: Update Hackage repository
+        run: cabal update
+      - name: cabal.project.local.ci
+        run: |
+          if [ -e cabal.project.local.ci ]; then
+            cp cabal.project.local.ci cabal.project.local
+          fi
+      - name: freeze
+        run: cabal freeze
+      - name: Restore build artifacts
+        uses: "actions/cache/restore@v4"
+        id: build-hslice-restore
+        with:
+          key: "${{ runner.os }}-${{ matrix.ghc }}-cabal-${{ hashFiles('cabal.project.freeze') }}"
+          path: |
+            "${{ steps.setup-haskell-cabal.outputs.cabal-store }}"
+            ~/.cabal/packages
+            ~/.cabal/store
+            ~/.cabal/bin
+            dist-newstyle
+            ~/.local/bin
+      - name: Install dependencies
+        run: cabal build all --enable-tests --enable-benchmarks --only-dependencies
+      - name: build all
+        run: cabal build all --enable-tests --enable-benchmarks
+      - name: Save build artifacts
+        uses: "actions/cache/save@v4"
+        with:
+          key: "${{ runner.os }}-${{ matrix.ghc }}-cabal-${{ hashFiles('cabal.project.freeze') }}"
+          path: |
+            "${{ steps.setup-haskell-cabal.outputs.cabal-store }}"
+            ~/.cabal/packages
+            ~/.cabal/store
+            ~/.cabal/bin
+            dist-newstyle
+            ~/.local/bin
       - name: haddock all
         run: cabal haddock all 
     strategy:
@@ -39,8 +174,3 @@ jobs:
           - '9.2.8'
           - '9.0.2'
           - '8.10.7'
-          - '8.8.4'
-name: Haskell CI
-on:
-  - push
-  - pull_request

.github/workflows/ormolu.yaml

@@ -8,18 +8,26 @@ jobs:
   ormolu:
     runs-on: ubuntu-latest
     steps:
-      - uses: "actions/checkout@v1"
+      - uses: "actions/checkout@v3"
 
-      - uses: "haskell/actions/setup@v1"
+      - uses: "haskell-actions/setup@v2"
         with:
           cabal-version: "${{ matrix.cabal }}"
           enable-stack: false
           ghc-version: "${{ matrix.ghc }}"
-
+      - name: Update Hackage repository
+        run: cabal update
+      - name: cabal.project.local.ci
+        run: |
+          if [ -e cabal.project.local.ci ]; then
+            cp cabal.project.local.ci cabal.project.local
+          fi
+      - name: freeze
+        run: cabal freeze
       - uses: "actions/cache@v2"
         name: Cache
         with:
-          key: "${{ runner.os }}"
+          key: "${{ runner.os }}-${{ matrix.ghc }}-cabal-${{ hashFiles('cabal.project.freeze') }}"
           path: |
             "${{ steps.setup-haskell-cabal.outputs.cabal-store }}"
             ~/.cabal/packages
@@ -32,11 +40,11 @@ jobs:
         run: |
           export PATH=$PATH:$HOME/.cabal/bin:$HOME/.local/bin
           export ORMOLU_VERSION=$(cat ./layout/ormolu.version)
-          (ormolu -v 2>/dev/null | grep -q $ORMOLU_VERSION) || (cabal update && cabal install ormolu --constraint="ormolu ==$ORMOLU_VERSION")
+          (ormolu -v 2>/dev/null | grep -q $ORMOLU_VERSION) || (cabal install ormolu --constraint="ormolu ==$ORMOLU_VERSION")
           test -e $HOME/.local/bin/yq || pip3 install yq
         shell: bash
 
-      - name: Ormolu
+      - name: Run Ormolu
         run: |
           export PATH=$PATH:$HOME/.cabal/bin:$HOME/.local/bin
           ./layout/ormolu.sh -c
@@ -45,6 +53,6 @@ jobs:
     strategy:
       matrix:
         cabal:
-          - '3.6.2.0'
+          - '3.10.2.1'
         ghc:
-          - '8.8.1'
+          - '9.4.6'

Graphics/Slicer/Math/Arcs.hs

@@ -24,6 +24,8 @@ module Graphics.Slicer.Math.Arcs (getFirstArc, getInsideArc, getOutsideArc, towa
 
 import Prelude (Bool, ($), (<>), (==), (>), (<=), (&&), (||), error, mempty, otherwise, show)
 
+import Data.Maybe (isNothing)
+
 import Graphics.Slicer.Math.Definitions (Point2, addPoints, distance, makeLineSeg, scalePoint)
 
 import Graphics.Slicer.Math.GeometricAlgebra (addVecPairWithErr, ulpVal)
@@ -32,6 +34,8 @@ import Graphics.Slicer.Math.Intersections (intersectionOf, isAntiCollinear, isCo
 
 import Graphics.Slicer.Math.PGA (PLine2Err(PLine2Err), PPoint2Err, ProjectiveLine(PLine2), ProjectiveLine2, ProjectivePoint2, angleBetween2PL, distance2PP, eToPL, flipL, join2PP, normalizeL, vecOfL)
 
+import Graphics.Slicer.Math.PGAPrimitives (canonicalizedIntersectionOf2PL)
+
 -- | Get a Projective Line in the direction of the inside of a contour. Generates a line bisecting the angle of the intersection between a line constructed from the first two points, and another line constrected from the last two points.
 getFirstArc :: Point2 -> Point2 -> Point2 -> (ProjectiveLine, PLine2Err)
 getFirstArc a b c = (res, resErr)
@@ -60,6 +64,8 @@ getAcuteArcFromPoints p1 p2 p3
 
 -- | Get a projective line along the angle bisector of the intersection of the two given lines, pointing in the 'acute' direction.
 --   A wrapper of getAcuteAngleBisectorFromLines, dropping the returning of normalization error of the inputs.
+-- Warning: assumes one PLine is toward the point of intersection, and the other is away from the point of intersection
+-- FIXME: Precision Loss
 getInsideArc :: (ProjectiveLine2 a, ProjectiveLine2 b) => (a, PLine2Err) -> (b, PLine2Err) -> (ProjectiveLine, PLine2Err)
 getInsideArc line1 line2 = (res, resErr)
   where
@@ -70,11 +76,15 @@ getInsideArc line1 line2 = (res, resErr)
 {-# INLINABLE getAcuteAngleBisectorFromLines #-}
 getAcuteAngleBisectorFromLines :: (ProjectiveLine2 a, ProjectiveLine2 b) => (a, PLine2Err) -> (b, PLine2Err) -> (ProjectiveLine, (PLine2Err, PLine2Err, PLine2Err))
 getAcuteAngleBisectorFromLines line1@(pl1, _) line2@(pl2, _)
-  | isCollinear line1 line2 = error "Asked to find the acute bisector of two colinear lines!"
-  | isAntiCollinear line1 line2 = error "Asked to find the acute bisector of two anti-colinear lines!"
-  | noIntersection line1 line2 = error $ "No intersection between line " <> show line1 <> " and line " <> show line2 <> ".\n"
+  -- something is wrong? throw an error.
+  | isNothing (canonicalizedIntersectionOf2PL pl1 pl2) = makeError
   | otherwise = (PLine2 addVecRes, (npline1Err, npline2Err, PLine2Err addVecErrs mempty mempty mempty mempty mempty))
   where
+    makeError
+      | isCollinear line1 line2 = error $ "Asked to find the acute bisector of two colinear lines!\n" <> show pl1 <> "\n" <> show pl2 <> "\n"
+      | isAntiCollinear line1 line2 = error $ "Asked to find the acute bisector of two anti-colinear lines!\n" <> show pl1 <> "\n" <> show pl2 <> "\n"
+      | noIntersection line1 line2 = error $ "No intersection between line " <> show pl1 <> " and line " <> show pl2 <> ".\n"
+      | otherwise = error "no error. just seeing how you're doing."
     (addVecRes, addVecErrs) = addVecPairWithErr lv1 lv2
     lv1 = vecOfL $ flipL npline1
     lv2 = vecOfL npline2

Graphics/Slicer/Math/PGA.hs

@@ -299,6 +299,7 @@ class (Show a) => Arcable a where
 
 -- | If there is an output arc, return it, along with it's error quotent.
 outAndErrOf :: (Arcable a) => a -> (ProjectiveLine, PLine2Err)
+{-# INLINABLE outAndErrOf #-}
 outAndErrOf a
   | hasArc a = (outOf a, errOfOut a)
   | otherwise = error $ "Asked for out and err of Arcable with no out!\n" <> show a <> "\n"

Graphics/Slicer/Math/Skeleton/Cells.hs

@@ -563,7 +563,7 @@ matchDirectionOfSegments firstSegOfNodeTree lastSegOfNodeTree (CellDivide (Divid
       | lastSegOfNodeTree == outSeg = LastFirst
       | otherwise = NoMatch
 
--- adjust the last output of the NodeTree so that it goes through the line it's supposed to.
+-- | Adjust the last inode of the NodeTree's output so that it goes through the line it's supposed to.
 redirectLastOut :: NodeTree -> (ProjectiveLine, PLine2Err) -> NodeTree
 redirectLastOut inNodeTree@(NodeTree eNodes maybeINodeSet) myCrossoverLine
   | isJust maybeINodeSet =
@@ -645,12 +645,12 @@ nodeTreeFromDivision cellDivision@(CellDivide motorcycles target) crossoverIn cr
 -- Note: If we are using the motorcycle as an out, we use nothing as an out, and use the motorcycle as an in.
 iNodeOfENodeDivision :: CellDivide -> (ProjectiveLine, PLine2Err) -> (ProjectiveLine, PLine2Err) -> INodeDirection -> MaybeMatch -> ENode -> INode
 iNodeOfENodeDivision cellDivision crossoverIn crossoverOut iNodeDirection matchDirection eNode
+  -- FIXME: we don't care about match direction here? flipping the order causes fun. maybe call a sort instead of hand building this?
+  | iNodeDirection == TowardMotorcycle = makeINode [eNodeOut, crossoverIn, motorcycle, crossoverOut] Nothing
   | iNodeDirection == TowardOut && matchDirection == LastFirst = makeINode [motorcycle, crossoverIn, eNodeOut] (Just crossoverOut)
   | iNodeDirection == TowardOut && matchDirection == FirstLast = makeINode [eNodeOut, crossoverIn, motorcycle] (Just crossoverOut)
   | iNodeDirection == TowardIn  && matchDirection == LastFirst = makeINode [motorcycle, crossoverOut, eNodeOut] (Just crossoverIn)
   | iNodeDirection == TowardIn  && matchDirection == FirstLast = makeINode [eNodeOut, crossoverOut, motorcycle] (Just crossoverIn)
-  | iNodeDirection == TowardMotorcycle && matchDirection == LastFirst = makeINode [crossoverOut, motorcycle, crossoverIn, eNodeOut] Nothing
-  | iNodeDirection == TowardMotorcycle && matchDirection == FirstLast = makeINode [eNodeOut, crossoverIn, motorcycle, crossoverOut] Nothing
   | matchDirection == NoMatch = error "no match!"
   | otherwise = error "wtf!"
   where
@@ -662,12 +662,12 @@ iNodeOfENodeDivision cellDivision crossoverIn crossoverOut iNodeDirection matchD
 -- Note: If we are using the motorcycle as an out, we use nothing as an out, and use the motorcycle as an in.
 iNodeOfPlainDivision :: CellDivide -> (ProjectiveLine, PLine2Err) -> (ProjectiveLine, PLine2Err) -> INodeDirection -> MaybeMatch -> INode
 iNodeOfPlainDivision cellDivision crossoverIn crossoverOut iNodeDirection matchDirection
+  -- FIXME: we don't care about match direction here? flipping the order causes fun. maybe call a sort instead of hand building this?
+  | iNodeDirection == TowardMotorcycle = makeINode [crossoverIn, motorcycle, crossoverOut] Nothing
   | iNodeDirection == TowardOut && matchDirection == LastFirst = makeINode [motorcycle, crossoverIn] (Just crossoverOut)
   | iNodeDirection == TowardOut && matchDirection == FirstLast = makeINode [crossoverIn, motorcycle] (Just crossoverOut)
   | iNodeDirection == TowardIn  && matchDirection == LastFirst = makeINode [motorcycle, crossoverOut] (Just crossoverIn)
   | iNodeDirection == TowardIn  && matchDirection == FirstLast = makeINode [crossoverOut, motorcycle] (Just crossoverIn)
-  | iNodeDirection == TowardMotorcycle && matchDirection == LastFirst = makeINode [crossoverOut, motorcycle, crossoverIn] Nothing
-  | iNodeDirection == TowardMotorcycle && matchDirection == FirstLast = makeINode [crossoverIn, motorcycle, crossoverOut] Nothing
   | matchDirection == NoMatch = error "no match!"
   | otherwise = error "wtf!"
   where

Graphics/Slicer/Math/Skeleton/Concave.hs

@@ -70,7 +70,7 @@ import Graphics.Slicer.Math.Lossy (distanceBetweenPPointsWithErr)
 
 import Graphics.Slicer.Math.PGA (Arcable(hasArc, outOf), Pointable(canPoint), ProjectiveLine, PLine2Err, cPPointAndErrOf, cPPointOf, distance2PP, flipL, join2PP, outAndErrOf, pLineIsLeft)
 
-import Graphics.Slicer.Math.Skeleton.Definitions (ENode, ENodeSet(ENodeSet), INode(INode), INodeSet(INodeSet), NodeTree(NodeTree), concaveLines, finalINodeOf, finalOutOf, firstInOf, getFirstLineSeg, getLastLineSeg, getPairs, indexPLinesTo, insOf, isLoop, linePairs, loopOfSegSets, makeENode, makeENodes, makeInitialGeneration, makeINode, makeSide, sortedPLines, sortPLinePair)
+import Graphics.Slicer.Math.Skeleton.Definitions (ENode, ENodeSet(ENodeSet), INode(INode), INodeSet(INodeSet), NodeTree(NodeTree), concaveLines, finalINodeOf, finalOutOf, firstInOf, getFirstLineSeg, getLastLineSeg, getPairs, insOf, isLoop, linePairs, loopOfSegSets, makeENode, makeENodes, makeInitialGeneration, makeINode, makeSide, sortPLinePair, sortPLinesByReferenceSafe)
 
 import Graphics.Slicer.Math.Skeleton.NodeTrees (makeNodeTree, findENodeByOutput, findINodeByOutput)
 
@@ -524,14 +524,14 @@ sortINodesByENodes loop eNodes inSegSets inINodeSet@(INodeSet inChildGenerations
         withoutPLine :: (ProjectiveLine, PLine2Err) -> [(ProjectiveLine, PLine2Err)] -> [(ProjectiveLine, PLine2Err)]
         withoutPLine myPLine = filter (\a -> fst a /= fst myPLine)
 
-    -- Order the input nodes of an INode.
+    -- Order the inputs of an INode.
     orderInsByENodes :: INode -> INode
     orderInsByENodes inode@(INode _ _ _ out)
       | isJust out = outRes
       | otherwise = noOutRes
         where
-          outRes = makeINode (indexPLinesTo flippedOut $ sortedPLines $ insOf inode) out
-          noOutRes = makeINode (indexPLinesTo firstPLine $ sortedPLines $ indexPLinesTo firstPLine $ insOf inode) Nothing
+          outRes = makeINode (sortPLinesByReferenceSafe flippedOut $ insOf inode) out
+          noOutRes = makeINode (sortPLinesByReferenceSafe firstPLine $ insOf inode) Nothing
           flippedOut = case out of
                          (Just (outPLine, outPLineErr)) -> (flipL outPLine, outPLineErr)
                          Nothing -> error "tried to evaluate flippedOut when out was Nothing."