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

import Test.QuickCheck ( Arbitrary(arbitrary, shrink) )
import GHC.Base
    ( otherwise,
      ($),
      Eq((==)),
      Ord((<=), (<), min, max),
      Int,
      Maybe(..),
      (.), 
      liftM2 )
import Control.Applicative((<$>))
import GHC.Num ( Num((+), negate) )
import IntervalAlgebra (
      Interval
    , Intervallic(unsafeInterval)
    , IntervalSizeable(add))
import Data.Time as DT ( Day(ModifiedJulianDay), toModifiedJulianDay)

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 => a -> b -> Interval a
safeInterval' 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) -> (Integer -> Integer) -> Integer -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
2000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+) (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 (Interval DT.Day) where
  arbitrary :: Gen (Interval Day)
arbitrary = (Day -> Integer -> Interval Day)
-> Gen Day -> Gen Integer -> Gen (Interval Day)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Day -> Integer -> Interval Day
forall a b. IntervalSizeable a b => a -> b -> Interval a
safeInterval' Gen Day
forall a. Arbitrary a => Gen a
arbitrary Gen Integer
forall a. Arbitrary a => Gen a
arbitrary

type IntervalInt = Interval Int

-- | Internal function for converting a number to a strictly positive value.
makePos :: (Ord b, Num b) => b -> b
makePos :: b -> b
makePos b
x
  | b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0    = b
x b -> b -> b
forall a. Num a => a -> a -> a
+ b
1
  | b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<  b
0    = b -> b
forall a. Num a => a -> a
negate b
x
  | Bool
otherwise = b
x

-- | A function for creating intervals when you think you know what you're doing.
safeInterval :: (Intervallic a) => a -> a -> Interval a
safeInterval :: a -> a -> Interval a
safeInterval a
x a
y = a -> a -> Interval a
forall a. Intervallic a => a -> a -> Interval a
unsafeInterval (a -> a -> a
forall a. Ord a => a -> a -> a
min a
x a
y) (a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
y)

-- | Safely create a valid 'Interval a' from two @a@ by adding a positive @dur@
--   to @start@ to set the duration of the interval.
safeInterval' :: (IntervalSizeable a b) => a -> b -> Interval a
safeInterval' :: a -> b -> Interval a
safeInterval' a
start b
dur = a -> a -> Interval a
forall a. Intervallic a => a -> a -> Interval a
safeInterval a
start (b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add (b -> b
forall b. (Ord b, Num b) => b -> b
makePos b
dur) a
start)

-- | Create a 'Maybe Interval a' from two @a@s.
safeInterval'' :: (Intervallic a) => a -> a -> Maybe (Interval a)
safeInterval'' :: a -> a -> Maybe (Interval a)
safeInterval'' a
x a
y
    | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x    = Maybe (Interval a)
forall a. Maybe a
Nothing
    | Bool
otherwise = Interval a -> Maybe (Interval a)
forall a. a -> Maybe a
Just (Interval a -> Maybe (Interval a))
-> Interval a -> Maybe (Interval a)
forall a b. (a -> b) -> a -> b
$ a -> a -> Interval a
forall a. Intervallic a => a -> a -> Interval a
safeInterval a
x a
y