Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
decker
decker
Commits
8c8df064
Commit
8c8df064
authored
Nov 21, 2016
by
Henrik Tramberend
Browse files
First working version. Almost ready for prime time.
parent
be54d03a
Changes
8
Hide whitespace changes
Inline
Side-by-side
app/tester.hs
View file @
8c8df064
...
...
@@ -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
exams/templates/exam/fill-text.md
View file @
8c8df064
\n
ewpage
# Aufgabe: {{Title}}
# Aufgabe {{CurrentNumber}}: {{Title}}
{{Question}}
...
...
exams/templates/exam/free-form.md
View file @
8c8df064
\n
ewpage
# Aufgabe: {{Title}}
# Aufgabe {{CurrentNumber}}: {{Title}}
{{Question}}
...
...
exams/templates/exam/multiple-choice.md
View file @
8c8df064
\n
ewpage
# Aufgabe: {{Title}}
# Aufgabe {{CurrentNumber}}: {{Title}}
{{Question}}
...
...
resource/ff-quest-catalog-template.md
View file @
8c8df064
# Aufgabe N: {{Title}}
\n
ewpage
# Aufgabe: {{Title}}
| | |
|---------------|----------------|
| Titel |
**{{Title}}**
|
| Id | {{TopicId}} |
| Base | {{BaseDir}} |
| Vorlesung | {{LectureId}} |
| Schwierigkeit | {{Difficulty}} |
| Punkte | {{Points}} |
...
...
@@ -14,6 +14,4 @@
\f
box{
\b
egin{minipage}{
\t
extwidth}
\h
fill
\v
space{ {{Answer.HeightInMm}}mm }
\e
nd{minipage}}
*Antwort:*
\f
box{
\b
egin{minipage}{
\t
extwidth} {{Answer.CorrectAnswer}}
\e
nd{minipage}}
{{Answer.CorrectAnswer}}
resource/ft-quest-catalog-template.md
View file @
8c8df064
# Aufgabe N: {{Title}}
\n
ewpage
# 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}}
resource/mc-quest-catalog-template.md
View file @
8c8df064
# Aufgabe N: {{Title}}
\n
ewpage
# Aufgabe: {{Title}}
| | |
|---------------|----------------|
| Titel |
**{{Title}}**
|
| Id | {{TopicId}} |
| Base | {{BaseDir}} |
| Vorlesung | {{LectureId}} |
| Schwierigkeit | {{Difficulty}} |
| Punkte | {{Points}} |
...
...
@@ -12,8 +13,6 @@
{{Question}}
*Antworten:*
{{
\#
Answer.Choices}}
-
{{
\#
Correct}}$
\b
oxtimes${{/Correct}}{{
\^
Correct}}$
\s
quare${{/Correct}} {{TheAnswer}}
...
...
src/test.hs
View file @
8c8df064
{-# 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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment