{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Intersection
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Defines a data type for representing intersections. Mostly useful
-- for the more geometric types.
--
--------------------------------------------------------------------------------
module HGeometry.Intersection
  ( Intersection
  , IntersectionOf
  , HasIntersectionWith(..)
  , IsIntersectableWith(..)
  ) where

import Control.Lens ((^.))
import Data.Kind (Type)
import Data.Maybe (isJust)
import HGeometry.Ext
import HGeometry.ByIndex
import HGeometry.Point

-------------------------------------------------------------------------------

-- | The result of interesecting two geometries,
type family Intersection g h :: Type

-- | The data family specifying to help implement the 'Intersection'
-- type family.
data family IntersectionOf g h

-- | Class for types for which we can test if they intersect.
class HasIntersectionWith g h where
  -- | g `intersects` h  <=> The intersection of g and h is non-empty.
  intersects :: g -> h -> Bool
  default intersects :: ( Intersection g h ~ Maybe intersection
                        , IsIntersectableWith g h
                        ) => g -> h -> Bool
  g
g `intersects` h
h = Maybe intersection -> Bool
forall a. Maybe a -> Bool
isJust (Maybe intersection -> Bool) -> Maybe intersection -> Bool
forall a b. (a -> b) -> a -> b
$ g
g g -> h -> Intersection g h
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` h
h

-- | Class relationship between intersectable geometric objects.
class HasIntersectionWith g h => IsIntersectableWith g h where
  -- | Computes te intersection of two geometric objects.
  intersect :: g -> h -> Intersection g h


-- type instance Intersection (geomA :+ extra) (geomB :+ extra) = Intersection geomA geomB

instance HasIntersectionWith geomA geomB
         => HasIntersectionWith (geomA :+ extra) (geomB :+ extra) where
  geomA :+ extra
ga intersects :: (geomA :+ extra) -> (geomB :+ extra) -> Bool
`intersects` geomB :+ extra
gb = (geomA :+ extra
ga(geomA :+ extra) -> Getting geomA (geomA :+ extra) geomA -> geomA
forall s a. s -> Getting a s a -> a
^.Getting geomA (geomA :+ extra) geomA
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core) geomA -> geomB -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` (geomB :+ extra
gb(geomB :+ extra) -> Getting geomB (geomB :+ extra) geomB -> geomB
forall s a. s -> Getting a s a -> a
^.Getting geomB (geomB :+ extra) geomB
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core)

type instance Intersection (Point d r :+ extra) geom =  Maybe (Point d r :+ extra)

instance HasIntersectionWith (Point d r) geom
         => HasIntersectionWith (Point d r :+ extra) geom where
  Point d r :+ extra
q intersects :: (Point d r :+ extra) -> geom -> Bool
`intersects` geom
g = (Point d r :+ extra
q(Point d r :+ extra)
-> Getting (Point d r) (Point d r :+ extra) (Point d r)
-> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ extra) (Point d r)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core) Point d r -> geom -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` geom
g

instance ( IsIntersectableWith (Point d r) geom
         , Intersection (Point d r) geom ~ Maybe (Point d r)
         ) => IsIntersectableWith (Point d r :+ extra) geom where
  Point d r :+ extra
q intersect :: (Point d r :+ extra)
-> geom -> Intersection (Point d r :+ extra) geom
`intersect` geom
g = Point d r :+ extra
q (Point d r :+ extra)
-> Maybe (Point d r) -> Maybe (Point d r :+ extra)
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Point d r :+ extra
q(Point d r :+ extra)
-> Getting (Point d r) (Point d r :+ extra) (Point d r)
-> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ extra) (Point d r)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core) Point d r -> geom -> Intersection (Point d r) geom
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` geom
g


instance (geom `HasIntersectionWith` left
        , geom `HasIntersectionWith` right
         ) => geom `HasIntersectionWith` Either left right where
  geom
q intersects :: geom -> Either left right -> Bool
`intersects` Either left right
e = case Either left right
e of
    Left  left
l -> geom
q geom -> left -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` left
l
    Right right
r -> geom
q geom -> right -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` right
r




-- instance IsIntersectableWith geomA geomB
--          => IsIntersectableWith (geomA :+ extra) (geomB :+ extra) where
--   ga `intersect` gb = (ga^.core) `intersect` (gb^.core)


--------------------------------------------------------------------------------
-- * Instances for ByIndex

instance (geomA `HasIntersectionWith` geomB
         ) => ByIndex ix geomA `HasIntersectionWith` ByIndex ix geomB where
  ByIndex ix geomA
a intersects :: ByIndex ix geomA -> ByIndex ix geomB -> Bool
`intersects` ByIndex ix geomB
b = (ByIndex ix geomA
aByIndex ix geomA -> Getting geomA (ByIndex ix geomA) geomA -> geomA
forall s a. s -> Getting a s a -> a
^.Getting geomA (ByIndex ix geomA) geomA
forall ix a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ByIndex ix a1 -> f (ByIndex ix a2)
theValue) geomA -> geomB -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` (ByIndex ix geomB
bByIndex ix geomB -> Getting geomB (ByIndex ix geomB) geomB -> geomB
forall s a. s -> Getting a s a -> a
^.Getting geomB (ByIndex ix geomB) geomB
forall ix a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ByIndex ix a1 -> f (ByIndex ix a2)
theValue)

type instance Intersection (ByIndex ix a) (ByIndex ix b) = Intersection a b

instance (geomA `IsIntersectableWith` geomB
         ) => ByIndex ix geomA `IsIntersectableWith` ByIndex ix geomB where
  ByIndex ix geomA
a intersect :: ByIndex ix geomA
-> ByIndex ix geomB
-> Intersection (ByIndex ix geomA) (ByIndex ix geomB)
`intersect` ByIndex ix geomB
b = (ByIndex ix geomA
aByIndex ix geomA -> Getting geomA (ByIndex ix geomA) geomA -> geomA
forall s a. s -> Getting a s a -> a
^.Getting geomA (ByIndex ix geomA) geomA
forall ix a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ByIndex ix a1 -> f (ByIndex ix a2)
theValue) geomA -> geomB -> Intersection geomA geomB
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` (ByIndex ix geomB
bByIndex ix geomB -> Getting geomB (ByIndex ix geomB) geomB -> geomB
forall s a. s -> Getting a s a -> a
^.Getting geomB (ByIndex ix geomB) geomB
forall ix a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ByIndex ix a1 -> f (ByIndex ix a2)
theValue)