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


module IntervalAlgebra.Arbitrary
  ( arbitraryWithRelation
  ) 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 (..),
                                      IntervalSizeable, Intervallic,
                                      PairedInterval, beginerval, converse,
                                      duration, makePairedInterval, moment,
                                      predicate, strictWithinRelations)
import           Prelude             (Eq, (==))
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 :: forall a. Integral a => Gen a
arbitrarySizedPositive = (forall a. Num a => a -> a -> a
+ a
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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.Day where
  arbitrary :: Gen Day
arbitrary = forall a. (Int -> Gen a) -> Gen a
sized (\Int
s -> Integer -> Day
DT.ModifiedJulianDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
s forall a. Int -> Gen a -> Gen a
`resize` forall a. Arbitrary a => Gen a
arbitrary)
  shrink :: Day -> [Day]
shrink    = (Integer -> Day
DT.ModifiedJulianDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer
DT.toModifiedJulianDay

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

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

instance Arbitrary DT.UTCTime  where
  arbitrary :: Gen UTCTime
arbitrary = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Day -> DiffTime -> UTCTime
UTCTime forall a. Arbitrary a => Gen a
arbitrary forall a. Arbitrary a => Gen a
arbitrary

-- | 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
   . (IntervalSizeable a b, Intervallic i, Arbitrary (i a))
  => i 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 (i a))
arbitraryWithRelation :: forall (i :: * -> *) a b.
(IntervalSizeable a b, Intervallic i, Arbitrary (i a)) =>
i a -> Set IntervalRelation -> Gen (Maybe (i a))
arbitraryWithRelation i a
iv Set IntervalRelation
rs
  | Set IntervalRelation
rs forall a. Eq a => a -> a -> Bool
== forall a. a -> Set a
Data.Set.singleton IntervalRelation
Equals = forall a. [a] -> Gen a
elements [forall a. a -> Maybe a
Just i a
iv]
  | Bool
isEnclose Bool -> Bool -> Bool
&& Bool
isMom = forall a. [a] -> Gen a
elements [forall a. Maybe a
Nothing]
  | Bool
isMom = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate Set IntervalRelation
notStrictEnclose i a
iv
  | Bool
otherwise = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` forall a (i0 :: * -> *) (i1 :: * -> *).
(Ord a, Intervallic i0, Intervallic i1) =>
Set IntervalRelation -> ComparativePredicateOf2 (i0 a) (i1 a)
predicate Set IntervalRelation
rs i a
iv
 where
  notStrictEnclose :: Set IntervalRelation
notStrictEnclose = 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        = forall a. Set a -> Bool
Data.Set.null Set IntervalRelation
notStrictEnclose
  isMom :: Bool
isMom            = forall a b (i :: * -> *).
(IntervalSizeable a b, Intervallic i) =>
i a -> b
duration i a
iv forall a. Eq a => a -> a -> Bool
== forall a b a. IntervalSizeable a b => b
moment @a