mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
261 lines
12 KiB
Haskell
261 lines
12 KiB
Haskell
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, StandaloneDeriving, FlexibleInstances #-}
|
|
|
|
module Set15Test where
|
|
|
|
import Mooc.Test
|
|
import Mooc.Th
|
|
import Examples.Validation
|
|
|
|
import Control.Applicative
|
|
|
|
import Test.QuickCheck hiding (Result,Fun,Failure)
|
|
|
|
import Set15
|
|
|
|
main = score tests
|
|
|
|
tests = [(1,"sumTwoMaybes",[ex1])
|
|
,(2,"statements",[ex2_1, ex2_2])
|
|
,(3,"calculator",[ex3_success, ex3_failure_1, ex3_failure_2])
|
|
,(4,"validateDiv",[ex4])
|
|
,(5,"validateAddress",[ex5_ok, ex5_fail])
|
|
,(6,"twoPersons",[ex6_maybe,ex6_list])
|
|
,(7,"boolOrInt",[ex7_ok, ex7_fail])
|
|
,(8,"normalizePhone",[ex8])
|
|
,(9,"parseExpression",[ex9_ok, ex9_fail])
|
|
,(10,"Priced",[ex10_fmap, ex10_liftA2])
|
|
,(11,"<*> via liftA2",[ex11])
|
|
,(12,"fmap via liftA2",[ex12])
|
|
,(13,"tryAll",[ex13_maybe, ex13_list, ex13_validation])
|
|
,(14,"Functor Both",[ex14_ok, ex14_fail])
|
|
,(15,"Applicative Both",[ex15_pure, ex15_liftA2, ex15_liftA2_2])
|
|
]
|
|
|
|
-- -- -- -- --
|
|
|
|
ex1 = forAll_ $ \i ->
|
|
forAll_ $ \j ->
|
|
conjoin [$(testing [|sumTwoMaybes (Just i) (Just j)|]) (?==Just (i+j))
|
|
,$(testing [|sumTwoMaybes (Just i) n|]) (?==Nothing)
|
|
,$(testing [|sumTwoMaybes n (Just j)|]) (?==Nothing)
|
|
,$(testing [|sumTwoMaybes n n|]) (?==Nothing)]
|
|
where n = Nothing :: Maybe Int
|
|
|
|
ex2_1 = conjoin
|
|
[$(testing [|statements ["x"] ["y"]|]) (hasElements ["x is y","x is not y"])
|
|
,$(testing [|statements ["x"] ["y","w"]|]) (hasElements ["x is y","x is w","x is not y","x is not w"])
|
|
,$(testing [|statements ["x","z"] ["y","w"]|]) (hasElements ["x is y","x is w","x is not y","x is not w"
|
|
,"z is y","z is w","z is not y","z is not w"])
|
|
,$(testing [|statements ([]::[String]) ["y","w"]|]) (?== [])]
|
|
|
|
word = listOf1 (choose ('a','z'))
|
|
|
|
ex2_2 = forAllBlind (resize 8 $ listOf1 word) $ \xs ->
|
|
forAllBlind (resize 8 $ listOf1 word) $ \ys ->
|
|
forAllBlind (elements xs) $ \x ->
|
|
forAllBlind (elements ys) $ \y ->
|
|
forAllBlind (elements [" is "," is not "]) $ \i ->
|
|
let exp = x ++ i ++ y
|
|
in $(testing [|statements xs ys|]) . was $ \out ->
|
|
counterexample (" Should contain "++show exp) $
|
|
elem exp out
|
|
|
|
ex3_success = forAllBlind (choose (-100,100)) $ \i ->
|
|
let s = show i
|
|
in conjoin [$(testing [|calculator "negate" s|]) (?==Just (negate i))
|
|
,$(testing [|calculator "double" s|]) (?==Just (2*i))]
|
|
|
|
ex3_failure_1 = forAllBlind word $ \w ->
|
|
forAllBlind (choose (-100,100::Int)) $ \i ->
|
|
not (elem w ["negate","double"]) ==> $(testing [|calculator w (show i)|]) (?==Nothing)
|
|
|
|
ex3_failure_2 = forAll (elements ["negate","double","xyzzy"]) $ \w ->
|
|
forAllBlind (choose (-100,100::Int)) $ \i ->
|
|
let s = show i
|
|
in conjoin [$(testing [|calculator w ""|]) (?==Nothing)
|
|
,$(testing [|calculator w (s++".3")|]) (?==Nothing)
|
|
,forAllBlind (shuffle (s++"z")) $ \s' -> $(testing [|calculator w s'|]) (?==Nothing)]
|
|
|
|
ok :: a -> Validation a
|
|
ok = pure
|
|
|
|
invalids :: [String] -> Validation a
|
|
invalids = foldr1 (<|>) . map invalid
|
|
|
|
ex4 = forAllBlind (choose (0,100)) $ \i ->
|
|
forAllBlind (choose (1,10)) $ \j ->
|
|
conjoin [$(testing [|validateDiv i j|]) (?==ok (div i j))
|
|
,$(testing [|validateDiv i 0|]) (?==invalid "Division by zero!")]
|
|
|
|
postCode = vectorOf 5 (choose ('0','9'))
|
|
street = listOf1 (elements (' ':['a'..'z'])) `suchThat` ((<=20).length)
|
|
|
|
ex5_ok = forAllBlind postCode $ \p ->
|
|
forAllBlind street $ \s ->
|
|
forAllBlind (fmap show (choose (1,1000::Int))) $ \n ->
|
|
$(testing [|validateAddress s n p|]) (?==ok (Address s n p))
|
|
|
|
ex5_fail = forAllBlind postCode $ \p ->
|
|
forAllBlind street $ \s ->
|
|
forAllBlind (fmap show (choose (1,1000::Int))) $ \n ->
|
|
forAllBlind (choose ('a','z')) $ \chaff ->
|
|
forAllBlind (vectorOf 20 (choose ('a','z'))) $ \pad ->
|
|
forAllBlind (shuffle (chaff:take 4 p)) $ \p' ->
|
|
forAllBlind (shuffle (chaff:n)) $ \n' ->
|
|
conjoin [$(testing [|validateAddress (s++pad) n p|]) (?==invalid "Invalid street name")
|
|
,$(testing [|validateAddress s n (take 4 p)|]) (?==invalid "Invalid postcode")
|
|
,$(testing [|validateAddress s n p'|]) (?==invalid "Invalid postcode")
|
|
,$(testing [|validateAddress s n' p|]) (?==invalid "Invalid street number")
|
|
,$(testing [|validateAddress (s++pad) n p'|]) (?==invalids ["Invalid street name", "Invalid postcode"])
|
|
,$(testing [|validateAddress (s++pad) n' (take 4 p)|]) (?==invalids ["Invalid street name", "Invalid street number","Invalid postcode"])]
|
|
|
|
ex6_maybe = forAllBlind word $ \name1 ->
|
|
forAllBlind word $ \name2 ->
|
|
forAllBlind (choose (10,100)) $ \age1 ->
|
|
forAllBlind (choose (10,100)) $ \age2 ->
|
|
forAll_ $ \(emp1,emp2) ->
|
|
conjoin [$(testing [|twoPersons (Just name1) (Just age1) (Just emp1) (Just name2) (Just age2) (Just emp2)|])
|
|
(?==Just [Person name1 age1 emp1, Person name2 age2 emp2])
|
|
,$(testing [|twoPersons (Just name1) (Nothing::Maybe Int) (Just emp1) (Just name2) (Just age2) (Just emp2)|])
|
|
(?==Nothing)
|
|
,$(testing [|twoPersons (Just name1) (Just age1) (Just emp1) (Just name2) (Just age2) (Nothing::Maybe Bool)|])
|
|
(?==Nothing)]
|
|
|
|
ex6_list = forAllBlind word $ \name1 ->
|
|
forAllBlind word $ \name2 ->
|
|
forAllBlind word $ \name3 ->
|
|
forAllBlind (choose (10,100)) $ \age1 ->
|
|
forAllBlind (choose (10,100)) $ \age2 ->
|
|
forAllBlind (choose (10,100)) $ \age3 ->
|
|
forAll_ $ \(emp1,emp2) ->
|
|
conjoin [$(testing [|twoPersons [name1] [age1] [emp1] [name2] [age2] [emp2]|])
|
|
(?==[[Person name1 age1 emp1, Person name2 age2 emp2]])
|
|
,$(testing [|twoPersons [name1,name3] [age1] [emp1] [name2] [age2] [emp2]|])
|
|
(?==[[Person name1 age1 emp1, Person name2 age2 emp2]
|
|
,[Person name3 age1 emp1, Person name2 age2 emp2]])
|
|
,$(testing [|twoPersons [name1] [age1] [emp1] [name2] [age2,age3] [emp2]|])
|
|
(?==[[Person name1 age1 emp1, Person name2 age2 emp2]
|
|
,[Person name1 age1 emp1, Person name2 age3 emp2]])]
|
|
|
|
ex7_ok = forAll_ $ \(i::Int) ->
|
|
forAll_ $ \(b::Bool) ->
|
|
conjoin [$(testing [|boolOrInt (show i)|]) (?==ok (Right i))
|
|
,$(testing [|boolOrInt (show b)|]) (?==ok (Left b))]
|
|
|
|
sow :: [a] -> [a] -> Gen [a]
|
|
sow xs [] = return xs
|
|
sow [] ys = return ys
|
|
sow (x:xs) (y:ys) = oneof [fmap (x:) $ sow xs (y:ys)
|
|
,fmap (y:) $ sow (x:xs) ys]
|
|
|
|
ex7_fail = forAll_ $ \(i::Int) ->
|
|
forAllBlind (choose ('a','n')) $ \c -> -- don't generate 0o or 0x by accident
|
|
forAllBlind (shuffle (c:show i)) $ \ni ->
|
|
forAll_ $ \(b::Bool) ->
|
|
forAllBlind (sow [c] (show b)) $ \nb ->
|
|
conjoin [$(testing [|boolOrInt ni|]) (?==invalids ["Not a Bool","Not an Int"])
|
|
,$(testing [|boolOrInt nb|]) (?==invalids ["Not a Bool","Not an Int"])]
|
|
|
|
digit = choose ('0','9')
|
|
|
|
ex8 = forAllBlind (take 10 <$> listOf1 digit) $ \out ->
|
|
forAllBlind (listOf1 (return ' ')) $ \spaces ->
|
|
forAllBlind word $ \chaff ->
|
|
forAllBlind (sow out spaces) $ \inp ->
|
|
forAllBlind (sow inp chaff) $ \wrong ->
|
|
conjoin [$(testing [|normalizePhone inp|]) (?==ok out)
|
|
,$(testing [|normalizePhone (inp++"9999999999")|]) (?==invalid "Too long")
|
|
,$(testing [|normalizePhone wrong|])
|
|
(?==invalids ((if length out + length chaff > 10 then ["Too long"] else [])++["Invalid character: "++[d] | d <- chaff]))]
|
|
|
|
showE (Plus x y) = showA x ++ " + " ++showA y
|
|
showE (Minus x y) = showA x ++ " - " ++showA y
|
|
|
|
showA (Number i) = show i
|
|
showA (Variable v) = [v]
|
|
|
|
genA = oneof [Number <$> choose (0,10)
|
|
,Variable <$> choose ('a','z')]
|
|
|
|
genE = elements [Plus,Minus] <*> genA <*> genA
|
|
|
|
ex9_ok = forAllBlind genE $ \exp ->
|
|
let s = showE exp
|
|
in $(testing [|parseExpression s|]) (?==ok exp)
|
|
|
|
ex9_fail = forAllBlind (showA<$>genA) $ \goodArg ->
|
|
forAllBlind (elements ["1z","1.0","xy","."]) $ \badArg ->
|
|
forAllBlind (elements ["+","-"]) $ \goodOp ->
|
|
forAllBlind (elements ["*","%","x","3"]) $ \badOp ->
|
|
let b x op y = x ++ " " ++ op ++ " " ++ y
|
|
badExp1 = (goodArg ++ " " ++ goodOp)
|
|
badExp2 = b goodArg goodOp goodArg ++ " " ++ goodOp
|
|
in conjoin [$(testing [|parseExpression (b goodArg goodOp badArg)|])
|
|
(?==invalids ["Invalid number: "++badArg, "Invalid variable: "++badArg])
|
|
,$(testing [|parseExpression (b badArg goodOp goodArg)|])
|
|
(?==invalids ["Invalid number: "++badArg, "Invalid variable: "++badArg])
|
|
,$(testing [|parseExpression (b goodArg badOp goodArg)|])
|
|
(?==invalid ("Unknown operator: "++badOp))
|
|
,$(testing [|parseExpression badExp1|])
|
|
(?==invalid ("Invalid expression: "++badExp1))
|
|
,$(testing [|parseExpression badExp2|])
|
|
(?==invalid ("Invalid expression: "++badExp2))
|
|
,$(testing [|parseExpression (b goodArg badOp badArg)|])
|
|
(?==invalids ["Unknown operator: "++badOp,"Invalid number: "++badArg, "Invalid variable: "++badArg])
|
|
,$(testing [|parseExpression (b goodArg badOp badArg)|])
|
|
(?==invalids ["Unknown operator: "++badOp,"Invalid number: "++badArg, "Invalid variable: "++badArg])]
|
|
|
|
ex10_fmap = conjoin [$(testing' [|fmap reverse (Priced 3 "abc")|]) (?==Priced 3 "cba")
|
|
,$(testing' [|fmap negate (Priced 1 7)|]) (?==Priced 1 (-7))]
|
|
|
|
ex10_liftA2 = conjoin [$(testing' [|liftA2 (++) (Priced 3 "abc") (Priced 5 "de")|]) (?==Priced 8 "abcde")
|
|
,$(testing' [|liftA2 (+) (pure 4) (Priced 3 6)|]) (?==Priced 3 10)]
|
|
|
|
deriving instance (Eq (f (g a))) => Eq (Both f g a)
|
|
|
|
ex11 = conjoin [$(testing' [|Just succ <#> Just 2|]) (?==Just 3)
|
|
,$(testing' [|Nothing <#> Just 2|]) (?==(Nothing :: Maybe Int))
|
|
,$(testing' [|Just reverse <#> Nothing|]) (?==(Nothing :: Maybe [Bool]))
|
|
,$(testing' [|[reverse,drop 1] <#> ["foo","bar"]|]) (?==["oof","rab","oo","ar"])]
|
|
|
|
ex12 = conjoin [$(testing' [|myFmap negate (Just 1)|]) (?==Just (-1))
|
|
,$(testing' [|myFmap negate Nothing|]) (?==Nothing)
|
|
,$(testing' [|myFmap negate [1,2]|]) (?==[-1,-2])
|
|
,$(testing' [|myFmap not [True,True,False]|]) (?==[False,False,True])
|
|
,$(testing' [|myFmap not Nothing|]) (?==Nothing)]
|
|
|
|
ex13_maybe = conjoin [$(testing' [|tryAll id [Nothing, Just 1, Just 2]|]) (?==Just 1)
|
|
,$(testing' [|tryAll id [Nothing, Nothing]|]) (?==(Nothing::Maybe Int))
|
|
,$(testing' [|tryAll id [] :: Maybe Int|]) (?==Nothing)]
|
|
|
|
ex13_list = conjoin [$(testing' [|tryAll tail ["abc", "d", "ef"]|]) (?=="bcf")
|
|
,$(testing' [|tryAll tail []|]) (?==([]::String))]
|
|
|
|
tA l xs k = counterexample' ("tryAll (\\x -> if x>" ++ show l ++ " then pure x else invalid \"zero\") "++show xs) $
|
|
k $ tryAll (\x -> if x>l then pure x else invalid "zero") xs
|
|
|
|
ex13_validation = forAllBlind (choose (0::Int,10)) $ \l ->
|
|
forAllBlind (listOf1 (choose (0::Int,10))) $ \xs ->
|
|
tA l xs (?==case filter (>l) xs of [] -> invalids (map (const "zero") xs)
|
|
(x:_) -> ok x)
|
|
|
|
ex14_ok = conjoin [$(testing' [|fmap not (Both (Just [True]))|]) (?== Both (Just [False]))
|
|
,$(testing' [|fmap negate (Both [Just 3, Just 4])|]) (?== Both [Just (-3), Just (-4)])
|
|
,$(testing' [|fmap negate (Both [[1,2,3],[4,5]])|]) (?== Both [[-1,-2,-3],[-4,-5]])]
|
|
|
|
ex14_fail = conjoin [$(testing' [|fmap not (Both [Nothing])|]) (?== Both [Nothing])
|
|
,$(testing' [|fmap not (Both []) :: Both [] Maybe Bool|]) (?== Both [])]
|
|
|
|
ex15_pure = conjoin [$(testing' [|pure 1 :: Both [] Maybe Int|]) (?== Both [Just 1])
|
|
,$(testing' [|pure "a" :: Both Maybe Validation String|]) (?==Both (Just (ok "a")))]
|
|
|
|
ex15_liftA2 = conjoin [$(testing' [|liftA2 (+) (Both (Just [10,100])) (Both (Just [1,2]))|]) (?==Both (Just [11,12,101,102]))
|
|
,$(testing' [|liftA2 (+) (Both (Just [10,100])) (Both Nothing)|]) (?==Both Nothing)]
|
|
|
|
ex15_liftA2_2 = conjoin [$(testing' [|liftA2 (&&) (Both (Just (invalid "err"))) (Both (Just (pure True)))|]) (?==Both (Just (invalid "err")))
|
|
,$(testing' [|liftA2 (&&) (Both (Just (invalid "err"))) (Both (Just (invalid "umm")))|]) (?==Both (Just (invalids ["err","umm"])))
|
|
,$(testing' [|liftA2 (+) (Both [pure 1, invalid "fail 1"]) (Both [pure 10, pure 100, invalid "fail 2"])|])
|
|
(?== Both [ok 11,ok 101,invalid "fail 2",
|
|
invalid "fail 1",invalid "fail 1",
|
|
invalids ["fail 1","fail 2"]])]
|