-- |
-- Module:      Data.Geo.Jord.Length
-- Copyright:   (c) 2020 Cedric Liegeois
-- License:     BSD3
-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
-- Stability:   experimental
-- Portability: portable
--
-- Types and functions for working with (signed) lengths in metres, kilometres, nautical miles or feet.
--
-- In order to use this module you should start with the following imports:
--
-- @
-- import Data.Geo.Jord.Length (Length)
-- import qualified Data.Geo.Jord.Length as Length
-- @
--
module Data.Geo.Jord.Length
    (
    -- * The 'Length' type
      Length
    -- * Smart constructors
    , feet
    , kilometres
    , metres
    , nauticalMiles
    -- * Read
    , length
    , read
    -- * Conversions
    , toFeet
    , toKilometres
    , toMetres
    , toMillimetres
    , toNauticalMiles
    -- * Misc
    , add
    , subtract
    , zero
    ) where

import Control.Applicative ((<|>))
import Prelude hiding (length, read, subtract)
import Text.ParserCombinators.ReadP (ReadP, pfail, readP_to_S, skipSpaces, string)
import Text.Read (readMaybe)

import Data.Geo.Jord.Parser

-- | A length with a resolution of 1 micrometre.
newtype Length =
    Length
        { Length -> Int
micrometre :: Int
        }
    deriving (Length -> Length -> Bool
(Length -> Length -> Bool)
-> (Length -> Length -> Bool) -> Eq Length
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c== :: Length -> Length -> Bool
Eq)

-- | See 'length'.
instance Read Length where
    readsPrec :: Int -> ReadS Length
readsPrec Int
_ = ReadP Length -> ReadS Length
forall a. ReadP a -> ReadS a
readP_to_S ReadP Length
length

-- | Length is shown in metres when absolute value is <= 10 km and in kilometres otherwise.
instance Show Length where
    show :: Length -> String
show Length
l
        | Length -> Length
abs' Length
l Length -> Length -> Bool
forall a. Ord a => a -> a -> Bool
<= Double -> Length
kilometres Double
10 = Double -> String
forall a. Show a => a -> String
show (Length -> Double
toMetres Length
l) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"m"
        | Bool
otherwise = Double -> String
forall a. Show a => a -> String
show (Length -> Double
toKilometres Length
l) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"km"

instance Ord Length where
    <= :: Length -> Length -> Bool
(<=) (Length Int
l1) (Length Int
l2) = Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l2

-- | Adds 2 lengths.
add :: Length -> Length -> Length
add :: Length -> Length -> Length
add Length
a Length
b = Int -> Length
Length (Length -> Int
micrometre Length
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Length -> Int
micrometre Length
b)

-- | Subtracts 2 lengths.
subtract :: Length -> Length -> Length
subtract :: Length -> Length -> Length
subtract Length
a Length
b = Int -> Length
Length (Length -> Int
micrometre Length
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Length -> Int
micrometre Length
b)

-- | 0 length.
zero :: Length
zero :: Length
zero = Int -> Length
Length Int
0

-- | 'Length' from given amount of feet.
feet :: Double -> Length
feet :: Double -> Length
feet Double
ft = Int -> Length
Length (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
ft Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.3048 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m2um))

-- | 'Length' from given amount of kilometres.
kilometres :: Double -> Length
kilometres :: Double -> Length
kilometres Double
km = Int -> Length
Length (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
km Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m2um))

-- | 'Length' from given amount of metres.
metres :: Double -> Length
metres :: Double -> Length
metres Double
m = Int -> Length
Length (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m2um))

-- | 'Length' from given amount of nautical miles.
nauticalMiles :: Double -> Length
nauticalMiles :: Double -> Length
nauticalMiles Double
nm = Int -> Length
Length (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
nm Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1852.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m2um))

-- | Reads a 'Length' from the given string using 'length'.
read :: String -> Maybe Length
read :: String -> Maybe Length
read String
s = String -> Maybe Length
forall a. Read a => String -> Maybe a
readMaybe String
s :: (Maybe Length)

-- | @toFeet l@ converts @l@ to feet.
toFeet :: Length -> Double
toFeet :: Length -> Double
toFeet (Length Int
l) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
0.3048 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m2um)

-- | @toKilometres l@ converts @l@ to kilometres.
toKilometres :: Length -> Double
toKilometres :: Length -> Double
toKilometres (Length Int
l) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1000.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m2um)

-- | @toMetres l@ converts @l@ to metres.
toMetres :: Length -> Double
toMetres :: Length -> Double
toMetres (Length Int
l) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
m2um

-- | @toMillimetres l@ converts @l@ to millimetres.
toMillimetres :: Length -> Double
toMillimetres :: Length -> Double
toMillimetres (Length Int
l) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000.0

-- | @toNauticalMiles l@ converts @l@ to nautical miles.
toNauticalMiles :: Length -> Double
toNauticalMiles :: Length -> Double
toNauticalMiles (Length Int
l) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1852.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m2um)

-- | Parses and returns a 'Length' formatted as (-)float[m|km|nm|ft].
-- e.g. 3000m, 2.5km, -154nm or 10000ft.
--
length :: ReadP Length
length :: ReadP Length
length = do
    Double
v <- ReadP Double
number
    ReadP ()
skipSpaces
    String
u <- String -> ReadP String
string String
"m" ReadP String -> ReadP String -> ReadP String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ReadP String
string String
"km" ReadP String -> ReadP String -> ReadP String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ReadP String
string String
"nm" ReadP String -> ReadP String -> ReadP String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ReadP String
string String
"ft"
    case String
u of
        String
"m" -> Length -> ReadP Length
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Length
metres Double
v)
        String
"km" -> Length -> ReadP Length
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Length
kilometres Double
v)
        String
"nm" -> Length -> ReadP Length
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Length
nauticalMiles Double
v)
        String
"ft" -> Length -> ReadP Length
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Length
feet Double
v)
        String
_ -> ReadP Length
forall a. ReadP a
pfail

-- | metre to micrometre.
m2um :: Double
m2um :: Double
m2um = Double
1000.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000.0

abs' :: Length -> Length
abs' :: Length -> Length
abs' (Length Int
um) = Int -> Length
Length (Int -> Int
forall a. Num a => a -> a
abs Int
um)