{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeApplications #-}
module IntervalAlgebra.Arbitrary() where
import Test.QuickCheck ( Arbitrary(arbitrary, shrink),
Gen, NonNegative )
import GHC.Int ( Int )
import GHC.Num
import GHC.Real
import GHC.Float
import Control.Applicative ( (<$>), liftA2 )
import Control.Monad ( liftM2 )
import IntervalAlgebra (Interval, beginerval)
import Data.Function ( (.), ($) )
import Data.Fixed
import Data.Bool
import Data.Ord
import Data.Time as DT ( Day(ModifiedJulianDay)
, toModifiedJulianDay
, picosecondsToDiffTime
, secondsToDiffTime
, secondsToNominalDiffTime
, UTCTime(..), NominalDiffTime)
instance Arbitrary (Interval Int) where
arbitrary :: Gen (Interval Int)
arbitrary = (Int -> Int -> Interval Int)
-> Gen Int -> Gen Int -> Gen (Interval Int)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Int -> Int -> Interval Int
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval Gen Int
forall a. Arbitrary a => Gen a
arbitrary Gen Int
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary DT.Day where
arbitrary :: Gen Day
arbitrary = Integer -> Day
DT.ModifiedJulianDay (Integer -> Day) -> Gen Integer -> Gen Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
shrink :: Day -> [Day]
shrink = (Integer -> Day
DT.ModifiedJulianDay (Integer -> Day) -> [Integer] -> [Day]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Integer] -> [Day]) -> (Day -> [Integer]) -> Day -> [Day]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink (Integer -> [Integer]) -> (Day -> Integer) -> Day -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer
DT.toModifiedJulianDay
withinDiffTimeRange :: Integer -> Integer
withinDiffTimeRange :: Integer -> Integer
withinDiffTimeRange Integer
x
| Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Integer
0
| Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
86400 = Integer
86400
| Bool
otherwise = Integer
x
instance Arbitrary DT.NominalDiffTime where
arbitrary :: Gen NominalDiffTime
arbitrary = Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> NominalDiffTime)
-> (Integer -> Integer) -> Integer -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
withinDiffTimeRange (Integer -> NominalDiffTime) -> Gen Integer -> Gen NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen Integer
forall a. Arbitrary a => Gen a
arbitrary :: Gen Integer)
instance Arbitrary DT.UTCTime where
arbitrary :: Gen UTCTime
arbitrary = (Day -> DiffTime -> UTCTime)
-> Gen Day -> Gen DiffTime -> Gen UTCTime
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Day -> DiffTime -> UTCTime
UTCTime
Gen Day
forall a. Arbitrary a => Gen a
arbitrary
(Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime)
-> (Integer -> Integer) -> Integer -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
withinDiffTimeRange (Integer -> DiffTime) -> Gen Integer -> Gen DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen Integer
forall a. Arbitrary a => Gen a
arbitrary :: Gen Integer) )
instance Arbitrary (Interval DT.Day) where
arbitrary :: Gen (Interval Day)
arbitrary = (Integer -> Day -> Interval Day)
-> Gen Integer -> Gen Day -> Gen (Interval Day)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Integer -> Day -> Interval Day
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval Gen Integer
forall a. Arbitrary a => Gen a
arbitrary Gen Day
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Interval DT.UTCTime) where
arbitrary :: Gen (Interval UTCTime)
arbitrary = (NominalDiffTime -> UTCTime -> Interval UTCTime)
-> Gen NominalDiffTime -> Gen UTCTime -> Gen (Interval UTCTime)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 NominalDiffTime -> UTCTime -> Interval UTCTime
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval Gen NominalDiffTime
forall a. Arbitrary a => Gen a
arbitrary Gen UTCTime
forall a. Arbitrary a => Gen a
arbitrary