{- | Ordinary time and duration notations.
     In terms of Weeks, Days, Hours, Minutes, Second and Centiseconds.
     c.f. "Music.Theory.Time.Duration".
-}
module Music.Theory.Time.Notation where

import Text.Printf {- base -}

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

import qualified Music.Theory.Function as Function {- hmt-base -}
import qualified Music.Theory.List as List {- hmt-base -}

-- * Integral types

-- | Week, one-indexed, ie. 1-52
type Week = Int

-- | Week, one-indexed, ie. 1-31
type Day = Int

-- | Hour, zero-indexed, ie. 0-23
type Hour = Int

-- | Minute, zero-indexed, ie. 0-59
type Min = Int

-- | Second, zero-indexed, ie. 0-59
type Sec = Int

-- | Centi-seconds, zero-indexed, ie. 0-99
type Csec = Int -- (0-99)

-- * Composite types

-- | Minutes, seconds as @(min,sec)@
type MinSec = (Min,Sec)

-- | Generic MinSec
type GMinSec n = (n,n)

-- | Minutes, seconds, centi-seconds as @(min,sec,csec)@
type MinCsec = (Min,Sec,Csec)

-- | Generic MinCsec
type GMinCsec n = (n,n,n)

-- | (Hours,Minutes,Seconds)
type Hms = (Hour,Min,Sec)

-- | (Days,Hours,Minutes,Seconds)
type Dhms = (Day,Hour,Min,Sec)

-- * Fractional types

-- | Fractional days.
type FDay = Double

-- | Fractional hour, ie. 1.50 is one and a half hours, ie. 1 hour and 30 minutes.
type FHour = Double

-- | Fractional minute, ie. 1.50 is one and a half minutes, ie. 1 minute and 30 seconds, cf. 'FMinSec'
type FMin = Double

-- | Fractional seconds.
type FSec = Double

-- | Fractional minutes and seconds (mm.ss, ie. 01.45 is 1 minute and 45 seconds).
type FMinSec = Double

-- * Time.UTCTime format strings.

-- | 'Time.parseTimeOrError' with 'Time.defaultTimeLocale'.
parse_time_str :: Time.ParseTime t => String -> String -> t
parse_time_str :: forall t. ParseTime t => String -> String -> t
parse_time_str = forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
Time.parseTimeOrError Bool
True TimeLocale
Time.defaultTimeLocale

format_time_str :: Time.FormatTime t => String -> t -> String
format_time_str :: forall t. FormatTime t => String -> t -> String
format_time_str = forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
Time.defaultTimeLocale

-- * Iso-8601

-- | Parse date in ISO-8601 extended (@YYYY-MM-DD@) or basic (@YYYYMMDD@) form.
--
-- > Time.toGregorian (Time.utctDay (parse_iso8601_date "2011-10-09")) == (2011,10,09)
-- > Time.toGregorian (Time.utctDay (parse_iso8601_date "20190803")) == (2019,08,03)
parse_iso8601_date :: String -> Time.UTCTime
parse_iso8601_date :: String -> UTCTime
parse_iso8601_date String
s =
  case forall (t :: * -> *) a. Foldable t => t a -> Sec
length String
s of
    Sec
8 -> forall t. ParseTime t => String -> String -> t
parse_time_str String
"%Y%m%d" String
s -- basic
    Sec
10 -> forall t. ParseTime t => String -> String -> t
parse_time_str String
"%F" String
s -- extended
    Sec
_ -> forall a. HasCallStack => String -> a
error String
"parse_iso8601_date?"

-- | Format date in ISO-8601 form.
--
-- > format_iso8601_date True (parse_iso8601_date "2011-10-09") == "2011-10-09"
-- > format_iso8601_date False (parse_iso8601_date "20190803") == "20190803"
format_iso8601_date :: Time.FormatTime t => Bool -> t -> String
format_iso8601_date :: forall t. FormatTime t => Bool -> t -> String
format_iso8601_date Bool
ext = if Bool
ext then forall t. FormatTime t => String -> t -> String
format_time_str String
"%F" else forall t. FormatTime t => String -> t -> String
format_time_str String
"%Y%m%d"

{- | Format date in ISO-8601 (@YYYY-WWW@) form.

> r = ["2016-W52","2011-W40"]
> map (format_iso8601_week . parse_iso8601_date) ["2017-01-01","2011-10-09"] == r

-}
format_iso8601_week :: Time.FormatTime t => t -> String
format_iso8601_week :: forall t. FormatTime t => t -> String
format_iso8601_week = forall t. FormatTime t => String -> t -> String
format_time_str String
"%G-W%V"

-- | Parse ISO-8601 time is extended (@HH:MM:SS@) or basic (@HHMMSS@) form.
--
-- > format_iso8601_time True (parse_iso8601_time "21:44:00") == "21:44:00"
-- > format_iso8601_time False (parse_iso8601_time "172511") == "172511"
parse_iso8601_time :: String -> Time.UTCTime
parse_iso8601_time :: String -> UTCTime
parse_iso8601_time String
s =
  case forall (t :: * -> *) a. Foldable t => t a -> Sec
length String
s of
    Sec
6 -> forall t. ParseTime t => String -> String -> t
parse_time_str String
"%H%M%S" String
s -- basic
    Sec
8 -> forall t. ParseTime t => String -> String -> t
parse_time_str String
"%H:%M:%S" String
s -- extended
    Sec
_ -> forall a. HasCallStack => String -> a
error String
"parse_iso8601_time?"

-- | Format time in ISO-8601 form.
--
-- > format_iso8601_time True (parse_iso8601_date_time "2011-10-09T21:44:00") == "21:44:00"
-- > format_iso8601_time False (parse_iso8601_date_time "20190803T172511") == "172511"
format_iso8601_time :: Time.FormatTime t => Bool -> t -> String
format_iso8601_time :: forall t. FormatTime t => Bool -> t -> String
format_iso8601_time Bool
ext = forall t. FormatTime t => String -> t -> String
format_time_str (if Bool
ext then String
"%H:%M:%S" else String
"%H%M%S")

-- | Parse date and time in extended or basic forms.
--
-- > Time.utctDayTime (parse_iso8601_date_time "2011-10-09T21:44:00") == Time.secondsToDiffTime 78240
-- > Time.utctDayTime (parse_iso8601_date_time "20190803T172511") == Time.secondsToDiffTime 62711
parse_iso8601_date_time :: String -> Time.UTCTime
parse_iso8601_date_time :: String -> UTCTime
parse_iso8601_date_time String
s =
  case forall (t :: * -> *) a. Foldable t => t a -> Sec
length String
s of
    Sec
15 -> forall t. ParseTime t => String -> String -> t
parse_time_str String
"%Y%m%dT%H%M%S" String
s -- basic
    Sec
19 -> forall t. ParseTime t => String -> String -> t
parse_time_str String
"%FT%H:%M:%S" String
s -- extended
    Sec
_ -> forall a. HasCallStack => String -> a
error (String
"parse_iso8601_date_time: " forall a. [a] -> [a] -> [a]
++ String
s)

{- | Format date in @YYYY-MM-DD@ and time in @HH:MM:SS@ forms.

> t = parse_iso8601_date_time "2011-10-09T21:44:00"
> format_iso8601_date_time True t == "2011-10-09T21:44:00"
> format_iso8601_date_time False t == "20111009T214400"

-}
format_iso8601_date_time :: Time.FormatTime t => Bool -> t -> String
format_iso8601_date_time :: forall t. FormatTime t => Bool -> t -> String
format_iso8601_date_time Bool
ext = forall t. FormatTime t => String -> t -> String
format_time_str (if Bool
ext then String
"%FT%H:%M:%S" else String
"%Y%m%dT%H%M%S")

-- * FMin

-- | 'fsec_to_minsec' . '*' 60
--
-- > fmin_to_minsec 6.48 == (6,29)
fmin_to_minsec :: FMin -> MinSec
fmin_to_minsec :: FSec -> MinSec
fmin_to_minsec = FSec -> MinSec
fsec_to_minsec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
(*) FSec
60

-- * FSec

-- | Translate fractional seconds to picoseconds.
--
-- > fsec_to_picoseconds 78240.05
fsec_to_picoseconds :: FSec -> Integer
fsec_to_picoseconds :: FSec -> Integer
fsec_to_picoseconds FSec
s = forall a b. (RealFrac a, Integral b) => a -> b
floor (FSec
s forall a. Num a => a -> a -> a
* (FSec
10 forall a. Floating a => a -> a -> a
** FSec
12))

fsec_to_difftime :: FSec -> Time.DiffTime
fsec_to_difftime :: FSec -> DiffTime
fsec_to_difftime = Integer -> DiffTime
Time.picosecondsToDiffTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSec -> Integer
fsec_to_picoseconds

-- * FMinSec

-- | Translate fractional minutes.seconds to picoseconds.
--
-- > map fminsec_to_fsec [0.45,15.355] == [45,935.5]
fminsec_to_fsec :: FMinSec -> FSec
fminsec_to_fsec :: FSec -> FSec
fminsec_to_fsec FSec
n =
    let m :: FSec
m = FSec -> FSec
ffloor FSec
n
        s :: FSec
s = (FSec
n forall a. Num a => a -> a -> a
- FSec
m) forall a. Num a => a -> a -> a
* FSec
100
    in (FSec
m forall a. Num a => a -> a -> a
* FSec
60) forall a. Num a => a -> a -> a
+ FSec
s

fminsec_to_sec_generic :: (RealFrac f,Integral i) => f -> i
fminsec_to_sec_generic :: forall f i. (RealFrac f, Integral i) => f -> i
fminsec_to_sec_generic f
n =
    let m :: i
m = forall a b. (RealFrac a, Integral b) => a -> b
floor f
n
        s :: i
s = forall a b. (RealFrac a, Integral b) => a -> b
round ((f
n forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral i
m) forall a. Num a => a -> a -> a
* f
100)
    in (i
m forall a. Num a => a -> a -> a
* i
60) forall a. Num a => a -> a -> a
+ i
s

-- | Fractional minutes are mm.ss, so that 15.35 is 15 minutes and 35 seconds.
--
-- > map fminsec_to_sec [0.45,15.35] == [45,935]
fminsec_to_sec :: FMinSec -> Sec
fminsec_to_sec :: FSec -> Sec
fminsec_to_sec = forall f i. (RealFrac f, Integral i) => f -> i
fminsec_to_sec_generic

-- > fsec_to_fminsec 935.5 == 15.355
fsec_to_fminsec :: FSec -> FMinSec
fsec_to_fminsec :: FSec -> FSec
fsec_to_fminsec FSec
n =
    let m :: FSec
m = FSec -> FSec
ffloor (FSec
n forall a. Fractional a => a -> a -> a
/ FSec
60)
        s :: FSec
s = FSec
n forall a. Num a => a -> a -> a
- (FSec
m forall a. Num a => a -> a -> a
* FSec
60)
    in FSec
m forall a. Num a => a -> a -> a
+ (FSec
s forall a. Fractional a => a -> a -> a
/ FSec
100)

-- > sec_to_fminsec 935 == 15.35
sec_to_fminsec :: Sec -> FMinSec
sec_to_fminsec :: Sec -> FSec
sec_to_fminsec Sec
n =
    let m :: FSec
m = FSec -> FSec
ffloor (forall a b. (Integral a, Num b) => a -> b
fromIntegral Sec
n forall a. Fractional a => a -> a -> a
/ FSec
60)
        s :: FSec
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Sec
n forall a. Num a => a -> a -> a
- (FSec
m forall a. Num a => a -> a -> a
* FSec
60)
    in FSec
m forall a. Num a => a -> a -> a
+ (FSec
s forall a. Fractional a => a -> a -> a
/ FSec
100)

-- > fminsec_add 1.30 0.45 == 2.15
-- > fminsec_add 1.30 0.45 == 2.15
fminsec_add :: Function.BinOp FMinSec
fminsec_add :: BinOp FSec
fminsec_add FSec
p FSec
q = FSec -> FSec
fsec_to_fminsec (FSec -> FSec
fminsec_to_fsec FSec
p forall a. Num a => a -> a -> a
+ FSec -> FSec
fminsec_to_fsec FSec
q)

fminsec_sub :: Function.BinOp FMinSec
fminsec_sub :: BinOp FSec
fminsec_sub FSec
p FSec
q = FSec -> FSec
fsec_to_fminsec (FSec -> FSec
fminsec_to_fsec FSec
p forall a. Num a => a -> a -> a
- FSec -> FSec
fminsec_to_fsec FSec
q)

-- > fminsec_mul 0.45 2 == 1.30
fminsec_mul :: Function.BinOp FMinSec
fminsec_mul :: BinOp FSec
fminsec_mul FSec
t FSec
n = FSec -> FSec
fsec_to_fminsec (FSec -> FSec
fminsec_to_fsec FSec
t forall a. Num a => a -> a -> a
* FSec
n)

-- * FHour

-- | Type specialised 'fromInteger' of 'floor'.
ffloor :: Double -> Double
ffloor :: FSec -> FSec
ffloor = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor

-- | Fractional hour to (hours,minutes,seconds).
--
-- > fhour_to_hms 21.75 == (21,45,0)
fhour_to_hms :: FHour -> Hms
fhour_to_hms :: FSec -> Hms
fhour_to_hms FSec
h =
    let m :: FSec
m = (FSec
h forall a. Num a => a -> a -> a
- FSec -> FSec
ffloor FSec
h) forall a. Num a => a -> a -> a
* FSec
60
        s :: FSec
s = (FSec
m forall a. Num a => a -> a -> a
- FSec -> FSec
ffloor FSec
m) forall a. Num a => a -> a -> a
* FSec
60
    in (forall a b. (RealFrac a, Integral b) => a -> b
floor FSec
h,forall a b. (RealFrac a, Integral b) => a -> b
floor FSec
m,forall a b. (RealFrac a, Integral b) => a -> b
round FSec
s)

-- | Hms to fractional hours.
--
-- > hms_to_fhour (21,45,0) == 21.75
hms_to_fhour :: Hms -> FHour
hms_to_fhour :: Hms -> FSec
hms_to_fhour (Sec
h,Sec
m,Sec
s) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Sec
h forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Sec
m forall a. Fractional a => a -> a -> a
/ FSec
60) forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Sec
s forall a. Fractional a => a -> a -> a
/ (FSec
60 forall a. Num a => a -> a -> a
* FSec
60))

-- | Fractional hour to seconds.
--
-- > fhour_to_fsec 21.75 == 78300.0
fhour_to_fsec :: FHour -> FSec
fhour_to_fsec :: FSec -> FSec
fhour_to_fsec = forall a. Num a => a -> a -> a
(*) (FSec
60 forall a. Num a => a -> a -> a
* FSec
60)

fhour_to_difftime :: FHour -> Time.DiffTime
fhour_to_difftime :: FSec -> DiffTime
fhour_to_difftime = FSec -> DiffTime
fsec_to_difftime forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSec -> FSec
fhour_to_fsec

-- * FDay

-- | Time in fractional days.
--
-- > round (utctime_to_fday (parse_iso8601_date_time "2011-10-09T09:00:00")) == 55843
-- > round (utctime_to_fday (parse_iso8601_date_time "2011-10-09T21:00:00")) == 55844
utctime_to_fday :: Time.UTCTime -> FDay
utctime_to_fday :: UTCTime -> FSec
utctime_to_fday UTCTime
t =
    let d :: Day
d = UTCTime -> Day
Time.utctDay UTCTime
t
        d' :: FSec
d' = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day -> Integer
Time.toModifiedJulianDay Day
d)
        s :: DiffTime
s = UTCTime -> DiffTime
Time.utctDayTime UTCTime
t
        s_max :: FSec
s_max = FSec
86401
    in FSec
d' forall a. Num a => a -> a -> a
+ (forall a. Fractional a => Rational -> a
fromRational (forall a. Real a => a -> Rational
toRational DiffTime
s) forall a. Fractional a => a -> a -> a
/ FSec
s_max)

-- * DiffTime

-- | 'Time.DiffTime' in fractional seconds.
--
-- > difftime_to_fsec (hms_to_difftime (21,44,30)) == 78270
difftime_to_fsec :: Time.DiffTime -> FSec
difftime_to_fsec :: DiffTime -> FSec
difftime_to_fsec = forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational

-- | 'Time.DiffTime' in fractional minutes.
--
-- > difftime_to_fmin (hms_to_difftime (21,44,30)) == 1304.5
difftime_to_fmin :: Time.DiffTime -> Double
difftime_to_fmin :: DiffTime -> FSec
difftime_to_fmin = (forall a. Fractional a => a -> a -> a
/ FSec
60) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> FSec
difftime_to_fsec

-- | 'Time.DiffTime' in fractional hours.
--
-- > difftime_to_fhour (hms_to_difftime (21,45,00)) == 21.75
difftime_to_fhour :: Time.DiffTime -> FHour
difftime_to_fhour :: DiffTime -> FSec
difftime_to_fhour = (forall a. Fractional a => a -> a -> a
/ FSec
60) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> FSec
difftime_to_fmin

hms_to_difftime :: Hms -> Time.DiffTime
hms_to_difftime :: Hms -> DiffTime
hms_to_difftime = FSec -> DiffTime
fhour_to_difftime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hms -> FSec
hms_to_fhour

-- * Hms

hms_to_sec :: Hms -> Sec
hms_to_sec :: Hms -> Sec
hms_to_sec (Sec
h,Sec
m,Sec
s) = Sec
h forall a. Num a => a -> a -> a
* Sec
60 forall a. Num a => a -> a -> a
* Sec
60 forall a. Num a => a -> a -> a
+ Sec
m forall a. Num a => a -> a -> a
* Sec
60 forall a. Num a => a -> a -> a
+ Sec
s

-- | Seconds to (hours,minutes,seconds).
--
-- > map sec_to_hms [60-1,60+1,60*60-1,60*60+1] == [(0,0,59),(0,1,1),(0,59,59),(1,0,1)]
sec_to_hms :: Sec -> Hms
sec_to_hms :: Sec -> Hms
sec_to_hms Sec
s =
  let (Sec
h,Sec
s') = Sec
s forall a. Integral a => a -> a -> (a, a)
`divMod` (Sec
60 forall a. Num a => a -> a -> a
* Sec
60)
      (Sec
m,Sec
s'') = forall n. Integral n => n -> GMinSec n
sec_to_minsec Sec
s'
  in (Sec
h,Sec
m,Sec
s'')

-- | 'Hms' pretty printer.
--
-- > map (hms_pp True) [(0,1,2),(1,2,3)] == ["01:02","01:02:03"]
hms_pp :: Bool -> Hms -> String
hms_pp :: Bool -> Hms -> String
hms_pp Bool
trunc (Sec
h,Sec
m,Sec
s) =
  if Bool
trunc Bool -> Bool -> Bool
&& Sec
h forall a. Eq a => a -> a -> Bool
== Sec
0
  then forall r. PrintfType r => String -> r
printf String
"%02d:%02d" Sec
m Sec
s
  else forall r. PrintfType r => String -> r
printf String
"%02d:%02d:%02d" Sec
h Sec
m Sec
s

-- * 'Hms' parser.
--
-- > hms_parse "0:01:00" == (0,1,0)
hms_parse :: String -> Hms
hms_parse :: String -> Hms
hms_parse String
x =
    case forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn String
":" String
x of
      [String
h,String
m,String
s] -> (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]
_ -> forall a. HasCallStack => String -> a
error String
"parse_hms"

-- * MinSec

-- | 'divMod' by @60@.
--
-- > sec_to_minsec 123 == (2,3)
sec_to_minsec :: Integral n => n -> GMinSec n
sec_to_minsec :: forall n. Integral n => n -> GMinSec n
sec_to_minsec = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod n
60

-- | Inverse of 'sec_minsec'.
--
-- > minsec_to_sec (2,3) == 123
minsec_to_sec :: Num n => GMinSec n -> n
minsec_to_sec :: forall n. Num n => GMinSec n -> n
minsec_to_sec (n
m,n
s) = n
m forall a. Num a => a -> a -> a
* n
60 forall a. Num a => a -> a -> a
+ n
s

-- | Convert /p/ and /q/ to seconds, apply /f/, and convert back to 'MinSec'.
minsec_binop :: Integral t => (t -> t -> t) -> GMinSec t -> GMinSec t -> GMinSec t
minsec_binop :: forall t.
Integral t =>
(t -> t -> t) -> GMinSec t -> GMinSec t -> GMinSec t
minsec_binop t -> t -> t
f GMinSec t
p GMinSec t
q = forall n. Integral n => n -> GMinSec n
sec_to_minsec (t -> t -> t
f (forall n. Num n => GMinSec n -> n
minsec_to_sec GMinSec t
p) (forall n. Num n => GMinSec n -> n
minsec_to_sec GMinSec t
q))

-- | 'minsec_binop' '-', assumes /q/ precedes /p/.
--
-- > minsec_sub (2,35) (1,59) == (0,36)
minsec_sub :: Integral n => GMinSec n -> GMinSec n -> GMinSec n
minsec_sub :: forall n. Integral n => GMinSec n -> GMinSec n -> GMinSec n
minsec_sub = forall t.
Integral t =>
(t -> t -> t) -> GMinSec t -> GMinSec t -> GMinSec t
minsec_binop (-)

-- | 'minsec_binop' 'subtract', assumes /p/ precedes /q/.
--
-- > minsec_diff (1,59) (2,35) == (0,36)
minsec_diff :: Integral n => GMinSec n -> GMinSec n -> GMinSec n
minsec_diff :: forall n. Integral n => GMinSec n -> GMinSec n -> GMinSec n
minsec_diff = forall t.
Integral t =>
(t -> t -> t) -> GMinSec t -> GMinSec t -> GMinSec t
minsec_binop forall a. Num a => a -> a -> a
subtract

-- | 'minsec_binop' '+'.
--
-- > minsec_add (1,59) (2,35) == (4,34)
minsec_add :: Integral n => GMinSec n -> GMinSec n -> GMinSec n
minsec_add :: forall n. Integral n => GMinSec n -> GMinSec n -> GMinSec n
minsec_add = forall t.
Integral t =>
(t -> t -> t) -> GMinSec t -> GMinSec t -> GMinSec t
minsec_binop forall a. Num a => a -> a -> a
(+)

-- | 'foldl' of 'minsec_add'
--
-- > minsec_sum [(1,59),(2,35),(4,34)] == (9,08)
minsec_sum :: Integral n => [GMinSec n] -> GMinSec n
minsec_sum :: forall n. Integral n => [GMinSec n] -> GMinSec n
minsec_sum = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall n. Integral n => GMinSec n -> GMinSec n -> GMinSec n
minsec_add (n
0,n
0)

-- | 'round' fractional seconds to @(min,sec)@.
--
-- > map fsec_to_minsec [59.49,60,60.51] == [(0,59),(1,0),(1,1)]
fsec_to_minsec :: FSec -> MinSec
fsec_to_minsec :: FSec -> MinSec
fsec_to_minsec = forall n. Integral n => n -> GMinSec n
sec_to_minsec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round

-- | 'MinSec' pretty printer.
--
-- > map (minsec_pp . fsec_to_minsec) [59,61] == ["00:59","01:01"]
minsec_pp :: MinSec -> String
minsec_pp :: MinSec -> String
minsec_pp (Sec
m,Sec
s) = forall r. PrintfType r => String -> r
printf String
"%02d:%02d" Sec
m Sec
s

-- * 'MinSec' parser.
minsec_parse :: (Num n,Read n) => String -> GMinSec n
minsec_parse :: forall n. (Num n, Read n) => String -> GMinSec n
minsec_parse String
x =
    case forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn String
":" String
x of
      [String
m,String
s] -> (forall a. Read a => String -> a
read String
m,forall a. Read a => String -> a
read String
s)
      [String]
_ -> forall a. HasCallStack => String -> a
error (String
"minsec_parse: " forall a. [a] -> [a] -> [a]
++ String
x)

-- * MinCsec

-- | Fractional seconds to @(min,sec,csec)@, csec value is 'round'ed.
--
-- > map fsec_to_mincsec [1,1.5,4/3] == [(0,1,0),(0,1,50),(0,1,33)]
fsec_to_mincsec :: FSec -> MinCsec
fsec_to_mincsec :: FSec -> Hms
fsec_to_mincsec FSec
tm =
    let tm' :: Sec
tm' = forall a b. (RealFrac a, Integral b) => a -> b
floor FSec
tm
        (Sec
m,Sec
s) = forall n. Integral n => n -> GMinSec n
sec_to_minsec Sec
tm'
        cs :: Sec
cs = forall a b. (RealFrac a, Integral b) => a -> b
round ((FSec
tm forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Sec
tm') forall a. Num a => a -> a -> a
* FSec
100)
    in (Sec
m,Sec
s,Sec
cs)

-- | Inverse of 'fsec_mincsec'.
mincsec_to_fsec :: Real n => GMinCsec n -> FSec
mincsec_to_fsec :: forall n. Real n => GMinCsec n -> FSec
mincsec_to_fsec (n
m,n
s,n
cs) = forall a b. (Real a, Fractional b) => a -> b
realToFrac n
m forall a. Num a => a -> a -> a
* FSec
60 forall a. Num a => a -> a -> a
+ forall a b. (Real a, Fractional b) => a -> b
realToFrac n
s forall a. Num a => a -> a -> a
+ (forall a b. (Real a, Fractional b) => a -> b
realToFrac n
cs forall a. Fractional a => a -> a -> a
/ FSec
100)

-- > map (mincsec_to_csec . fsec_to_mincsec) [1,6+2/3,123.45] == [100,667,12345]
mincsec_to_csec :: Num n => GMinCsec n -> n
mincsec_to_csec :: forall n. Num n => GMinCsec n -> n
mincsec_to_csec (n
m,n
s,n
cs) = n
m forall a. Num a => a -> a -> a
* n
60 forall a. Num a => a -> a -> a
* n
100 forall a. Num a => a -> a -> a
+ n
s forall a. Num a => a -> a -> a
* n
100 forall a. Num a => a -> a -> a
+ n
cs

-- | Centi-seconds to 'MinCsec'.
--
-- > map csec_to_mincsec [123,12345] == [(0,1,23),(2,3,45)]
csec_to_mincsec :: Integral n => n -> GMinCsec n
csec_to_mincsec :: forall n. Integral n => n -> GMinCsec n
csec_to_mincsec n
csec =
    let (n
m,n
cs) = n
csec forall a. Integral a => a -> a -> (a, a)
`divMod` n
6000
        (n
s,n
cs') = n
cs forall a. Integral a => a -> a -> (a, a)
`divMod` n
100
    in (n
m,n
s,n
cs')

-- | 'MinCsec' pretty printer, concise mode omits centiseconds when zero.
--
-- > map (mincsec_pp_opt True . fsec_to_mincsec) [1,60.5] == ["00:01","01:00.50"]
mincsec_pp_opt :: Bool -> MinCsec -> String
mincsec_pp_opt :: Bool -> Hms -> String
mincsec_pp_opt Bool
concise (Sec
m,Sec
s,Sec
cs) =
  if Bool
concise Bool -> Bool -> Bool
&& Sec
cs forall a. Eq a => a -> a -> Bool
== Sec
0
  then forall r. PrintfType r => String -> r
printf String
"%02d:%02d" Sec
m Sec
s
  else forall r. PrintfType r => String -> r
printf String
"%02d:%02d.%02d" Sec
m Sec
s Sec
cs

-- | 'MinCsec' pretty printer.
--
-- > let r = ["00:01.00","00:06.67","02:03.45"]
-- > map (mincsec_pp . fsec_to_mincsec) [1,6+2/3,123.45] == r
mincsec_pp :: MinCsec -> String
mincsec_pp :: Hms -> String
mincsec_pp = Bool -> Hms -> String
mincsec_pp_opt Bool
False

mincsec_binop :: Integral t => (t -> t -> t) -> GMinCsec t -> GMinCsec t -> GMinCsec t
mincsec_binop :: forall t.
Integral t =>
(t -> t -> t) -> GMinCsec t -> GMinCsec t -> GMinCsec t
mincsec_binop t -> t -> t
f GMinCsec t
p GMinCsec t
q = forall n. Integral n => n -> GMinCsec n
csec_to_mincsec (t -> t -> t
f (forall n. Num n => GMinCsec n -> n
mincsec_to_csec GMinCsec t
p) (forall n. Num n => GMinCsec n -> n
mincsec_to_csec GMinCsec t
q))

-- * DHms

-- | Convert seconds into (days,hours,minutes,seconds).
sec_to_dhms_generic :: Integral n => n -> (n,n,n,n)
sec_to_dhms_generic :: forall n. Integral n => n -> (n, n, n, n)
sec_to_dhms_generic n
n =
    let (n
d,n
h') = n
n forall a. Integral a => a -> a -> (a, a)
`divMod` (n
24 forall a. Num a => a -> a -> a
* n
60 forall a. Num a => a -> a -> a
* n
60)
        (n
h,n
m') = n
h' forall a. Integral a => a -> a -> (a, a)
`divMod` (n
60 forall a. Num a => a -> a -> a
* n
60)
        (n
m,n
s) = n
m' forall a. Integral a => a -> a -> (a, a)
`divMod` n
60
    in (n
d,n
h,n
m,n
s)

-- | Type specialised 'sec_to_dhms_generic'.
--
-- > sec_to_dhms 1475469 == (17,1,51,9)
sec_to_dhms :: Sec -> Dhms
sec_to_dhms :: Sec -> Dhms
sec_to_dhms = forall n. Integral n => n -> (n, n, n, n)
sec_to_dhms_generic

-- | Inverse of 'seconds_to_dhms'.
--
-- > dhms_to_sec (17,1,51,9) == 1475469
dhms_to_sec :: Num n => (n,n,n,n) -> n
dhms_to_sec :: forall n. Num n => (n, n, n, n) -> n
dhms_to_sec (n
d,n
h,n
m,n
s) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [n
d forall a. Num a => a -> a -> a
* n
24 forall a. Num a => a -> a -> a
* n
60 forall a. Num a => a -> a -> a
* n
60,n
h forall a. Num a => a -> a -> a
* n
60 forall a. Num a => a -> a -> a
* n
60,n
m forall a. Num a => a -> a -> a
* n
60,n
s]

-- | Generic form of 'parse_dhms'.
parse_dhms_generic :: (Integral n,Read n) => String -> (n,n,n,n)
parse_dhms_generic :: forall n. (Integral n, Read n) => String -> (n, n, n, n)
parse_dhms_generic =
    let sep_elem :: String -> String -> [String]
sep_elem = forall a. Splitter a -> [a] -> [[a]]
Split.split forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Splitter a -> Splitter a
Split.keepDelimsR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> Splitter a
Split.oneOf
        sep_last :: [b] -> ([b], b)
sep_last [b]
x = let (b
e, [b]
x') = forall a. [a] -> (a, [a])
List.headTail (forall a. [a] -> [a]
reverse [b]
x) in (forall a. [a] -> [a]
reverse [b]
x',b
e)
        p :: String -> a
p String
x = case forall {b}. [b] -> ([b], b)
sep_last String
x of
                (String
n,Char
'd') -> forall a. Read a => String -> a
read String
n forall a. Num a => a -> a -> a
* a
24 forall a. Num a => a -> a -> a
* a
60 forall a. Num a => a -> a -> a
* a
60
                (String
n,Char
'h') -> forall a. Read a => String -> a
read String
n forall a. Num a => a -> a -> a
* a
60 forall a. Num a => a -> a -> a
* a
60
                (String
n,Char
'm') -> forall a. Read a => String -> a
read String
n forall a. Num a => a -> a -> a
* a
60
                (String
n,Char
's') -> forall a. Read a => String -> a
read String
n
                (String, Char)
_ -> forall a. HasCallStack => String -> a
error String
"parse_dhms"
    in forall n. Integral n => n -> (n, n, n, n)
sec_to_dhms_generic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Num a, Read a) => String -> a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
sep_elem String
"dhms"

-- | Parse DHms text.  All parts are optional, order is not
-- significant, multiple entries are allowed.
--
-- > parse_dhms "17d1h51m9s" == (17,1,51,9)
-- > parse_dhms "1s3d" == (3,0,0,1)
-- > parse_dhms "1h1h" == (0,2,0,0)
parse_dhms :: String -> Dhms
parse_dhms :: String -> Dhms
parse_dhms = forall n. (Integral n, Read n) => String -> (n, n, n, n)
parse_dhms_generic

-- * Week

-- | Week that /t/ lies in.
--
-- > map (time_to_week . parse_iso8601_date) ["2017-01-01","2011-10-09"] == [52,40]
time_to_week :: Time.UTCTime -> Week
time_to_week :: UTCTime -> Sec
time_to_week = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => String -> t -> String
format_time_str String
"%V"

-- * Util

-- | Given printer, pretty print time span.
span_pp :: (t -> String) -> (t,t) -> String
span_pp :: forall t. (t -> String) -> (t, t) -> String
span_pp t -> String
f (t
t1,t
t2) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [t -> String
f t
t1,String
" - ",t -> String
f t
t2]