mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
341 lines
14 KiB
Haskell
341 lines
14 KiB
Haskell
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
|
|
|
|
module Set6Test where
|
|
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.Char (toUpper)
|
|
import Language.Haskell.TH.Syntax (lift,isInstance,mkName)
|
|
import Test.QuickCheck
|
|
|
|
import Mooc.Th
|
|
import Mooc.Test
|
|
|
|
import Set6
|
|
|
|
testEquals x y exp = $(testing [|x == y|]) (?==exp)
|
|
|
|
ex1 = conjoin [testEquals Finland Finland True
|
|
,testEquals Norway Norway True
|
|
,testEquals Switzerland Switzerland True
|
|
,testEquals Finland Norway False
|
|
,testEquals Finland Switzerland False
|
|
,testEquals Norway Finland False
|
|
,testEquals Norway Switzerland False
|
|
,testEquals Switzerland Finland False
|
|
,testEquals Switzerland Norway False]
|
|
|
|
ex2 = conjoin
|
|
[Finland ?<= Finland, Finland ?<= Norway, Finland ?<= Switzerland
|
|
,Norway ?<= Norway, Norway ?<= Switzerland
|
|
,Switzerland ?<= Switzerland
|
|
,Norway ?> Finland
|
|
,Switzerland ?> Norway, Switzerland ?> Finland
|
|
,$(testing [|compare Norway Switzerland|]) (?==LT)
|
|
,$(testing [|compare Finland Finland|]) (?==EQ)
|
|
,$(testing [|min Switzerland Norway|]) (?==Norway)
|
|
,$(testing [|max Norway Finland|]) (?==Norway)]
|
|
where x ?<= y = $(testing [|x <= y|]) (?==True)
|
|
x ?> y = $(testing [|x > y|]) (?==True)
|
|
|
|
word = listOf1 (choose ('a','z'))
|
|
|
|
capitalizeOne :: String -> Gen String
|
|
capitalizeOne [c] = return [toUpper c]
|
|
capitalizeOne (c:cs) = oneof [return (toUpper c:cs)
|
|
,(c:) <$> capitalizeOne cs]
|
|
|
|
ex3 = property $ do
|
|
name <- word
|
|
diff <- word `suchThat` (/=name)
|
|
namev1 <- capitalizeOne name
|
|
namev2 <- capitalizeOne name
|
|
diffv1 <- capitalizeOne diff
|
|
return $ conjoin [testEquals (Name namev1) (Name namev2) True
|
|
,testEquals (Name namev1) (Name diffv1) False
|
|
,testEquals (Name namev1) (Name (namev1++diff)) False]
|
|
|
|
fromList = foldr LNode Empty
|
|
|
|
ex4_eq = forAll_ $ \(xs::[Bool]) -> testEquals (fromList xs) (fromList xs) True
|
|
|
|
ex4_neq = forAll_ $ \(xs::[Int],ys) -> testEquals (fromList xs) (fromList ys) (xs == ys)
|
|
|
|
ex5_egg = $(withInstance "Price" "Egg" [|price|]) $ \price -> conjoin [$(testing [|price ChocolateEgg|]) (?==30)
|
|
,$(testing [|price ChickenEgg|]) (?==20)]
|
|
|
|
|
|
ex5_milk = $(withInstance "Price" "Milk" [|price|]) $ \price ->
|
|
forAllBlind (choose (0,100)) $ \l ->
|
|
$(testing [|price (Milk l)|]) (?==(15*l))
|
|
|
|
ex6_egg =
|
|
$(withInstances1 "Price" ["Maybe", "[]"] [|price|]) $ \price ->
|
|
conjoin [$(testing [|price [Just ChocolateEgg, Nothing, Just ChickenEgg]|]) (?==50)
|
|
,$(testing [|price [Nothing, Nothing, Nothing :: Maybe Egg]|]) (?==0)]
|
|
|
|
|
|
ex6_milk =
|
|
$(withInstances1 "Price" ["Maybe", "[]"] [|price|]) $ \price ->
|
|
forAllBlind (choose (0,10)) $ \milk1 ->
|
|
forAllBlind (choose (0,10)) $ \milk2 ->
|
|
conjoin [$(testing [|price [Just (Milk milk1), Nothing, Just (Milk milk2)]|]) (?==(15*milk1+15*milk2))
|
|
,$(testing [|price [Nothing, Nothing, Nothing :: Maybe Milk]|]) (?==0)]
|
|
|
|
instance Arbitrary Number where
|
|
arbitrary = do
|
|
b <- arbitrary
|
|
if b then arbitrary >>= return . Finite else return Infinite
|
|
|
|
ex7_eq_check =
|
|
$(withInstance "Eq" "Number" [|(==) :: Number -> Number -> Bool|]) $ \(==) ->
|
|
forAll_ $ \i ->
|
|
forAll_ $ \j ->
|
|
conjoin [$(testing [|Finite i == Finite j|]) (?==(i Prelude.== j))
|
|
,$(testing [|Finite i == Infinite|]) (?==False)
|
|
,$(testing [|Infinite == Infinite|]) (?==True)]
|
|
|
|
ex7_finite_finite =
|
|
$(withInstance "Ord" "Number" [|((<) :: Number -> Number -> Bool
|
|
,(>) :: Number -> Number -> Bool
|
|
,(<=) :: Number -> Number -> Bool
|
|
,(>=) :: Number -> Number -> Bool)|]) $ \((<),(>),(<=),(>=)) ->
|
|
forAll_ $ \i ->
|
|
forAll_ $ \(Positive delta) ->
|
|
let a = Finite i
|
|
b = Finite (i+delta)
|
|
in conjoin [$(testing [|a < b|]) (?==True)
|
|
,$(testing [|b < a|]) (?==False)
|
|
,$(testing [|a > b|]) (?==False)
|
|
,$(testing [|b > a|]) (?==True)
|
|
,$(testing [|a <= b|]) (?==True)
|
|
,$(testing [|b <= a|]) (?==False)
|
|
,$(testing [|a >= b|]) (?==False)
|
|
,$(testing [|b >= a|]) (?==True)
|
|
]
|
|
|
|
ex7_finite_infinite =
|
|
$(withInstance "Ord" "Number" [|((<) :: Number -> Number -> Bool
|
|
,(>) :: Number -> Number -> Bool
|
|
,(<=) :: Number -> Number -> Bool
|
|
,(>=) :: Number -> Number -> Bool)|]) $ \((<),(>),(<=),(>=)) ->
|
|
forAll_ $ \i ->
|
|
let a = Finite i
|
|
b = Infinite
|
|
in conjoin [$(testing [|a < b|]) (?==True)
|
|
,$(testing [|b < a|]) (?==False)
|
|
,$(testing [|a > b|]) (?==False)
|
|
,$(testing [|b > a|]) (?==True)
|
|
,$(testing [|a <= b|]) (?==True)
|
|
,$(testing [|b <= a|]) (?==False)
|
|
,$(testing [|a >= b|]) (?==False)
|
|
,$(testing [|b >= a|]) (?==True)
|
|
]
|
|
|
|
ex7_infinite_infinite =
|
|
$(withInstance "Ord" "Number" [|((<) :: Number -> Number -> Bool
|
|
,(>) :: Number -> Number -> Bool
|
|
,(<=) :: Number -> Number -> Bool
|
|
,(>=) :: Number -> Number -> Bool)|]) $ \((<),(>),(<=),(>=)) ->
|
|
conjoin [$(testing [|Infinite < Infinite|]) (?==False)
|
|
,$(testing [|Infinite > Infinite|]) (?==False)
|
|
,$(testing [|Infinite <= Infinite|]) (?==True)
|
|
,$(testing [|Infinite >= Infinite|]) (?==True)
|
|
]
|
|
|
|
ex7_max_finite =
|
|
$(withInstance "Ord" "Number" [|max :: Number -> Number -> Number|]) $ \max ->
|
|
forAll_ $ \i ->
|
|
forAll_ $ \j ->
|
|
$(testing [|max (Finite i) (Finite j)|]) (?==Finite (Prelude.max i j))
|
|
|
|
ex7_max_infinite =
|
|
$(withInstance "Ord" "Number" [|max :: Number -> Number -> Number|]) $ \max ->
|
|
forAll_ $ \i ->
|
|
conjoin [$(testing [|max (Finite i) Infinite|]) (?==Infinite)
|
|
,$(testing [|max Infinite (Finite i)|]) (?==Infinite)
|
|
,$(testing [|max Infinite Infinite|]) (?==Infinite)]
|
|
|
|
instance Arbitrary RationalNumber where
|
|
arbitrary = do num <- arbitrary
|
|
(Positive den) <- arbitrary
|
|
return (RationalNumber num den)
|
|
|
|
ex8_refl =
|
|
$(withInstance "Eq" "RationalNumber" [|(==) :: RationalNumber -> RationalNumber -> Bool|]) $ \(==) ->
|
|
forAll_ $ \r ->
|
|
$(testing [|r == r|]) (?==True)
|
|
|
|
ex8_eq = $(withInstance "Eq" "RationalNumber" [|(==) :: RationalNumber -> RationalNumber -> Bool|]) $ \(==) ->
|
|
forAll_ $ \r@(RationalNumber p q) ->
|
|
forAll_ $ \(NonZero i) ->
|
|
forAll_ $ \(NonZero j) ->
|
|
conjoin [$(testing [|r == (RationalNumber (i*p) (i*q))|]) (?==True)
|
|
,$(testing [|r == (RationalNumber (i*p+j) (i*q))|]) (?==False)]
|
|
|
|
primes = nubBy (\x y -> mod y x == 0) [2..]
|
|
genPrime = elements $ take 100 primes
|
|
|
|
identical :: RationalNumber -> RationalNumber -> Bool
|
|
identical (RationalNumber a b) (RationalNumber c d) = a==c && b==d
|
|
|
|
exactly should was = expectation should was (identical should was)
|
|
|
|
genSimpl = do
|
|
q <- genPrime
|
|
p <- choose (1,q-1)
|
|
return $ RationalNumber p q
|
|
|
|
ex9_prime = forAllBlind genSimpl $ \(RationalNumber p q) ->
|
|
forAll_ $ \(Positive i) ->
|
|
$(testing [|simplify (RationalNumber (i*p) (i*q))|]) (exactly (RationalNumber p q))
|
|
|
|
ex9_eq = forAll_ $ \r@(RationalNumber p q) ->
|
|
forAll_ $ \(Positive i) ->
|
|
let s = RationalNumber (i*p) (i*q)
|
|
in $(testing [|simplify r|]) . was $ \r' ->
|
|
$(testing [|simplify s|]) . was $ \s' ->
|
|
counterexample " Should be the same" (identical r' s')
|
|
|
|
ex10_add_zero = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
|
|
forAllBlind genSimpl $ \r ->
|
|
forAll_ $ \(Positive q) ->
|
|
$(testing [|r + (RationalNumber 0 q)|]) (exactly r)
|
|
|
|
ex10_add_commut = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
|
|
forAll_ $ \r ->
|
|
forAll_ $ \s ->
|
|
$(testing [|r + s|]) . was $ \was1 ->
|
|
$(testing [|s + r|]) . was $ \was2 ->
|
|
counterexample " Should be the same" (identical was1 was2)
|
|
|
|
ex10_add_whole = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
|
|
forAll_ $ \(Positive q) ->
|
|
forAll_ $ \(i,j) ->
|
|
$(testing [|RationalNumber (q*i) q + RationalNumber (q*j) q|]) (exactly (RationalNumber (i Prelude.+ j) 1))
|
|
|
|
ex10_add = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
|
|
forAll_ $ \(Positive n) ->
|
|
$(testing [|RationalNumber 1 (n Prelude.+ 1) + RationalNumber 1 (n*(n Prelude.+ 1))|]) (exactly (RationalNumber 1 n))
|
|
|
|
ex10_multiply_one = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
|
|
forAllBlind genSimpl $ \r ->
|
|
forAll_ $ \(Positive q) ->
|
|
$(testing [|r * (RationalNumber q q)|]) (exactly r)
|
|
|
|
ex10_multiply_commut = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
|
|
forAll_ $ \r ->
|
|
forAll_ $ \s ->
|
|
$(testing [|r * s|]) . was $ \was1 ->
|
|
$(testing [|s * r|]) . was $ \was2 ->
|
|
counterexample " Should be the same" (identical was1 was2)
|
|
|
|
ex10_multiply_inverse = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
|
|
forAllBlind genPrime $ \p ->
|
|
forAllBlind genPrime $ \q ->
|
|
$(testing [|RationalNumber p q * RationalNumber q p|]) (exactly (RationalNumber 1 1))
|
|
|
|
ex10_multiply = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
|
|
forAllBlind genPrime $ \p ->
|
|
forAllBlind genPrime $ \q ->
|
|
forAllBlind genPrime $ \r ->
|
|
nub [p,q,r] == [p,q,r] ==>
|
|
forAll_ $ \(Positive i) ->
|
|
$(testing [|RationalNumber (i Prelude.* p) q * RationalNumber q (r Prelude.* i)|]) (exactly (RationalNumber p r))
|
|
|
|
ex10_abs = $(withInstance "Num" "RationalNumber" [|abs :: RationalNumber -> RationalNumber|]) $ \abs ->
|
|
forAllBlind genSimpl $ \r@(RationalNumber p q) ->
|
|
conjoin [$(testing [|abs (RationalNumber (-p) q)|]) (exactly r)
|
|
,$(testing [|abs r|]) (exactly r)]
|
|
|
|
ex10_signum_abs = $(withInstance "Num" "RationalNumber" [|abs :: RationalNumber -> RationalNumber|]) $ \abs ->
|
|
forAll_ $ \r ->
|
|
counterexample "signum r * abs r == r" $
|
|
counterexample (" failed with r = " ++ show r) $
|
|
signum r * abs r == r
|
|
|
|
ex10_fromInteger = $(withInstance "Num" "RationalNumber" [|fromInteger :: Integer -> RationalNumber|]) $ \fromInteger ->
|
|
forAll_ $ \(i,j) ->
|
|
counterexample ("fromIntegral "++show i++" + fromIntegral "++show j) $
|
|
exactly (RationalNumber (i+j) 1) (fromIntegral i + fromIntegral j)
|
|
|
|
ex10_negate = $(withInstance "Num" "RationalNumber" [|negate :: RationalNumber -> RationalNumber|]) $ \negate ->
|
|
forAll_ $ \r ->
|
|
counterexample ("("++show r++") + negate ("++show r++")") $
|
|
exactly (RationalNumber 0 1) (r + negate r)
|
|
|
|
ex11_integer = $(withInstance "Addable" "Integer" [|(zero::Integer,add::Integer->Integer->Integer)|]) $ \(zero,add) ->
|
|
forAll_ $ \(x::Integer,y) ->
|
|
conjoin [$(testing [|add x y|]) (?==x+y)
|
|
,$(testing [|add zero x|]) (?==x)]
|
|
|
|
ex11_list = $(withInstance1 "Addable" "[]" [|(zero::[Bool],add::[Bool]->[Bool]->[Bool])|]) $ \(zero,add) ->
|
|
forAll_ $ \(x::[Bool],y) ->
|
|
conjoin [$(testing [|add x y|]) (?==x++y)
|
|
,$(testing [|add zero x|]) (?==x)
|
|
,$(testing [|add x zero|]) (?==x)]
|
|
|
|
ex12_step_color = $(withInstance "Cycle" "Color" [|step|]) $ \step ->
|
|
conjoin [$(testing [|step Red|]) (?==Green)
|
|
,$(testing [|step Green|]) (?==Blue)
|
|
,$(testing [|step Blue|]) (?==Red)]
|
|
|
|
ex12_step_suit = $(withInstance "Cycle" "Suit" [|step|]) $ \step ->
|
|
conjoin [$(testing [|step Club|]) (?==Spade)
|
|
,$(testing [|step Spade|]) (?==Diamond)
|
|
,$(testing [|step Diamond|]) (?==Heart)
|
|
,$(testing [|step Heart|]) (?==Club)]
|
|
|
|
ex12_stepMany_color = $(withInstance "Cycle" "Color" [|stepMany|]) $ \stepMany ->
|
|
property $ do
|
|
let vals = [Red,Green,Blue]
|
|
i <- choose (0,2)
|
|
j <- choose (0,20)
|
|
return $ $(testing [|stepMany j (vals!!i)|]) (?==vals!!(mod (i+j) 3))
|
|
|
|
ex12_stepMany_suit = $(withInstance "Cycle" "Suit" [|stepMany|]) $ \stepMany ->
|
|
property $ do
|
|
let vals = [Club,Spade,Diamond,Heart]
|
|
i <- choose (0,3)
|
|
j <- choose (0,20)
|
|
return $ $(testing [|stepMany j (vals!!i)|]) (?==vals!!(mod (i+j) 4))
|
|
|
|
ex12_stepMany_class = $(classContains "Cycle" "stepMany")
|
|
|
|
$(defineInstance "Cycle" ''Int "step" [|succ|])
|
|
|
|
$(return []) -- hack to make next test see instance
|
|
|
|
ex12_stepMany_default = counterexample "After defining\n instance Cycle Int where step = succ" $
|
|
$(withInstance "Cycle" "Int" [|stepMany|]) $ \stepMany ->
|
|
forAllBlind (choose (0,100::Int)) $ \n ->
|
|
forAllBlind (choose (0,100::Int)) $ \m ->
|
|
$(testing [|stepMany n m|]) (?==n+m)
|
|
|
|
-- -- -- -- -- -- -- -- tests need to be defined after TH splice above
|
|
|
|
main = score tests
|
|
|
|
tests = [(1,"Eq Country",[ex1])
|
|
,(2,"Ord Country",[ex2])
|
|
,(3,"Eq Name",[ex3])
|
|
,(4,"Eq List",[ex4_eq, ex4_neq])
|
|
,(5,"Price",[ex5_egg, ex5_milk])
|
|
,(6,"Price List",[ex6_egg, ex6_milk])
|
|
,(7,"Ord Number",[ ex7_eq_check
|
|
, ex7_finite_finite, ex7_finite_infinite, ex7_infinite_infinite
|
|
, ex7_max_finite, ex7_max_infinite ])
|
|
,(8,"Eq RationalNumber",[ex8_refl, ex8_eq])
|
|
,(9,"simplify",[ex9_prime, ex9_eq])
|
|
,(10,"Num RationalNumber",[ex10_add_zero, ex10_add_commut, ex10_add_whole, ex10_add
|
|
,ex10_multiply_one, ex10_multiply_commut, ex10_multiply_inverse, ex10_multiply
|
|
,ex10_abs
|
|
,ex10_signum_abs
|
|
,ex10_fromInteger
|
|
,ex10_negate
|
|
])
|
|
,(11,"Addable",[ex11_integer, ex11_list])
|
|
,(12,"Cycle",[ex12_step_color, ex12_step_suit, ex12_stepMany_color, ex12_stepMany_suit
|
|
,ex12_stepMany_class, ex12_stepMany_default])
|
|
]
|