Give an Arbitrary Quaternion instance to fix tests

implicit.cabal

@@ -221,7 +221,8 @@ Test-suite test-implicit
                   hw-hspec-hedgehog,
                   quickspec,
                   QuickCheck,
-                  vector-space
+                  vector-space,
+                  linear
     Other-Modules:
                   ParserSpec.Expr
                   ParserSpec.Statement

tests/Graphics/Implicit/Test/Instances.hs

@@ -6,9 +6,9 @@
 
 module Graphics.Implicit.Test.Instances (Quantizable (quantize), epsilon, observe, (=~=)) where
 
-import Prelude (Bool (True, False), Int, Double, Integer, (.), flip, uncurry, ($), (>), (<), (&&), all, (>=), length, div, (<*>), (<$>), (+), fmap, (/), fromIntegral, (^), (*), (<>), round, (<=), filter, notElem)
+import Prelude ((==), pure, Bool (True, False), Int, Double, Integer, (.), flip, uncurry, ($), (>), (<), (&&), all, (>=), length, div, (<*>), (<$>), (+), fmap, (/), fromIntegral, (^), (*), (<>), round, (<=), filter, notElem)
 
-import Data.VectorSpace (AdditiveGroup((^-^)))
+import Data.VectorSpace (magnitudeSq, AdditiveGroup((^-^)))
 
 import qualified Graphics.Implicit as I (scale)
 
@@ -47,7 +47,7 @@ import Graphics.Implicit.Primitives ( Object(getBox, getImplicit) )
 import QuickSpec ( Observe(observe), (=~=) )
 
 import Test.QuickCheck
-    ( Arbitrary(arbitrary, shrink),
+    (discard,  Arbitrary(arbitrary, shrink),
       genericShrink,
       choose,
       oneof,
@@ -57,6 +57,8 @@ import Test.QuickCheck
       Gen,
       Positive(getPositive) )
 
+import Linear (Quaternion, axisAngle)
+import Graphics.Implicit.MathUtil (packV3)
 
 ------------------------------------------------------------------------------
 -- | The number of decimal points we need to agree to assume two 'Double's are
@@ -109,6 +111,15 @@ instance Arbitrary ExtrudeRMScale where
     ]
 
 
+instance Arbitrary (Quaternion ℝ) where
+  arbitrary = do
+    q <- arbitrary
+    v <- arbitraryV3
+    case magnitudeSq v == 0.0 of
+      True  -> discard
+      False -> pure $ axisAngle (packV3 v) q
+
+
 ------------------------------------------------------------------------------
 -- | Two 'SymbolicObj2's are the same if their 'getImplicit' functions agree at
 -- all points (up to an error term of 'epsilon')
@@ -218,7 +229,6 @@ isValid3 (IntersectR3 _ _) = False  -- Bug #306
 isValid3 (Translate3 _ s) = isValid3 s
 isValid3 (Scale3 (x, y, z) s) = x > 0 && y > 0 && z > 0 && isValid3 s
 isValid3 (Rotate3 _ s) = isValid3 s
-{- isValid3 (Rotate3V _ _ s) = isValid3 s -} 
 isValid3 (Outset3 _ s) = isValid3 s
 isValid3 (Shell3 _ s) = isValid3 s
 isValid3 (CubeR _ (x0, y0, z0)) = (0 < x0) && (0 < y0) && (0 < z0)

tests/ImplicitSpec.hs

@@ -33,7 +33,6 @@ spec = do
             rotate3 (vec ^* (2 * pi - rads)) . rotate3 (vec ^* rads)
               =~= id
 
-      -- NOTE(sandy): getBox is broken in HEAD, but fixed in #314
       describe ("rotation in the " <> axis <> " plane (observed by getBox)") $ do
         it "360 degrees is id" $
           expectFailure $
@@ -56,7 +55,6 @@ spec = do
           rotate3V (2 * pi - rads) vec . rotate3V rads vec
             =~= id
 
-  -- NOTE(sandy): getBox is broken in HEAD, but fixed in #314
   describe "rotation in arbitrary planes (observed by getBox)" $ do
     it "360 degrees is id" $
       expectFailure $ do