{-# 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.Data
import Data.Fixed (Fixed (MkFixed))
import Data.Sequence qualified as Seq
import Data.Text (Text, pack, unpack)
import Data.Time hiding (Hours, Minutes, Seconds)
import NumHask.Prelude
import NumHask.Space.Range
import NumHask.Space.Types

-- $setup
--
-- >>> :m -Prelude
-- >>> :set -XRebindableSyntax
-- >>> import NumHask.Prelude
-- >>> import NumHask.Space
-- >>> import NumHask.Space.Time (TimeGrain(..))
-- >>> import Data.Text (Text, pack)
-- >>> import Data.Time hiding (Hours, Minutes, Seconds)

-- | a step in time
data TimeGrain
  = Years Int
  | Months Int
  | Days Int
  | Hours Int
  | Minutes Int
  | Seconds Double
  deriving (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, 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, (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, Typeable TimeGrain
Typeable TimeGrain =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TimeGrain -> c TimeGrain)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TimeGrain)
-> (TimeGrain -> Constr)
-> (TimeGrain -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TimeGrain))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeGrain))
-> ((forall b. Data b => b -> b) -> TimeGrain -> TimeGrain)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeGrain -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeGrain -> r)
-> (forall u. (forall d. Data d => d -> u) -> TimeGrain -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TimeGrain -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain)
-> Data TimeGrain
TimeGrain -> Constr
TimeGrain -> DataType
(forall b. Data b => b -> b) -> TimeGrain -> TimeGrain
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TimeGrain -> u
forall u. (forall d. Data d => d -> u) -> TimeGrain -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeGrain -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeGrain -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeGrain
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeGrain -> c TimeGrain
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeGrain)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeGrain)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeGrain -> c TimeGrain
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeGrain -> c TimeGrain
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeGrain
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeGrain
$ctoConstr :: TimeGrain -> Constr
toConstr :: TimeGrain -> Constr
$cdataTypeOf :: TimeGrain -> DataType
dataTypeOf :: TimeGrain -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeGrain)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeGrain)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeGrain)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeGrain)
$cgmapT :: (forall b. Data b => b -> b) -> TimeGrain -> TimeGrain
gmapT :: (forall b. Data b => b -> b) -> TimeGrain -> TimeGrain
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeGrain -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeGrain -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeGrain -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeGrain -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TimeGrain -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TimeGrain -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimeGrain -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimeGrain -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeGrain -> m TimeGrain
Data)

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
Whole Double
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
Whole Double
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 (Int, UTCTime), Int)
begin = ([UTCTime]
tps', Seq (Int, UTCTime)
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)
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 :: [UTCTime] -> [UTCTime]
posns = case Pos
p of
      Pos
OuterPos -> Int -> [UTCTime] -> [UTCTime]
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
Whole Double
n' Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
1)
      Pos
InnerPos ->
        Int -> [UTCTime] -> [UTCTime]
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))
          ([UTCTime] -> [UTCTime])
-> ([UTCTime] -> [UTCTime]) -> [UTCTime] -> [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 -> [UTCTime] -> [UTCTime]
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
Whole Double
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 -> [UTCTime] -> [UTCTime]
forall a. Int -> [a] -> [a]
drop Int
1 ([UTCTime] -> [UTCTime])
-> ([UTCTime] -> [UTCTime]) -> [UTCTime] -> [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 -> [UTCTime] -> [UTCTime]
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
Whole Double
n' Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
1)
      Pos
LowerPos -> Int -> [UTCTime] -> [UTCTime]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral Int
Whole Double
n')
      Pos
MidPos -> Int -> [UTCTime] -> [UTCTime]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. FromIntegral a b => b -> a
fromIntegral Int
Whole Double
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
Whole Double
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]
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