{-|
Module      : Generate arbitrary Intervals
Description : Functions for generating arbitrary intervals
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
Stability   : experimental
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Safe              #-}


module IntervalAlgebra.Arbitrary() where

import           Control.Applicative (liftA2, (<$>))
import           Control.Monad       (liftM2)
import           Data.Bool
import           Data.Fixed
import           Data.Function       (($), (.))
import           Data.Ord
import           Data.Time           as DT (Day (ModifiedJulianDay),
                                            NominalDiffTime, UTCTime (..),
                                            DiffTime,
                                            picosecondsToDiffTime,
                                            secondsToDiffTime,
                                            secondsToNominalDiffTime,
                                            toModifiedJulianDay)
import           GHC.Float
import           GHC.Int             (Int)
import           GHC.Num
import           GHC.Real
import           IntervalAlgebra     (Interval, beginerval)
import           Test.QuickCheck     (Arbitrary (arbitrary, shrink), Gen,
                                      arbitrarySizedNatural, resize)

-- NOTE: the default size for arbitrary :: Gen Int appears to be 30
arbitrarySizedPositive :: Integral a => Gen a
arbitrarySizedPositive :: Gen a
arbitrarySizedPositive = (a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) (a -> a) -> Gen a -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Integral a => Gen a
arbitrarySizedNatural

maxDiffTime :: Int
maxDiffTime :: Int
maxDiffTime = Int
86400

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. Integral a => Gen a
arbitrarySizedPositive 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

instance Arbitrary DT.NominalDiffTime where
   arbitrary :: Gen NominalDiffTime
arbitrary = Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> NominalDiffTime) -> Gen Integer -> Gen NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
maxDiffTime Int -> Gen Integer -> Gen Integer
forall a. Int -> Gen a -> Gen a
`resize` Gen Integer
forall a. Integral a => Gen a
arbitrarySizedNatural)

instance Arbitrary DT.DiffTime where
   arbitrary :: Gen DiffTime
arbitrary = Integer -> DiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> DiffTime) -> Gen Integer -> Gen DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
maxDiffTime Int -> Gen Integer -> Gen Integer
forall a. Int -> Gen a -> Gen a
`resize` Gen Integer
forall a. Integral a => Gen a
arbitrarySizedNatural)

instance Arbitrary DT.UTCTime  where
    -- resize in utctDayTime is to avoid rare leap-seconds-related failure, in
    -- which e.g.  1858-12-31 00:00:00 UTC /= 1858-12-30 23:59:60 UTC
    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 (Int
86399 Int -> Gen DiffTime -> Gen DiffTime
forall a. Int -> Gen a -> Gen a
`resize` Gen DiffTime
forall a. Arbitrary a => Gen a
arbitrary)
                  
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