module Music.Theory.Time.Duration where
import qualified Data.List.Split as S
import Text.Printf
data Duration = Duration {hours :: Int
,minutes :: Int
,seconds :: Int
,milliseconds :: Int}
deriving (Eq)
s_sms :: (RealFrac n,Integral i) => n -> (i,i)
s_sms s =
let s' = floor s
ms = round ((s fromIntegral s') * 1000)
in (s',ms)
sms_s :: (Integral i) => (i,i) -> Double
sms_s (s,ms) = fromIntegral s + fromIntegral ms / 1000
read_duration_tuple :: String -> (Int,Int,Int,Int)
read_duration_tuple x =
let f :: (Int,Int,Double) -> (Int,Int,Int,Int)
f (h,m,s) = let (s',ms) = s_sms s in (h,m,s',ms)
in case S.splitOneOf ":" x of
[h,m,s] -> f (read h,read m,read s)
[m,s] -> f (0,read m,read s)
[s] -> f (0,0,read s)
_ -> error "read_duration_tuple"
read_duration :: String -> Duration
read_duration = tuple_to_duration id . read_duration_tuple
instance Read Duration where
readsPrec _ x = [(read_duration x,"")]
show_duration :: Duration -> String
show_duration (Duration h m s ms) =
let f :: Int -> String
f = printf "%02d"
g = f . fromIntegral
s' = sms_s (s,ms)
in concat [g h,":",g m,":",printf "%06.3f" s']
instance Show Duration where
show = show_duration
normalise_minutes :: Duration -> Duration
normalise_minutes (Duration h m s ms) =
let (h',m') = m `divMod` 60
in Duration (h + h') m' s ms
normalise_seconds :: Duration -> Duration
normalise_seconds (Duration h m s ms) =
let (m',s') = s `divMod` 60
in Duration h (m + m') s' ms
normalise_milliseconds :: Duration -> Duration
normalise_milliseconds (Duration h m s ms) =
let (s',ms') = ms `divMod` 1000
in Duration h m (s + s') ms'
normalise_duration :: Duration -> Duration
normalise_duration =
normalise_minutes .
normalise_seconds .
normalise_milliseconds
duration_to_tuple :: (Int -> a) -> Duration -> (a,a,a,a)
duration_to_tuple f (Duration h m s ms) = (f h,f m,f s,f ms)
tuple_to_duration :: (a -> Int) -> (a,a,a,a) -> Duration
tuple_to_duration f (h,m,s,ms) = Duration (f h) (f m) (f s) (f ms)
duration_to_hours :: Fractional n => Duration -> n
duration_to_hours d =
let (h,m,s,ms) = duration_to_tuple fromIntegral d
in h + (m / 60) + (s / (60 * 60)) + (ms / (60 * 60 * 1000))
duration_to_minutes :: Fractional n => Duration -> n
duration_to_minutes = (* 60) . duration_to_hours
duration_to_seconds :: Fractional n => Duration -> n
duration_to_seconds = (* 60) . duration_to_minutes
hours_to_duration :: RealFrac a => a -> Duration
hours_to_duration n =
let r = fromIntegral :: RealFrac a => Int -> a
h = (r . floor) n
m = (n h) * 60
(s,ms) = s_sms ((m (r . floor) m) * 60)
in Duration (floor h) (floor m) s ms
minutes_to_duration :: RealFrac a => a -> Duration
minutes_to_duration n = hours_to_duration (n / 60)
seconds_to_duration :: RealFrac a => a -> Duration
seconds_to_duration n = minutes_to_duration (n / 60)
nil_duration :: Duration
nil_duration = Duration 0 0 0 0
negate_duration :: Duration -> Duration
negate_duration (Duration h m s ms) =
let h' = if h > 0 then h else h
m' = if h == 0 && m > 0 then m else m
s' = if h == 0 && m == 0 && s > 0 then s else s
ms' = if h == 0 && m == 0 && s == 0 then ms else ms
in Duration h' m' s' ms'
duration_diff :: Duration -> Duration -> Duration
duration_diff p q =
let f = duration_to_hours :: Duration -> Double
(p',q') = (f p,f q)
g = normalise_duration . hours_to_duration
in case compare p' q' of
LT -> negate_duration (g (q' p'))
EQ -> nil_duration
GT -> g (p' q')