[Haskell-beginners] data design for a questionnaire (retitled + update)

[Alia]

Hi folks,

As a follow-on question from my prior post, I got stuck on not being able to compile the following
code in my survey data model which basically generally unwraps the the inner type from the 
wrapper:

extract :: Question' -> Question a
extract q = case q of
    QuestionS x -> extractQString q
    QuestionI x -> extractQInt q
    QuestionD x -> extractQDouble q

and I had to produce the following instead:

extractQString :: Question' -> Question String
extractQString (QuestionS q) = q

extractQInt :: Question' -> Question Int
extractQInt (QuestionI q) = q

extractQDouble :: Question' -> Question Double
extractQDouble (QuestionD q) = q

An exchange in stackoverflow seems to suggest that the only way to do it is to use GADTs (which is a language extension).
http://stackoverflow.com/questions/6047522/haskell-type-and-pattern-matching-question-extracting-fields-from-a-data-type

I'm disinclined to use language extensions because I'd rather use haskell98 proper to begin with. So Is this indeed the case?
 My code has become more verbose as a result and I am trying to learn most elegant and general haskell 'way' (if it exists) 
and hence I would appreciate any advice to this end.

regards,

Alia


<survey.hs>

module Main where

import Text.Show.Functions
import Data.Maybe

type Name            = String
type QuestionText    = String
type Answer          = String
type Score           = Double
type CorrectAnswer a = a
type Option a        = (String, a)

-- type converters
str      = id
int s    = read s :: Int
double s = read s :: Double

data QuestionType   = Open
                    | Test 
                    | Choice 
                      deriving (Show, Eq)

data Question a = Question
    { questionName    :: Name
    , questionText    :: QuestionText
    , questionType    :: QuestionType
    , answerFunc      :: (String -> a)
    , correctAnswer   :: Maybe a
    , options         :: Maybe [Option a]
    } deriving (Show)

data Question' = QuestionS (Question String) 
               | QuestionI (Question Int) 
               | QuestionD (Question Double)  
                 deriving (Show)

data QuestionSet = QuestionSet
    { qsetTitle     :: String
    , qsetQuestions :: [Question']
    , qsetPoints    :: Double
    } deriving (Show)

data Survey = Survey
    { surveyTitle        :: String
    , surveyQuestionSets :: [QuestionSet]
    } deriving (Show)



parse :: Question a -> Answer -> a
parse = answerFunc

view  :: Question a -> String
view q = questionName q

ask   :: Question a -> IO ()
ask q = putStrLn $ questionText q

store :: Question a -> Answer -> IO ()
store q ans = putStrLn $ questionName q ++ ": " ++ show ans

{-
extract :: Question' -> Question a
extract q = case q of
    QuestionS x -> extractQString q
    QuestionI x -> extractQInt q
    QuestionD x -> extractQDouble q
-}

extractQString :: Question' -> Question String
extractQString (QuestionS q) = q

extractQInt :: Question' -> Question Int
extractQInt (QuestionI q) = q

extractQDouble :: Question' -> Question Double
extractQDouble (QuestionD q) = q

testQ :: (Eq a) => Question a -> Answer -> Bool
testQ q ans = case (correctAnswer q) of
    Nothing -> False
    Just x  -> x == (answerFunc q $ ans)

testQ' :: Question' -> Answer -> Bool
testQ' q a = case q of
    QuestionS x -> testQS q a
    QuestionI x -> testQI q a
    QuestionD x -> testQD q a
    where
        testQS q a = testQ (extractQString q) a
        testQI q a = testQ (extractQInt    q) a
        testQD q a = testQ (extractQDouble q) a


testQset :: QuestionSet -> [Answer] -> [Bool]
testQset qs as = zipWith testQ' (qsetQuestions qs) as


evalQset :: QuestionSet -> [Answer] -> Score
evalQset qs as = (total_correct / total_questions) * score
    where
        total_questions = fromIntegral (length $ qsetQuestions qset)
        total_correct = fromIntegral (length $ filter (== True) (testQset qset as))
        score = qsetPoints qset


q1 = Question
    { questionName  = "q1"
    , questionText  = "What is our name?"
    , questionType  = Open
    , answerFunc    = id
    , correctAnswer = Nothing
    , options       = Nothing
    }

q2 = Question
    { questionName  = "q2"
    , questionText  = "What is 1+1?"
    , questionType  = Test
    , answerFunc    = int
    , correctAnswer = Just 2
    , options       = Nothing
    }

q3 = Question
    { questionName  = "q3"
    , questionText  = "What is 2+1?"
    , questionType  = Choice
    , answerFunc    = int
    , correctAnswer = Just 3
    , options       = Just [("a", 2), ("b", 3), ("c", 4)]
    }

q4 = Question
    { questionName  = "q4"
    , questionText  = "What is 2.0 + 1.5 ?"
    , questionType  = Choice
    , answerFunc    = double
    , correctAnswer = Just 3.5
    , options       = Just [("a", 2.1), ("b", 3.5), ("c", 4.4)]
    }


qset = QuestionSet
    { qsetTitle     = "simple questions"
    , qsetQuestions = [ QuestionS q1 
                      , QuestionI q2 
                      , QuestionI q3
                      , QuestionD q4
                      ]
    , qsetPoints    = 100.0
    }

survey = Survey
    { surveyTitle        = "a survey"
    , surveyQuestionSets = [qset]
    }
    
t1 = evalQset qset ["1", "2", "3", "4"]

</survey.hs>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20111123/e78cb9e8/attachment.htm>