{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

-------------------------------------------------------------------
-- |
-- Module       : Data.Geospatial.Internal.BasicTypes
-- Copyright    : (C) 2014-2019 HS-GeoJSON Project
-- License      : BSD-style (see the file LICENSE.md)
-- Maintainer   : Andrew Newman
--
-- Basic types for GeoJSON representations.
-------------------------------------------------------------------
module Data.Geospatial.Internal.BasicTypes (
    -- * Coordinate types
        Latitude
    ,   Longitude
    ,   Easting
    ,   Northing
    ,   Altitude
    ,   GeoPositionWithoutCRS (..)
    ,   retrieveXY
    ,   PointXY (..)
    ,   PointXYZ (..)
    ,   PointXYZM (..)
    ,   DoubleArray (..)
    ,   HasGeoPositionWithoutCRS(..)
    -- * CRS Reference types
    ,   Name
    ,   Code
    ,   Href
    ,   FormatString
    ,   ProjectionType
    -- * Feature Types
    ,   BoundingBoxWithoutCRS (..)
    ,   FeatureID (..)
    ) where

import           Control.DeepSeq
import           Control.Lens.TH  (makeClassy)
import qualified Data.Aeson       as Aeson
import qualified Data.Aeson.Types as AesonTypes
import qualified Data.Maybe       as DataMaybe
import qualified Data.Scientific  as Scientific
import qualified Data.Text        as Text
import qualified Data.Vector      as Vector
import           GHC.Generics

type Latitude = Double
type Longitude = Double
type Easting = Double
type Northing = Double
type Altitude = Double

newtype DoubleArray = DoubleArray [Double] deriving (Eq, Show, Generic, NFData, Aeson.FromJSON, Aeson.ToJSON)

-- | (`GeoPositionWithoutCRS` is a catch all for indeterminate CRSs and for expression of positions
-- before a CRS has been determined
--
data PointXY = PointXY
    { _xyX :: !Double
    , _xyY :: !Double
    } deriving (Show, Eq, Generic, NFData)

data PointXYZ = PointXYZ
    { _xyzX :: !Double
    , _xyzY :: !Double
    , _xyzZ :: !Double
    } deriving (Show, Eq, Generic, NFData)

data PointXYZM = PointXYZM
    { _xyzmX :: !Double
    , _xyzmY :: !Double
    , _xyzmZ :: !Double
    , _xyzmM :: !Double
    } deriving (Show, Eq, Generic, NFData)

data GeoPositionWithoutCRS = GeoEmpty | GeoPointXY PointXY | GeoPointXYZ PointXYZ | GeoPointXYZM PointXYZM deriving (Show, Eq, Generic, NFData)

makeClassy ''GeoPositionWithoutCRS

_toDoubleArray :: GeoPositionWithoutCRS -> [Double]
_toDoubleArray GeoEmpty                           = []
_toDoubleArray (GeoPointXY (PointXY x y))         = [x, y]
_toDoubleArray (GeoPointXYZ (PointXYZ x y z))     = [x, y, z]
_toDoubleArray (GeoPointXYZM (PointXYZM x y z m)) = [x, y, z, m]

_toGeoPoint :: DoubleArray -> Maybe GeoPositionWithoutCRS
_toGeoPoint (DoubleArray [])           = Just GeoEmpty
_toGeoPoint (DoubleArray [x, y])       = Just $ GeoPointXY (PointXY x y)
_toGeoPoint (DoubleArray [x, y, z])    = Just $ GeoPointXYZ (PointXYZ x y z)
_toGeoPoint (DoubleArray [x, y, z, m]) = Just $ GeoPointXYZM (PointXYZM x y z m)
_toGeoPoint _                          = Nothing

retrieveXY :: GeoPositionWithoutCRS -> PointXY
retrieveXY position =
  case position of
    GeoEmpty                             -> undefined -- TODO - Fix - represent this like WKB - NaN value
    (GeoPointXY p)                       -> p
    (GeoPointXYZ (PointXYZ pX pY _))     -> PointXY pX pY
    (GeoPointXYZM (PointXYZM pX pY _ _)) -> PointXY pX pY
{-# INLINE retrieveXY #-}

-- instances

instance Aeson.ToJSON GeoPositionWithoutCRS where
  --  toJSON :: a -> Value
  toJSON a = Aeson.toJSON $ _toDoubleArray a

instance Aeson.FromJSON GeoPositionWithoutCRS where
--  parseJSON :: Value -> Parser a
  parseJSON o = do
    x <- Aeson.parseJSON o
    DataMaybe.maybe (fail "Illegal coordinates") pure (_toGeoPoint x)

type Name = Text.Text
type Code = Int
type Href = Text.Text
type FormatString = Text.Text
type ProjectionType = Text.Text

-- Feature Types

data FeatureID =
        FeatureIDText Text.Text
    |   FeatureIDNumber Int deriving (Show, Eq, Generic, NFData)

instance Aeson.FromJSON FeatureID where
    parseJSON (Aeson.Number nID) =
        case x of
            Nothing -> fail "Not an integer value"
            Just z  -> pure $ FeatureIDNumber z
        where
            x = Scientific.toBoundedInteger nID :: Maybe Int
    parseJSON (Aeson.String sID) = pure $ FeatureIDText sID
    parseJSON _                  = fail "unknown id type"


instance Aeson.ToJSON FeatureID where
    toJSON (FeatureIDText a)   = Aeson.String a
    toJSON (FeatureIDNumber b) = Aeson.Number (fromInteger $ toInteger b :: Scientific.Scientific)


-- | See Section 4 /Bounding Boxes/ of the GeoJSON spec,
-- The length of the list/array must be 2*n where n is the dimensionality of the position type for the CRS
-- with min values first followed by the max values, wich both the min/max sets following the same axis order as the CRS,
-- e.g for WGS84: minLongitude, minLatitude, maxLongitude, maxLatitude
-- The spec mentions that it can be part of a geometry object too but doesnt give an example,
-- This implementation will ignore bboxes on Geometry objects, they can be added if required.
data BoundingBoxWithoutCRS
  = BoundingBoxWithoutCRSXY PointXY PointXY
  | BoundingBoxWithoutCRSXYZ PointXYZ PointXYZ
  | BoundingBoxWithoutCRSXYZM PointXYZM PointXYZM deriving (Eq, Show, Generic, NFData)

instance Aeson.FromJSON BoundingBoxWithoutCRS where
  parseJSON json = do
    x <- AesonTypes.parseJSON json
    DataMaybe.maybe (fail "Invalid bounding box") pure (_toBoundingBoxWithoutCRS x)

instance Aeson.ToJSON BoundingBoxWithoutCRS where
  toJSON (BoundingBoxWithoutCRSXY (PointXY bbMinX bbMinY) (PointXY bbMaxX bbMaxY)) =
    Aeson.Array (Vector.fromList $ fmap (Aeson.Number . Scientific.fromFloatDigits) [bbMinX, bbMinY, bbMaxX, bbMaxY])
  toJSON (BoundingBoxWithoutCRSXYZ (PointXYZ bbMinX bbMinY bbMinZ) (PointXYZ bbMaxX bbMaxY bbMaxZ)) =
    Aeson.Array (Vector.fromList $ fmap (Aeson.Number . Scientific.fromFloatDigits) [bbMinX, bbMinY, bbMinZ, bbMaxX, bbMaxY, bbMaxZ])
  toJSON (BoundingBoxWithoutCRSXYZM (PointXYZM bbMinX bbMinY bbMinZ bbMinM) (PointXYZM bbMaxX bbMaxY bbMaxZ bbMaxM)) =
    Aeson.Array (Vector.fromList $ fmap (Aeson.Number . Scientific.fromFloatDigits) [bbMinX, bbMinY, bbMinZ, bbMinM, bbMaxX, bbMaxY, bbMaxZ, bbMaxM])

_toBoundingBoxWithoutCRS :: [Double] -> Maybe BoundingBoxWithoutCRS
_toBoundingBoxWithoutCRS [bbMinX, bbMinY, bbMaxX, bbMaxY] =
  Just $ BoundingBoxWithoutCRSXY (PointXY bbMinX bbMinY) (PointXY bbMaxX bbMaxY)
_toBoundingBoxWithoutCRS [bbMinX, bbMinY, bbMinZ, bbMaxX, bbMaxY, bbMaxZ] =
  Just $ BoundingBoxWithoutCRSXYZ (PointXYZ bbMinX bbMinY bbMinZ) (PointXYZ bbMaxX bbMaxY bbMaxZ)
_toBoundingBoxWithoutCRS [bbMinX, bbMinY, bbMinZ, bbMinM, bbMaxX, bbMaxY, bbMaxZ, bbMaxM] =
  Just $ BoundingBoxWithoutCRSXYZM (PointXYZM bbMinX bbMinY bbMinZ bbMinM) (PointXYZM bbMaxX bbMaxY bbMaxZ bbMaxM)
_toBoundingBoxWithoutCRS _ =
  Nothing