{-# LANGUAGE RebindableSyntax #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- | data algorithms related to time (as a Space)
module NumHask.Space.Time
  ( TimeGrain (..),
    floorGrain,
    ceilingGrain,
    addGrain,
    sensibleTimeGrid,
    PosDiscontinuous (..),
    placedTimeLabelDiscontinuous,
    placedTimeLabelContinuous,
    fromNominalDiffTime,
    toNominalDiffTime,
    fromDiffTime,
    toDiffTime,
  )
where

import Data.Containers.ListUtils (nubOrd)
import Data.Fixed (Fixed (MkFixed))
import Data.Sequence qualified as Seq
import Data.Text (Text, pack, unpack)
import Data.Time
import NumHask.Prelude
import NumHask.Space.Range
import NumHask.Space.Types

-- $setup
--
-- >>> :set -XRebindableSyntax
-- >>> import NumHask.Prelude
-- >>> import NumHask.Space
-- >>> import Data.Text (Text, pack)
-- >>> import Data.Time

-- | a step in time
data TimeGrain
  = Years Int
  | Months Int
  | Days Int
  | Hours Int
  | Minutes Int
  | Seconds Double
  deriving (Int -> TimeGrain -> ShowS
[TimeGrain] -> ShowS
TimeGrain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeGrain] -> ShowS
$cshowList :: [TimeGrain] -> ShowS
show :: TimeGrain -> String
$cshow :: TimeGrain -> String
showsPrec :: Int -> TimeGrain -> ShowS
$cshowsPrec :: Int -> TimeGrain -> ShowS
Show, TimeGrain -> TimeGrain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeGrain -> TimeGrain -> Bool
$c/= :: TimeGrain -> TimeGrain -> Bool
== :: TimeGrain -> TimeGrain -> Bool
$c== :: TimeGrain -> TimeGrain -> Bool
Eq, forall x. Rep TimeGrain x -> TimeGrain
forall x. TimeGrain -> Rep TimeGrain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeGrain x -> TimeGrain
$cfrom :: forall x. TimeGrain -> Rep TimeGrain x
Generic)

grainSecs :: TimeGrain -> Double
grainSecs :: TimeGrain -> Double
grainSecs (Years Int
n) = forall a b. FromIntegral a b => b -> a
fromIntegral Int
n forall a. Multiplicative a => a -> a -> a
* Double
365.0 forall a. Multiplicative a => a -> a -> a
* NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
grainSecs (Months Int
n) = forall a b. FromIntegral a b => b -> a
fromIntegral Int
n forall a. Multiplicative a => a -> a -> a
* Double
365.0 forall a. Divisive a => a -> a -> a
/ Double
12 forall a. Multiplicative a => a -> a -> a
* NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
grainSecs (Days Int
n) = forall a b. FromIntegral a b => b -> a
fromIntegral Int
n forall a. Multiplicative a => a -> a -> a
* NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
grainSecs (Hours Int
n) = forall a b. FromIntegral a b => b -> a
fromIntegral Int
n forall a. Multiplicative a => a -> a -> a
* Double
60 forall a. Multiplicative a => a -> a -> a
* Double
60
grainSecs (Minutes Int
n) = forall a b. FromIntegral a b => b -> a
fromIntegral Int
n forall a. Multiplicative a => a -> a -> a
* Double
60
grainSecs (Seconds Double
n) = Double
n

-- | convenience conversion to Double
fromNominalDiffTime :: NominalDiffTime -> Double
fromNominalDiffTime :: NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
t = forall a. FromInteger a => Integer -> a
fromInteger Integer
i forall a. Multiplicative a => a -> a -> a
* Double
1e-12
  where
    (MkFixed Integer
i) = NominalDiffTime -> Fixed E12
nominalDiffTimeToSeconds NominalDiffTime
t

-- | convenience conversion from Double
toNominalDiffTime :: Double -> NominalDiffTime
toNominalDiffTime :: Double -> NominalDiffTime
toNominalDiffTime Double
x =
  let d0 :: Day
d0 = Integer -> Day
ModifiedJulianDay Integer
0
      days :: Whole Double
days = forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor (Double
x forall a. Divisive a => a -> a -> a
/ NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay)
      secs :: Double
secs = Double
x forall a. Subtractive a => a -> a -> a
- forall a b. FromIntegral a b => b -> a
fromIntegral Int
days forall a. Multiplicative a => a -> a -> a
* NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
      t0 :: UTCTime
t0 = Day -> DiffTime -> UTCTime
UTCTime Day
d0 (Integer -> DiffTime
picosecondsToDiffTime Integer
0)
      t1 :: UTCTime
t1 = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (forall a b. FromIntegral a b => b -> a
fromIntegral Int
days) Day
d0) (Integer -> DiffTime
picosecondsToDiffTime forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. FromIntegral a b => b -> a
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor (Double
secs forall a. Divisive a => a -> a -> a
/ Double
1.0e-12))
   in UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t1 UTCTime
t0

-- | Convert from 'DiffTime' to seconds (as a Double)
--
-- >>> fromDiffTime $ toDiffTime 1
-- 1.0
fromDiffTime :: DiffTime -> Double
fromDiffTime :: DiffTime -> Double
fromDiffTime = (forall a. Multiplicative a => a -> a -> a
* Double
1e-12) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. FromInteger a => Integer -> a
fromInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DiffTime -> Integer
diffTimeToPicoseconds

-- | Convert from seconds (as a Double) to 'DiffTime'
-- >>> toDiffTime 1
-- 1s
toDiffTime :: Double -> DiffTime
toDiffTime :: Double -> DiffTime
toDiffTime = Integer -> DiffTime
picosecondsToDiffTime forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. FromIntegral a b => b -> a
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. Multiplicative a => a -> a -> a
* Double
1e12)

-- | add a TimeGrain to a UTCTime
--
-- >>> addGrain (Years 1) 5 (UTCTime (fromGregorian 2015 2 28) (toDiffTime 0))
-- 2020-02-29 00:00:00 UTC
--
-- >>> addGrain (Months 1) 1 (UTCTime (fromGregorian 2015 2 28) (toDiffTime 0))
-- 2015-03-31 00:00:00 UTC
--
-- >>> addGrain (Hours 6) 5 (UTCTime (fromGregorian 2015 2 28) (toDiffTime 0))
-- 2015-03-01 06:00:00 UTC
--
-- >>> addGrain (Seconds 0.001) (60*1000+1) (UTCTime (fromGregorian 2015 2 28) (toDiffTime 0))
-- 2015-02-28 00:01:00.001 UTC
addGrain :: TimeGrain -> Int -> UTCTime -> UTCTime
addGrain :: TimeGrain -> Int -> UTCTime -> UTCTime
addGrain (Years Int
n) Int
x (UTCTime Day
d DiffTime
t) =
  Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (-Integer
1) forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addGregorianYearsClip (forall a b. FromIntegral a b => b -> a
fromIntegral Int
n forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral Int
x) (Integer -> Day -> Day
addDays Integer
1 Day
d)) DiffTime
t
addGrain (Months Int
n) Int
x (UTCTime Day
d DiffTime
t) =
  Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (-Integer
1) forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addGregorianMonthsClip (forall a b. FromIntegral a b => b -> a
fromIntegral (Int
n forall a. Multiplicative a => a -> a -> a
* Int
x)) (Integer -> Day -> Day
addDays Integer
1 Day
d)) DiffTime
t
addGrain (Days Int
n) Int
x (UTCTime Day
d DiffTime
t) = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (forall a b. FromIntegral a b => b -> a
fromIntegral Int
x forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral Int
n) Day
d) DiffTime
t
addGrain g :: TimeGrain
g@(Hours Int
_) Int
x UTCTime
d = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
toNominalDiffTime (forall a b. FromIntegral a b => b -> a
fromIntegral Int
x forall a. Multiplicative a => a -> a -> a
* TimeGrain -> Double
grainSecs TimeGrain
g)) UTCTime
d
addGrain g :: TimeGrain
g@(Minutes Int
_) Int
x UTCTime
d = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
toNominalDiffTime (forall a b. FromIntegral a b => b -> a
fromIntegral Int
x forall a. Multiplicative a => a -> a -> a
* TimeGrain -> Double
grainSecs TimeGrain
g)) UTCTime
d
addGrain g :: TimeGrain
g@(Seconds Double
_) Int
x UTCTime
d = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
toNominalDiffTime (forall a b. FromIntegral a b => b -> a
fromIntegral Int
x forall a. Multiplicative a => a -> a -> a
* TimeGrain -> Double
grainSecs TimeGrain
g)) UTCTime
d

addHalfGrain :: TimeGrain -> UTCTime -> UTCTime
addHalfGrain :: TimeGrain -> UTCTime -> UTCTime
addHalfGrain (Years Int
n) (UTCTime Day
d DiffTime
t) =
  Day -> DiffTime -> UTCTime
UTCTime
    ( Integer -> Day -> Day
addDays (-Integer
1) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (if Int
m' forall a. Eq a => a -> a -> Bool
== Int
1 then Integer -> Day -> Day
addGregorianMonthsClip Integer
6 else forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) forall a b. (a -> b) -> a -> b
$
        Integer -> Day -> Day
addGregorianYearsClip (forall a b. FromIntegral a b => b -> a
fromIntegral Int
d') (Integer -> Day -> Day
addDays Integer
1 Day
d)
    )
    DiffTime
t
  where
    (Int
d', Int
m') = forall a. Integral a => a -> a -> (a, a)
divMod Int
2 Int
n
addHalfGrain (Months Int
n) (UTCTime Day
d DiffTime
t) =
  Day -> DiffTime -> UTCTime
UTCTime
    ( Integer -> Day -> Day
addDays (if Int
m' forall a. Eq a => a -> a -> Bool
== Int
1 then Integer
15 else Integer
0 {- sue me -})
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Day -> Day
addDays (-Integer
1)
        forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addGregorianMonthsClip (forall a b. FromIntegral a b => b -> a
fromIntegral Int
d') (Integer -> Day -> Day
addDays Integer
1 Day
d)
    )
    DiffTime
t
  where
    (Int
d', Int
m') = forall a. Integral a => a -> a -> (a, a)
divMod Int
2 Int
n
addHalfGrain (Days Int
n) (UTCTime Day
d DiffTime
t) =
  (if Int
m' forall a. Eq a => a -> a -> Bool
== Int
1 then NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
toNominalDiffTime (Double
0.5 forall a. Multiplicative a => a -> a -> a
* TimeGrain -> Double
grainSecs (Int -> TimeGrain
Days Int
1))) else forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) forall a b. (a -> b) -> a -> b
$
    Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (forall a b. FromIntegral a b => b -> a
fromIntegral Int
d') Day
d) DiffTime
t
  where
    (Int
d', Int
m') = forall a. Integral a => a -> a -> (a, a)
divMod Int
2 Int
n
addHalfGrain g :: TimeGrain
g@(Hours Int
_) UTCTime
d = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
toNominalDiffTime (Double
0.5 forall a. Multiplicative a => a -> a -> a
* TimeGrain -> Double
grainSecs TimeGrain
g)) UTCTime
d
addHalfGrain g :: TimeGrain
g@(Minutes Int
_) UTCTime
d = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
toNominalDiffTime (Double
0.5 forall a. Multiplicative a => a -> a -> a
* TimeGrain -> Double
grainSecs TimeGrain
g)) UTCTime
d
addHalfGrain g :: TimeGrain
g@(Seconds Double
_) UTCTime
d = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
toNominalDiffTime (Double
0.5 forall a. Multiplicative a => a -> a -> a
* TimeGrain -> Double
grainSecs TimeGrain
g)) UTCTime
d

-- | compute the floor UTCTime based on the timegrain
--
-- >>> floorGrain (Years 5) (UTCTime (fromGregorian 1999 1 1) (toDiffTime 0))
-- 1995-12-31 00:00:00 UTC
--
-- >>> floorGrain (Months 3) (UTCTime (fromGregorian 2016 12 30) (toDiffTime 0))
-- 2016-09-30 00:00:00 UTC
--
-- >>> floorGrain (Days 5) (UTCTime (fromGregorian 2016 12 30) (toDiffTime 1))
-- 2016-12-30 00:00:00 UTC
--
-- >>> floorGrain (Minutes 15) (UTCTime (fromGregorian 2016 12 30) (toDiffTime $ 15*60+1))
-- 2016-12-30 00:15:00 UTC
--
-- >>> floorGrain (Seconds 0.1) (UTCTime (fromGregorian 2016 12 30) ((toDiffTime 0.12)))
-- 2016-12-30 00:00:00.1 UTC
floorGrain :: TimeGrain -> UTCTime -> UTCTime
floorGrain :: TimeGrain -> UTCTime -> UTCTime
floorGrain (Years Int
n) (UTCTime Day
d DiffTime
_) = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (-Integer
1) forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
y' Int
1 Int
1) (Integer -> DiffTime
secondsToDiffTime Integer
0)
  where
    (Integer
y, Int
_, Int
_) = Day -> (Integer, Int, Int)
toGregorian (Integer -> Day -> Day
addDays Integer
1 Day
d)
    y' :: Integer
y' = forall a b. FromIntegral a b => b -> a
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
1 forall a. Additive a => a -> a -> a
+ Int
n forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor (forall a b. FromIntegral a b => b -> a
fromIntegral (Integer
y forall a. Subtractive a => a -> a -> a
- Integer
1) forall a. Divisive a => a -> a -> a
/ forall a b. FromIntegral a b => b -> a
fromIntegral Int
n :: Double))
floorGrain (Months Int
n) (UTCTime Day
d DiffTime
_) = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (-Integer
1) forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m' Int
1) (Integer -> DiffTime
secondsToDiffTime Integer
0)
  where
    (Integer
y, Int
m, Int
_) = Day -> (Integer, Int, Int)
toGregorian (Integer -> Day -> Day
addDays Integer
1 Day
d)
    m' :: Int
m' = forall a b. FromIntegral a b => b -> a
fromIntegral (Int
1 forall a. Additive a => a -> a -> a
+ forall a b. FromIntegral a b => b -> a
fromIntegral Int
n forall a. Multiplicative a => a -> a -> a
* forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor (forall a b. FromIntegral a b => b -> a
fromIntegral (Int
m forall a. Subtractive a => a -> a -> a
- Int
1) forall a. Divisive a => a -> a -> a
/ forall a b. FromIntegral a b => b -> a
fromIntegral Int
n :: Double))
floorGrain (Days Int
_) (UTCTime Day
d DiffTime
_) = Day -> DiffTime -> UTCTime
UTCTime Day
d (Integer -> DiffTime
secondsToDiffTime Integer
0)
floorGrain (Hours Int
h) u :: UTCTime
u@(UTCTime Day
_ DiffTime
t) = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
x UTCTime
u
  where
    s :: Double
s = DiffTime -> Double
fromDiffTime DiffTime
t
    x :: NominalDiffTime
x = Double -> NominalDiffTime
toNominalDiffTime forall a b. (a -> b) -> a -> b
$ forall a b. FromIntegral a b => b -> a
fromIntegral (Int
h forall a. Multiplicative a => a -> a -> a
* Int
3600 forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor (Double
s forall a. Divisive a => a -> a -> a
/ (forall a b. FromIntegral a b => b -> a
fromIntegral Int
h forall a. Multiplicative a => a -> a -> a
* Double
3600)))) forall a. Subtractive a => a -> a -> a
- Double
s
floorGrain (Minutes Int
m) u :: UTCTime
u@(UTCTime Day
_ DiffTime
t) = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
x UTCTime
u
  where
    s :: Double
s = DiffTime -> Double
fromDiffTime DiffTime
t
    x :: NominalDiffTime
x = Double -> NominalDiffTime
toNominalDiffTime forall a b. (a -> b) -> a -> b
$ forall a b. FromIntegral a b => b -> a
fromIntegral (Int
m forall a. Multiplicative a => a -> a -> a
* Int
60 forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor (Double
s forall a. Divisive a => a -> a -> a
/ (forall a b. FromIntegral a b => b -> a
fromIntegral Int
m forall a. Multiplicative a => a -> a -> a
* Double
60)))) forall a. Subtractive a => a -> a -> a
- Double
s
floorGrain (Seconds Double
secs) u :: UTCTime
u@(UTCTime Day
_ DiffTime
t) = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
x UTCTime
u
  where
    s :: Double
s = DiffTime -> Double
fromDiffTime DiffTime
t
    x :: NominalDiffTime
x = Double -> NominalDiffTime
toNominalDiffTime forall a b. (a -> b) -> a -> b
$ (Double
secs forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor (Double
s forall a. Divisive a => a -> a -> a
/ Double
secs))) forall a. Subtractive a => a -> a -> a
- Double
s

-- | compute the ceiling UTCTime based on the timegrain
--
-- >>> ceilingGrain (Years 5) (UTCTime (fromGregorian 1999 1 1) (toDiffTime 0))
-- 2000-12-31 00:00:00 UTC
--
-- >>> ceilingGrain (Months 3) (UTCTime (fromGregorian 2016 12 30) (toDiffTime 0))
-- 2016-12-31 00:00:00 UTC
--
-- >>> ceilingGrain (Days 5) (UTCTime (fromGregorian 2016 12 30) (toDiffTime 1))
-- 2016-12-31 00:00:00 UTC
--
-- >>> ceilingGrain (Minutes 15) (UTCTime (fromGregorian 2016 12 30) (toDiffTime $ 15*60+1))
-- 2016-12-30 00:30:00 UTC
--
-- >>> ceilingGrain (Seconds 0.1) (UTCTime (fromGregorian 2016 12 30) (toDiffTime 0.12))
-- 2016-12-30 00:00:00.2 UTC
ceilingGrain :: TimeGrain -> UTCTime -> UTCTime
ceilingGrain :: TimeGrain -> UTCTime -> UTCTime
ceilingGrain (Years Int
n) (UTCTime Day
d DiffTime
_) = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (-Integer
1) forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
y' Int
1 Int
1) (Integer -> DiffTime
secondsToDiffTime Integer
0)
  where
    (Integer
y, Int
_, Int
_) = Day -> (Integer, Int, Int)
toGregorian (Integer -> Day -> Day
addDays Integer
1 Day
d)
    y' :: Integer
y' = forall a b. FromIntegral a b => b -> a
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
1 forall a. Additive a => a -> a -> a
+ Int
n forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Distributive (Whole a)) => a -> Whole a
ceiling (forall a b. FromIntegral a b => b -> a
fromIntegral (Integer
y forall a. Subtractive a => a -> a -> a
- Integer
1) forall a. Divisive a => a -> a -> a
/ forall a b. FromIntegral a b => b -> a
fromIntegral Int
n :: Double))
ceilingGrain (Months Int
n) (UTCTime Day
d DiffTime
_) = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (-Integer
1) forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian Integer
y' Int
m'' Int
1) (Integer -> DiffTime
secondsToDiffTime Integer
0)
  where
    (Integer
y, Int
m, Int
_) = Day -> (Integer, Int, Int)
toGregorian (Integer -> Day -> Day
addDays Integer
1 Day
d)
    m' :: Int
m' = (Int
m forall a. Additive a => a -> a -> a
+ Int
n forall a. Subtractive a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`div` Int
n forall a. Multiplicative a => a -> a -> a
* Int
n
    (Integer
y', Int
m'') = forall a b. FromIntegral a b => b -> a
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Int
m' forall a. Eq a => a -> a -> Bool
== Int
12 then (Integer
y forall a. Additive a => a -> a -> a
+ Integer
1, Int
1) else (Integer
y, Int
m' forall a. Additive a => a -> a -> a
+ Int
1)
ceilingGrain (Days Int
_) (UTCTime Day
d DiffTime
t) = if DiffTime
t forall a. Eq a => a -> a -> Bool
== Integer -> DiffTime
secondsToDiffTime Integer
0 then Day -> DiffTime -> UTCTime
UTCTime Day
d (Integer -> DiffTime
secondsToDiffTime Integer
0) else Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays Integer
1 Day
d) (Integer -> DiffTime
secondsToDiffTime Integer
0)
ceilingGrain (Hours Int
h) u :: UTCTime
u@(UTCTime Day
_ DiffTime
t) = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
x UTCTime
u
  where
    s :: Double
s = DiffTime -> Double
fromDiffTime DiffTime
t
    x :: NominalDiffTime
x = Double -> NominalDiffTime
toNominalDiffTime forall a b. (a -> b) -> a -> b
$ forall a b. FromIntegral a b => b -> a
fromIntegral (Int
h forall a. Multiplicative a => a -> a -> a
* Int
3600 forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Distributive (Whole a)) => a -> Whole a
ceiling (Double
s forall a. Divisive a => a -> a -> a
/ (forall a b. FromIntegral a b => b -> a
fromIntegral Int
h forall a. Multiplicative a => a -> a -> a
* Double
3600)))) forall a. Subtractive a => a -> a -> a
- Double
s
ceilingGrain (Minutes Int
m) u :: UTCTime
u@(UTCTime Day
_ DiffTime
t) = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
x UTCTime
u
  where
    s :: Double
s = DiffTime -> Double
fromDiffTime DiffTime
t
    x :: NominalDiffTime
x = Double -> NominalDiffTime
toNominalDiffTime forall a b. (a -> b) -> a -> b
$ forall a b. FromIntegral a b => b -> a
fromIntegral (Int
m forall a. Multiplicative a => a -> a -> a
* Int
60 forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Distributive (Whole a)) => a -> Whole a
ceiling (Double
s forall a. Divisive a => a -> a -> a
/ (forall a b. FromIntegral a b => b -> a
fromIntegral Int
m forall a. Multiplicative a => a -> a -> a
* Double
60)))) forall a. Subtractive a => a -> a -> a
- Double
s
ceilingGrain (Seconds Double
secs) u :: UTCTime
u@(UTCTime Day
_ DiffTime
t) = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
x UTCTime
u
  where
    s :: Double
s = DiffTime -> Double
fromDiffTime DiffTime
t
    x :: NominalDiffTime
x = Double -> NominalDiffTime
toNominalDiffTime forall a b. (a -> b) -> a -> b
$ (Double
secs forall a. Multiplicative a => a -> a -> a
* forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Distributive (Whole a)) => a -> Whole a
ceiling (Double
s forall a. Divisive a => a -> a -> a
/ Double
secs))) forall a. Subtractive a => a -> a -> a
- Double
s

-- | whether to include lower and upper times
data PosDiscontinuous = PosInnerOnly | PosIncludeBoundaries

-- | Dates used for time series analysis or attached to charts are often discontinuous, but we want to smooth that reality over and show a continuous range on the axis.
--
-- The assumption with getSensibleTimeGrid is that there is a list of discountinuous UTCTimes rather than a continuous range.  Output is a list of index points for the original [UTCTime] and label tuples, and a list of unused list elements.
--
-- >>> placedTimeLabelDiscontinuous PosIncludeBoundaries (Just (pack "%d %b")) 2 [UTCTime (fromGregorian 2017 12 6) (toDiffTime 0), UTCTime (fromGregorian 2017 12 29) (toDiffTime 0), UTCTime (fromGregorian 2018 1 31) (toDiffTime 0), UTCTime (fromGregorian 2018 3 3) (toDiffTime 0)]
-- ([(0,"06 Dec"),(1,"31 Dec"),(2,"28 Feb"),(3,"03 Mar")],[])
placedTimeLabelDiscontinuous :: PosDiscontinuous -> Maybe Text -> Int -> [UTCTime] -> ([(Int, Text)], [UTCTime])
placedTimeLabelDiscontinuous :: PosDiscontinuous
-> Maybe Text -> Int -> [UTCTime] -> ([(Int, Text)], [UTCTime])
placedTimeLabelDiscontinuous PosDiscontinuous
_ Maybe Text
_ Int
_ [] = ([], [])
placedTimeLabelDiscontinuous PosDiscontinuous
posd Maybe Text
format Int
n [UTCTime]
ts = (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, UTCTime)]
inds') [Text]
labels, [UTCTime]
rem')
  where
    r :: Range UTCTime
r@(Range UTCTime
l UTCTime
u) = forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [UTCTime]
ts
    (TimeGrain
grain, [UTCTime]
tps) = Pos -> Int -> Range UTCTime -> (TimeGrain, [UTCTime])
sensibleTimeGrid Pos
InnerPos Int
n Range UTCTime
r
    tps' :: [UTCTime]
tps' = case PosDiscontinuous
posd of
      PosDiscontinuous
PosInnerOnly -> [UTCTime]
tps
      PosDiscontinuous
PosIncludeBoundaries -> [UTCTime
l] forall a. Semigroup a => a -> a -> a
<> [UTCTime]
tps forall a. Semigroup a => a -> a -> a
<> [UTCTime
u]
    begin :: ([UTCTime], Seq a, Int)
begin = ([UTCTime]
tps', forall a. Seq a
Seq.empty, forall a. Additive a => a
zero :: Int)
    done :: (a, t a, c) -> (a, [a])
done (a
p, t a
x, c
_) = (a
p, forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
x)
    step :: ([a], Seq (c, a), c) -> a -> ([a], Seq (c, a), c)
step ([], Seq (c, a)
xs, c
n) a
_ = ([], Seq (c, a)
xs, c
n)
    step (a
p : [a]
ps, Seq (c, a)
xs, c
n) a
a
      | a
p forall a. Eq a => a -> a -> Bool
== a
a = ([a], Seq (c, a), c) -> a -> ([a], Seq (c, a), c)
step ([a]
ps, Seq (c, a)
xs forall a. Seq a -> a -> Seq a
Seq.:|> (c
n, a
p), c
n) a
a
      | a
p forall a. Ord a => a -> a -> Bool
> a
a = (a
p forall a. a -> [a] -> [a]
: [a]
ps, Seq (c, a)
xs, c
n forall a. Additive a => a -> a -> a
+ c
1)
      | Bool
otherwise = ([a], Seq (c, a), c) -> a -> ([a], Seq (c, a), c)
step ([a]
ps, Seq (c, a)
xs forall a. Seq a -> a -> Seq a
Seq.:|> (c
n forall a. Subtractive a => a -> a -> a
- c
1, a
p), c
n) a
a
    ([UTCTime]
rem', [(Int, UTCTime)]
inds) = forall {t :: * -> *} {a} {a} {c}.
Foldable t =>
(a, t a, c) -> (a, [a])
done forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {c}.
(Ord a, FromInteger c, Subtractive c) =>
([a], Seq (c, a), c) -> a -> ([a], Seq (c, a), c)
step forall {a}. ([UTCTime], Seq a, Int)
begin [UTCTime]
ts
    inds' :: [(Int, UTCTime)]
inds' = forall a. [(Int, a)] -> [(Int, a)]
laterTimes [(Int, UTCTime)]
inds
    fmt :: String
fmt = case Maybe Text
format of
      Just Text
f -> Text -> String
unpack Text
f
      Maybe Text
Nothing -> TimeGrain -> String
autoFormat TimeGrain
grain
    labels :: [Text]
labels = String -> Text
pack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, UTCTime)]
inds'

autoFormat :: TimeGrain -> String
autoFormat :: TimeGrain -> String
autoFormat (Years Int
x)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
1 = String
"%b %Y"
  | Bool
otherwise = String
"%Y"
autoFormat (Months Int
_) = String
"%d %b %Y"
autoFormat (Days Int
_) = String
"%d %b %y"
autoFormat (Hours Int
x)
  | Int
x forall a. Ord a => a -> a -> Bool
> Int
3 = String
"%d/%m/%y %R"
  | Bool
otherwise = String
"%R"
autoFormat (Minutes Int
_) = String
"%R"
autoFormat (Seconds Double
_) = String
"%T%Q"

laterTimes :: [(Int, a)] -> [(Int, a)]
laterTimes :: forall a. [(Int, a)] -> [(Int, a)]
laterTimes [] = []
laterTimes [(Int, a)
x] = [(Int, a)
x]
laterTimes ((Int, a)
x : [(Int, a)]
xs) =
  (\((Int, a)
x, Seq (Int, a)
xs) -> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Seq (Int, a)
xs forall a. Seq a -> a -> Seq a
Seq.:|> (Int, a)
x) forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {b} {b}.
Eq a =>
((a, b), Seq (a, b)) -> (a, b) -> ((a, b), Seq (a, b))
step ((Int, a)
x, forall a. Seq a
Seq.empty) [(Int, a)]
xs
  where
    step :: ((a, b), Seq (a, b)) -> (a, b) -> ((a, b), Seq (a, b))
step ((a
n, b
a), Seq (a, b)
rs) (a
na, b
aa) =
      forall a. a -> a -> Bool -> a
bool ((a
na, b
aa), Seq (a, b)
rs forall a. Seq a -> a -> Seq a
Seq.:|> (a
n, b
a)) ((a
na, b
aa), Seq (a, b)
rs) (a
na forall a. Eq a => a -> a -> Bool
== a
n)

-- | A sensible time grid between two dates, projected onto (0,1) with no attempt to get finnicky.
--
-- >>> placedTimeLabelContinuous PosIncludeBoundaries (Just (pack "%d %b")) 2 (Range (UTCTime (fromGregorian 2017 12 6) (toDiffTime 0)) (UTCTime (fromGregorian 2017 12 29) (toDiffTime 0)))
-- [(0.0,"06 Dec"),(0.4347826086956521,"16 Dec"),(0.8695652173913042,"26 Dec"),(0.9999999999999999,"29 Dec")]
placedTimeLabelContinuous :: PosDiscontinuous -> Maybe Text -> Int -> Range UTCTime -> [(Double, Text)]
placedTimeLabelContinuous :: PosDiscontinuous
-> Maybe Text -> Int -> Range UTCTime -> [(Double, Text)]
placedTimeLabelContinuous PosDiscontinuous
posd Maybe Text
format Int
n r :: Range UTCTime
r@(Range UTCTime
l UTCTime
u) = forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
tpsd [Text]
labels
  where
    (TimeGrain
grain, [UTCTime]
tps) = Pos -> Int -> Range UTCTime -> (TimeGrain, [UTCTime])
sensibleTimeGrid Pos
InnerPos Int
n Range UTCTime
r
    tps' :: [UTCTime]
tps' = case PosDiscontinuous
posd of
      PosDiscontinuous
PosInnerOnly -> [UTCTime]
tps
      PosDiscontinuous
PosIncludeBoundaries -> forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ [UTCTime
l] forall a. Semigroup a => a -> a -> a
<> [UTCTime]
tps forall a. Semigroup a => a -> a -> a
<> [UTCTime
u]
    fmt :: String
fmt = case Maybe Text
format of
      Just Text
f -> Text -> String
unpack Text
f
      Maybe Text
Nothing -> TimeGrain -> String
autoFormat TimeGrain
grain
    labels :: [Text]
labels = String -> Text
pack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UTCTime]
tps'
    r' :: Double
r' = NominalDiffTime -> Double
fromNominalDiffTime forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
u UTCTime
l
    tpsd :: [Double]
tpsd = (forall a. Divisive a => a -> a -> a
/ Double
r') forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NominalDiffTime -> Double
fromNominalDiffTime forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UTCTime]
tps'

-- | compute a sensible TimeGrain and list of UTCTimes
--
-- >>> sensibleTimeGrid InnerPos 2 (Range (UTCTime (fromGregorian 2016 12 31) (toDiffTime 0)) (UTCTime (fromGregorian 2017 12 31) (toDiffTime 0)))
-- (Months 6,[2016-12-31 00:00:00 UTC,2017-06-30 00:00:00 UTC,2017-12-31 00:00:00 UTC])
--
-- >>> sensibleTimeGrid InnerPos 2 (Range (UTCTime (fromGregorian 2017 1 1) (toDiffTime 0)) (UTCTime (fromGregorian 2017 12 30) (toDiffTime 0)))
-- (Months 6,[2017-06-30 00:00:00 UTC])
--
-- >>> sensibleTimeGrid UpperPos 2 (Range (UTCTime (fromGregorian 2017 1 1) (toDiffTime 0)) (UTCTime (fromGregorian 2017 12 30) (toDiffTime 0)))
-- (Months 6,[2017-06-30 00:00:00 UTC,2017-12-31 00:00:00 UTC])
--
-- >>> sensibleTimeGrid LowerPos 2 (Range (UTCTime (fromGregorian 2017 1 1) (toDiffTime 0)) (UTCTime (fromGregorian 2017 12 30) (toDiffTime 0)))
-- (Months 6,[2016-12-31 00:00:00 UTC,2017-06-30 00:00:00 UTC])
sensibleTimeGrid :: Pos -> Int -> Range UTCTime -> (TimeGrain, [UTCTime])
sensibleTimeGrid :: Pos -> Int -> Range UTCTime -> (TimeGrain, [UTCTime])
sensibleTimeGrid Pos
p Int
n (Range UTCTime
l UTCTime
u) = (TimeGrain
grain, [UTCTime]
ts)
  where
    span' :: NominalDiffTime
span' = UTCTime
u UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
l
    grain :: TimeGrain
grain = Pos -> NominalDiffTime -> Int -> TimeGrain
stepSensibleTime Pos
p NominalDiffTime
span' Int
n
    first' :: UTCTime
first' = TimeGrain -> UTCTime -> UTCTime
floorGrain TimeGrain
grain UTCTime
l
    last' :: UTCTime
last' = TimeGrain -> UTCTime -> UTCTime
ceilingGrain TimeGrain
grain UTCTime
u
    n' :: Whole Double
n' =
      forall a.
(QuotientField a, Eq (Whole a), Ring (Whole a)) =>
a -> Whole a
round forall a b. (a -> b) -> a -> b
$
        NominalDiffTime -> Double
fromNominalDiffTime (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
last' UTCTime
first')
          forall a. Divisive a => a -> a -> a
/ TimeGrain -> Double
grainSecs TimeGrain
grain
    posns :: [a] -> [a]
posns = case Pos
p of
      Pos
OuterPos -> forall a. Int -> [a] -> [a]
take (forall a b. FromIntegral a b => b -> a
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
n' forall a. Additive a => a -> a -> a
+ Int
1)
      Pos
InnerPos ->
        forall a. Int -> [a] -> [a]
drop (forall a. a -> a -> Bool -> a
bool forall a. Multiplicative a => a
one forall a. Additive a => a
zero (UTCTime
first' forall a. Eq a => a -> a -> Bool
== UTCTime
l))
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Int -> [a] -> [a]
take (forall a b. FromIntegral a b => b -> a
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
n' forall a. Additive a => a -> a -> a
+ forall a. a -> a -> Bool -> a
bool forall a. Additive a => a
zero forall a. Multiplicative a => a
one (UTCTime
last' forall a. Eq a => a -> a -> Bool
== UTCTime
u))
      Pos
UpperPos -> forall a. Int -> [a] -> [a]
drop Int
1 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Int -> [a] -> [a]
take (forall a b. FromIntegral a b => b -> a
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
n' forall a. Additive a => a -> a -> a
+ Int
1)
      Pos
LowerPos -> forall a. Int -> [a] -> [a]
take (forall a b. FromIntegral a b => b -> a
fromIntegral Int
n')
      Pos
MidPos -> forall a. Int -> [a] -> [a]
take (forall a b. FromIntegral a b => b -> a
fromIntegral Int
n')
    ts :: [UTCTime]
ts = case Pos
p of
      Pos
MidPos ->
        forall a. Int -> [a] -> [a]
take (forall a b. FromIntegral a b => b -> a
fromIntegral Int
n') forall a b. (a -> b) -> a -> b
$
          TimeGrain -> UTCTime -> UTCTime
addHalfGrain TimeGrain
grain
            forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\Int
x -> TimeGrain -> Int -> UTCTime -> UTCTime
addGrain TimeGrain
grain Int
x UTCTime
first')
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 ..]
      Pos
_notMid -> forall {a}. [a] -> [a]
posns forall a b. (a -> b) -> a -> b
$ (\Int
x -> TimeGrain -> Int -> UTCTime -> UTCTime
addGrain TimeGrain
grain Int
x UTCTime
first') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 ..]

-- come up with a sensible step for a grid over a Field
stepSensible ::
  Pos ->
  Double ->
  Int ->
  Double
stepSensible :: Pos -> Double -> Int -> Double
stepSensible Pos
tp Double
span' Int
n =
  Double
step
    forall a. Additive a => a -> a -> a
+ if Pos
tp forall a. Eq a => a -> a -> Bool
== Pos
MidPos
      then Double
step forall a. Divisive a => a -> a -> a
/ Double
2
      else Double
0
  where
    step' :: Double
step' = Double
10 forall b a.
(Ord b, Divisive a, Subtractive b, Integral b) =>
a -> b -> a
^^ forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor (forall a. ExpField a => a -> a -> a
logBase Double
10 (Double
span' forall a. Divisive a => a -> a -> a
/ forall a b. FromIntegral a b => b -> a
fromIntegral Int
n))
    err :: Double
err = forall a b. FromIntegral a b => b -> a
fromIntegral Int
n forall a. Divisive a => a -> a -> a
/ Double
span' forall a. Multiplicative a => a -> a -> a
* Double
step'
    step :: Double
step
      | Double
err forall a. Ord a => a -> a -> Bool
<= Double
0.15 = Double
10 forall a. Multiplicative a => a -> a -> a
* Double
step'
      | Double
err forall a. Ord a => a -> a -> Bool
<= Double
0.35 = Double
5 forall a. Multiplicative a => a -> a -> a
* Double
step'
      | Double
err forall a. Ord a => a -> a -> Bool
<= Double
0.75 = Double
2 forall a. Multiplicative a => a -> a -> a
* Double
step'
      | Bool
otherwise = Double
step'

-- come up with a sensible step for a grid over a Field, where sensible means the 18th century
-- practice of using multiples of 3 to round
stepSensible3 ::
  Pos ->
  Double ->
  Int ->
  Double
stepSensible3 :: Pos -> Double -> Int -> Double
stepSensible3 Pos
tp Double
span' Int
n =
  Double
step
    forall a. Additive a => a -> a -> a
+ if Pos
tp forall a. Eq a => a -> a -> Bool
== Pos
MidPos
      then Double
step forall a. Divisive a => a -> a -> a
/ Double
2
      else Double
0
  where
    step' :: Double
step' = Double
10 forall b a.
(Ord b, Divisive a, Subtractive b, Integral b) =>
a -> b -> a
^^ forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor (forall a. ExpField a => a -> a -> a
logBase Double
10 (Double
span' forall a. Divisive a => a -> a -> a
/ forall a b. FromIntegral a b => b -> a
fromIntegral Int
n))
    err :: Double
err = forall a b. FromIntegral a b => b -> a
fromIntegral Int
n forall a. Divisive a => a -> a -> a
/ Double
span' forall a. Multiplicative a => a -> a -> a
* Double
step'
    step :: Double
step
      | Double
err forall a. Ord a => a -> a -> Bool
<= Double
0.05 = Double
12 forall a. Multiplicative a => a -> a -> a
* Double
step'
      | Double
err forall a. Ord a => a -> a -> Bool
<= Double
0.3 = Double
6 forall a. Multiplicative a => a -> a -> a
* Double
step'
      | Double
err forall a. Ord a => a -> a -> Bool
<= Double
0.5 = Double
3 forall a. Multiplicative a => a -> a -> a
* Double
step'
      | Bool
otherwise = Double
step'

-- | come up with a sensible TimeGrain over a NominalDiffTime
stepSensibleTime :: Pos -> NominalDiffTime -> Int -> TimeGrain
stepSensibleTime :: Pos -> NominalDiffTime -> Int -> TimeGrain
stepSensibleTime Pos
tp NominalDiffTime
span' Int
n
  | Double
yearsstep forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Years (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor Double
yearsstep)
  | Double
monthsstep forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Months (forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor Double
monthsstep))
  | Double
daysstep forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Days (forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor Double
daysstep))
  | Double
hoursstep forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Hours (forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor Double
hoursstep))
  | Double
minutesstep forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Minutes (forall a b. FromIntegral a b => b -> a
fromIntegral (forall a. (QuotientField a, Ring (Whole a)) => a -> Whole a
floor Double
minutesstep))
  | Double
secondsstep forall a. Ord a => a -> a -> Bool
>= Double
1 = Double -> TimeGrain
Seconds Double
secondsstep3
  | Bool
otherwise = Double -> TimeGrain
Seconds Double
secondsstep
  where
    sp :: Double
sp = NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
span'
    minutes :: Double
minutes = Double
sp forall a. Divisive a => a -> a -> a
/ Double
60
    hours :: Double
hours = Double
sp forall a. Divisive a => a -> a -> a
/ (Double
60 forall a. Multiplicative a => a -> a -> a
* Double
60)
    days :: Double
days = Double
sp forall a. Divisive a => a -> a -> a
/ NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
    years :: Double
years = Double
sp forall a. Divisive a => a -> a -> a
/ Double
365 forall a. Divisive a => a -> a -> a
/ NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
    months' :: Double
months' = Double
years forall a. Multiplicative a => a -> a -> a
* Double
12
    yearsstep :: Double
yearsstep = Pos -> Double -> Int -> Double
stepSensible Pos
tp Double
years Int
n
    monthsstep :: Double
monthsstep = Pos -> Double -> Int -> Double
stepSensible3 Pos
tp Double
months' Int
n
    daysstep :: Double
daysstep = Pos -> Double -> Int -> Double
stepSensible Pos
tp Double
days Int
n
    hoursstep :: Double
hoursstep = Pos -> Double -> Int -> Double
stepSensible3 Pos
tp Double
hours Int
n
    minutesstep :: Double
minutesstep = Pos -> Double -> Int -> Double
stepSensible3 Pos
tp Double
minutes Int
n
    secondsstep3 :: Double
secondsstep3 = Pos -> Double -> Int -> Double
stepSensible3 Pos
tp Double
sp Int
n
    secondsstep :: Double
secondsstep = Pos -> Double -> Int -> Double
stepSensible Pos
tp Double
sp Int
n