Monadic Test Frameworks with Grading

IdealSolution.hs

import Control.Monad.Trans.Writer
 
type Rubric = [Bool] -> Int
data TestSeries = Test String (IO Bool) | Block String [TestSeries] Rubric
 
type Spec a = Writer [TestSeries] a
 
shouldBe :: Eq a => a -> a -> IO Bool
shouldBe x y = return (x == y)
 
check :: String -> IO Bool -> Spec ()
check lbl tst = tell $ [Test lbl tst]
 
grade :: String -> Spec a -> Rubric -> Spec a
grade lbl spec rubric = censor (\tests -> [Block lbl tests rubric]) spec
 
testList :: Spec ()
testList = do
  grade "Full Project" $ do
    c <- check "c" $ (2+4) `shouldBe` 10
    d <- check "d" $ (2^4) `shouldBe` 16
    rubric $ if pass c
                then if pass d
                          then 5
                          else 2
                else 0

SimpleIO.hs

pass = snd
 
check :: String -> IO Result -> IO (String, Bool)
check s mb = mb >>= (\b -> return (s,b))
 
shouldBe :: Eq a => a -> a -> IO Bool
shouldBe x y = return (x == y)
 
alpha :: IO (String, Bool, Int)
alpha =
  do a <- check "a" $ 2 `shouldBe` 3
     b <- check "b" $ 5 `shouldBe` 7)
     c <- check "c" $ 10 `shouldBe` 20
     let success = pass a
         grade = if pass a
                    then if pass b && pass c
                           then 7
                           else 2
                  else 0
     return ("alpha",success,grade)

WriterMonad.hs

import Control.Monad.Trans.Writer
 
type Rubric = [Bool] -> Int
data TestSeries = Test String (IO Bool) | Block String [TestSeries] Rubric
 
type Spec a = Writer [TestSeries] a
 
shouldBe :: Eq a => a -> a -> IO Bool
shouldBe x y = return (x == y)
 
check :: String -> IO Bool -> Spec ()
check lbl tst = tell $ [Test lbl tst]
 
grade :: String -> Spec a -> Rubric -> Spec a
grade lbl spec rubric = censor (\tests -> [Block lbl tests rubric]) spec
 
testList :: Spec ()
testList = do
  grade "Full Project" ( do
    check "c" $ (2+4) `shouldBe` 10
    check "d" $ (2^4) `shouldBe` 16
    ) (\[c,d] -> if c
                  then if d
                          then 5
                          else 2
                else 0)