{-|
Module      : Generate arbitrary Intervals
Description : Functions for generating arbitrary intervals
Copyright   : (c) NoviSci, Inc 2020-2022
                  TargetRWE, 2023
License     : BSD3
Maintainer  : bsaul@novisci.com 2020-2022, bbrown@targetrwe.com 2023
Stability   : experimental
-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}


module IntervalAlgebra.Arbitrary where

import           Control.Applicative (liftA2, (<$>))
import           Control.Monad       (liftM2)
import           Data.Bool
import           Data.Fixed
import           Data.Function       (flip, ($), (.))
import           Data.Maybe          (Maybe (Just, Nothing))
import           Data.Ord
import qualified Data.Set            (Set, difference, null, singleton)
import           Data.Time           as DT (Day (ModifiedJulianDay), DiffTime,
                                            NominalDiffTime, UTCTime (..),
                                            picosecondsToDiffTime,
                                            secondsToDiffTime,
                                            secondsToNominalDiffTime,
                                            toModifiedJulianDay)
import           GHC.Float
import           GHC.Int             (Int)
import           GHC.Num
import           GHC.Real
import           IntervalAlgebra     (Interval, IntervalRelation (..),
                                      Intervallic, PairedInterval, Point,
                                      SizedIv (..), beginerval, converse,
                                      duration, makePairedInterval, moment,
                                      predicate, strictWithinRelations)
import           Test.QuickCheck     (Arbitrary (arbitrary, shrink), Gen,
                                      NonNegative, arbitrarySizedNatural,
                                      elements, resize, sized, suchThat)

-- 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

-- 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
maxDiffTime :: Int
maxDiffTime :: Int
maxDiffTime = Int
86399

--instance Arbitrary DT.DiffTime where
--  arbitrary = sized
--
--
--instance Arbitrary DT.UTCTime  where
--  arbitrary = liftA2 UTCTime arbitrary arbitrary

-- Helper
-- NOTE: You likely want to restrict the size of `dur` in a more appropriate
-- way, to be uniform over the range >= moment.
sizedIntervalGen :: (SizedIv (Interval a), Ord (Moment (Interval a))) => Int -> Gen a -> Gen (Moment (Interval a)) -> Gen (Interval a)
sizedIntervalGen :: Int -> Gen a -> Gen (Moment (Interval a)) -> Gen (Interval a)
sizedIntervalGen Int
s Gen a
gpt Gen (Moment (Interval a))
gmom = do
  a
b <- Int
s Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
`resize` Gen a
gpt
  Moment (Interval a)
dur <- Int
s Int -> Gen (Moment (Interval a)) -> Gen (Moment (Interval a))
forall a. Int -> Gen a -> Gen a
`resize` Gen (Moment (Interval a))
gmom
  Interval a -> Gen (Interval a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Interval a -> Gen (Interval a)) -> Interval a -> Gen (Interval a)
forall a b. (a -> b) -> a -> b
$ Moment (Interval a) -> a -> Interval a
forall a.
SizedIv (Interval a) =>
Moment (Interval a) -> a -> Interval a
beginerval Moment (Interval a)
dur a
b

-- Generators for types that do not implement Arbitrary. This avoids creating
-- orphan instances for these types.

genDay :: Gen DT.Day
genDay :: Gen Day
genDay = (Int -> Gen Day) -> Gen Day
forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> Integer -> Day
DT.ModifiedJulianDay (Integer -> Day) -> Gen Integer -> Gen Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
s Int -> Gen Integer -> Gen Integer
forall a. Int -> Gen a -> Gen a
`resize` Gen Integer
forall a. Arbitrary a => Gen a
arbitrary)

genNominalDiffTime :: Gen DT.NominalDiffTime
genNominalDiffTime :: Gen NominalDiffTime
genNominalDiffTime = (Int -> Gen NominalDiffTime) -> Gen NominalDiffTime
forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> 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 -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
s Int
maxDiffTime Int -> Gen Integer -> Gen Integer
forall a. Int -> Gen a -> Gen a
`resize` Gen Integer
forall a. Integral a => Gen a
arbitrarySizedNatural))

genDiffTime :: Gen DT.DiffTime
genDiffTime :: Gen DiffTime
genDiffTime = (Int -> Gen DiffTime) -> Gen DiffTime
forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> 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 -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
s Int
maxDiffTime Int -> Gen Integer -> Gen Integer
forall a. Int -> Gen a -> Gen a
`resize` Gen Integer
forall a. Integral a => Gen a
arbitrarySizedNatural))

genUTCTime :: Gen DT.UTCTime
genUTCTime :: Gen UTCTime
genUTCTime = (Int -> Gen UTCTime) -> Gen UTCTime
forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> (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
genDay Gen DiffTime
genDiffTime)

-- Arbitrary instances
-- for SizedIv instances defined in Core

instance Arbitrary (Interval Int) where
  arbitrary :: Gen (Interval Int)
arbitrary = (Int -> Gen (Interval Int)) -> Gen (Interval Int)
forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> Int -> Gen Int -> Gen (Moment (Interval Int)) -> Gen (Interval Int)
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
Int -> Gen a -> Gen (Moment (Interval a)) -> Gen (Interval a)
sizedIntervalGen Int
s Gen Int
forall a. Arbitrary a => Gen a
arbitrary Gen (Moment (Interval Int))
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (Interval Integer) where
  arbitrary :: Gen (Interval Integer)
arbitrary = (Int -> Gen (Interval Integer)) -> Gen (Interval Integer)
forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> Int
-> Gen Integer
-> Gen (Moment (Interval Integer))
-> Gen (Interval Integer)
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
Int -> Gen a -> Gen (Moment (Interval a)) -> Gen (Interval a)
sizedIntervalGen Int
s Gen Integer
forall a. Arbitrary a => Gen a
arbitrary Gen (Moment (Interval Integer))
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (Interval Double) where
  arbitrary :: Gen (Interval Double)
arbitrary = (Int -> Gen (Interval Double)) -> Gen (Interval Double)
forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> Int
-> Gen Double
-> Gen (Moment (Interval Double))
-> Gen (Interval Double)
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
Int -> Gen a -> Gen (Moment (Interval a)) -> Gen (Interval a)
sizedIntervalGen Int
s Gen Double
forall a. Arbitrary a => Gen a
arbitrary Gen (Moment (Interval Double))
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (Interval DT.Day) where
  arbitrary :: Gen (Interval Day)
arbitrary = (Int -> Gen (Interval Day)) -> Gen (Interval Day)
forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> Int -> Gen Day -> Gen (Moment (Interval Day)) -> Gen (Interval Day)
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
Int -> Gen a -> Gen (Moment (Interval a)) -> Gen (Interval a)
sizedIntervalGen Int
s Gen Day
genDay Gen (Moment (Interval Day))
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (Interval DT.UTCTime) where
  arbitrary :: Gen (Interval UTCTime)
arbitrary = (Int -> Gen (Interval UTCTime)) -> Gen (Interval UTCTime)
forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> Int
-> Gen UTCTime
-> Gen (Moment (Interval UTCTime))
-> Gen (Interval UTCTime)
forall a.
(SizedIv (Interval a), Ord (Moment (Interval a))) =>
Int -> Gen a -> Gen (Moment (Interval a)) -> Gen (Interval a)
sizedIntervalGen Int
s Gen UTCTime
genUTCTime Gen NominalDiffTime
Gen (Moment (Interval UTCTime))
genNominalDiffTime)


-- | Conditional generation of intervals relative to a reference.  If the
-- reference @iv@ is of 'moment' duration, it is not possible to generate
-- intervals from the strict enclose relations StartedBy, Contains, FinishedBy.
-- If @iv@ and @rs@ are such that no possible relations can be generated, this
-- function returns `Nothing`. Otherwise, it returns `Just` an interval that
-- satisfies at least one of the possible relations in @rs@ relative to
-- @iv@.
--
-- @
-- > import Test.QuickCheck (generate)
-- > import Data.Set (fromList)
-- > isJust $ generate $ arbitraryWithRelation (beginerval 10 (0::Int)) (fromList [Before])
-- Just (20, 22)
-- > generate $ arbitraryWithRelation (beginerval 1 (0::Int)) (fromList [StartedBy])
-- Nothing
-- > generate $ arbitraryWithRelation (beginerval 1 (0::Int)) (fromList [StartedBy, Before])
-- Just (4, 13)
-- @
--
arbitraryWithRelation
  :: forall i a b
   . (SizedIv (Interval a), Ord a, Eq (Moment (Interval a)), Arbitrary (Interval a))
  => Interval a -- ^ reference interval
  -> Data.Set.Set IntervalRelation -- ^ set of `IntervalRelation`s, of which at least one will hold for the generated interval relative to the reference
  -> Gen (Maybe (Interval a))
arbitraryWithRelation :: Interval a -> Set IntervalRelation -> Gen (Maybe (Interval a))
arbitraryWithRelation Interval a
iv Set IntervalRelation
rs
  | Set IntervalRelation
rs Set IntervalRelation -> Set IntervalRelation -> Bool
forall a. Eq a => a -> a -> Bool
== IntervalRelation -> Set IntervalRelation
forall a. a -> Set a
Data.Set.singleton IntervalRelation
Equals = [Maybe (Interval a)] -> Gen (Maybe (Interval a))
forall a. [a] -> Gen a
elements [Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just Interval a
iv]
  | Bool
isEnclose Bool -> Bool -> Bool
&& Bool
isMom = [Maybe (Interval a)] -> Gen (Maybe (Interval a))
forall a. [a] -> Gen a
elements [Maybe (Interval a)
forall a. Maybe a
Nothing]
  | Bool
isMom = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Gen (Interval a) -> Gen (Maybe (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Interval a)
forall a. Arbitrary a => Gen a
arbitrary Gen (Interval a) -> (Interval a -> Bool) -> Gen (Interval a)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Set IntervalRelation
-> ComparativePredicateOf2 (Interval a) (Interval a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(SizedIv (Interval a), Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate Set IntervalRelation
notStrictEnclose Interval a
iv
  | Bool
otherwise = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Gen (Interval a) -> Gen (Maybe (Interval a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Interval a)
forall a. Arbitrary a => Gen a
arbitrary Gen (Interval a) -> (Interval a -> Bool) -> Gen (Interval a)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Set IntervalRelation
-> ComparativePredicateOf2 (Interval a) (Interval a)
forall a (i0 :: * -> *) (i1 :: * -> *).
(SizedIv (Interval a), Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate Set IntervalRelation
rs Interval a
iv
 where
  notStrictEnclose :: Set IntervalRelation
notStrictEnclose = Set IntervalRelation
-> Set IntervalRelation -> Set IntervalRelation
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set IntervalRelation
rs (Set IntervalRelation -> Set IntervalRelation
converse Set IntervalRelation
strictWithinRelations)
  isEnclose :: Bool
isEnclose        = Set IntervalRelation -> Bool
forall a. Set a -> Bool
Data.Set.null Set IntervalRelation
notStrictEnclose
  isMom :: Bool
isMom            = Interval a -> Moment (Interval a)
forall iv. SizedIv iv => iv -> Moment iv
duration Interval a
iv Moment (Interval a) -> Moment (Interval a) -> Bool
forall a. Eq a => a -> a -> Bool
== SizedIv (Interval a) => Moment (Interval a)
forall iv. SizedIv iv => Moment iv
moment @(Interval a)