more small fixes + trying to run haddock again on CI

.github/workflows/gh-pages.yml

@@ -171,7 +171,7 @@ jobs:
       - name: haddock
         run: |
           $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all > haddock.raw.txt
-          $CABAL haddock-project --with-compiler=$HC --with-haddock $HADDOCK
+          $CABAL haddock-project --with-haddock=$HADDOCK --with-ghc=$HC
       - name: haddock-badge
         run: |
           grep ") in " haddock.raw.txt | sort -hr > haddock.txt

hgeometry-examples/convexHull/Main.hs

@@ -16,10 +16,9 @@ import qualified HGeometry.Miso.Svg.Canvas as Canvas
 import           HGeometry.Number.Real.Rational
 import           HGeometry.Point
 import           HGeometry.Polygon.Convex
-import           HGeometry.Polygon.Simple
 import qualified Language.Javascript.JSaddle.Warp as JSaddle
 import           Miso
-import           Miso.String (ToMisoString(..), ms)
+import           Miso.String (MisoString,ToMisoString(..), ms)
 import           Miso.Svg hiding (height_, id_, style_, width_)
 
 --------------------------------------------------------------------------------

hgeometry/kernel/src/HGeometry/LineSegment/Intersection.hs

@@ -62,41 +62,6 @@ instance ( Point_ point 2 r, Num r, Ord r
   intersects = intersectsImpl
   {-# INLINE intersects #-}
 
-
--- instance ( Point_ point 2 r, Num r, Ord r
---          ) => LinePV 2 r `HasIntersectionWith` ClosedLineSegment point where
---   intersects = intersectsImpl
---   {-# INLINE intersects #-}
-
--- instance ( Point_ point 2 r, Num r, Ord r
---          ) => LineEQ r `HasIntersectionWith` ClosedLineSegment point where
---   --
---   -- >>> LineEQ 1 2 `intersects` ClosedLineSegment origin (Point2 1 10)
---   -- True
---   intersects = intersectsImpl
---   {-# INLINE intersects #-}
-
--- instance ( Point_ point 2 r, Num r,  Ord r
---          ) => LineEQ r `HasIntersectionWith` LineSegment AnEndPoint point where
---   intersects = intersectsImpl
---   {-# INLINE intersects #-}
--- instance ( Point_ point 2 r, Num r,  Ord r
---          ) => LinePV 2 r `HasIntersectionWith` LineSegment AnEndPoint point where
---   intersects = intersectsImpl
---   {-# INLINE intersects #-}
-
--- instance ( Point_ point 2 r, Num r, Ord r
---          ) => LinePV 2 r `HasIntersectionWith` OpenLineSegment point where
---   intersects = intersectsImpl
---   {-# INLINE intersects #-}
-
--- instance ( Point_ point 2 r, Num r, Ord r
---          ) => LineEQ r `HasIntersectionWith` OpenLineSegment point where
---   intersects = intersectsImpl
---   {-# INLINE intersects #-}
-
-
-
 -- | Test whether a line in R^2 intersects a closed linesegment
 intersectsImpl       :: ( HyperPlane_ line 2 r
                         , Point_ point 2 r
@@ -112,9 +77,6 @@ l `intersectsImpl` s = case (onSideTest (s^.start) l, onSideTest (s^.end) l) of
                          (GT, LT) -> True
                          (GT, EQ) -> s^.endPoint.to endPointType == Closed
                          (GT, GT) -> False
-  -- case onSideTest (s^.start) l of
-  --                        EQ   -> True
-  --                        side -> side /= onSideTest (s^.end) l
 {-# INLINE intersectsImpl #-}
 
 
@@ -221,8 +183,7 @@ instance ( Point_ point 2 r, Num r,  Ord r
          LineSegment endPoint point `HasIntersectionWith` LineSegment endPoint point where
   s `intersects `s' = supportingLine s `intersects` s' && supportingLine s' `intersects` s
   {-# INLINE intersects #-}
-
--- TODO: specialize instance for ClosedLineSegment and AnLineSegment
+  -- this does not really work; i.e. if the segments are colinear
 
 instance ( Point_ point 2 r, Num r,  Ord r
          ) =>

hgeometry/kernel/test/HGeometry/HyperPlaneSpec.hs

@@ -145,11 +145,6 @@ spec = describe "HyperPlane Tests" $ do
          it "on side of non-vertical line / hyperplane 5" $
            (Point2 0 0 `onSideTest` HyperPlane2 (-1) (-1) (-1))
            `shouldBe` GT
-
-         it "on vertical line" $
-           ((Point 0 10) `onSideTest` (HyperPlane2 0 0 1))
-           `shouldBe` EQ
-
          prop "pointOn produces a point on the hyperplane (2d)" $
            \(h :: HyperPlane 2 R) -> onHyperPlane (pointOn h) h
          prop "pointOn produces a point on the hyperplane (3d)" $

hgeometry/kernel/test/HGeometry/LineSegmentSpec.hs

@@ -205,6 +205,9 @@ test5 = OpenLineSegment (Point2 0 20) (Point2 200 20)
 
 -- -- test = withRank (Vector2 0 1) test1 test4
 
+vertSeg :: OpenLineSegment (Point 2 Int)
+vertSeg = OpenLineSegment (Point2 20 (-5)) (Point2 20 10)
+
 testI :: Spec
 testI = describe "some manual intersection tests" $ do
           it "manual intersection" $ (test1 `intersects` test2 ) `shouldBe` True
@@ -213,6 +216,15 @@ testI = describe "some manual intersection tests" $ do
           it "manual intersection" $ (test2 `intersects` test4 ) `shouldBe` True
           it "manual intersection" $ (test2 `intersects` test5 ) `shouldBe` False
 
+          it "open ended segments x vertical Line" $
+            (supportingLine vertSeg `intersects` test2) `shouldBe` False
+
+          it "open ended segments; open endpoint on segment" $
+            (test2 `intersects` vertSeg) `shouldBe` False
+          it "open ended segments; endpointtest" $
+            (Point2 20 (0 :: Int) `onSegment` test2) `shouldBe` False
+
+
           describe "manual intersect with line" $ do
             let l = LinePV origin (Vector2 0 (1 :: Int))
             it "man" $ (l `intersects` test1) `shouldBe` True

hgeometry/svg/src/Miso/String/Util.hs

@@ -2,7 +2,8 @@
 module Miso.String.Util where
 
 import qualified Data.List as List
-import           Miso.String (MisoString, ToMisoString, ms)
+import           Miso.String (MisoString)
 
+-- | Unwords for MisoStrings
 unwords :: [MisoString] -> MisoString
 unwords = mconcat @MisoString . List.intersperse " "