{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Slotting.Arbitrary () where

import Cardano.Slotting.Block (BlockNo (..))
import Cardano.Slotting.Slot (
  EpochInterval (..),
  EpochNo (..),
  EpochSize (..),
  SlotNo (..),
  WithOrigin (..),
 )
import Cardano.Slotting.Time (SystemStart (..))
import Test.QuickCheck
import Test.QuickCheck.Instances.Time ()

deriving instance Arbitrary BlockNo

deriving instance Arbitrary EpochNo

deriving instance Arbitrary EpochSize

deriving instance Arbitrary EpochInterval

instance Arbitrary SlotNo where
  arbitrary :: Gen SlotNo
arbitrary =
    Word64 -> SlotNo
SlotNo
      (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (Positive Word64 -> Word64
forall a. Positive a -> a
getPositive (Positive Word64 -> Word64) -> Gen (Positive Word64) -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary)
              Gen Word64 -> (Word64 -> Bool) -> Gen Word64
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (\Word64
n -> Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
2 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
32 :: Int))
          )

  -- need some room, we're assuming we'll never wrap around 64bits

  shrink :: SlotNo -> [SlotNo]
shrink (SlotNo Word64
n) = [Word64 -> SlotNo
SlotNo Word64
n' | Word64
n' <- Word64 -> [Word64]
forall a. Arbitrary a => a -> [a]
shrink Word64
n, Word64
n' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0]

instance Arbitrary t => Arbitrary (WithOrigin t) where
  arbitrary :: Gen (WithOrigin t)
arbitrary = [(Int, Gen (WithOrigin t))] -> Gen (WithOrigin t)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
20, WithOrigin t -> Gen (WithOrigin t)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithOrigin t
forall t. WithOrigin t
Origin), (Int
80, t -> WithOrigin t
forall t. t -> WithOrigin t
At (t -> WithOrigin t) -> Gen t -> Gen (WithOrigin t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen t
forall a. Arbitrary a => Gen a
arbitrary)]
  shrink :: WithOrigin t -> [WithOrigin t]
shrink = \case
    WithOrigin t
Origin -> []
    At t
x -> WithOrigin t
forall t. WithOrigin t
Origin WithOrigin t -> [WithOrigin t] -> [WithOrigin t]
forall a. a -> [a] -> [a]
: (t -> WithOrigin t) -> [t] -> [WithOrigin t]
forall a b. (a -> b) -> [a] -> [b]
map t -> WithOrigin t
forall t. t -> WithOrigin t
At (t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
x)

deriving instance Arbitrary SystemStart