[Haskell-cafe] Client-extensible heterogeneous types (Duck-typed variadic functions?)

[Jacek Generowicz]

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