{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
-------------------------------------------------------------------
-- |
-- Module       : Data.Geospatial.Internal.CRS
-- Copyright    : (C) 2014-2019 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           Data.Geospatial.Internal.BasicTypes

import           Control.Applicative                 ((<$>), (<*>))
import           Control.Lens                        (makePrisms)
import           Control.Monad                       (mzero)
import           Data.Aeson                          (FromJSON (..), Object,
                                                      ToJSON (..), Value (..),
                                                      object, (.:), (.=))
import           Data.Aeson.Types                    (Parser)
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 (Int -> CRSObject -> ShowS
[CRSObject] -> ShowS
CRSObject -> String
(Int -> CRSObject -> ShowS)
-> (CRSObject -> String)
-> ([CRSObject] -> ShowS)
-> Show CRSObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CRSObject] -> ShowS
$cshowList :: [CRSObject] -> ShowS
show :: CRSObject -> String
$cshow :: CRSObject -> String
showsPrec :: Int -> CRSObject -> ShowS
$cshowsPrec :: Int -> CRSObject -> ShowS
Show, CRSObject -> CRSObject -> Bool
(CRSObject -> CRSObject -> Bool)
-> (CRSObject -> CRSObject -> Bool) -> Eq CRSObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CRSObject -> CRSObject -> Bool
$c/= :: CRSObject -> CRSObject -> Bool
== :: CRSObject -> CRSObject -> Bool
$c== :: 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 = Int -> CRSObject
EPSG Int
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 (m :: * -> *) a. Monad m => a -> m a
return CRSObject
NoCRS
    parseJSON (Object Object
obj) = do
        Href
crsType <- Object
obj Object -> Href -> Parser Href
forall a. FromJSON a => Object -> Href -> Parser a
.: Href
"type"
        Href -> Object -> Parser CRSObject
crsObjectFromAeson Href
crsType Object
obj
    parseJSON Value
_ = Parser CRSObject
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

-- helpers

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

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