module Data.Geometry.Polygon.Core( PolygonType(..)
                                 , Polygon(..)
                                 , _SimplePolygon, _MultiPolygon
                                 , SimplePolygon, MultiPolygon, SomePolygon
                                 , fromPoints
                                 , polygonVertices, listEdges
                                 , outerBoundary, outerBoundaryEdges
                                 , outerVertex, outerBoundaryEdge
                                 , polygonHoles, polygonHoles'
                                 , holeList
                                 , inPolygon, insidePolygon, onBoundary
                                 , area, signedArea
                                 , centroid
                                 , pickPoint
                                 , isTriangle
                                 , isCounterClockwise
                                 , toCounterClockWiseOrder, toCounterClockWiseOrder'
                                 , toClockwiseOrder, toClockwiseOrder'
                                 , reverseOuterBoundary
                                 , findDiagonal
                                 , withIncidentEdges, numberVertices
                                 , asSimplePolygon
                                 ) where
import           Control.DeepSeq
import           Control.Lens hiding (Simple)
import           Data.Bifoldable
import           Data.Bifunctor
import           Data.Bitraversable
import qualified Data.CircularSeq as C
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Boundary
import           Data.Geometry.Box
import           Data.Geometry.Line
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.Transformation
import           Data.Geometry.Triangle (Triangle(..), inTriangle)
import           Data.Geometry.Vector
import qualified Data.List as List
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe (mapMaybe, catMaybes)
import           Data.Ord (comparing)
import           Data.Semigroup (sconcat)
import           Data.Semigroup.Foldable
import qualified Data.Sequence as Seq
import           Data.Util
import           Data.Vinyl.CoRec (asA)
data PolygonType = Simple | Multi
data Polygon (t :: PolygonType) p r where
  SimplePolygon :: C.CSeq (Point 2 r :+ p)                         -> Polygon Simple p r
  MultiPolygon  :: C.CSeq (Point 2 r :+ p) -> [Polygon Simple p r] -> Polygon Multi  p r
_SimplePolygon :: Prism' (Polygon Simple p r) (C.CSeq (Point 2 r :+ p))
_SimplePolygon = prism' SimplePolygon (\(SimplePolygon vs) -> Just vs)
_MultiPolygon :: Prism' (Polygon Multi p r) (C.CSeq (Point 2 r :+ p), [Polygon Simple p r])
_MultiPolygon = prism' (uncurry MultiPolygon) (\(MultiPolygon vs hs) -> Just (vs,hs))
instance Bifunctor (Polygon t) where
  bimap = bimapDefault
instance Bifoldable (Polygon t) where
  bifoldMap = bifoldMapDefault
instance Bitraversable (Polygon t) where
  bitraverse f g p = case p of
    SimplePolygon vs   -> SimplePolygon <$> bitraverseVertices f g vs
    MultiPolygon vs hs -> MultiPolygon  <$> bitraverseVertices f g vs
                                        <*> traverse (bitraverse f g) hs
instance (NFData p, NFData r) => NFData (Polygon t p r) where
  rnf (SimplePolygon vs)   = rnf vs
  rnf (MultiPolygon vs hs) = rnf (vs,hs)
bitraverseVertices     :: (Applicative f, Traversable t) => (p -> f q) -> (r -> f s)
                  -> t (Point 2 r :+ p) -> f (t (Point 2 s :+ q))
bitraverseVertices f g = traverse (bitraverse (traverse g) f)
type SimplePolygon = Polygon Simple
type MultiPolygon  = Polygon Multi
type SomePolygon p r = Either (Polygon Simple p r) (Polygon Multi p r)
type instance Dimension (SomePolygon p r) = 2
type instance NumType   (SomePolygon p r) = r
type instance Dimension (Polygon t p r) = 2
type instance NumType   (Polygon t p r) = r
instance (Show p, Show r) => Show (Polygon t p r) where
  show (SimplePolygon vs)   = "SimplePolygon (" <> show vs <> ")"
  show (MultiPolygon vs hs) = "MultiPolygon (" <> show vs <> ") (" <> show hs <> ")"
instance (Eq p, Eq r) => Eq (Polygon t p r) where
  (SimplePolygon vs)   == (SimplePolygon vs')    = vs == vs'
  (MultiPolygon vs hs) == (MultiPolygon vs' hs') = vs == vs' && hs == hs'
instance PointFunctor (Polygon t p) where
  pmap f (SimplePolygon vs)   = SimplePolygon (fmap (first f) vs)
  pmap f (MultiPolygon vs hs) = MultiPolygon  (fmap (first f) vs) (map (pmap f) hs)
instance Fractional r => IsTransformable (Polygon t p r) where
  transformBy = transformPointFunctor
instance IsBoxable (Polygon t p r) where
  boundingBox = boundingBoxList' . toListOf (outerBoundary.traverse.core)
type instance IntersectionOf (Line 2 r) (Boundary (Polygon t p r)) =
  '[Seq.Seq (Either (Point 2 r) (LineSegment 2 () r))]
type instance IntersectionOf (Point 2 r) (Polygon t p r) = [NoIntersection, Point 2 r]
instance (Fractional r, Ord r) => (Point 2 r) `IsIntersectableWith` (Polygon t p r) where
  nonEmptyIntersection = defaultNonEmptyIntersection
  q `intersects` pg = q `inPolygon` pg /= Outside
  q `intersect` pg | q `intersects` pg = coRec q
                   | otherwise         = coRec NoIntersection
  
  
  
  
  
  
  
outerBoundary :: forall t p r. Lens' (Polygon t p r) (C.CSeq (Point 2 r :+ p))
outerBoundary = lens g s
  where
    g                     :: Polygon t p r -> C.CSeq (Point 2 r :+ p)
    g (SimplePolygon vs)  = vs
    g (MultiPolygon vs _) = vs
    s                           :: Polygon t p r -> C.CSeq (Point 2 r :+ p)
                                -> Polygon t p r
    s (SimplePolygon _)      vs = SimplePolygon vs
    s (MultiPolygon  _   hs) vs = MultiPolygon vs hs
polygonHoles :: forall p r. Lens' (Polygon Multi p r) [Polygon Simple p r]
polygonHoles = lens g s
  where
    g                     :: Polygon Multi p r -> [Polygon Simple p r]
    g (MultiPolygon _ hs) = hs
    s                     :: Polygon Multi p r -> [Polygon Simple p r]
                          -> Polygon Multi p r
    s (MultiPolygon vs _) = MultiPolygon vs
polygonHoles' :: Traversal' (Polygon t p r) [Polygon Simple p r]
polygonHoles' = \f -> \case
  p@(SimplePolygon _)  -> pure p
  (MultiPolygon vs hs) -> MultiPolygon vs <$> f hs
outerVertex   :: Int -> Lens' (Polygon t p r) (Point 2 r :+ p)
outerVertex i = outerBoundary.C.item i
outerBoundaryEdge     :: Int -> Polygon t p r -> LineSegment 2 p r
outerBoundaryEdge i p = let u = p^.outerVertex i
                            v = p^.outerVertex (i+1)
                        in LineSegment (Closed u) (Open v)
holeList                     :: Polygon t p r -> [Polygon Simple p r]
holeList (SimplePolygon _)   = []
holeList (MultiPolygon _ hs) = hs
polygonVertices                      :: Polygon t p r
                                     -> NonEmpty.NonEmpty (Point 2 r :+ p)
polygonVertices (SimplePolygon vs)   = toNonEmpty vs
polygonVertices (MultiPolygon vs hs) =
  sconcat $ toNonEmpty vs NonEmpty.:| map polygonVertices hs
fromPoints :: [Point 2 r :+ p] -> SimplePolygon p r
fromPoints = SimplePolygon . C.fromList
outerBoundaryEdges :: Polygon t p r -> C.CSeq (LineSegment 2 p r)
outerBoundaryEdges = toEdges . (^.outerBoundary)
listEdges    :: Polygon t p r -> [LineSegment 2 p r]
listEdges pg = let f = F.toList . outerBoundaryEdges
               in  f pg <> concatMap f (holeList pg)
withIncidentEdges                    :: Polygon t p r
                                     -> Polygon t (Two (LineSegment 2 p r)) r
withIncidentEdges (SimplePolygon vs) =
      SimplePolygon $ C.zip3LWith f (C.rotateL vs) vs (C.rotateR vs)
  where
    f p c n = c&extra .~ SP (ClosedLineSegment p c) (ClosedLineSegment c n)
withIncidentEdges (MultiPolygon vs hs) = MultiPolygon vs' hs'
  where
    (SimplePolygon vs') = withIncidentEdges $ SimplePolygon vs
    hs' = map withIncidentEdges hs
toEdges    :: C.CSeq (Point 2 r :+ p) -> C.CSeq (LineSegment 2 p r)
toEdges vs = C.zipLWith (\p q -> LineSegment (Closed p) (Open q)) vs (C.rotateR vs)
  
  
onBoundary        :: (Fractional r, Ord r) => Point 2 r -> Polygon t p r -> Bool
q `onBoundary` pg = any (q `onSegment`) es
  where
    out = SimplePolygon $ pg^.outerBoundary
    es = concatMap (F.toList . outerBoundaryEdges) $ out : holeList pg
inPolygon                                :: forall t p r. (Fractional r, Ord r)
                                         => Point 2 r -> Polygon t p r
                                         -> PointLocationResult
q `inPolygon` pg
    | q `onBoundary` pg                             = OnBoundary
    | odd kl && odd kr && not (any (q `inHole`) hs) = Inside
    | otherwise                                     = Outside
  where
    l = horizontalLine $ q^.yCoord
    
    
    intersectionPoint = asA @(Point 2 r) . (`intersect` l)
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    SP kl kr = count (\p -> (p^.xCoord) `compare` (q^.xCoord))
             . mapMaybe intersectionPoint . F.toList . outerBoundaryEdges $ pg
    
    inHole = insidePolygon
    hs     = holeList pg
    count   :: (a -> Ordering) -> [a] -> SP Int Int
    count f = foldr (\x (SP lts gts) -> case f x of
                             LT -> SP (lts + 1) gts
                             EQ -> SP lts       gts
                             GT -> SP lts       (gts + 1)) (SP 0 0)
insidePolygon        :: (Fractional r, Ord r) => Point 2 r -> Polygon t p r -> Bool
q `insidePolygon` pg = q `inPolygon` pg == Inside
area                        :: Fractional r => Polygon t p r -> r
area poly@(SimplePolygon _) = abs $ signedArea poly
area (MultiPolygon vs hs)   = area (SimplePolygon vs) - sum [area h | h <- hs]
signedArea      :: Fractional r => SimplePolygon p r -> r
signedArea poly = x / 2
  where
    x = sum [ p^.core.xCoord * q^.core.yCoord - q^.core.xCoord * p^.core.yCoord
            | LineSegment' p q <- F.toList $ outerBoundaryEdges poly  ]
centroid      :: Fractional r => SimplePolygon p r -> Point 2 r
centroid poly = Point $ sum' xs ^/ (6 * signedArea poly)
  where
    xs = [ (toVec p ^+^ toVec q) ^* (p^.xCoord * q^.yCoord - q^.xCoord * p^.yCoord)
         | LineSegment' (p :+ _) (q :+ _) <- F.toList $ outerBoundaryEdges poly  ]
    sum' = F.foldl' (^+^) zero
pickPoint    :: (Ord r, Fractional r) => Polygon p t r -> Point 2 r
pickPoint pg | isTriangle pg = centroid . SimplePolygon $ pg^.outerBoundary
             | otherwise     = let LineSegment' (p :+ _) (q :+ _) = findDiagonal pg
                               in p .+^ (0.5 *^ (q .-. p))
isTriangle :: Polygon p t r -> Bool
isTriangle = \case
    SimplePolygon vs   -> go vs
    MultiPolygon vs [] -> go vs
    MultiPolygon _  _  -> False
  where
    go vs = case toNonEmpty vs of
              (_ :| [_,_]) -> True
              _            -> False
findDiagonal    :: (Ord r, Fractional r) => Polygon t p r -> LineSegment 2 p r
findDiagonal pg = List.head . catMaybes . F.toList $ diags
     
  where
    vs      = pg^.outerBoundary
    diags   = C.zip3LWith f (C.rotateL vs) vs (C.rotateR vs)
    f u v w = case ccw (u^.core) (v^.core) (w^.core) of
                CCW      -> Just $ findDiag u v w
                            
                            
                            
                CW       -> Nothing 
                CoLinear -> Nothing 
    
    
    
    
    
    
    
    findDiag u v w = let t  = Triangle u v w
                         uw = ClosedLineSegment u w
                     in maybe uw (ClosedLineSegment v)
                      . safeMaximumOn (distTo $ supportingLine uw)
                      . filter (\(z :+ _) -> z `inTriangle` t == Inside)
                      . F.toList . polygonVertices
                      $ pg
    distTo l (z :+ _) = sqDistanceTo z l
safeMaximumOn   :: Ord b => (a -> b) -> [a] -> Maybe a
safeMaximumOn f = \case
  [] -> Nothing
  xs -> Just $ List.maximumBy (comparing f) xs
isCounterClockwise :: (Eq r, Fractional r) => Polygon t p r -> Bool
isCounterClockwise = (\x -> x == abs x) . signedArea
                   . fromPoints . F.toList . (^.outerBoundary)
toClockwiseOrder   :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
toClockwiseOrder p = (toClockwiseOrder' p)&polygonHoles'.traverse %~ toCounterClockWiseOrder'
toClockwiseOrder'   :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
toClockwiseOrder' pg
      | isCounterClockwise pg = reverseOuterBoundary pg
      | otherwise             = pg
toCounterClockWiseOrder   :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
toCounterClockWiseOrder p =
  (toCounterClockWiseOrder' p)&polygonHoles'.traverse %~ toClockwiseOrder'
toCounterClockWiseOrder'   :: (Eq r, Fractional r) => Polygon t p r -> Polygon t p r
toCounterClockWiseOrder' p
      | not $ isCounterClockwise p = reverseOuterBoundary p
      | otherwise                  = p
reverseOuterBoundary   :: Polygon t p r -> Polygon t p r
reverseOuterBoundary p = p&outerBoundary %~ C.reverseDirection
asSimplePolygon                        :: Polygon t p r -> SimplePolygon p r
asSimplePolygon poly@(SimplePolygon _) = poly
asSimplePolygon (MultiPolygon vs _)    = SimplePolygon vs
numberVertices :: Polygon t p r -> Polygon t (SP Int p) r
numberVertices = snd . bimapAccumL (\a p -> (a+1,SP a p)) (\a r -> (a,r)) 0