{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}

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

-- |
-- Module       : Data.Geospatial.Internal.Geometry.GeoPolygon
-- Copyright    : (C) 2014-2021 HS-GeoJSON Project
-- License      : BSD-style (see the file LICENSE.md)
-- Maintainer   : Andrew Newman
module Data.Geospatial.Internal.Geometry.GeoPolygon
  ( -- * Type
    GeoPolygon (..),

    -- * Lenses
    unGeoPolygon,
  )
where

import Control.DeepSeq
import Control.Lens (makeLenses)
import Control.Monad (mzero)
import qualified Data.Aeson as Aeson
import Data.Geospatial.Internal.BasicTypes
import Data.Geospatial.Internal.Geometry.Aeson
import qualified Data.LinearRing as LinearRing
import qualified Data.Sequence as Sequence
import GHC.Generics (Generic)

newtype GeoPolygon = GeoPolygon {GeoPolygon -> Seq (LinearRing GeoPositionWithoutCRS)
_unGeoPolygon :: Sequence.Seq (LinearRing.LinearRing GeoPositionWithoutCRS)} deriving (Int -> GeoPolygon -> ShowS
[GeoPolygon] -> ShowS
GeoPolygon -> String
(Int -> GeoPolygon -> ShowS)
-> (GeoPolygon -> String)
-> ([GeoPolygon] -> ShowS)
-> Show GeoPolygon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeoPolygon] -> ShowS
$cshowList :: [GeoPolygon] -> ShowS
show :: GeoPolygon -> String
$cshow :: GeoPolygon -> String
showsPrec :: Int -> GeoPolygon -> ShowS
$cshowsPrec :: Int -> GeoPolygon -> ShowS
Show, GeoPolygon -> GeoPolygon -> Bool
(GeoPolygon -> GeoPolygon -> Bool)
-> (GeoPolygon -> GeoPolygon -> Bool) -> Eq GeoPolygon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeoPolygon -> GeoPolygon -> Bool
$c/= :: GeoPolygon -> GeoPolygon -> Bool
== :: GeoPolygon -> GeoPolygon -> Bool
$c== :: GeoPolygon -> GeoPolygon -> Bool
Eq, (forall x. GeoPolygon -> Rep GeoPolygon x)
-> (forall x. Rep GeoPolygon x -> GeoPolygon) -> Generic GeoPolygon
forall x. Rep GeoPolygon x -> GeoPolygon
forall x. GeoPolygon -> Rep GeoPolygon x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GeoPolygon x -> GeoPolygon
$cfrom :: forall x. GeoPolygon -> Rep GeoPolygon x
Generic, GeoPolygon -> ()
(GeoPolygon -> ()) -> NFData GeoPolygon
forall a. (a -> ()) -> NFData a
rnf :: GeoPolygon -> ()
$crnf :: GeoPolygon -> ()
NFData)

-- Sequence.Seq (LinearRing.LinearRing DoubleArray)

makeLenses ''GeoPolygon

-- instances

instance Aeson.ToJSON GeoPolygon where
  --  toJSON :: a -> Value
  toJSON :: GeoPolygon -> Value
toJSON = String -> Seq (LinearRing GeoPositionWithoutCRS) -> Value
forall a. ToJSON a => String -> a -> Value
makeGeometryGeoAeson String
"Polygon" (Seq (LinearRing GeoPositionWithoutCRS) -> Value)
-> (GeoPolygon -> Seq (LinearRing GeoPositionWithoutCRS))
-> GeoPolygon
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeoPolygon -> Seq (LinearRing GeoPositionWithoutCRS)
_unGeoPolygon

instance Aeson.FromJSON GeoPolygon where
  --  parseJSON :: Value -> Parser a
  parseJSON :: Value -> Parser GeoPolygon
parseJSON (Aeson.Object Object
o) = String
-> (Seq (LinearRing GeoPositionWithoutCRS) -> GeoPolygon)
-> Object
-> Parser GeoPolygon
forall a b.
(FromJSON a, FromJSON b) =>
String -> (a -> b) -> Object -> Parser b
readGeometryGeoAeson String
"Polygon" Seq (LinearRing GeoPositionWithoutCRS) -> GeoPolygon
GeoPolygon Object
o
  parseJSON Value
_ = Parser GeoPolygon
forall (m :: * -> *) a. MonadPlus m => m a
mzero