{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Geospatial.Internal.BasicTypes (
Latitude
, Longitude
, Easting
, Northing
, Altitude
, GeoPositionWithoutCRS (..)
, retrieveXY
, PointXY (..)
, PointXYZ (..)
, PointXYZM (..)
, DoubleArray (..)
, HasGeoPositionWithoutCRS(..)
, Name
, Code
, Href
, FormatString
, ProjectionType
, 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.Foldable as Foldable
import qualified Data.Maybe as DataMaybe
import qualified Data.Scientific as Scientific
import qualified Data.Sequence as Sequence
import qualified Data.Text as Text
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)
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
(GeoPointXY p) -> p
(GeoPointXYZ (PointXYZ pX pY _)) -> PointXY pX pY
(GeoPointXYZM (PointXYZM pX pY _ _)) -> PointXY pX pY
{-# INLINE retrieveXY #-}
instance Aeson.ToJSON GeoPositionWithoutCRS where
toJSON a = Aeson.toJSON $ _toDoubleArray a
instance Aeson.FromJSON GeoPositionWithoutCRS where
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
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)
newtype BoundingBoxWithoutCRS = BoundingBoxWithoutCRS { unBoundingBoxWithoutCrs :: Sequence.Seq Double } deriving (Eq, Show, Generic, NFData)
instance Aeson.FromJSON BoundingBoxWithoutCRS where
parseJSON obj = do
doubles <- Aeson.parseJSON obj :: AesonTypes.Parser [Double]
pure . BoundingBoxWithoutCRS $ Sequence.fromList doubles
instance Aeson.ToJSON BoundingBoxWithoutCRS where
toJSON = Aeson.toJSON . Foldable.toList . unBoundingBoxWithoutCrs