Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module Arbitrary.Product where
import Test.QuickCheck
-- Example
data Record = R Int Bool String
test :: Gen Record
test = arbitraryProduct R
data S
= S1 Int Double
| S2 Double String
test2 :: Gen S
test2 = frequency
[ 97 % S1
, 3 % S2
]
-- Implementation
arbitraryProduct
:: (Uncurry ctor, Arbitrary tuple, Uncurried ctor ~ (tuple -> record))
=> ctor -> Gen record
arbitraryProduct con = uncurry_ con <$> arbitrary
-- | > Uncurried (a -> b -> c -> d -> e) = (((a, b), c), d) -> e
type family Uncurried a where
Uncurried (a -> b -> c) = Uncurried ((a, b) -> c)
Uncurried (a -> b) = a -> b
class Uncurry a where
uncurry_ :: a -> Uncurried a
instance {-# OVERLAPPING #-} Uncurry ((a, b) -> c) => Uncurry (a -> b -> c) where
uncurry_ = uncurry_ . uncurry
instance (Uncurried (a -> b) ~ (a -> b)) => Uncurry (a -> b) where
uncurry_ = id
(%)
:: (Uncurry ctor, Arbitrary tuple, Uncurried ctor ~ (tuple -> record))
=> Int -> ctor -> (Int, Gen record)
n % ctor = (n, arbitraryProduct ctor)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.