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

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

-- |
-- Module       : Data.Geospatial.Internal.Geometry
-- Copyright    : (C) 2014-2021 HS-GeoJSON Project
-- License      : BSD-style (see the file LICENSE.md)
-- Maintainer   : Andrew Newman
--
-- See section 2.1 "Geometry Objects" in the GeoJSON Spec.
module Data.Geospatial.Internal.Geometry
  ( -- * Types
    GeoPoint (..),
    retrieveXY,
    GeoMultiPoint (..),
    splitGeoMultiPoint,
    mergeGeoPoints,
    GeoPolygon (..),
    GeoMultiPolygon (..),
    splitGeoMultiPolygon,
    mergeGeoPolygons,
    GeoLine (..),
    GeoMultiLine (..),
    splitGeoMultiLine,
    mergeGeoLines,
    GeospatialGeometry (..),

    -- * Lenses
    unGeoPoint,
    unGeoMultiPoint,
    unGeoPolygon,
    unGeoMultiPolygon,
    unGeoLine,
    unGeoMultiLine,

    -- * Prisms
    _NoGeometry,
    _Point,
    _MultiPoint,
    _Polygon,
    _MultiPolygon,
    _Line,
    _MultiLine,
    _Collection,
  )
where

import Control.DeepSeq
import Control.Lens (makePrisms)
import Control.Monad (mzero)
import Data.Aeson
  ( FromJSON (..),
    ToJSON (..),
    Value (..),
    object,
    (.:),
    (.=),
  )
import Data.Aeson.Types (Parser)
import Data.Geospatial.Internal.Geometry.GeoLine
import Data.Geospatial.Internal.Geometry.GeoMultiLine
import Data.Geospatial.Internal.Geometry.GeoMultiPoint
import Data.Geospatial.Internal.Geometry.GeoMultiPolygon
import Data.Geospatial.Internal.Geometry.GeoPoint
import Data.Geospatial.Internal.Geometry.GeoPolygon
import qualified Data.Sequence as Sequence
import Data.Text (Text)
import GHC.Generics (Generic)

-- | See section 2.1 /Geometry Objects/ in the GeoJSON Spec.
data GeospatialGeometry
  = NoGeometry
  | Point GeoPoint
  | MultiPoint GeoMultiPoint
  | Polygon GeoPolygon
  | MultiPolygon GeoMultiPolygon
  | Line GeoLine
  | MultiLine GeoMultiLine
  | Collection (Sequence.Seq GeospatialGeometry)
  deriving (Int -> GeospatialGeometry -> ShowS
[GeospatialGeometry] -> ShowS
GeospatialGeometry -> String
(Int -> GeospatialGeometry -> ShowS)
-> (GeospatialGeometry -> String)
-> ([GeospatialGeometry] -> ShowS)
-> Show GeospatialGeometry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeospatialGeometry] -> ShowS
$cshowList :: [GeospatialGeometry] -> ShowS
show :: GeospatialGeometry -> String
$cshow :: GeospatialGeometry -> String
showsPrec :: Int -> GeospatialGeometry -> ShowS
$cshowsPrec :: Int -> GeospatialGeometry -> ShowS
Show, GeospatialGeometry -> GeospatialGeometry -> Bool
(GeospatialGeometry -> GeospatialGeometry -> Bool)
-> (GeospatialGeometry -> GeospatialGeometry -> Bool)
-> Eq GeospatialGeometry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeospatialGeometry -> GeospatialGeometry -> Bool
$c/= :: GeospatialGeometry -> GeospatialGeometry -> Bool
== :: GeospatialGeometry -> GeospatialGeometry -> Bool
$c== :: GeospatialGeometry -> GeospatialGeometry -> Bool
Eq, (forall x. GeospatialGeometry -> Rep GeospatialGeometry x)
-> (forall x. Rep GeospatialGeometry x -> GeospatialGeometry)
-> Generic GeospatialGeometry
forall x. Rep GeospatialGeometry x -> GeospatialGeometry
forall x. GeospatialGeometry -> Rep GeospatialGeometry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GeospatialGeometry x -> GeospatialGeometry
$cfrom :: forall x. GeospatialGeometry -> Rep GeospatialGeometry x
Generic, GeospatialGeometry -> ()
(GeospatialGeometry -> ()) -> NFData GeospatialGeometry
forall a. (a -> ()) -> NFData a
rnf :: GeospatialGeometry -> ()
$crnf :: GeospatialGeometry -> ()
NFData)

makePrisms ''GeospatialGeometry

geometryFromAeson :: String -> Value -> Parser GeospatialGeometry
geometryFromAeson :: String -> Value -> Parser GeospatialGeometry
geometryFromAeson String
"Point" Value
obj = GeoPoint -> GeospatialGeometry
Point (GeoPoint -> GeospatialGeometry)
-> Parser GeoPoint -> Parser GeospatialGeometry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GeoPoint
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
geometryFromAeson String
"MultiPoint" Value
obj = GeoMultiPoint -> GeospatialGeometry
MultiPoint (GeoMultiPoint -> GeospatialGeometry)
-> Parser GeoMultiPoint -> Parser GeospatialGeometry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GeoMultiPoint
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
geometryFromAeson String
"Polygon" Value
obj = GeoPolygon -> GeospatialGeometry
Polygon (GeoPolygon -> GeospatialGeometry)
-> Parser GeoPolygon -> Parser GeospatialGeometry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GeoPolygon
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
geometryFromAeson String
"MultiPolygon" Value
obj = GeoMultiPolygon -> GeospatialGeometry
MultiPolygon (GeoMultiPolygon -> GeospatialGeometry)
-> Parser GeoMultiPolygon -> Parser GeospatialGeometry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GeoMultiPolygon
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
geometryFromAeson String
"LineString" Value
obj = GeoLine -> GeospatialGeometry
Line (GeoLine -> GeospatialGeometry)
-> Parser GeoLine -> Parser GeospatialGeometry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GeoLine
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
geometryFromAeson String
"MultiLineString" Value
obj = GeoMultiLine -> GeospatialGeometry
MultiLine (GeoMultiLine -> GeospatialGeometry)
-> Parser GeoMultiLine -> Parser GeospatialGeometry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GeoMultiLine
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
geometryFromAeson String
"GeometryCollection" (Object Object
jsonObj) = Seq GeospatialGeometry -> GeospatialGeometry
Collection (Seq GeospatialGeometry -> GeospatialGeometry)
-> Parser (Seq GeospatialGeometry) -> Parser GeospatialGeometry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
jsonObj Object -> Key -> Parser (Seq GeospatialGeometry)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"geometries")
geometryFromAeson String
"GeometryCollection" Value
_ = Parser GeospatialGeometry
forall (m :: * -> *) a. MonadPlus m => m a
mzero
geometryFromAeson String
_ Value
_ = Parser GeospatialGeometry
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- |
-- encodes Geometry Objects to GeoJSON
instance ToJSON GeospatialGeometry where
  --  toJSON :: a -> Value
  toJSON :: GeospatialGeometry -> Value
toJSON GeospatialGeometry
NoGeometry = Value
Null
  toJSON (Point GeoPoint
point) = GeoPoint -> Value
forall a. ToJSON a => a -> Value
toJSON GeoPoint
point
  toJSON (MultiPoint GeoMultiPoint
points) = GeoMultiPoint -> Value
forall a. ToJSON a => a -> Value
toJSON GeoMultiPoint
points
  toJSON (Polygon GeoPolygon
vertices) = GeoPolygon -> Value
forall a. ToJSON a => a -> Value
toJSON GeoPolygon
vertices
  toJSON (MultiPolygon GeoMultiPolygon
vertices) = GeoMultiPolygon -> Value
forall a. ToJSON a => a -> Value
toJSON GeoMultiPolygon
vertices
  toJSON (Line GeoLine
vertices) = GeoLine -> Value
forall a. ToJSON a => a -> Value
toJSON GeoLine
vertices
  toJSON (MultiLine GeoMultiLine
vertices) = GeoMultiLine -> Value
forall a. ToJSON a => a -> Value
toJSON GeoMultiLine
vertices
  toJSON (Collection Seq GeospatialGeometry
geometries) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"GeometryCollection" :: Text),
        Key
"geometries" Key -> Seq GeospatialGeometry -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Seq GeospatialGeometry
geometries
      ]

-- |
-- decodes Geometry Objects from GeoJSON
--
-- Aeson doesnt decode "null" into `Null` unfortunately
instance FromJSON GeospatialGeometry where
  --  parseJSON :: Value -> Parser a
  parseJSON :: Value -> Parser GeospatialGeometry
parseJSON Value
Null = GeospatialGeometry -> Parser GeospatialGeometry
forall (m :: * -> *) a. Monad m => a -> m a
return GeospatialGeometry
NoGeometry
  parseJSON (Object Object
obj) = do
    String
geometryType <- Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    String -> Value -> Parser GeospatialGeometry
geometryFromAeson String
geometryType (Object -> Value
Object Object
obj)
  parseJSON Value
_ = Parser GeospatialGeometry
forall (m :: * -> *) a. MonadPlus m => m a
mzero