{-# 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
--
-- >>> :m -Prelude
-- >>> :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
(Int -> TimeGrain -> ShowS)
-> (TimeGrain -> String)
-> ([TimeGrain] -> ShowS)
-> Show TimeGrain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeGrain -> ShowS
showsPrec :: Int -> TimeGrain -> ShowS
$cshow :: TimeGrain -> String
show :: TimeGrain -> String
$cshowList :: [TimeGrain] -> ShowS
showList :: [TimeGrain] -> ShowS
Show, TimeGrain -> TimeGrain -> Bool
(TimeGrain -> TimeGrain -> Bool)
-> (TimeGrain -> TimeGrain -> Bool) -> Eq TimeGrain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeGrain -> TimeGrain -> Bool
== :: TimeGrain -> TimeGrain -> Bool
$c/= :: TimeGrain -> TimeGrain -> Bool
/= :: TimeGrain -> TimeGrain -> Bool
Eq, (forall x. TimeGrain -> Rep TimeGrain x)
-> (forall x. Rep TimeGrain x -> TimeGrain) -> Generic TimeGrain
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
$cfrom :: forall x. TimeGrain -> Rep TimeGrain x
from :: forall x. TimeGrain -> Rep TimeGrain x
$cto :: forall x. Rep TimeGrain x -> TimeGrain
to :: forall x. Rep TimeGrain x -> TimeGrain
Generic)

grainSecs :: TimeGrain -> Double
grainSecs :: TimeGrain -> Double
grainSecs (Years Int
n) = Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
365.0 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
grainSecs (Months Int
n) = Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
365.0 Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
12 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
grainSecs (Days Int
n) = Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
grainSecs (Hours Int
n) = Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
60 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
60
grainSecs (Minutes Int
n) = Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Double -> Double -> Double
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 = Integer -> Double
forall a. FromInteger a => Integer -> a
fromInteger Integer
i Double -> Double -> Double
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 = Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Double
x Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay)
      secs :: Double
secs = Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
days Double -> Double -> Double
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 (Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral Int
days) Day
d0) (Integer -> DiffTime
picosecondsToDiffTime (Integer -> DiffTime) -> (Int -> Integer) -> Int -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> DiffTime) -> Int -> DiffTime
forall a b. (a -> b) -> a -> b
$ Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Double
secs Double -> Double -> Double
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 = (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
1e-12) (Double -> Double) -> (DiffTime -> Double) -> DiffTime -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Double
forall a. FromInteger a => Integer -> a
fromInteger (Integer -> Double) -> (DiffTime -> Integer) -> DiffTime -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 (Integer -> DiffTime) -> (Double -> Integer) -> Double -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Whole Double -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral (Whole Double -> Integer)
-> (Double -> Whole Double) -> Double -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Double -> Whole Double)
-> (Double -> Double) -> Double -> Whole Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double -> Double -> Double
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) (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addGregorianYearsClip (Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Integer -> Integer -> Integer
forall a. Multiplicative a => a -> a -> a
* Int -> Integer
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) (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addGregorianMonthsClip (Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral (Int
n Int -> Int -> Int
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 (Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral Int
x Integer -> Integer -> Integer
forall a. Multiplicative a => a -> a -> a
* Int -> Integer
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 (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
x Double -> Double -> Double
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 (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
x Double -> Double -> Double
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 (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
x Double -> Double -> Double
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) (Day -> Day) -> (Day -> Day) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
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' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Integer -> Day -> Day
addGregorianMonthsClip Integer
6 else Day -> Day
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$
        Integer -> Day -> Day
addGregorianYearsClip (Int -> Integer
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') = Int -> Int -> (Int, Int)
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' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Integer
15 else Integer
0 {- sue me -})
        (Day -> Day) -> (Day -> Day) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
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)
        (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addGregorianMonthsClip (Int -> Integer
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') = Int -> Int -> (Int, Int)
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' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Double -> NominalDiffTime
toNominalDiffTime (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* TimeGrain -> Double
grainSecs (Int -> TimeGrain
Days Int
1))) else UTCTime -> UTCTime
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) (UTCTime -> UTCTime) -> UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$
    Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays (Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral Int
d') Day
d) DiffTime
t
  where
    (Int
d', Int
m') = Int -> Int -> (Int, Int)
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 Double -> Double -> Double
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 Double -> Double -> Double
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 Double -> Double -> Double
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) (Day -> Day) -> Day -> Day
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' = Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Integer -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Integer
y Integer -> Integer -> Integer
forall a. Subtractive a => a -> a -> a
- Integer
1) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Int -> Double
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) (Day -> Day) -> Day -> Day
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 -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Int
1 Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int
m Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Int
1) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Int -> Double
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 (Double -> NominalDiffTime) -> Double -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int
h Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int
3600 Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
h Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
3600)))) Double -> Double -> Double
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 (Double -> NominalDiffTime) -> Double -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int
m Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
m Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
60)))) Double -> Double -> Double
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 (Double -> NominalDiffTime) -> Double -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ (Double
secs Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
secs))) Double -> Double -> Double
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) (Day -> Day) -> Day -> Day
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' = Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
ceiling (Integer -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Integer
y Integer -> Integer -> Integer
forall a. Subtractive a => a -> a -> a
- Integer
1) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Int -> Double
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) (Day -> Day) -> Day -> Day
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 Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int
n
    (Integer
y', Int
m'') = Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Int) -> (Integer, Int) -> (Integer, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Int
m' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
12 then (Integer
y Integer -> Integer -> Integer
forall a. Additive a => a -> a -> a
+ Integer
1, Int
1) else (Integer
y, Int
m' Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
1)
ceilingGrain (Days Int
_) (UTCTime Day
d DiffTime
t) = if DiffTime
t DiffTime -> DiffTime -> Bool
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 (Double -> NominalDiffTime) -> Double -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int
h Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int
3600 Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
ceiling (Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
h Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
3600)))) Double -> Double -> Double
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 (Double -> NominalDiffTime) -> Double -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int
m Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
ceiling (Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
m Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
60)))) Double -> Double -> Double
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 (Double -> NominalDiffTime) -> Double -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ (Double
secs Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
ceiling (Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
secs))) Double -> Double -> Double
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 = ([Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int, UTCTime) -> Int
forall a b. (a, b) -> a
fst ((Int, UTCTime) -> Int) -> [(Int, UTCTime)] -> [Int]
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) = [Element (Range UTCTime)] -> Range UTCTime
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [UTCTime]
[Element (Range 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] [UTCTime] -> [UTCTime] -> [UTCTime]
forall a. Semigroup a => a -> a -> a
<> [UTCTime]
tps [UTCTime] -> [UTCTime] -> [UTCTime]
forall a. Semigroup a => a -> a -> a
<> [UTCTime
u]
    begin :: ([UTCTime], Seq a, Int)
begin = ([UTCTime]
tps', Seq a
forall a. Seq a
Seq.empty, Int
forall a. Additive a => a
zero :: Int)
    done :: (a, t a, c) -> (a, [a])
done (a
p, t a
x, c
_) = (a
p, t a -> [a]
forall a. t a -> [a]
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 a -> a -> Bool
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 Seq (c, a) -> (c, a) -> Seq (c, a)
forall a. Seq a -> a -> Seq a
Seq.:|> (c
n, a
p), c
n) a
a
      | a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
a = (a
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ps, Seq (c, a)
xs, c
n c -> c -> c
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 Seq (c, a) -> (c, a) -> Seq (c, a)
forall a. Seq a -> a -> Seq a
Seq.:|> (c
n c -> c -> c
forall a. Subtractive a => a -> a -> a
- c
1, a
p), c
n) a
a
    ([UTCTime]
rem', [(Int, UTCTime)]
inds) = ([UTCTime], Seq (Int, UTCTime), Int)
-> ([UTCTime], [(Int, UTCTime)])
forall {t :: * -> *} {a} {a} {c}.
Foldable t =>
(a, t a, c) -> (a, [a])
done (([UTCTime], Seq (Int, UTCTime), Int)
 -> ([UTCTime], [(Int, UTCTime)]))
-> ([UTCTime], Seq (Int, UTCTime), Int)
-> ([UTCTime], [(Int, UTCTime)])
forall a b. (a -> b) -> a -> b
$ (([UTCTime], Seq (Int, UTCTime), Int)
 -> UTCTime -> ([UTCTime], Seq (Int, UTCTime), Int))
-> ([UTCTime], Seq (Int, UTCTime), Int)
-> [UTCTime]
-> ([UTCTime], Seq (Int, UTCTime), Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([UTCTime], Seq (Int, UTCTime), Int)
-> UTCTime -> ([UTCTime], Seq (Int, UTCTime), Int)
forall {a} {c}.
(Ord a, FromInteger c, Subtractive c) =>
([a], Seq (c, a), c) -> a -> ([a], Seq (c, a), c)
step ([UTCTime], Seq (Int, UTCTime), Int)
forall {a}. ([UTCTime], Seq a, Int)
begin [UTCTime]
ts
    inds' :: [(Int, UTCTime)]
inds' = [(Int, UTCTime)] -> [(Int, UTCTime)]
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 (String -> Text)
-> ((Int, UTCTime) -> String) -> (Int, UTCTime) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt (UTCTime -> String)
-> ((Int, UTCTime) -> UTCTime) -> (Int, UTCTime) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int, UTCTime) -> UTCTime
forall a b. (a, b) -> b
snd ((Int, UTCTime) -> Text) -> [(Int, UTCTime)] -> [Text]
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 Int -> Int -> Bool
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 Int -> Int -> Bool
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) -> Seq (Int, a) -> [(Int, a)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Int, a) -> [(Int, a)]) -> Seq (Int, a) -> [(Int, a)]
forall a b. (a -> b) -> a -> b
$ Seq (Int, a)
xs Seq (Int, a) -> (Int, a) -> Seq (Int, a)
forall a. Seq a -> a -> Seq a
Seq.:|> (Int, a)
x) (((Int, a), Seq (Int, a)) -> [(Int, a)])
-> ((Int, a), Seq (Int, a)) -> [(Int, a)]
forall a b. (a -> b) -> a -> b
$
    (((Int, a), Seq (Int, a)) -> (Int, a) -> ((Int, a), Seq (Int, a)))
-> ((Int, a), Seq (Int, a))
-> [(Int, a)]
-> ((Int, a), Seq (Int, a))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Int, a), Seq (Int, a)) -> (Int, a) -> ((Int, a), Seq (Int, a))
forall {a} {b} {b}.
Eq a =>
((a, b), Seq (a, b)) -> (a, b) -> ((a, b), Seq (a, b))
step ((Int, a)
x, Seq (Int, a)
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) =
      ((a, b), Seq (a, b))
-> ((a, b), Seq (a, b)) -> Bool -> ((a, b), Seq (a, b))
forall a. a -> a -> Bool -> a
bool ((a
na, b
aa), Seq (a, b)
rs Seq (a, b) -> (a, b) -> Seq (a, b)
forall a. Seq a -> a -> Seq a
Seq.:|> (a
n, b
a)) ((a
na, b
aa), Seq (a, b)
rs) (a
na a -> a -> Bool
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) = [Double] -> [Text] -> [(Double, Text)]
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 -> [UTCTime] -> [UTCTime]
forall a. Ord a => [a] -> [a]
nubOrd ([UTCTime] -> [UTCTime]) -> [UTCTime] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ [UTCTime
l] [UTCTime] -> [UTCTime] -> [UTCTime]
forall a. Semigroup a => a -> a -> a
<> [UTCTime]
tps [UTCTime] -> [UTCTime] -> [UTCTime]
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 (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt (UTCTime -> Text) -> [UTCTime] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UTCTime]
tps'
    r' :: Double
r' = NominalDiffTime -> Double
fromNominalDiffTime (NominalDiffTime -> Double) -> NominalDiffTime -> Double
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
u UTCTime
l
    tpsd :: [Double]
tpsd = (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
r') (Double -> Double) -> (UTCTime -> Double) -> UTCTime -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 (NominalDiffTime -> Double)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (UTCTime -> UTCTime -> NominalDiffTime)
-> UTCTime -> UTCTime -> NominalDiffTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
l (UTCTime -> Double) -> [UTCTime] -> [Double]
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' =
      Double -> Whole Double
forall a. QuotientField a => a -> Whole a
round (Double -> Whole Double) -> Double -> Whole Double
forall a b. (a -> b) -> a -> b
$
        NominalDiffTime -> Double
fromNominalDiffTime (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
last' UTCTime
first')
          Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ TimeGrain -> Double
grainSecs TimeGrain
grain
    posns :: [a] -> [a]
posns = case Pos
p of
      Pos
OuterPos -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
n' Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
1)
      Pos
InnerPos ->
        Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
forall a. Multiplicative a => a
one Int
forall a. Additive a => a
zero (UTCTime
first' UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== UTCTime
l))
          ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
n' Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
forall a. Additive a => a
zero Int
forall a. Multiplicative a => a
one (UTCTime
last' UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== UTCTime
u))
      Pos
UpperPos -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
n' Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
1)
      Pos
LowerPos -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n')
      Pos
MidPos -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n')
    ts :: [UTCTime]
ts = case Pos
p of
      Pos
MidPos ->
        Int -> [UTCTime] -> [UTCTime]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n') ([UTCTime] -> [UTCTime]) -> [UTCTime] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$
          TimeGrain -> UTCTime -> UTCTime
addHalfGrain TimeGrain
grain
            (UTCTime -> UTCTime) -> (Int -> UTCTime) -> Int -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
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')
            (Int -> UTCTime) -> [Int] -> [UTCTime]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 ..]
      Pos
_notMid -> [UTCTime] -> [UTCTime]
forall {a}. [a] -> [a]
posns ([UTCTime] -> [UTCTime]) -> [UTCTime] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ (\Int
x -> TimeGrain -> Int -> UTCTime -> UTCTime
addGrain TimeGrain
grain Int
x UTCTime
first') (Int -> UTCTime) -> [Int] -> [UTCTime]
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, 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
    Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ if Pos
tp Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
MidPos
      then Double
step Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2
      else Double
0
  where
    step' :: Double
step' = Double
10 Double -> Int -> Double
forall b a.
(Ord b, Divisive a, Subtractive b, Integral b) =>
a -> b -> a
^^ Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor (Double -> Double -> Double
forall a. ExpField a => a -> a -> a
logBase Double
10 (Double
span' Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n))
    err :: Double
err = Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
span' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
step'
    step :: Double
step
      | Double
err Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.05 = Double
12 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
step'
      | Double
err Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.3 = Double
6 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
step'
      | Double
err Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.5 = Double
3 Double -> Double -> Double
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Years (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor Double
yearsstep)
  | Double
monthsstep Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Months (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor Double
monthsstep))
  | Double
daysstep Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Days (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor Double
daysstep))
  | Double
hoursstep Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Hours (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor Double
hoursstep))
  | Double
minutesstep Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Minutes (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Whole Double
forall a. QuotientField a => a -> Whole a
floor Double
minutesstep))
  | Double
secondsstep Double -> Double -> Bool
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 Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
60
    hours :: Double
hours = Double
sp Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Double
60 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
60)
    days :: Double
days = Double
sp Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
    years :: Double
years = Double
sp Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
365 Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
nominalDay
    months' :: Double
months' = Double
years Double -> Double -> Double
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