{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Geospatial.Internal.GeoFeatureCollection (
GeoFeatureCollection(..)
, boundingbox
, geofeatures
) where
import Data.Geospatial.Internal.BasicTypes
import Data.Geospatial.Internal.GeoFeature
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 qualified Data.Sequence as Sequence
import Data.Text (Text)
import Prelude (Eq (..), Show, ($))
data GeoFeatureCollection a = GeoFeatureCollection
{ GeoFeatureCollection a -> Maybe BoundingBoxWithoutCRS
_boundingbox :: Maybe BoundingBoxWithoutCRS
, GeoFeatureCollection a -> Seq (GeoFeature a)
_geofeatures :: Sequence.Seq (GeoFeature a)
} deriving (Int -> GeoFeatureCollection a -> ShowS
[GeoFeatureCollection a] -> ShowS
GeoFeatureCollection a -> String
(Int -> GeoFeatureCollection a -> ShowS)
-> (GeoFeatureCollection a -> String)
-> ([GeoFeatureCollection a] -> ShowS)
-> Show (GeoFeatureCollection a)
forall a. Show a => Int -> GeoFeatureCollection a -> ShowS
forall a. Show a => [GeoFeatureCollection a] -> ShowS
forall a. Show a => GeoFeatureCollection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeoFeatureCollection a] -> ShowS
$cshowList :: forall a. Show a => [GeoFeatureCollection a] -> ShowS
show :: GeoFeatureCollection a -> String
$cshow :: forall a. Show a => GeoFeatureCollection a -> String
showsPrec :: Int -> GeoFeatureCollection a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GeoFeatureCollection a -> ShowS
Show, GeoFeatureCollection a -> GeoFeatureCollection a -> Bool
(GeoFeatureCollection a -> GeoFeatureCollection a -> Bool)
-> (GeoFeatureCollection a -> GeoFeatureCollection a -> Bool)
-> Eq (GeoFeatureCollection a)
forall a.
Eq a =>
GeoFeatureCollection a -> GeoFeatureCollection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeoFeatureCollection a -> GeoFeatureCollection a -> Bool
$c/= :: forall a.
Eq a =>
GeoFeatureCollection a -> GeoFeatureCollection a -> Bool
== :: GeoFeatureCollection a -> GeoFeatureCollection a -> Bool
$c== :: forall a.
Eq a =>
GeoFeatureCollection a -> GeoFeatureCollection a -> Bool
Eq)
makeLenses ''GeoFeatureCollection
instance (FromJSON a) => FromJSON (GeoFeatureCollection a) where
parseJSON :: Value -> Parser (GeoFeatureCollection a)
parseJSON (Object Object
obj) = do
Text
objType <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: (Text
"type" :: Text)
if Text
objType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= (Text
"FeatureCollection" :: Text)
then
Parser (GeoFeatureCollection a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
else
Maybe BoundingBoxWithoutCRS
-> Seq (GeoFeature a) -> GeoFeatureCollection a
forall a.
Maybe BoundingBoxWithoutCRS
-> Seq (GeoFeature a) -> GeoFeatureCollection a
GeoFeatureCollection
(Maybe BoundingBoxWithoutCRS
-> Seq (GeoFeature a) -> GeoFeatureCollection a)
-> Parser (Maybe BoundingBoxWithoutCRS)
-> Parser (Seq (GeoFeature a) -> GeoFeatureCollection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe BoundingBoxWithoutCRS)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? (Text
"bbox" :: Text)
Parser (Seq (GeoFeature a) -> GeoFeatureCollection a)
-> Parser (Seq (GeoFeature a)) -> Parser (GeoFeatureCollection a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser (Seq (GeoFeature a))
forall a. FromJSON a => Object -> Text -> Parser a
.: (Text
"features" :: Text)
parseJSON Value
_ = Parser (GeoFeatureCollection a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance (ToJSON a) => ToJSON (GeoFeatureCollection a) where
toJSON :: GeoFeatureCollection a -> Value
toJSON (GeoFeatureCollection Maybe BoundingBoxWithoutCRS
bbox' Seq (GeoFeature a)
features) = [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'
where
baseAttributes :: [Pair]
baseAttributes = [Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"FeatureCollection" :: Text), Text
"features" Text -> Seq (GeoFeature a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Seq (GeoFeature a)
features]