{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumericUnderscores    #-}
{-# LANGUAGE FlexibleContexts #-}

{- | Universal Transverse Mercator (UTM)

The UTM grid system covers the whole world between 84°N and 80°S. It divides the world into 
grid zones of 6° longitude by 8° latitude. Each zone has a 2 digit number for longitude and
a letter for latitude. This regular system has two exceptions:

* North of Norway the zones 32X, 34X and 36X are not used, with 31X, 33X, 35X and 37X being
  wider instead.

* Zone 32V is widened to cover the south-western end of Norway.

There are two notations for writing UTM grid positions:

* The UTM standard: Zone number, N or S for hemisphere, and then northings and eastings
  relative to the equator.

* The Military Grid Reference System (MGRS): Zone number, latitude band letter, a
  2 letter code for the 100km square within the zone, and then northings and eastings within
  that square.

In this library each UTM longitude zone has two grids, one for the northern hemisphere and
one for the south.

For more details see

* https://en.wikipedia.org/wiki/Universal_Transverse_Mercator_coordinate_system.

* THE UNIVERSAL GRIDS: Universal Transverse Mercator (UTM) and Universal Polar Stereographic (UPS).
  DMA Technical Manual. AD-A226497. https://apps.dtic.mil/sti/tr/pdf/ADA266497.pdf
-}
module Geodetics.UTM (
  UtmHemisphere (..),
  UtmZoneNumber,
  utmZoneNumber,
  UtmZone (utmHemisphere, utmZoneNum, utmProjection),
  utmZone,
  mkUtmZone,
  mkUtmZoneUnsafe,
  fromUtmGridReference,
  toUtmGridReference,
  mgrsBandLetterToLatitude,
  mgrsLatitudeToBandLetter,
  fromMgrsGridReference,
  toMgrsGridReference
) where

import Control.Monad (mplus, guard, void, when, unless)
import Data.Array
import Data.Char
import Data.List
import Geodetics.Ellipsoids
import Geodetics.Geodetic
import Geodetics.Grid
import Geodetics.TransverseMercator
import Text.Parsec
import Text.Parsec.Error
import Text.Printf
import Text.Read



-- | In UTM the northern and southern hemispheres have different false origins.
data UtmHemisphere = UtmNorth | UtmSouth deriving UtmHemisphere -> UtmHemisphere -> Bool
(UtmHemisphere -> UtmHemisphere -> Bool)
-> (UtmHemisphere -> UtmHemisphere -> Bool) -> Eq UtmHemisphere
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UtmHemisphere -> UtmHemisphere -> Bool
== :: UtmHemisphere -> UtmHemisphere -> Bool
$c/= :: UtmHemisphere -> UtmHemisphere -> Bool
/= :: UtmHemisphere -> UtmHemisphere -> Bool
Eq

instance Show UtmHemisphere where
  show :: UtmHemisphere -> String
show UtmHemisphere
UtmNorth = String
"N"
  show UtmHemisphere
UtmSouth = String
"S"


-- | A UTM Zone number. Must be between 1 and 60.
type UtmZoneNumber = Int


-- | A UTM Zone, representing a band of typically 6 degrees of latitude between the equator and one of
-- the poles. The projection *must* match the hemisphere and zone.
data UtmZone = UtmZone {
  UtmZone -> UtmHemisphere
utmHemisphere :: UtmHemisphere,
  UtmZone -> Int
utmZoneNum :: UtmZoneNumber,
  UtmZone -> GridTM WGS84
utmProjection :: GridTM WGS84
} deriving (Int -> UtmZone -> ShowS
[UtmZone] -> ShowS
UtmZone -> String
(Int -> UtmZone -> ShowS)
-> (UtmZone -> String) -> ([UtmZone] -> ShowS) -> Show UtmZone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UtmZone -> ShowS
showsPrec :: Int -> UtmZone -> ShowS
$cshow :: UtmZone -> String
show :: UtmZone -> String
$cshowList :: [UtmZone] -> ShowS
showList :: [UtmZone] -> ShowS
Show)

instance Eq UtmZone where
  UtmZone
z1 == :: UtmZone -> UtmZone -> Bool
== UtmZone
z2  = UtmZone -> UtmHemisphere
utmHemisphere UtmZone
z1 UtmHemisphere -> UtmHemisphere -> Bool
forall a. Eq a => a -> a -> Bool
== UtmZone -> UtmHemisphere
utmHemisphere UtmZone
z2 Bool -> Bool -> Bool
&& UtmZone -> Int
utmZoneNum UtmZone
z1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== UtmZone -> Int
utmZoneNum UtmZone
z2

instance GridClass UtmZone WGS84 where
  fromGrid :: GridPoint UtmZone -> Geodetic WGS84
fromGrid GridPoint UtmZone
p = GridPoint (GridTM WGS84) -> Geodetic WGS84
forall r e. GridClass r e => GridPoint r -> Geodetic e
fromGrid (GridPoint (GridTM WGS84) -> Geodetic WGS84)
-> GridPoint (GridTM WGS84) -> Geodetic WGS84
forall a b. (a -> b) -> a -> b
$ GridTM WGS84 -> GridPoint UtmZone -> GridPoint (GridTM WGS84)
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce (UtmZone -> GridTM WGS84
utmProjection (UtmZone -> GridTM WGS84) -> UtmZone -> GridTM WGS84
forall a b. (a -> b) -> a -> b
$ GridPoint UtmZone -> UtmZone
forall r. GridPoint r -> r
gridBasis GridPoint UtmZone
p) GridPoint UtmZone
p
  toGrid :: UtmZone -> Geodetic WGS84 -> GridPoint UtmZone
toGrid UtmZone
grid = UtmZone -> GridPoint (GridTM WGS84) -> GridPoint UtmZone
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce UtmZone
grid (GridPoint (GridTM WGS84) -> GridPoint UtmZone)
-> (Geodetic WGS84 -> GridPoint (GridTM WGS84))
-> Geodetic WGS84
-> GridPoint UtmZone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GridTM WGS84 -> Geodetic WGS84 -> GridPoint (GridTM WGS84)
forall r e. GridClass r e => r -> Geodetic e -> GridPoint r
toGrid (UtmZone -> GridTM WGS84
utmProjection UtmZone
grid)
  gridEllipsoid :: UtmZone -> WGS84
gridEllipsoid UtmZone
_ = WGS84
WGS84


-- Internal data type representing a "rectangle" of latitude/longitude with an exceptional zone number.
data UtmException = UtmE {
  UtmException -> (Int, Int)
uteSW :: (Int, Int),  -- South west corner in integer degrees (lat, long), inclusive.
  UtmException -> (Int, Int)
uteNE :: (Int, Int),  -- North east corner in integer degrees (lat, long), exclusive.
  UtmException -> Int
uteActual :: UtmZoneNumber
} deriving Int -> UtmException -> ShowS
[UtmException] -> ShowS
UtmException -> String
(Int -> UtmException -> ShowS)
-> (UtmException -> String)
-> ([UtmException] -> ShowS)
-> Show UtmException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UtmException -> ShowS
showsPrec :: Int -> UtmException -> ShowS
$cshow :: UtmException -> String
show :: UtmException -> String
$cshowList :: [UtmException] -> ShowS
showList :: [UtmException] -> ShowS
Show


-- | Determine if the integer latitude and longitude are within the exception area.
inException :: Int -> Int -> UtmException -> Bool
inException :: Int -> Int -> UtmException -> Bool
inException Int
lat Int
long UtmException
e =
    Int -> Int -> Int -> Bool
forall {a}. Ord a => a -> a -> a -> Bool
inR Int
lat  ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ UtmException -> (Int, Int)
uteSW UtmException
e) ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ UtmException -> (Int, Int)
uteNE UtmException
e) Bool -> Bool -> Bool
&&
    Int -> Int -> Int -> Bool
forall {a}. Ord a => a -> a -> a -> Bool
inR Int
long ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ UtmException -> (Int, Int)
uteSW UtmException
e) ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ UtmException -> (Int, Int)
uteNE UtmException
e)
  where
    inR :: a -> a -> a -> Bool
inR a
v a
v1 a
v2 = a
v1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
v Bool -> Bool -> Bool
&& a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
v2


-- The UTM zone that encloses a given geodetic position. For most of the world this is based on
-- @longitude/6@, but there are exceptions around Norway and Svalbard.
utmZoneNumber :: Geodetic a -> Maybe UtmZoneNumber
utmZoneNumber :: forall a. Geodetic a -> Maybe Int
utmZoneNumber Geodetic a
geo = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
lat1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (-Int
80) Bool -> Bool -> Bool
&& Int
lat1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
84
    Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> (UtmException -> Int) -> Maybe UtmException -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
zone1 UtmException -> Int
uteActual Maybe UtmException
exception
  where
    lat1 :: Int
lat1 = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Geodetic a -> Double
forall e. Geodetic e -> Double
latitude Geodetic a
geo Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
degree
    long1 :: Int
long1 = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Geodetic a -> Double
forall e. Geodetic e -> Double
longitude Geodetic a
geo Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
degree
    zone1 :: Int
zone1 = (Int
long1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    exception :: Maybe UtmException
exception = (UtmException -> Bool) -> [UtmException] -> Maybe UtmException
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int -> Int -> UtmException -> Bool
inException Int
lat1 Int
long1)
      [
        (Int, Int) -> (Int, Int) -> Int -> UtmException
UtmE (Int
56,Int
03) (Int
64,Int
12) Int
32,  -- Southwestern end of Norway around Bergen.
        (Int, Int) -> (Int, Int) -> Int -> UtmException
UtmE (Int
72,Int
00) (Int
84,Int
09) Int
31,
        (Int, Int) -> (Int, Int) -> Int -> UtmException
UtmE (Int
72,Int
09) (Int
84,Int
21) Int
33,  -- Svalbard.
        (Int, Int) -> (Int, Int) -> Int -> UtmException
UtmE (Int
72,Int
21) (Int
84,Int
33) Int
35,
        (Int, Int) -> (Int, Int) -> Int -> UtmException
UtmE (Int
72,Int
33) (Int
84,Int
42) Int
37
      ]


-- | The UTM Zone for the given location, if it exists.
utmZone :: Geodetic a -> Maybe UtmZone
utmZone :: forall a. Geodetic a -> Maybe UtmZone
utmZone Geodetic a
geo = do
  let hemi :: UtmHemisphere
hemi = if Geodetic a -> Double
forall e. Geodetic e -> Double
latitude Geodetic a
geo Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 then UtmHemisphere
UtmNorth else UtmHemisphere
UtmSouth
  Int
zn <- Geodetic a -> Maybe Int
forall a. Geodetic a -> Maybe Int
utmZoneNumber Geodetic a
geo
  UtmHemisphere -> Int -> Maybe UtmZone
mkUtmZone UtmHemisphere
hemi Int
zn


-- | Construct a UTM Zone value. Returns @Nothing@ if the zone number is out of range.
mkUtmZone :: UtmHemisphere -> UtmZoneNumber -> Maybe UtmZone
mkUtmZone :: UtmHemisphere -> Int -> Maybe UtmZone
mkUtmZone UtmHemisphere
h Int
n = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
60
    UtmZone -> Maybe UtmZone
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (UtmZone -> Maybe UtmZone) -> UtmZone -> Maybe UtmZone
forall a b. (a -> b) -> a -> b
$ UtmHemisphere -> Int -> UtmZone
mkUtmZoneUnsafe UtmHemisphere
h Int
n


-- | Construct a UTM Zone value without checking whether the zone number is valid.
mkUtmZoneUnsafe :: UtmHemisphere -> UtmZoneNumber -> UtmZone
mkUtmZoneUnsafe :: UtmHemisphere -> Int -> UtmZone
mkUtmZoneUnsafe UtmHemisphere
h Int
n = UtmHemisphere -> Int -> GridTM WGS84 -> UtmZone
UtmZone UtmHemisphere
h Int
n (GridTM WGS84 -> UtmZone) -> GridTM WGS84 -> UtmZone
forall a b. (a -> b) -> a -> b
$ Geodetic WGS84 -> GridOffset -> Double -> GridTM WGS84
forall e.
Ellipsoid e =>
Geodetic e -> GridOffset -> Double -> GridTM e
mkGridTM Geodetic WGS84
trueO GridOffset
falseO Double
scale
  where
    trueO :: Geodetic WGS84
trueO = Double -> Double -> Double -> WGS84 -> Geodetic WGS84
forall e. Double -> Double -> Double -> e -> Geodetic e
Geodetic Double
0 (Double
degree Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
183)) Double
0 WGS84
WGS84
    falseO :: GridOffset
falseO = case UtmHemisphere
h of
      UtmHemisphere
UtmNorth -> Double -> Double -> Double -> GridOffset
GridOffset (-Double
500_000) Double
0 Double
0
      UtmHemisphere
UtmSouth -> Double -> Double -> Double -> GridOffset
GridOffset (-Double
500_000) (-Double
10_000_000) Double
0
    scale :: Double
scale = Double
0.999_6


-- | Units for UTM grid coordinates.
data UtmGridUnit = UtmMeters | UtmKilometers deriving (UtmGridUnit -> UtmGridUnit -> Bool
(UtmGridUnit -> UtmGridUnit -> Bool)
-> (UtmGridUnit -> UtmGridUnit -> Bool) -> Eq UtmGridUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UtmGridUnit -> UtmGridUnit -> Bool
== :: UtmGridUnit -> UtmGridUnit -> Bool
$c/= :: UtmGridUnit -> UtmGridUnit -> Bool
/= :: UtmGridUnit -> UtmGridUnit -> Bool
Eq, Int -> UtmGridUnit -> ShowS
[UtmGridUnit] -> ShowS
UtmGridUnit -> String
(Int -> UtmGridUnit -> ShowS)
-> (UtmGridUnit -> String)
-> ([UtmGridUnit] -> ShowS)
-> Show UtmGridUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UtmGridUnit -> ShowS
showsPrec :: Int -> UtmGridUnit -> ShowS
$cshow :: UtmGridUnit -> String
show :: UtmGridUnit -> String
$cshowList :: [UtmGridUnit] -> ShowS
showList :: [UtmGridUnit] -> ShowS
Show)


-- | Convert a grid reference to a position, if the reference is valid.
--
-- The northings and eastings cannot contain more than 20 digits each,
-- including an optional decimal point. Negative values are not permitted.
--
-- Northings and eastings can each be followed by an optional unit. The unit
-- must be either \"m\" or \"km\". The units for both
-- must be the same because otherwise its probably an error. The default is meters.
--
-- Northings may be followed by an \"N\" and Eastings may be followed by an \"E\".
--
-- If the argument cannot be parsed then one or more error messages are returned.
fromUtmGridReference :: String -> Either [String] (GridPoint UtmZone)
fromUtmGridReference :: String -> Either [String] (GridPoint UtmZone)
fromUtmGridReference String
str = case Parsec String () (GridPoint UtmZone)
-> String -> String -> Either ParseError (GridPoint UtmZone)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () (GridPoint UtmZone)
gridP String
str String
str of
    Left ParseError
err -> [String] -> Either [String] (GridPoint UtmZone)
forall a b. a -> Either a b
Left ([String] -> Either [String] (GridPoint UtmZone))
-> [String] -> Either [String] (GridPoint UtmZone)
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages
      String
"or" String
"unknown parse error" String
"expecting" String
"unexpected" String
"end of input"
      (ParseError -> [Message]
errorMessages ParseError
err)
    Right GridPoint UtmZone
r -> GridPoint UtmZone -> Either [String] (GridPoint UtmZone)
forall a b. b -> Either a b
Right GridPoint UtmZone
r
  where
    gridP :: Parsec String () (GridPoint UtmZone)
gridP = do
      ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
spaces1
      Int
zone <- Parsec String () Int
readZone Parsec String () Int -> String -> Parsec String () Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Zone number"
      UtmHemisphere
hemi <- Parsec String () UtmHemisphere
readHemi Parsec String () UtmHemisphere
-> String -> Parsec String () UtmHemisphere
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Hemisphere (N or S)"
      ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
spaces1
      (Double
eastings1, UtmGridUnit
eastUnit) <- Parsec String () (Double, UtmGridUnit)
readDistance
      ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"Ee" ParsecT String () Identity Char
-> String -> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"E")
      ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
spaces1
      (Double
northings1, UtmGridUnit
northUnit) <- Parsec String () (Double, UtmGridUnit)
readDistance
      Bool
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UtmGridUnit
eastUnit UtmGridUnit -> UtmGridUnit -> Bool
forall a. Eq a => a -> a -> Bool
== UtmGridUnit
northUnit) (ParsecT String () Identity () -> ParsecT String () Identity ())
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity ()
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Northings and Eastings units don't match."
      ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
spaces1
      ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"Nn" ParsecT String () Identity Char
-> String -> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"N")
      ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
spaces1
      ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
      GridPoint UtmZone -> Parsec String () (GridPoint UtmZone)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (GridPoint UtmZone -> Parsec String () (GridPoint UtmZone))
-> GridPoint UtmZone -> Parsec String () (GridPoint UtmZone)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> UtmZone -> GridPoint UtmZone
forall r. Double -> Double -> Double -> r -> GridPoint r
GridPoint Double
eastings1 Double
northings1 Double
0 (UtmZone -> GridPoint UtmZone) -> UtmZone -> GridPoint UtmZone
forall a b. (a -> b) -> a -> b
$ UtmHemisphere -> Int -> UtmZone
mkUtmZoneUnsafe UtmHemisphere
hemi Int
zone
    readZone :: Parsec String () UtmZoneNumber
    readZone :: Parsec String () Int
readZone = do
      String
ds <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ds of
        Maybe Int
Nothing -> String -> Parsec String () Int
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Zone number not found."
        Just Int
n ->
          if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
60
            then String -> Parsec String () Int
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parsec String () Int) -> String -> Parsec String () Int
forall a b. (a -> b) -> a -> b
$ String
"Zone number " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" out of range."
            else Int -> Parsec String () Int
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
    readHemi :: Parsec String () UtmHemisphere
    readHemi :: Parsec String () UtmHemisphere
readHemi = do
      Char
h <- String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"NSns"
      case Char -> Char
toUpper Char
h of
        Char
'N' -> UtmHemisphere -> Parsec String () UtmHemisphere
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return UtmHemisphere
UtmNorth
        Char
'S' -> UtmHemisphere -> Parsec String () UtmHemisphere
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return UtmHemisphere
UtmSouth
        Char
_ -> String -> Parsec String () UtmHemisphere
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parsec String () UtmHemisphere)
-> String -> Parsec String () UtmHemisphere
forall a b. (a -> b) -> a -> b
$ String
"Invalid hemisphere: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char
h Char -> ShowS
forall a. a -> [a] -> [a]
: String
". Must be N or S.")
    readDistance :: Parsec String () (Double, UtmGridUnit)  -- (Distance, unit)
    readDistance :: Parsec String () (Double, UtmGridUnit)
readDistance = do
      String
digits <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT String () Identity Char
-> String -> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"number")
      ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
spaces1
      Bool
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
digits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20) (ParsecT String () Identity () -> ParsecT String () Identity ())
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity ()
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Too many digits."
      (Double
multiplier, UtmGridUnit
unit) <- do
        String
unit <- String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"m" (String -> ParsecT String () Identity String
forall {s} {m :: * -> *} {u}.
Stream s m Char =>
String -> ParsecT s u m String
string1' String
"m" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity String
forall {s} {m :: * -> *} {u}.
Stream s m Char =>
String -> ParsecT s u m String
string1' String
"km" ParsecT String () Identity String
-> String -> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"units (m or km)")
        if String
unit String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"km" then (Double, UtmGridUnit) -> Parsec String () (Double, UtmGridUnit)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
1000, UtmGridUnit
UtmKilometers) else (Double, UtmGridUnit) -> Parsec String () (Double, UtmGridUnit)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
1, UtmGridUnit
UtmMeters)
      case String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
digits of
        Just Double
d -> (Double, UtmGridUnit) -> Parsec String () (Double, UtmGridUnit)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
multiplier, UtmGridUnit
unit)
        Maybe Double
Nothing -> String -> Parsec String () (Double, UtmGridUnit)
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parsec String () (Double, UtmGridUnit))
-> String -> Parsec String () (Double, UtmGridUnit)
forall a b. (a -> b) -> a -> b
$ String
"Cannot read number: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
digits
    string1' :: String -> ParsecT s u m String
string1' String
target = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ do  -- Case-insensitive version of string'
      String
cs <- Int -> ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
target) ParsecT s u m Char
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
      if (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
target String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cs then String -> ParsecT s u m String
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
cs else String -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
cs
    spaces1 :: ParsecT String u Identity ()
spaces1 = ParsecT String u Identity String -> ParsecT String u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String u Identity String -> ParsecT String u Identity ())
-> ParsecT String u Identity String -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' ParsecT String u Identity Char
-> String -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"space")  -- Other white space not permitted.


-- | Convert a grid point to a UTM grid reference.
-- The northings and eastings are rounded down to the resolution, so the result is the south-west
-- corner of the grid square enclosing the grid point.
toUtmGridReference ::
  Maybe UtmGridUnit  -- ^ Include explicit units in the output. @Nothing@ means meters without units.
  -> Bool -- ^ Include \"E\" and \"N\" in the output.
  -> Int  -- ^ Digits of resolution. 0 = 1m resolution, 1 = 10m, 2 = 100m etc. (-2) = 1cm.
  -> GridPoint UtmZone
  -> String
toUtmGridReference :: Maybe UtmGridUnit -> Bool -> Int -> GridPoint UtmZone -> String
toUtmGridReference Maybe UtmGridUnit
unit Bool
letters Int
res GridPoint UtmZone
gp =
    String
zoneStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    Double -> String
forall {b}. PrintfType b => Double -> b
dist (GridPoint UtmZone -> Double
forall r. GridPoint r -> Double
eastings GridPoint UtmZone
gp)  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (if Bool
letters then String
"E " else String
" ") String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
    Double -> String
forall {b}. PrintfType b => Double -> b
dist (GridPoint UtmZone -> Double
forall r. GridPoint r -> Double
northings GridPoint UtmZone
gp) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (if Bool
letters then String
"N" else String
"")
  where
    res1 :: Double
    res1 :: Double
res1 = Double
10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res   -- Resolution in meters.
    floorRes :: Double -> Double
    floorRes :: Double -> Double
floorRes Double
d = Double
res1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
dDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
res1) :: Integer)
    b :: UtmZone
b = GridPoint UtmZone -> UtmZone
forall r. GridPoint r -> r
gridBasis GridPoint UtmZone
gp
    zoneStr :: String
zoneStr = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" (UtmZone -> Int
utmZoneNum UtmZone
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UtmHemisphere -> String
forall a. Show a => a -> String
show (UtmZone -> UtmHemisphere
utmHemisphere UtmZone
b)
    dist :: Double -> b
dist Double
d = case Maybe UtmGridUnit
unit of
      Maybe UtmGridUnit
Nothing            -> String -> Int -> Double -> b
forall r. PrintfType r => String -> r
printf String
"%.*f" (-Int
res) (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ Double -> Double
floorRes Double
d
      Just UtmGridUnit
UtmMeters     -> String -> Int -> Double -> b
forall r. PrintfType r => String -> r
printf String
"%.*fm" (-Int
res) (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ Double -> Double
floorRes Double
d
      Just UtmGridUnit
UtmKilometers -> String -> Int -> Double -> b
forall r. PrintfType r => String -> r
printf String
"%.*fkm" (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
res) (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ Double -> Double
floorRes Double
d Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000



-- | The MGRS latitude band code letters, excluding A and B used for Antarctica (south of -80 degrees)
-- and Y and Z used for the Arctic (north of 84 degrees).
mgrsBandLetters :: [Char]
mgrsBandLetters :: String
mgrsBandLetters = String
"CDEFGHJKLMNPQRSTUVWX"


-- | Find the southern boundary of a latitude band letter.
mgrsBandLetterToLatitude :: Char -> Maybe Double
mgrsBandLetterToLatitude :: Char -> Maybe Double
mgrsBandLetterToLatitude Char
band = do
    Int
n1 <- Char -> Maybe Int
ix Char
band
    Double -> Maybe Double
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
degree Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (-Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
  where
    indexMap :: Array Char (Maybe Int)
    indexMap :: Array Char (Maybe Int)
indexMap = (Maybe Int -> Maybe Int -> Maybe Int)
-> Maybe Int
-> (Char, Char)
-> [(Char, Maybe Int)]
-> Array Char (Maybe Int)
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe Int
forall a. Maybe a
Nothing (Char
'A', Char
'Z') [(Char
c1, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) | (Char
c1, Int
n) <- String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
mgrsBandLetters [Int
0..]]
    ix :: Char -> Maybe Int
ix Char
c1 = if (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array Char (Maybe Int) -> (Char, Char)
forall i e. Array i e -> (i, i)
bounds Array Char (Maybe Int)
indexMap) Char
c1 then Array Char (Maybe Int)
indexMap Array Char (Maybe Int) -> Char -> Maybe Int
forall i e. Ix i => Array i e -> i -> e
! Char
c1 else Maybe Int
forall a. Maybe a
Nothing


-- | Find the band letter for a latitude, if it is in the range (-80, 84) degrees.
-- (Argument in radians)
mgrsLatitudeToBandLetter :: Double -> Maybe Char
mgrsLatitudeToBandLetter :: Double -> Maybe Char
mgrsLatitudeToBandLetter Double
lat = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ -Double
80 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
dlat Bool -> Bool -> Bool
&& Double
dlat Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
84
    Char -> Maybe Char
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Array Int Char
indexMap Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
! Int
latIdx
  where
    dlat :: Double
dlat = Double
lat Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
degree
    ilat :: Int
    ilat :: Int
ilat = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
dlat
    latIdx :: Int
latIdx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
19 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
ilat Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
80) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8  -- Band 19 (X) extends an extra 4 degrees.
    indexMap :: Array Int Char
indexMap = (Int, Int) -> String -> Array Int Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
19) String
mgrsBandLetters



-- | Letters A-Z except for I and O.
mgrsEastingsLetters :: [Char]
mgrsEastingsLetters :: String
mgrsEastingsLetters = String
"ABCDEFGHJKLMNPQRSTUVWXYZ"

-- | If zone number is in range and the letter is one of the valid Eastings letters for that zone
-- then return the UTM easting in meters.
--
-- Zone 1 starts with \'A\'. Each zone is 8 characters wide. Hence the letters repeat every 3 zones.
mgrsLetterToEasting :: UtmZoneNumber -> Char -> Maybe Double
mgrsLetterToEasting :: Int -> Char -> Maybe Double
mgrsLetterToEasting Int
zn Char
c = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
zn Bool -> Bool -> Bool
&& Int
zn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
60
    Int
n1 <- Char -> Maybe Int
ix Char
c
    let n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
base
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n2 Bool -> Bool -> Bool
&& Int
n2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7
    Double -> Maybe Double
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100_000
  where
    indexMap :: Array Char (Maybe Int)
indexMap = (Maybe Int -> Maybe Int -> Maybe Int)
-> Maybe Int
-> (Char, Char)
-> [(Char, Maybe Int)]
-> Array Char (Maybe Int)
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe Int
forall a. Maybe a
Nothing (Char
'A', Char
'Z') [(Char
c1, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) | (Char
c1, Int
n) <- String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
mgrsEastingsLetters [Int
0..]]
    base :: Int
base = ((Int
znInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
    ix :: Char -> Maybe Int
ix Char
c1 = if (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array Char (Maybe Int) -> (Char, Char)
forall i e. Array i e -> (i, i)
bounds Array Char (Maybe Int)
indexMap) Char
c1 then Array Char (Maybe Int)
indexMap Array Char (Maybe Int) -> Char -> Maybe Int
forall i e. Ix i => Array i e -> i -> e
! Char
c1 else Maybe Int
forall a. Maybe a
Nothing


-- | If the zone number is in range and the eastings are between 100,000 and 900,000 then
-- return the Eastings letter.
mgrsEastingToLetter :: UtmZoneNumber -> Double -> Maybe Char
mgrsEastingToLetter :: Int -> Double -> Maybe Char
mgrsEastingToLetter Int
zn Double
east = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
zn Bool -> Bool -> Bool
&& Int
zn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
60
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
east Bool -> Bool -> Bool
&& Double
east Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
900 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer
    Char -> Maybe Char
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Array Int Char
indexMap Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
! Int
ix
  where
    indexMap :: Array Int Char
indexMap = (Int, Int) -> String -> Array Int Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
23) String
mgrsEastingsLetters
    base :: Int
base = ((Int
znInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
    square :: Int
square = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
7 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Double
east Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer)  -- Clamped in range (0,7).
    ix :: Int
ix = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
square  -- Must be in range (0,23)


-- | Letters A-V except for I and O.
mgrsNorthingsLetters :: [Char]
mgrsNorthingsLetters :: String
mgrsNorthingsLetters = String
"ABCDEFGHJKLMNPQRSTUV"


-- | MGRS Northings letters have rather complex relationship to the latitude bands. The 20 letters
-- repeat every 2,000km going north and south from the equator, so the latitude band is needed
-- to disambiguate which repetition of the Northings letter is meant.

-- Unfortunately this repetition of the letters does not neatly coincide with
-- the latitude band boundaries, which are based on degrees of latitude.

-- The base letter just north of the equator is A in odd-numbered zones and F in even numbered zones.
--
-- This uses the latitude band to estimate the range of northings that would be valid there,
-- and hence determine which possible grid band is meant by the northings letter.
-- The algorithm used is approximate and deliberately very forgiving: it will accept some grid squares
-- which are north or south of the band given.
mgrsLetterToNorthings ::
  UtmZoneNumber
  -> Char  -- ^ Latitude band letter (@C@ - @X@ excluding @I@ and @O@).
  -> Char  -- ^ MGRS Northings letter (@A@ - @V@ excluding @I@ and @O@).
  -> Maybe Double
mgrsLetterToNorthings :: Int -> Char -> Char -> Maybe Double
mgrsLetterToNorthings Int
zone Char
bandC Char
northingsC = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
zone Bool -> Bool -> Bool
&& Int
zone Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
60
  Double
band <- (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
degree) (Double -> Double) -> Maybe Double -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Maybe Double
mgrsBandLetterToLatitude Char
bandC
  Int
northings0 <- (Int
baseNorthingsOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Maybe Int
ix Char
northingsC
  let bandDist :: Double
bandDist = Double
band Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
metersPerDegree -- Approx dist from equator to southern edge of band.
      bandGridLower :: Int
bandGridLower = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
bandDist Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100_000 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2  -- Lower limit of band in 100km units
      bandGridUpper :: Int
bandGridUpper = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ if Double
band Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
71 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
degree  -- Upper limit of band in 100km units.
        then (Double
bandDist Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
12 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
metersPerDegree) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100_000 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1  -- Band X.
        else (Double
bandDist Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
8 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
metersPerDegree) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100_000 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2  -- Other bands.
      rep :: Int
rep = (Int
bandGridLower Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
northings0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
20  -- Lower limit in 2,000,000km units.
      grid :: Int
grid = (Int
repInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
northings0
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
grid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bandGridLower
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
grid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bandGridUpper
  Double -> Maybe Double
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int
grid Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100_000
  where
    metersPerDegree :: Double
metersPerDegree = Double
10_002_000 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
90  -- Equator to north pole.
    baseNorthingsOffset :: Int
    baseNorthingsOffset :: Int
baseNorthingsOffset = if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
zone then Int
0 else -Int
5
    indexMap :: Array Char (Maybe Int)
    indexMap :: Array Char (Maybe Int)
indexMap = (Maybe Int -> Maybe Int -> Maybe Int)
-> Maybe Int
-> (Char, Char)
-> [(Char, Maybe Int)]
-> Array Char (Maybe Int)
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe Int
forall a. Maybe a
Nothing (Char
'A', Char
'Z') [(Char
c, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) | (Char
c, Int
n) <- String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
mgrsEastingsLetters [Int
0..]]
    ix :: Char -> Maybe Int
ix Char
c1 = if (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array Char (Maybe Int) -> (Char, Char)
forall i e. Array i e -> (i, i)
bounds Array Char (Maybe Int)
indexMap) Char
c1 then Array Char (Maybe Int)
indexMap Array Char (Maybe Int) -> Char -> Maybe Int
forall i e. Ix i => Array i e -> i -> e
! Char
c1 else Maybe Int
forall a. Maybe a
Nothing


-- | Find the northings letter of the 100km square containing the given Northings.
--
-- The input is not range checked. It just assumes that the northings letters repeat forever.
mgrsNorthingToLetter :: UtmZoneNumber -> Double -> Char
mgrsNorthingToLetter :: Int -> Double -> Char
mgrsNorthingToLetter Int
zone Double
northings1 =
  Array Int Char
letters Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
! ((Int
gridNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
baseNorthingsOffset) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
20)
  where
    gridNum :: Int
    gridNum :: Int
gridNum = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
northings1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer)
    baseNorthingsOffset :: Int
baseNorthingsOffset = if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
zone then Int
0 else Int
5
    letters :: Array Int Char
letters = (Int, Int) -> String -> Array Int Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
19) String
mgrsNorthingsLetters


-- | Convert an MGRS grid reference to a UTM @GridPoint@, if the reference is valid.
-- E.g. \"30U XC 99304 10208\" is the grid reference for Nelson's Column in London.
-- 
-- If the input contains spaces then these are used to delimit the fields. Any or all spaces
-- may be omitted. Multiple spaces are treated as a single space.
--
-- If the reference is valid this returns the position of the south-west corner of the
-- nominated grid square and an offset to its centre. Altitude is set to zero.
fromMgrsGridReference :: String -> Either [String] (GridPoint UtmZone, GridOffset)
fromMgrsGridReference :: String -> Either [String] (GridPoint UtmZone, GridOffset)
fromMgrsGridReference String
str = case Parsec String () (GridPoint UtmZone, GridOffset)
-> String
-> String
-> Either ParseError (GridPoint UtmZone, GridOffset)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () (GridPoint UtmZone, GridOffset)
forall {u}.
ParsecT String u Identity (GridPoint UtmZone, GridOffset)
mgrsP String
str String
str of
    Left ParseError
err -> [String] -> Either [String] (GridPoint UtmZone, GridOffset)
forall a b. a -> Either a b
Left ([String] -> Either [String] (GridPoint UtmZone, GridOffset))
-> [String] -> Either [String] (GridPoint UtmZone, GridOffset)
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
-> String -> String -> String -> String -> [Message] -> String
showErrorMessages
      String
"or" String
"unknown parse error" String
"expecting" String
"unexpected" String
"end of input"
      (ParseError -> [Message]
errorMessages ParseError
err)
    Right (GridPoint UtmZone, GridOffset)
r -> (GridPoint UtmZone, GridOffset)
-> Either [String] (GridPoint UtmZone, GridOffset)
forall a b. b -> Either a b
Right (GridPoint UtmZone, GridOffset)
r
  where
    mgrsP :: ParsecT String u Identity (GridPoint UtmZone, GridOffset)
mgrsP = do
      Int
zoneNum <- String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT String u Identity String
-> ParsecT String u Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit  -- Safe because we can only read digits here.
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      Char
band <- ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper ParsecT String u Identity Char
-> String -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"latitude band letter"
      let (UtmHemisphere
hemi, Double
falseNorthing) = if Char
band Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'N'
            then (UtmHemisphere
UtmNorth, Double
0)
            else (UtmHemisphere
UtmSouth, -Double
10_000_000)
      UtmZone
zone <- ParsecT String u Identity UtmZone
-> (UtmZone -> ParsecT String u Identity UtmZone)
-> Maybe UtmZone
-> ParsecT String u Identity UtmZone
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT String u Identity UtmZone
forall a. String -> ParsecT String u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid zone") UtmZone -> ParsecT String u Identity UtmZone
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe UtmZone -> ParsecT String u Identity UtmZone)
-> Maybe UtmZone -> ParsecT String u Identity UtmZone
forall a b. (a -> b) -> a -> b
$ UtmHemisphere -> Int -> Maybe UtmZone
mkUtmZone UtmHemisphere
hemi Int
zoneNum
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      Char
squareEast <- ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper ParsecT String u Identity Char
-> String -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"eastings letter"
      Double
eastingBase <- ParsecT String u Identity Double
-> (Double -> ParsecT String u Identity Double)
-> Maybe Double
-> ParsecT String u Identity Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT String u Identity Double
forall a. String -> ParsecT String u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid eastings letter") Double -> ParsecT String u Identity Double
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Double -> ParsecT String u Identity Double)
-> Maybe Double -> ParsecT String u Identity Double
forall a b. (a -> b) -> a -> b
$
        Int -> Char -> Maybe Double
mgrsLetterToEasting Int
zoneNum Char
squareEast
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      Char
squareNorth <- ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper ParsecT String u Identity Char
-> String -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"northings letter"
      Double
northingBase <- ParsecT String u Identity Double
-> (Double -> ParsecT String u Identity Double)
-> Maybe Double
-> ParsecT String u Identity Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT String u Identity Double
forall a. String -> ParsecT String u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid northings letter") Double -> ParsecT String u Identity Double
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Double -> ParsecT String u Identity Double)
-> Maybe Double -> ParsecT String u Identity Double
forall a b. (a -> b) -> a -> b
$
        Int -> Char -> Char -> Maybe Double
mgrsLetterToNorthings Int
zoneNum Char
band Char
squareNorth
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      (String
eastingChars, String
northingChars) <- ParsecT String u Identity (String, String)
-> ParsecT String u Identity (String, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity (String, String)
forall {u}. ParsecT String u Identity (String, String)
spaced ParsecT String u Identity (String, String)
-> ParsecT String u Identity (String, String)
-> ParsecT String u Identity (String, String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity (String, String)
-> ParsecT String u Identity (String, String)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String u Identity (String, String)
forall {u}. ParsecT String u Identity (String, String)
unspaced ParsecT String u Identity (String, String)
-> ParsecT String u Identity (String, String)
-> ParsecT String u Identity (String, String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity (String, String)
forall {u}. ParsecT String u Identity (String, String)
noDigits
      Bool
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
eastingChars Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
northingChars) (ParsecT String u Identity () -> ParsecT String u Identity ())
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$
        String -> ParsecT String u Identity ()
forall a. String -> ParsecT String u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Northings and Eastings must be the same length."
      if String
northingChars String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
&& String
eastingChars String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
""
        then -- No digits, just return the outer 100km grid square
          (GridPoint UtmZone, GridOffset)
-> ParsecT String u Identity (GridPoint UtmZone, GridOffset)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> Double -> UtmZone -> GridPoint UtmZone
forall r. Double -> Double -> Double -> r -> GridPoint r
GridPoint Double
eastingBase (Double
northingBase Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
falseNorthing) Double
0 UtmZone
zone,
                  Double -> Double -> Double -> GridOffset
GridOffset (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Double
0)
        else do
          (Double
northing, Double
offset) <- ParsecT String u Identity (Double, Double)
-> ((Double, Double) -> ParsecT String u Identity (Double, Double))
-> Maybe (Double, Double)
-> ParsecT String u Identity (Double, Double)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT String u Identity (Double, Double)
forall a. String -> ParsecT String u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid northing digits") (Double, Double) -> ParsecT String u Identity (Double, Double)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Double, Double)
 -> ParsecT String u Identity (Double, Double))
-> Maybe (Double, Double)
-> ParsecT String u Identity (Double, Double)
forall a b. (a -> b) -> a -> b
$
            Double -> String -> Maybe (Double, Double)
fromGridDigits (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer) String
northingChars
          (Double
easting, Double
_) <- ParsecT String u Identity (Double, Double)
-> ((Double, Double) -> ParsecT String u Identity (Double, Double))
-> Maybe (Double, Double)
-> ParsecT String u Identity (Double, Double)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT String u Identity (Double, Double)
forall a. String -> ParsecT String u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid easting digits") (Double, Double) -> ParsecT String u Identity (Double, Double)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Double, Double)
 -> ParsecT String u Identity (Double, Double))
-> Maybe (Double, Double)
-> ParsecT String u Identity (Double, Double)
forall a b. (a -> b) -> a -> b
$
            Double -> String -> Maybe (Double, Double)
fromGridDigits (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer) String
eastingChars
          (GridPoint UtmZone, GridOffset)
-> ParsecT String u Identity (GridPoint UtmZone, GridOffset)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> Double -> UtmZone -> GridPoint UtmZone
forall r. Double -> Double -> Double -> r -> GridPoint r
GridPoint (Double
eastingBase Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
easting) (Double
northingBase Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
northing Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
falseNorthing) Double
0 UtmZone
zone,
                  Double -> Double -> Double -> GridOffset
GridOffset (Double
offsetDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Double
offsetDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) Double
0)
    spaced :: ParsecT String u Identity (String, String)
spaced = do
      String
e <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space  -- A space is mandatory here.
      String
n <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      (String, String) -> ParsecT String u Identity (String, String)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
e,String
n)
    unspaced :: ParsecT String u Identity (String, String)
unspaced = do
      String
digits <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      let c :: Int
c = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
digits
      Bool
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
forall a. Integral a => a -> Bool
odd Int
c) (ParsecT String u Identity () -> ParsecT String u Identity ())
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity ()
forall a. String -> ParsecT String u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Northings and Eastings must be the same length."
      (String, String) -> ParsecT String u Identity (String, String)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) String
digits)
    noDigits :: ParsecT String u Identity (String, String)
noDigits = do
      ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
      (String, String) -> ParsecT String u Identity (String, String)
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"", String
"")

-- | Convert UTM @GridPoint@ to an MGRS grid reference.
toMgrsGridReference ::
  Bool  -- ^ Include spaces in the output. The standard says no spaces, but they make 
        -- the output easier to read.
  -> Int  -- ^ Number of digits of precision in the easting and northing. Must be 0-5.
  -> GridPoint UtmZone
  -> Maybe String
toMgrsGridReference :: Bool -> Int -> GridPoint UtmZone -> Maybe String
toMgrsGridReference Bool
withSpaces Int
precision GridPoint UtmZone
gp = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
precision Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
precision Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5
  Char
band <- Double -> Maybe Char
mgrsLatitudeToBandLetter (Double -> Maybe Char) -> Double -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Geodetic WGS84 -> Double
forall e. Geodetic e -> Double
latitude (Geodetic WGS84 -> Double) -> Geodetic WGS84 -> Double
forall a b. (a -> b) -> a -> b
$ GridPoint UtmZone -> Geodetic WGS84
forall r e. GridClass r e => GridPoint r -> Geodetic e
fromGrid GridPoint UtmZone
gp
  let
    zoneNum :: Int
zoneNum = UtmZone -> Int
utmZoneNum (UtmZone -> Int) -> UtmZone -> Int
forall a b. (a -> b) -> a -> b
$ GridPoint UtmZone -> UtmZone
forall r. GridPoint r -> r
gridBasis GridPoint UtmZone
gp
    northLetter :: Char
northLetter = Int -> Double -> Char
mgrsNorthingToLetter Int
zoneNum (Double -> Char) -> Double -> Char
forall a b. (a -> b) -> a -> b
$ GridPoint UtmZone -> Double
forall r. GridPoint r -> Double
northings GridPoint UtmZone
gp
  Char
eastLetter <- Int -> Double -> Maybe Char
mgrsEastingToLetter Int
zoneNum (Double -> Maybe Char) -> Double -> Maybe Char
forall a b. (a -> b) -> a -> b
$ GridPoint UtmZone -> Double
forall r. GridPoint r -> Double
eastings GridPoint UtmZone
gp
  (Integer
_, String
northDigits) <- Double -> Int -> Double -> Maybe (Integer, String)
toGridDigits (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer) Int
precision (Double -> Maybe (Integer, String))
-> Double -> Maybe (Integer, String)
forall a b. (a -> b) -> a -> b
$ GridPoint UtmZone -> Double
forall r. GridPoint r -> Double
northings GridPoint UtmZone
gp
  (Integer
_, String
eastDigits) <- Double -> Int -> Double -> Maybe (Integer, String)
toGridDigits (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer) Int
precision (Double -> Maybe (Integer, String))
-> Double -> Maybe (Integer, String)
forall a b. (a -> b) -> a -> b
$ GridPoint UtmZone -> Double
forall r. GridPoint r -> Double
eastings GridPoint UtmZone
gp
  let part1 :: String
part1 = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
zoneNum String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
band]
      part2 :: String
part2 = [Char
eastLetter, Char
northLetter]
  String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ if Bool
withSpaces
    then String
part1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
part2 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
eastDigits String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
northDigits
    else String
part1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
part2 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
eastDigits String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
northDigits