--------------------------------------------------------------------------------
--
-- Module      : Data.Geography.GeoJSON
-- Description : GeoJSON Support
-- Copyright   : (c) 2014 Brian W Bush
-- License     : MIT
-- Maintainer  : code@bwbush.io
-- Stability   : stable
-- Portability : portable
-- 
-- |  Support for parsing and manipulating GeoJSON 1.0 < <http://geojson.org/geojson-spec.html>>.
--
--------------------------------------------------------------------------------


{-# LANGUAGE OverloadedStrings #-}


module Data.Geography.GeoJSON (
-- * Types
  FeatureCollection(..)
, Feature(..)
, Geometry(..) 
, PointGeometry(..)
, MultiPointGeometry(..)
, LineStringGeometry(..)
, MultiLineStringGeometry(..)
, PolygonGeometry(..)
, MultiPolygonGeometry(..)
-- * Functions
, readGeoJSON
) where


import Control.Applicative ((<$>), (<*>))
import Control.Monad (guard, liftM2, mzero)
import Data.Aeson (FromJSON(..), Value(..), (.:), (.:?), decode)
import Data.Aeson.Types (Parser)
import Data.Scientific (Scientific)

import qualified Data.ByteString.Lazy.Char8 as BS (readFile)


-- | Read and parse a GeoJSON file.
readGeoJSON
  :: FilePath                     -- ^ The path to the file to be read.
  -> IO (Maybe FeatureCollection) -- ^ An action for reading and parsing the file as a feature collection.
readGeoJSON file = decode <$> BS.readFile file


-- | A GeoJSON feature collection object < <http://geojson.org/geojson-spec.html#feature-collection-objects>>.
data FeatureCollection =
    FeatureCollection
    {
      collectionBoundingBox :: Maybe Value
    , features              :: [Feature]
    }
      deriving (Eq, Show)

instance FromJSON FeatureCollection where
  parseJSON (Object o) =
    do
      oType <- o .: "type"
      guard $ oType == ("FeatureCollection" :: String)
      FeatureCollection
        <$> o .:? "bbox"
        <*> o .:  "features"
  parseJSON _ = mzero


-- | A GeoJSON feature object < <http://geojson.org/geojson-spec.html#feature-objects>>.
data Feature =
    Feature
    {
      boundingBox :: Maybe Value
    , geometry    :: Geometry
    , properties  :: Value
    , identifier  :: Maybe Value
    }
      deriving (Eq, Show)

instance FromJSON Feature where
  parseJSON (Object o) =
    do
      oType <- o .: "type"
      guard $ oType == ("Feature" :: String)
      Feature
        <$> o .:? "bbox"
        <*> o .:  "geometry"
        <*> o .:  "properties"
        <*> o .:? "id"
  parseJSON _ = mzero


-- | A GeoJSON geometry object < <http://geojson.org/geojson-spec.html#geometry-objects>>.
data Geometry =
    -- | A GeoJSON @Point@ < <http://geojson.org/geojson-spec.html#point>>.
    Point PointGeometry
    -- | A GeoJSON @MultiPoint@ < <http://geojson.org/geojson-spec.html#multipoint>>.
  | MultiPoint MultiPointGeometry
    -- | A GeoJSON @LineString@ < <http://geojson.org/geojson-spec.html#linestring>>.
  | LineString LineStringGeometry
    -- | A GeoJSON @MultiLineString@ < <http://geojson.org/geojson-spec.html#multilinestring>>.
  | MultiLineString MultiLineStringGeometry
    -- | A GeoJSON @Polygon@ < <http://geojson.org/geojson-spec.html#polygon>>.
  | Polygon PolygonGeometry
    -- | A GeoJSON @MultiPolygon@ < <http://geojson.org/geojson-spec.html#multipolygon>>.
  | MultiPolygon MultiPolygonGeometry
    -- | A GeoJSON @GeometryCollection@ < <http://geojson.org/geojson-spec.html#geometry-collection>>.
  | GeometryCollection [Geometry]
    deriving (Eq, Read, Show)

instance FromJSON Geometry where
  parseJSON v@(Object o) =
    do
      gType <- o .: "type"
      parseJSON'' gType v
  parseJSON _ = mzero


parseJSON'' :: String -> Value -> Parser Geometry
parseJSON'' "Point"              = (Point           <$>) . parseJSON
parseJSON'' "MultiPoint"         = (MultiPoint      <$>) . parseJSON
parseJSON'' "LineString"         = (LineString      <$>) . parseJSON
parseJSON'' "MultiLineString"    = (MultiLineString <$>) . parseJSON
parseJSON'' "Polygon"            = (Polygon         <$>) . parseJSON
parseJSON'' "MultiPolygon"       = (MultiPolygon    <$>) . parseJSON
parseJSON'' "GeometryCollection" = parseCollection
  where
    parseCollection (Object o) = GeometryCollection <$> o .: "geometries"
    parseCollection _ = mzero
parseJSON'' _ = const mzero


parseJSON' :: (FromJSON a, FromJSON b) => String -> (a -> b) -> Value -> Parser b
parseJSON' gName gConstructor (Object o) =
  do
    gType <- o .: "type"
    guard $ gType == gName
    gConstructor <$> o .: "coordinates" 
parseJSON' _ _ _ = mzero


-- | GeoJSON @Point@ geometry < <http://geojson.org/geojson-spec.html#point>>.
data PointGeometry =
    PointGeometry
    {
      coordinates :: [Scientific]
    }
      deriving (Eq, Read, Show)

instance FromJSON PointGeometry where
  parseJSON = parseJSON' "Point" PointGeometry


-- | GeoJSON @MultiPoint@ geometry < <http://geojson.org/geojson-spec.html#multipoint>>.
data MultiPointGeometry =
    MultiPointGeometry
    {
      points :: [PointGeometry]
    }
      deriving (Eq, Read, Show)

instance FromJSON MultiPointGeometry where
  parseJSON =
    parseJSON' "MultiPoint" $
      MultiPointGeometry <$>
      map PointGeometry


-- | GeoJSON @LineString@ geometry < <http://geojson.org/geojson-spec.html#linestring>>.
data LineStringGeometry =
    LineStringGeometry
    {
      lineString :: [PointGeometry]
    }
      deriving (Eq, Read, Show)

instance FromJSON LineStringGeometry where
  parseJSON =
    parseJSON' "LineString" $
      LineStringGeometry <$>
      map PointGeometry


-- | GeoJSON @MultiLineString@ geometry < <http://geojson.org/geojson-spec.html#multilinestring>>.
data MultiLineStringGeometry =
    MultiLineStringGeometry
    {
      lineStrings :: [LineStringGeometry]
    }
      deriving (Eq, Read, Show)

instance FromJSON MultiLineStringGeometry where
  parseJSON =
    parseJSON' "MultiLineString" $
      MultiLineStringGeometry <$>
      map (LineStringGeometry . map PointGeometry)

    
-- | GeoJSON @Polygon@ geometry < <http://geojson.org/geojson-spec.html#polygon>>.
data PolygonGeometry =
    PolygonGeometry
    {
      exterior :: [PointGeometry]
    , holes :: [[PointGeometry]]
    }
      deriving (Eq, Read, Show)

instance FromJSON PolygonGeometry where
  parseJSON =
    parseJSON' "Polygon" $
    liftM2 PolygonGeometry head tail <$>
    map (map PointGeometry)


-- | GeoJSON @MultiPolygon@ geometry < <http://geojson.org/geojson-spec.html#multipolygon>>.
data MultiPolygonGeometry =
    MultiPolygonGeometry
    {
      polygons :: [PolygonGeometry]
    }
      deriving (Eq, Read, Show)

instance FromJSON MultiPolygonGeometry where
  parseJSON =
    parseJSON' "MultiPolygon" $
    MultiPolygonGeometry <$>
    map (liftM2 PolygonGeometry head tail <$>
    map (map PointGeometry))