test.hs 2.95 KB
Newer Older
1
{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
Henrik Tramberend's avatar
Henrik Tramberend committed
2

3
4
5
6
module Test
       (Question(..), Answer(..), Difficulty(..), Exam(..), Templates,
        compileTesterTemplates, selectTemplate)
       where
Henrik Tramberend's avatar
Henrik Tramberend committed
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

import Control.Exception
import Data.Yaml
import Data.Aeson.Types
import Data.Char
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.ByteString.Char8 as B
import Data.Typeable
import qualified Text.Mustache as M
import qualified Text.Mustache.Types as MT
import Embed
import Utilities
import Data.Aeson.TH

23
24
25
26
27
28
29
30
31
32
data Question = Question
    { qstTopicId :: T.Text
    , qstLectureId :: T.Text
    , qstTitle :: T.Text
    , qstPoints :: Int
    , qstQuestion :: T.Text
    , qstAnswer :: Answer
    , qstDifficulty :: Difficulty
    , qstComment :: T.Text
    } deriving (Eq,Show,Typeable)
Henrik Tramberend's avatar
Henrik Tramberend committed
33
34

data Answer
35
36
37
38
39
40
41
    = MultipleChoice { answCorrect :: [T.Text]
                     , answIncorrect :: [T.Text]}
    | FillText { answFillText :: T.Text
               , answCorrectWords :: [T.Text]}
    | FreeForm { answHeightInMm :: Int
               , answCorrectAnswer :: T.Text}
    deriving (Eq,Show,Typeable)
Henrik Tramberend's avatar
Henrik Tramberend committed
42

43
44
45
46
47
data Difficulty
    = Easy 
    | Medium 
    | Hard 
    deriving (Eq,Show,Typeable)
Henrik Tramberend's avatar
Henrik Tramberend committed
48

49
50
51
52
53
54
55
56
data Exam = Exam
    { examStudentInfoFile :: FilePath
    , examDateTime :: T.Text
    , examDurationInMinutes :: T.Text
    , examTrack :: Int
    , examLectureIds :: [T.Text]
    , examExcludedTopicIds :: [T.Text]
    } deriving (Eq,Show,Typeable)
Henrik Tramberend's avatar
Henrik Tramberend committed
57

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
$(deriveJSON
      defaultOptions
      { fieldLabelModifier = drop 4
      }
      ''Answer)

$(deriveJSON
      defaultOptions
      { fieldLabelModifier = drop 3
      }
      ''Question)

$(deriveJSON
      defaultOptions
      { fieldLabelModifier = drop 4
      }
      ''Exam)
Henrik Tramberend's avatar
Henrik Tramberend committed
75
76
77
78

$(deriveJSON defaultOptions ''Difficulty)

mcKey = typeOf $ MultipleChoice [] []
79

Henrik Tramberend's avatar
Henrik Tramberend committed
80
ftKey = typeOf $ FillText "" []
81

82
ffKey = typeOf $ FreeForm 0 ""
Henrik Tramberend's avatar
Henrik Tramberend committed
83

84
type Templates = [(TypeRep, M.Template)]
Henrik Tramberend's avatar
Henrik Tramberend committed
85

86
selectTemplate :: Templates -> Question -> M.Template
87
-- selectTemplate templates question = fromJust $ lookup (typeOf $ qstAnswer question) templates
88
89
90
91
92
93
selectTemplate templates question = 
    case qstAnswer question of
        MultipleChoice _ _ -> 
            compileMustacheTemplate $ fixMustacheMarkup testerMultipleChoiceTemplate
        FillText _ _ -> compileMustacheTemplate $ fixMustacheMarkup testerFillTextTemplate
        FreeForm _ _ -> compileMustacheTemplate $ fixMustacheMarkup testerFreeFormTemplate
Henrik Tramberend's avatar
Henrik Tramberend committed
94
95

compileTesterTemplates :: Templates
96
97
98
99
100
101
102
103
104
105
compileTesterTemplates = 
    [ (mcKey, compileMustacheTemplate $ fixMustacheMarkup testerMultipleChoiceTemplate)
    , (ftKey, compileMustacheTemplate $ fixMustacheMarkup testerFillTextTemplate)
    , (ffKey, compileMustacheTemplate $ fixMustacheMarkup testerFreeFormTemplate)]

compileMustacheTemplate :: T.Text -> M.Template
compileMustacheTemplate string = 
    case M.compileTemplate "" string of
        Left err -> throw $ MustacheException $ show err
        Right template -> template