{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Polygon.Simple.Implementation
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- default implementations for simple polygons
--
--------------------------------------------------------------------------------
module HGeometry.Polygon.Simple.Implementation
  (
  -- * Polygon
    isCounterClockwise
  , toCounterClockwiseOrder
  -- * Show
  , showsPrecSimplePolygon
  -- * Read
  , readsPrecSimplePolygon
  -- * Aeson
  , toJSONSimplePolgyon, parseJSONSimplePolygon
  -- * HasSquaredEuclideanDistance
  -- , pointClosestToWithDistanceSimplePolygon
  ) where

import           Control.Lens
import           Data.Aeson
import qualified Data.Aeson as Aeson
import           Data.Aeson.Types (Parser)
import qualified Data.List.NonEmpty as NonEmpty
import           HGeometry.Polygon.Class
import           HGeometry.Polygon.Simple.Class

--------------------------------------------------------------------------------
-- * Polygon_


-- | Test if the outer boundary of the polygon is in clockwise or counter
-- clockwise order.
--
-- Note that this function is useful only for implementing fromPoints;
-- since any valid simplePolygon should be in CCW order!
--
-- running time: \( O(n) \)
isCounterClockwise :: (Num r, Eq r, SimplePolygon_ simplePolygon point r)
                   => simplePolygon -> Bool
isCounterClockwise :: forall r simplePolygon point.
(Num r, Eq r, SimplePolygon_ simplePolygon point r) =>
simplePolygon -> Bool
isCounterClockwise = (\r
x -> r
x r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r -> r
forall a. Num a => a -> a
abs r
x) (r -> Bool) -> (simplePolygon -> r) -> simplePolygon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. simplePolygon -> r
forall r simplePolygon point.
(Num r, HasOuterBoundary simplePolygon, Point_ point 2 r,
 Vertex simplePolygon ~ point) =>
simplePolygon -> r
signedArea2X

-- | Make sure that every edge has the polygon's interior on its left,
-- by orienting the outer boundary into counter-clockwise order, and
-- the inner borders (i.e. any holes, if they exist) into clockwise order.
--
-- Note that this function is useful only for implementing fromPoints;
-- since any valid simplePolygon should be in CCW order!
--
-- running time: \( O(n) \)
toCounterClockwiseOrder   :: (Num r, Eq r, SimplePolygon_ simplePolygon point r)
                          => simplePolygon -> simplePolygon
toCounterClockwiseOrder :: forall r simplePolygon point.
(Num r, Eq r, SimplePolygon_ simplePolygon point r) =>
simplePolygon -> simplePolygon
toCounterClockwiseOrder simplePolygon
pg
  | simplePolygon -> Bool
forall r simplePolygon point.
(Num r, Eq r, SimplePolygon_ simplePolygon point r) =>
simplePolygon -> Bool
isCounterClockwise simplePolygon
pg = simplePolygon
pg
  | Bool
otherwise             = NonEmpty point -> simplePolygon
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *). Foldable1 f => f point -> simplePolygon
uncheckedFromCCWPoints (NonEmpty point -> simplePolygon)
-> (simplePolygon -> NonEmpty point)
-> simplePolygon
-> simplePolygon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty point -> NonEmpty point
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse
                          (NonEmpty point -> NonEmpty point)
-> (simplePolygon -> NonEmpty point)
-> simplePolygon
-> NonEmpty point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (NonEmptyDList point) simplePolygon point
-> simplePolygon -> NonEmpty point
forall a s. Getting (NonEmptyDList a) s a -> s -> NonEmpty a
toNonEmptyOf Getting (NonEmptyDList point) simplePolygon point
(Vertex simplePolygon
 -> Const (NonEmptyDList point) (Vertex simplePolygon))
-> simplePolygon -> Const (NonEmptyDList point) simplePolygon
forall polygon.
HasOuterBoundary polygon =>
IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
IndexedTraversal1'
  (VertexIx simplePolygon) simplePolygon (Vertex simplePolygon)
outerBoundary (simplePolygon -> simplePolygon) -> simplePolygon -> simplePolygon
forall a b. (a -> b) -> a -> b
$ simplePolygon
pg

--------------------------------------------------------------------------------
-- * Show

-- | helper implementation for show
showsPrecSimplePolygon           :: ( SimplePolygon_ simplePolygon point r
                                    , Show point
                                    )
                                 => String -- ^ Polygon type name
                                 -> Int
                                 -> simplePolygon -> ShowS
showsPrecSimplePolygon :: forall simplePolygon point r.
(SimplePolygon_ simplePolygon point r, Show point) =>
String -> Int -> simplePolygon -> ShowS
showsPrecSimplePolygon String
name Int
k simplePolygon
pg = Bool -> ShowS -> ShowS
showParen (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                                     String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                     Int -> [point] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (simplePolygon
pgsimplePolygon
-> Getting (Endo [point]) simplePolygon point -> [point]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting (Endo [point]) simplePolygon point
(Vertex simplePolygon
 -> Const (Endo [point]) (Vertex simplePolygon))
-> simplePolygon -> Const (Endo [point]) simplePolygon
forall polygon.
HasOuterBoundary polygon =>
IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
IndexedTraversal1'
  (VertexIx simplePolygon) simplePolygon (Vertex simplePolygon)
outerBoundary)
  where
    app_prec :: Int
app_prec = Int
10


--------------------------------------------------------------------------------
-- * Read

-- | default implementation for readsPrec
readsPrecSimplePolygon        :: forall simplePolygon point r.
                                 ( Read point
                                 , SimplePolygon_ simplePolygon point r
                                 )
                              => String -- ^ constructor name
                              -> Int -> ReadS simplePolygon
readsPrecSimplePolygon :: forall simplePolygon point r.
(Read point, SimplePolygon_ simplePolygon point r) =>
String -> Int -> ReadS simplePolygon
readsPrecSimplePolygon String
name Int
d = Bool -> ReadS simplePolygon -> ReadS simplePolygon
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ReadS simplePolygon -> ReadS simplePolygon)
-> ReadS simplePolygon -> ReadS simplePolygon
forall a b. (a -> b) -> a -> b
$ \String
r ->
      [ (forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
uncheckedFromCCWPoints @simplePolygon @point @r (NonEmpty point -> simplePolygon)
-> NonEmpty point -> simplePolygon
forall a b. (a -> b) -> a -> b
$ [point] -> NonEmpty point
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList [point]
vs, String
t)
      | (String
name', String
s) <- ReadS String
lex String
r
      , String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name'
      , ([point]
vs, String
t) <- ReadS [point]
forall a. Read a => ReadS a
reads String
s
      ]
    where app_prec :: Int
app_prec = Int
10


--------------------------------------------------------------------------------
-- * Aeson

toJSONSimplePolgyon    :: ( ToJSON point
                          , SimplePolygon_ simplePolygon point r
                          ) => simplePolygon -> Value
toJSONSimplePolgyon :: forall point simplePolygon r.
(ToJSON point, SimplePolygon_ simplePolygon point r) =>
simplePolygon -> Value
toJSONSimplePolgyon simplePolygon
pg = [Pair] -> Value
object [ Key
"tag"      Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (String
"SimplePolygon" :: String)
                                , Key
"vertices" Key -> [point] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (simplePolygon
pgsimplePolygon
-> Getting (Endo [point]) simplePolygon point -> [point]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting (Endo [point]) simplePolygon point
(Vertex simplePolygon
 -> Const (Endo [point]) (Vertex simplePolygon))
-> simplePolygon -> Const (Endo [point]) simplePolygon
forall polygon.
HasOuterBoundary polygon =>
IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
IndexedTraversal1'
  (VertexIx simplePolygon) simplePolygon (Vertex simplePolygon)
outerBoundary)
                                ]

-- instance (FromJSON r, Eq r, Num r, FromJSON p) => FromJSON (Polygon Simple p r) where
parseJSONSimplePolygon :: forall simplePolygon point r.
                          ( FromJSON point
                          , SimplePolygon_ simplePolygon point r
                          ) => Value -> Parser simplePolygon
parseJSONSimplePolygon :: forall simplePolygon point r.
(FromJSON point, SimplePolygon_ simplePolygon point r) =>
Value -> Parser simplePolygon
parseJSONSimplePolygon = String
-> (Object -> Parser simplePolygon)
-> Value
-> Parser simplePolygon
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Polygon" ((Object -> Parser simplePolygon) -> Value -> Parser simplePolygon)
-> (Object -> Parser simplePolygon)
-> Value
-> Parser simplePolygon
forall a b. (a -> b) -> a -> b
$ \Object
o -> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag" Parser String
-> (String -> Parser simplePolygon) -> Parser simplePolygon
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                           String
"SimplePolygon" -> Object -> Parser simplePolygon
pSimple Object
o
                           (String
_ :: String)   -> String -> Parser simplePolygon
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a SimplePolygon"
  where
    pSimple :: Object -> Parser simplePolygon
pSimple Object
o = forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
uncheckedFromCCWPoints @simplePolygon @point @r (NonEmpty point -> simplePolygon)
-> ([point] -> NonEmpty point) -> [point] -> simplePolygon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [point] -> NonEmpty point
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
             ([point] -> simplePolygon)
-> Parser [point] -> Parser simplePolygon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [point]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vertices"



--------------------------------------------------------------------------------
-- * HasSquaredEuclideanDistance

{-

pointClosestToWithDistanceSimplePolygon      :: forall simplePolygon point point' r.
                                                ( SimplePolygon_ simplePolygon point r
                                                , Point_ point' 2 r
                                                , Fractional r, Ord r
                                                )
                                             => point'
                                             -> simplePolygon
                                             -> (Point 2 r, r)
pointClosestToWithDistanceSimplePolygon q poly =
    minimumBy (comparing snd)
  . map (pointClosestToWithDistance q) . id @[ClosedLineSegment 2 point r]
  $ poly^..outerBoundaryEdgeSegments

-}

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