{-# LANGUAGE OverloadedStrings #-}

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

-- |
-- Module       : Data.Geosptial.Geometry.Aeson
-- Copyright    : (C) 2014-2021 HS-GeoJSON Project
-- License      : BSD-style (see the file LICENSE.md)
-- Maintainer   : Andrew Newman
--
-- Some helpers for some of the common Aeson ops
module Data.Geospatial.Internal.Geometry.Aeson
  ( -- * Geometry
    readGeometryGeoAeson,
    makeGeometryGeoAeson,

    -- * Optional fields
    optValFromObj,
    optAttributes,
  )
where

import Control.Monad (mzero)
import Data.Aeson
  ( FromJSON (..),
    Object,
    ToJSON (..),
    Value,
    object,
    (.:),
    (.:?),
    (.=),
  )
import qualified Data.Aeson.Key as AesonKey
import Data.Aeson.Types (Pair, Parser)
import Data.Text (Text)

-- | A generic function that can be used to read in the GeoJSON for:
-- `GeoPoint`, `GeoMultiPoint`, `GeoLine`, `GeoMultiLine`, `GeoPolygon` and `GeoMultiPolygon`
-- Takes in a String for the GeoJSON geometry type, the type constructor
-- for the datatype and the JSON object containing both the 'type' val and the 'coordinates' val
readGeometryGeoAeson :: (FromJSON a, FromJSON b) => String -> (a -> b) -> Object -> Parser b
readGeometryGeoAeson :: String -> (a -> b) -> Object -> Parser b
readGeometryGeoAeson String
geomTypeString a -> b
geomType Object
geopointObj = do
  String
geometryType <- Object
geopointObj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
  if String
geometryType String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
geomTypeString
    then a -> b
geomType (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
geopointObj Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"coordinates"
    else Parser b
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | The inverse to the above, you just give it the type string and the value for the coordinates
-- and it will create the JSON object
makeGeometryGeoAeson :: (ToJSON a) => String -> a -> Value
makeGeometryGeoAeson :: String -> a -> Value
makeGeometryGeoAeson String
typeString a
coordinates =
  [Pair] -> Value
object [Key
"type" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
typeString, Key
"coordinates" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
coordinates]

-- | get an optional value out of a JSON object:
optValFromObj :: (FromJSON a) => Text -> Object -> Parser (Maybe a)
optValFromObj :: Text -> Object -> Parser (Maybe a)
optValFromObj Text
t = (Object -> Key -> Parser (Maybe a))
-> Key -> Object -> Parser (Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
(.:?) (Text -> Key
AesonKey.fromText Text
t)

-- | The other way around, given an optional value, will return the attributes that
-- should be added to the makeObj input
optAttributes :: (ToJSON a) => Text -> Maybe a -> [Pair]
optAttributes :: Text -> Maybe a -> [Pair]
optAttributes Text
_ Maybe a
Nothing = []
optAttributes Text
name (Just a
x) = [Text -> Key
AesonKey.fromText Text
name Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
x]