mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
126 lines
4.0 KiB
Haskell
126 lines
4.0 KiB
Haskell
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
|
|
|
|
module Set16bTest where
|
|
|
|
import Mooc.Test
|
|
import Mooc.Th
|
|
|
|
import Examples.Phantom
|
|
|
|
import Control.Monad
|
|
import Data.Char
|
|
import Data.List
|
|
import Test.QuickCheck
|
|
import Test.QuickCheck.Monadic hiding (pick)
|
|
|
|
import Set16b
|
|
|
|
ex1_t = $(hasType' "pounds" "Money GBP") (const True)
|
|
|
|
ex1_v = $(testing' [|pounds|]) (?==Money 3.0)
|
|
|
|
niceFloat = (/2) <$> fromIntegral <$> choose (1::Int,10)
|
|
|
|
ex2_v = forAllBlind niceFloat $ \r1 ->
|
|
forAllBlind niceFloat $ \r2 ->
|
|
$(testing [|composeRates (Rate r1) (Rate r2)|]) (?==Rate (r1*r2))
|
|
|
|
eurToChf = composeRates eurToUsd usdToChf
|
|
|
|
composeTest1 x = composeRates usdToChf (composeRates x eurToUsd)
|
|
|
|
bob = toFirst "bob"
|
|
|
|
smith = toLast "smith"
|
|
|
|
capitalBob = capitalize (toFirst "bob")
|
|
|
|
capitalSmith = capitalize (toLast "smith")
|
|
|
|
bobSmith = toFull (toFirst "bob") (toLast "smith")
|
|
|
|
aSmith x = toFull x (toLast "smith")
|
|
|
|
aBob x = toFull (toFirst "bob") x
|
|
|
|
$(return []) -- hack to push above definitions into reify scope
|
|
|
|
ex2_t1 =
|
|
counterexample "eurToChf = composeRates eurToUsd usdToChf" $
|
|
$(hasType' "eurToChf" "Rate EUR CHF") (const True)
|
|
|
|
ex2_t2 =
|
|
counterexample "composeTest1 x = composeRates usdToChf (composeRates x eurToUsd)" $
|
|
$(hasType' "composeTest1" "Rate CHF EUR -> Rate USD USD") (const True)
|
|
|
|
letter = choose ('a','z')
|
|
|
|
word = listOf1 letter
|
|
|
|
assertPhantom (DataType vars cs) =
|
|
conjoin [counterexample " should have no constructors (be a phantom type)" $ null cs
|
|
,counterexample " should have no type parameters" $ null vars]
|
|
|
|
ex3_phantom_First = $(reifyType "First") assertPhantom
|
|
ex3_phantom_Last = $(reifyType "Last") assertPhantom
|
|
ex3_phantom_Full = $(reifyType "Full") assertPhantom
|
|
|
|
ex3_v = forAll word $ \w ->
|
|
conjoin [counterexample ("fromName (toFirst "++show w++")") $
|
|
fromName (toFirst w) ?== w
|
|
,counterexample ("fromName (toLast "++show w++")") $
|
|
fromName (toLast w) ?== w]
|
|
|
|
ex3_t1 =
|
|
counterexample "bob = toFirst \"bob\"" $
|
|
$(hasType' "bob" "Name First") (const True)
|
|
|
|
ex3_t2 =
|
|
counterexample "smith = toLast \"smith\"" $
|
|
$(hasType' "smith" "Name Last") (const True)
|
|
|
|
ex4_v1 = forAllBlind word $ \w ->
|
|
counterexample ("fromName (capitalize (toFirst "++show w++"))") $
|
|
fromName (capitalize (toFirst w)) ?== zipWith id (toUpper:repeat id) w
|
|
|
|
ex4_t1 =
|
|
conjoin [counterexample "capitalBob = capitalize (toFirst \"bob\")" $
|
|
$(hasType' "capitalBob" "Name First") (const True)
|
|
,counterexample "capitalSmith = capitalize (toLast \"smith\")" $
|
|
$(hasType' "capitalSmith" "Name Last") (const True)]
|
|
|
|
ex4_v2 = forAllBlind word $ \f ->
|
|
forAllBlind word $ \l ->
|
|
counterexample ("fromName (toFull (toFirst "++show f++") (toLast "++show l++"))") $
|
|
fromName (toFull (toFirst f) (toLast l)) ?== f ++ " " ++ l
|
|
|
|
ex4_t2 =
|
|
conjoin [counterexample "bobSmith = toFull (toFirst \"bob\") (toLast \"smith\")" $
|
|
$(hasType' "bobSmith" "Name Full") (const True)
|
|
,counterexample "aSmith x = toFull x (toLast \"smith\")" $
|
|
$(hasType' "aSmith" "Name First -> Name Full") (const True)
|
|
,counterexample "aBob x = toFull (toFirst \"bob\") x" $
|
|
$(hasType' "aBob" "Name Last -> Name Full") (const True)]
|
|
|
|
ex5_e = counterexample "render (Money 1.0 :: Money EUR)" $
|
|
$(withInstanceSilent "Render" "EUR" [|render|] " Type error!") $ \render ->
|
|
render (Money 1.0 :: Money EUR) ?=="1.0e"
|
|
|
|
ex5_u = counterexample "render (Money 1.0 :: Money USD)" $
|
|
$(withInstanceSilent "Render" "USD" [|render|] " Type error!") $ \render ->
|
|
render (Money 1.0 :: Money USD) ?=="$1.0"
|
|
|
|
ex5_c = counterexample "render (Money 1.0 :: Money CHF)" $
|
|
$(withInstanceSilent "Render" "CHF" [|render|] " Type error!") $ \render ->
|
|
render (Money 1.0 :: Money CHF) ?=="1.0chf"
|
|
|
|
-- -- -- -- --
|
|
|
|
tests = [(1,"pounds",[ex1_t,ex1_v])
|
|
,(2,"composeRates",[ex2_v, ex2_t1, ex2_t2])
|
|
,(3,"firstlastfull1",[ex3_phantom_First, ex3_phantom_Last, ex3_phantom_Full, ex3_v, ex3_t1, ex3_t2])
|
|
,(4,"firstlastfull2",[ex4_v1, ex4_t1, ex4_v2, ex4_t2])
|
|
,(5,"Render currency",[ex5_e, ex5_u, ex5_c])]
|
|
|
|
main = score tests
|