{-# LANGUAGE CPP #-}
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 :: (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 :: 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 :: (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)
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
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
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'
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'
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'
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'
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')
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)
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
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)
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)
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
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"
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