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

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

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

    -- * Lenses
    unGeoMultiPolygon,

    -- * To Polygons
    splitGeoMultiPolygon,
    mergeGeoPolygons,
  )
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 Data.Geospatial.Internal.Geometry.GeoPolygon as GeoPolygon
import qualified Data.LinearRing as LinearRing
import qualified Data.Sequence as Sequence
import GHC.Generics (Generic)

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

-- | Split GeoMultiPolygon coordinates into multiple GeoPolygons
splitGeoMultiPolygon :: GeoMultiPolygon -> Sequence.Seq GeoPolygon
splitGeoMultiPolygon :: GeoMultiPolygon -> Seq GeoPolygon
splitGeoMultiPolygon = (Seq (LinearRing GeoPositionWithoutCRS) -> GeoPolygon)
-> Seq (Seq (LinearRing GeoPositionWithoutCRS)) -> Seq GeoPolygon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq (LinearRing GeoPositionWithoutCRS) -> GeoPolygon
GeoPolygon (Seq (Seq (LinearRing GeoPositionWithoutCRS)) -> Seq GeoPolygon)
-> (GeoMultiPolygon
    -> Seq (Seq (LinearRing GeoPositionWithoutCRS)))
-> GeoMultiPolygon
-> Seq GeoPolygon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeoMultiPolygon -> Seq (Seq (LinearRing GeoPositionWithoutCRS))
_unGeoMultiPolygon

-- | Merge multiple GeoPolygons into one GeoMultiPolygon
mergeGeoPolygons :: Sequence.Seq GeoPolygon -> GeoMultiPolygon
mergeGeoPolygons :: Seq GeoPolygon -> GeoMultiPolygon
mergeGeoPolygons = Seq (Seq (LinearRing GeoPositionWithoutCRS)) -> GeoMultiPolygon
GeoMultiPolygon (Seq (Seq (LinearRing GeoPositionWithoutCRS)) -> GeoMultiPolygon)
-> (Seq GeoPolygon -> Seq (Seq (LinearRing GeoPositionWithoutCRS)))
-> Seq GeoPolygon
-> GeoMultiPolygon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeoPolygon -> Seq (LinearRing GeoPositionWithoutCRS))
-> Seq GeoPolygon -> Seq (Seq (LinearRing GeoPositionWithoutCRS))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GeoPolygon -> Seq (LinearRing GeoPositionWithoutCRS)
GeoPolygon._unGeoPolygon

makeLenses ''GeoMultiPolygon

-- instances

instance Aeson.ToJSON GeoMultiPolygon where
  --  toJSON :: a -> Value
  toJSON :: GeoMultiPolygon -> Value
toJSON = String -> Seq (Seq (LinearRing GeoPositionWithoutCRS)) -> Value
forall a. ToJSON a => String -> a -> Value
makeGeometryGeoAeson String
"MultiPolygon" (Seq (Seq (LinearRing GeoPositionWithoutCRS)) -> Value)
-> (GeoMultiPolygon
    -> Seq (Seq (LinearRing GeoPositionWithoutCRS)))
-> GeoMultiPolygon
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeoMultiPolygon -> Seq (Seq (LinearRing GeoPositionWithoutCRS))
_unGeoMultiPolygon

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