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

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

-- |
-- Module       : Data.Geospatial.Internal.GeoFeature
-- Copyright    : (C) 2014-2021 HS-GeoJSON Project
-- License      : BSD-style (see the file LICENSE.md)
-- Maintainer   : Andrew Newman
--
-- See Section 2.2 /Feature Objects/ of the GeoJSON spec.
-- Parameterised on the property type
module Data.Geospatial.Internal.GeoFeature
  ( -- * Types
    GeoFeature (..),

    -- * Lenses
    bbox,
    geometry,
    properties,
    featureId,

    -- * Utils
    reWrapGeometry,
  )
where

import Control.Applicative ((<$>), (<*>))
import Control.DeepSeq
import Control.Lens (makeLenses)
import Control.Monad (mzero)
import Data.Aeson
  ( FromJSON (..),
    ToJSON (..),
    Value (..),
    object,
    (.:),
    (.:?),
    (.=),
  )
import Data.Geospatial.Internal.BasicTypes
import Data.Geospatial.Internal.Geometry
import Data.Geospatial.Internal.Geometry.Aeson
import Data.List ((++))
import Data.Maybe (Maybe)
import Data.Text (Text)
import GHC.Generics (Generic)
import Prelude (Eq (..), Show, ($))

-- | See Section 2.2 /Feature Objects/ of the GeoJSON spec.
-- Parameterised on the property type
data GeoFeature a = GeoFeature
  { GeoFeature a -> Maybe BoundingBoxWithoutCRS
_bbox :: Maybe BoundingBoxWithoutCRS,
    GeoFeature a -> GeospatialGeometry
_geometry :: GeospatialGeometry,
    GeoFeature a -> a
_properties :: a,
    GeoFeature a -> Maybe FeatureID
_featureId :: Maybe FeatureID
  }
  deriving (Int -> GeoFeature a -> ShowS
[GeoFeature a] -> ShowS
GeoFeature a -> String
(Int -> GeoFeature a -> ShowS)
-> (GeoFeature a -> String)
-> ([GeoFeature a] -> ShowS)
-> Show (GeoFeature a)
forall a. Show a => Int -> GeoFeature a -> ShowS
forall a. Show a => [GeoFeature a] -> ShowS
forall a. Show a => GeoFeature a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeoFeature a] -> ShowS
$cshowList :: forall a. Show a => [GeoFeature a] -> ShowS
show :: GeoFeature a -> String
$cshow :: forall a. Show a => GeoFeature a -> String
showsPrec :: Int -> GeoFeature a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GeoFeature a -> ShowS
Show, GeoFeature a -> GeoFeature a -> Bool
(GeoFeature a -> GeoFeature a -> Bool)
-> (GeoFeature a -> GeoFeature a -> Bool) -> Eq (GeoFeature a)
forall a. Eq a => GeoFeature a -> GeoFeature a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeoFeature a -> GeoFeature a -> Bool
$c/= :: forall a. Eq a => GeoFeature a -> GeoFeature a -> Bool
== :: GeoFeature a -> GeoFeature a -> Bool
$c== :: forall a. Eq a => GeoFeature a -> GeoFeature a -> Bool
Eq, (forall x. GeoFeature a -> Rep (GeoFeature a) x)
-> (forall x. Rep (GeoFeature a) x -> GeoFeature a)
-> Generic (GeoFeature a)
forall x. Rep (GeoFeature a) x -> GeoFeature a
forall x. GeoFeature a -> Rep (GeoFeature a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (GeoFeature a) x -> GeoFeature a
forall a x. GeoFeature a -> Rep (GeoFeature a) x
$cto :: forall a x. Rep (GeoFeature a) x -> GeoFeature a
$cfrom :: forall a x. GeoFeature a -> Rep (GeoFeature a) x
Generic, GeoFeature a -> ()
(GeoFeature a -> ()) -> NFData (GeoFeature a)
forall a. NFData a => GeoFeature a -> ()
forall a. (a -> ()) -> NFData a
rnf :: GeoFeature a -> ()
$crnf :: forall a. NFData a => GeoFeature a -> ()
NFData)

reWrapGeometry :: GeoFeature a -> GeospatialGeometry -> GeoFeature a
reWrapGeometry :: GeoFeature a -> GeospatialGeometry -> GeoFeature a
reWrapGeometry (GeoFeature Maybe BoundingBoxWithoutCRS
bbox GeospatialGeometry
_ a
props Maybe FeatureID
fId) GeospatialGeometry
geom = Maybe BoundingBoxWithoutCRS
-> GeospatialGeometry -> a -> Maybe FeatureID -> GeoFeature a
forall a.
Maybe BoundingBoxWithoutCRS
-> GeospatialGeometry -> a -> Maybe FeatureID -> GeoFeature a
GeoFeature Maybe BoundingBoxWithoutCRS
bbox GeospatialGeometry
geom a
props Maybe FeatureID
fId

makeLenses ''GeoFeature

-- instances

-- | Decodes Feature objects from GeoJSON
instance (FromJSON a) => FromJSON (GeoFeature a) where
  --  parseJSON :: Value -> Parse a
  parseJSON :: Value -> Parser (GeoFeature a)
parseJSON (Object Object
obj) = do
    Text
objType <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    if Text
objType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= (Text
"Feature" :: Text)
      then Parser (GeoFeature a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      else
        Maybe BoundingBoxWithoutCRS
-> GeospatialGeometry -> a -> Maybe FeatureID -> GeoFeature a
forall a.
Maybe BoundingBoxWithoutCRS
-> GeospatialGeometry -> a -> Maybe FeatureID -> GeoFeature a
GeoFeature
          (Maybe BoundingBoxWithoutCRS
 -> GeospatialGeometry -> a -> Maybe FeatureID -> GeoFeature a)
-> Parser (Maybe BoundingBoxWithoutCRS)
-> Parser
     (GeospatialGeometry -> a -> Maybe FeatureID -> GeoFeature a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe BoundingBoxWithoutCRS)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bbox"
          Parser (GeospatialGeometry -> a -> Maybe FeatureID -> GeoFeature a)
-> Parser GeospatialGeometry
-> Parser (a -> Maybe FeatureID -> GeoFeature a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser GeospatialGeometry
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"geometry"
          Parser (a -> Maybe FeatureID -> GeoFeature a)
-> Parser a -> Parser (Maybe FeatureID -> GeoFeature a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"properties"
          Parser (Maybe FeatureID -> GeoFeature a)
-> Parser (Maybe FeatureID) -> Parser (GeoFeature a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe FeatureID)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
  parseJSON Value
_ = Parser (GeoFeature a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Encodes Feature objects to GeoJSON
instance (ToJSON a) => ToJSON (GeoFeature a) where
  --  toJSON :: a -> Value
  toJSON :: GeoFeature a -> Value
toJSON (GeoFeature Maybe BoundingBoxWithoutCRS
bbox' GeospatialGeometry
geom a
props Maybe FeatureID
featureId') = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair]
baseAttributes [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Text -> Maybe BoundingBoxWithoutCRS -> [Pair]
forall a. ToJSON a => Text -> Maybe a -> [Pair]
optAttributes Text
"bbox" Maybe BoundingBoxWithoutCRS
bbox' [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Text -> Maybe FeatureID -> [Pair]
forall a. ToJSON a => Text -> Maybe a -> [Pair]
optAttributes Text
"id" Maybe FeatureID
featureId'
    where
      baseAttributes :: [Pair]
baseAttributes = [Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"Feature" :: Text), Key
"properties" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
props, Key
"geometry" Key -> GeospatialGeometry -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GeospatialGeometry
geom]