Geometry.hs

{-# 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