{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

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

-- |
-- Module       : Data.Geospatial.Internal.CRS
-- Copyright    : (C) 2014-2021 HS-GeoJSON Project
-- License      : BSD-style (see the file LICENSE.md)
-- Maintainer   : Andrew Newman
--
-- See Section 3 /Coordinate Reference System Objects/
-- in the GeoJSON Spec
module Data.Geospatial.Internal.CRS
  ( -- * Types
    CRSObject (..),

    -- * Functions
    defaultCRS,

    -- * Prisms
    _NoCRS,
    _NamedCRS,
    _EPSG,
    _LinkedCRS,
  )
where

import Control.Lens (makePrisms)
import Control.Monad (mzero)
import Data.Aeson
  ( FromJSON (..),
    Object,
    ToJSON (..),
    Value (..),
    object,
    (.:),
    (.=),
  )
import qualified Data.Aeson.Key as AesonKey
import Data.Aeson.Types (Parser)
import Data.Geospatial.Internal.BasicTypes
import Data.Text (Text)

-- | See Section 3 /Coordinate Reference System Objects/ in the GeoJSON Spec
-- `NoCRS` is required because no 'crs' attribute in a GeoJSON feature is NOT the same thing as
-- a null 'crs' attribute. no 'crs' value implies the default CRS, while a null CRS means
-- you cannot assume a CRS, null will mapped to `NoCRS` while a non-existent attribute will
-- be mapped to a `Nothing` `Maybe` value
data CRSObject
  = NoCRS
  | NamedCRS !Name
  | EPSG Code
  | LinkedCRS !Href !FormatString
  deriving (Code -> CRSObject -> ShowS
[CRSObject] -> ShowS
CRSObject -> String
(Code -> CRSObject -> ShowS)
-> (CRSObject -> String)
-> ([CRSObject] -> ShowS)
-> Show CRSObject
forall a.
(Code -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Code -> CRSObject -> ShowS
showsPrec :: Code -> CRSObject -> ShowS
$cshow :: CRSObject -> String
show :: CRSObject -> String
$cshowList :: [CRSObject] -> ShowS
showList :: [CRSObject] -> ShowS
Show, CRSObject -> CRSObject -> Bool
(CRSObject -> CRSObject -> Bool)
-> (CRSObject -> CRSObject -> Bool) -> Eq CRSObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CRSObject -> CRSObject -> Bool
== :: CRSObject -> CRSObject -> Bool
$c/= :: CRSObject -> CRSObject -> Bool
/= :: CRSObject -> CRSObject -> Bool
Eq)

makePrisms ''CRSObject

-- | The default CRS according to Section 3 /Coordinate Reference System Objects/ is WGS84 which I believe,
-- from <http://spatialreference.org/ref/epsg/4326/> which translates to this in JSON: <http://spatialreference.org/ref/epsg/4326/json/>)
-- is represented thus:
defaultCRS :: CRSObject
defaultCRS :: CRSObject
defaultCRS = Code -> CRSObject
EPSG Code
4326

-- instances

-- |
-- decode CRS Objects from GeoJSON
--
-- Aeson doesnt decode "null" to `Null` unfortunately
instance FromJSON CRSObject where
  parseJSON :: Value -> Parser CRSObject
parseJSON Value
Null = CRSObject -> Parser CRSObject
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return CRSObject
NoCRS
  parseJSON (Object Object
obj) = do
    crsType <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    crsObjectFromAeson crsType obj
  parseJSON Value
_ = Parser CRSObject
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- |
-- encode CRS Objects to GeoJSON
instance ToJSON CRSObject where
  toJSON :: CRSObject -> Value
toJSON (NamedCRS Text
name) = [Pair] -> Value
object [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"name" :: Text), Key
"properties" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name]]
  toJSON (EPSG Code
code) = [Pair] -> Value
object [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"epsg" :: Text), Key
"properties" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"code" Key -> Code -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Code
code]]
  toJSON (LinkedCRS Text
href Text
format) = [Pair] -> Value
object [Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"link" :: Text), Key
"properties" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"href" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
href, Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
format]]
  toJSON CRSObject
NoCRS = Value
Null

-- helpers

crsPropertyFromAesonObj :: (FromJSON a) => Text -> Object -> Parser a
crsPropertyFromAesonObj :: forall a. FromJSON a => Text -> Object -> Parser a
crsPropertyFromAesonObj Text
name Object
obj = do
  props <- Object
obj Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"properties"
  props .: AesonKey.fromText name

crsObjectFromAeson :: Text -> Object -> Parser CRSObject
crsObjectFromAeson :: Text -> Object -> Parser CRSObject
crsObjectFromAeson Text
"name" Object
obj = Text -> CRSObject
NamedCRS (Text -> CRSObject) -> Parser Text -> Parser CRSObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Object -> Parser Text
forall a. FromJSON a => Text -> Object -> Parser a
crsPropertyFromAesonObj Text
"name" Object
obj
crsObjectFromAeson Text
"epsg" Object
obj = Code -> CRSObject
EPSG (Code -> CRSObject) -> Parser Code -> Parser CRSObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Object -> Parser Code
forall a. FromJSON a => Text -> Object -> Parser a
crsPropertyFromAesonObj Text
"code" Object
obj
crsObjectFromAeson Text
"link" Object
obj = Text -> Text -> CRSObject
LinkedCRS (Text -> Text -> CRSObject)
-> Parser Text -> Parser (Text -> CRSObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Object -> Parser Text
forall a. FromJSON a => Text -> Object -> Parser a
crsPropertyFromAesonObj Text
"href" Object
obj Parser (Text -> CRSObject) -> Parser Text -> Parser CRSObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Object -> Parser Text
forall a. FromJSON a => Text -> Object -> Parser a
crsPropertyFromAesonObj Text
"type" Object
obj
crsObjectFromAeson Text
_ Object
_ = Parser CRSObject
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero