module Data.Geo.Jord.Length
(
Length
, feet
, kilometres
, metres
, nauticalMiles
, length
, read
, toFeet
, toKilometres
, toMetres
, toMillimetres
, toNauticalMiles
, 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
newtype Length =
Length
{ micrometre :: Int
}
deriving (Eq)
instance Read Length where
readsPrec _ = readP_to_S length
instance Show Length where
show l
| abs' l <= kilometres 10 = show (toMetres l) ++ "m"
| otherwise = show (toKilometres l) ++ "km"
instance Ord Length where
(<=) (Length l1) (Length l2) = l1 <= l2
add :: Length -> Length -> Length
add a b = Length (micrometre a + micrometre b)
subtract :: Length -> Length -> Length
subtract a b = Length (micrometre a - micrometre b)
zero :: Length
zero = Length 0
feet :: Double -> Length
feet ft = Length (round (ft * 0.3048 * m2um))
kilometres :: Double -> Length
kilometres km = Length (round (km * 1000.0 * m2um))
metres :: Double -> Length
metres m = Length (round (m * m2um))
nauticalMiles :: Double -> Length
nauticalMiles nm = Length (round (nm * 1852.0 * m2um))
read :: String -> Maybe Length
read s = readMaybe s :: (Maybe Length)
toFeet :: Length -> Double
toFeet (Length l) = fromIntegral l / (0.3048 * m2um)
toKilometres :: Length -> Double
toKilometres (Length l) = fromIntegral l / (1000.0 * m2um)
toMetres :: Length -> Double
toMetres (Length l) = fromIntegral l / m2um
toMillimetres :: Length -> Double
toMillimetres (Length l) = fromIntegral l / 1000.0
toNauticalMiles :: Length -> Double
toNauticalMiles (Length l) = fromIntegral l / (1852.0 * m2um)
length :: ReadP Length
length = do
v <- number
skipSpaces
u <- string "m" <|> string "km" <|> string "nm" <|> string "ft"
case u of
"m" -> return (metres v)
"km" -> return (kilometres v)
"nm" -> return (nauticalMiles v)
"ft" -> return (feet v)
_ -> pfail
m2um :: Double
m2um = 1000.0 * 1000.0
abs' :: Length -> Length
abs' (Length um) = Length (abs um)