-- | Ordinary timing durations, in H:M:S:m (Hours:Minutes:Seconds:milliseconds)
module Music.Theory.Time.Duration where

import Text.Printf {- base -}

import qualified Data.List.Split as Split {- split -}

-- | Duration stored as /hours/, /minutes/, /seconds/ and /milliseconds/.
data Duration = Duration {Duration -> Int
hours :: Int
                         ,Duration -> Int
minutes :: Int
                         ,Duration -> Int
seconds :: Int
                         ,Duration -> Int
milliseconds :: Int}
                deriving (Duration -> Duration -> Bool
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)

{- | Convert fractional /seconds/ to integral /(seconds,milliseconds)/.

> s_sms 1.75 == (1,750)
-}
s_sms :: (RealFrac n,Integral i) => n -> (i,i)
s_sms :: forall n i. (RealFrac n, Integral i) => n -> (i, i)
s_sms n
s =
    let s' :: i
s' = forall a b. (RealFrac a, Integral b) => a -> b
floor n
s
        ms :: i
ms = forall a b. (RealFrac a, Integral b) => a -> b
round ((n
s forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral i
s') forall a. Num a => a -> a -> a
* n
1000)
    in (i
s',i
ms)

{- | Inverse of 's_sms'.

> sms_s (1,750) == 1.75
-}
sms_s :: (Integral i) => (i,i) -> Double
sms_s :: forall i. Integral i => (i, i) -> Double
sms_s (i
s,i
ms) = forall a b. (Integral a, Num b) => a -> b
fromIntegral i
s forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral i
ms forall a. Fractional a => a -> a -> a
/ Double
1000

{- | 'Read' function for 'Duration' tuple.
     The notation writes seconds fractionally, and allows hours and minutes to be elided if zero.
-}
read_duration_tuple :: String -> (Int,Int,Int,Int)
read_duration_tuple :: String -> (Int, Int, Int, Int)
read_duration_tuple String
x =
    let f :: (Int,Int,Double) -> (Int,Int,Int,Int)
        f :: (Int, Int, Double) -> (Int, Int, Int, Int)
f (Int
h,Int
m,Double
s) = let (Int
s',Int
ms) = forall n i. (RealFrac n, Integral i) => n -> (i, i)
s_sms Double
s in (Int
h,Int
m,Int
s',Int
ms)
    in case forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOneOf String
":" String
x of
        [String
h,String
m,String
s] -> (Int, Int, Double) -> (Int, Int, Int, Int)
f (forall a. Read a => String -> a
read String
h,forall a. Read a => String -> a
read String
m,forall a. Read a => String -> a
read String
s)
        [String
m,String
s] -> (Int, Int, Double) -> (Int, Int, Int, Int)
f (Int
0,forall a. Read a => String -> a
read String
m,forall a. Read a => String -> a
read String
s)
        [String
s] -> (Int, Int, Double) -> (Int, Int, Int, Int)
f (Int
0,Int
0,forall a. Read a => String -> a
read String
s)
        [String]
_ -> forall a. HasCallStack => String -> a
error String
"read_duration_tuple"

{- | 'Read' function for 'Duration'.  Allows either @H:M:S.MS@ or @M:S.MS@ or @S.MS@.

> read_duration "01:35:05.250" == Duration 1 35 5 250
> read_duration    "35:05.250" == Duration 0 35 5 250
> read_duration       "05.250" == Duration 0 0 5 250
-}
read_duration :: String -> Duration
read_duration :: String -> Duration
read_duration = forall a. (a -> Int) -> (a, a, a, a) -> Duration
tuple_to_duration forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Int, Int, Int, Int)
read_duration_tuple

instance Read Duration where
    readsPrec :: Int -> ReadS Duration
readsPrec Int
_ String
x = [(String -> Duration
read_duration String
x,String
"")]

{- | 'Show' function for 'Duration'.
     Inverse of read_duration.
     Hours and minutes are always shown, even if zero.

> show_duration (Duration 1 35 5 250) == "01:35:05.250"
> show (Duration 1 15 0 000) == "01:15:00.000"
> show (Duration 0 0 3 500) == "00:00:03.500"
-}
show_duration :: Duration -> String
show_duration :: Duration -> String
show_duration (Duration Int
h Int
m Int
s Int
ms) =
    let f :: Int -> String
        f :: Int -> String
f = forall r. PrintfType r => String -> r
printf String
"%02d"
        g :: Int -> String
g = Int -> String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
        s' :: Double
s' = forall i. Integral i => (i, i) -> Double
sms_s (Int
s,Int
ms)
    in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> String
g Int
h,String
":",Int -> String
g Int
m,String
":",forall r. PrintfType r => String -> r
printf String
"%06.3f" Double
s']

instance Show Duration where
    show :: Duration -> String
show = Duration -> String
show_duration

-- | If minutes is not in (0,59) then edit hours.
normalise_minutes :: Duration -> Duration
normalise_minutes :: Duration -> Duration
normalise_minutes (Duration Int
h Int
m Int
s Int
ms) =
    let (Int
h',Int
m') = Int
m forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
    in Int -> Int -> Int -> Int -> Duration
Duration (Int
h forall a. Num a => a -> a -> a
+ Int
h') Int
m' Int
s Int
ms

-- | If seconds is not in (0,59) then edit minutes.
normalise_seconds :: Duration -> Duration
normalise_seconds :: Duration -> Duration
normalise_seconds (Duration Int
h Int
m Int
s Int
ms) =
    let (Int
m',Int
s') = Int
s forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
    in Int -> Int -> Int -> Int -> Duration
Duration Int
h (Int
m forall a. Num a => a -> a -> a
+ Int
m') Int
s' Int
ms

-- | If milliseconds is not in (0,999) then edit seconds.
normalise_milliseconds :: Duration -> Duration
normalise_milliseconds :: Duration -> Duration
normalise_milliseconds (Duration Int
h Int
m Int
s Int
ms) =
    let (Int
s',Int
ms') = Int
ms forall a. Integral a => a -> a -> (a, a)
`divMod` Int
1000
    in Int -> Int -> Int -> Int -> Duration
Duration Int
h Int
m (Int
s forall a. Num a => a -> a -> a
+ Int
s') Int
ms'

-- | Normalise duration so that all parts are in normal ranges.
normalise_duration :: Duration -> Duration
normalise_duration :: Duration -> Duration
normalise_duration =
    Duration -> Duration
normalise_minutes forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Duration -> Duration
normalise_seconds forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Duration -> Duration
normalise_milliseconds

{- | Extract 'Duration' tuple applying filter function at each element

> duration_to_tuple id (Duration 1 35 5 250) == (1,35,5,250)
-}
duration_to_tuple :: (Int -> a) -> Duration -> (a,a,a,a)
duration_to_tuple :: forall a. (Int -> a) -> Duration -> (a, a, a, a)
duration_to_tuple Int -> a
f (Duration Int
h Int
m Int
s Int
ms) = (Int -> a
f Int
h,Int -> a
f Int
m,Int -> a
f Int
s,Int -> a
f Int
ms)

-- | Inverse of 'duration_to_tuple'.
tuple_to_duration :: (a -> Int) -> (a,a,a,a) -> Duration
tuple_to_duration :: forall a. (a -> Int) -> (a, a, a, a) -> Duration
tuple_to_duration a -> Int
f (a
h,a
m,a
s,a
ms) = Int -> Int -> Int -> Int -> Duration
Duration (a -> Int
f a
h) (a -> Int
f a
m) (a -> Int
f a
s) (a -> Int
f a
ms)

{- | Duration as fractional hours.

> duration_to_hours (read "01:35:05.250") == 1.5847916666666668
-}
duration_to_hours :: Fractional n => Duration -> n
duration_to_hours :: forall n. Fractional n => Duration -> n
duration_to_hours Duration
d =
    let (n
h,n
m,n
s,n
ms) = forall a. (Int -> a) -> Duration -> (a, a, a, a)
duration_to_tuple forall a b. (Integral a, Num b) => a -> b
fromIntegral Duration
d
    in n
h forall a. Num a => a -> a -> a
+ (n
m forall a. Fractional a => a -> a -> a
/ n
60) forall a. Num a => a -> a -> a
+ (n
s forall a. Fractional a => a -> a -> a
/ (n
60 forall a. Num a => a -> a -> a
* n
60)) forall a. Num a => a -> a -> a
+ (n
ms forall a. Fractional a => a -> a -> a
/ (n
60 forall a. Num a => a -> a -> a
* n
60 forall a. Num a => a -> a -> a
* n
1000))

{- | Duration as fractional minutes.

> duration_to_minutes (read "01:35:05.250") == 95.0875
-}
duration_to_minutes :: Fractional n => Duration -> n
duration_to_minutes :: forall n. Fractional n => Duration -> n
duration_to_minutes = (forall a. Num a => a -> a -> a
* n
60) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Fractional n => Duration -> n
duration_to_hours

{- | Duration as fractional seconds.

> duration_to_seconds (read "01:35:05.250") == 5705.25
-}
duration_to_seconds :: Fractional n => Duration -> n
duration_to_seconds :: forall n. Fractional n => Duration -> n
duration_to_seconds = (forall a. Num a => a -> a -> a
* n
60) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Fractional n => Duration -> n
duration_to_minutes

{- | Inverse of duration_to_hours.

> hours_to_duration 1.5847916 == Duration 1 35 5 250
-}
hours_to_duration :: RealFrac a => a -> Duration
hours_to_duration :: forall a. RealFrac a => a -> Duration
hours_to_duration a
n =
    let r :: Int -> a
r = forall a b. (Integral a, Num b) => a -> b
fromIntegral :: RealFrac a => Int -> a
        h :: a
h = (Int -> a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor) a
n
        m :: a
m = (a
n forall a. Num a => a -> a -> a
- a
h) forall a. Num a => a -> a -> a
* a
60
        (Int
s,Int
ms) = forall n i. (RealFrac n, Integral i) => n -> (i, i)
s_sms ((a
m forall a. Num a => a -> a -> a
- (Int -> a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor) a
m) forall a. Num a => a -> a -> a
* a
60)
    in Int -> Int -> Int -> Int -> Duration
Duration (forall a b. (RealFrac a, Integral b) => a -> b
floor a
h) (forall a b. (RealFrac a, Integral b) => a -> b
floor a
m) Int
s Int
ms

-- | Inverse of duration_to_minutes.
minutes_to_duration :: RealFrac a => a -> Duration
minutes_to_duration :: forall a. RealFrac a => a -> Duration
minutes_to_duration a
n = forall a. RealFrac a => a -> Duration
hours_to_duration (a
n forall a. Fractional a => a -> a -> a
/ a
60)

-- | Inverse of duration_to_seconds.
seconds_to_duration :: RealFrac a => a -> Duration
seconds_to_duration :: forall a. RealFrac a => a -> Duration
seconds_to_duration a
n = forall a. RealFrac a => a -> Duration
minutes_to_duration (a
n forall a. Fractional a => a -> a -> a
/ a
60)

-- | Empty (zero) duration.
nil_duration :: Duration
nil_duration :: Duration
nil_duration = Int -> Int -> Int -> Int -> Duration
Duration Int
0 Int
0 Int
0 Int
0

-- | Negate the leftmost non-zero element of Duration.
negate_duration :: Duration -> Duration
negate_duration :: Duration -> Duration
negate_duration (Duration Int
h Int
m Int
s Int
ms) =
    let h' :: Int
h' = if Int
h forall a. Ord a => a -> a -> Bool
> Int
0 then -Int
h else Int
h
        m' :: Int
m' = if Int
h forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
m forall a. Ord a => a -> a -> Bool
> Int
0 then -Int
m else Int
m
        s' :: Int
s' = if Int
h forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
m forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
s forall a. Ord a => a -> a -> Bool
> Int
0 then -Int
s else Int
s
        ms' :: Int
ms' = if Int
h forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
m forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
s forall a. Eq a => a -> a -> Bool
== Int
0 then -Int
ms else Int
ms
    in Int -> Int -> Int -> Int -> Duration
Duration Int
h' Int
m' Int
s' Int
ms'

{- | Difference between two durations as a duration.
     Implemented by translation to and from Rational fractional hours.

> duration_diff (Duration 1 35 5 250) (Duration 0 25 1 125) == Duration 1 10 4 125
> duration_diff (Duration 0 25 1 125) (Duration 1 35 5 250) == Duration (-1) 10 4 125
> duration_diff (Duration 0 25 1 125) (Duration 0 25 1 250) == Duration 0 0 0 (-125)
-}
duration_diff :: Duration -> Duration -> Duration
duration_diff :: Duration -> Duration -> Duration
duration_diff Duration
p Duration
q =
    let f :: Duration -> Rational
f = forall n. Fractional n => Duration -> n
duration_to_hours :: Duration -> Rational
        (Rational
p',Rational
q') = (Duration -> Rational
f Duration
p,Duration -> Rational
f Duration
q)
        g :: Rational -> Duration
g = Duration -> Duration
normalise_duration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFrac a => a -> Duration
hours_to_duration
    in case forall a. Ord a => a -> a -> Ordering
compare Rational
p' Rational
q' of
         Ordering
LT -> Duration -> Duration
negate_duration (Rational -> Duration
g (Rational
q' forall a. Num a => a -> a -> a
- Rational
p'))
         Ordering
EQ -> Duration
nil_duration
         Ordering
GT -> Rational -> Duration
g (Rational
p' forall a. Num a => a -> a -> a
- Rational
q')