Aeson.hs

{-# LANGUAGE OverloadedStrings #-}
-------------------------------------------------------------------
-- |
-- Module       : Data.Geosptial.Geometry.Aeson
-- Copyright    : (C) 2014 Dom De Re
-- License      : BSD-style (see the file etc/LICENSE.md)
-- Maintainer   : Dom De Re
--
-- Some helpers for some of the common Aeson ops
-------------------------------------------------------------------
module Data.Geospatial.Geometry.Aeson (
    -- * Geometry
        readGeometryGeoAeson
    ,   makeGeometryGeoAeson
    -- * Optional fields
    ,   optValFromObj
    ,   optAttributes
    ) where

import Control.Applicative ( (<$>) )
import Control.Monad ( mzero )
import Data.Aeson
    (   FromJSON(..)
    ,   ToJSON(..)
    ,   Object
    ,   Value
    ,   (.:)
    ,   (.:?)
    ,   (.=)
    ,   object
    )
import Data.Aeson.Types ( Pair, Parser )
import Data.Maybe ( Maybe(..) )
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 geomTypeString geomType geopointObj = do
    geometryType <- geopointObj .: "type"
    if geometryType == geomTypeString
        then
            geomType <$> geopointObj .: "coordinates"
        else
            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 typeString coordinates =
    object ["type" .= typeString, "coordinates" .= coordinates]

-- | get an optional value out of a JSON object:
--
optValFromObj :: (FromJSON a) => Text -> Object -> Parser (Maybe a)
optValFromObj = flip (.:?)

-- | 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 _ Nothing     = []
optAttributes name (Just x) = [name .= x]