geom2d-0.1.3.1: Test/Point.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.AEq
import Data.Maybe
import Geom2d.Point
import Geom2d.Rotation
import Test.QuickCheck hiding (scale)
import Test.Utils
import Data.Fixed

mkpropPoint :: forall a p. (Arbitrary (p a), Point p, Eq a) =>
                 p a -> Bool
mkpropPoint p =
  and [ prop_identity
      ]
  where prop_identity = x p == x idPoint &&
                        y p == y idPoint
        idPoint :: p a
        idPoint = fromCoords (x p) (y p)

mkpropNum :: (Arbitrary a, Num a) => (a -> a -> Bool) -> a -> Bool
mkpropNum isEqual x =
    x `isEqual` (signum x * abs x)

mkpropFunctor :: (Arbitrary (f a), Eq (f a), Functor f) =>
                  f a -> Bool
mkpropFunctor x =
  fmap id x == x

mkpropScale :: (Arbitrary (p a), Scale p, Floating a, Point p) =>
                (a -> a -> Bool) -> p a -> a -> Bool
mkpropScale comparison p a =
  (magnitude p * abs a) `comparison`
  magnitude (a `scale` p)

mkpropNormalize :: (Arbitrary (p a), Point p, Scale p, Floating a, AEq a
                    , Num a) =>
                p a -> Bool
mkpropNormalize v =
  maybe (magnitude v ~== 0)
  ( (~== 1).magnitude )
  ( normalize v)

prop_scaleTo :: Point' Float -> Float -> Bool
prop_scaleTo vector x =
  fromMaybe (magnitude vector == 0) $ do
    scaledVector <- scaleTo x vector
    return (magnitude scaledVector ~== abs x)

prop_point_point' :: Point' Integer -> Bool
prop_point_point' = mkpropPoint

prop_num_point' :: Point' Float -> Bool
prop_num_point' = mkpropNum (~==)

prop_functor_point' :: Point' Integer -> Bool
prop_functor_point' = mkpropFunctor

prop_point'_magnitude :: Point' Float -> Bool
prop_point'_magnitude p =
  sqrt ( x p ^ 2 + y p ^ 2 ) ~== magnitude p

prop_triarea :: Float -> Float -> Bool
prop_triarea a b =
  triArea triangle ~== abs ((a * b) / 2)
  where triangle :: Triangle (Point' Float)
        triangle = ( fromCoords 0 0
                   , fromCoords a 0
                   , fromCoords 0 b
                   )

prop_point_scale :: Point' Float -> Float -> Bool
prop_point_scale = mkpropScale (~==)

prop_point_normalize :: Point' Float -> Bool
prop_point_normalize = mkpropNormalize

prop_pointInTriangle :: Bool
prop_pointInTriangle =
  pointInTriangle tri p
  where tri = ( fromCoords (-1) (-1)
              , fromCoords 1 (-1)
              , fromCoords 0 1
              )
        p :: Point' Float
        p = fromCoords 0 0

prop_pointInTriangle_onVert :: Bool
prop_pointInTriangle_onVert =
  pointInTriangle tri p
  where p = fromCoords 0 0
        tri :: Triangle (Point' Float)
        tri = (p, fromCoords 1 1, fromCoords 1 (-1))

prop_angle_zero :: Bool
prop_angle_zero =
  angle (fromCoords 1 0 :: Point' Float) == Just 0

prop_point_show_read :: Point' Float -> Bool
prop_point_show_read p =
  p == (read.show) p

prop_point_add :: Point' Float -> Point' Float -> Bool
prop_point_add p q =
  x (p + q) == x p + x q &&
  y (p + q) == y p + y q

prop_point_negate :: Point' Float -> Bool
prop_point_negate p =
  x (negate p) == negate (x p) &&
  y (negate p) == negate (y p)

prop_triangle_invalid :: Bool
prop_triangle_invalid =
  let tri :: Triangle (Point' Float)
      tri = ( fromCoords 0 0
            , fromCoords 1 1
            , fromCoords 1 1
            )
  in not (pointInTriangle tri (fromCoords 0 0))

prop_rotation_point_linear :: Point' Float -> Bool
prop_rotation_point_linear x =
  fromMaybe True
  ( (~==) <$>
    angle (r `rotate` x) <*>
    ((subtract pi).((`mod'` (2*pi)).(+pi).(+r)) <$> angle x)
  )
  where r = 1.2

prop_rotation_point_bounds :: Point' Float -> Bool
prop_rotation_point_bounds x =
  fromMaybe True
  ( fmap
    (\a -> a >= (- pi) && a <= pi)
    (angle x)
  )

return []
runTests = $quickCheckAll

main :: IO ()
main = do
  putStrLn "Test Point"
  runTests >>= doExit