2016-08-14 23:45:49 +03:00
|
|
|
{-# LANGUAGE DataKinds #-}
|
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
2016-08-15 01:11:59 +03:00
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
2017-08-21 22:23:41 +03:00
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
{-# LANGUAGE TypeFamilies #-}
|
2016-08-15 01:11:59 +03:00
|
|
|
{-# LANGUAGE UndecidableInstances #-}
|
2016-08-14 23:45:49 +03:00
|
|
|
|
2017-08-21 22:23:41 +03:00
|
|
|
import GHC.Generics (Generic)
|
2016-08-14 23:45:49 +03:00
|
|
|
import Test.QuickCheck
|
2018-01-05 22:12:19 +03:00
|
|
|
import Generic.Random
|
2016-08-14 23:45:49 +03:00
|
|
|
|
|
|
|
data Tree a = Leaf | Node (Tree a) a (Tree a)
|
|
|
|
deriving (Show, Generic)
|
|
|
|
|
|
|
|
instance Arbitrary a => Arbitrary (Tree a) where
|
2017-08-21 22:23:41 +03:00
|
|
|
arbitrary = genericArbitrary' uniform
|
2016-08-14 23:45:49 +03:00
|
|
|
|
2016-08-15 01:11:59 +03:00
|
|
|
data Bush a = Tip a | Fork (Bush a) (Bush a)
|
|
|
|
deriving (Show, Generic)
|
|
|
|
|
2017-08-21 22:23:41 +03:00
|
|
|
instance (Arbitrary a, BaseCase (Bush a)) => Arbitrary (Bush a) where
|
2017-08-22 19:46:30 +03:00
|
|
|
arbitrary = genericArbitrary' (1 % (2 % ()))
|
2016-08-15 01:11:59 +03:00
|
|
|
|
2017-08-21 22:23:41 +03:00
|
|
|
main :: IO ()
|
2016-08-15 01:11:59 +03:00
|
|
|
main = do
|
|
|
|
sample (arbitrary :: Gen (Tree ()))
|
|
|
|
putStrLn ""
|
|
|
|
sample (arbitrary :: Gen (Bush ()))
|