{-# LANGUAGE CPP #-}
{-|
  To represent a Military Grid Reference System (MGRS) reference.

  Military Grid Reference System (MGRS)

  The Military Grid Reference System (MGRS) is an extension of the Universal
  Transverse Mercator (UTM) reference system. An MGRS reference is made from 5
  parts:

  UTM Longitude Zone
  This is a number indicating which UTM longitude zone the reference falls
  into. Zones are numbered from 1 (starting at 180°W) through 60. Each zone
  is 6° wide.

  UTM Latitude Zone
  Latitude is split into regions that are 8° high, starting at 80°S.
  Latitude zones are lettered using C through X, but omitting I and O as they
  can easily be confused with the numbers 1 and 0.

  100,000m Square identification
  Each UTM zone is treated as a square 100,000m to a side. The 50,000m easting
  is centred on the centre-point of the UTM zone. 100,000m squares are
  identified using two characters - one to identify the row and one to identify
  the column.
  Row identifiers use the characters A through V (omitting I and O again). The
  sequence is repeated every 2,000,000m from the equator. If the UTM longitude
  zone is odd, then the lettering is advanced by five characters to start at F.
  Column identifiers use the characters A through Z (again omitting I and O).

  Easting and northing
  Each 100,000m grid square is further divided into smaller squares
  representing 1m, 10m, 100m, 1,000m and 10,000m precision. The easting and
  northing are given using the numeric row and column reference of the square,
  starting at the bottom-left corner of the square.

  MGRS Reference Example
  18SUU8362601432 is an example of an MGRS reference. '18' is the UTM longitude
  zone, 'S' is the UTM latitude zone, 'UU' is the 100,000m square
  identification, 83626 is the easting reference to 1m precision and 01432 is
  the northing reference to 1m precision.

  MGRSRef
  Methods are provided to query an  MGRSRef  object for its
  parameters. As MGRS references are related to UTM references, a
  {@link MGRSRef#toUTMRef() toUTMRef()}  method is provided to
  convert an  MGRSRef  object into a  {@link UTMRef} 
  object. The reverse conversion can be made using the
  {@link #MGRSRef(UTMRef) MGRSRef(UTMRef)}  constructor.
  MGRSRef  objects can be converted to {@link LatLng LatLng}
  objects using the {@link MGRSRef#toLatLng() toLatLng()}  method. The reverse
  conversion is made using the {@link LatLng#toMGRSRef() LatLng.toMGRSRef()}  method.
  Some MGRS references use the Bessel 1841 ellipsoid rather than the Geodetic
  Reference System 1980 (GRS 1980), International or World Geodetic System 1984
  (WGS84) ellipsoids. Use the constructors with the optional boolean parameter
  to be able to specify whether your MGRS reference uses the Bessel 1841
  ellipsoid. Note that no automatic determination of the correct ellipsoid to
  use is made.

  Important note: There is currently no support for MGRS references in
  polar regions north of 84°N and south of 80°S. There is also no
  account made for UTM zones with slightly different sizes to normal around
  Svalbard and Norway.
-}
module MGRSRef where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif

import Control.Monad.Except
import Data.Char
import Data.Fixed
import Text.Regex.PCRE

import Datum
import qualified UTMRef as U

data MGRSRef = MGRSRef { easting :: Int
                       , northing :: Int
                       , eastingId :: Char
                       , northingId :: Char
                       , utmZoneNumber :: Int
                       , utmZoneChar :: Char
                       , precision :: Precision
                       , isBessel :: Bool
                       , datum :: Datum
                       } deriving (Eq)


data Precision = M1 -- ^ precision of 1m
                 | M10 -- ^ precision of 10m
                 | M100 -- ^ precision of 100m
                 | M1000 -- ^ precision of 1000m (1km)
                 | M10000  -- ^ precision of 10000m (10km)
                 deriving (Eq)


instance Enum Precision where
  fromEnum M1 = 1
  fromEnum M10 = 10
  fromEnum M100 = 100
  fromEnum M1000 = 1000
  fromEnum M10000 = 10000
  toEnum 1 = M1
  toEnum 10 = M10
  toEnum 100 = M100
  toEnum 1000 = M1000
  toEnum 10000 = M10000


-- | Northing characters
northingIds :: [Char]
northingIds = [ 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'J', 'K'
              , 'L', 'M', 'N', 'P', 'Q', 'R', 'S', 'T', 'U', 'V' ]


instance Show MGRSRef where
  show m@(MGRSRef _ _ _ _ _ _ precision _ _) = showWithPrecision m precision

-- | Return a String representation of this MGRS reference to 1m, 10m, 100m, 1000m or 10000m precision.
showWithPrecision :: MGRSRef
                     -> Precision -- ^ One of MGRSRef.PRECISION_1M, MGRSRef.PRECISION_10M, MGRSRef.PRECISION_100M, MGRSRef.PRECISION_1000M, MGRSRef.PRECISION_10000M.
                     -> String -- ^ ~ String representation of this MGRS reference to the required precision.
showWithPrecision (MGRSRef easting northing eastingId northingId utmZoneNumber utmZoneChar _ _ _) precision = do
  let
      p = fromEnum precision
      eastingR = easting `div` p
      northingR = northing `div` p
      padding = case precision of
        M1 -> 5
        M10 -> 4
        M100 -> 3
        M1000 -> 2
        M10000 -> 1
      eastingRs = padWithZeros (show eastingR) padding
      northingRs = padWithZeros (show northingR) padding
      utmZonePadding = if (utmZoneNumber < 10) then "0" else ""
  utmZonePadding ++ show utmZoneNumber ++ [utmZoneChar] ++ [eastingId] ++ [northingId] ++ eastingRs ++ northingRs
  where padWithZeros :: String -> Int -> String
        padWithZeros text padding =
          if (padding - length text > 0) then padWithZeros ('0' : text) padding
          else text


{-|
  Create a new MGRS reference object from the given UTM reference. It is
  assumed that this MGRS reference represents a point using the GRS 1980,
  International or WGS84 ellipsoids. It is assumed that the UTMRef object is
  valid.
-}
toMGRSRef :: U.UTMRef -- ^ UTM reference.
             -> Bool -- ^ True if the parameters represent an MGRS reference using the Bessel 1841 ellipsoid; false is the parameters represent an MGRS reference using the GRS 1980, International or WGS84 ellipsoids.
             -> MGRSRef
toMGRSRef (U.UTMRef easting northing latZone lngZone _) isBessel = do
  let
      set = (lngZone - 1) `mod` 6 + 1

      eId = (\x -> x + (if x > 14 then 1 else 0))
            . (\x -> x + (if x > 8 then 1 else 0))
            $ (floor (easting / 100000.0) + 8 * ((set - 1) `mod` 3))
      eIdC = chr $ eId + 64

      nId = (\x -> x - (if x > 19 then 20 else 0))
            . (\x -> x + (if isBessel then 10 else 0))
            . (\x -> x + (if even set then 5 else 0))
            $ floor ((northing  `mod'` 2000000) / 100000.0)
      nIdC = northingIds !! nId

  MGRSRef (round(easting) `mod` 100000) (round(northing) `mod` 100000) eIdC nIdC lngZone latZone M1 isBessel wgs84Datum


mkMGRSRef :: Int -- ^ The easting in metres. Must be greater than or equal to 0.0 and less than 100000.
             -> Int -- ^ The northing in metres. Must be greater than or equal to 0.0 and less than or equal to 500000.0.
             -> Char -- ^ The character representing the 100,000km easting square.
             -> Char -- ^ The character representing the 100,000km northing square.
             -> Int -- ^ The UTM zone number representing the longitude.
             -> Char -- ^ The UTM zone character representing the latitude.
             -> Precision -- ^ The precision of the given easting and northing.
             -> Bool -- ^ True if the parameters represent an MGRS reference using the Bessel 1841 ellipsoid; False is the parameters represent an MGRS reference using the GRS 1980, International or WGS84 ellipsoids.
             -> Except String MGRSRef -- ^ Throws an exception if any of the given parameters are invalid. Note that the parameters are only checked for the range of values that they can take on. Being able to create an MGRSRef object does not necessarily imply that the reference is valid.
mkMGRSRef e n eId nId un uc p b = do
  est <- withExcept (const "Invalid easting") (evalEasting e)
  nrt <- withExcept (const "Invalid northing") (evalNorthing n)
  estId <- withExcept (const "Invalid eastingId") (evalEastingId eId)
  nrtId <- withExcept (const "Invalid northingId") (evalNorthingId nId)
  uzn <- withExcept (const "Invalid utmZoneNumber") (evalUtmZoneNumber un)
  uzc <- withExcept (const "Invalid utmZoneChar") (evalUtmZoneChar uc)
  pure MGRSRef { easting = est
               , northing = nrt
               , eastingId = estId
               , northingId = nrtId
               , utmZoneNumber = uzn
               , utmZoneChar = uzc
               , precision = p
               , isBessel = b
               , datum = wgs84Datum }


  where evalEasting :: Int -> Except String Int
        evalEasting e | e < 0 || e > 99999 = throwError ("Invalid easting (" ++ show e ++ ")")
                      | otherwise = pure (e)

        evalNorthing :: Int -> Except String Int
        evalNorthing n | n < 0 || n > 99999 = throwError ("Invalid northing (" ++ show n ++ ")")
                       | otherwise = pure (n)

        evalUtmZoneNumber :: Int -> Except String Int
        evalUtmZoneNumber u | u < 1 || u > 60 = throwError ("Invalid utmZoneNumber (" ++ show u ++ ")")
                            | otherwise = pure (u)

        evalUtmZoneChar :: Char -> Except String Char
        evalUtmZoneChar u | u < 'A' || u > 'Z' = throwError ("Invalid utmZoneChar (" ++ show u ++ ")")
                          | otherwise = pure (u)

        evalEastingId :: Char -> Except String Char
        evalEastingId e | e < 'A' || e > 'Z' || e == 'I' || e == 'O' = throwError ("Invalid eastingId (" ++ show e ++ ")")
                        | otherwise = pure (e)

        evalNorthingId :: Char -> Except String Char
        evalNorthingId n | n < 'A' || n > 'Z' || n == 'I' || n == 'O' = throwError ("Invalid northingId (" ++ show n ++ ")")
                         | otherwise = pure (n)


{-|
  Create a new MGRS reference object from the given String. Must be correctly
  formatted otherwise an IllegalArgumentException will be thrown.
-}
mkMGRSRef' :: String -- ^ A String to create an MGRS reference from.
              -> Except String MGRSRef -- ^ Throws an exception if the given String is not correctly formatted.
mkMGRSRef' ref = do
  groups <- withExcept (const "Invalid easting") (evalRefMatch ref)
  let
      group = head groups
      en = group !! 5
      enlh = length en `div` 2
      p = 10 ^ (5 - enlh)
  pure MGRSRef { easting = p * (read (take enlh en) :: Int)
               , northing = p * (read (drop enlh en) :: Int)
               , eastingId = (group !! 3) !! 0
               , northingId = (group !! 4) !! 0
               , utmZoneNumber = read (group !! 1) :: Int
               , utmZoneChar =  (group !! 2) !! 0
               , precision = toEnum p
               , isBessel = False
               , datum = wgs84Datum }


  where evalRefMatch :: String -> Except String [[String]]
        evalRefMatch ref = do
          let groups = ref =~ "(\\d{1,2})((?![IO])[C-X])((?![IO])[A-Z])((?![IO])[A-Z])(\\d{2,10})" :: [[String]]
          case groups of
            [] -> throwError ("No matches")
            [_,_,_,_,_,en]
              | odd $ length en -> throwError ("Invalid ref")
              | otherwise -> pure groups
            _ -> pure groups


-- | Convert this MGRS reference to an equivelent UTM reference.
toUTMRef :: MGRSRef -> Except String U.UTMRef
toUTMRef (MGRSRef easting northing eastingId northingId utmZoneNumber utmZoneChar _ _ _) = do
  let
      set = (utmZoneNumber - 1) `mod` 6 + 1
      isOffset = even set

      e = (\x -> if (x > 9) then x - 1 else x)
          . (\x -> if (x > 15) then x - 1 else x)
          $ ord eastingId - 65
      ex = (easting + ((e `mod` 8 + 1) * 100000)) `mod` 1000000

      n = (\x -> if (x < 0) then x + 16 else x)
          . (\x -> if isOffset then x - 5 else x)
          . (\x -> if (x > 9) then x - 1 else x)
          . (\x -> if (x > 15) then x - 1 else x)
          $ ord northingId - 64

      nn = case utmZoneChar of
             'Q'
               | (not(isOffset) && northingId < 'T') || (isOffset && (northingId < 'C' || northingId > 'E')) -> 2000000
               | otherwise -> 0
             'R' -> 2000000
             'S'
               | (not(isOffset) && northingId < 'R') || (isOffset && northingId > 'E') -> 4000000
               | otherwise -> 2000000
             'T' -> 4000000
             'U'
               | (not(isOffset) && northingId < 'P') || (isOffset && northingId > 'U') -> 6000000
               | otherwise -> 4000000
             'V' -> 6000000
             'W' -> 6000000
             'X' -> 8000000

      nx = nn + (100000 * (n - 1)) + northing
  U.mkUTMRef (fromIntegral ex) (fromIntegral nx) utmZoneChar utmZoneNumber