```{-# LANGUAGE TemplateHaskell  #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveAnyClass #-}
module Data.Geometry.HalfLine where

import           Control.DeepSeq
import           Control.Lens
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Interval
import           Data.Geometry.Line
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.SubLine
import           Data.Geometry.Transformation
import           Data.Geometry.Vector
import qualified Data.Traversable as T
import           Data.UnBounded
import           GHC.Generics (Generic)
import           GHC.TypeLits

--------------------------------------------------------------------------------
-- * \(d\)-dimensional Half-Lines

-- | \(d\)-dimensional Half-Lines
data HalfLine d r = HalfLine { _startPoint        :: Point  d r
, _halfLineDirection :: Vector d r
} deriving Generic
makeLenses ''HalfLine

deriving instance (Show r, Arity d)   => Show    (HalfLine d r)
deriving instance (NFData r, Arity d) => NFData  (HalfLine d r)

deriving instance Arity d           => Functor (HalfLine d)
deriving instance Arity d           => F.Foldable    (HalfLine d)
deriving instance Arity d           => T.Traversable (HalfLine d)

type instance Dimension (HalfLine d r) = d
type instance NumType   (HalfLine d r) = r

instance (Eq r, Fractional r, Arity d) => Eq (HalfLine d r) where
(HalfLine p u) == (HalfLine q v) = let lam = scalarMultiple u v
in p == q && (signum <\$> lam) == Just 1

instance HasStart (HalfLine d r) where
type StartCore  (HalfLine d r) = Point d r
type StartExtra (HalfLine d r) = ()

start = lens ((:+ ()) . _startPoint) (\(HalfLine _ v) p -> HalfLine (p^.core) v)

instance HasSupportingLine (HalfLine d r) where
supportingLine ~(HalfLine p v) = Line p v

-- Half-Lines are transformable
instance (Fractional r, Arity d, Arity (d + 1)) => IsTransformable (HalfLine d r) where
transformBy t = toHalfLine . transformPointFunctor t . toLineSegment'
where
toLineSegment' :: (Num r, Arity d) => HalfLine d r -> LineSegment d () r
toLineSegment' (HalfLine p v) = ClosedLineSegment (p :+ ()) ((p .+^ v) :+ ())

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

halfLineToSubLine                :: (Arity d, Num r)
=> HalfLine d r -> SubLine d () (UnBounded r) r
halfLineToSubLine (HalfLine p v) = let l = Line p v
in SubLine l (Interval (Closed \$ ext (Val 0))
(Open   \$ ext MaxInfinity))

fromSubLine               :: (Num r, Arity d) => SubLine d p (UnBounded r) r
-> Maybe (HalfLine d r)
fromSubLine (SubLine l i) = case (i^.start.core, i^.end.core) of
(Val x, MaxInfinity) -> Just \$ HalfLine (pointAt x l) (l^.direction)
(MinInfinity, Val x) -> Just \$ HalfLine (pointAt x l) ((-1) *^ l^.direction)
_                    -> Nothing

type instance IntersectionOf (HalfLine 2 r) (Line 2 r) = [ NoIntersection
, Point 2 r
, HalfLine 2 r
]

type instance IntersectionOf (HalfLine 2 r) (HalfLine 2 r) = [ NoIntersection
, Point 2 r
, LineSegment 2 () r
, HalfLine 2 r
]

type instance IntersectionOf (HalfLine 2 r) (LineSegment 2 p r) = [ NoIntersection
, Point 2 r
, LineSegment 2 () r
]

-- instance (Ord r, Fractional r) => (HalfLine 2 r) `IsIntersectableWith` (Line 2 r) where
-- hl `intersect` l = match (halfLineToSubLine hl, l)

-- instance (Ord r, Fractional r) => (HalfLine 2 r) `IsIntersectableWith` (Line 2 r) where
--   data Intersection (HalfLine 2 r) (Line 2 r) = NoHalfLineLineIntersection
--                                               | HalfLineLineIntersection !(Point 2 r)
--                                               | HalfLineLineOverlap      !(HalfLine 2 r)
--                                               deriving (Show,Eq)

--   nonEmptyIntersection NoHalfLineLineIntersection = False
--   nonEmptyIntersection _                          = True

--   hl `intersect` l = case supportingLine hl `intersect` l of
--     SameLine _             -> HalfLineLineOverlap hl
--     LineLineIntersection p -> if p `onHalfLine` hl then HalfLineLineIntersection p
--                                                    else NoHalfLineLineIntersection
--     ParallelLines          -> NoHalfLineLineIntersection

-- instance (Ord r, Fractional r) => (HalfLine 2 r) `IsIntersectableWith` (HalfLine 2 r) where
--   data Intersection (HalfLine 2 r) (HalfLine 2 r) = NoHalfLineHalfLineIntersection
--                                                   | HLHLIntersectInPoint    !(Point 2 r)
--                                                   | HLHLIntersectInSegment  !(LineSegment 2 () r)
--                                                   | HLHLIntersectInHalfLine !(HalfLine 2 r)
--                                                   deriving (Show,Eq)

--   nonEmptyIntersection NoHalfLineHalfLineIntersection = False
--   nonEmptyIntersection _                              = True

--   hl' `intersect` hl = case supportingLine hl' `intersect` supportingLine hl of
--     ParallelLines          -> NoHalfLineHalfLineIntersection
--     LineLineIntersection p -> if p `onHalfLine` hl' && p `onHalfLine` hl then HLHLIntersectInPoint p
--                                                                          else NoHalfLineHalfLineIntersection
--     SameLine _             -> let p   = _startPoint hl'
--                                   q   = _startPoint hl
--                                   seg = LineSegment (p :+ ()) (q :+ ())
--                               in case (p `onHalfLine` hl, q `onHalfLine` hl') of
--                                    (False,False) -> NoHalfLineHalfLineIntersection
--                                    (False,True)  -> HLHLIntersectInHalfLine hl
--                                    (True, False) -> HLHLIntersectInHalfLine hl'
--                                    (True, True)  -> if hl == hl' then HLHLIntersectInHalfLine hl
--                                                                  else HLHLIntersectInSegment seg

-- instance (Ord r, Fractional r) => (LineSegment 2 p r) `IsIntersectableWith` (HalfLine 2 r) where
--   data Intersection (LineSegment 2 p r) (HalfLine 2 r) = NoSegmentHalfLineIntersection
--                                                        | SegmentHalfLineIntersection !(Point 2 r)
--                                                        | SegmentOnHalfLine           !(LineSegment 2 () r)

--   nonEmptyIntersection NoSegmentHalfLineIntersection = False
--   nonEmptyIntersection _                             = True

--   s `intersect` hl = case supportingLine s `intersect` supportingLine hl of
--     ParallelLines          -> NoSegmentHalfLineIntersection
--     LineLineIntersection p -> if p `onSegment` s && p `onHalfLine` hl then SegmentHalfLineIntersection p
--                                                                       else NoSegmentHalfLineIntersection
--     SameLine _             -> let p = s  ^.start.core
--                                   q = s  ^.end.core
--                                   r = hl ^.start.core
--                                   seg a b = LineSegment (a :+ ()) (b :+ ())
--                               in case (p `onHalfLine` hl, q `onHalfLine` hl) of
--                                    (False, False)   -> NoSegmentHalfLineIntersection
--                                    (False, True)    -> SegmentOnHalfLine \$ seg r q
--                                    (True,  False)   -> SegmentOnHalfLine \$ seg p r
--                                    (True,  True)    -> SegmentOnHalfLine \$ seg p q

-- | Test if a point lies on a half-line
onHalfLine :: (Ord r, Fractional r, Arity d) => Point d r -> HalfLine d r -> Bool
p `onHalfLine` (HalfLine q v) = maybe False (>= 0) \$ scalarMultiple (p .-. q) v

-- | Transform a LineSegment into a half-line, by forgetting the second endpoint.
-- Note that this also forgets about if the starting point was open or closed.
toHalfLine   :: (Num r, Arity d) => LineSegment d p r -> HalfLine d r
toHalfLine s = let p = s^.start.core
q = s^.end.core
in HalfLine p (q .-. p)
```