Set16bTest.hs

{-# 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