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

Alia alia_khouri at yahoo.com
Sat Nov 26 18:20:55 CET 2011


Hi folks,

Just to wrap things up: I think I'm satisfied with the design below, mostly due to David McBride's advice.
My final code is a slight variation on his suggested course, but not by much. Many thanks to all those
who replied and helped with this problem.

<survey.final.hs>

module Main where

import Text.Show.Functions

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

-- type converters
convert x = read x :: AnswerType
str s = convert ("AnsS \""++ s ++"\"")
int s = convert ("AnsI "++s)
double s = convert ("AnsD "++s)


data AnswerType = AnsD Double
                | AnsS String
                | AnsI Integer
                  deriving (Show, Read, Eq)

data Answer = AnyAnswer
            | TestAnswer AnswerType
            | MultipleChoice AnswerType [Option AnswerType]
              deriving (Show)

data Question = Question
    { questionName    :: Name
    , questionText    :: QuestionText
    , answerFunc      :: String -> AnswerType
    , answer          :: Answer
    } deriving (Show)


data QuestionSet = QuestionSet
    { qsetTitle     :: Name
    , qsetQuestions :: [Question]
    , qsetPoints    :: Score
    } deriving (Show)

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


askQuestion   :: Question -> IO String
askQuestion q = do
    putStrLn $ questionText q
    getLine

askQuestionSet :: QuestionSet -> IO [String]
askQuestionSet qs = mapM askQuestion (qsetQuestions qs)

takeQuestionSet :: QuestionSet -> IO [Bool]
takeQuestionSet qs = do
    answers <- askQuestionSet qs
    return (testQuestionSet qs answers)

testQuestion :: Question -> String -> Bool
testQuestion q ans = case answer q of
    AnyAnswer           -> not (null ans)
    TestAnswer c        -> c == answerFunc q ans
    MultipleChoice c os -> c == answerFunc q ans

testQuestionSet :: QuestionSet -> [String] -> [Bool]
testQuestionSet qs = zipWith testQuestion (qsetQuestions qs)

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


-- TESTING


q1 = Question
    { questionName  = "q1"
    , questionText  = "What is our name?"
    , answerFunc    = str
    , answer        = AnyAnswer
    }

q2 = Question
    { questionName  = "q2"
    , questionText  = "What is 1+1?"
    , answerFunc    = int
    , answer        = TestAnswer (AnsI 2)
    }

q3 = Question
    { questionName  = "q3"
    , questionText  = "What is 2+1?"
    , answerFunc    = int
    , answer        = MultipleChoice (AnsI 3) [ ("a", AnsI 2)
                                              , ("b", AnsI 3)
                                              , ("c", AnsI 4)
                                              ]
    }

q4 = Question
    { questionName  = "q4"
    , questionText  = "What is 2.0 + 1.5 ?"
    , answerFunc    = double
    , answer        = MultipleChoice (AnsD 3.5) [ ("a", AnsD 2.1)
                                                , ("b", AnsD 3.5)
                                                , ("c", AnsD 4.4)
                                                ]
    }


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

survey = Survey
    { surveyTitle        = "a survey"
    , surveyQuestionSets = [qset]
    }


t1 = evalQuestionSet qset ["1", "2", "3", "4"]


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


More information about the Beginners mailing list