-- |

-- Module:      Data.Geo.Jord.Angle

-- Copyright:   (c) 2020 Cedric Liegeois

-- License:     BSD3

-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>

-- Stability:   experimental

-- Portability: portable

--

-- Types and functions for working with angles representing latitudes, longitude and bearings.

--

-- In order to use this module you should start with the following imports:

--

-- @

-- import Data.Geo.Jord.Angle (Angle)

-- import qualified Data.Geo.Jord.Angle as Angle

-- @

module Data.Geo.Jord.Angle
    (
    -- * The 'Angle' type

      Angle
    -- * Smart constructors

    , decimalDegrees
    , dms
    , radians
    -- * Calculations

    , arcLength
    , central
    , clockwiseDifference
    , isNegative
    , isWithin
    , negate
    , normalise
    -- * Trigonometric functions

    , asin
    , atan2
    , cos
    , sin
    -- * Accessors

    , getDegrees
    , getArcminutes
    , getArcseconds
    , getArcmilliseconds
    -- * Conversions

    , toDecimalDegrees
    , toRadians
    -- * Read

    , angle
    , read
    -- * Misc

    , add
    , subtract
    , zero
    ) where

import Control.Applicative ((<|>))
import Data.Fixed (mod')
import Prelude hiding (atan2, asin, acos, cos, negate, read, sin, subtract)
import qualified Prelude (atan2, asin, cos, sin)
import Text.ParserCombinators.ReadP (ReadP, char, option, readP_to_S, string)
import Text.Printf (printf)
import Text.Read (readMaybe)

import Data.Geo.Jord.Length (Length)
import qualified Data.Geo.Jord.Length as Length (metres, toMetres)
import Data.Geo.Jord.Parser

-- | An angle with a resolution of a microarcsecond.

-- When used as a latitude/longitude this roughly translate to a precision

-- of 0.03 millimetres at the equator.

newtype Angle =
    Angle
        { Angle -> Int
microarcseconds :: Int
        }
    deriving (Angle -> Angle -> Bool
(Angle -> Angle -> Bool) -> (Angle -> Angle -> Bool) -> Eq Angle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Angle -> Angle -> Bool
$c/= :: Angle -> Angle -> Bool
== :: Angle -> Angle -> Bool
$c== :: Angle -> Angle -> Bool
Eq)

-- | See 'angle'.

instance Read Angle where
    readsPrec :: Int -> ReadS Angle
readsPrec Int
_ = ReadP Angle -> ReadS Angle
forall a. ReadP a -> ReadS a
readP_to_S ReadP Angle
angle

-- | Show 'Angle' as degrees, minutes, seconds and milliseconds - e.g. 154°25'43.5".

instance Show Angle where
    show :: Angle -> String
show Angle
a =
        String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++
        Int -> String
forall a. Show a => a -> String
show Int
d String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
"°" String -> ShowS
forall a. [a] -> [a] -> [a]
++
        Int -> String
forall a. Show a => a -> String
show (Angle -> Int
getArcminutes Angle
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Angle -> Int
getArcseconds Angle
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%03d" (Angle -> Int
getArcmilliseconds Angle
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
      where
        d :: Int
d = Angle -> Int
getDegrees Angle
a
        s :: String
s =
            if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Angle -> Int
microarcseconds Angle
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
                then String
"-"
                else String
""

instance Ord Angle where
    <= :: Angle -> Angle -> Bool
(<=) (Angle Int
uas1) (Angle Int
uas2) = Int
uas1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
uas2

-- | Adds 2 angles.

add :: Angle -> Angle -> Angle
add :: Angle -> Angle -> Angle
add Angle
a1 Angle
a2 = Int -> Angle
Angle (Angle -> Int
microarcseconds Angle
a1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Angle -> Int
microarcseconds Angle
a2)

-- | Subtracts 2 angles.

subtract :: Angle -> Angle -> Angle
subtract :: Angle -> Angle -> Angle
subtract Angle
a1 Angle
a2 = Int -> Angle
Angle (Angle -> Int
microarcseconds Angle
a1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Angle -> Int
microarcseconds Angle
a2)

-- | 0 degrees.

zero :: Angle
zero :: Angle
zero = Int -> Angle
Angle Int
0

-- | 'Angle' from given decimal degrees. Any 'Double' is accepted: it must be

-- validated by the call site when representing a latitude or longitude.

decimalDegrees :: Double -> Angle
decimalDegrees :: Double -> Angle
decimalDegrees Double
dec = Int -> Angle
Angle (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
dec Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
3600000000.0))

-- | 'Angle' from the given degrees, arcminutes and __decimal__ arcseconds.

-- A 'Left' indicates that given arcminutes and/or arcseconds are invalid.

dms :: Int -> Int -> Double -> Either String Angle
dms :: Int -> Int -> Double -> Either String Angle
dms Int
degs Int
mins Double
secs
    | Int
mins Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
mins Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
59 = String -> Either String Angle
forall a b. a -> Either a b
Left (String
"Invalid arcminutes: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
mins)
    | Double
secs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 Bool -> Bool -> Bool
|| Double
secs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
60 = String -> Either String Angle
forall a b. a -> Either a b
Left (String
"Invalid arcseconds: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
secs)
    | Bool
otherwise = Angle -> Either String Angle
forall a b. b -> Either a b
Right (Double -> Angle
decimalDegrees Double
d)
  where
    d :: Double
d =
        Double -> Int -> Double
forall a b. (Num a, Num b, Ord b) => a -> b -> a
signed
            (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Num a => a -> a
abs Int
degs) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mins Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
60.0 :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
+
             (Double
secs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3600.0))
            (Int -> Int
forall a. Num a => a -> a
signum Int
degs)

-- | 'Angle' from the given radians.

radians :: Double -> Angle
radians :: Double -> Angle
radians Double
r = Double -> Angle
decimalDegrees (Double
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
180.0)

-- | @arcLength a r@ computes the 'Length' of the arc that subtends the angle @a@ for radius @r@.

arcLength :: Angle -> Length -> Length
arcLength :: Angle -> Length -> Length
arcLength Angle
a Length
r = Double -> Length
Length.metres (Length -> Double
Length.toMetres Length
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Angle -> Double
toRadians Angle
a)

-- | @central l r@ computes the central 'Angle' from the arc length @l@ and radius @r@.

central :: Length -> Length -> Angle
central :: Length -> Length -> Angle
central Length
s Length
r = Double -> Angle
radians (Length -> Double
Length.toMetres Length
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Length -> Double
Length.toMetres Length
r)

-- | @clockwiseDifference f s@ computes the angle between given angles, rotating clockwise.

clockwiseDifference :: Angle -> Angle -> Angle
clockwiseDifference :: Angle -> Angle -> Angle
clockwiseDifference Angle
f Angle
s = Double -> Angle
decimalDegrees Double
d
  where
    d :: Double
d = Double -> Double -> Double
cd (Angle -> Double
toDecimalDegrees Angle
f) (Angle -> Double
toDecimalDegrees Angle
s)

cd :: Double -> Double -> Double
cd :: Double -> Double -> Double
cd Double
d1 Double
d2
  | Double
d2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
d1 = Double -> Double -> Double
cd Double
d1 (Double
d2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
360.0)
  | Bool
otherwise = Double
d2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
d1

-- | Returns the given 'Angle' negated.

negate :: Angle -> Angle
negate :: Angle -> Angle
negate (Angle Int
millis) = Int -> Angle
Angle (-Int
millis)

-- | @normalise a n@ normalises @a@ to [0, @n@].

normalise :: Angle -> Angle -> Angle
normalise :: Angle -> Angle -> Angle
normalise Angle
a Angle
n = Double -> Angle
decimalDegrees Double
dec
  where
    dec :: Double
dec = Double -> Double -> Double
forall a. Real a => a -> a -> a
mod' (Angle -> Double
toDecimalDegrees Angle
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Angle -> Double
toDecimalDegrees Angle
n) Double
360.0

-- | Is given 'Angle' < 0?

isNegative :: Angle -> Bool
isNegative :: Angle -> Bool
isNegative (Angle Int
millis) = Int
millis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0

-- | Is given 'Angle' within range [@low@..@high@] inclusive?

isWithin :: Angle -> Angle -> Angle -> Bool
isWithin :: Angle -> Angle -> Angle -> Bool
isWithin (Angle Int
millis) (Angle Int
low) (Angle Int
high) = Int
millis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
low Bool -> Bool -> Bool
&& Int
millis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
high

-- | @atan2 y x@ computes the 'Angle' (from the positive x-axis) of the vector from the origin to the point (x,y).

atan2 :: Double -> Double -> Angle
atan2 :: Double -> Double -> Angle
atan2 Double
y Double
x = Double -> Angle
radians (Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
Prelude.atan2 Double
y Double
x)

-- | @asin a@ computes arc sine of @a@.

asin :: Double -> Angle
asin :: Double -> Angle
asin Double
a = Double -> Angle
radians (Double -> Double
forall a. Floating a => a -> a
Prelude.asin Double
a)

-- | @cos a@ returns the cosinus of @a@.

cos :: Angle -> Double
cos :: Angle -> Double
cos Angle
a = Double -> Double
forall a. Floating a => a -> a
Prelude.cos (Angle -> Double
toRadians Angle
a)

-- | @sin a@ returns the sinus of @a@.

sin :: Angle -> Double
sin :: Angle -> Double
sin Angle
a = Double -> Double
forall a. Floating a => a -> a
Prelude.sin (Angle -> Double
toRadians Angle
a)

-- | degrees to radians.

toRadians :: Angle -> Double
toRadians :: Angle -> Double
toRadians Angle
a = Angle -> Double
toDecimalDegrees Angle
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
180.0

-- | Converts the given 'Angle' to decimal degrees.

toDecimalDegrees :: Angle -> Double
toDecimalDegrees :: Angle -> Double
toDecimalDegrees (Angle Int
uas) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
uas Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3600000000.0

-- | @getDegrees a@ returns the degree component of @a@.

getDegrees :: Angle -> Int
getDegrees :: Angle -> Int
getDegrees Angle
a = Int -> Int -> Int
forall a b. (Num a, Num b, Ord b) => a -> b -> a
signed (Angle -> Double -> Double -> Int
field Angle
a Double
3600000000.0 Double
360.0) (Int -> Int
forall a. Num a => a -> a
signum (Angle -> Int
microarcseconds Angle
a))

-- | @getArcminutes a@ returns the arcminute component of @a@.

getArcminutes :: Angle -> Int
getArcminutes :: Angle -> Int
getArcminutes Angle
a = Angle -> Double -> Double -> Int
field Angle
a Double
60000000.0 Double
60.0

-- | @getArcseconds a@ returns the arcsecond component of @a@.

getArcseconds :: Angle -> Int
getArcseconds :: Angle -> Int
getArcseconds Angle
a = Angle -> Double -> Double -> Int
field Angle
a Double
1000000.0 Double
60.0

-- | @getArcmilliseconds a@ returns the arcmilliseconds component of @a@.

getArcmilliseconds :: Angle -> Int
getArcmilliseconds :: Angle -> Int
getArcmilliseconds Angle
a = Angle -> Double -> Double -> Int
field Angle
a Double
1000.0 Double
1000.0

field :: Angle -> Double -> Double -> Int
field :: Angle -> Double -> Double -> Int
field (Angle Int
uas) Double
divisor Double
modulo =
    Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double -> Double
forall a. Real a => a -> a -> a
mod' (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int
forall a. Num a => a -> a
abs Int
uas) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
divisor) Double
modulo) :: Int

signed :: (Num a, Num b, Ord b) => a -> b -> a
signed :: a -> b -> a
signed a
n b
s
    | b
s b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0 = -a
n
    | Bool
otherwise = a
n

-- | Parses and returns an 'Angle'.

--

-- Supported formats:

--

--     * d°m′s.ms″ - e.g. 55°36'21.3", where minutes, seconds and milliseconds are optional.

--

--     * decimal° - e.g. 55.6050° or -133°

--

-- Symbols:

--

--     * degree: ° or d

--

--     * minute: ', ′ or m

--

--     * second: ", ″, '' or s

angle :: ReadP Angle
angle :: ReadP Angle
angle = ReadP Angle
degsMinsSecs ReadP Angle -> ReadP Angle -> ReadP Angle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadP Angle
decimal

-- | Reads an 'Angle' from the given string using 'angle'.

read :: String -> Maybe Angle
read :: String -> Maybe Angle
read String
s = String -> Maybe Angle
forall a. Read a => String -> Maybe a
readMaybe String
s :: (Maybe Angle)

-- | Parses DMS.MS and returns an 'Angle'.

degsMinsSecs :: ReadP Angle
degsMinsSecs :: ReadP Angle
degsMinsSecs = do
    Int
d' <- (Int -> Int) -> ReadP Int -> ReadP Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ReadP Int
integer
    ReadP ()
degSymbol
    (Int
m', Double
s') <- (Int, Double) -> ReadP (Int, Double) -> ReadP (Int, Double)
forall a. a -> ReadP a -> ReadP a
option (Int
0, Double
0.0) (ReadP (Int, Double)
minsSecs ReadP (Int, Double) -> ReadP (Int, Double) -> ReadP (Int, Double)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadP (Int, Double)
minsOnly)
    case Int -> Int -> Double -> Either String Angle
dms Int
d' Int
m' Double
s' of
        Left String
err -> String -> ReadP Angle
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
        Right Angle
a -> Angle -> ReadP Angle
forall (m :: * -> *) a. Monad m => a -> m a
return Angle
a

-- | Parses arcminutes and arcseconds.

minsSecs :: ReadP (Int, Double)
minsSecs :: ReadP (Int, Double)
minsSecs = do
    Int
m' <- ReadP Int
natural
    ReadP ()
minSymbol
    Double
s' <- ReadP Double
number
    ReadP ()
secSymbol
    (Int, Double) -> ReadP (Int, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
m', Double
s')

-- | Parses minutes.

minsOnly :: ReadP (Int, Double)
minsOnly :: ReadP (Int, Double)
minsOnly = do
    Int
m' <- ReadP Int
natural
    ReadP ()
minSymbol
    (Int, Double) -> ReadP (Int, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
m', Double
0.0)

-- | Parses decimal degrees.

decimal :: ReadP Angle
decimal :: ReadP Angle
decimal = do
    Double
d <- ReadP Double
double
    ReadP ()
degSymbol
    Angle -> ReadP Angle
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Angle
decimalDegrees Double
d)

-- | skips degree symbol.

degSymbol :: ReadP ()
degSymbol :: ReadP ()
degSymbol = do
    Char
_ <- Char -> ReadP Char
char Char
'°' ReadP Char -> ReadP Char -> ReadP Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ReadP Char
char Char
'd'
    () -> ReadP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | skips minute symbol.

minSymbol :: ReadP ()
minSymbol :: ReadP ()
minSymbol = do
    Char
_ <- Char -> ReadP Char
char Char
'\'' ReadP Char -> ReadP Char -> ReadP Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ReadP Char
char Char
'′' ReadP Char -> ReadP Char -> ReadP Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ReadP Char
char Char
'm'
    () -> ReadP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | skips second symbol.

secSymbol :: ReadP ()
secSymbol :: ReadP ()
secSymbol = do
    String
_ <- String -> ReadP String
string String
"\"" ReadP String -> ReadP String -> ReadP String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ReadP String
string String
"''" ReadP String -> ReadP String -> ReadP String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ReadP String
string String
"″" ReadP String -> ReadP String -> ReadP String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ReadP String
string String
"s"
    () -> ReadP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()