Getting rid of a lot of "Default" constraints by introducing Construc…

…table* classes (#230)

* ConstructablePoint class

* constructable intervals and line segments

* getting rid of defaults

* getting rid of more defaults

* even more no defaults

* more nodefaults

* getting rid of even more defaults

* renaming the lower envelope modules

hgeometry-examples/bapc2012/Gunslinger.hs

@@ -1,7 +1,6 @@
 module Main where
 
 import           Control.Lens
-import           Data.Default.Class
 import           Data.Fixed
 import qualified Data.Foldable as F
 import qualified Data.List as List
@@ -83,9 +82,6 @@ instance Show Answer where
 
 data Kind = Luke | Hatch | Dalton deriving (Show,Eq)
 
-instance Default Kind where
-  def = Dalton -- if we have to invent a value; invent a dalton.
-
 data Input = Input { _luke    :: Point 2 Int
                    , _hatch   :: Point 2 Int
                    , _daltons :: [Point 2 Int]

hgeometry-examples/polyLineDrawing/Main.hs

@@ -138,9 +138,6 @@ makeLenses ''Model
 instance KnownNat p => ToMisoString (RealNumber p) where
   toMisoString = toMisoString . toFixed
 
-instance Default (Point 2 R :+ Int) where
-  def = origin :+ 0
-
 ----------------------------------------
 
 initialModel :: Model

hgeometry-examples/polygonTriangulation/Main.hs

@@ -21,8 +21,6 @@ import           Miso
 import           Miso.String (MisoString,ToMisoString(..), ms)
 import           Miso.Svg hiding (height_, id_, style_, width_)
 
-import Data.Default.Class
-
 --------------------------------------------------------------------------------
 
 type R = RealNumber 5

hgeometry-examples/voronoiDiagram/Main.hs

@@ -20,8 +20,6 @@ import           Miso
 import           Miso.String (MisoString,ToMisoString(..), ms)
 import           Miso.Svg hiding (height_, id_, style_, width_)
 
-import Data.Default.Class
-
 --------------------------------------------------------------------------------
 
 type R = RealNumber 5
@@ -37,9 +35,6 @@ makeLenses ''Model
 instance KnownNat p => ToMisoString (RealNumber p) where
   toMisoString = toMisoString . toFixed
 
-instance Default (Point 2 R :+ Int) where
-  def = origin :+ 0
-
 ----------------------------------------
 
 initialModel :: Model

hgeometry/bench/Util.hs

@@ -19,7 +19,7 @@ import           System.Random.Stateful
 -- | Generate an infinite list random points in a sufficiently large
 -- bounding box.
 randomPoints       :: forall point r. ( UniformRange point
-                      , Point_ point 2 r
+                      , ConstructablePoint_ point 2 r
                       , Num r
                       )
                    => StdGen -- ^ generator to use

hgeometry/hgeometry.cabal

@@ -392,11 +392,11 @@ library
         HGeometry.LineSegment.Intersection.Naive
         HGeometry.LineSegment.Intersection.BentleyOttmann
 
-        HGeometry.LowerEnvelope
-        HGeometry.LowerEnvelope.Naive
-        HGeometry.LowerEnvelope.VertexForm
-        HGeometry.LowerEnvelope.AdjListForm
-        HGeometry.LowerEnvelope.Connected
+        HGeometry.Plane.LowerEnvelope
+        HGeometry.Plane.LowerEnvelope.Naive
+        HGeometry.Plane.LowerEnvelope.VertexForm
+        HGeometry.Plane.LowerEnvelope.AdjListForm
+        HGeometry.Plane.LowerEnvelope.Connected
 
 
         HGeometry.VoronoiDiagram
@@ -427,14 +427,14 @@ library
 
         HGeometry.LineSegment.Intersection.Types
 
-        HGeometry.LowerEnvelope.Type
-        HGeometry.LowerEnvelope.Connected.Type
-        HGeometry.LowerEnvelope.Connected.FromVertexForm
-        -- HGeometry.LowerEnvelope.Sample
+        HGeometry.Plane.LowerEnvelope.Type
+        HGeometry.Plane.LowerEnvelope.Connected.Type
+        HGeometry.Plane.LowerEnvelope.Connected.FromVertexForm
+        -- HGeometry.Plane.LowerEnvelope.Sample
 
 
-        -- HGeometry.LowerEnvelope.AtMostThree
-        -- HGeometry.LowerEnvelope.Triangulate
+        -- HGeometry.Plane.LowerEnvelope.AtMostThree
+        -- HGeometry.Plane.LowerEnvelope.Triangulate
 
         HGeometry.VoronoiDiagram.ViaLowerEnvelope
 

hgeometry/ipe/src/Ipe/IpeOut.hs

@@ -20,6 +20,7 @@ import           Control.Lens hiding (Simple)
 import           Data.Foldable (toList)
 import           Data.Kind
 import           Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Sequence as Seq
 import           Data.Text (Text)
 import qualified Data.Text as Text
@@ -276,7 +277,10 @@ path = Path . Seq.singleton
 -- | Construct a PolyLine path segment
 pathSegment :: (LineSegment_ lineSegment point, Point_ point 2 r)
             => lineSegment -> PathSegment r
-pathSegment = PolyLineSegment . fmap (^.asPoint) . review _PolyLineLineSegment
+pathSegment = PolyLineSegment . fmap (^.asPoint) . lineSegmentToPolyLine
+  where
+    lineSegmentToPolyLine s = polyLineFromPoints . NonEmpty.fromList $ [s^.start, s^.end]
+
 
 -- | Draw a polygon
 ipePolygon    :: IpeOut (SimplePolygon (Point 2 r)) Path r

hgeometry/kernel/src/HGeometry/Ball/Class.hs

@@ -49,7 +49,8 @@ class ( HasCenter ball point
   fromCenterAndSquaredRadius :: point -> NumType ball -> ball
 
   -- | A d dimensional unit ball centered at the origin.
-  unitBall :: Num (NumType ball) => ball
+  unitBall :: (r ~ NumType ball, d ~ Dimension ball
+              , Num r, ConstructablePoint_ point d r) => ball
   unitBall = fromCenterAndSquaredRadius origin 1
 
   -- | A lens to get/set the radius of a Ball

hgeometry/kernel/src/HGeometry/HyperPlane/Class.hs

@@ -346,7 +346,7 @@ class HyperPlaneFromPoints hyperPlane where
                            ) => Vector d point -> hyperPlane
 
 
-instance (HyperPlane_ hyperPlane d r, Default extra)
+instance (HyperPlane_ hyperPlane d r)
          => HyperPlane_ (hyperPlane :+ extra) d r where
   evalHyperPlaneEquation h = evalHyperPlaneEquation (h^.core)
   {-# INLINE evalHyperPlaneEquation #-}
@@ -368,7 +368,7 @@ instance (ConstructableHyperPlane_ hyperPlane d r, Default extra)
   fromPointAndNormal p v = fromPointAndNormal p v :+ def
   {-# INLINE fromPointAndNormal #-}
 
-instance (NonVerticalHyperPlane_  hyperPlane d r, Default extra)
+instance (NonVerticalHyperPlane_  hyperPlane d r)
          => NonVerticalHyperPlane_ (hyperPlane :+ extra) d r where
   evalAt p = evalAt p . view core
   {-# INLINE evalAt #-}

hgeometry/kernel/src/HGeometry/Interval/Class.hs

@@ -12,11 +12,14 @@
 module HGeometry.Interval.Class
   ( Interval_, pattern Interval_
   , IntervalLike_(..)
+  , ConstructableInterval_(..)
 
   , ClosedInterval_(..), pattern ClosedInterval_
+  , ConstructableClosedInterval_(..)
   , clampTo
 
   , OpenInterval_(..), pattern OpenInterval_
+  , ConstructableOpenInterval_(..)
 
   , HasStart(..)
   , HasEnd(..)
@@ -103,6 +106,19 @@ class ( HasStart interval point, HasStartPoint interval (StartPointOf interval)
       , EndPoint_ (EndPointOf interval), IxValue (EndPointOf interval) ~ point
       , EndPoint_ (StartPointOf interval), IxValue (StartPointOf interval) ~ point
       ) => IntervalLike_ interval point | interval -> point where
+  {-# MINIMAL  #-}
+
+-- | A class for types representing Intervals
+type Interval_ :: Type -> Type -> Constraint
+class ( IntervalLike_ interval r
+      , NumType interval ~ r
+      ) => Interval_ interval r | interval -> r where
+
+--------------------------------------------------------------------------------
+
+-- | A class for constructable intervals
+type ConstructableInterval_ :: Type -> Type -> Constraint
+class  Interval_ interval point => ConstructableInterval_ interval point where
   {-# MINIMAL mkInterval #-}
 
   -- | Construct an interval given its start and end point.
@@ -124,15 +140,6 @@ class ( HasStart interval point, HasStartPoint interval (StartPointOf interval)
   {-# INLINE buildInterval #-}
 
 
---------------------------------------------------------------------------------
-
--- | A class for types representing Intervals
-type Interval_ :: Type -> Type -> Constraint
-class ( IntervalLike_ interval r
-      , NumType interval ~ r
-      ) => Interval_ interval r | interval -> r where
-
-
 --------------------------------------------------------------------------------
 -- * Closed Intervals
 
@@ -142,6 +149,12 @@ class ( Interval_ interval r
       , StartPointOf interval ~ EndPoint Closed r
       , EndPointOf interval ~ EndPoint Closed r
       ) => ClosedInterval_ interval r where
+
+-- | A class representing constructable closed intervals
+class ( ClosedInterval_ interval r
+      , ConstructableInterval_ interval r
+      ) => ConstructableClosedInterval_ interval r where
+
   -- | Construct an interval given its start and end point.
   mkClosedInterval     :: r -> r -> interval
   mkClosedInterval s e = mkInterval (ClosedE s) (ClosedE e)
@@ -157,10 +170,10 @@ class ( Interval_ interval r
 -- | Pattern matching on an arbitrary closed interval
 pattern ClosedInterval_     :: ClosedInterval_ interval r => r -> r -> interval
 pattern ClosedInterval_ l u <- (startAndEnd -> (l,u))
-  where
-    ClosedInterval_ l u = mkClosedInterval l u
 {-# COMPLETE ClosedInterval_ #-}
-{-# INLINE ClosedInterval_ #-}
+--   where
+--     ClosedInterval_ l u = mkClosedInterval l u
+-- {-# INLINE ClosedInterval_ #-}
 
 -- | Clamps a value to an interval. I.e. if the value lies outside the range we
 -- report the closest value "in the range".
@@ -182,6 +195,11 @@ class ( Interval_ interval r
       , StartPointOf interval ~ EndPoint Open r
       , EndPointOf interval ~ EndPoint Open r
       ) => OpenInterval_ interval r | interval -> r where
+
+-- | Constructable Open intervals
+class ( OpenInterval_ interval r
+      , ConstructableInterval_ interval r
+      ) => ConstructableOpenInterval_ interval r | interval -> r where
   -- | Construct an interval given its start s and end point t.
   --
   -- pre: s < t
@@ -192,19 +210,19 @@ class ( Interval_ interval r
 -- | Pattern matching on an arbitrary open interval
 pattern OpenInterval_     :: OpenInterval_ interval r => r -> r -> interval
 pattern OpenInterval_ l u <- (startAndEnd -> (l,u))
-  where
-    OpenInterval_ l u = mkOpenInterval l u
+  -- where
+  --   OpenInterval_ l u = mkOpenInterval l u
 {-# COMPLETE OpenInterval_ #-}
 
 --------------------------------------------------------------------------------
 
--- | Pattern to match on intervals or construct them.
+-- | Pattern to match on intervals
 pattern Interval_     :: Interval_ interval r
                       => StartPointOf interval -> EndPointOf interval -> interval
 pattern Interval_ s t <- (startAndEndPoint -> (s,t))
-  where
-    Interval_ s t = mkInterval s t
 {-# COMPLETE Interval_ #-}
+  -- where
+  --   Interval_ s t = mkInterval s t
 
 
 -- | Compute where the given query value is with respect to the interval.
@@ -320,20 +338,28 @@ type instance StartPointOf (interval :+ extra) = StartPointOf interval
 type instance EndPointOf (interval :+ extra) = EndPointOf interval
 
 instance ( IntervalLike_ interval point
-         , Default extra
          ) => IntervalLike_ (interval :+ extra) point where
-  mkInterval s t = mkInterval s t :+ def
 
 instance ( Interval_ interval r
-         , Default extra
          ) => Interval_ (interval :+ extra) r
 
 instance ( ClosedInterval_ interval r
+         ) => ClosedInterval_ (interval :+ extra) r
+
+instance ( OpenInterval_ interval r
+         ) => OpenInterval_ (interval :+ extra) r
+
+instance ( ConstructableInterval_ interval point
          , Default extra
-         ) => ClosedInterval_ (interval :+ extra) r where
+         ) => ConstructableInterval_ (interval :+ extra) point where
+  mkInterval s t = mkInterval s t :+ def
+
+instance ( ConstructableClosedInterval_ interval r
+         , Default extra
+         ) => ConstructableClosedInterval_ (interval :+ extra) r where
   mkClosedInterval s t = mkClosedInterval s t :+ def
 
-instance ( OpenInterval_ interval r
+instance ( ConstructableOpenInterval_ interval r
          , Default extra
-         ) => OpenInterval_ (interval :+ extra) r where
+         ) => ConstructableOpenInterval_ (interval :+ extra) r where
   mkOpenInterval s t = mkOpenInterval s t :+ def

hgeometry/kernel/src/HGeometry/Interval/HalfOpen.hs

@@ -52,10 +52,12 @@ instance HasEndPoint (HalfOpenInterval r) (EndPoint Closed r) where
   endPoint = lens _right (\ai x -> ai { _right = x})
 
 instance IntervalLike_ (HalfOpenInterval r) r where
-  mkInterval = HalfOpenInterval
 
 instance Interval_ (HalfOpenInterval r) r where
 
+instance ConstructableInterval_ (HalfOpenInterval r) r where
+  mkInterval = HalfOpenInterval
+
 instance (Ord r) => Point 1 r `HasIntersectionWith` HalfOpenInterval r where
   (Point1 q) `intersects` i = q `stabsInterval` i
 

hgeometry/kernel/src/HGeometry/Interval/Internal.hs

@@ -83,15 +83,19 @@ type instance EndPointOf   (Interval endPoint r) = endPoint r
 
 instance ( EndPoint_ (endPoint r), IxValue (endPoint r) ~ r
          ) => IntervalLike_ (Interval endPoint r) r where
-  mkInterval = Interval
 
 instance ( EndPoint_ (endPoint r), IxValue (endPoint r) ~ r
          ) => Interval_ (Interval endPoint r) r where
 
+instance ( EndPoint_ (endPoint r), IxValue (endPoint r) ~ r
+         ) => ConstructableInterval_ (Interval endPoint r) r where
+  mkInterval = Interval
 
 instance ClosedInterval_ (ClosedInterval r) r
+instance ConstructableClosedInterval_ (ClosedInterval r) r
 
 instance OpenInterval_ (OpenInterval r) r
+instance ConstructableOpenInterval_ (OpenInterval r) r
 
 --------------------------------------------------------------------------------