{-# LANGUAGE CPP #-}

-- |

-- Module:      Data.Geo.Jord.LatLong

-- Copyright:   (c) 2020 Cedric Liegeois

-- License:     BSD3

-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>

-- Stability:   experimental

-- Portability: portable

--

-- Parsers and formatter of latitudes & longitudes.

--

module Data.Geo.Jord.LatLong
    ( isValidLatLong
    , isValidLat
    , isValidLong
    , latLongDms
    , latLongDmsCompact
    , latLongDmsSymbols
    , showLatLong
    ) where

import Control.Applicative ((<|>))
#if __GLASGOW_HASKELL__ < 808
import Control.Monad.Fail (MonadFail)
#endif
import Data.Char ()
import Data.Maybe ()
import Text.ParserCombinators.ReadP (ReadP, char, option, pfail)

import Data.Geo.Jord.Angle (Angle)
import qualified Data.Geo.Jord.Angle as Angle
    ( angle
    , decimalDegrees
    , dms
    , isNegative
    , isWithin
    , negate
    )
import Data.Geo.Jord.Model
import Data.Geo.Jord.Parser

-- | @isValidLatLong lat lon m@ determines whether the given latitude & longitude are

-- both valid for model @m@.

isValidLatLong :: (Model a) => Angle -> Angle -> a -> Bool
isValidLatLong :: Angle -> Angle -> a -> Bool
isValidLatLong Angle
lat Angle
lon a
m = Angle -> Bool
isValidLat Angle
lat Bool -> Bool -> Bool
&& Angle -> a -> Bool
forall a. Model a => Angle -> a -> Bool
isValidLong Angle
lon a
m

-- | @isValidLat lat@ determines whether the given latitude is valid - i.e. in range [-90°, 90°].

isValidLat :: Angle -> Bool
isValidLat :: Angle -> Bool
isValidLat Angle
lat = Angle -> Angle -> Angle -> Bool
Angle.isWithin Angle
lat (Double -> Angle
Angle.decimalDegrees (-Double
90)) (Double -> Angle
Angle.decimalDegrees Double
90)

-- | @isValidLong lon m@ determines whether the given longitude is valid for model @m@.

--

-- * If longitude range is L180: in range [-180°, 180°]

-- * If longitude range is L360: in range [0°, 360°]

isValidLong :: (Model a) => Angle -> a -> Bool
isValidLong :: Angle -> a -> Bool
isValidLong Angle
lon a
m =
    case a -> LongitudeRange
forall a. Model a => a -> LongitudeRange
longitudeRange a
m of
        LongitudeRange
L180 -> Angle -> Angle -> Angle -> Bool
Angle.isWithin Angle
lon (Double -> Angle
Angle.decimalDegrees (-Double
180)) (Double -> Angle
Angle.decimalDegrees Double
180)
        LongitudeRange
L360 -> Angle -> Angle -> Angle -> Bool
Angle.isWithin Angle
lon (Double -> Angle
Angle.decimalDegrees Double
0) (Double -> Angle
Angle.decimalDegrees Double
360)

-- | latitude and longitude reader.

-- Formats:

--

--     * DD(MM)(SS)[N|S]DDD(MM)(SS)[E|W] - e.g. 553621N0130002E or 0116S03649E or 47N122W

--

--     * 'Angle'[N|S] 'Angle'[E|W] - e.g. 55°36'21''N 13°0'02''E or 11°16'S 36°49'E or 47°N 122°W

--

latLongDms :: (Model a) => a -> ReadP (Angle, Angle)
latLongDms :: a -> ReadP (Angle, Angle)
latLongDms a
m = a -> ReadP (Angle, Angle)
forall a. Model a => a -> ReadP (Angle, Angle)
latLongDmsCompact a
m ReadP (Angle, Angle)
-> ReadP (Angle, Angle) -> ReadP (Angle, Angle)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> ReadP (Angle, Angle)
forall a. Model a => a -> ReadP (Angle, Angle)
latLongDmsSymbols a
m

-- | reads latitude and longitude in DD(D)MMSS.

latLongDmsCompact :: (Model a) => a -> ReadP (Angle, Angle)
latLongDmsCompact :: a -> ReadP (Angle, Angle)
latLongDmsCompact a
m = do
    Angle
lat <- ReadP Angle
blat
    Angle
lon <- ReadP Angle
blon
    if Angle -> Angle -> a -> Bool
forall a. Model a => Angle -> Angle -> a -> Bool
isValidLatLong Angle
lat Angle
lon a
m
        then (Angle, Angle) -> ReadP (Angle, Angle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Angle
lat, Angle
lon)
        else ReadP (Angle, Angle)
forall a. ReadP a
pfail

-- | reads latitude in DDMMSS.

blat :: ReadP Angle
blat :: ReadP Angle
blat = do
    Int
d' <- Int -> ReadP Int
digits Int
2
    (Int
m', Double
s') <- (Int, Double) -> ReadP (Int, Double) -> ReadP (Int, Double)
forall a. a -> ReadP a -> ReadP a
option (Int
0, Double
0.0) (ReadP (Int, Double)
ms ReadP (Int, Double) -> ReadP (Int, Double) -> ReadP (Int, Double)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadP (Int, Double)
mi)
    Char
h <- ReadP Char
hemisphere
    if Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'N'
        then Int -> Int -> Double -> ReadP Angle
forall (m :: * -> *).
MonadFail m =>
Int -> Int -> Double -> m Angle
dmsF Int
d' Int
m' Double
s'
        else Int -> Int -> Double -> ReadP Angle
forall (m :: * -> *).
MonadFail m =>
Int -> Int -> Double -> m Angle
dmsF (-Int
d') Int
m' Double
s'

-- | reads longitude in DDDMMSS.

blon :: ReadP Angle
blon :: ReadP Angle
blon = do
    Int
d' <- Int -> ReadP Int
digits Int
3
    (Int
m', Double
s') <- (Int, Double) -> ReadP (Int, Double) -> ReadP (Int, Double)
forall a. a -> ReadP a -> ReadP a
option (Int
0, Double
0.0) (ReadP (Int, Double)
ms ReadP (Int, Double) -> ReadP (Int, Double) -> ReadP (Int, Double)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadP (Int, Double)
mi)
    Char
m'' <- ReadP Char
meridian
    if Char
m'' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E'
        then Int -> Int -> Double -> ReadP Angle
forall (m :: * -> *).
MonadFail m =>
Int -> Int -> Double -> m Angle
dmsF Int
d' Int
m' Double
s'
        else Int -> Int -> Double -> ReadP Angle
forall (m :: * -> *).
MonadFail m =>
Int -> Int -> Double -> m Angle
dmsF (-Int
d') Int
m' Double
s'

-- | reads N or S char.

hemisphere :: ReadP Char
hemisphere :: ReadP Char
hemisphere = Char -> ReadP Char
char Char
'N' ReadP Char -> ReadP Char -> ReadP Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ReadP Char
char Char
'S'

-- | reads E or W char.

meridian :: ReadP Char
meridian :: ReadP Char
meridian = Char -> ReadP Char
char Char
'E' ReadP Char -> ReadP Char -> ReadP Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ReadP Char
char Char
'W'

-- | reads minutes and seconds.

ms :: ReadP (Int, Double)
ms :: ReadP (Int, Double)
ms = do
    Int
m' <- Int -> ReadP Int
digits Int
2
    Int
s' <- Int -> ReadP Int
digits Int
2
    (Int, Double) -> ReadP (Int, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
m', Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s')

-- | reads minutes.

mi :: ReadP (Int, Double)
mi :: ReadP (Int, Double)
mi = do
    Int
m' <- Int -> ReadP Int
digits Int
2
    (Int, Double) -> ReadP (Int, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
m', Double
0.0)

-- | reads (latitude, longitude) from a human friendly text - see 'Angle'.

latLongDmsSymbols :: (Model a) => a -> ReadP (Angle, Angle)
latLongDmsSymbols :: a -> ReadP (Angle, Angle)
latLongDmsSymbols a
m = do
    Angle
lat <- ReadP Angle
hlat
    Char
_ <- Char -> ReadP Char
char Char
' ' ReadP Char -> ReadP Char -> ReadP Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ReadP Char
char Char
','
    Angle
lon <- ReadP Angle
hlon
    if Angle -> Angle -> a -> Bool
forall a. Model a => Angle -> Angle -> a -> Bool
isValidLatLong Angle
lat Angle
lon a
m
        then (Angle, Angle) -> ReadP (Angle, Angle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Angle
lat, Angle
lon)
        else ReadP (Angle, Angle)
forall a. ReadP a
pfail

-- | reads a latitude, 'Angle'N|S expected.

hlat :: ReadP Angle
hlat :: ReadP Angle
hlat = do
    Angle
lat <- ReadP Angle
Angle.angle
    Char
h <- ReadP Char
hemisphere
    if Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'N'
        then Angle -> ReadP Angle
forall (m :: * -> *) a. Monad m => a -> m a
return Angle
lat
        else Angle -> ReadP Angle
forall (m :: * -> *) a. Monad m => a -> m a
return (Angle -> Angle
Angle.negate Angle
lat)

-- | reads a longitude, 'Angle'E|W expected.

hlon :: ReadP Angle
hlon :: ReadP Angle
hlon = do
    Angle
lon <- ReadP Angle
Angle.angle
    Char
m' <- ReadP Char
meridian
    if Char
m' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E'
        then Angle -> ReadP Angle
forall (m :: * -> *) a. Monad m => a -> m a
return Angle
lon
        else Angle -> ReadP Angle
forall (m :: * -> *) a. Monad m => a -> m a
return (Angle -> Angle
Angle.negate Angle
lon)

-- | Show a (latitude, longitude) pair as DMS - e.g. 55°36'21''N,13°0'2''E.

showLatLong :: (Angle, Angle) -> String
showLatLong :: (Angle, Angle) -> String
showLatLong (Angle
lat, Angle
lon) = Angle -> String
showLat Angle
lat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Angle -> String
showLon Angle
lon

-- | Latitude to string.

showLat :: Angle -> String
showLat :: Angle -> String
showLat Angle
lat
    | Angle -> Bool
Angle.isNegative Angle
lat = Angle -> String
forall a. Show a => a -> String
show (Angle -> Angle
Angle.negate Angle
lat) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"S"
    | Bool
otherwise = Angle -> String
forall a. Show a => a -> String
show Angle
lat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"N"

-- | Longitude to string.

showLon :: Angle -> String
showLon :: Angle -> String
showLon Angle
lon
    | Angle -> Bool
Angle.isNegative Angle
lon = Angle -> String
forall a. Show a => a -> String
show (Angle -> Angle
Angle.negate Angle
lon) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"W"
    | Bool
otherwise = Angle -> String
forall a. Show a => a -> String
show Angle
lon String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"E"

dmsF :: (MonadFail m) => Int -> Int -> Double -> m Angle
dmsF :: Int -> Int -> Double -> m Angle
dmsF Int
degs Int
mins Double
secs =
    case Either String Angle
e of
        Left String
err -> String -> m Angle
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
        Right Angle
a -> Angle -> m Angle
forall (m :: * -> *) a. Monad m => a -> m a
return Angle
a
  where
    e :: Either String Angle
e = Int -> Int -> Double -> Either String Angle
Angle.dms Int
degs Int
mins Double
secs