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

-- |
-- Module       : Data.Geospatial.Internal.GeoPosition
-- Copyright    : (C) 2014-2021 HS-GeoJSON Project
-- License      : BSD-style (see the file LICENSE.md)
-- Maintainer   : Andrew Newman
--
-- see Section 2.1.1 /Position/ in the GeoJSON Spec
module Data.Geospatial.Internal.GeoPosition
  ( -- * Type
    GeoPosition (..),

    -- * Functions
    stripCRSFromPosition,
  )
where

import qualified Data.Geospatial.Internal.BasicTypes as BasicTypes

-- | see Section 2.1.1 /Position/ in the GeoJSON Spec,
-- I make the assumption here that the only position types we will use will
-- involve easting or northing (+ve or -ve Altitude) or lon or lat (+ve or -ve Altitude)
data GeoPosition
  = LonLat BasicTypes.Longitude BasicTypes.Latitude
  | LonLatAlt BasicTypes.Longitude BasicTypes.Latitude BasicTypes.Altitude
  | EastingNorthing BasicTypes.Easting BasicTypes.Northing
  | EastingNorthingAlt BasicTypes.Easting BasicTypes.Northing BasicTypes.Altitude

-- | the `GeoPosition` is a bit special in that when you convert it to GeoJSON,
-- it will lose the CRS info attached to it and cannot be read back in
-- from the GeoJSON.  Hence it is ineligible for the `FromJSON` type class,
-- so this function will strip it down to a `GeoPositionWithoutCRS`, which is eligible
stripCRSFromPosition :: GeoPosition -> BasicTypes.GeoPositionWithoutCRS
stripCRSFromPosition :: GeoPosition -> GeoPositionWithoutCRS
stripCRSFromPosition (LonLat Longitude
lon Longitude
lat) = PointXY -> GeoPositionWithoutCRS
BasicTypes.GeoPointXY (PointXY -> GeoPositionWithoutCRS)
-> PointXY -> GeoPositionWithoutCRS
forall a b. (a -> b) -> a -> b
$ Longitude -> Longitude -> PointXY
BasicTypes.PointXY Longitude
lon Longitude
lat
stripCRSFromPosition (LonLatAlt Longitude
lon Longitude
lat Longitude
alt) = PointXYZ -> GeoPositionWithoutCRS
BasicTypes.GeoPointXYZ (PointXYZ -> GeoPositionWithoutCRS)
-> PointXYZ -> GeoPositionWithoutCRS
forall a b. (a -> b) -> a -> b
$ Longitude -> Longitude -> Longitude -> PointXYZ
BasicTypes.PointXYZ Longitude
lon Longitude
lat Longitude
alt
stripCRSFromPosition (EastingNorthing Longitude
easting Longitude
northing) = PointXY -> GeoPositionWithoutCRS
BasicTypes.GeoPointXY (PointXY -> GeoPositionWithoutCRS)
-> PointXY -> GeoPositionWithoutCRS
forall a b. (a -> b) -> a -> b
$ Longitude -> Longitude -> PointXY
BasicTypes.PointXY Longitude
easting Longitude
northing
stripCRSFromPosition (EastingNorthingAlt Longitude
easting Longitude
northing Longitude
alt) = PointXYZ -> GeoPositionWithoutCRS
BasicTypes.GeoPointXYZ (PointXYZ -> GeoPositionWithoutCRS)
-> PointXYZ -> GeoPositionWithoutCRS
forall a b. (a -> b) -> a -> b
$ Longitude -> Longitude -> Longitude -> PointXYZ
BasicTypes.PointXYZ Longitude
easting Longitude
northing Longitude
alt