{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE TemplateHaskell #-}
-------------------------------------------------------------------
-- |
-- Module       : Data.Geospatial.Internal.Geometry.GeoPolygon
-- Copyright    : (C) 2014-2019 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