{-# OPTIONS_GHC -Wno-orphans #-}

module PlutusLedgerApi.V1.Orphans.Interval () where

import Data.Word (Word32)
import PlutusLedgerApi.V1 qualified as PLA
import PlutusLedgerApi.V1.Interval qualified as Interval
import PlutusLedgerApi.V1.Orphans.Time ()
import Test.QuickCheck (
  Arbitrary (arbitrary, shrink),
  Arbitrary1 (liftArbitrary, liftShrink),
  CoArbitrary (coarbitrary),
  Function (function),
  frequency,
  functionMap,
  getNonNegative,
  oneof,
  variant,
 )

{- | This instance does not bias the constructor choice: it is equally likely to
produce 'PLA.Finite', 'PLA.NegInf' and 'PLA.PosInf'. Bear this in mind when
using: in particular, the instance for 'PLA.Interval' /does not/ make use of
this instance.

@since 1.0.0
-}
instance Arbitrary1 PLA.Extended where
  {-# INLINEABLE liftArbitrary #-}
  liftArbitrary :: forall a. Gen a -> Gen (Extended a)
liftArbitrary Gen a
genInner =
    [Gen (Extended a)] -> Gen (Extended a)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Extended a -> Gen (Extended a)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Extended a
forall a. Extended a
PLA.NegInf
      , a -> Extended a
forall a. a -> Extended a
PLA.Finite (a -> Extended a) -> Gen a -> Gen (Extended a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genInner
      , Extended a -> Gen (Extended a)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Extended a
forall a. Extended a
PLA.PosInf
      ]
  {-# INLINEABLE liftShrink #-}
  liftShrink :: forall a. (a -> [a]) -> Extended a -> [Extended a]
liftShrink a -> [a]
shrinkInner = \case
    Extended a
PLA.NegInf -> []
    PLA.Finite a
x -> a -> Extended a
forall a. a -> Extended a
PLA.Finite (a -> Extended a) -> [a] -> [Extended a]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
shrinkInner a
x
    Extended a
PLA.PosInf -> []

{- | This makes use of the 'Arbitrary1' instance of 'PLA.Extended' internally,
and thus is subject to the same caveats.

@since 1.0.0
-}
instance Arbitrary a => Arbitrary (PLA.Extended a) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (Extended a)
arbitrary = Gen a -> Gen (Extended a)
forall a. Gen a -> Gen (Extended a)
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
forall a. Arbitrary a => Gen a
arbitrary
  {-# INLINEABLE shrink #-}
  shrink :: Extended a -> [Extended a]
shrink = (a -> [a]) -> Extended a -> [Extended a]
forall a. (a -> [a]) -> Extended a -> [Extended a]
forall (f :: Type -> Type) a.
Arbitrary1 f =>
(a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

-- | @since 1.0.0
instance CoArbitrary a => CoArbitrary (PLA.Extended a) where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. Extended a -> Gen b -> Gen b
coarbitrary = \case
    Extended a
PLA.NegInf -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
0 :: Int)
    PLA.Finite a
x -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
1 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Gen b -> Gen b
forall b. a -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary a
x
    Extended a
PLA.PosInf -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
2 :: Int)

-- | @since 1.0.0
instance Function a => Function (PLA.Extended a) where
  {-# INLINEABLE function #-}
  function :: forall b. (Extended a -> b) -> Extended a :-> b
function = (Extended a -> Maybe (Maybe a))
-> (Maybe (Maybe a) -> Extended a)
-> (Extended a -> b)
-> Extended a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Extended a -> Maybe (Maybe a)
into Maybe (Maybe a) -> Extended a
outOf
    where
      into :: PLA.Extended a -> Maybe (Maybe a)
      into :: Extended a -> Maybe (Maybe a)
into = \case
        Extended a
PLA.NegInf -> Maybe (Maybe a)
forall a. Maybe a
Nothing
        Extended a
PLA.PosInf -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
        PLA.Finite a
x -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
      outOf :: Maybe (Maybe a) -> PLA.Extended a
      outOf :: Maybe (Maybe a) -> Extended a
outOf = \case
        Maybe (Maybe a)
Nothing -> Extended a
forall a. Extended a
PLA.NegInf
        Just Maybe a
Nothing -> Extended a
forall a. Extended a
PLA.PosInf
        Just (Just a
x) -> a -> Extended a
forall a. a -> Extended a
PLA.Finite a
x

{- | This makes use of the 'Arbitrary1' instance of 'PLA.Extended' internally,
and thus is subject to the same caveats. Furthermore, in cases where it makes
sense to talk about open and closed bounds, this instance produces open and
closed bounds with equal probability. Keep these in mind when using this
instance; in particular, the instance for 'PLA.Interval' /does not/ make use
of this instance.

@since 1.0.0
-}
instance Arbitrary (PLA.LowerBound PLA.POSIXTime) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (LowerBound POSIXTime)
arbitrary = do
    Extended POSIXTime
e <- Gen (Extended POSIXTime)
forall a. Arbitrary a => Gen a
arbitrary
    case Extended POSIXTime
e of
      -- For a finite bound, it makes sense to talk about it being open or
      -- closed.
      PLA.Finite POSIXTime
_ -> Extended POSIXTime -> Closure -> LowerBound POSIXTime
forall a. Extended a -> Closure -> LowerBound a
PLA.LowerBound Extended POSIXTime
e (Closure -> LowerBound POSIXTime)
-> Gen Closure -> Gen (LowerBound POSIXTime)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Closure
forall a. Arbitrary a => Gen a
arbitrary
      -- If the bound is infinite, it _must_ be open.
      Extended POSIXTime
_ -> LowerBound POSIXTime -> Gen (LowerBound POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (LowerBound POSIXTime -> Gen (LowerBound POSIXTime))
-> (Closure -> LowerBound POSIXTime)
-> Closure
-> Gen (LowerBound POSIXTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extended POSIXTime -> Closure -> LowerBound POSIXTime
forall a. Extended a -> Closure -> LowerBound a
PLA.LowerBound Extended POSIXTime
e (Closure -> Gen (LowerBound POSIXTime))
-> Closure -> Gen (LowerBound POSIXTime)
forall a b. (a -> b) -> a -> b
$ Closure
False
  {-# INLINEABLE shrink #-}
  shrink :: LowerBound POSIXTime -> [LowerBound POSIXTime]
shrink (PLA.LowerBound Extended POSIXTime
e Closure
c) = case Extended POSIXTime
e of
    PLA.Finite POSIXTime
_ -> Extended POSIXTime -> Closure -> LowerBound POSIXTime
forall a. Extended a -> Closure -> LowerBound a
PLA.LowerBound (Extended POSIXTime -> Closure -> LowerBound POSIXTime)
-> [Extended POSIXTime] -> [Closure -> LowerBound POSIXTime]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Extended POSIXTime -> [Extended POSIXTime]
forall a. Arbitrary a => a -> [a]
shrink Extended POSIXTime
e [Closure -> LowerBound POSIXTime]
-> [Closure] -> [LowerBound POSIXTime]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Closure -> [Closure]
forall a. Arbitrary a => a -> [a]
shrink Closure
c
    -- Negative or positive infinity bounds can't really shrink sensibly
    Extended POSIXTime
_ -> []

-- | @since 1.0.0
instance CoArbitrary a => CoArbitrary (PLA.LowerBound a) where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. LowerBound a -> Gen b -> Gen b
coarbitrary (PLA.LowerBound Extended a
e Closure
c) = Extended a -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Extended a -> Gen b -> Gen b
coarbitrary Extended a
e (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Closure -> Gen b -> Gen b
forall b. Closure -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Closure
c

-- | @since 1.0.0
instance Function a => Function (PLA.LowerBound a) where
  {-# INLINEABLE function #-}
  function :: forall b. (LowerBound a -> b) -> LowerBound a :-> b
function = (LowerBound a -> (Extended a, Closure))
-> ((Extended a, Closure) -> LowerBound a)
-> (LowerBound a -> b)
-> LowerBound a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(PLA.LowerBound Extended a
e Closure
c) -> (Extended a
e, Closure
c)) ((Extended a -> Closure -> LowerBound a)
-> (Extended a, Closure) -> LowerBound a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Extended a -> Closure -> LowerBound a
forall a. Extended a -> Closure -> LowerBound a
PLA.LowerBound)

{- | This makes use of the 'Arbitrary1' instance of 'PLA.Extended' internally,
and thus is subject to the same caveats. Furthermore, in cases where it makes
sense to talk about open and closed bounds, this instance produces open and
closed bounds with equal probability. Keep these in mind when using this
instance; in particular, the instance for 'PLA.Interval' /does not/ make use
of this instance.

@since 1.0.0
-}
instance Arbitrary (PLA.UpperBound PLA.POSIXTime) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (UpperBound POSIXTime)
arbitrary = do
    Extended POSIXTime
e <- Gen (Extended POSIXTime)
forall a. Arbitrary a => Gen a
arbitrary
    case Extended POSIXTime
e of
      -- For a finite bound, it makes sense to talk about it being open or
      -- closed.
      PLA.Finite POSIXTime
_ -> Extended POSIXTime -> Closure -> UpperBound POSIXTime
forall a. Extended a -> Closure -> UpperBound a
PLA.UpperBound Extended POSIXTime
e (Closure -> UpperBound POSIXTime)
-> Gen Closure -> Gen (UpperBound POSIXTime)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Closure
forall a. Arbitrary a => Gen a
arbitrary
      -- If the bound is infinite, it _must_ be open.
      Extended POSIXTime
_ -> UpperBound POSIXTime -> Gen (UpperBound POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (UpperBound POSIXTime -> Gen (UpperBound POSIXTime))
-> (Closure -> UpperBound POSIXTime)
-> Closure
-> Gen (UpperBound POSIXTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extended POSIXTime -> Closure -> UpperBound POSIXTime
forall a. Extended a -> Closure -> UpperBound a
PLA.UpperBound Extended POSIXTime
e (Closure -> Gen (UpperBound POSIXTime))
-> Closure -> Gen (UpperBound POSIXTime)
forall a b. (a -> b) -> a -> b
$ Closure
False
  {-# INLINEABLE shrink #-}
  shrink :: UpperBound POSIXTime -> [UpperBound POSIXTime]
shrink (PLA.UpperBound Extended POSIXTime
e Closure
c) = case Extended POSIXTime
e of
    PLA.Finite POSIXTime
_ -> Extended POSIXTime -> Closure -> UpperBound POSIXTime
forall a. Extended a -> Closure -> UpperBound a
PLA.UpperBound (Extended POSIXTime -> Closure -> UpperBound POSIXTime)
-> [Extended POSIXTime] -> [Closure -> UpperBound POSIXTime]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Extended POSIXTime -> [Extended POSIXTime]
forall a. Arbitrary a => a -> [a]
shrink Extended POSIXTime
e [Closure -> UpperBound POSIXTime]
-> [Closure] -> [UpperBound POSIXTime]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Closure -> [Closure]
forall a. Arbitrary a => a -> [a]
shrink Closure
c
    -- Negative or positive infinity bounds can't really shrink sensibly
    Extended POSIXTime
_ -> []

-- | @since 1.0.0
instance CoArbitrary a => CoArbitrary (PLA.UpperBound a) where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. UpperBound a -> Gen b -> Gen b
coarbitrary (PLA.UpperBound Extended a
e Closure
c) = Extended a -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Extended a -> Gen b -> Gen b
coarbitrary Extended a
e (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Closure -> Gen b -> Gen b
forall b. Closure -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Closure
c

-- | @since 1.0.0
instance Function a => Function (PLA.UpperBound a) where
  {-# INLINEABLE function #-}
  function :: forall b. (UpperBound a -> b) -> UpperBound a :-> b
function = (UpperBound a -> (Extended a, Closure))
-> ((Extended a, Closure) -> UpperBound a)
-> (UpperBound a -> b)
-> UpperBound a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(PLA.UpperBound Extended a
e Closure
c) -> (Extended a
e, Closure
c)) ((Extended a -> Closure -> UpperBound a)
-> (Extended a, Closure) -> UpperBound a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Extended a -> Closure -> UpperBound a
forall a. Extended a -> Closure -> UpperBound a
PLA.UpperBound)

{- | We provide an instance specialized to 'PLA.POSIXTime', rather than a more
general one, as it doesn't make much sense to talk about 'PLA.Interval's of
arbitrary types in general. Furthermore, this is the only instance we
actually use, so there's no real loss there.

This instance tries to make time intervals as fairly as possible, while also
ensuring that they're sensibly formed. We work under the assumption of a
32-bit epoch: while this is _technically_ not going to last much longer,
we're safe until about 2030 on that basis, which should be enough for now.

We choose not to shrink intervals, as this is surprisingly complex: in at
least one common case, it's not even possible to write a shrinker that will
ever 'bottom out', due to us having infinite bounds!

@since 1.0.0
-}
instance Arbitrary (PLA.Interval PLA.POSIXTime) where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen (Interval POSIXTime)
arbitrary = do
    let epochSize :: Int
epochSize = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)
    Extended POSIXTime
lowerBound <-
      [(Int, Gen (Extended POSIXTime))] -> Gen (Extended POSIXTime)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
        [ (Int
1, Extended POSIXTime -> Gen (Extended POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Extended POSIXTime
forall a. Extended a
PLA.NegInf)
        , (Int
1, Extended POSIXTime -> Gen (Extended POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Extended POSIXTime
forall a. Extended a
PLA.PosInf)
        , (Int
epochSize, POSIXTime -> Extended POSIXTime
forall a. a -> Extended a
PLA.Finite (POSIXTime -> Extended POSIXTime)
-> (NonNegative POSIXTime -> POSIXTime)
-> NonNegative POSIXTime
-> Extended POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative POSIXTime -> POSIXTime
forall a. NonNegative a -> a
getNonNegative (NonNegative POSIXTime -> Extended POSIXTime)
-> Gen (NonNegative POSIXTime) -> Gen (Extended POSIXTime)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative POSIXTime)
forall a. Arbitrary a => Gen a
arbitrary)
        ]
    case Extended POSIXTime
lowerBound of
      -- With a finite lower bound, it makes sense to talk about an upper one
      PLA.Finite POSIXTime
x -> do
        Closure
lowerClosure <- Gen Closure
forall a. Arbitrary a => Gen a
arbitrary
        let lower :: LowerBound POSIXTime
lower = Extended POSIXTime -> Closure -> LowerBound POSIXTime
forall a. Extended a -> Closure -> LowerBound a
PLA.LowerBound Extended POSIXTime
lowerBound Closure
lowerClosure
        -- To ensure we generate something sensible for the upper bound, we
        -- either generate a 'diff', or positive infinity.
        Either (Extended Any) POSIXTime
whatUpper <-
          [(Int, Gen (Either (Extended Any) POSIXTime))]
-> Gen (Either (Extended Any) POSIXTime)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
            [ (Int
1, Either (Extended Any) POSIXTime
-> Gen (Either (Extended Any) POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either (Extended Any) POSIXTime
 -> Gen (Either (Extended Any) POSIXTime))
-> (Extended Any -> Either (Extended Any) POSIXTime)
-> Extended Any
-> Gen (Either (Extended Any) POSIXTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extended Any -> Either (Extended Any) POSIXTime
forall a b. a -> Either a b
Left (Extended Any -> Gen (Either (Extended Any) POSIXTime))
-> Extended Any -> Gen (Either (Extended Any) POSIXTime)
forall a b. (a -> b) -> a -> b
$ Extended Any
forall a. Extended a
PLA.PosInf)
            , (Int
epochSize, POSIXTime -> Either (Extended Any) POSIXTime
forall a b. b -> Either a b
Right (POSIXTime -> Either (Extended Any) POSIXTime)
-> (NonNegative POSIXTime -> POSIXTime)
-> NonNegative POSIXTime
-> Either (Extended Any) POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative POSIXTime -> POSIXTime
forall a. NonNegative a -> a
getNonNegative (NonNegative POSIXTime -> Either (Extended Any) POSIXTime)
-> Gen (NonNegative POSIXTime)
-> Gen (Either (Extended Any) POSIXTime)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative POSIXTime)
forall a. Arbitrary a => Gen a
arbitrary)
            ]
        case Either (Extended Any) POSIXTime
whatUpper of
          -- If we have an infinite upper bound, we know it will be open.
          Left Extended Any
_ -> do
            let upper :: UpperBound a
upper = Extended a -> Closure -> UpperBound a
forall a. Extended a -> Closure -> UpperBound a
PLA.UpperBound Extended a
forall a. Extended a
PLA.PosInf Closure
False
            Interval POSIXTime -> Gen (Interval POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Interval POSIXTime -> Gen (Interval POSIXTime))
-> (UpperBound POSIXTime -> Interval POSIXTime)
-> UpperBound POSIXTime
-> Gen (Interval POSIXTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LowerBound POSIXTime -> UpperBound POSIXTime -> Interval POSIXTime
forall a. LowerBound a -> UpperBound a -> Interval a
PLA.Interval LowerBound POSIXTime
lower (UpperBound POSIXTime -> Gen (Interval POSIXTime))
-> UpperBound POSIXTime -> Gen (Interval POSIXTime)
forall a b. (a -> b) -> a -> b
$ UpperBound POSIXTime
forall {a}. UpperBound a
upper
          Right POSIXTime
diff -> case (POSIXTime
diff, Closure
lowerClosure) of
            -- A diff of 0 means we can only have a singleton closure sensibly.
            (POSIXTime
0, Closure
_) -> Interval POSIXTime -> Gen (Interval POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Interval POSIXTime -> Gen (Interval POSIXTime))
-> (POSIXTime -> Interval POSIXTime)
-> POSIXTime
-> Gen (Interval POSIXTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Interval POSIXTime
forall a. a -> Interval a
Interval.singleton (POSIXTime -> Gen (Interval POSIXTime))
-> POSIXTime -> Gen (Interval POSIXTime)
forall a b. (a -> b) -> a -> b
$ POSIXTime
x
            -- A diff of 1 with an open lower bound means we either have a
            -- singleton closure or an empty one.
            (POSIXTime
1, Closure
False) -> do
              Closure
upperClosure <- Gen Closure
forall a. Arbitrary a => Gen a
arbitrary
              Interval POSIXTime -> Gen (Interval POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Interval POSIXTime -> Gen (Interval POSIXTime))
-> Interval POSIXTime -> Gen (Interval POSIXTime)
forall a b. (a -> b) -> a -> b
$
                if Closure
upperClosure
                  then POSIXTime -> Interval POSIXTime
forall a. a -> Interval a
Interval.singleton POSIXTime
x
                  else Interval POSIXTime
forall a. Interval a
Interval.never
            -- A diff of 1 with a closed lower bound is either a singleton
            -- closure or one with two values.
            (POSIXTime
1, Closure
True) -> do
              Closure
upperClosure <- Gen Closure
forall a. Arbitrary a => Gen a
arbitrary
              Interval POSIXTime -> Gen (Interval POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Interval POSIXTime -> Gen (Interval POSIXTime))
-> Interval POSIXTime -> Gen (Interval POSIXTime)
forall a b. (a -> b) -> a -> b
$
                if Closure
upperClosure
                  then LowerBound POSIXTime -> UpperBound POSIXTime -> Interval POSIXTime
forall a. LowerBound a -> UpperBound a -> Interval a
PLA.Interval LowerBound POSIXTime
lower (UpperBound POSIXTime -> Interval POSIXTime)
-> (Closure -> UpperBound POSIXTime)
-> Closure
-> Interval POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extended POSIXTime -> Closure -> UpperBound POSIXTime
forall a. Extended a -> Closure -> UpperBound a
PLA.UpperBound (POSIXTime -> Extended POSIXTime
forall a. a -> Extended a
PLA.Finite (POSIXTime
x POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
diff)) (Closure -> Interval POSIXTime) -> Closure -> Interval POSIXTime
forall a b. (a -> b) -> a -> b
$ Closure
upperClosure
                  else POSIXTime -> Interval POSIXTime
forall a. a -> Interval a
Interval.singleton POSIXTime
x
            -- A diff bigger than 1 can be treated uniformly.
            (POSIXTime
_, Closure
_) -> LowerBound POSIXTime -> UpperBound POSIXTime -> Interval POSIXTime
forall a. LowerBound a -> UpperBound a -> Interval a
PLA.Interval LowerBound POSIXTime
lower (UpperBound POSIXTime -> Interval POSIXTime)
-> (Closure -> UpperBound POSIXTime)
-> Closure
-> Interval POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extended POSIXTime -> Closure -> UpperBound POSIXTime
forall a. Extended a -> Closure -> UpperBound a
PLA.UpperBound (POSIXTime -> Extended POSIXTime
forall a. a -> Extended a
PLA.Finite (POSIXTime
x POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
diff)) (Closure -> Interval POSIXTime)
-> Gen Closure -> Gen (Interval POSIXTime)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Closure
forall a. Arbitrary a => Gen a
arbitrary
      -- With an negative infinite lower bound, we know it will be open.
      Extended POSIXTime
PLA.NegInf -> do
        let lower :: LowerBound POSIXTime
lower = Extended POSIXTime -> Closure -> LowerBound POSIXTime
forall a. Extended a -> Closure -> LowerBound a
PLA.LowerBound Extended POSIXTime
lowerBound Closure
False
        -- To ensure we generate something sensible for the upper bound, we
        -- do not attempt to generate NegInf
        Extended POSIXTime
upperBound <-
          [(Int, Gen (Extended POSIXTime))] -> Gen (Extended POSIXTime)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
            [ (Int
1, Extended POSIXTime -> Gen (Extended POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Extended POSIXTime
forall a. Extended a
PLA.PosInf)
            , (Int
epochSize, POSIXTime -> Extended POSIXTime
forall a. a -> Extended a
PLA.Finite (POSIXTime -> Extended POSIXTime)
-> (NonNegative POSIXTime -> POSIXTime)
-> NonNegative POSIXTime
-> Extended POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative POSIXTime -> POSIXTime
forall a. NonNegative a -> a
getNonNegative (NonNegative POSIXTime -> Extended POSIXTime)
-> Gen (NonNegative POSIXTime) -> Gen (Extended POSIXTime)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative POSIXTime)
forall a. Arbitrary a => Gen a
arbitrary)
            ]
        case Extended POSIXTime
upperBound of
          -- With a finite upper bound, we just choose a closure and move on.
          PLA.Finite POSIXTime
_ -> do
            UpperBound POSIXTime
upper <- Extended POSIXTime -> Closure -> UpperBound POSIXTime
forall a. Extended a -> Closure -> UpperBound a
PLA.UpperBound Extended POSIXTime
upperBound (Closure -> UpperBound POSIXTime)
-> Gen Closure -> Gen (UpperBound POSIXTime)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Closure
forall a. Arbitrary a => Gen a
arbitrary
            Interval POSIXTime -> Gen (Interval POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Interval POSIXTime -> Gen (Interval POSIXTime))
-> (UpperBound POSIXTime -> Interval POSIXTime)
-> UpperBound POSIXTime
-> Gen (Interval POSIXTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LowerBound POSIXTime -> UpperBound POSIXTime -> Interval POSIXTime
forall a. LowerBound a -> UpperBound a -> Interval a
PLA.Interval LowerBound POSIXTime
lower (UpperBound POSIXTime -> Gen (Interval POSIXTime))
-> UpperBound POSIXTime -> Gen (Interval POSIXTime)
forall a b. (a -> b) -> a -> b
$ UpperBound POSIXTime
upper
          -- With an infinite upper bound, we have the range that includes
          -- everything. We use the canonical choice provided by
          -- Interval.always.
          Extended POSIXTime
_ -> Interval POSIXTime -> Gen (Interval POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Interval POSIXTime
forall a. Interval a
Interval.always
      -- With an positive infinite lower bound, we have the empty interval, and
      -- can choose any representation of such that we like. We use the
      -- canonical choice provided by Interval.never.
      Extended POSIXTime
PLA.PosInf -> Interval POSIXTime -> Gen (Interval POSIXTime)
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Interval POSIXTime
forall a. Interval a
Interval.never

-- | @since 1.0.0
instance CoArbitrary a => CoArbitrary (PLA.Interval a) where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. Interval a -> Gen b -> Gen b
coarbitrary (PLA.Interval LowerBound a
lower UpperBound a
upper) = LowerBound a -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. LowerBound a -> Gen b -> Gen b
coarbitrary LowerBound a
lower (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpperBound a -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. UpperBound a -> Gen b -> Gen b
coarbitrary UpperBound a
upper

-- | @since 1.0.0
instance Function a => Function (PLA.Interval a) where
  {-# INLINEABLE function #-}
  function :: forall b. (Interval a -> b) -> Interval a :-> b
function = (Interval a -> (LowerBound a, UpperBound a))
-> ((LowerBound a, UpperBound a) -> Interval a)
-> (Interval a -> b)
-> Interval a :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(PLA.Interval LowerBound a
lower UpperBound a
upper) -> (LowerBound a
lower, UpperBound a
upper)) ((LowerBound a -> UpperBound a -> Interval a)
-> (LowerBound a, UpperBound a) -> Interval a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LowerBound a -> UpperBound a -> Interval a
forall a. LowerBound a -> UpperBound a -> Interval a
PLA.Interval)