From 07f61992d9a318a91628d39ca8d232be810ef0d6 Mon Sep 17 00:00:00 2001
From: Richard Marko <srk@48.io>
Date: Fri, 6 May 2022 15:13:27 +0200
Subject: [PATCH 1/9] Expand vec to f a, add Applicative, Eq

---
 Graphics/Implicit/Definitions.hs              | 16 ++---
 Graphics/Implicit/Export/SymbolicFormats.hs   |  2 +-
 Graphics/Implicit/ObjectUtil/GetBoxShared.hs  |  4 +-
 .../Implicit/ObjectUtil/GetImplicitShared.hs  |  4 +-
 Graphics/Implicit/Primitives.hs               | 70 ++++++++++---------
 Graphics/Implicit/Primitives.hs-boot          | 25 ++++---
 tests/Graphics/Implicit/Test/Instances.hs     |  2 +-
 tests/ImplicitSpec.hs                         | 36 +++++-----
 8 files changed, 85 insertions(+), 74 deletions(-)

diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs
index 967014dd..ee0a6bee 100644
--- a/Graphics/Implicit/Definitions.hs
+++ b/Graphics/Implicit/Definitions.hs
@@ -209,23 +209,23 @@ type BoxedObj3 = Boxed3 Obj3
 -- | Means of constructing symbolic objects that are common between the 2D and
 -- 3D case. This type is parameterized on @obj@ and @vec@ so that
 -- 'SymbolicObj2' and 'SymbolicObj3' can instantiate it for their own purposes.
-data SharedObj obj vec
+data SharedObj obj f a
   = Empty  -- ^ The empty object
   | Full   -- ^ The entirely full object
   | Complement obj
   | UnionR ℝ [obj]
   | DifferenceR ℝ obj [obj]
   | IntersectR ℝ [obj]
-  | Translate vec obj
-  | Scale vec obj
-  | Mirror vec obj -- ^ Mirror across the line whose normal is defined by the vector
+  | Translate (f a) obj
+  | Scale (f a) obj
+  | Mirror (f a) obj -- ^ Mirror across the line whose normal is defined by the vector
   | Outset ℝ obj
   | Shell ℝ obj
-  | EmbedBoxedObj (vec -> ℝ, (vec, vec))
+  | EmbedBoxedObj ((f a) -> ℝ, ((f a), (f a)))
   | WithRounding ℝ obj
   deriving (Generic)
 
-instance (Show obj, Show vec) => Show (SharedObj obj vec) where
+instance (Show obj, Show (f a)) => Show (SharedObj obj f a) where
   showsPrec = flip $ \case
      Empty                   -> showCon "emptySpace"
      Full                    -> showCon "fullSpace"
@@ -274,7 +274,7 @@ data SymbolicObj2 =
     | Rotate2 ℝ SymbolicObj2
     | Transform2 (M33 ℝ) SymbolicObj2
     -- Lifting common objects
-    | Shared2 (SharedObj SymbolicObj2 ℝ2)
+    | Shared2 (SharedObj SymbolicObj2 V2 ℝ)
     deriving (Generic)
 
 instance Show SymbolicObj2 where
@@ -320,7 +320,7 @@ data SymbolicObj3 =
         (Either ℝ  (ℝ -> ℝ )) -- rotate
         SymbolicObj2          -- object to extrude
     | ExtrudeOnEdgeOf SymbolicObj2 SymbolicObj2
-    | Shared3 (SharedObj SymbolicObj3 ℝ3)
+    | Shared3 (SharedObj SymbolicObj3 V3 ℝ)
     deriving (Generic)
 
 instance Show SymbolicObj3 where
diff --git a/Graphics/Implicit/Export/SymbolicFormats.hs b/Graphics/Implicit/Export/SymbolicFormats.hs
index 4def3ed2..700eac25 100644
--- a/Graphics/Implicit/Export/SymbolicFormats.hs
+++ b/Graphics/Implicit/Export/SymbolicFormats.hs
@@ -78,7 +78,7 @@ bvect v = "[" <> fold (intersperse "," $ vectAsArgs v) <> "]"
 
 ------------------------------------------------------------------------------
 -- | Build the common combinators.
-buildShared :: forall obj vec. (Build obj, VectorStuff vec) => SharedObj obj vec -> Reader ℝ Builder
+buildShared :: forall obj f a. (Build obj, VectorStuff (f a)) => SharedObj obj f a -> Reader ℝ Builder
 
 buildShared Empty = call "union" [] []
 
diff --git a/Graphics/Implicit/ObjectUtil/GetBoxShared.hs b/Graphics/Implicit/ObjectUtil/GetBoxShared.hs
index 8111f72a..5c8e0062 100644
--- a/Graphics/Implicit/ObjectUtil/GetBoxShared.hs
+++ b/Graphics/Implicit/ObjectUtil/GetBoxShared.hs
@@ -127,8 +127,8 @@ outsetBox r (a, b) = (a - uniformV r, b + uniformV r)
 -- Get a box around the given object.
 getBoxShared
     :: forall obj f a
-     .  ( Applicative f, Object obj (f a), VectorStuff (f a), Eq (f a), ComponentWiseMultable (f a), Fractional a, Metric f)
-    => SharedObj obj (f a)
+     .  ( Applicative f, Object obj f a, VectorStuff (f a), Eq (f a), ComponentWiseMultable (f a), Fractional a, Metric f)
+    => SharedObj obj f a
     -> (f a, f a)
 -- Primitives
 getBoxShared Empty = emptyBox
diff --git a/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs b/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs
index ee014028..d02e8286 100644
--- a/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs
+++ b/Graphics/Implicit/ObjectUtil/GetImplicitShared.hs
@@ -38,13 +38,13 @@ normalize v =
 -- Get a function that describes the surface of the object.
 getImplicitShared
     :: forall obj f
-     . ( Object obj (f ℝ)
+     . ( Object obj f ℝ
        , VectorStuff (f ℝ)
        , ComponentWiseMultable (f ℝ)
        , Metric f
        )
     => ObjectContext
-    -> SharedObj obj (f ℝ)
+    -> SharedObj obj f ℝ
     -> f ℝ
     -> ℝ
 getImplicitShared _ Empty = const infty
diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs
index bb4b48e2..939bbdd3 100644
--- a/Graphics/Implicit/Primitives.hs
+++ b/Graphics/Implicit/Primitives.hs
@@ -50,7 +50,7 @@ module Graphics.Implicit.Primitives (
                                      Object
                                     ) where
 
-import Prelude(abs, (<), otherwise, id, Num, (+), (-), (*), (/), (.), negate, Bool(True, False), Maybe(Just, Nothing), Either, fmap, ($))
+import Prelude(Applicative, Eq, Num, abs, (<), otherwise, id, Num, (+), (-), (*), (/), (.), negate, Bool(True, False), Maybe(Just, Nothing), Either, fmap, ($))
 
 import Graphics.Implicit.Definitions (ObjectContext, ℝ, ℝ2, ℝ3, Box2,
                                       SharedObj(Empty,
@@ -178,41 +178,45 @@ polygon = Polygon
 -- instead provided by 'rotate' and 'rotate3'.
 --
 -- Library users shouldn't need to provide new instances of this class.
-class Num vec => Object obj vec
-      | obj -> vec where
-
+class ( Applicative f
+      , Eq a
+      , Eq (f a)
+      , Num a
+      , Num (f a))
+      => Object obj f a | obj -> f a
+      where
     -- | A 'Prism'' for including 'SharedObj's in @obj@. Prefer using 'Shared'
     -- instead of this.
-    _Shared :: Prism' obj (SharedObj obj vec)
+    _Shared :: Prism' obj (SharedObj obj f a)
 
     -- | Get the bounding box an object
     getBox ::
         obj           -- ^ Object to get box of
-        -> (vec, vec) -- ^ Bounding box
+        -> (f a, f a) -- ^ Bounding box
 
     -- | Get the implicit function for an object
     getImplicit'
         :: ObjectContext
         -> obj         -- ^ Object to get implicit function of
-        -> (vec -> ℝ)  -- ^ Implicit function
+        -> (f a -> ℝ)  -- ^ Implicit function
 
 -- | Get the implicit function for an object
 getImplicit
-    :: Object obj vec
+    :: Object obj f a
     => obj         -- ^ Object to get implicit function of
-    -> (vec -> ℝ)  -- ^ Implicit function
+    -> (f a -> ℝ)  -- ^ Implicit function
 getImplicit = getImplicit' defaultObjectContext
 
 -- | A pattern that abstracts over 'Shared2' and 'Shared3'.
-pattern Shared :: Object obj vec => SharedObj obj vec -> obj
+pattern Shared :: (Object obj f a) => SharedObj obj f a -> obj
 pattern Shared v <- (preview _Shared -> Just v)
   where
     Shared v = _Shared # v
 
 -- | Translate an object by a vector of appropriate dimension.
 translate
-    :: Object obj vec
-    => vec  -- ^ Vector to translate by
+    :: Object obj f a
+    => f a  -- ^ Vector to translate by
     -> obj  -- ^ Object to translate
     -> obj  -- ^ Resulting object
 translate _ s@(Shared Empty) = s
@@ -222,8 +226,8 @@ translate v s = Shared $ Translate v s
 
 -- | Scale an object
 scale
-    :: Object obj vec
-    => vec  -- ^ Amount to scale by
+    :: Object obj f a
+    => f a  -- ^ Amount to scale by
     -> obj  -- ^ Object to scale
     -> obj  -- ^ Resulting scaled object
 scale _ s@(Shared Empty) = s
@@ -232,7 +236,7 @@ scale v s = Shared $ Scale v s
 
 -- | Complement an Object
 complement
-    :: Object obj vec
+    :: Object obj f a
     => obj  -- ^ Object to complement
     -> obj  -- ^ Result
 complement (Shared Empty) = Shared Full
@@ -241,11 +245,11 @@ complement (Shared (Complement s)) = s
 complement s = Shared $ Complement s
 
 -- | The object that fills no space
-emptySpace :: Object obj vec => obj
+emptySpace :: Object obj f a => obj
 emptySpace = Shared Empty
 
 -- | The object that fills the entire space
-fullSpace :: Object obj vec => obj
+fullSpace :: Object obj f a => obj
 fullSpace = Shared Full
 
 -- | Set the current object-rounding value for the given object. The rounding
@@ -260,15 +264,15 @@ fullSpace = Shared Full
 -- @obj@, so long as they have the same dimensionality. That is to say,
 -- the current object-rounding value set in 3D will not apply to extruded 2D
 -- shapes.
-withRounding :: Object obj vec => ℝ -> obj -> obj
+withRounding :: Object obj f a => ℝ -> obj -> obj
 withRounding 0 = id
 withRounding r = Shared . WithRounding r
 
 -- | Mirror an object across the hyperplane whose normal is a given
 -- vector.
 mirror
-    :: Object obj vec
-    => vec  -- ^ Vector defining the hyperplane
+    :: Object obj f a
+    => f a  -- ^ Vector defining the hyperplane
     -> obj  -- ^ Object to mirror
     -> obj  -- ^ Resulting object
 mirror _ s@(Shared Empty) = s
@@ -277,7 +281,7 @@ mirror v s = Shared $ Mirror v s
 
 -- | Outset of an object.
 outset
-    :: Object obj vec
+    :: Object obj f a
     => ℝ     -- ^ distance to outset
     -> obj   -- ^ object to outset
     -> obj   -- ^ resulting object
@@ -288,7 +292,7 @@ outset v s = Shared $ Outset v s
 
 -- | Make a shell of an object.
 shell
-    :: Object obj vec
+    :: Object obj f a
     => ℝ     -- ^ width of shell
     -> obj   -- ^ object to take shell of
     -> obj   -- ^ resulting shell
@@ -298,7 +302,7 @@ shell v s = Shared $ Shell v s
 
 -- | Rounded union
 unionR
-    :: Object obj vec
+    :: Object obj f a
     => ℝ      -- ^ The radius (in mm) of rounding
     -> [obj]  -- ^ objects to union
     -> obj    -- ^ Resulting object
@@ -308,7 +312,7 @@ unionR r ss = Shared $ UnionR r ss
 
 -- | Rounded difference
 differenceR
-    :: Object obj vec
+    :: Object obj f a
     => ℝ     -- ^ The radius (in mm) of rounding
     -> obj   -- ^ Base object
     -> [obj] -- ^ Objects to subtract from the base
@@ -320,7 +324,7 @@ differenceR r s ss = Shared $ DifferenceR r s ss
 
 -- | Rounded minimum
 intersectR
-    :: Object obj vec
+    :: Object obj f a
     => ℝ     -- ^ The radius (in mm) of rounding
     -> [obj] -- ^ Objects to intersect
     -> obj   -- ^ Resulting object
@@ -329,33 +333,33 @@ intersectR _ [s] = s
 intersectR r ss = Shared $ IntersectR r ss
 
 implicit
-    :: Object obj vec
-    => (vec -> ℝ)     -- ^ Implicit function
-    -> (vec, vec)  -- ^ Bounding box
+    :: Object obj f a
+    => (f a -> ℝ)     -- ^ Implicit function
+    -> (f a, f a)  -- ^ Bounding box
     -> obj         -- ^ Resulting object
 implicit a b = Shared $ EmbedBoxedObj (a, b)
 
-instance Object SymbolicObj2 ℝ2 where
+instance Object SymbolicObj2 V2 ℝ where
   _Shared = prism' Shared2 $ \case
     Shared2 x -> Just x
     _         -> Nothing
   getBox       = getBox2
   getImplicit' = getImplicit2
 
-instance Object SymbolicObj3 ℝ3 where
+instance Object SymbolicObj3 V3 ℝ where
   _Shared = prism' Shared3 $ \case
     Shared3 x -> Just x
     _         -> Nothing
   getBox       = getBox3
   getImplicit' = getImplicit3
 
-union :: Object obj vec => [obj] -> obj
+union :: Object obj f a => [obj] -> obj
 union = unionR 0
 
-difference :: Object obj vec => obj -> [obj] -> obj
+difference :: Object obj f a => obj -> [obj] -> obj
 difference = differenceR 0
 
-intersect :: Object obj vec => [obj] -> obj
+intersect :: Object obj f a => [obj] -> obj
 intersect = intersectR 0
 
 -- 3D operations
diff --git a/Graphics/Implicit/Primitives.hs-boot b/Graphics/Implicit/Primitives.hs-boot
index f1170cf2..91004d41 100644
--- a/Graphics/Implicit/Primitives.hs-boot
+++ b/Graphics/Implicit/Primitives.hs-boot
@@ -5,19 +5,26 @@
 
 module Graphics.Implicit.Primitives (Object(getBox, getImplicit'), getImplicit) where
 
-import Graphics.Implicit.Definitions (ObjectContext, SymbolicObj2, SymbolicObj3, SharedObj, ℝ3, ℝ2, ℝ)
+import Graphics.Implicit.Definitions (ObjectContext, SymbolicObj2, SymbolicObj3, SharedObj, ℝ)
 import Control.Lens (Prism')
-import Prelude (Num)
+import Prelude (Applicative, Eq, Num)
+import Linear (V2, V3)
 
 -- See the non-source version of "Graphics.Implicit.Primitives" for
 -- documentation of this class.
-class Num vec => Object obj vec | obj -> vec where
-    _Shared :: Prism' obj (SharedObj obj vec)
-    getBox       :: obj -> (vec, vec)
-    getImplicit' :: ObjectContext -> obj -> (vec -> ℝ)
+class ( Applicative f
+      , Eq a
+      , Eq (f a)
+      , Num a
+      , Num (f a))
+      => Object obj f a | obj -> f a
+  where
+    _Shared :: Prism' obj (SharedObj obj f a)
+    getBox       :: obj -> (f a, f a)
+    getImplicit' :: ObjectContext -> obj -> (f a -> ℝ)
 
-getImplicit :: Object obj vec => obj -> (vec -> ℝ)
+getImplicit :: Object obj f a => obj -> (f a -> ℝ)
 
-instance Object SymbolicObj2 ℝ2
-instance Object SymbolicObj3 ℝ3
+instance Object SymbolicObj2 V2 ℝ
+instance Object SymbolicObj3 V3 ℝ
 
diff --git a/tests/Graphics/Implicit/Test/Instances.hs b/tests/Graphics/Implicit/Test/Instances.hs
index 89381767..2c4afba0 100644
--- a/tests/Graphics/Implicit/Test/Instances.hs
+++ b/tests/Graphics/Implicit/Test/Instances.hs
@@ -112,7 +112,7 @@ instance Arbitrary SymbolicObj3 where
         , pure emptySpace
         ]
 
-instance (Arbitrary obj, Arbitrary vec, CoArbitrary vec) => Arbitrary (SharedObj obj vec) where
+instance (Arbitrary obj, Arbitrary (f a), CoArbitrary (f a)) => Arbitrary (SharedObj obj f a) where
   shrink = genericShrink
   arbitrary = oneof
     [ Translate    <$> arbitrary    <*> decayArbitrary 2
diff --git a/tests/ImplicitSpec.hs b/tests/ImplicitSpec.hs
index fffe7b2b..ea1f1fa6 100644
--- a/tests/ImplicitSpec.hs
+++ b/tests/ImplicitSpec.hs
@@ -74,25 +74,25 @@ spec = do
 ------------------------------------------------------------------------------
 -- All the constraints we need in scope to parameterize tests by both 2d and
 -- 3d symbolic objects.
-type TestInfrastructure obj vec test outcome =
-  ( Object obj vec
+type TestInfrastructure obj f a test outcome =
+  ( Object obj f a
   , Observe test outcome obj
   , Monoid obj
   , Show outcome
   , Show test
   , Show obj
-  , Show vec
+  , Show (f a)
   , Arbitrary obj
-  , Arbitrary vec
-  , Epsilon vec
-  , Fractional vec
+  , Arbitrary (f a)
+  , Epsilon (f a)
+  , Fractional (f a)
   )
 
 ------------------------------------------------------------------------------
 -- Tests proving that symbolic objects form a monoid.
 monoidSpec
-    :: forall obj vec test outcome
-     . TestInfrastructure obj vec test outcome
+    :: forall obj f a test outcome
+     . TestInfrastructure obj f a test outcome
     => Spec
 monoidSpec = describe "monoid laws" $ do
   prop "a <> mempty = a" $ \obj ->
@@ -109,8 +109,8 @@ monoidSpec = describe "monoid laws" $ do
 -- 'fullSpace'. Additionally, that 'scale' is a no-op on 'emptySpace' (but not
 -- for 'fullSpace', because scaling by 0 is instead 'emptySpace').
 idempotenceSpec
-    :: forall obj vec test outcome
-     . TestInfrastructure obj vec test outcome
+    :: forall obj f a test outcome
+     . TestInfrastructure obj f a test outcome
     => Spec
 idempotenceSpec = describe "idempotence" $ do
   for_ [("empty", emptySpace @obj), ("full", fullSpace)] $ \(name, obj) ->
@@ -130,8 +130,8 @@ idempotenceSpec = describe "idempotence" $ do
 ------------------------------------------------------------------------------
 -- Proofs of the invertability of operations.
 inverseSpec
-    :: forall obj vec test outcome
-     . TestInfrastructure obj vec test outcome
+    :: forall obj f a test outcome
+     . TestInfrastructure obj f a test outcome
     => Spec
 inverseSpec = describe "inverses" $ do
   prop "complement inverse" $
@@ -150,8 +150,8 @@ inverseSpec = describe "inverses" $ do
 ------------------------------------------------------------------------------
 -- Proofs that 'fullSpace' is an annhilative element with respect to union.
 annihilationSpec
-    :: forall obj vec test outcome
-     . TestInfrastructure obj vec test outcome
+    :: forall obj f a test outcome
+     . TestInfrastructure obj f a test outcome
     => Spec
 annihilationSpec = describe "annihilation" $ do
   prop "full <> obj = full" $ \obj ->
@@ -288,8 +288,8 @@ misc3dSpec = describe "misc 3d tests" $ do
 ------------------------------------------------------------------------------
 -- Misc identity proofs that should hold for all symbolic objects.
 identitySpec
-    :: forall obj vec test outcome
-     . TestInfrastructure obj vec test outcome
+    :: forall obj f a test outcome
+     . TestInfrastructure obj f a test outcome
     => Spec
 identitySpec = describe "identity" $ do
   prop "complement empty" $
@@ -319,8 +319,8 @@ identitySpec = describe "identity" $ do
 -- Functions proving symbolic objects form homomorphisms with respect to
 -- translate and scale.
 homomorphismSpec
-    :: forall obj vec test outcome
-     . TestInfrastructure obj vec test outcome
+    :: forall obj f a test outcome
+     . TestInfrastructure obj f a test outcome
     => Spec
 homomorphismSpec = describe "homomorphism" $ do
   prop "translate" $ \xyz1 xyz2 ->

From 30f13a9c8a41f18060c359f79fb002b76bc96613 Mon Sep 17 00:00:00 2001
From: Richard Marko <srk@48.io>
Date: Fri, 6 May 2022 15:15:32 +0200
Subject: [PATCH 2/9] Fix haddocks for some primitives

---
 Graphics/Implicit/Primitives.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs
index 939bbdd3..0b93fc83 100644
--- a/Graphics/Implicit/Primitives.hs
+++ b/Graphics/Implicit/Primitives.hs
@@ -104,7 +104,7 @@ sphere ::
 
 sphere = Sphere
 
--- | A rectangular prism, with rounded corners.
+-- | A rectangular prism
 rect3
     :: ℝ3             -- ^ Bottom.. corner
     -> ℝ3             -- ^ Top right... corner
@@ -112,7 +112,7 @@ rect3
 
 rect3 xyz1 xyz2 = translate xyz1 $ Cube $ xyz2 - xyz1
 
--- | A rectangular prism, with rounded corners.
+-- | A cube
 cube
     :: Bool           -- ^ Centered?
     -> ℝ3             -- ^ Size
@@ -148,7 +148,7 @@ circle ::
 
 circle   = Circle
 
--- | A rectangle, with rounded corners.
+-- | A rectangle
 rect
     :: ℝ2           -- ^ Bottom left corner
     -> ℝ2           -- ^ Top right corner
@@ -156,7 +156,7 @@ rect
 
 rect xy1 xy2 = translate xy1 $ Square $ xy2 - xy1
 
--- | A rectangle, with rounded corners.
+-- | A square
 square
     :: Bool         -- ^ Centered?
     -> ℝ2           -- ^ Size
@@ -164,7 +164,7 @@ square
 square False size = Square size
 square True  size = translate (fmap (negate . (/ 2)) size) $ Square size
 
--- | A 2D polygon, with rounded corners.
+-- | A 2D polygon
 polygon
     :: [ℝ2]          -- ^ Verticies of the polygon
     -> SymbolicObj2  -- ^ Resulting polygon

From a7887fada4a7da24aacc0dd422806eb7e882498b Mon Sep 17 00:00:00 2001
From: Richard Marko <srk@48.io>
Date: Fri, 6 May 2022 15:25:26 +0200
Subject: [PATCH 3/9] Drop now redundant constraints from getBoxShared

---
 Graphics/Implicit/ObjectUtil/GetBoxShared.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Graphics/Implicit/ObjectUtil/GetBoxShared.hs b/Graphics/Implicit/ObjectUtil/GetBoxShared.hs
index 5c8e0062..89cbbc6e 100644
--- a/Graphics/Implicit/ObjectUtil/GetBoxShared.hs
+++ b/Graphics/Implicit/ObjectUtil/GetBoxShared.hs
@@ -127,7 +127,7 @@ outsetBox r (a, b) = (a - uniformV r, b + uniformV r)
 -- Get a box around the given object.
 getBoxShared
     :: forall obj f a
-     .  ( Applicative f, Object obj f a, VectorStuff (f a), Eq (f a), ComponentWiseMultable (f a), Fractional a, Metric f)
+     .  ( Object obj f a, VectorStuff (f a), ComponentWiseMultable (f a), Fractional a, Metric f)
     => SharedObj obj f a
     -> (f a, f a)
 -- Primitives

From ed24f59cd3edad5330a8c35a735bdcbee1afe87c Mon Sep 17 00:00:00 2001
From: Richard Marko <srk@48.io>
Date: Fri, 6 May 2022 15:25:57 +0200
Subject: [PATCH 4/9] Drop Epsilon from spec

---
 tests/ImplicitSpec.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/tests/ImplicitSpec.hs b/tests/ImplicitSpec.hs
index ea1f1fa6..af6825e6 100644
--- a/tests/ImplicitSpec.hs
+++ b/tests/ImplicitSpec.hs
@@ -8,7 +8,7 @@
 
 module ImplicitSpec (spec) where
 
-import Prelude (Fractional, not, fmap, pure, negate, (+), String,  Show, Monoid, mempty, (*), (/), (<>), (-), (/=), ($), (.), pi, id)
+import Prelude (Fractional, fmap, pure, negate, (+), String,  Show, Monoid, mempty, (*), (/), (<>), (-), (/=), ($), (.), pi, id)
 import Test.Hspec (xit, SpecWith, describe, Spec)
 import Graphics.Implicit
     ( difference,
@@ -35,7 +35,7 @@ import Test.QuickCheck
       forAll)
 import Data.Foldable ( for_ )
 import Test.Hspec.QuickCheck (prop)
-import Linear (V2(V2), V3(V3), V4(V4), (^*) , Epsilon(nearZero))
+import Linear (V2(V2), V3(V3), V4(V4), (^*))
 import qualified Linear
 import Graphics.Implicit (unionR)
 import Graphics.Implicit (intersectR)
@@ -84,7 +84,6 @@ type TestInfrastructure obj f a test outcome =
   , Show (f a)
   , Arbitrary obj
   , Arbitrary (f a)
-  , Epsilon (f a)
   , Fractional (f a)
   )
 
@@ -143,7 +142,7 @@ inverseSpec = describe "inverses" $ do
       =~= id
 
   prop "scale inverse" $
-    forAll (arbitrary `suchThat` (not . nearZero)) $ \xyz ->
+    forAll (arbitrary `suchThat` (/= 0)) $ \xyz ->
       scale @obj xyz . scale (1 / xyz)
       =~= id
 
@@ -252,7 +251,7 @@ transform3dSpec = describe "3d transform" $ do
     =~= translate tr . rotateQ quat
 
   prop "scale"
-    $ forAll (arbitrary `suchThat` (not . nearZero)) $ \s@(V3 x y z) ->
+    $ forAll (arbitrary `suchThat` (/= 0)) $ \s@(V3 x y z) ->
     transform3
       (V4 (V4 x 0 0 0)
           (V4 0 y 0 0)

From b51eedaa45887d2301fd2cedcc078c04ec0c1330 Mon Sep 17 00:00:00 2001
From: Richard Marko <srk@48.io>
Date: Fri, 6 May 2022 15:26:42 +0200
Subject: [PATCH 5/9] Reduce identities of translate, scale, rotate3, rotate3V

---
 Graphics/Implicit/Primitives.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs
index 0b93fc83..ab504c3e 100644
--- a/Graphics/Implicit/Primitives.hs
+++ b/Graphics/Implicit/Primitives.hs
@@ -219,6 +219,7 @@ translate
     => f a  -- ^ Vector to translate by
     -> obj  -- ^ Object to translate
     -> obj  -- ^ Resulting object
+translate 0 s = s
 translate _ s@(Shared Empty) = s
 translate _ s@(Shared Full) = s
 translate v1 (Shared (Translate v2 s)) = translate (v1 + v2) s
@@ -230,6 +231,7 @@ scale
     => f a  -- ^ Amount to scale by
     -> obj  -- ^ Object to scale
     -> obj  -- ^ Resulting scaled object
+scale 1 s = s
 scale _ s@(Shared Empty) = s
 scale v1 (Shared (Scale v2 s)) = scale (v1 * v2) s
 scale v s = Shared $ Scale v s
@@ -399,6 +401,7 @@ extrudeOnEdgeOf = ExtrudeOnEdgeOf
 -- | Rotate a 3D object via an Euler angle, measured in radians, along the
 -- world axis.
 rotate3 :: ℝ3 -> SymbolicObj3 -> SymbolicObj3
+rotate3 0 = id
 rotate3 (V3 pitch roll yaw)
   = Rotate3
   $ axisAngle (V3 0 0 1) yaw
@@ -417,6 +420,7 @@ rotate3V
     -> ℝ3  -- ^ Axis of rotation
     -> SymbolicObj3
     -> SymbolicObj3
+rotate3V 0 _ = id
 rotate3V w xyz = Rotate3 $ axisAngle xyz w
 
 -- | Transform a 3D object using a 4x4 matrix representing affine transformation

From a9406a112a005dccc83e3d4af9e78dc3284a7164 Mon Sep 17 00:00:00 2001
From: Richard Marko <srk@48.io>
Date: Fri, 6 May 2022 15:30:39 +0200
Subject: [PATCH 6/9] =?UTF-8?q?Generalize=20implicit=20f=20a=20->=20?=
 =?UTF-8?q?=E2=84=9D=20to=20f=20a=20->=20a?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 Graphics/Implicit/Definitions.hs     | 2 +-
 Graphics/Implicit/Primitives.hs      | 6 +++---
 Graphics/Implicit/Primitives.hs-boot | 4 ++--
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs
index ee0a6bee..8e8d0bfc 100644
--- a/Graphics/Implicit/Definitions.hs
+++ b/Graphics/Implicit/Definitions.hs
@@ -221,7 +221,7 @@ data SharedObj obj f a
   | Mirror (f a) obj -- ^ Mirror across the line whose normal is defined by the vector
   | Outset ℝ obj
   | Shell ℝ obj
-  | EmbedBoxedObj ((f a) -> ℝ, ((f a), (f a)))
+  | EmbedBoxedObj ((f a) -> a, ((f a), (f a)))
   | WithRounding ℝ obj
   deriving (Generic)
 
diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs
index ab504c3e..abca10e3 100644
--- a/Graphics/Implicit/Primitives.hs
+++ b/Graphics/Implicit/Primitives.hs
@@ -198,13 +198,13 @@ class ( Applicative f
     getImplicit'
         :: ObjectContext
         -> obj         -- ^ Object to get implicit function of
-        -> (f a -> ℝ)  -- ^ Implicit function
+        -> (f a -> a)  -- ^ Implicit function
 
 -- | Get the implicit function for an object
 getImplicit
     :: Object obj f a
     => obj         -- ^ Object to get implicit function of
-    -> (f a -> ℝ)  -- ^ Implicit function
+    -> (f a -> a)  -- ^ Implicit function
 getImplicit = getImplicit' defaultObjectContext
 
 -- | A pattern that abstracts over 'Shared2' and 'Shared3'.
@@ -336,7 +336,7 @@ intersectR r ss = Shared $ IntersectR r ss
 
 implicit
     :: Object obj f a
-    => (f a -> ℝ)     -- ^ Implicit function
+    => (f a -> a)     -- ^ Implicit function
     -> (f a, f a)  -- ^ Bounding box
     -> obj         -- ^ Resulting object
 implicit a b = Shared $ EmbedBoxedObj (a, b)
diff --git a/Graphics/Implicit/Primitives.hs-boot b/Graphics/Implicit/Primitives.hs-boot
index 91004d41..fe69ec83 100644
--- a/Graphics/Implicit/Primitives.hs-boot
+++ b/Graphics/Implicit/Primitives.hs-boot
@@ -21,9 +21,9 @@ class ( Applicative f
   where
     _Shared :: Prism' obj (SharedObj obj f a)
     getBox       :: obj -> (f a, f a)
-    getImplicit' :: ObjectContext -> obj -> (f a -> ℝ)
+    getImplicit' :: ObjectContext -> obj -> (f a -> a)
 
-getImplicit :: Object obj f a => obj -> (f a -> ℝ)
+getImplicit :: Object obj f a => obj -> (f a -> a)
 
 instance Object SymbolicObj2 V2 ℝ
 instance Object SymbolicObj3 V3 ℝ

From 97ea1b4a6f85c41f0e33db98b1d7984c1993cf71 Mon Sep 17 00:00:00 2001
From: Richard Marko <srk@48.io>
Date: Fri, 6 May 2022 15:31:27 +0200
Subject: [PATCH 7/9] Align Show SymbolicObj2

---
 Graphics/Implicit/Definitions.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs
index 8e8d0bfc..3de94286 100644
--- a/Graphics/Implicit/Definitions.hs
+++ b/Graphics/Implicit/Definitions.hs
@@ -282,10 +282,10 @@ instance Show SymbolicObj2 where
     -- NB: The False here is the centering argument, which has already been
     -- transformed into a translate. The 'Square' constructor itself is never
     -- centered.
-    Square sz  -> showCon "square"    @| False @| sz
-    Circle r      -> showCon "circle" @| r
-    Polygon ps -> showCon "polygon"   @| ps
-    Rotate2 v obj -> showCon "rotate" @| v     @| obj
+    Square sz        -> showCon "square"     @| False @| sz
+    Circle r         -> showCon "circle"     @| r
+    Polygon ps       -> showCon "polygon"    @| ps
+    Rotate2 v obj    -> showCon "rotate"     @| v     @| obj
     Transform2 m obj -> showCon "transform2" @| m     @| obj
     Shared2 obj   -> flip showsPrec obj
 

From 96ed6924d4368220a5c0e08ea0b625cf7ded5131 Mon Sep 17 00:00:00 2001
From: Richard Marko <srk@48.io>
Date: Fri, 6 May 2022 15:45:52 +0200
Subject: [PATCH 8/9] Align docs

---
 Graphics/Implicit/Definitions.hs | 2 +-
 Graphics/Implicit/Primitives.hs  | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs
index 3de94286..ad45c2d8 100644
--- a/Graphics/Implicit/Definitions.hs
+++ b/Graphics/Implicit/Definitions.hs
@@ -310,7 +310,7 @@ data SymbolicObj3 =
     | Extrude SymbolicObj2 ℝ
     | ExtrudeM
         (Either ℝ (ℝ -> ℝ))   -- twist
-        ExtrudeMScale        -- scale
+        ExtrudeMScale         -- scale
         (Either ℝ2 (ℝ -> ℝ2)) -- translate
         SymbolicObj2          -- object to extrude
         (Either ℝ (ℝ2 -> ℝ))  -- height to extrude to
diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs
index abca10e3..c55b6896 100644
--- a/Graphics/Implicit/Primitives.hs
+++ b/Graphics/Implicit/Primitives.hs
@@ -336,7 +336,7 @@ intersectR r ss = Shared $ IntersectR r ss
 
 implicit
     :: Object obj f a
-    => (f a -> a)     -- ^ Implicit function
+    => (f a -> a)  -- ^ Implicit function
     -> (f a, f a)  -- ^ Bounding box
     -> obj         -- ^ Resulting object
 implicit a b = Shared $ EmbedBoxedObj (a, b)

From 89c63af37d9e1290df3928e20cea60bf70d4843d Mon Sep 17 00:00:00 2001
From: Richard Marko <srk@48.io>
Date: Fri, 6 May 2022 16:19:47 +0200
Subject: [PATCH 9/9] Fix Arbitrary SharedObj instance

---
 tests/Graphics/Implicit/Test/Instances.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/Graphics/Implicit/Test/Instances.hs b/tests/Graphics/Implicit/Test/Instances.hs
index 2c4afba0..f5a286df 100644
--- a/tests/Graphics/Implicit/Test/Instances.hs
+++ b/tests/Graphics/Implicit/Test/Instances.hs
@@ -112,7 +112,7 @@ instance Arbitrary SymbolicObj3 where
         , pure emptySpace
         ]
 
-instance (Arbitrary obj, Arbitrary (f a), CoArbitrary (f a)) => Arbitrary (SharedObj obj f a) where
+instance (Arbitrary obj, Arbitrary a, Arbitrary (f a), CoArbitrary (f a)) => Arbitrary (SharedObj obj f a) where
   shrink = genericShrink
   arbitrary = oneof
     [ Translate    <$> arbitrary    <*> decayArbitrary 2