Created
August 15, 2012 00:57
-
-
Save thiago-negri/3354394 to your computer and use it in GitHub Desktop.
Simple EDSL to test a calculator
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Edsl where | |
-- | |
-- Imports | |
import Control.Monad.Trans.State.Lazy | |
(State, evalState, modify, get) | |
import Data.Char | |
(toLower) | |
-- | |
-- Test definition | |
data TestSequence = | |
Do Action TestSequence | |
| Check Assertion TestSequence | |
| Done | |
deriving (Show) | |
type Test = TestSequence -> TestSequence | |
data Action = | |
Press Button | |
deriving (Show) | |
data Assertion = | |
DisplayHasNumber Int | |
deriving (Show) | |
-- | |
-- Test case transform | |
unroll :: (TestSequence -> a) -> Test -> [a] | |
unroll f t = g (t Done) | |
where g Done = [f Done] | |
g v@(Do _ next) = f v : g next | |
g v@(Check _ next) = f v : g next | |
-- | |
-- Sample test case | |
sample :: Test | |
sample = | |
Do (Press One). | |
Do (Press Plus). | |
Do (Press One). | |
Do (Press Equals). | |
Check (DisplayHasNumber 2). | |
Do (Press Clear). | |
Check (DisplayHasNumber 0). | |
Do (Press Two). | |
Do (Press Zero). | |
Check (DisplayHasNumber 20). | |
Do (Press Divide). | |
Do (Press Two). | |
Check (DisplayHasNumber 2). | |
Do (Press Equals). | |
Check (DisplayHasNumber 10) | |
-- | |
-- Pretty print test case | |
prettyPrint :: Test -> String | |
prettyPrint = unlines . unroll prettyPrintTestSequence | |
prettyPrintTestSequence :: TestSequence -> String | |
prettyPrintTestSequence s = | |
case s of | |
Done -> "end" | |
Do action _ -> prettyPrintAction action | |
Check assertion _ -> prettyPrintAssertion assertion | |
prettyPrintAction :: Action -> String | |
prettyPrintAction (Press button) = | |
"press " ++ prettyPrintButton button | |
prettyPrintButton :: Button -> String | |
prettyPrintButton = map toLower . show | |
prettyPrintAssertion :: Assertion -> String | |
prettyPrintAssertion (DisplayHasNumber number) = | |
"the display should be showing the number " ++ show number | |
-- | |
-- Generate JUnit from test case | |
generateJUnit :: Test -> String | |
generateJUnit = ("@Test\npublic void test() {\n" ++) . | |
unlines . | |
unroll generateJUnitTestSequence | |
generateJUnitTestSequence :: TestSequence -> String | |
generateJUnitTestSequence s = | |
case s of | |
Done -> "}" | |
Do a _ -> generateJUnitAction a | |
Check a _ -> generateJUnitAssertion a | |
generateJUnitAction :: Action -> String | |
generateJUnitAction (Press b) = | |
generateJUnitButton b ++ ".press();" | |
generateJUnitButton :: Button -> String | |
generateJUnitButton b = "getButton" ++ show b ++ "()" | |
generateJUnitAssertion :: Assertion -> String | |
generateJUnitAssertion (DisplayHasNumber n) = | |
"assertEquals(" ++ show n ++ ", getDisplayNumber());" | |
-- | |
-- Real test checking | |
data TestResult = | |
Ok | |
| Failed FailureMessage | |
type Step = String | |
type FailureMessage = String | |
instance Show TestResult where | |
show Ok = "Test passed" | |
show (Failed m) = "Test failed: " ++ m | |
checkTest :: Test -> TestResult | |
checkTest t = | |
evalState | |
(threadCheckState . unroll checkTestSequence $ t) | |
mkCalculator | |
threadCheckState :: [State Calculator TestResult] -> | |
State Calculator TestResult | |
threadCheckState = go 0 | |
where go _ [] = return Ok | |
go n (x:xs) = x >>= (f n xs) | |
f n xs Ok = go (n + 1) xs | |
f n _ (Failed m) = | |
return . Failed $ | |
"Step " ++ show n ++ ". " ++ m | |
checkTestSequence :: TestSequence -> | |
State Calculator TestResult | |
checkTestSequence Done = return Ok | |
checkTestSequence (Do a _) = checkAction a | |
checkTestSequence (Check a _) = checkAssertion a | |
checkAction :: Action -> State Calculator TestResult | |
checkAction (Press b) = do | |
modify $ pressButton b | |
return Ok | |
checkAssertion :: Assertion -> State Calculator TestResult | |
checkAssertion (DisplayHasNumber n) = | |
get >>= \c -> | |
if displayNumber c == n | |
then return Ok | |
else return . Failed $ | |
"Wrong number in display, should be " ++ | |
show n ++ " but was " ++ show (displayNumber c) | |
-- | |
-- Calculator's core | |
data Calculator = Calculator { | |
displayNumber :: Int | |
, operation :: Maybe (Int -> Int -> Int) | |
, savedNumber :: Int | |
} | |
data Button = | |
Zero | |
| One | |
| Two | |
| Three | |
| Four | |
| Five | |
| Six | |
| Seven | |
| Eight | |
| Nine | |
| Plus | |
| Minus | |
| Times | |
| Divide | |
| Equals | |
| Clear | |
deriving (Show) | |
pressButton :: Button -> Calculator -> Calculator | |
pressButton b = | |
case b of | |
Zero -> appendNumber 0 | |
One -> appendNumber 1 | |
Two -> appendNumber 2 | |
Three -> appendNumber 3 | |
Four -> appendNumber 4 | |
Five -> appendNumber 5 | |
Six -> appendNumber 6 | |
Seven -> appendNumber 7 | |
Eight -> appendNumber 8 | |
Nine -> appendNumber 9 | |
Plus -> saveOperation (+) | |
Minus -> saveOperation (-) | |
Times -> saveOperation (*) | |
Divide -> saveOperation div | |
Equals -> performOperation | |
Clear -> clear | |
appendNumber :: Int -> Calculator -> Calculator | |
appendNumber i c = | |
c { | |
displayNumber = (displayNumber c) * 10 + i | |
} | |
saveOperation :: (Int -> Int -> Int) -> Calculator -> Calculator | |
saveOperation f c = | |
c { | |
savedNumber = (displayNumber c) | |
, displayNumber = 0 | |
, operation = Just f | |
} | |
performOperation :: Calculator -> Calculator | |
performOperation c = | |
c { | |
savedNumber = newNumber | |
, displayNumber = newNumber | |
} | |
where newNumber = | |
case (operation c) of | |
Nothing -> displayNumber c | |
Just f -> let a = savedNumber c | |
b = displayNumber c | |
in | |
f a b | |
clear :: Calculator -> Calculator | |
clear = const mkCalculator | |
mkCalculator :: Calculator | |
mkCalculator = | |
Calculator { | |
displayNumber = 0 | |
, operation = Nothing | |
, savedNumber = 0 | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment