-- |

-- Module:      Data.Geo.Jord.Duration

-- Copyright:   (c) 2020 Cedric Liegeois

-- License:     BSD3

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

-- Stability:   experimental

-- Portability: portable

--

-- Types and functions for working with (signed) durations.

--

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

--

-- @

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

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

-- @

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

      Duration
    , toMilliseconds
    -- * Smart constructors

    , milliseconds
    , hours
    , minutes
    , seconds
    , hms
    -- * Conversions

    , toHours
    , toMinutes
    , toSeconds
    -- * Read

    , duration
    , read
    -- * Misc

    , add
    , subtract
    , zero
    ) where

import Prelude hiding (read, subtract)
import Text.ParserCombinators.ReadP (ReadP, char, option, readP_to_S)
import Text.Printf (printf)
import Text.Read (readMaybe)

import Data.Geo.Jord.Parser

-- | A duration with a resolution of 1 millisecond.

newtype Duration =
    Duration
        { Duration -> Int
toMilliseconds :: Int -- ^ the number of milliseconds in duration.

        }
    deriving (Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq)

-- | See 'duration'.

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

-- | Show 'Duration' as @(-)nHnMn.nS@.

instance Show Duration where
    show :: Duration -> String
show d :: Duration
d@(Duration Int
millis) =
        Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"M" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s 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" Int
ms String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"S"
      where
        h :: Int
h = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Duration -> Double
toHours Duration
d) :: Int
        m :: Int
m = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
millis Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3600000) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
60000.0 :: Double) :: Int
        s :: Int
s = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
millis Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
60000) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000.0 :: Double) :: Int
        ms :: Int
ms = Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int -> Int
forall a. Num a => a -> a
abs Int
millis) Int
1000

instance Ord Duration where
    <= :: Duration -> Duration -> Bool
(<=) (Duration Int
d1) (Duration Int
d2) = Int
d1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
d2

-- | Adds 2 durations.

add :: Duration -> Duration -> Duration
add :: Duration -> Duration -> Duration
add Duration
a Duration
b = Int -> Duration
Duration (Duration -> Int
toMilliseconds Duration
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Duration -> Int
toMilliseconds Duration
b)

-- | Subtracts 2 durations.

subtract :: Duration -> Duration -> Duration
subtract :: Duration -> Duration -> Duration
subtract Duration
a Duration
b = Int -> Duration
Duration (Duration -> Int
toMilliseconds Duration
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Duration -> Int
toMilliseconds Duration
b)

-- | 0 duration.

zero :: Duration
zero :: Duration
zero = Int -> Duration
Duration Int
0

-- | 'Duration' from hours minutes and decimal seconds.

hms :: Int -> Int -> Double -> Duration
hms :: Int -> Int -> Double -> Duration
hms Int
h Int
m Double
s = Double -> Duration
milliseconds (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
3600000 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60000 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000)

-- | 'Duration' from given amount of hours.

hours :: Double -> Duration
hours :: Double -> Duration
hours Double
h = Double -> Duration
milliseconds (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
3600000)

-- | 'Duration' from given amount of minutes.

minutes :: Double -> Duration
minutes :: Double -> Duration
minutes Double
m = Double -> Duration
milliseconds (Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60000)

-- | 'Duration' from given amount of seconds.

seconds :: Double -> Duration
seconds :: Double -> Duration
seconds Double
s = Double -> Duration
milliseconds (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000)

-- | 'Duration' from given amount of milliseconds.

milliseconds :: Double -> Duration
milliseconds :: Double -> Duration
milliseconds Double
ms = Int -> Duration
Duration (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
ms)

-- | @toHours d@ gets the number of hours in @d@.

toHours :: Duration -> Double
toHours :: Duration -> Double
toHours (Duration Int
ms) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ms Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3600000.0 :: Double

-- | @toMinutes d@ gets the number of minutes in @d@.

toMinutes :: Duration -> Double
toMinutes :: Duration -> Double
toMinutes (Duration Int
ms) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ms Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
60000.0 :: Double

-- | @toSeconds d@ gets the number of seconds in @d@.

toSeconds :: Duration -> Double
toSeconds :: Duration -> Double
toSeconds (Duration Int
ms) = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ms Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000.0 :: Double

-- | Reads a 'Duration' from the given string using 'duration'.

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

-- | Parses and returns an 'Duration' formatted @(-)nHnMn.nS@.

duration :: ReadP Duration
duration :: ReadP Duration
duration = do
    Double
h <- Double -> ReadP Double -> ReadP Double
forall a. a -> ReadP a -> ReadP a
option Double
0 ReadP Double
hoursP
    Double
m <- Double -> ReadP Double -> ReadP Double
forall a. a -> ReadP a -> ReadP a
option Double
0 ReadP Double
minutesP
    Double
s <- Double -> ReadP Double -> ReadP Double
forall a. a -> ReadP a -> ReadP a
option Double
0.0 ReadP Double
secondsP
    Duration -> ReadP Duration
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Duration
milliseconds (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
3600000.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60000.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000.0))

hoursP :: ReadP Double
hoursP :: ReadP Double
hoursP = do
    Int
h <- ReadP Int
integer
    Char
_ <- Char -> ReadP Char
char Char
'H'
    Double -> ReadP Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h :: Double)

minutesP :: ReadP Double
minutesP :: ReadP Double
minutesP = do
    Int
m <- ReadP Int
integer
    Char
_ <- Char -> ReadP Char
char Char
'M'
    Double -> ReadP Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m :: Double)

secondsP :: ReadP Double
secondsP :: ReadP Double
secondsP = do
    Double
s <- ReadP Double
number
    Char
_ <- Char -> ReadP Char
char Char
'S'
    Double -> ReadP Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
s