{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} ------------------------------------------------------------------- -- | -- Module : Data.Geospatial.Internal.Geometry -- Copyright : (C) 2014-2019 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 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.DeepSeq import Control.Lens (makePrisms) import Control.Monad (mzero) import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, (.:), (.=)) import Data.Aeson.Types (Parser) 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 (Show, Eq, Generic, NFData) 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 -- | -- encodes Geometry Objects to GeoJSON -- instance ToJSON GeospatialGeometry where -- toJSON :: a -> Value 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 ] -- | -- decodes Geometry Objects from GeoJSON -- -- Aeson doesnt decode "null" into `Null` unfortunately -- instance FromJSON GeospatialGeometry where -- parseJSON :: Value -> Parser a parseJSON Null = return NoGeometry parseJSON (Object obj) = do geometryType <- obj .: ("type" :: Text) geometryFromAeson geometryType (Object obj) parseJSON _ = mzero