Koan spikes

AboutAsserts.hs

module HaskellKoans.AboutAsserts where

import HaskellKoans.KoanBase

aboutAsserts = 
    Koans "HaskellKoans.AboutAsserts"
        [ koanAboutQuestion
        , koanAboutBool
        , koanAboutEquality
        ]

koanAboutQuestion = Koan "about (???)" $
    assertBool 
        "Open AboutAsserts.hs and find 'koanAboutQuestion'. Replace (???) with True to pass" 
        (???)

koanAboutBool = Koan "assertBool" $
    assertBool "False should be True to pass" False

koanAboutEquality = Koan "assertEqual" $
    assertEqual "What does this sum equal? Replace (???) with the answer"
        (1+1)
        (???)

KoanBase.hs

{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
module HaskellKoans.KoanBase
(
    (???),
    Koans(..),
    Koan(..),
    KoanResult,
    assertBool,
    assertEqual
) where

import Control.Exception as E

(???) :: a
(???) = undefined

type KoanSetName = String
data Koans = Koans KoanSetName [Koan]
data Koan = Koan String KoanAssert
type KoanAssert = IO KoanResult
data KoanResult = Pass String | Fail String deriving Show

assertBool :: String -> Bool -> KoanAssert
assertBool msg = assertEqual msg True

assertEqual :: (Eq a, Show a) => String -> a -> a -> KoanAssert
assertEqual msg expected actual =
    do 
        result <- tryJust errorCalls (actual `seq` return $ check (actual == expected)) 
        case result of
            Left _ -> return . Fail $ format (show expected) "(???)"
            Right v -> return v
    where check True = Pass $ "Answer: " ++ show expected
          check False = Fail $ format (show expected) (show actual)
          format expectedStr actualStr = "Expected: " ++ expectedStr ++ "\nActual: " ++ actualStr
          errorCalls (_ :: ErrorCall) = Just ()

runKoan :: Koan -> IO (String, KoanResult)
runKoan (Koan name assert) = fmap (name,) assert