{-# 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 lat lon m = isValidLat lat && isValidLong lon m
isValidLat :: Angle -> Bool
isValidLat lat = Angle.isWithin lat (Angle.decimalDegrees (-90)) (Angle.decimalDegrees 90)
isValidLong :: (Model a) => Angle -> a -> Bool
isValidLong lon m =
case longitudeRange m of
L180 -> Angle.isWithin lon (Angle.decimalDegrees (-180)) (Angle.decimalDegrees 180)
L360 -> Angle.isWithin lon (Angle.decimalDegrees 0) (Angle.decimalDegrees 360)
latLongDms :: (Model a) => a -> ReadP (Angle, Angle)
latLongDms m = latLongDmsCompact m <|> latLongDmsSymbols m
latLongDmsCompact :: (Model a) => a -> ReadP (Angle, Angle)
latLongDmsCompact m = do
lat <- blat
lon <- blon
if isValidLatLong lat lon m
then return (lat, lon)
else pfail
blat :: ReadP Angle
blat = do
d' <- digits 2
(m', s') <- option (0, 0.0) (ms <|> mi)
h <- hemisphere
if h == 'N'
then dmsF d' m' s'
else dmsF (-d') m' s'
blon :: ReadP Angle
blon = do
d' <- digits 3
(m', s') <- option (0, 0.0) (ms <|> mi)
m'' <- meridian
if m'' == 'E'
then dmsF d' m' s'
else dmsF (-d') m' s'
hemisphere :: ReadP Char
hemisphere = char 'N' <|> char 'S'
meridian :: ReadP Char
meridian = char 'E' <|> char 'W'
ms :: ReadP (Int, Double)
ms = do
m' <- digits 2
s' <- digits 2
return (m', fromIntegral s')
mi :: ReadP (Int, Double)
mi = do
m' <- digits 2
return (m', 0.0)
latLongDmsSymbols :: (Model a) => a -> ReadP (Angle, Angle)
latLongDmsSymbols m = do
lat <- hlat
_ <- char ' ' <|> char ','
lon <- hlon
if isValidLatLong lat lon m
then return (lat, lon)
else pfail
hlat :: ReadP Angle
hlat = do
lat <- Angle.angle
h <- hemisphere
if h == 'N'
then return lat
else return (Angle.negate lat)
hlon :: ReadP Angle
hlon = do
lon <- Angle.angle
m' <- meridian
if m' == 'E'
then return lon
else return (Angle.negate lon)
showLatLong :: (Angle, Angle) -> String
showLatLong (lat, lon) = showLat lat ++ "," ++ showLon lon
showLat :: Angle -> String
showLat lat
| Angle.isNegative lat = show (Angle.negate lat) ++ "S"
| otherwise = show lat ++ "N"
showLon :: Angle -> String
showLon lon
| Angle.isNegative lon = show (Angle.negate lon) ++ "W"
| otherwise = show lon ++ "E"
dmsF :: (MonadFail m) => Int -> Int -> Double -> m Angle
dmsF degs mins secs =
case e of
Left err -> fail err
Right a -> return a
where
e = Angle.dms degs mins secs