{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NamedFieldPuns #-}
module Data.Timeline.Hedgehog
(
gen,
genRecord,
)
where
import Data.Timeline
import Hedgehog (MonadGen)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
gen ::
(MonadGen m, Ord t) =>
m t ->
m a ->
m (Timeline t a)
gen :: forall (m :: * -> *) t a.
(MonadGen m, Ord t) =>
m t -> m a -> m (Timeline t a)
gen m t
genTime m a
genValue = do
a
initialValue <- m a
genValue
Map t a
values <- forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20) forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m t
genTime forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
genValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timeline {a
$sel:initialValue:Timeline :: a
initialValue :: a
initialValue, Map t a
$sel:values:Timeline :: Map t a
values :: Map t a
values}
genRecord ::
(MonadGen m, Ord t) =>
m t ->
m a ->
m (Record t a)
genRecord :: forall (m :: * -> *) t a.
(MonadGen m, Ord t) =>
m t -> m a -> m (Record t a)
genRecord m t
genTime m a
genValue =
forall (m :: * -> *) a. MonadGen m => m (Maybe a) -> m a
Gen.justT forall a b. (a -> b) -> a -> b
$ do
t
t1 <- m t
genTime
Maybe t
t2 <- forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadGen m => (a -> Bool) -> m a -> m a
Gen.filterT (forall a. Eq a => a -> a -> Bool
/= t
t1) m t
genTime
forall t a. Ord t => t -> Maybe t -> a -> Maybe (Record t a)
makeRecord t
t1 Maybe t
t2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
genValue