--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.HalfSpace.Class
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Class for modelling Halfspaces
--
--------------------------------------------------------------------------------
{-# LANGUAGE UndecidableInstances #-}
module HGeometry.HalfSpace.Class
  ( HalfSpace_(..)
  , HalfPlane_
  , inHalfSpace
  ) where

import Control.Lens
import HGeometry.Ext
import HGeometry.Properties (NumType, Dimension)
import HGeometry.Sign
import HGeometry.Point.Class
import HGeometry.Boundary
import HGeometry.HyperPlane.Class

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

-- | Types modelling halfspaces.
class ( Dimension halfSpace ~ d, Dimension (BoundingHyperPlane halfSpace d r) ~ d
      , NumType halfSpace ~ r,   NumType (BoundingHyperPlane halfSpace d r) ~ r
      )
       => HalfSpace_ halfSpace d r | halfSpace -> d,
                                     halfSpace -> r where
  type BoundingHyperPlane halfSpace d r
  -- removed the 'HyperPlane_' constraint on BoundingHyperPlane. Since at least in R^1
  -- it's useful to not have it.
  -- HyperPlane_ (BoundingHyperPlane halfSpace d r) d r

  -- | Access the bounding hyperplane
  boundingHyperPlane :: Lens' halfSpace (BoundingHyperPlane halfSpace d r)

  -- | Lens to access the sign of the halfspace.
  halfSpaceSign :: Lens' halfSpace Sign

-- | Type synonym for halfplanes in R^2
type HalfPlane_ halfPlane r = HalfSpace_ halfPlane 2 r


-- class Line_ (BoundingLine halfPlane r) 2 r
--       => HalfPlane_ halfPlane r | halfPlane -> r where
--   type BoundingLine halfPlane r

--   -- | Lens to access the boundin gline of a halfspace
--   boundingLine :: Lens' halfPlane (BoundingLine halfPlane r)

--   -- | Get the normal vector into the halfplane
--   normalIntoHalfPlane :: halfPlane -> Vector 2 r

instance HalfSpace_ core d r => HalfSpace_ (core :+ extra) d r where
  type BoundingHyperPlane (core :+ extra) d r = BoundingHyperPlane core d r
  boundingHyperPlane :: Lens' (core :+ extra) (BoundingHyperPlane (core :+ extra) d r)
boundingHyperPlane = (core -> f core) -> (core :+ extra) -> f (core :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((core -> f core) -> (core :+ extra) -> f (core :+ extra))
-> ((BoundingHyperPlane core d r
     -> f (BoundingHyperPlane core d r))
    -> core -> f core)
-> (BoundingHyperPlane core d r -> f (BoundingHyperPlane core d r))
-> (core :+ extra)
-> f (core :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BoundingHyperPlane core d r -> f (BoundingHyperPlane core d r))
-> core -> f core
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens' core (BoundingHyperPlane core d r)
boundingHyperPlane
  halfSpaceSign :: Lens' (core :+ extra) Sign
halfSpaceSign = (core -> f core) -> (core :+ extra) -> f (core :+ extra)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core((core -> f core) -> (core :+ extra) -> f (core :+ extra))
-> ((Sign -> f Sign) -> core -> f core)
-> (Sign -> f Sign)
-> (core :+ extra)
-> f (core :+ extra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Sign -> f Sign) -> core -> f core
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace Sign
Lens' core Sign
halfSpaceSign



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


-- | Test if a point lies inside a halfspace
inHalfSpace     :: ( Point_ point d r, Ord r, Num r
                   , HalfSpace_ halfSpace d r
                   , HyperPlane_ (BoundingHyperPlane halfSpace d r) d r
                   )
                => point -> halfSpace -> PointLocationResult
inHalfSpace :: forall point (d :: Nat) r halfSpace.
(Point_ point d r, Ord r, Num r, HalfSpace_ halfSpace d r,
 HyperPlane_ (BoundingHyperPlane halfSpace d r) d r) =>
point -> halfSpace -> PointLocationResult
inHalfSpace point
q halfSpace
h = case point
q point -> BoundingHyperPlane halfSpace d r -> Ordering
forall point.
(Point_ point d r, Ord r, Num r) =>
point -> BoundingHyperPlane halfSpace d r -> Ordering
forall hyperPlane (d :: Nat) r point.
(HyperPlane_ hyperPlane d r, Point_ point d r, Ord r, Num r) =>
point -> hyperPlane -> Ordering
`onSideTest` (halfSpace
hhalfSpace
-> Getting
     (BoundingHyperPlane halfSpace d r)
     halfSpace
     (BoundingHyperPlane halfSpace d r)
-> BoundingHyperPlane halfSpace d r
forall s a. s -> Getting a s a -> a
^.Getting
  (BoundingHyperPlane halfSpace d r)
  halfSpace
  (BoundingHyperPlane halfSpace d r)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
boundingHyperPlane) of
                    Ordering
LT -> case halfSpace
hhalfSpace -> Getting Sign halfSpace Sign -> Sign
forall s a. s -> Getting a s a -> a
^.Getting Sign halfSpace Sign
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace Sign
Lens' halfSpace Sign
halfSpaceSign of
                            Sign
Negative -> PointLocationResult
Inside
                            Sign
Positive -> PointLocationResult
Outside
                    Ordering
GT -> case halfSpace
hhalfSpace -> Getting Sign halfSpace Sign -> Sign
forall s a. s -> Getting a s a -> a
^.Getting Sign halfSpace Sign
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace Sign
Lens' halfSpace Sign
halfSpaceSign of
                            Sign
Negative -> PointLocationResult
Outside
                            Sign
Positive -> PointLocationResult
Inside
                    Ordering
EQ -> PointLocationResult
OnBoundary