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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
-- |
-- Module: Math.NumberTheory.TestUtils
-- Copyright: (c) 2016 Andrew Lelechenko
-- Licence: MIT
-- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com>
-- Stability: Provisional
-- Portability: Non-portable (GHC extensions)
--
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Math.NumberTheory.TestUtils
( module Test.SmallCheck.Series
, Power (..)
, Huge (..)
, testSmallAndQuick
) where
import Test.Tasty
import Test.Tasty.SmallCheck as SC
import Test.Tasty.QuickCheck as QC hiding (Positive, NonNegative, generate, getNonNegative)
import Test.SmallCheck.Series (Positive(..), NonNegative(..), Serial(..), Series, generate)
import Control.Applicative
testSmallAndQuick
:: SC.Testable IO a
=> QC.Testable a
=> String -> a -> TestTree
testSmallAndQuick name f = testGroup name
[ SC.testProperty "smallcheck" f
, QC.testProperty "quickcheck" f
]
-------------------------------------------------------------------------------
-- Power
newtype Power a = Power { getPower :: a }
deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real)
instance (Monad m, Num a, Ord a, Serial m a) => Serial m (Power a) where
series = Power <$> series `suchThatSerial` (> 0)
instance (Num a, Ord a, Integral a, Arbitrary a) => Arbitrary (Power a) where
arbitrary = Power <$> (getSmall <$> arbitrary) `suchThat` (> 0)
shrink (Power x) = Power <$> filter (> 0) (shrink x)
suchThatSerial :: Series m a -> (a -> Bool) -> Series m a
suchThatSerial s p = s >>= \x -> if p x then pure x else empty
-------------------------------------------------------------------------------
-- Huge
newtype Huge a = Huge { getHuge :: a }
deriving (Eq, Ord, Read, Show, Num, Enum, Bounded, Integral, Real)
instance (Num a, Arbitrary a) => Arbitrary (Huge a) where
arbitrary = do
Positive l <- arbitrary
ds <- vector (l :: Int)
return $ Huge $ foldl1 (\acc n -> acc * 2^(63 :: Int) + n) ds
-- | maps 'Huge' constructor over series
instance Serial m a => Serial m (Huge a) where
series = fmap Huge series
-------------------------------------------------------------------------------
-- Positive from smallcheck
instance (Num a, Ord a, Arbitrary a) => Arbitrary (Positive a) where
arbitrary = Positive <$> (arbitrary `suchThat` (> 0))
shrink (Positive x) = Positive <$> filter (> 0) (shrink x)
|
