{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE DefaultSignatures #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.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 Data.Intersection where

import Data.Maybe (isNothing)
import Data.Vinyl.CoRec
import Data.Vinyl.Core
import Data.Vinyl.Functor
import Data.Vinyl.Lens

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

-- | A simple data type expressing that there are no intersections
data NoIntersection = NoIntersection deriving (Int -> NoIntersection -> ShowS
[NoIntersection] -> ShowS
NoIntersection -> String
(Int -> NoIntersection -> ShowS)
-> (NoIntersection -> String)
-> ([NoIntersection] -> ShowS)
-> Show NoIntersection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoIntersection] -> ShowS
$cshowList :: [NoIntersection] -> ShowS
show :: NoIntersection -> String
$cshow :: NoIntersection -> String
showsPrec :: Int -> NoIntersection -> ShowS
$cshowsPrec :: Int -> NoIntersection -> ShowS
Show,ReadPrec [NoIntersection]
ReadPrec NoIntersection
Int -> ReadS NoIntersection
ReadS [NoIntersection]
(Int -> ReadS NoIntersection)
-> ReadS [NoIntersection]
-> ReadPrec NoIntersection
-> ReadPrec [NoIntersection]
-> Read NoIntersection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NoIntersection]
$creadListPrec :: ReadPrec [NoIntersection]
readPrec :: ReadPrec NoIntersection
$creadPrec :: ReadPrec NoIntersection
readList :: ReadS [NoIntersection]
$creadList :: ReadS [NoIntersection]
readsPrec :: Int -> ReadS NoIntersection
$creadsPrec :: Int -> ReadS NoIntersection
Read,NoIntersection -> NoIntersection -> Bool
(NoIntersection -> NoIntersection -> Bool)
-> (NoIntersection -> NoIntersection -> Bool) -> Eq NoIntersection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoIntersection -> NoIntersection -> Bool
$c/= :: NoIntersection -> NoIntersection -> Bool
== :: NoIntersection -> NoIntersection -> Bool
$c== :: NoIntersection -> NoIntersection -> Bool
Eq,Eq NoIntersection
Eq NoIntersection
-> (NoIntersection -> NoIntersection -> Ordering)
-> (NoIntersection -> NoIntersection -> Bool)
-> (NoIntersection -> NoIntersection -> Bool)
-> (NoIntersection -> NoIntersection -> Bool)
-> (NoIntersection -> NoIntersection -> Bool)
-> (NoIntersection -> NoIntersection -> NoIntersection)
-> (NoIntersection -> NoIntersection -> NoIntersection)
-> Ord NoIntersection
NoIntersection -> NoIntersection -> Bool
NoIntersection -> NoIntersection -> Ordering
NoIntersection -> NoIntersection -> NoIntersection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NoIntersection -> NoIntersection -> NoIntersection
$cmin :: NoIntersection -> NoIntersection -> NoIntersection
max :: NoIntersection -> NoIntersection -> NoIntersection
$cmax :: NoIntersection -> NoIntersection -> NoIntersection
>= :: NoIntersection -> NoIntersection -> Bool
$c>= :: NoIntersection -> NoIntersection -> Bool
> :: NoIntersection -> NoIntersection -> Bool
$c> :: NoIntersection -> NoIntersection -> Bool
<= :: NoIntersection -> NoIntersection -> Bool
$c<= :: NoIntersection -> NoIntersection -> Bool
< :: NoIntersection -> NoIntersection -> Bool
$c< :: NoIntersection -> NoIntersection -> Bool
compare :: NoIntersection -> NoIntersection -> Ordering
$ccompare :: NoIntersection -> NoIntersection -> Ordering
$cp1Ord :: Eq NoIntersection
Ord)

-- | The result of interesecting two geometries is a CoRec,
type Intersection g h = CoRec Identity (IntersectionOf g h)

-- | The type family specifying the list of possible result types of an
-- intersection.
type family IntersectionOf g h :: [*]

-- | Helper to produce a corec
coRec :: (a ∈ as) => a -> CoRec Identity as
coRec :: a -> CoRec Identity as
coRec = Identity a -> CoRec Identity as
forall k (a1 :: k) (b :: [k]) (a :: k -> *).
RElem a1 b (RIndex a1 b) =>
a a1 -> CoRec a b
CoRec (Identity a -> CoRec Identity as)
-> (a -> Identity a) -> a -> CoRec Identity as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
Identity

-- | Class relationship between intersectable geometric objects.
class IsIntersectableWith g h where
  intersect :: g -> h -> Intersection g h

  -- | g `intersects` h  <=> The intersection of g and h is non-empty.
  --
  -- The default implementation computes the intersection of g and h,
  -- and uses nonEmptyIntersection to determine if the intersection is
  -- non-empty.
  intersects :: g -> h -> Bool
  g
g `intersects` h
h = Identity g -> Identity h -> Intersection g h -> Bool
forall g h (proxy :: * -> *).
IsIntersectableWith g h =>
proxy g -> proxy h -> Intersection g h -> Bool
nonEmptyIntersection (g -> Identity g
forall a. a -> Identity a
Identity g
g) (h -> Identity h
forall a. a -> Identity a
Identity h
h) (Intersection g h -> Bool) -> Intersection g h -> 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

  -- | Helper to implement `intersects`.
  nonEmptyIntersection :: proxy g -> proxy h -> Intersection g h -> Bool
  {-# MINIMAL intersect, nonEmptyIntersection #-}

  default nonEmptyIntersection :: ( NoIntersection ∈ IntersectionOf g h
                                  , RecApplicative (IntersectionOf g h)
                                  )
                                  => proxy g -> proxy h -> Intersection g h -> Bool
  nonEmptyIntersection = proxy g -> proxy h -> Intersection g h -> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection


-- | When using IntersectionOf we may need some constraints that are always
-- true anyway.
type AlwaysTrueIntersection g h = RecApplicative (IntersectionOf g h)


-- | Returns True iff the result is *not* a NoIntersection
defaultNonEmptyIntersection :: forall g h proxy.
                            ( NoIntersection ∈ IntersectionOf g h
                            , RecApplicative (IntersectionOf g h)
                            )
                            => proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection :: proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection proxy g
_ proxy h
_ = Maybe NoIntersection -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe NoIntersection -> Bool)
-> (Intersection g h -> Maybe NoIntersection)
-> Intersection g h
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ts :: [*]).
NatToInt (RIndex NoIntersection ts) =>
CoRec Identity ts -> Maybe NoIntersection
forall t (ts :: [*]).
NatToInt (RIndex t ts) =>
CoRec Identity ts -> Maybe t
asA @NoIntersection