src/Cube.hs: use explicit Prelude imports.

[spline3.git] / src / Cube.hs

diff --git a/src/Cube.hs b/src/Cube.hs
index 6652e8b6331f039cd90cd9c7791dab61f2fd3f58..4992851f3f7b3f7a3358e33852b53730c9269961 100644 (file)
--- a/src/Cube.hs
+++ b/src/Cube.hs
@@ -1,13 +1,17 @@
+-- The "tetrahedron" function pattern matches on the integers zero
+-- through twenty-three, but doesn't handle the "otherwise" case, for
+-- performance reasons.
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+
 module Cube (
   Cube(..),
   cube_properties,
   find_containing_tetrahedron,
   tetrahedra,
-  tetrahedron
-  )
+  tetrahedron )
 where
 
-import Data.Maybe (fromJust)
+import Data.Maybe ( fromJust )
 import qualified Data.Vector as V (
   Vector,
   findIndex,
@@ -15,20 +19,56 @@ import qualified Data.Vector as V (
   minimum,
   singleton,
   snoc,
-  unsafeIndex
-  )
-import Prelude hiding (LT)
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.QuickCheck (Arbitrary(..), Gen, Positive(..), choose)
-
-import Cardinal
-import Comparisons ((~=), (~~=))
-import qualified Face (Face(..), center)
-import FunctionValues (FunctionValues, eval, rotate)
-import Misc (all_equal, disjoint)
-import Point (Point(..), dot)
-import Tetrahedron (Tetrahedron(..), barycenter, c, volume)
+  unsafeIndex)
+import Prelude(
+  Bool,
+  Double,
+  Int,
+  Eq( (==) ),
+  Fractional( (/) ),
+  Maybe,
+  Num( (+), (-), (*) ),
+  Ord( (>=), (<=) ),
+  Show( show ),
+  ($),
+  (.),
+  (&&),
+  (++),
+  abs,
+  all,
+  and,
+  fromIntegral,
+  head,
+  map,
+  otherwise,
+  return,
+  tail )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.QuickCheck (
+  Arbitrary( arbitrary ),
+  Gen,
+  Positive( Positive ),
+  choose,
+  testProperty )
+import Cardinal (
+  Cardinal(F, B, L, R, D, T, FL, FR, FD, FT,
+           BL, BR, BD, BT, LD, LT, RD, RT, I),
+  ccwx,
+  ccwy,
+  ccwz,
+  cwx,
+  cwy,
+  cwz )
+import Comparisons ( (~=), (~~=) )
+import qualified Face ( Face(..), center )
+import FunctionValues ( FunctionValues, eval, rotate )
+import Misc ( all_equal, disjoint )
+import Point ( Point( Point ), dot )
+import Tetrahedron (
+  Tetrahedron(Tetrahedron, function_values, v0, v1, v2, v3),
+  barycenter,
+  c,
+  volume )
 
 data Cube = Cube { i  :: !Int,
                    j  :: !Int,
@@ -51,7 +91,7 @@ instance Arbitrary Cube where
         -- these numbers don't overflow 64 bits. This number is not
         -- magic in any other sense than that it does not cause test
         -- failures, while 2^23 does.
-        coordmax = 4194304 -- 2^22
+        coordmax = 4194304 :: Int -- 2^22
         coordmin = -coordmax
 
 
@@ -130,7 +170,7 @@ center cube =
 top_face :: Cube -> Face.Face
 top_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point delta (-delta) delta )
       v1' = cc + ( Point delta delta delta )
@@ -143,7 +183,7 @@ top_face cube = Face.Face v0' v1' v2' v3'
 back_face :: Cube -> Face.Face
 back_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point delta (-delta) (-delta) )
       v1' = cc + ( Point delta delta (-delta) )
@@ -155,7 +195,7 @@ back_face cube = Face.Face v0' v1' v2' v3'
 down_face :: Cube -> Face.Face
 down_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point (-delta) (-delta) (-delta) )
       v1' = cc + ( Point (-delta) delta (-delta) )
@@ -168,7 +208,7 @@ down_face cube = Face.Face v0' v1' v2' v3'
 front_face :: Cube -> Face.Face
 front_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point (-delta) (-delta) delta )
       v1' = cc + ( Point (-delta) delta delta )
@@ -179,7 +219,7 @@ front_face cube = Face.Face v0' v1' v2' v3'
 left_face :: Cube -> Face.Face
 left_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point delta (-delta) delta )
       v1' = cc + ( Point (-delta) (-delta) delta )
@@ -191,7 +231,7 @@ left_face cube = Face.Face v0' v1' v2' v3'
 right_face :: Cube -> Face.Face
 right_face cube = Face.Face v0' v1' v2' v3'
     where
-      delta = 1/2
+      delta = (1/2) :: Double
       cc  = center cube
       v0' = cc + ( Point (-delta) delta delta)
       v1' = cc + ( Point delta  delta delta )
@@ -603,9 +643,8 @@ find_containing_tetrahedron cube p =
     left_half = in_left_half cube p
 
     candidates :: V.Vector Tetrahedron
-    candidates =
-      if front_half then
-
+    candidates
+      | front_half =
         if left_half then
           if top_half then
             front_left_top_tetrahedra cube
@@ -617,8 +656,7 @@ find_containing_tetrahedron cube p =
           else
             front_right_down_tetrahedra cube
 
-      else -- bottom half
-
+      | otherwise = -- back half
         if left_half then
           if top_half then
             back_left_top_tetrahedra cube
@@ -654,9 +692,7 @@ find_containing_tetrahedron cube p =
 
 
 
--- Tests
-
--- Quickcheck tests.
+-- * Tests
 
 prop_opposite_octant_tetrahedra_disjoint1 :: Cube -> Bool
 prop_opposite_octant_tetrahedra_disjoint1 cube =
@@ -976,7 +1012,7 @@ prop_interior_values_all_identical cube =
 --   This test checks the rotation works as expected.
 prop_c_tilde_2100_rotation_correct :: Cube -> Bool
 prop_c_tilde_2100_rotation_correct cube =
-    expr1 == expr2
+    expr1 ~= expr2
     where
       t0 = tetrahedron cube 0
       t6 = tetrahedron cube 6
@@ -1010,7 +1046,7 @@ prop_c_tilde_2100_rotation_correct cube =
 --   even meaningful!
 prop_c_tilde_2100_correct :: Cube -> Bool
 prop_c_tilde_2100_correct cube =
-    c t6 2 1 0 0 == expected
+    c t6 2 1 0 0 ~= expected
     where
       t0 = tetrahedron cube 0
       t6 = tetrahedron cube 6
@@ -1132,9 +1168,9 @@ prop_t7_shares_edge_with_t20 cube =
         t20 = tetrahedron cube 20
 
 
-p79_26_properties :: Test.Framework.Test
+p79_26_properties :: TestTree
 p79_26_properties =
-    testGroup "p. 79, Section (2.6) Properties" [
+    testGroup "p. 79, Section (2.6) properties" [
       testProperty "c0120 identity1" prop_c0120_identity1,
       testProperty "c0120 identity2" prop_c0120_identity2,
       testProperty "c0120 identity3" prop_c0120_identity3,
@@ -1148,9 +1184,9 @@ p79_26_properties =
       testProperty "c1200 identity1" prop_c1200_identity1,
       testProperty "c2100 identity1" prop_c2100_identity1]
 
-p79_27_properties :: Test.Framework.Test
+p79_27_properties :: TestTree
 p79_27_properties =
-    testGroup "p. 79, Section (2.7) Properties" [
+    testGroup "p. 79, Section (2.7) properties" [
       testProperty "c0102 identity1" prop_c0102_identity1,
       testProperty "c0201 identity1" prop_c0201_identity1,
       testProperty "c0300 identity2" prop_c0300_identity2,
@@ -1159,9 +1195,9 @@ p79_27_properties =
       testProperty "c2100 identity2" prop_c2100_identity2 ]
 
 
-p79_28_properties :: Test.Framework.Test
+p79_28_properties :: TestTree
 p79_28_properties =
-  testGroup "p. 79, Section (2.8) Properties" [
+  testGroup "p. 79, Section (2.8) properties" [
     testProperty "c3000 identity" prop_c3000_identity,
     testProperty "c2010 identity" prop_c2010_identity,
     testProperty "c2001 identity" prop_c2001_identity,
@@ -1170,9 +1206,9 @@ p79_28_properties =
     testProperty "c1011 identity" prop_c1011_identity ]
 
 
-edge_incidence_tests :: Test.Framework.Test
+edge_incidence_tests :: TestTree
 edge_incidence_tests =
-    testGroup "Edge Incidence Tests" [
+    testGroup "Edge incidence tests" [
       testProperty "t0 shares edge with t6" prop_t0_shares_edge_with_t6,
       testProperty "t0 shares edge with t1" prop_t0_shares_edge_with_t1,
       testProperty "t0 shares edge with t3" prop_t0_shares_edge_with_t3,
@@ -1189,9 +1225,9 @@ edge_incidence_tests =
       testProperty "t6 shares edge with t7" prop_t6_shares_edge_with_t7,
       testProperty "t7 shares edge with t20" prop_t7_shares_edge_with_t20 ]
 
-cube_properties :: Test.Framework.Test
+cube_properties :: TestTree
 cube_properties =
-  testGroup "Cube Properties" [
+  testGroup "Cube properties" [
     p79_26_properties,
     p79_27_properties,
     p79_28_properties,