mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
280 lines
12 KiB
Haskell
280 lines
12 KiB
Haskell
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, StandaloneDeriving, DeriveGeneric #-}
|
|
|
|
module Set7Test where
|
|
|
|
import Data.List
|
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
|
import GHC.Generics (Generic)
|
|
import Generic.Random
|
|
import Test.QuickCheck
|
|
|
|
import Mooc.Th
|
|
import Mooc.Test
|
|
|
|
import Set7 hiding (bake)
|
|
|
|
main = score tests
|
|
|
|
tests = [(1,"travel",[ex1_travel, ex1_velocity])
|
|
,(2,"Set",[ex2_member, ex2_add, ex2_empty_add])
|
|
,(3,"bake",[ex3_ok, ex3_finished, ex3_error, ex3_type])
|
|
,(4,"average NonEmpty",[ex4])
|
|
,(5,"reverseNonEmpty",[ex5_one, ex5_many])
|
|
,(6,"Semigroup x3",[ex6_Distance, ex6_Time, ex6_Velocity])
|
|
,(7,"Monoid Set",[ex7_combine, ex7_mempty])
|
|
,(8,"Operation1&2",[ex8_multiply1, ex8_multiply2, ex8_show1, ex8_show1_multiply1, ex8_show2, ex8_show2_multiply2])
|
|
,(9,"PasswordRequirement",[ex9_basics, ex9_either_both, ex9_large])
|
|
,(10,"Arithmetic",[ex10_examples, ex10_large])
|
|
]
|
|
|
|
--
|
|
|
|
ex1_velocity = forAll_ $ \d ->
|
|
forAll_ $ \(Positive t) ->
|
|
$(testing [|velocity (Distance d) (Time t)|]) (?==Velocity (d/t))
|
|
|
|
ex1_travel = forAll_ $ \(v,t) ->
|
|
$(testing [|travel (Velocity v) (Time t)|]) (?==Distance (v*t))
|
|
|
|
instance (Ord a, Arbitrary a) => Arbitrary (Set a) where
|
|
arbitrary = fmap (Set . nub) orderedList
|
|
|
|
m2_member example = forAll_ $ \(Set xs) ->
|
|
not (null xs) ==>
|
|
forAllBlind (elements (xs`asTypeOf`example)) $ \x ->
|
|
conjoin [$(testing [|member x (Set xs)|]) (?==True)
|
|
,$(testing [|member x (Set (delete x xs))|]) (?==False)]
|
|
|
|
ex2_member = conjoin [m2_member [True,False]
|
|
,m2_member [1::Int,2,3]]
|
|
|
|
m2_add example = forAll_ $ \(Set xs) ->
|
|
not (null xs) ==>
|
|
forAllBlind (elements (xs`asTypeOf`example)) $ \x ->
|
|
conjoin [$(testing [|add x (Set xs)|]) (?==(Set xs))
|
|
,$(testing [|add x (Set (delete x xs))|]) (?==(Set xs))]
|
|
|
|
ex2_add = conjoin [m2_add ["foo","bar"]
|
|
,m2_add [1::Int,2,3]]
|
|
|
|
ex2_empty_add = conjoin
|
|
[forAll_ $ \(i::Integer) -> counterexample ("add "++show i++" emptySet") (add i emptySet ?== Set [i])
|
|
,forAll_ $ \(b::Bool) -> counterexample ("add " ++show b++"(add "++show b++" emptySet)")
|
|
(add b (add b emptySet) ?== Set [b])]
|
|
|
|
deriving instance Generic Event
|
|
instance Arbitrary Event where
|
|
arbitrary = genericArbitrary uniform
|
|
|
|
ex3_good = [[AddEggs,AddFlour,AddSugar,Mix,Bake]
|
|
,[AddEggs,AddSugar,AddFlour,Mix,Bake]]
|
|
|
|
canFinish ev = any (\g -> ev `isPrefixOf` g) ex3_good
|
|
finished ev = any (\g -> g `isPrefixOf` ev) ex3_good
|
|
|
|
bake :: [Event] -> State
|
|
bake events = go Start events
|
|
where go state [] = state
|
|
go state (e:es) = go (step state e) es
|
|
|
|
ex3_ok = forAllBlind (elements ex3_good) $ \events ->
|
|
$(testing [|bake events|]) (?==Finished)
|
|
|
|
ex3_finished = forAll_ $ \(ev::Event) ->
|
|
$(testing [|step Finished ev|]) (?==Finished)
|
|
|
|
genBad = do
|
|
g <- elements ex3_good
|
|
i <- choose (0,length g - 1)
|
|
let pre = take i g
|
|
x <- arbitrary `suchThat` (\x -> not (canFinish (pre++[x]) || finished (pre++[x])))
|
|
y <- arbitrary
|
|
elements [pre++[x], pre++[x,y]]
|
|
|
|
ex3_error = forAllBlind (genBad) $ \events ->
|
|
$(testing [|bake events|]) (?==Error)
|
|
|
|
ex3_type = $(reifyType "State") $ \(DataType vars cs) ->
|
|
conjoin [counterexample " should have no type parameters" $ vars == []
|
|
,conjoin $ map ok cs]
|
|
where ok (Constructor _ []) = property True
|
|
ok (Constructor n _) = counterexample (" constructor "++show n++" should have no fields") $ property False
|
|
ok (Weird n) = counterexample (" constructor "++show n++" is weird. Make it normal.") $ property False
|
|
|
|
ex4 = conjoin [forAll_ $ \(Small i) -> $(testing [|average ((fromIntegral i :: Float) :| [])|]) (?==fromIntegral i)
|
|
,forAllBlind (choose (1,10)) $ \n -> forAll_ $ \(i::Rational) ->
|
|
$(testing [|average (i:|(replicate n i))|]) (?==i)
|
|
,forAll_ $ \(Small i) -> let f = fromIntegral i in $(testing [|average ((f-1):|[f,f+1])|]) (?==f)
|
|
,forAll_ $ \(Small i,Small j) ->
|
|
let x = fromIntegral i :: Double
|
|
y = fromIntegral j :: Double
|
|
in $(testing [|average (x:|(replicate 9 x ++ replicate 10 y))|]) (?~=(x+y)/2)]
|
|
|
|
ex5_one = forAll_ $ \(x::Bool) -> $(testing [|reverseNonEmpty (x:|[])|]) (?==(x:|[]))
|
|
|
|
ex5_many = forAllBlind (choose (0,10)) $ \(i::Int) ->
|
|
forAllBlind (choose (2,10)) $ \(n::Int) ->
|
|
$(testing [|reverseNonEmpty (i:|[i+1..i+n])|]) (?==((i+n):|[i+n-1,i+n-2..i]))
|
|
|
|
ex6_Distance = $(withInstance "Semigroup" "Distance" [|(<>)|]) $ \(<>) ->
|
|
forAll_ $ \(x,y) ->
|
|
$(testing [|(Distance x) <> (Distance y)|]) (?==Distance (x+y))
|
|
|
|
ex6_Time = $(withInstance "Semigroup" "Time" [|(<>)|]) $ \(<>) ->
|
|
forAll_ $ \(x,y) ->
|
|
$(testing [|(Time x) <> (Time y)|]) (?==Time (x+y))
|
|
|
|
ex6_Velocity = $(withInstance "Semigroup" "Velocity" [|(<>)|]) $ \(<>) ->
|
|
forAll_ $ \(x,y) ->
|
|
$(testing [|(Velocity x) <> (Velocity y)|]) (?==Velocity (x+y))
|
|
|
|
split [] = return ([],[])
|
|
split (x:xs) = do
|
|
(as,bs) <- split xs
|
|
oneof [return (x:as,bs)
|
|
,return (as,x:bs)
|
|
,return (x:as,x:bs)]
|
|
|
|
ex7_combine = $(withInstance1 "Monoid" "Set" [|(<>)|]) $ \(<>) ->
|
|
forAll_ $ \(Set (xs :: [Integer])) ->
|
|
forAllBlind (split xs) $ \(as,bs) ->
|
|
$(testing [|(Set as) <> (Set bs)|]) (?==(Set xs))
|
|
|
|
ex7_mempty = $(withInstance1 "Monoid" "Set" [|((<>),mempty)|]) $ \((<>),mempty) ->
|
|
forAll_ $ \(Set (xs :: [Char])) ->
|
|
conjoin [counterexample (show (Set xs) ++ " <> mempty") ((Set xs <> mempty) ?== Set xs)
|
|
,counterexample ("mempty <> " ++ show (Set xs)) ((mempty <> Set xs) ?== Set xs)]
|
|
|
|
smallInt = choose (0,100::Int)
|
|
|
|
ex8_multiply1 = $(withConstructor "Operation1" "Multiply1" ["Int","Int"]) $ \mul1 ->
|
|
forAllBlind smallInt $ \i ->
|
|
forAllBlind smallInt $ \j ->
|
|
$(testing [|compute1 (mul1 i j)|]) (?==(i*j))
|
|
|
|
{-
|
|
ex8_multiply1 = $(reifyType "Operation1") $ \(DataType vars cs) ->
|
|
case filter ok cs of
|
|
[Constructor _ ts] -> counterexample " constructor Multiply1 should have type Int -> Int -> Operation1" $
|
|
property $ ts == [SimpleType "Int", SimpleType "Int"]
|
|
[_] -> counterexample (" constructor Multiply1 is weid. Make it normal.") $ property False
|
|
_ -> counterexample (" should have a constructor named Multiply1") $ property False
|
|
where ok (Constructor "Multiply1" _) = True
|
|
ok (Weird "Multiply1") = True
|
|
ok _ = False
|
|
-}
|
|
|
|
ex8_multiply2 =
|
|
$(withInstance "Operation2" "Multiply2" [|compute2|]) $ \compute2 ->
|
|
$(withDefined "Multiply2") $ \mul2 ->
|
|
forAllBlind smallInt $ \i ->
|
|
forAllBlind smallInt $ \j ->
|
|
-- no Show instance available...
|
|
counterexample ("compute2 (Multiply2 " ++ show i ++ " " ++ show j ++ ")") $
|
|
compute2 (mul2 i j) ?== (i*j)
|
|
|
|
ex8_show1 =
|
|
$(hasType "show1" [t|Operation1 -> String|]) $ \show1 ->
|
|
forAllBlind smallInt $ \i ->
|
|
forAllBlind smallInt $ \j ->
|
|
conjoin [$(testing [|show1 (Add1 i j)|]) (?==show i++"+"++show j)
|
|
,$(testing [|show1 (Subtract1 i j)|]) (?==show i++"-"++show j)]
|
|
|
|
ex8_show1_multiply1 =
|
|
$(withConstructor "Operation1" "Multiply1" ["Int","Int"]) $ \mul1 ->
|
|
$(hasType "show1" [t|Operation1 -> String|]) $ \show1 ->
|
|
forAllBlind smallInt $ \i ->
|
|
forAllBlind smallInt $ \j ->
|
|
counterexample ("show1 (Multiply1 " ++ show i ++ " " ++ show j ++ ")") $
|
|
show1 (mul1 i j) ?== show i++"*"++show j
|
|
|
|
ex8_show2 =
|
|
conjoin [$(withDefined "show2") $ \show2 ->
|
|
forAllBlind smallInt $ \i ->
|
|
forAllBlind smallInt $ \j ->
|
|
$(testing [|show2 (Add2 i j)|]) (?==show i++"+"++show j)
|
|
,$(withDefined "show2") $ \show2 ->
|
|
forAllBlind smallInt $ \i ->
|
|
forAllBlind smallInt $ \j ->
|
|
$(testing [|show2 (Subtract2 i j)|]) (?==show i++"-"++show j)]
|
|
|
|
ex8_show2_multiply2 =
|
|
$(withDefined "show2") $ \show2 ->
|
|
$(withDefined "Multiply2") $ \mul2 ->
|
|
forAllBlind (choose (0,100::Int)) $ \i ->
|
|
forAllBlind (choose (0,100::Int)) $ \j ->
|
|
$(testing [|show2 (Add2 i j)|]) (?==show i++"+"++show j)
|
|
|
|
ex9_basics =
|
|
conjoin [$(testing [|passwordAllowed "short" (MinimumLength 8)|]) (?==False)
|
|
,$(testing [|passwordAllowed "veryLongPassword" (MinimumLength 8)|]) (?==True)
|
|
,$(testing [|passwordAllowed "password" (ContainsSome "0123456789")|]) (?==False)
|
|
,$(testing [|passwordAllowed "p4ssword" (ContainsSome "0123456789")|]) (?==True)
|
|
,$(testing [|passwordAllowed "password" (DoesNotContain "0123456789")|]) (?==True)
|
|
,$(testing [|passwordAllowed "p4ssword" (DoesNotContain "0123456789")|]) (?==False)
|
|
]
|
|
|
|
ex9_either_both = property $ do
|
|
~limits@[a,b,c,d] <- vectorOf 4 (choose (3,12))
|
|
password <- vectorOf 24 (choose ('a','z'))
|
|
let or = Or (Or (MinimumLength a) (MinimumLength b)) (Or (MinimumLength c) (MinimumLength d))
|
|
and = And (And (MinimumLength a) (MinimumLength b)) (And (MinimumLength c) (MinimumLength d))
|
|
low = minimum limits
|
|
hi = maximum limits
|
|
return $
|
|
(low < hi) ==> do med <- choose (low,hi-1)
|
|
return $
|
|
conjoin [$(testing [|passwordAllowed (take (low-1) password) or|]) (?==False)
|
|
,$(testing [|passwordAllowed (take (low-1) password) and|]) (?==False)
|
|
,$(testing [|passwordAllowed (take med password) or|]) (?==True)
|
|
,$(testing [|passwordAllowed (take med password) and|]) (?==False)
|
|
,$(testing [|passwordAllowed (take hi password) or|]) (?==True)
|
|
,$(testing [|passwordAllowed (take hi password) and|]) (?==True)]
|
|
|
|
tree leaf node [] = MinimumLength 0
|
|
tree leaf node cs
|
|
| length cs <= 2 = leaf cs
|
|
tree leaf node cs = node (tree leaf node lefts) (tree leaf node rights)
|
|
where (lefts,rights) = splitAt (length cs `div` 2) cs
|
|
|
|
special = elements "0123456789!#%&/()="
|
|
|
|
ex9_large = forAllBlind (listOf special) $ \forbidden ->
|
|
forAllBlind (listOf special) $ \required' ->
|
|
forAllShrink_ (listOf (choose ('a','z'))) $ \base ->
|
|
let required = filter (not . flip elem forbidden) required'
|
|
rules = And (tree ContainsSome Or required) (tree DoesNotContain And forbidden)
|
|
in not (null required) ==>
|
|
not (null forbidden) ==>
|
|
forAllBlind (elements required) $ \req ->
|
|
forAllBlind (elements forbidden) $ \forb ->
|
|
conjoin [$(testing [|passwordAllowed base rules|]) (?==False)
|
|
,forAllBlind (shuffle (req:base)) $ \pw ->
|
|
$(testing [|passwordAllowed pw rules|]) (?==True)
|
|
,forAllBlind (shuffle (forb:req:base)) $ \pw ->
|
|
$(testing [|passwordAllowed pw rules|]) (?==False)]
|
|
|
|
ex10_examples = conjoin [$(testing [|evaluate (literal 3)|]) (?==3)
|
|
,$(testing [|render (literal 3)|]) (?=="3")
|
|
,$(testing [|evaluate (operation "+" (literal 3) (literal 4))|]) (?==7)
|
|
,$(testing [|render (operation "+" (literal 3) (literal 4))|]) (?=="(3+4)")
|
|
,$(testing [|evaluate (operation "*" (literal 3) (operation "+" (literal 1) (literal 1)))|]) (?==6)
|
|
,$(testing [|render (operation "*" (literal 3) (operation "+" (literal 1) (literal 1)))|]) (?=="(3*(1+1))")]
|
|
|
|
gen_arithmetic :: Integer -> Gen (Integer,Arithmetic,String,String)
|
|
gen_arithmetic 0 = do
|
|
i <- choose (0,10)
|
|
return (i,literal i,show i,"(literal "++show i++")")
|
|
gen_arithmetic i = do
|
|
(lval,lexp,lshow,lcode) <- gen_arithmetic (i-1)
|
|
(rval,rexp,rshow,rcode) <- gen_arithmetic (i-1)
|
|
elements [(lval+rval,operation "+" lexp rexp,"("++lshow++"+"++rshow++")","(operation \"+\" "++lcode++" "++rcode++")")
|
|
,(lval*rval,operation "*" lexp rexp,"("++lshow++"*"++rshow++")","(operation \"*\" "++lcode++" "++rcode++")")]
|
|
|
|
m_ex10 level = forAllShrink_ (choose (1,level)) $ \l ->
|
|
forAllBlind (gen_arithmetic level) $ \(val,exp,show,code) ->
|
|
conjoin [counterexample ("evaluate "++code) $ evaluate exp ?== val
|
|
,counterexample ("render "++code) $ render exp ?== show]
|
|
|
|
ex10_large = conjoin [m_ex10 level | level <- [1..5]]
|