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

{- | The Military Grid Reference System (MGRS)

In MGRS there are two syntaxes for grid references:

  1. Between 80 South and 84 North a grid reference has a zone number, latitude band letter, a
    2 letter code for the 100km square within the zone, and then northings and eastings within
    that square.

  2. In the polar regions a grid reference has a latitude band letter (A or B for South, Y or Z 
    for North), a 2 letter code for the 100km square within the polar region, and then northings
    and eastings within that square. There is no zone number in the polar regions.
-}
module Geodetics.MGRS (
  -- * MGRS Grid Basis
  MgrsGrid (..),
  mgrsGrid,
  utmToMgrsPoint,
  upsToMgrsPoint,
  fromMgrsPoint,
  -- * Textual Representation
  mgrsBandLetterToLatitude,
  mgrsLatitudeToBandLetter,
  fromMgrsGridReference,
  toMgrsGridReference
) where

import Control.Monad
import Data.Array
import Geodetics.Ellipsoids
import Geodetics.Geodetic
import Geodetics.Grid
import Geodetics.PolarStereographic
import Geodetics.UTM
import Text.Parsec
import Text.Parsec.Error
import Text.Printf


-- | MGRS grid references can be anywhere on Earth. Hence the position can be either on a UTM or
-- a UPS grid.
data MgrsGrid =
  MgrsUtm UtmZone
  | MgrsUps UpsGrid
  deriving (MgrsGrid -> MgrsGrid -> Bool
(MgrsGrid -> MgrsGrid -> Bool)
-> (MgrsGrid -> MgrsGrid -> Bool) -> Eq MgrsGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MgrsGrid -> MgrsGrid -> Bool
== :: MgrsGrid -> MgrsGrid -> Bool
$c/= :: MgrsGrid -> MgrsGrid -> Bool
/= :: MgrsGrid -> MgrsGrid -> Bool
Eq, Int -> MgrsGrid -> ShowS
[MgrsGrid] -> ShowS
MgrsGrid -> String
(Int -> MgrsGrid -> ShowS)
-> (MgrsGrid -> String) -> ([MgrsGrid] -> ShowS) -> Show MgrsGrid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MgrsGrid -> ShowS
showsPrec :: Int -> MgrsGrid -> ShowS
$cshow :: MgrsGrid -> String
show :: MgrsGrid -> String
$cshowList :: [MgrsGrid] -> ShowS
showList :: [MgrsGrid] -> ShowS
Show)

instance GridClass MgrsGrid WGS84 where
  fromGrid :: GridPoint MgrsGrid -> Geodetic WGS84
fromGrid GridPoint MgrsGrid
p = case GridPoint MgrsGrid -> MgrsGrid
forall r. GridPoint r -> r
gridBasis GridPoint MgrsGrid
p of
    MgrsUtm UtmZone
zone -> GridPoint UtmZone -> Geodetic WGS84
forall r e. GridClass r e => GridPoint r -> Geodetic e
fromGrid (GridPoint UtmZone -> Geodetic WGS84)
-> GridPoint UtmZone -> Geodetic WGS84
forall a b. (a -> b) -> a -> b
$ UtmZone -> GridPoint MgrsGrid -> GridPoint UtmZone
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce UtmZone
zone GridPoint MgrsGrid
p
    MgrsUps UpsGrid
grid -> GridPoint UpsGrid -> Geodetic WGS84
forall r e. GridClass r e => GridPoint r -> Geodetic e
fromGrid (GridPoint UpsGrid -> Geodetic WGS84)
-> GridPoint UpsGrid -> Geodetic WGS84
forall a b. (a -> b) -> a -> b
$ UpsGrid -> GridPoint MgrsGrid -> GridPoint UpsGrid
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce UpsGrid
grid GridPoint MgrsGrid
p

  toGrid :: MgrsGrid -> Geodetic WGS84 -> GridPoint MgrsGrid
toGrid (MgrsUtm UtmZone
zone) = MgrsGrid -> GridPoint UtmZone -> GridPoint MgrsGrid
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce (UtmZone -> MgrsGrid
MgrsUtm UtmZone
zone) (GridPoint UtmZone -> GridPoint MgrsGrid)
-> (Geodetic WGS84 -> GridPoint UtmZone)
-> Geodetic WGS84
-> GridPoint MgrsGrid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtmZone -> Geodetic WGS84 -> GridPoint UtmZone
forall r e. GridClass r e => r -> Geodetic e -> GridPoint r
toGrid UtmZone
zone
  toGrid (MgrsUps UpsGrid
grid) = MgrsGrid -> GridPoint UpsGrid -> GridPoint MgrsGrid
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce (UpsGrid -> MgrsGrid
MgrsUps UpsGrid
grid) (GridPoint UpsGrid -> GridPoint MgrsGrid)
-> (Geodetic WGS84 -> GridPoint UpsGrid)
-> Geodetic WGS84
-> GridPoint MgrsGrid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpsGrid -> Geodetic WGS84 -> GridPoint UpsGrid
forall r e. GridClass r e => r -> Geodetic e -> GridPoint r
toGrid UpsGrid
grid

  gridEllipsoid :: MgrsGrid -> WGS84
gridEllipsoid MgrsGrid
_ = WGS84
WGS84


-- | Find the most appropriate grid for the given geodetic position
mgrsGrid :: Geodetic WGS84 -> MgrsGrid
mgrsGrid :: Geodetic WGS84 -> MgrsGrid
mgrsGrid Geodetic WGS84
geo =
  case Geodetic WGS84 -> Maybe UtmZone
forall a. Geodetic a -> Maybe UtmZone
utmZone Geodetic WGS84
geo of
    Just UtmZone
zone -> UtmZone -> MgrsGrid
MgrsUtm UtmZone
zone
    Maybe UtmZone
Nothing -> UpsGrid -> MgrsGrid
MgrsUps (UpsGrid -> MgrsGrid) -> UpsGrid -> MgrsGrid
forall a b. (a -> b) -> a -> b
$ if Geodetic WGS84 -> Double
forall e. Geodetic e -> Double
latitude Geodetic WGS84
geo Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then UpsGrid
upsNorth else UpsGrid
upsSouth


-- | Generalise from UTM to MGRS
utmToMgrsPoint :: GridPoint UtmZone -> GridPoint MgrsGrid
utmToMgrsPoint :: GridPoint UtmZone -> GridPoint MgrsGrid
utmToMgrsPoint GridPoint UtmZone
gp = MgrsGrid -> GridPoint UtmZone -> GridPoint MgrsGrid
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce (UtmZone -> MgrsGrid
MgrsUtm (UtmZone -> MgrsGrid) -> UtmZone -> MgrsGrid
forall a b. (a -> b) -> a -> b
$ GridPoint UtmZone -> UtmZone
forall r. GridPoint r -> r
gridBasis GridPoint UtmZone
gp) GridPoint UtmZone
gp


-- | Generalise from UPS to MGRS
upsToMgrsPoint :: GridPoint UpsGrid -> GridPoint MgrsGrid
upsToMgrsPoint :: GridPoint UpsGrid -> GridPoint MgrsGrid
upsToMgrsPoint GridPoint UpsGrid
gp = MgrsGrid -> GridPoint UpsGrid -> GridPoint MgrsGrid
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce (UpsGrid -> MgrsGrid
MgrsUps (UpsGrid -> MgrsGrid) -> UpsGrid -> MgrsGrid
forall a b. (a -> b) -> a -> b
$ GridPoint UpsGrid -> UpsGrid
forall r. GridPoint r -> r
gridBasis GridPoint UpsGrid
gp) GridPoint UpsGrid
gp


-- | Convert an MGRS grid point to either UTM or UPS, depending on its basis.
fromMgrsPoint :: GridPoint MgrsGrid -> Either (GridPoint UtmZone) (GridPoint UpsGrid)
fromMgrsPoint :: GridPoint MgrsGrid
-> Either (GridPoint UtmZone) (GridPoint UpsGrid)
fromMgrsPoint GridPoint MgrsGrid
gp = case GridPoint MgrsGrid -> MgrsGrid
forall r. GridPoint r -> r
gridBasis GridPoint MgrsGrid
gp of
  MgrsUtm UtmZone
zone -> GridPoint UtmZone -> Either (GridPoint UtmZone) (GridPoint UpsGrid)
forall a b. a -> Either a b
Left (GridPoint UtmZone
 -> Either (GridPoint UtmZone) (GridPoint UpsGrid))
-> GridPoint UtmZone
-> Either (GridPoint UtmZone) (GridPoint UpsGrid)
forall a b. (a -> b) -> a -> b
$ UtmZone -> GridPoint MgrsGrid -> GridPoint UtmZone
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce UtmZone
zone GridPoint MgrsGrid
gp
  MgrsUps UpsGrid
grid -> GridPoint UpsGrid -> Either (GridPoint UtmZone) (GridPoint UpsGrid)
forall a b. b -> Either a b
Right (GridPoint UpsGrid
 -> Either (GridPoint UtmZone) (GridPoint UpsGrid))
-> GridPoint UpsGrid
-> Either (GridPoint UtmZone) (GridPoint UpsGrid)
forall a b. (a -> b) -> a -> b
$ UpsGrid -> GridPoint MgrsGrid -> GridPoint UpsGrid
forall b a. b -> GridPoint a -> GridPoint b
unsafeGridCoerce UpsGrid
grid GridPoint MgrsGrid
gp


-- | Convert a list of letters into an inverse lookup function.
letterTable :: [Char] -> Char -> Maybe Int
letterTable :: String -> Char -> Maybe Int
letterTable String
cs = \Char
c -> 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)
arr) Char
c then Array Char (Maybe Int)
arr Array Char (Maybe Int) -> Char -> Maybe Int
forall i e. Ix i => Array i e -> i -> e
! Char
c else Maybe Int
forall a. Maybe a
Nothing
  where arr :: Array Char (Maybe Int)
arr = (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
cs [Int
0..]]
  -- Second argument in a lambda so that partial application returns a function with a CAF
  -- rather than computing the array for every call.


-- | 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"

mgrsBandIx :: Char -> Maybe Int
mgrsBandIx :: Char -> Maybe Int
mgrsBandIx = String -> Char -> Maybe Int
letterTable String
mgrsBandLetters

-- | Polar regions have special bands A, B, Y and Z.
mgrsBandLetterToPole :: Char -> Maybe Pole
mgrsBandLetterToPole :: Char -> Maybe Pole
mgrsBandLetterToPole Char
'A' = Pole -> Maybe Pole
forall a. a -> Maybe a
Just Pole
SouthPole
mgrsBandLetterToPole Char
'B' = Pole -> Maybe Pole
forall a. a -> Maybe a
Just Pole
SouthPole
mgrsBandLetterToPole Char
'Y' = Pole -> Maybe Pole
forall a. a -> Maybe a
Just Pole
NorthPole
mgrsBandLetterToPole Char
'Z' = Pole -> Maybe Pole
forall a. a -> Maybe a
Just Pole
NorthPole
mgrsBandLetterToPole Char
_ = Maybe Pole
forall a. Maybe a
Nothing

polarBandLetters :: [Char]
polarBandLetters :: String
polarBandLetters = String
"ABYZ"

-- | Polar regions use different northings and eastings letters to the rest of the world.
polarEastingLetters :: [Char]
polarEastingLetters :: String
polarEastingLetters = String
"ABCFGHJKLPQRSTUXYZ"

polarEastingIx :: Char -> Maybe Int
polarEastingIx :: Char -> Maybe Int
polarEastingIx = String -> Char -> Maybe Int
letterTable String
polarEastingLetters

polarNorthingLetters :: [Char]
polarNorthingLetters :: String
polarNorthingLetters = String
"ABCDEFGHJKLMNPQRSTUVWXYZ"

polarNorthingIx :: Char -> Maybe Int
polarNorthingIx :: Char -> Maybe Int
polarNorthingIx = String -> Char -> Maybe Int
letterTable String
polarNorthingLetters


-- | Convert the three letters of an MGRS grid reference to the south-west corner of a 100km square.
--
-- If any of the letters are invalid for the positions they are in then an error message is returned.
mgrsLettersToPolar ::
  Char   -- ^ Latitude band: A, B, Y or Z.
  -> Char  -- ^ Eastings letter.
  -> Char  -- ^ Northings letter.
  -> Parsec s u (Pole, Double, Double)
mgrsLettersToPolar :: forall s u.
Char -> Char -> Char -> Parsec s u (Pole, Double, Double)
mgrsLettersToPolar Char
bandC Char
eastC Char
northC =
  case (Maybe Pole
pole, Maybe Double
baseEasting, Maybe Double
baseNorthing) of
    (Just Pole
pole1, Just Double
easting, Just Double
northing) -> (Pole, Double, Double) -> Parsec s u (Pole, Double, Double)
forall a. a -> ParsecT s u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pole
pole1, Double
easting, Double
northing Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Pole -> Double
polarNorthingLetterOrigin Pole
pole1)
    (Maybe Pole, Maybe Double, Maybe Double)
_ -> String -> Parsec s u (Pole, Double, Double)
forall a. String -> ParsecT s u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid polar grid letters"
  where
    pole :: Maybe Pole
pole = Char -> Maybe Pole
mgrsBandLetterToPole Char
bandC
    baseEasting :: Maybe Double
baseEasting = (Double
bandEasting Double -> Double -> Double
forall a. Num a => a -> a -> a
+) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
100_000 Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Maybe Int -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Maybe Int
polarEastingIx Char
eastC
    baseNorthing :: Maybe Double
baseNorthing = (Double
100_000 Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Maybe Int -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Maybe Int
polarNorthingIx Char
northC
    bandEasting :: Double
bandEasting = if Char
bandC Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"AY" then Double
200Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
kilometer else Double
2000Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
kilometer
      -- A and Y denote the "eastern" halves of the south and north polar regions respectively.


-- | Find the southern boundary of a latitude band letter (excluding poles).
mgrsBandLetterToLatitude :: Char -> Maybe Double
mgrsBandLetterToLatitude :: Char -> Maybe Double
mgrsBandLetterToLatitude Char
band = do
    Int
n1 <- Char -> Maybe Int
mgrsBandIx 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)


-- | 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"

mgrsEastingIx :: Char -> Maybe Int
mgrsEastingIx :: Char -> Maybe Int
mgrsEastingIx = String -> Char -> Maybe Int
letterTable String
mgrsEastingsLetters

-- | 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
mgrsEastingIx 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
    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


-- | 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"

mgrsNorthingIx :: Char -> Maybe Int
mgrsNorthingIx :: Char -> Maybe Int
mgrsNorthingIx = String -> Char -> Maybe Int
letterTable String
mgrsEastingsLetters


-- | 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
mgrsNorthingIx 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


-- | 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


polarEastingsToLetter :: Double -> Char
polarEastingsToLetter :: Double -> Char
polarEastingsToLetter Double
eastings1 =
  Array Int Char
letters Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
! ((Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
eastings1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
20) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
18 :: Int)
  where
    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
17) String
polarEastingLetters


-- | The southern edge of the @A@ northings letter differs between north and south poles.
polarNorthingLetterOrigin :: Pole -> Double
polarNorthingLetterOrigin :: Pole -> Double
polarNorthingLetterOrigin Pole
NorthPole = Double
1_300 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer
polarNorthingLetterOrigin Pole
SouthPole =   Double
800 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer


polarNorthingsToLetter :: Pole -> Double -> Maybe Char
polarNorthingsToLetter :: Pole -> Double -> Maybe Char
polarNorthingsToLetter Pole
pole Double
northings1 = do
  let i :: Int
      i :: Int
i = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
northings1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Pole -> Double
polarNorthingLetterOrigin Pole
pole) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
24
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24
  Char -> Maybe Char
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Array Int Char
letters Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
! Int
i
  where
    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
23) String
polarNorthingLetters

-- | 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. 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 MgrsGrid, GridOffset)
fromMgrsGridReference :: String -> Either [String] (GridPoint MgrsGrid, GridOffset)
fromMgrsGridReference String
str = case Parsec String () (GridPoint MgrsGrid, GridOffset)
-> String
-> String
-> Either ParseError (GridPoint MgrsGrid, GridOffset)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () (GridPoint MgrsGrid, GridOffset)
forall u. Parsec String u (GridPoint MgrsGrid, GridOffset)
parseMgrsGridReference String
"" String
str of
    Left ParseError
err -> [String] -> Either [String] (GridPoint MgrsGrid, GridOffset)
forall a b. a -> Either a b
Left ([String] -> Either [String] (GridPoint MgrsGrid, GridOffset))
-> [String] -> Either [String] (GridPoint MgrsGrid, 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 MgrsGrid, GridOffset)
r -> (GridPoint MgrsGrid, GridOffset)
-> Either [String] (GridPoint MgrsGrid, GridOffset)
forall a b. b -> Either a b
Right (GridPoint MgrsGrid, GridOffset)
r

parseMgrsGridReference :: Parsec String u (GridPoint MgrsGrid, GridOffset)
parseMgrsGridReference :: forall u. Parsec String u (GridPoint MgrsGrid, GridOffset)
parseMgrsGridReference = ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
forall u. Parsec String u (GridPoint MgrsGrid, GridOffset)
mgrsUtmParser ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
-> ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
-> ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
forall u. Parsec String u (GridPoint MgrsGrid, GridOffset)
mgrsUpsParser
  where
    mgrsUtmParser :: ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
mgrsUtmParser = 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 u (m :: * -> *) a. 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 Int
-> String -> ParsecT String u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"UTM zone number"
          -- Safe because we can only read digits
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      Char
band <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
mgrsBandLetters 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)
      MgrsGrid
zone <- ParsecT String u Identity MgrsGrid
-> (UtmZone -> ParsecT String u Identity MgrsGrid)
-> Maybe UtmZone
-> ParsecT String u Identity MgrsGrid
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT String u Identity MgrsGrid
forall a. String -> ParsecT String u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid zone") (MgrsGrid -> ParsecT String u Identity MgrsGrid
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MgrsGrid -> ParsecT String u Identity MgrsGrid)
-> (UtmZone -> MgrsGrid)
-> UtmZone
-> ParsecT String u Identity MgrsGrid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtmZone -> MgrsGrid
MgrsUtm) (Maybe UtmZone -> ParsecT String u Identity MgrsGrid)
-> Maybe UtmZone -> ParsecT String u Identity MgrsGrid
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 <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
mgrsEastingsLetters 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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
mgrsNorthingsLetters 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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 MgrsGrid, GridOffset)
-> ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double -> Double -> MgrsGrid -> GridPoint MgrsGrid
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 MgrsGrid
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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 MgrsGrid, GridOffset)
-> ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double -> Double -> MgrsGrid -> GridPoint MgrsGrid
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 MgrsGrid
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)

    mgrsUpsParser :: ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
mgrsUpsParser = do
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      Char
band <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
polarBandLetters 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
"polar band letter"
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      Char
squareEast <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
polarEastingLetters 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"
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      Char
squareNorth <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
polarNorthingLetters 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"
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      (Pole
pole, Double
eastingBase, Double
northingBase) <- Char -> Char -> Char -> Parsec String u (Pole, Double, Double)
forall s u.
Char -> Char -> Char -> Parsec s u (Pole, Double, Double)
mgrsLettersToPolar Char
band Char
squareEast Char
squareNorth
      let grid :: MgrsGrid
grid = case Pole
pole of
            Pole
NorthPole -> UpsGrid -> MgrsGrid
MgrsUps UpsGrid
upsNorth
            Pole
SouthPole -> UpsGrid -> MgrsGrid
MgrsUps UpsGrid
upsSouth
      (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 MgrsGrid, GridOffset)
-> ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double -> Double -> MgrsGrid -> GridPoint MgrsGrid
forall r. Double -> Double -> Double -> r -> GridPoint r
GridPoint Double
eastingBase Double
northingBase Double
0 MgrsGrid
grid,
                  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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 MgrsGrid, GridOffset)
-> ParsecT String u Identity (GridPoint MgrsGrid, GridOffset)
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double -> Double -> MgrsGrid -> GridPoint MgrsGrid
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
0 MgrsGrid
grid,
                  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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 u (m :: * -> *) a. 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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 (f :: * -> *) a. Applicative f => a -> f a
pure (String
"", String
"")

-- | Convert a UTM or UPS @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-8.
  -> GridPoint MgrsGrid
  -> Maybe String
toMgrsGridReference :: Bool -> Int -> GridPoint MgrsGrid -> Maybe String
toMgrsGridReference Bool
withSpaces Int
precision GridPoint MgrsGrid
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
8
  case GridPoint MgrsGrid -> MgrsGrid
forall r. GridPoint r -> r
gridBasis GridPoint MgrsGrid
gp of
    MgrsUtm UtmZone
zone -> do
      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 MgrsGrid -> Geodetic WGS84
forall r e. GridClass r e => GridPoint r -> Geodetic e
fromGrid GridPoint MgrsGrid
gp
      let
        zoneNum :: Int
zoneNum = UtmZone -> Int
utmZoneNum UtmZone
zone
        northLetter :: Char
northLetter = Int -> Double -> Char
mgrsNorthingToLetter Int
zoneNum (Double -> Char) -> Double -> Char
forall a b. (a -> b) -> a -> b
$ GridPoint MgrsGrid -> Double
forall r. GridPoint r -> Double
northings GridPoint MgrsGrid
gp
      Char
eastLetter <- Int -> Double -> Maybe Char
mgrsEastingToLetter Int
zoneNum (Double -> Maybe Char) -> Double -> Maybe Char
forall a b. (a -> b) -> a -> b
$ GridPoint MgrsGrid -> Double
forall r. GridPoint r -> Double
eastings GridPoint MgrsGrid
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 MgrsGrid -> Double
forall r. GridPoint r -> Double
northings GridPoint MgrsGrid
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 MgrsGrid -> Double
forall r. GridPoint r -> Double
eastings GridPoint MgrsGrid
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 (f :: * -> *) a. Applicative f => a -> f a
pure (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
    MgrsUps UpsGrid
grid -> do
      let zoneLetter :: Char
zoneLetter = case UpsGrid -> Pole
forall e. PolarStereographic e -> Pole
trueOrigin UpsGrid
grid of
            Pole
NorthPole -> if GridPoint MgrsGrid -> Double
forall r. GridPoint r -> Double
eastings GridPoint MgrsGrid
gp Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
2_000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer then Char
'Y' else Char
'Z'
            Pole
SouthPole -> if GridPoint MgrsGrid -> Double
forall r. GridPoint r -> Double
eastings GridPoint MgrsGrid
gp Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
2_000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
kilometer then Char
'A' else Char
'B'
          eastLetter :: Char
eastLetter = Double -> Char
polarEastingsToLetter (Double -> Char) -> Double -> Char
forall a b. (a -> b) -> a -> b
$ GridPoint MgrsGrid -> Double
forall r. GridPoint r -> Double
eastings GridPoint MgrsGrid
gp
      Char
northLetter <- Pole -> Double -> Maybe Char
polarNorthingsToLetter (UpsGrid -> Pole
forall e. PolarStereographic e -> Pole
trueOrigin UpsGrid
grid) (Double -> Maybe Char) -> Double -> Maybe Char
forall a b. (a -> b) -> a -> b
$ GridPoint MgrsGrid -> Double
forall r. GridPoint r -> Double
northings GridPoint MgrsGrid
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 MgrsGrid -> Double
forall r. GridPoint r -> Double
northings GridPoint MgrsGrid
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 MgrsGrid -> Double
forall r. GridPoint r -> Double
eastings GridPoint MgrsGrid
gp
      String -> Maybe String
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ if Bool
withSpaces
        then Char
zoneLetter Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
eastLetter Char -> ShowS
forall a. a -> [a] -> [a]
: Char
northLetter Char -> ShowS
forall 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 Char
zoneLetter Char -> ShowS
forall a. a -> [a] -> [a]
: Char
eastLetter Char -> ShowS
forall a. a -> [a] -> [a]
: Char
northLetter Char -> ShowS
forall a. a -> [a] -> [a]
: String
eastDigits String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
northDigits