content: {-# LANGUAGE FlexibleContexts  #-}
  {-# LANGUAGE FlexibleInstances #-}
  
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Diagrams.Test.TwoD.Segment
      (
        tests
      ) where
  
  import qualified Test.QuickCheck.Property as Q
  import           Test.Tasty               (TestTree)
  import           Test.Tasty.QuickCheck
  
  import           Diagrams.Prelude
  import           Diagrams.TwoD.Segment
  
  newtype InBox = InBox { unInBox :: Double }
  
  instance Arbitrary InBox where
    arbitrary = InBox <$> choose (-1, 1)
  
  instance Arbitrary (Point V2 Double) where
    arbitrary = curry p2 <$> (unInBox <$> arbitrary)
                         <*> (unInBox <$> arbitrary)
  
  instance Arbitrary (FixedSegment V2 Double) where
     arbitrary = oneof [FLinear <$> arbitrary <*> arbitrary, FCubic <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary]
  
  epsT, epsE :: Double
  epsT = 1.0e-9 -- parameter space epsilon
  epsE = 1.0e-8 -- Euclidean space epsilon
  
  (.=~.) :: P2 Double -> P2 Double -> Bool
  x .=~. y = norm (x .-. y) < epsE
  
  tests :: [TestTree]
  tests =
      [ testProperty "segmentSegment" $
          \a b -> validateIntersections a b (segmentSegment epsT a b)
      ]
  
  validateIntersections :: FixedSegment V2 Double -> FixedSegment V2 Double -> [(Double, Double, P2 Double)] -> Q.Result
  validateIntersections _ _ [] = Q.rejected -- TODO: check for false negatives (rasterize both and look for overlap?)
  validateIntersections a b isects = go isects
    where
      go [] = Q.succeeded
      go ((ta,tb,p):is)
        | and [ 0 <= ta && ta <= 1
              , 0 <= tb && tb <= 1
              , a `atParam` ta .=~. p
              , b `atParam` tb .=~. p
              ] = go is
        | otherwise = Q.failed
  