{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Geospatial.Internal.GeoFeature (
GeoFeature(..)
, bbox
, geometry
, properties
, featureId
) where
import Data.Geospatial.Internal.BasicTypes
import Data.Geospatial.Internal.Geometry
import Data.Geospatial.Internal.Geometry.Aeson
import Control.Applicative ((<$>), (<*>))
import Control.Lens (makeLenses)
import Control.Monad (mzero)
import Data.Aeson (FromJSON (..),
ToJSON (..),
Value (..), object,
(.:), (.:?), (.=))
import Data.List ((++))
import Data.Maybe (Maybe)
import Data.Text (Text)
import Prelude (Eq (..), Show, ($))
data GeoFeature a = GeoFeature {
_bbox :: Maybe BoundingBoxWithoutCRS,
_geometry :: GeospatialGeometry,
_properties :: a,
_featureId :: Maybe FeatureID } deriving (Show, Eq)
makeLenses ''GeoFeature
instance (FromJSON a) => FromJSON (GeoFeature a) where
parseJSON (Object obj) = do
objType <- obj .: ("type" :: Text)
if objType /= ("Feature" :: Text)
then
mzero
else
GeoFeature
<$> obj .:? ("bbox" :: Text)
<*> obj .: ("geometry" :: Text)
<*> obj .: ("properties" :: Text)
<*> obj .:? ("id" :: Text)
parseJSON _ = mzero
instance (ToJSON a) => ToJSON (GeoFeature a) where
toJSON (GeoFeature bbox' geom props featureId') = object $ baseAttributes ++ optAttributes "bbox" bbox' ++ optAttributes "id" featureId'
where
baseAttributes = ["type" .= ("Feature" :: Text), "properties" .= props, "geometry" .= geom]