{-|
[Constructive Solid Geometry \(CSG\)](https://en.wikipedia.org/wiki/Constructive_solid_geometry) operations on `Solid`, and `Shape`.
-}
module Waterfall.Booleans
( union3D
, difference3D
, intersection3D
, complement
, unions3D
, intersections3D
, Boolean(..)
) where

import Waterfall.Internal.Solid(union3D, unions3D, difference3D, intersection3D, intersections3D, complement)
import qualified Waterfall.Solids as Solids
import qualified Waterfall.TwoD.Internal.Shape as Shape
import Waterfall.TwoD.Internal.Shape (union2D, difference2D, intersection2D, unions2D, intersections2D)

-- | Boolean Algebras, with an "empty" value.
class Boolean a where
    -- | Take the union of two objects
    -- 
    -- The region occupied by either one of them.
    union :: a -> a -> a
    
    -- | Take the difference of two objects
    -- 
    -- The region occupied by the first, but not the second.
    difference :: a -> a -> a
    
    -- | Take the intersection of two objects
    --
    -- The region occupied by both of them.
    intersection :: a -> a -> a
    
    -- | The empty object (identity for union, annihilator for intersection)
    --
    -- Represents a region of space containing no volume or area.
    --
    -- For union: @empty `union` x = x `union` empty = x@
    -- For intersection: @empty `intersection` x = x `intersection` empty = empty@
    empty :: a
    
    -- | Take the union of a list of objects
    --
    -- May be more performant than chaining multiple applications of `union`.
    unions :: [a] -> a
    unions = (a -> a -> a) -> a -> [a] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall a. Boolean a => a -> a -> a
union a
forall a. Boolean a => a
empty
    
    -- | Take the intersection of a list of objects
    --
    -- May be more performant than chaining multiple applications of `intersection`.
    intersections :: [a] -> a
    intersections [] = a
forall a. Boolean a => a
empty
    intersections [a]
xs = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
forall a. Boolean a => a -> a -> a
intersection [a]
xs

instance Boolean Solids.Solid where
    union :: Solid -> Solid -> Solid
union = Solid -> Solid -> Solid
union3D
    difference :: Solid -> Solid -> Solid
difference = Solid -> Solid -> Solid
difference3D
    intersection :: Solid -> Solid -> Solid
intersection = Solid -> Solid -> Solid
intersection3D
    empty :: Solid
empty = Solid
Solids.emptySolid
    unions :: [Solid] -> Solid
unions = [Solid] -> Solid
unions3D
    intersections :: [Solid] -> Solid
intersections = [Solid] -> Solid
intersections3D

instance Boolean Shape.Shape where
    union :: Shape -> Shape -> Shape
union = Shape -> Shape -> Shape
union2D
    difference :: Shape -> Shape -> Shape
difference = Shape -> Shape -> Shape
difference2D
    intersection :: Shape -> Shape -> Shape
intersection = Shape -> Shape -> Shape
intersection2D
    empty :: Shape
empty = Shape
Shape.emptyShape
    unions :: [Shape] -> Shape
unions = [Shape] -> Shape
unions2D
    intersections :: [Shape] -> Shape
intersections = [Shape] -> Shape
intersections2D