{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.GenValidity.Mergeful.Timed where

import Data.GenValidity
import Data.Mergeful.Timed
import Test.QuickCheck

instance GenValid a => GenValid (Timed a) where
  genValid :: Gen (Timed a)
genValid = forall a. (Generic a, GGenValid (Rep a)) => Gen a
genValidStructurallyWithoutExtraChecking
  shrinkValid :: Timed a -> [Timed a]
shrinkValid = forall a.
(Generic a, GValidRecursivelyShrink (Rep a),
 GValidSubterms (Rep a) a) =>
a -> [a]
shrinkValidStructurallyWithoutExtraFiltering

instance GenValid ServerTime where
  genValid :: Gen ServerTime
genValid = Word64 -> ServerTime
ServerTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

  -- Use the quickcheck generator to produce Word64s
  -- This will hide the failures around maxBound for Word64
  -- but that's fine in this case.
  -- See also the comment for the 'ServerTime' constructor.
  shrinkValid :: ServerTime -> [ServerTime]
shrinkValid = forall a.
(Generic a, GValidRecursivelyShrink (Rep a),
 GValidSubterms (Rep a) a) =>
a -> [a]
shrinkValidStructurallyWithoutExtraFiltering