{-# LANGUAGE NumericUnderscores #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Provides utility functions relating to testing with times and dates.

module Test.Utils.Time
    ( UniformTime
    , genUniformTime
    , genUniformTimeWithinRange
    , getUniformTime
    ) where

import Prelude

import Data.Time
    ( Day (ModifiedJulianDay)
    , NominalDiffTime
    , UTCTime (..)
    , addUTCTime
    , toModifiedJulianDay
    )
import Test.QuickCheck
    ( Arbitrary, Gen, arbitrary, choose, oneof )

-- | A wrapper for 'UTCTime' whose 'Arbitrary' instance spans a uniform range
--   of dates and a mixture of time precisions.
--
newtype UniformTime = UniformTime { UniformTime -> UTCTime
getUniformTime :: UTCTime }
    deriving (UniformTime -> UniformTime -> Bool
(UniformTime -> UniformTime -> Bool)
-> (UniformTime -> UniformTime -> Bool) -> Eq UniformTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UniformTime -> UniformTime -> Bool
$c/= :: UniformTime -> UniformTime -> Bool
== :: UniformTime -> UniformTime -> Bool
$c== :: UniformTime -> UniformTime -> Bool
Eq, Eq UniformTime
Eq UniformTime
-> (UniformTime -> UniformTime -> Ordering)
-> (UniformTime -> UniformTime -> Bool)
-> (UniformTime -> UniformTime -> Bool)
-> (UniformTime -> UniformTime -> Bool)
-> (UniformTime -> UniformTime -> Bool)
-> (UniformTime -> UniformTime -> UniformTime)
-> (UniformTime -> UniformTime -> UniformTime)
-> Ord UniformTime
UniformTime -> UniformTime -> Bool
UniformTime -> UniformTime -> Ordering
UniformTime -> UniformTime -> UniformTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UniformTime -> UniformTime -> UniformTime
$cmin :: UniformTime -> UniformTime -> UniformTime
max :: UniformTime -> UniformTime -> UniformTime
$cmax :: UniformTime -> UniformTime -> UniformTime
>= :: UniformTime -> UniformTime -> Bool
$c>= :: UniformTime -> UniformTime -> Bool
> :: UniformTime -> UniformTime -> Bool
$c> :: UniformTime -> UniformTime -> Bool
<= :: UniformTime -> UniformTime -> Bool
$c<= :: UniformTime -> UniformTime -> Bool
< :: UniformTime -> UniformTime -> Bool
$c< :: UniformTime -> UniformTime -> Bool
compare :: UniformTime -> UniformTime -> Ordering
$ccompare :: UniformTime -> UniformTime -> Ordering
$cp1Ord :: Eq UniformTime
Ord, Int -> UniformTime -> ShowS
[UniformTime] -> ShowS
UniformTime -> String
(Int -> UniformTime -> ShowS)
-> (UniformTime -> String)
-> ([UniformTime] -> ShowS)
-> Show UniformTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UniformTime] -> ShowS
$cshowList :: [UniformTime] -> ShowS
show :: UniformTime -> String
$cshow :: UniformTime -> String
showsPrec :: Int -> UniformTime -> ShowS
$cshowsPrec :: Int -> UniformTime -> ShowS
Show)

instance Arbitrary UniformTime where
    arbitrary :: Gen UniformTime
arbitrary = UTCTime -> UniformTime
UniformTime (UTCTime -> UniformTime) -> Gen UTCTime -> Gen UniformTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTCTime
genUniformTime

-- | Generate 'UTCTime' values over a uniform range of dates and a mixture of
--   time precisions.
--
-- Dates will be generated in a range that's bounded by 'defaultLowerBound' and
-- 'defaultUpperBound'.

genUniformTime :: Gen UTCTime
genUniformTime :: Gen UTCTime
genUniformTime = Day -> Day -> Gen UTCTime
genUniformTimeWithinRange Day
defaultLowerBound Day
defaultUpperBound

-- | Generate 'UTCTime' values over a uniform range of dates and a mixture of
--   time precisions.
--
-- Dates will be generated in a range that's bounded by the given minimum and
-- maximum Julian day arguments.
--
genUniformTimeWithinRange :: Day -> Day -> Gen UTCTime
genUniformTimeWithinRange :: Day -> Day -> Gen UTCTime
genUniformTimeWithinRange Day
lowerBound Day
upperBound
    | Day
lowerBound Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
upperBound = String -> Gen UTCTime
forall a. HasCallStack => String -> a
error (String -> Gen UTCTime) -> String -> Gen UTCTime
forall a b. (a -> b) -> a -> b
$
        String
"genUniformTimeWithinRange: invalid bounds: "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Day, Day) -> String
forall a. Show a => a -> String
show (Day
lowerBound, Day
upperBound)
    | Bool
otherwise = [Gen UTCTime] -> Gen UTCTime
forall a. [Gen a] -> Gen a
oneof
        [ (Integer -> NominalDiffTime) -> Integer -> Gen UTCTime
genWith
            Integer -> NominalDiffTime
forall a. Integral a => a -> NominalDiffTime
hoursToNominalDiffTime
            Integer
forall a. Integral a => a
hoursInOneDay
        , (Integer -> NominalDiffTime) -> Integer -> Gen UTCTime
genWith
            Integer -> NominalDiffTime
forall a. Integral a => a -> NominalDiffTime
secondsToNominalDiffTime
            Integer
forall a. Integral a => a
secondsInOneDay
        , (Integer -> NominalDiffTime) -> Integer -> Gen UTCTime
genWith
            Integer -> NominalDiffTime
forall a. Integral a => a -> NominalDiffTime
picosecondsToNominalDiffTime
            Integer
forall a. Integral a => a
picosecondsInOneDay
        ]
  where
    genWith :: (Integer -> NominalDiffTime) -> Integer -> Gen UTCTime
    genWith :: (Integer -> NominalDiffTime) -> Integer -> Gen UTCTime
genWith Integer -> NominalDiffTime
unitsToNominalDiffTime Integer
unitsInOneDay = do
        Day
numberOfDays <- Integer -> Day
ModifiedJulianDay
            (Integer -> Day) -> Gen Integer -> Gen Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose
                ( Day -> Integer
toModifiedJulianDay Day
lowerBound
                , Day -> Integer
toModifiedJulianDay Day
upperBound
                )
        NominalDiffTime
timeSinceMidnight <- Integer -> NominalDiffTime
unitsToNominalDiffTime
            (Integer -> NominalDiffTime) -> Gen Integer -> Gen NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
unitsInOneDay)
        UTCTime -> Gen UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> Gen UTCTime) -> UTCTime -> Gen UTCTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
timeSinceMidnight (Day -> DiffTime -> UTCTime
UTCTime Day
numberOfDays DiffTime
0)

defaultLowerBound :: Day
defaultLowerBound :: Day
defaultLowerBound = Integer -> Day
ModifiedJulianDay Integer
0

defaultUpperBound :: Day
defaultUpperBound :: Day
defaultUpperBound = Integer -> Day
ModifiedJulianDay (Integer -> Day) -> Integer -> Day
forall a b. (a -> b) -> a -> b
$ Integer
365 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
50

-- | The number of hours in a day.
hoursInOneDay :: Integral a => a
hoursInOneDay :: a
hoursInOneDay = a
24

-- | The maximum number of picoseconds in one day, allowing for leap seconds.
picosecondsInOneDay :: Integral a => a
picosecondsInOneDay :: a
picosecondsInOneDay = a
forall a. Integral a => a
secondsInOneDay a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Integral a => a
picosecondsInOneSecond

-- | The exact number of picoseconds in one second.
picosecondsInOneSecond :: Integral a => a
picosecondsInOneSecond :: a
picosecondsInOneSecond = a
1_000_000_000_000

-- | The maximum number of seconds in one day, allowing for leap seconds.
secondsInOneDay :: Integral a => a
secondsInOneDay :: a
secondsInOneDay = (a
forall a. Integral a => a
secondsInOneHour a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Integral a => a
hoursInOneDay) a -> a -> a
forall a. Num a => a -> a -> a
+ a
1

-- | The exact number of seconds in one hour.
secondsInOneHour :: Integral a => a
secondsInOneHour :: a
secondsInOneHour = a
60 a -> a -> a
forall a. Num a => a -> a -> a
* a
60

-- | Convert a number of hours into a 'NominalDiffTime' value.
hoursToNominalDiffTime :: Integral a => a -> NominalDiffTime
hoursToNominalDiffTime :: a -> NominalDiffTime
hoursToNominalDiffTime = a -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> NominalDiffTime) -> (a -> a) -> a -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
forall a. Integral a => a
secondsInOneHour a -> a -> a
forall a. Num a => a -> a -> a
*)

-- | Convert a number of picoseconds into a 'NominalDiffTime' value.
picosecondsToNominalDiffTime :: Integral a => a -> NominalDiffTime
picosecondsToNominalDiffTime :: a -> NominalDiffTime
picosecondsToNominalDiffTime = Int -> NominalDiffTime
forall a. Enum a => Int -> a
toEnum (Int -> NominalDiffTime) -> (a -> Int) -> a -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Convert a number of seconds into a 'NominalDiffTime' value.
secondsToNominalDiffTime :: Integral a => a -> NominalDiffTime
secondsToNominalDiffTime :: a -> NominalDiffTime
secondsToNominalDiffTime = a -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral