{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Geometry.PlanarSubdivision.Basic( VertexId', FaceId'
                                            , VertexData(VertexData), PG.vData, PG.location
                                            , FaceData(FaceData), holes, fData
                                            , PlanarSubdivision(PlanarSubdivision)
                                            , Wrap
                                            , Component, ComponentId
                                            , PolygonFaceData(..)
                                            , PlanarGraph
                                            , PlaneGraph
                                            , fromSimplePolygon
                                            , fromConnectedSegments
                                            , fromPlaneGraph, fromPlaneGraph'
                                            , numComponents, numVertices
                                            , numEdges, numFaces, numDarts
                                            , dual
                                            , components, component
                                            , vertices', vertices
                                            , edges', edges
                                            , faces', faces, internalFaces
                                            , darts'
                                            
                                            , headOf, tailOf, twin, endPoints
                                            , incidentEdges, incomingEdges, outgoingEdges
                                            , nextIncidentEdge
                                            , neighboursOf
                                            , leftFace, rightFace
                                            , outerBoundaryDarts, boundaryVertices, holesOf
                                            , outerFaceId
                                            , boundary'
                                            , locationOf
                                            , HasDataOf(..)
                                            , endPointsOf, endPointData
                                            , faceDataOf
                                            , edgeSegment, edgeSegments
                                            , rawFacePolygon, rawFaceBoundary
                                            , rawFacePolygons
                                            , VertexId(..), FaceId(..), Dart, World(..)
                                            , rawVertexData, rawDartData, rawFaceData
                                            , vertexData, dartData, faceData
                                            , dataVal
                                            , dartMapping, Raw(..)
                                            ) where
import           Control.Lens hiding (holes, holesOf, (.=))
import           Data.Coerce
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Box
import           Data.Geometry.LineSegment hiding (endPoints)
import           Data.Geometry.PlanarSubdivision.Raw
import           Data.Geometry.Point
import           Data.Geometry.Polygon
import           Data.Geometry.Properties
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.PlanarGraph.Dart (allDarts,isPositive)
import qualified Data.PlaneGraph as PG
import           Data.PlaneGraph( PlaneGraph, PlanarGraph, dual
                                , Dart, VertexId(..), FaceId(..), twin
                                , World(..)
                                , VertexId', FaceId'
                                , VertexData, location, vData
                                , HasDataOf(..)
                                )
import qualified Data.Sequence as Seq
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import           GHC.Generics (Generic)
type Component s r = PlaneGraph (Wrap s)
                                (VertexId' s) (Dart s) (FaceId' s)
                                r
data PlanarSubdivision s v e f r =
  PlanarSubdivision { _components    :: V.Vector (Component s r)
                    , _rawVertexData :: V.Vector (Raw s (VertexId' (Wrap s)) v)
                    , _rawDartData   :: V.Vector (Raw s (Dart      (Wrap s)) e)
                    , _rawFaceData   :: V.Vector (RawFace s f)
                    } deriving (Show,Eq,Functor,Generic)
makeLenses ''PlanarSubdivision
type instance NumType   (PlanarSubdivision s v e f r) = r
type instance Dimension (PlanarSubdivision s v e f r) = 2
instance IsBoxable (PlanarSubdivision s v e f r) where
  boundingBox = boundingBoxList' . V.toList . _components
component    :: ComponentId s -> Lens' (PlanarSubdivision s v e f r)
                                       (Component s r)
component ci = components.singular (ix $ unCI ci)
fromPlaneGraph   :: forall s v e f r. (Ord r, Fractional r)
                      => PlaneGraph s v e f r -> PlanarSubdivision s v e f r
fromPlaneGraph g = fromPlaneGraph' g (PG.outerFaceDart g)
fromPlaneGraph'        :: forall s v e f r. PlaneGraph s v e f r -> Dart s
                       -> PlanarSubdivision s v e f r
fromPlaneGraph' g ofD = PlanarSubdivision (V.singleton . coerce $ g') vd ed fd
  where
    c = ComponentId 0
    vd = V.imap    (\i v   -> Raw c (VertexId i) v)                   $ g^.PG.vertexData
    ed = V.zipWith (\d dd  -> Raw c d dd) allDarts''                  $ g^.PG.rawDartData
    fd = V.imap (\i f      -> RawFace (mkFaceIdx i) (mkFaceData i f)) $ g^.PG.faceData
    g' :: PlaneGraph s (VertexId' s) (Dart s) (FaceId' s) r
    g' = g&PG.faceData    %~ V.imap (\i _ -> mkFaceId $ flipID i)
          &PG.vertexData  %~ V.imap (\i _ -> VertexId i)
          &PG.rawDartData .~ allDarts''
    allDarts'' :: forall s'. V.Vector (Dart s')
    allDarts'' = allDarts' (PG.numDarts g)
    
    oF@(FaceId (VertexId of')) = PG.leftFace ofD g
    mkFaceIdx i | i == 0    = Nothing
                | otherwise = Just (c,mkFaceId . flipID $ i)
    
    mkFaceData                 :: Int -> f -> FaceData (Dart s) f
    mkFaceData i f | i == 0    = FaceData (Seq.singleton ofD) (g^.dataOf oF)
                   | i == of'  = FaceData mempty              (g^.dataOf (mkFaceId @s 0))
                   | otherwise = FaceData mempty              f
    mkFaceId :: forall s'. Int -> FaceId' s'
    mkFaceId = FaceId . VertexId
    flipID i | i == 0    = of'
             | i == of'  = 0
             | otherwise = i
fromSimplePolygon            :: (Ord r, Fractional r)
                             => proxy s
                             -> SimplePolygon p r
                             -> f 
                             -> f 
                             -> PlanarSubdivision s p () f r
fromSimplePolygon p pg iD oD =
  fromPlaneGraph (PG.fromSimplePolygon p pg iD oD)
fromConnectedSegments    :: (Foldable f, Ord r, Fractional r)
                         => proxy s
                         -> f (LineSegment 2 p r :+ e)
                         -> PlanarSubdivision s (NonEmpty p) e () r
fromConnectedSegments px = fromPlaneGraph . PG.fromConnectedSegments px
data PolygonFaceData = Inside | Outside deriving (Show,Read,Eq)
numComponents :: PlanarSubdivision s v e f r  -> Int
numComponents = V.length . _components
numVertices :: PlanarSubdivision s v e f r  -> Int
numVertices = V.length . _rawVertexData
numDarts :: PlanarSubdivision s v e f r  -> Int
numDarts = V.length . _rawDartData
numEdges :: PlanarSubdivision s v e f r  -> Int
numEdges = (`div` 2) . V.length . _rawDartData
numFaces :: PlanarSubdivision s v e f r  -> Int
numFaces = V.length . _rawFaceData
vertices'   :: PlanarSubdivision s v e f r  -> V.Vector (VertexId' s)
vertices' ps = let n = numVertices ps
               in V.fromList $ map VertexId [0..n-1]
vertices    :: PlanarSubdivision s v e f r  -> V.Vector (VertexId' s, VertexData r v)
vertices ps = (\vi -> (vi,ps^.vertexDataOf vi)) <$> vertices' ps
darts' :: PlanarSubdivision s v e f r  -> V.Vector (Dart s)
darts' = allDarts' . numDarts
allDarts'   :: forall s'. Int -> V.Vector (Dart s')
allDarts' n = V.fromList $ take n allDarts
edges' :: PlanarSubdivision s v e f r  -> V.Vector (Dart s)
edges' = V.filter isPositive . darts'
edges    :: PlanarSubdivision s v e f r  -> V.Vector (Dart s, e)
edges ps = (\e -> (e,ps^.dataOf e)) <$> edges' ps
faces'    :: PlanarSubdivision s v e f r -> V.Vector (FaceId' s)
faces' ps = let n = numFaces ps
            in V.fromList $ map (FaceId . VertexId) [0..n-1]
faces    :: PlanarSubdivision s v e f r -> V.Vector (FaceId' s, FaceData (Dart s) f)
faces ps = (\fi -> (fi,ps^.faceDataOf fi)) <$> faces' ps
internalFaces    :: PlanarSubdivision s v e f r
                 -> V.Vector (FaceId' s, FaceData (Dart s) f)
internalFaces ps = V.tail $ faces ps
  
dartData :: Lens (PlanarSubdivision s v e f r) (PlanarSubdivision s v e' f r)
                 (V.Vector (Dart s, e))        (V.Vector (Dart s, e'))
dartData = lens getF setF
  where
    getF     = V.imap (\i x -> (toEnum i, x^.dataVal)) . _rawDartData
    setF ps ds' = ps&rawDartData %~ mkDS' ds'
    
    mkDS' ds' ds = V.create $ do
                     v <- MV.new (V.length ds)
                     mapM_ (assignDart ds v) ds'
                     pure v
    assignDart ds v (d,x) = let i = fromEnum d
                                y = ds V.! i
                            in MV.write v i (y&dataVal .~ x)
faceData :: Lens (PlanarSubdivision s v e f r) (PlanarSubdivision s v e f' r)
                 (V.Vector f)                  (V.Vector f')
faceData = lens getF setF
  where
    getF = fmap (^.faceDataVal.fData) . _rawFaceData
    setF ps v' = ps&rawFaceData %~ V.zipWith (\x' x -> x&faceDataVal.fData .~ x') v'
vertexData :: Lens (PlanarSubdivision s v e f r) (PlanarSubdivision s v' e f r)
                   (V.Vector v)                  (V.Vector v')
vertexData = lens getF setF
  where
    getF = fmap (^.dataVal) . _rawVertexData
    setF ps v' = ps&rawVertexData %~ V.zipWith (\x' x -> x&dataVal .~ x') v'
tailOf      :: Dart s -> PlanarSubdivision s v e f r  -> VertexId' s
tailOf d ps = let (_,d',g) = asLocalD d ps
              in g^.dataOf (PG.tailOf d' g)
headOf       :: Dart s -> PlanarSubdivision s v e f r  -> VertexId' s
headOf d ps = let (_,d',g) = asLocalD d ps
              in g^.dataOf (PG.headOf d' g)
endPoints      :: Dart s -> PlanarSubdivision s v e f r
               -> (VertexId' s, VertexId' s)
endPoints d ps = (tailOf d ps, headOf d ps)
incidentEdges                 :: VertexId' s -> PlanarSubdivision s v e f r
                              -> V.Vector (Dart s)
incidentEdges v ps=  let (_,v',g) = asLocalV v ps
                         ds       = PG.incidentEdges v' g
                     in (\d -> g^.dataOf d) <$> ds
nextIncidentEdge      :: Dart s -> PlanarSubdivision s v e f r -> Dart s
nextIncidentEdge d ps = let (_,d',g) = asLocalD d ps
                            d''      = PG.nextIncidentEdge d' g
                        in g^.dataOf d''
incomingEdges      :: VertexId' s -> PlanarSubdivision s v e f r -> V.Vector (Dart s)
incomingEdges v ps = orient <$> incidentEdges v ps
  where
    orient d = if headOf d ps == v then d else twin d
outgoingEdges      :: VertexId' s -> PlanarSubdivision s v e f r  -> V.Vector (Dart s)
outgoingEdges v ps = orient <$> incidentEdges v ps
  where
    orient d = if tailOf d ps == v then d else twin d
neighboursOf      :: VertexId' s -> PlanarSubdivision s v e f r -> V.Vector (VertexId' s)
neighboursOf v ps = flip tailOf ps <$> incomingEdges v ps
leftFace      :: Dart s -> PlanarSubdivision s v e f r  -> FaceId' s
leftFace d ps = let (_,d',g) = asLocalD d ps
                    fi       = PG.leftFace d' g
                in g^.dataOf fi
rightFace      :: Dart s -> PlanarSubdivision s v e f r  -> FaceId' s
rightFace d ps = let (_,d',g) = asLocalD d ps
                     fi       = PG.rightFace d' g
                in g^.dataOf fi
outerBoundaryDarts      :: FaceId' s -> PlanarSubdivision s v e f r  -> V.Vector (Dart s)
outerBoundaryDarts f ps = V.concatMap single . V.fromList . NonEmpty.toList $ asLocalF f ps
  where
    single (_,f',g) = (\d -> g^.dataOf d) <$> PG.boundary f' g
asLocalF                          :: FaceId' s -> PlanarSubdivision s v e f r
                                  -> NonEmpty (ComponentId s, FaceId' (Wrap s), Component s r)
asLocalF (FaceId (VertexId f)) ps = case ps^?!rawFaceData.ix f of
      RawFace (Just (ci,f')) _        -> (ci,f',ps^.component ci) :| []
      RawFace Nothing (FaceData hs _) -> toLocalF <$> NonEmpty.fromList (F.toList hs)
  where
    toLocalF d = let (ci,d',c) = asLocalD d ps in (ci,PG.leftFace d' c,c)
boundaryVertices      :: FaceId' s -> PlanarSubdivision s v e f r
                      -> V.Vector (VertexId' s)
boundaryVertices f ps = (\d -> headOf d ps) <$> outerBoundaryDarts f ps
holesOf       :: FaceId' s -> PlanarSubdivision s v e f r -> Seq.Seq (Dart s)
holesOf fi ps = ps^.faceDataOf fi.holes
asLocalD      :: Dart s -> PlanarSubdivision s v e f r
              -> (ComponentId s, Dart (Wrap s), Component s r)
asLocalD d ps = let (Raw ci d' _) = ps^?!rawDartData.ix (fromEnum d)
                in (ci,d',ps^.component ci)
asLocalV                 :: VertexId' s -> PlanarSubdivision s v e f r
                         -> (ComponentId s, VertexId' (Wrap s), Component s r)
asLocalV (VertexId v) ps = let (Raw ci v' _) = ps^?!rawVertexData.ix v
                           in (ci,v',ps^.component ci)
vertexDataOf               :: VertexId' s
                           -> Lens' (PlanarSubdivision s v e f r ) (VertexData r v)
vertexDataOf (VertexId vi) = lens get' set''
  where
    get' ps = let (Raw ci wvdi x) = ps^?!rawVertexData.ix vi
                  vd              = ps^.component ci.PG.vertexDataOf wvdi
              in vd&vData .~ x
    set'' ps x = let (Raw ci wvdi _)  = ps^?!rawVertexData.ix vi
                 in ps&rawVertexData.ix vi.dataVal                .~ (x^.vData)
                      &component ci.PG.vertexDataOf wvdi.location .~ (x^.location)
locationOf   :: VertexId' s -> Lens' (PlanarSubdivision s v e f r ) (Point 2 r)
locationOf v = vertexDataOf v.location
faceDataOf    :: FaceId' s -> Lens' (PlanarSubdivision s v e f r)
                                    (FaceData (Dart s) f)
faceDataOf fi = lens getF setF
  where
    (FaceId (VertexId i)) = fi
    getF ps = ps^?!rawFaceData.ix i.faceDataVal
    setF ps fd = ps&rawFaceData.ix i.faceDataVal .~ fd
instance HasDataOf (PlanarSubdivision s v e f r) (VertexId' s) where
  type DataOf (PlanarSubdivision s v e f r) (VertexId' s) = v
  dataOf v = vertexDataOf v.vData
instance HasDataOf (PlanarSubdivision s v e f r) (Dart s) where
  type DataOf (PlanarSubdivision s v e f r) (Dart s) = e
  dataOf d = rawDartData.singular (ix (fromEnum d)).dataVal
instance HasDataOf (PlanarSubdivision s v e f r) (FaceId' s) where
  type DataOf (PlanarSubdivision s v e f r) (FaceId' s) = f
  dataOf f = faceDataOf f.fData
endPointsOf   :: Dart s -> Getter (PlanarSubdivision s v e f r )
                                  (VertexData r v, VertexData r v)
endPointsOf d = to (endPointData d)
endPointData      :: Dart s -> PlanarSubdivision s v e f r
                  ->  (VertexData r v, VertexData r v)
endPointData d ps = let (u,v) = endPoints d ps
                    in (ps^.vertexDataOf u, ps^.vertexDataOf v)
outerFaceId :: PlanarSubdivision s v e f r -> FaceId' s
outerFaceId = const . FaceId . VertexId $ 0
  
edgeSegments    :: PlanarSubdivision s v e f r -> V.Vector (Dart s, LineSegment 2 v r :+ e)
edgeSegments ps = (\d -> (d,edgeSegment d ps)) <$> edges' ps
edgeSegment      :: Dart s -> PlanarSubdivision s v e f r -> LineSegment 2 v r :+ e
edgeSegment d ps = let (p,q) = bimap PG.vtxDataToExt PG.vtxDataToExt $ ps^.endPointsOf d
                   in ClosedLineSegment p q :+ ps^.dataOf d
boundary'     :: Dart s -> PlanarSubdivision s v e f r -> V.Vector (Dart s)
boundary' d ps = let (_,d',g) = asLocalD d ps
                 in (\d'' -> g^.dataOf d'') <$> PG.boundary' d' g
rawFaceBoundary      :: FaceId' s -> PlanarSubdivision s v e f r -> SimplePolygon v r :+ f
rawFaceBoundary i ps = fromPoints pts :+ (ps^.dataOf i)
  where
    d   = V.head $ outerBoundaryDarts i ps
    pts = (\d' -> PG.vtxDataToExt $ ps^.vertexDataOf (headOf d' ps))
       <$> V.toList (boundary' d ps)
rawFacePolygon      :: FaceId' s -> PlanarSubdivision s v e f r
                    -> SomePolygon v r :+ f
rawFacePolygon i ps = case F.toList $ holesOf i ps of
                        [] -> Left  res                               :+ x
                        hs -> Right (MultiPolygon vs $ map toHole hs) :+ x
  where
    res@(SimplePolygon vs) :+ x = rawFaceBoundary i ps
    toHole d = (rawFaceBoundary (leftFace d ps) ps)^.core
rawFacePolygons    :: PlanarSubdivision s v e f r
                   -> V.Vector (FaceId' s, SomePolygon v r :+ f)
rawFacePolygons ps = fmap (\(i,_) -> (i,rawFacePolygon i ps)) . internalFaces $ ps
dartMapping    :: PlanarSubdivision s v e f r -> V.Vector (Dart (Wrap s), Dart s)
dartMapping ps = ps^.component (ComponentId 0).PG.dartData