{-|
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              #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}


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 :: 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.Day where
  arbitrary :: Gen Day
arbitrary = (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)
  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 = (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))

instance Arbitrary DT.DiffTime where
  arbitrary :: Gen DiffTime
arbitrary = (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))

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