Thank you all for your contributions so far. Plenty of food for thought.

I though I'd try to put it into practice and have a go at the motivating example I gave: essentially a EDSL for defining simple maths tests.

I've included the beginnings of an attempt at the end. It started promisingly. As long as I stuck to binary operators over integers, everything went smoothly, and adding new question types was a joy.

The first annoyance comes when adding the first unary operation into the set of questions. Then I was forced to duplicate make into make1 and make2: essentially identical functions, differing only in the number of arguments they take. This sort of copy-paste programming really annoys me, but I can live with it in this case, as the duplication will only be in one dimension (operator arity), and concerns only one function.

But it all goes pear shaped as soon as I try to cater for questions dealing with fractions, for example: Now the type system requires me to duplicate all the question-making utilities and give them different names. I tried to mitigate this by using type classes but got walloped by the No Monomorphism Restriction, and so on, and so forth. Wherever I turned, the type system was getting in the way.

Looking at it another way, I have the Question type which can contain a sufficient variety of questions, but providing a set of utilities for conveniently populating the type, without excessive code duplication, is something that I am unable to do with Haskell's type system getting in the way. But I take this to be my shortcoming rather than Haskell's, so I would appreciate advice on how to proceed with this exercise.

Code follows.

Thank you all.





======================================================

import System.IO (hFlush, stdout)

data Result = Correct | Improve String | Huh String | Incorrect String
              deriving Show

data Question = Question { ask    :: String
                         , answer :: String
                         , check  :: String -> Result }

bool2result True  = Correct
bool2result False = Incorrect ""

-- askers

infix2  sym a b = show a ++ " " ++ sym ++ " " ++ show b
prefix1 sym a   = sym ++ " " ++ show a
prefix2 sym a b = sym ++ " " ++ show a ++ " " ++ show b

-- checkers

chk correct given = bool2result $ read given == correct

-- makers

make1 op symbol asker checker a = Question ask (show answer) check where
    ask = asker symbol a
    answer = op a
    check = checker answer

make2 op symbol asker checker a b = Question ask (show answer) check where
    ask = asker symbol a b
    answer = op a b
    check = checker answer

-- question 'types'

addition       = make2 (+) "+" infix2 chk
subtraction    = make2 (-) "-" infix2 chk
multiplication = make2 (*) "x" infix2 chk
power          = make2 (^) "^" infix2 chk

square = (flip power) 2
cube   = (flip power) 3

square'  = make1 (^2) "square" prefix1 chk

questions = [ addition 1 2
            , subtraction 3 2
            , multiplication 4 5
            , square 3
            , cube 3 ]


test :: [Question] -> IO ()
test [] = return ()
test (q:qs) = do
  putStr $ ask q ++ " = "
  hFlush stdout
  reply <- getLine
  putStrLn $ show $ check q reply
  test qs

main = test questions

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to