{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Geospatial.Internal.Geometry (
GeoPoint(..)
, GeoMultiPoint(..), splitGeoMultiPoint, mergeGeoPoints
, GeoPolygon(..)
, GeoMultiPolygon(..), splitGeoMultiPolygon, mergeGeoPolygons
, GeoLine(..)
, GeoMultiLine(..), splitGeoMultiLine, mergeGeoLines
, GeospatialGeometry(..)
, unGeoPoint
, unGeoMultiPoint
, unGeoPolygon
, unGeoMultiPolygon
, unGeoLine
, unGeoMultiLine
, _NoGeometry
, _Point
, _MultiPoint
, _Polygon
, _MultiPolygon
, _Line
, _MultiLine
, _Collection
) where
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 Control.Applicative ((<$>))
import Control.Lens (makePrisms)
import Control.Monad (mzero)
import Data.Aeson (FromJSON (..),
ToJSON (..),
Value (..),
object,
(.:), (.=))
import Data.Aeson.Types (Parser)
import Data.Text (Text)
data GeospatialGeometry =
NoGeometry
| Point GeoPoint
| MultiPoint GeoMultiPoint
| Polygon GeoPolygon
| MultiPolygon GeoMultiPolygon
| Line GeoLine
| MultiLine GeoMultiLine
| Collection [GeospatialGeometry] deriving (Show, Eq)
makePrisms ''GeospatialGeometry
geometryFromAeson :: String -> Value -> Parser GeospatialGeometry
geometryFromAeson "Point" obj = Point <$> parseJSON obj
geometryFromAeson "MultiPoint" obj = MultiPoint <$> parseJSON obj
geometryFromAeson "Polygon" obj = Polygon <$> parseJSON obj
geometryFromAeson "MultiPolygon" obj = MultiPolygon <$> parseJSON obj
geometryFromAeson "LineString" obj = Line <$> parseJSON obj
geometryFromAeson "MultiLineString" obj = MultiLine <$> parseJSON obj
geometryFromAeson "GeometryCollection" (Object jsonObj) = Collection <$> (jsonObj .: ("geometries" :: Text))
geometryFromAeson "GeometryCollection" _ = mzero
geometryFromAeson _ _ = mzero
instance ToJSON GeospatialGeometry where
toJSON NoGeometry = Null
toJSON (Point point) = toJSON point
toJSON (MultiPoint points) = toJSON points
toJSON (Polygon vertices) = toJSON vertices
toJSON (MultiPolygon vertices) = toJSON vertices
toJSON (Line vertices) = toJSON vertices
toJSON (MultiLine vertices) = toJSON vertices
toJSON (Collection geometries) = object
[ "type" .= ("GeometryCollection" :: Text)
, "geometries" .= geometries
]
instance FromJSON GeospatialGeometry where
parseJSON Null = return NoGeometry
parseJSON (Object obj) = do
geometryType <- obj .: ("type" :: Text)
geometryFromAeson geometryType (Object obj)
parseJSON _ = mzero