Geometry.hs

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

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

-- |
-- Module       : Data.Geospatial.Internal.Geometry
-- Copyright    : (C) 2014-2021 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 Control.DeepSeq
import Control.Lens (makePrisms)
import Control.Monad (mzero)
import Data.Aeson
  ( FromJSON (..),
    ToJSON (..),
    Value (..),
    object,
    (.:),
    (.=),
  )
import Data.Aeson.Types (Parser)
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 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")
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"
    geometryFromAeson geometryType (Object obj)
  parseJSON _ = mzero