blob: be12bc29451331274cbd77a32b6822f0cee1518f (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
{-# LANGUAGE UndecidableInstances #-}
module Xanthous.Util.QuickCheck
( functionShow
, FunctionShow(..)
, functionJSON
, FunctionJSON(..)
, genericArbitrary
, GenericArbitrary(..)
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
import Test.QuickCheck
import Test.QuickCheck.Function
import Test.QuickCheck.Instances.ByteString ()
import Test.QuickCheck.Arbitrary.Generic
import Data.Aeson
import GHC.Generics (Rep)
--------------------------------------------------------------------------------
newtype FunctionShow a = FunctionShow a
deriving newtype (Show, Read)
instance (Show a, Read a) => Function (FunctionShow a) where
function = functionShow
functionJSON :: (ToJSON a, FromJSON a) => (a -> c) -> a :-> c
functionJSON = functionMap encode (headEx . decode)
newtype FunctionJSON a = FunctionJSON a
deriving newtype (ToJSON, FromJSON)
instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where
function = functionJSON
--------------------------------------------------------------------------------
newtype GenericArbitrary a = GenericArbitrary a
deriving newtype Generic
instance (Generic a, GArbitrary rep, Rep a ~ rep)
=> Arbitrary (GenericArbitrary a) where
arbitrary = genericArbitrary
|