{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module NumHask.Space.Time
( parseUTCTime,
TimeGrain (..),
floorGrain,
ceilingGrain,
addGrain,
sensibleTimeGrid,
PosDiscontinuous (..),
placedTimeLabelDiscontinuous,
placedTimeLabelContinuous,
fromNominalDiffTime,
toNominalDiffTime,
fromDiffTime,
toDiffTime,
)
where
import Data.Containers.ListUtils (nubOrd)
import Data.Fixed (Fixed (MkFixed))
import qualified Data.Sequence as Seq
import Data.Text (Text, pack, unpack)
import Data.Time
import NumHask.Prelude
import NumHask.Space.Range
import NumHask.Space.Types
parseUTCTime :: Text -> Maybe UTCTime
parseUTCTime :: Text -> Maybe UTCTime
parseUTCTime =
Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale (Maybe String -> String
iso8601DateFormat Maybe String
forall a. Maybe a
Nothing) (String -> Maybe UTCTime)
-> (Text -> String) -> Text -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
data TimeGrain
= Years Integer
| 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
showList :: [TimeGrain] -> ShowS
$cshowList :: [TimeGrain] -> ShowS
show :: TimeGrain -> String
$cshow :: TimeGrain -> String
showsPrec :: Int -> TimeGrain -> ShowS
$cshowsPrec :: Int -> TimeGrain -> ShowS
Show, TimeGrain -> TimeGrain -> Bool
(TimeGrain -> TimeGrain -> Bool)
-> (TimeGrain -> TimeGrain -> Bool) -> Eq TimeGrain
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. 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
$cto :: forall x. Rep TimeGrain x -> TimeGrain
$cfrom :: forall x. TimeGrain -> Rep TimeGrain x
Generic)
grainSecs :: TimeGrain -> Double
grainSecs :: TimeGrain -> Double
grainSecs (Years Integer
n) = Integer -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Integer
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
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
toNominalDiffTime :: Double -> NominalDiffTime
toNominalDiffTime :: Double -> NominalDiffTime
toNominalDiffTime Double
x =
let d0 :: Day
d0 = Integer -> Day
ModifiedJulianDay Integer
0
days :: Integer
days = Double -> Integer
forall a b. QuotientField a b => a -> b
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
- Integer -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Integer
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 Integer
days Day
d0) (Integer -> DiffTime
picosecondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. QuotientField a b => a -> b
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
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
. 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
. DiffTime -> Integer
diffTimeToPicoseconds
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
. Double -> Integer
forall a b. QuotientField a b => a -> b
floor (Double -> Integer) -> (Double -> Double) -> Double -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
1e12)
addGrain :: TimeGrain -> Int -> UTCTime -> UTCTime
addGrain :: TimeGrain -> Int -> UTCTime -> UTCTime
addGrain (Years Integer
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 (Integer
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 Integer
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
. (if Integer
m' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Integer -> Day -> Day
addGregorianMonthsClip Integer
6 else Day -> Day
forall a. a -> a
id) (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$
Integer -> Day -> Day
addGregorianYearsClip Integer
d' (Integer -> Day -> Day
addDays Integer
1 Day
d)
)
DiffTime
t
where
(Integer
d', Integer
m') = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
2 Integer
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 )
(Day -> Day) -> (Day -> Day) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> 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
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
floorGrain :: TimeGrain -> UTCTime -> UTCTime
floorGrain :: TimeGrain -> UTCTime -> UTCTime
floorGrain (Years Integer
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' = Integer -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Integer
forall a. Additive a => a -> a -> a
+ Integer
n Integer -> Integer -> Integer
forall a. Multiplicative a => a -> a -> a
* Double -> Integer
forall a b. QuotientField a b => a -> b
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
/ Integer -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Integer
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' = Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Integer
1 Integer -> Integer -> Integer
forall a. Additive a => a -> a -> a
+ Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n Integer -> Integer -> Integer
forall a. Multiplicative a => a -> a -> a
* Double -> Integer
forall a b. QuotientField a b => a -> b
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) :: Integer)
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
* Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
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)) :: Integer)) 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
* Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
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)) :: Integer)) 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
* Integer -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
floor (Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
secs) :: Integer)) Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
s
ceilingGrain :: TimeGrain -> UTCTime -> UTCTime
ceilingGrain :: TimeGrain -> UTCTime -> UTCTime
ceilingGrain (Years Integer
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' = Integer -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Integer
forall a. Additive a => a -> a -> a
+ Integer
n Integer -> Integer -> Integer
forall a. Multiplicative a => a -> a -> a
* Double -> Integer
forall a b. QuotientField a b => a -> b
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
/ Integer -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Integer
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
* Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
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)) :: Integer)) 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
* Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
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)) :: Integer)) 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
* Integer -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
ceiling (Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
secs) :: Integer)) Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
s
data PosDiscontinuous = PosInnerOnly | PosIncludeBoundaries
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 (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
x)
step :: ([a], Seq (a, a), a) -> a -> ([a], Seq (a, a), a)
step ([], Seq (a, a)
xs, a
n) a
_ = ([], Seq (a, a)
xs, a
n)
step (a
p : [a]
ps, Seq (a, a)
xs, a
n) a
a
| a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a = ([a], Seq (a, a), a) -> a -> ([a], Seq (a, a), a)
step ([a]
ps, Seq (a, a)
xs Seq (a, a) -> (a, a) -> Seq (a, a)
forall a. Seq a -> a -> Seq a
Seq.:|> (a
n, a
p), a
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 (a, a)
xs, a
n a -> a -> a
forall a. Additive a => a -> a -> a
+ a
1)
| Bool
otherwise = ([a], Seq (a, a), a) -> a -> ([a], Seq (a, a), a)
step ([a]
ps, Seq (a, a)
xs Seq (a, a) -> (a, a) -> Seq (a, a)
forall a. Seq a -> a -> Seq a
Seq.:|> (a
n a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
1, a
p), a
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 (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 a.
(Ord a, FromInteger a, Subtractive a) =>
([a], Seq (a, a), a) -> a -> ([a], Seq (a, a), a)
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
. 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
. (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 Integer
x)
| Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
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
"%R%Q"
laterTimes :: [(Int, a)] -> [(Int, a)]
laterTimes :: [(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 (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 (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)
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
. 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'
(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)]
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
. NominalDiffTime -> Double
fromNominalDiffTime (NominalDiffTime -> Double)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> Double
forall b c a. (b -> c) -> (a -> b) -> 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'
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' :: Integer
n' =
Double -> Integer
forall a b. QuotientField a b => a -> b
round (Double -> Integer) -> Double -> Integer
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 ::
Integer
posns :: [a] -> [a]
posns = case Pos
p of
Pos
OuterPos -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer
n' Integer -> Integer -> Integer
forall a. Additive a => a -> a -> a
+ Integer
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
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer
n' Integer -> Integer -> Integer
forall a. Additive a => a -> a -> a
+ Integer -> Integer -> Bool -> Integer
forall a. a -> a -> Bool -> a
bool Integer
forall a. Additive a => a
zero Integer
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
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer
n' Integer -> Integer -> Integer
forall a. Additive a => a -> a -> a
+ Integer
1)
Pos
LowerPos -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral Integer
n')
Pos
MidPos -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral Integer
n')
ts :: [UTCTime]
ts = case Pos
p of
Pos
MidPos ->
Int -> [UTCTime] -> [UTCTime]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral Integer
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
. (\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 ..]
stepSensible ::
Pos ->
Double ->
Int ->
Double
stepSensible :: Pos -> Double -> Int -> Double
stepSensible 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 -> Integer -> Double
forall b a.
(Ord b, Divisive a, Subtractive b, Integral b) =>
a -> b -> a
^^ (Double -> Integer
forall a b. QuotientField a b => a -> b
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)) :: Integer)
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.15 = Double
10 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.35 = Double
5 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.75 = Double
2 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
step'
| Bool
otherwise = Double
step'
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 -> Integer -> Double
forall b a.
(Ord b, Divisive a, Subtractive b, Integral b) =>
a -> b -> a
^^ (Double -> Integer
forall a b. QuotientField a b => a -> b
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)) :: Integer)
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'
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 = Integer -> TimeGrain
Years (Double -> Integer
forall a b. QuotientField a b => a -> b
floor Double
yearsstep)
| Double
monthsstep Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Months (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
floor Double
monthsstep :: Integer))
| Double
daysstep Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Days (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
floor Double
daysstep :: Integer))
| Double
hoursstep Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Hours (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
floor Double
hoursstep :: Integer))
| Double
minutesstep Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Int -> TimeGrain
Minutes (Integer -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Integer
forall a b. QuotientField a b => a -> b
floor Double
minutesstep :: Integer))
| 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