Commit 8c8df064 authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

First working version. Almost ready for prime time.

parent be54d03a
......@@ -51,6 +51,11 @@ main = do
(replaceSuffix "-exam.yaml" "-exam.pdf" .
combine privateDir . makeRelative projectDir)
examSources
let solutions =
map
(replaceSuffix "-exam.yaml" "-solution.pdf" .
combine privateDir . makeRelative projectDir)
examSources
-- Meta data
metaFiles <- glob "**/*-meta.yaml"
-- Calculate targets
......@@ -95,6 +100,10 @@ main = do
"exams" $
need exams
--
phony
"solutions" $
need solutions
--
"//*-exam.pdf" %>
\out -> do
let examPath =
......@@ -102,28 +111,32 @@ main = do
combine projectDir . makeRelative privateDir)
out
need $ [examPath]
questions <- readQuestions questionSources
exam <- readExamData examPath
let studentInfoPath =
adjustLocalUrl
projectDir
(takeDirectory examPath)
(examStudentInfoFile exam)
Students studentMap <- readStudentInfo studentInfoPath (examTrack exam)
putNormal $ "Read student data from: " ++ studentInfoPath
let examData = generateExam exam questions (Map.elems studentMap)
putNormal $
"Exams generated for N students. N: " ++ (show . length . snd) examData
templates <- compileTemplates "exam"
putNormal "Templates compiled."
examPandoc <- compileExam projectDir templates examData
putNormal "Exams compiled to pandoc"
compilePandocPdf examPandoc out
buildExam projectDir "exam" examPath questionSources out
--
"//*-solution.pdf" %>
\out -> do
let examPath =
(replaceSuffix "-solution.pdf" "-exam.yaml" .
combine projectDir . makeRelative privateDir)
out
buildExam projectDir "solution" examPath questionSources out
--
phony
"clean" $
removeFilesAfter "." ["private"]
buildExam projectDir disposition examSource questionSources out = do
need $ [examSource]
questions <- readQuestions questionSources
exam <- readExamData examSource
let studentInfoPath =
adjustLocalUrl projectDir (takeDirectory examSource) (examStudentInfoFile exam)
Students studentMap <- readStudentInfo studentInfoPath (examTrack exam)
let examData = generateExam exam questions (Map.elems studentMap)
templates <- compileTemplates disposition
examPandoc <- compileExam projectDir templates examData
compilePandocPdf examPandoc out
compileTemplates :: FilePath -> Action MT.TemplateCache
compileTemplates disposition = do
let templateNames =
......@@ -152,9 +165,10 @@ compileProjectTemplate disposition name = do
compilePandocPdf :: Pandoc -> FilePath -> Action ()
compilePandocPdf exam out = do
let variables =
[ ("fontsize", "12pt")
, ("fontfamily", "roboto")
, ("header-includes", "\\renewcommand{\\familydefault}{\\sfdefault}")]
[ ("documentclass", "scrartcl")
, ("lang", "german")
, ("babel-lang", "german")
, ("classoption", "fontsize=13pt")]
let options =
def
{ writerStandalone = True
......@@ -263,9 +277,11 @@ filterQuestions includeLectures excludeTopics questions =
filter (not . (flip elem) excludeTopics . qstLectureId . fst) $
filter ((flip elem) includeLectures . qstLectureId . fst) questions
type GroupedQuestions = Map.HashMap T.Text (Map.HashMap T.Text [(Question, FilePath)])
-- | Groups questions first by LectureId and then by TopicId into nested HashMaps.
groupQuestions
:: [(Question, FilePath)] -> Map.HashMap T.Text (Map.HashMap T.Text [(Question, FilePath)])
:: [(Question, FilePath)] -> GroupedQuestions
groupQuestions questions =
let byLectureId = foldl (groupBy qstLectureId) Map.empty questions
in Map.map (foldl (groupBy qstTopicId) Map.empty) byLectureId
......@@ -290,10 +306,21 @@ generateExam exam questions students =
-- Should produce the identical exam for one student each time and different
-- exams for all students every time.
let gen = mkStdGen (hash student)
selection =
take (examNumberOfQuestions exam) $ shuffle' candidates (length candidates) gen
-- Shuffle the deck of questions
shuffled = shuffle' candidates (length candidates) gen
-- Remove questions with duplicate TopicId. Keep the first one.
singled =
nubBy
(\(q1,_) (q2,_) ->
qstTopicId q1 == qstTopicId q2)
shuffled
-- Take the number of questions that is needed
selection = take (examNumberOfQuestions exam) singled
-- Shuffle multiple choices
questions = map (shuffleChoices gen) selection
in (student, questions)
-- Number the questions
numbered = map numberQuestion (zip [1 ..] questions)
in (student, numbered)
shuffleChoices gen (question,basePath) =
let answer =
case qstAnswer question of
......@@ -304,6 +331,11 @@ generateExam exam questions students =
{ qstAnswer = answer
}
, basePath)
numberQuestion (n,(q,p)) =
( q
{ qstCurrentNumber = n
}
, p)
-- | Throw, result is shitty.
maybeThrowYaml
......@@ -455,6 +487,8 @@ multipleChoiceStationary =
}
, qstDifficulty = Medium
, qstComment = "COMMENT"
, qstCurrentNumber = 0
, qstBasePath = "."
}
fillTextStationary :: Question
......@@ -471,6 +505,8 @@ fillTextStationary =
}
, qstDifficulty = Medium
, qstComment = "COMMENT"
, qstCurrentNumber = 0
, qstBasePath = "."
}
freeStationary :: Question
......@@ -487,4 +523,6 @@ freeStationary =
}
, qstDifficulty = Medium
, qstComment = "COMMENT"
, qstCurrentNumber = 0
, qstBasePath = "."
}
\ No newline at end of file
\newpage
# Aufgabe: {{Title}}
# Aufgabe {{CurrentNumber}}: {{Title}}
{{Question}}
......
\newpage
# Aufgabe: {{Title}}
# Aufgabe {{CurrentNumber}}: {{Title}}
{{Question}}
......
\newpage
# Aufgabe: {{Title}}
# Aufgabe {{CurrentNumber}}: {{Title}}
{{Question}}
......
# Aufgabe N: {{Title}}
\newpage
# Aufgabe: {{Title}}
| | |
|---------------|----------------|
| Titel | **{{Title}}** |
| Id | {{TopicId}} |
| Base | {{BaseDir}} |
| Vorlesung | {{LectureId}} |
| Schwierigkeit | {{Difficulty}} |
| Punkte | {{Points}} |
......@@ -14,6 +14,4 @@
\fbox{\begin{minipage}{\textwidth} \hfill \vspace{ {{Answer.HeightInMm}}mm } \end{minipage}}
*Antwort:*
\fbox{\begin{minipage}{\textwidth} {{Answer.CorrectAnswer}} \end{minipage}}
{{Answer.CorrectAnswer}}
# Aufgabe N: {{Title}}
\newpage
# Aufgabe: {{Title}}
| | |
|---------------|----------------|
| Titel | **{{Title}}** |
| Id | {{TopicId}} |
| Base | {{BaseDir}} |
| Vorlesung | {{LectureId}} |
| Schwierigkeit | {{Difficulty}} |
| Punkte | {{Points}} |
......@@ -14,4 +15,4 @@
{{Answer.FillText}}
*Antwort:* {{\#Answer.CorrectWords}}{{.}}, {{/Answer.CorrectWords}}
{{\#Answer.CorrectWords}}{{.}}, {{/Answer.CorrectWords}}
# Aufgabe N: {{Title}}
\newpage
# Aufgabe: {{Title}}
| | |
|---------------|----------------|
| Titel | **{{Title}}** |
| Id | {{TopicId}} |
| Base | {{BaseDir}} |
| Vorlesung | {{LectureId}} |
| Schwierigkeit | {{Difficulty}} |
| Punkte | {{Points}} |
......@@ -12,8 +13,6 @@
{{Question}}
*Antworten:*
{{\#Answer.Choices}}
- {{\#Correct}}$\boxtimes${{/Correct}}{{\^Correct}}$\square${{/Correct}} {{TheAnswer}}
......
{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell, OverloadedStrings, DeriveGeneric #-}
module Test
(Question(..)
......@@ -18,6 +18,7 @@ import Data.Yaml
import Data.Aeson.Types
import Data.Char
import Data.Maybe
import GHC.Generics
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.ByteString.Char8 as B
......@@ -37,7 +38,9 @@ data Question = Question
, qstAnswer :: Answer
, qstDifficulty :: Difficulty
, qstComment :: T.Text
} deriving (Eq,Show,Typeable)
, qstCurrentNumber :: Int
, qstBasePath :: String
} deriving (Eq,Show,Typeable,Generic)
data Choice = Choice
{ choiceTheAnswer :: T.Text
......@@ -93,12 +96,31 @@ $(deriveJSON
}
''Answer)
$(deriveJSON
defaultOptions
{ fieldLabelModifier = drop 3
}
''Question)
questionOptions =
defaultOptions
{ fieldLabelModifier = drop 3
}
instance ToJSON Question where
toJSON = genericToJSON questionOptions
toEncoding = genericToEncoding questionOptions
instance FromJSON Question where
parseJSON (Object q) =
Question <$> q .: "TopicId" <*> q .: "LectureId" <*> q .: "Title" <*> q .: "Points" <*>
q .: "Question" <*>
q .: "Answer" <*>
q .: "Difficulty" <*>
q .: "Comment" <*>
q .:? "CurrentNumber" .!= 0 <*>
q .:? "BasePath" .!= "."
parseJSON invalid = typeMismatch "Question" invalid
-- $(deriveJSON
-- defaultOptions
-- { fieldLabelModifier = drop 3
-- }
-- ''Question)
$(deriveJSON
defaultOptions
{ fieldLabelModifier = drop 4
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment