{-# LANGUAGE NumericUnderscores #-}
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 )
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
genUniformTime :: Gen UTCTime
genUniformTime :: Gen UTCTime
genUniformTime = Day -> Day -> Gen UTCTime
genUniformTimeWithinRange Day
defaultLowerBound Day
defaultUpperBound
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
hoursInOneDay :: Integral a => a
hoursInOneDay :: a
hoursInOneDay = a
24
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
picosecondsInOneSecond :: Integral a => a
picosecondsInOneSecond :: a
picosecondsInOneSecond = a
1_000_000_000_000
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
secondsInOneHour :: Integral a => a
secondsInOneHour :: a
secondsInOneHour = a
60 a -> a -> a
forall a. Num a => a -> a -> a
* a
60
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
*)
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
secondsToNominalDiffTime :: Integral a => a -> NominalDiffTime
secondsToNominalDiffTime :: a -> NominalDiffTime
secondsToNominalDiffTime = a -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral