<html><body><div style="color:#000; background-color:#fff; font-family:arial, helvetica, sans-serif;font-size:10pt">Hi folks,<br><br>As a follow-on question from my prior post, I got stuck on not being able to compile the following<br>code in my survey data model which basically generally unwraps the the inner type from the <br>wrapper:<br><br>extract :: Question' -> Question a<br>
extract q = case q of<br>
QuestionS x -> extractQString q<br>
QuestionI x -> extractQInt q<br>
QuestionD x -> extractQDouble q<br>
<br>and I had to produce the following instead:<br><br>extractQString :: Question' -> Question String<br>
extractQString (QuestionS q) = q<br>
<br>
extractQInt :: Question' -> Question Int<br>
extractQInt (QuestionI q) = q<br>
<br>
extractQDouble :: Question' -> Question Double<br>
extractQDouble (QuestionD q) = q<br><br>An exchange in stackoverflow seems to suggest that the only way to do it is to use GADTs (which is a language extension).<br>http://stackoverflow.com/questions/6047522/haskell-type-and-pattern-matching-question-extracting-fields-from-a-data-type<br><br>I'm disinclined to use language extensions because I'd rather use haskell98 proper to begin with. So Is this indeed the case?<br> My code has become more verbose as a result and I am trying to learn most elegant and general haskell 'way' (if it exists) <br>and hence I would appreciate any advice to this end.<br><br>regards,<br><br>Alia<br>
<br><br><survey.hs><br><br>module Main where<br><br>import Text.Show.Functions<br>import Data.Maybe<br><br>type Name = String<br>type QuestionText = String<br>type Answer = String<br>type Score = Double<br>type CorrectAnswer a = a<br>type Option a = (String, a)<br><br>-- type converters<br>str = id<br>int s = read s :: Int<br>double s = read s :: Double<br><br>data QuestionType = Open<br> | Test <br> | Choice
<br> deriving (Show, Eq)<br><br>data Question a = Question<br> { questionName :: Name<br> , questionText :: QuestionText<br> , questionType :: QuestionType<br> , answerFunc :: (String -> a)<br> , correctAnswer :: Maybe a<br> , options :: Maybe [Option a]<br> } deriving (Show)<br><br>data Question' = QuestionS (Question String) <br> | QuestionI (Question Int) <br> | QuestionD (Question
Double) <br> deriving (Show)<br><br>data QuestionSet = QuestionSet<br> { qsetTitle :: String<br> , qsetQuestions :: [Question']<br> , qsetPoints :: Double<br> } deriving (Show)<br><br>data Survey = Survey<br> { surveyTitle :: String<br> , surveyQuestionSets :: [QuestionSet]<br> } deriving (Show)<br><br><br><br>parse :: Question a -> Answer -> a<br>parse = answerFunc<br><br>view :: Question a -> String<br>view q = questionName q<br><br>ask :: Question a -> IO ()<br>ask q = putStrLn $ questionText q<br><br>store :: Question a -> Answer -> IO ()<br>store q ans = putStrLn $ questionName q ++ ": " ++ show
ans<br><br>{-<br>extract :: Question' -> Question a<br>extract q = case q of<br> QuestionS x -> extractQString q<br> QuestionI x -> extractQInt q<br> QuestionD x -> extractQDouble q<br>-}<br><br>extractQString :: Question' -> Question String<br>extractQString (QuestionS q) = q<br><br>extractQInt :: Question' -> Question Int<br>extractQInt (QuestionI q) = q<br><br>extractQDouble :: Question' -> Question Double<br>extractQDouble (QuestionD q) = q<br><br>testQ :: (Eq a) => Question a -> Answer -> Bool<br>testQ q ans = case (correctAnswer q) of<br> Nothing -> False<br> Just x -> x == (answerFunc q $ ans)<br><br>testQ' :: Question' -> Answer -> Bool<br>testQ' q a = case q of<br> QuestionS x -> testQS q a<br> QuestionI x -> testQI q a<br> QuestionD x -> testQD q
a<br> where<br> testQS q a = testQ (extractQString q) a<br> testQI q a = testQ (extractQInt q) a<br> testQD q a = testQ (extractQDouble q) a<br><br><br>testQset :: QuestionSet -> [Answer] -> [Bool]<br>testQset qs as = zipWith testQ' (qsetQuestions qs) as<br><br><br>evalQset :: QuestionSet -> [Answer] -> Score<br>evalQset qs as = (total_correct / total_questions) * score<br> where<br> total_questions = fromIntegral (length $ qsetQuestions qset)<br> total_correct = fromIntegral (length $ filter (== True) (testQset qset as))<br> score = qsetPoints qset<br><br><br>q1 = Question<br> { questionName =
"q1"<br> , questionText = "What is our name?"<br> , questionType = Open<br> , answerFunc = id<br> , correctAnswer = Nothing<br> , options = Nothing<br> }<br><br>q2 = Question<br> { questionName = "q2"<br> , questionText = "What is 1+1?"<br> , questionType = Test<br> , answerFunc = int<br> , correctAnswer = Just 2<br> , options = Nothing<br> }<br><br>q3 = Question<br> { questionName = "q3"<br> , questionText = "What is 2+1?"<br> , questionType = Choice<br> , answerFunc =
int<br> , correctAnswer = Just 3<br> , options = Just [("a", 2), ("b", 3), ("c", 4)]<br> }<br><br>q4 = Question<br> { questionName = "q4"<br> , questionText = "What is 2.0 + 1.5 ?"<br> , questionType = Choice<br> , answerFunc = double<br> , correctAnswer = Just 3.5<br> , options = Just [("a", 2.1), ("b", 3.5), ("c", 4.4)]<br> }<br><br><br>qset = QuestionSet<br> { qsetTitle = "simple questions"<br> , qsetQuestions = [ QuestionS q1 <br> , QuestionI q2
<br> , QuestionI q3<br> , QuestionD q4<br> ]<br> , qsetPoints = 100.0<br> }<br><br>survey = Survey<br> { surveyTitle = "a survey"<br> , surveyQuestionSets = [qset]<br> }<br> <br>t1 = evalQset qset ["1", "2", "3", "4"]<br><br></survey.hs><br><br><br></div></body></html>