tester begins to be useful

.gitignore

@@ -11,3 +11,5 @@ index.html
 *-page.html
 .shake
 public/
+private/
+auto/
\ No newline at end of file

app/decker.hs

@@ -30,14 +30,13 @@ main = do
     -- Find sources
     deckSources <- glob "**/*-deck.md"
     pageSources <- glob "**/*-page.md"
-    allSources <- glob "**/*.md"
-    meta <- glob "**/*.yaml"
+    let allSources = deckSources ++ pageSources
+
+    meta <- glob "**/*-meta.yaml"
 
     -- Read meta data.
     metaData <- readMetaDataIO meta
 
-    -- let plainSources = allSources \\ (deckSources ++ pageSources)
-
     -- Calculate targets
     let decks = targetPathes deckSources projectDir ".md" ".html"
     let decksPdf = targetPathes deckSources projectDir ".md" ".pdf"
@@ -45,13 +44,11 @@ main = do
     let handoutsPdf = targetPathes deckSources projectDir "-deck.md" "-handout.pdf"
     let pages = targetPathes pageSources projectDir ".md" ".html"
     let pagesPdf = targetPathes pageSources projectDir ".md" ".pdf"
-    -- let plain = targetPathes plainSources projectDir ".md" ".html"
-    -- let plainPdf = targetPathes pageSources projectDir ".md" ".pdf"
 
     let indexSource = projectDir </> "index.md"
     let index = publicDir </> "index.html"
 
-    let everything = decks ++ handouts ++ pages ++ [index]
+    let everything = decks ++ handouts ++ pages
     let everythingPdf = decksPdf ++ handoutsPdf ++ pagesPdf
 
     let cruft = [ "index.md.generated"
@@ -87,8 +84,8 @@ main = do
         phony "example" writeExampleProject
 
         priority 2 $ "//*-deck.html" %> \out -> do
-            need ["support"]
             let src = sourcePath out projectDir ".html" ".md"
+            need $ src : meta
             markdownToHtmlDeck src metaData out
 
         priority 2 $ "//*-deck.pdf" %> \out -> do
@@ -103,34 +100,35 @@ main = do
                  return ()
 
         priority 2 $ "//*-handout.html" %> \out -> do
-            need ["support"]
             let src = sourcePath out projectDir "-handout.html" "-deck.md"
+            need $ src : meta
             markdownToHtmlHandout src meta out
 
         priority 2 $ "//*-handout.pdf" %> \out -> do
             let src = sourcePath out projectDir "-handout.pdf" "-deck.md"
+            need $ src : meta
             markdownToPdfHandout src meta out
 
         priority 2 $ "//*-page.html" %> \out -> do
             let src = sourcePath out projectDir "-page.html" "-page.md"
-            need $ [src, "support"] ++ meta
+            need $ src : meta
             markdownToHtmlPage src metaData out
 
         priority 2 $ "//*-page.pdf" %> \out -> do
             let src = sourcePath out projectDir "-page.pdf" "-page.md"
-            need $ [src, "support", "cache"] ++ meta
+            need $ src : meta
             markdownToPdfPage src metaData out
 
         priority 2 $ index %> \out -> do
             exists <- Development.Shake.doesFileExist indexSource
             let src = if exists then indexSource else indexSource <.> "generated"
+            need $ src : meta
             putNormal out
             rel <- getRelativeSupportDir out
             putNormal rel
             markdownToHtmlPage src metaData out
 
         indexSource <.> "generated" %> \out -> do
-            need $ decks ++ handouts ++ pages
             writeIndex out (takeDirectory index) decks handouts pages
 
         phony "clean" $ do
@@ -142,8 +140,10 @@ main = do
 
         phony "plan" $ do
             putNormal $ "project directory: " ++ projectDir
+            putNormal "meta:"
+            mapM_ putNormal $ meta
             putNormal "sources:"
-            mapM_ putNormal $ allSources ++ meta
+            mapM_ putNormal $ allSources
             putNormal "targets:"
             mapM_ putNormal $ everything ++ everythingPdf
 
@@ -155,10 +155,9 @@ main = do
             writeEmbeddedFiles deckerSupportDir supportDir
 
         phony "publish" $ do
-            need $ everything ++ ["index.html"]
+            need $ everything ++ [index]
             hasResource <- Development.Shake.doesDirectoryExist resourceDir
             let source = if hasResource then resourceDir : everything else everything
-            metaData <- readMetaData meta
             let host = metaValueAsString "rsync-destination.host" metaData
             let path = metaValueAsString "rsync-destination.path" metaData
             if isJust host && isJust path
@@ -178,14 +177,6 @@ main = do
           ctx <- getActionContext
           putNormal $ show ctx
 
--- | Glob for pathes below and relative to the current directory.
-globRelative :: String -> Action [FilePath]
-globRelative pat = liftIO $ glob pat >>= mapM makeRelativeToCurrentDirectory
-
--- | Glob for pathes below and relative to the current directory.
-globRelativeIO :: String -> IO [FilePath]
-globRelativeIO pat = glob pat >>= mapM makeRelativeToCurrentDirectory
-
 -- | Some constants that might need tweaking
 resourceDir = "img"
 options = shakeOptions{shakeFiles=".shake"}

app/tester.hs

+import Control.Monad ()
+import Control.Exception
+import Data.Maybe ()
+import Data.Typeable
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import qualified Data.Yaml as Y
+import Data.Yaml.Pretty as Y
+import qualified Data.ByteString.Char8 as B
+import Debug.Trace
+import Development.Shake
+import Development.Shake.FilePath
+import System.FilePath ()
+import System.FilePath.Glob
+import System.Directory
+import System.Random
+import System.Random.Shuffle
+import qualified Text.Mustache as M
+import qualified Text.Mustache.Types as MT
+import Text.Highlighting.Kate.Styles
+import Text.Pandoc
+import Text.Pandoc.PDF
+import Text.Pandoc.Walk
+import Utilities
+import Filter
+import Test
+import Embed
+
+main :: IO ()
+main =
+  do
+     -- Calculate some directories
+     projectDir <- calcProjectDirectory
+     let privateDir = projectDir </> "private"
+     -- Find sources
+     testFiles <- glob "**/*-test.yaml"
+     -- Meta data
+     metaFiles <- glob "**/*-meta.yaml"
+     -- Calculate targets
+     let catalog = privateDir </> "complete-test-catalog.pdf"
+     -- Prepare Mustache templates
+     let templates = compileTesterTemplates
+     ---
+     shakeArgs shakeOptions $
+       do want ["catalog"]
+          --
+          catalog %>
+            \out ->
+              do need testFiles
+                 allQuestions <- readTests testFiles
+                 renderCatalog projectDir templates allQuestions out
+          --
+          phony "catalog" $
+            do need [catalog]
+          --
+          phony "new-mc" $
+            do let string = Y.encodePretty Y.defConfig multipleChoiceStationary
+               liftIO $ B.writeFile "new-mc-test.yaml" string
+          --
+          phony "new-ft" $
+            do let string = Y.encodePretty Y.defConfig fillTextStationary
+               liftIO $ B.writeFile "new-ft-test.yaml" string
+          --
+          phony "new-f" $
+            do let string = Y.encodePretty Y.defConfig freeStationary
+               liftIO $ B.writeFile "new-f-test.yaml" string
+          --
+          phony "clean" $
+            do removeFilesAfter "." ["private"]
+
+-- Reads all the questions and returns them along with the base directory of
+-- each.
+readTests :: [FilePath] -> Action [(Question, FilePath)]
+readTests files = mapM readTest files
+  where readTest :: FilePath -> Action (Question, FilePath)
+        readTest file =
+          do absolutePath <- liftIO $ makeAbsolute file
+             string <- liftIO $ B.readFile absolutePath
+             let question =
+                   case Y.decodeEither' string of
+                     Right yaml -> yaml
+                     Left exception ->
+                       throw $
+                       YamlException $
+                       "Error parsing YAML file: " ++
+                       file ++ ", " ++ (show exception)
+             return (question, takeDirectory absolutePath)
+
+renderCatalog :: FilePath -> Templates -> [(Question, FilePath)] -> FilePath -> Action()
+renderCatalog projectDir templates questions out =
+  do let markdown = map (\(q,b) -> (renderMarkdown q,b)) questions
+     let pandoc = map parseMarkdown markdown
+     need $ concat $ map extractLocalImagePathes pandoc
+     let catalog =
+           Pandoc nullMeta $ concat $ map (\(Pandoc _ blocks) -> blocks) pandoc
+     let options =
+           def {writerStandalone = True
+               ,writerTemplate = B.unpack testLatexTemplate
+               ,writerHighlight = True
+               ,writerHighlightStyle = pygments
+               ,writerCiteMethod = Citeproc}
+     putNormal $ "# pandoc (for " ++ out ++ ")"
+     pandocMakePdf options catalog out
+  where parseMarkdown (markdown,base) =
+          case readMarkdown def markdown of
+            Left err -> throw $ PandocException (show err)
+            Right pandoc -> walk (adjustImageUrls base) pandoc
+        adjustImageUrls base (Image attr inlines (url,title)) =
+          (Image attr inlines (absoluteIncludePath projectDir base url,title))
+        adjustImageUrls _ inline = inline
+        renderMarkdown question =
+          T.unpack $
+          M.substitute (selectTemplate templates question)
+                       (MT.mFromJSON question)
+
+-- TODO Make this work
+newOrder :: Int -> IO [Int]
+newOrder n =
+  do gen <- getStdGen
+     return $ shuffle' [0..(n-1)] n gen
+
+-- TODO Make this work
+shuffleAnswers :: Question -> Action Question
+shuffleAnswers q =
+  case qstAnswer q of
+    MultipleChoice choices correct ->
+      do let n = length choices
+         order <- liftIO $ newOrder n
+         return q {qstAnswer =
+                     MultipleChoice (shuffle choices order)
+                                    (shuffle correct order)}
+    otherwise -> return q
+
+multipleChoiceStationary :: Question
+multipleChoiceStationary =
+  Question {qstId = "ID"
+           ,qstLecture = 0
+           ,qstTitle = "MULTIPLE CHOICE"
+           ,qstPoints = 5
+           ,qstQuestion = "THE QUESTION?"
+           ,qstAnswer =
+              MultipleChoice {answChoices = ["RIGHT_ANSWER","WRONG_ANSWER"]
+                             ,answCorrectChoices = [True,False]}
+           ,qstDifficulty = Medium
+           ,qstComment = "COMMENT"}
+
+fillTextStationary :: Question
+fillTextStationary =
+  Question {qstId = "ID"
+           ,qstLecture = 0
+           ,qstTitle = "FILL TEXT"
+           ,qstPoints = 5
+           ,qstQuestion = "THE QUESTION?"
+           ,qstAnswer =
+             FillText {answFillText = "FILL THE ___ IN THE ___."
+                      ,answCorrectWords = ["HOLES", "TEXT"]}
+           ,qstDifficulty = Medium
+           ,qstComment = "COMMENT"}
+
+freeStationary :: Question
+freeStationary =
+  Question {qstId = "ID"
+           ,qstLecture = 0
+           ,qstTitle = "FREE"
+           ,qstPoints = 5
+           ,qstQuestion = "THE QUESTION?"
+           ,qstAnswer =
+              Free {answHeightInMm = 20
+                   ,answCorrectAnswer = "THE ANSWER."}
+           ,qstDifficulty = Medium
+           ,qstComment = "COMMENT"}

resource/deck.html

@@ -96,7 +96,7 @@ $body$
         showNotes: sn,
         controls: false,         // Display controls in the bottom right corner
         progress: true,         // Display a presentation progress bar
-        history: $if(history)$$history$$else$true$endif$,          // Push each slide change to the browser history
+        history: $if(history)$$history$$else$false$endif$,          // Push each slide change to the browser history
         center: $if(center)$$center$$else$true$endif$,                       // Vertical centering of slides
         maxScale: $if(maxScale)$$maxScale$$else$1.5$endif$,                  // Bounds for smallest/largest possible content scale
         slideNumber: $if(slideNumber)$true$else$false$endif$,                // Display the page number of the current slide

resource/example/example-meta.yaml

@@ -9,7 +9,6 @@ structured:
   - First
   - Second
   - Third
-  - Fourth
 date: 14.5.2016
 csl: chicago-author-date.csl
 ...

resource/test-question.md

+# Aufgabe N: {{Title}}
+
+|               |                   |
+|---------------+-------------------|
+| Titel         | **{{Title}}**  |
+| Id            | {{Id}}         |
+| Vorlesung     | {{Lecture}}    |
+| Schwierigkeit | {{Difficulty}} |
+| Punkte        | {{Points}}     |
+| Kommentar     | {{Comment}}    |
+
+{{Question}}
+
+{{#Answer.Choices}}
+- {{.}}
+{{/Answer.Choices}}

resource/test.tex

+\documentclass[$if(fontsize)$$fontsize$,$endif$$if(lang)$$babel-lang$,$endif$$if(papersize)$$papersize$paper,$endif$$for(classoption)$$classoption$$sep$,$endfor$]{$documentclass$}
+$if(fontfamily)$
+\usepackage[$for(fontfamilyoptions)$$fontfamilyoptions$$sep$,$endfor$]{$fontfamily$}
+$else$
+\usepackage{lmodern}
+$endif$
+$if(linestretch)$
+\usepackage{setspace}
+\setstretch{$linestretch$}
+$endif$
+\usepackage{amssymb,amsmath}
+\usepackage{ifxetex,ifluatex}
+\usepackage{fixltx2e} % provides \textsubscript
+\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex
+  \usepackage[$if(fontenc)$$fontenc$$else$T1$endif$]{fontenc}
+  \usepackage[utf8]{inputenc}
+$if(euro)$
+  \usepackage{eurosym}
+$endif$
+\else % if luatex or xelatex
+  \ifxetex
+    \usepackage{mathspec}
+  \else
+    \usepackage{fontspec}
+  \fi
+  \defaultfontfeatures{Ligatures=TeX,Scale=MatchLowercase}
+$if(euro)$
+  \newcommand{\euro}{€}
+$endif$
+$if(mainfont)$
+    \setmainfont[$for(mainfontoptions)$$mainfontoptions$$sep$,$endfor$]{$mainfont$}
+$endif$
+$if(sansfont)$
+    \setsansfont[$for(sansfontoptions)$$sansfontoptions$$sep$,$endfor$]{$sansfont$}
+$endif$
+$if(monofont)$
+    \setmonofont[Mapping=tex-ansi$if(monofontoptions)$,$for(monofontoptions)$$monofontoptions$$sep$,$endfor$$endif$]{$monofont$}
+$endif$
+$if(mathfont)$
+    \setmathfont(Digits,Latin,Greek)[$for(mathfontoptions)$$mathfontoptions$$sep$,$endfor$]{$mathfont$}
+$endif$
+$if(CJKmainfont)$
+    \usepackage{xeCJK}
+    \setCJKmainfont[$for(CJKoptions)$$CJKoptions$$sep$,$endfor$]{$CJKmainfont$}
+$endif$
+\fi
+% use upquote if available, for straight quotes in verbatim environments
+\IfFileExists{upquote.sty}{\usepackage{upquote}}{}
+% use microtype if available
+\IfFileExists{microtype.sty}{%
+\usepackage{microtype}
+\UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts
+}{}
+$if(geometry)$
+\usepackage[$for(geometry)$$geometry$$sep$,$endfor$]{geometry}
+$endif$
+\usepackage{hyperref}
+$if(colorlinks)$
+\PassOptionsToPackage{usenames,dvipsnames}{color} % color is loaded by hyperref
+$endif$
+\hypersetup{unicode=true,
+$if(title-meta)$
+            pdftitle={$title-meta$},
+$endif$
+$if(author-meta)$
+            pdfauthor={$author-meta$},
+$endif$
+$if(keywords)$
+            pdfkeywords={$for(keywords)$$keywords$$sep$; $endfor$},
+$endif$
+$if(colorlinks)$
+            colorlinks=true,
+            linkcolor=$if(linkcolor)$$linkcolor$$else$Maroon$endif$,
+            citecolor=$if(citecolor)$$citecolor$$else$Blue$endif$,
+            urlcolor=$if(urlcolor)$$urlcolor$$else$Blue$endif$,
+$else$
+            pdfborder={0 0 0},
+$endif$
+            breaklinks=true}
+\urlstyle{same}  % don't use monospace font for urls
+$if(lang)$
+\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex
+  \usepackage[shorthands=off,$for(babel-otherlangs)$$babel-otherlangs$,$endfor$main=$babel-lang$]{babel}
+$if(babel-newcommands)$
+  $babel-newcommands$
+$endif$
+\else
+  \usepackage{polyglossia}
+  \setmainlanguage[$polyglossia-lang.options$]{$polyglossia-lang.name$}
+$for(polyglossia-otherlangs)$
+  \setotherlanguage[$polyglossia-otherlangs.options$]{$polyglossia-otherlangs.name$}
+$endfor$
+\fi
+$endif$
+$if(natbib)$
+\usepackage{natbib}
+\bibliographystyle{$if(biblio-style)$$biblio-style$$else$plainnat$endif$}
+$endif$
+$if(biblatex)$
+\usepackage$if(biblio-style)$[style=$biblio-style$]$endif${biblatex}
+$if(biblatexoptions)$\ExecuteBibliographyOptions{$for(biblatexoptions)$$biblatexoptions$$sep$,$endfor$}$endif$
+$for(bibliography)$
+\addbibresource{$bibliography$}
+$endfor$
+$endif$
+$if(listings)$
+\usepackage{listings}
+$endif$
+$if(lhs)$
+\lstnewenvironment{code}{\lstset{language=Haskell,basicstyle=\small\ttfamily}}{}
+$endif$
+$if(highlighting-macros)$
+$highlighting-macros$
+$endif$
+$if(verbatim-in-note)$
+\usepackage{fancyvrb}
+\VerbatimFootnotes % allows verbatim text in footnotes
+$endif$
+$if(tables)$
+\usepackage{longtable,booktabs}
+$endif$
+$if(graphics)$
+\usepackage{graphicx,grffile}
+\makeatletter
+\def\maxwidth{\ifdim\Gin@nat@width>\linewidth\linewidth\else\Gin@nat@width\fi}
+\def\maxheight{\ifdim\Gin@nat@height>\textheight\textheight\else\Gin@nat@height\fi}
+\makeatother
+% Scale images if necessary, so that they will not overflow the page
+% margins by default, and it is still possible to overwrite the defaults
+% using explicit options in \includegraphics[width, height, ...]{}
+\setkeys{Gin}{width=\maxwidth,height=\maxheight,keepaspectratio}
+$endif$
+$if(links-as-notes)$
+% Make links footnotes instead of hotlinks:
+\renewcommand{\href}[2]{#2\footnote{\url{#1}}}
+$endif$
+$if(strikeout)$
+\usepackage[normalem]{ulem}
+% avoid problems with \sout in headers with hyperref:
+\pdfstringdefDisableCommands{\renewcommand{\sout}{}}
+$endif$
+$if(indent)$
+$else$
+\IfFileExists{parskip.sty}{%
+\usepackage{parskip}
+}{% else
+\setlength{\parindent}{0pt}
+\setlength{\parskip}{6pt plus 2pt minus 1pt}
+}
+$endif$
+\setlength{\emergencystretch}{3em}  % prevent overfull lines
+\providecommand{\tightlist}{%
+  \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}}
+$if(numbersections)$
+\setcounter{secnumdepth}{5}
+$else$
+\setcounter{secnumdepth}{0}
+$endif$
+$if(subparagraph)$
+$else$
+% Redefines (sub)paragraphs to behave more like sections
+\ifx\paragraph\undefined\else
+\let\oldparagraph\paragraph
+\renewcommand{\paragraph}[1]{\oldparagraph{#1}\mbox{}}
+\fi
+\ifx\subparagraph\undefined\else
+\let\oldsubparagraph\subparagraph
+\renewcommand{\subparagraph}[1]{\oldsubparagraph{#1}\mbox{}}
+\fi
+$endif$
+$if(dir)$
+\ifxetex
+  % load bidi as late as possible as it modifies e.g. graphicx
+  $if(latex-dir-rtl)$
+  \usepackage[RTLdocument]{bidi}
+  $else$
+  \usepackage{bidi}
+  $endif$
+\fi
+\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex
+  \TeXXeTstate=1
+  \newcommand{\RL}[1]{\beginR #1\endR}
+  \newcommand{\LR}[1]{\beginL #1\endL}
+  \newenvironment{RTL}{\beginR}{\endR}
+  \newenvironment{LTR}{\beginL}{\endL}
+\fi
+$endif$
+$for(header-includes)$
+$header-includes$
+$endfor$
+
+$if(title)$
+\title{$title$$if(thanks)$\thanks{$thanks$}$endif$}
+$endif$
+$if(subtitle)$
+\providecommand{\subtitle}[1]{}
+\subtitle{$subtitle$}
+$endif$
+$if(author)$
+\author{$for(author)$$author$$sep$ \and $endfor$}
+$endif$
+\date{$date$}
+
+\begin{document}
+$if(title)$
+\maketitle
+$endif$
+$if(abstract)$
+\begin{abstract}
+$abstract$
+\end{abstract}
+$endif$
+
+$for(include-before)$
+$include-before$
+
+$endfor$
+$if(toc)$
+{
+$if(colorlinks)$
+\hypersetup{linkcolor=$if(toccolor)$$toccolor$$else$black$endif$}
+$endif$
+\setcounter{tocdepth}{$toc-depth$}
+\tableofcontents
+}
+$endif$
+$if(lot)$
+\listoftables
+$endif$
+$if(lof)$
+\listoffigures
+$endif$
+$body$
+
+$if(natbib)$
+$if(bibliography)$
+$if(biblio-title)$
+$if(book-class)$
+\renewcommand\bibname{$biblio-title$}
+$else$
+\renewcommand\refname{$biblio-title$}
+$endif$
+$endif$
+\bibliography{$for(bibliography)$$bibliography$$sep$,$endfor$}
+
+$endif$
+$endif$
+$if(biblatex)$
+\printbibliography$if(biblio-title)$[title=$biblio-title$]$endif$
+
+$endif$
+$for(include-after)$
+$include-after$
+
+$endfor$
+\end{document}

resource/tester-example/cross-product-geometry-test.yaml

+---
+Answer:
+  tag: MultipleChoice
+  CorrectChoices:
+  - True
+  - True
+  - False
+  - False
+  - False
+  Choices:
+  - |
+    Der Vektor $\vec{v}$ steht senkrecht auf den Vektoren $\vec{a}$ und
+    $\vec{b}$.
+  - |
+    Die Länge von Vektor $\vec{v}$ enspricht der Fläche des von den Vektoren
+    $\vec{a}$ und $\vec{b}$ aufgespannten Parallelograms.
+  - |
+    Die Länge von Vektor $\vec{v}$ enspricht der Länge der Hauptdiagonalen des
+    von den Vektoren $\vec{a}$ und $\vec{b}$ aufgespannten Parallelograms.
+  - |
+    Vektor $\vec{v}$ ist die Winkelhalbierende des von Vektoren
+    $\vec{a}$ und $\vec{b}$ aufgespannten Winkels.
+  - |
+    Die Länge von Vektor $\vec{v}$ enspricht der Summe der Längen der Vektoren
+    $\vec{a}$ und $\vec{b}$.
+Comment: Gebrauchsfertig.
+Id: kreuzprodukt-geometrische-interpretation
+Question: |
+  ![](../example/img/06-metal.png){width=50%}\
+  Welche der folgenden Aussagen über das Kreuzprodukt $\vec{v} = \vec{a} \times
+  \vec{b}$ sind richtig?
+Title: Geometrische Deutung Kreuzprodukt
+Points: 5
+Lecture: 7
+Difficulty: Easy
+...

resource/tester-example/cross-product-math-test.yaml

+---
+Answer:
+  tag: MultipleChoice
+  CorrectChoices:
+  - True
+  - True
+  - False
+  - False
+  Choices:
+  - |
+    $\vec{a}\times\vec{b}=(y_a z_b - z_a y_b, z_a x_b - x_a z_b, x_a y_b - y_a x_b)$
+  - |
+    $\vec{a}\times\vec{b}=|\vec{a}| |\vec{b}| \sin \Phi_{\vec{a},\vec{b}}$
+  - |
+    $\vec{a}\times\vec{b}=|\vec{a}| |\vec{b}| \cos \Phi_{\vec{a},\vec{b}}$
+  - |
+    $\vec{a}\times\vec{b}=|\vec{a}| |\vec{b}| \tan \Phi_{\vec{a},\vec{b}}$
+Comment: Gebrauchsfertig.
+Id: kreuzprodukt-formal
+Question: |
+  Welche der folgenden Definitionen des Kreuzprodukts $\vec{v} = \vec{a} \times
+  \vec{b}$ sind korrekt?
+Title: Das Kreuzprodukt
+Points: 5
+Lecture: 7
+Difficulty: Easy
+...

slides.cabal

@@ -15,8 +15,9 @@ cabal-version:       >=1.10
 
 library
   hs-source-dirs:      src
-  exposed-modules:     Embed, Context, Utilities, Filter
+  exposed-modules:     Test, Embed, Context, Utilities, Filter
   build-depends:       base
+                     , aeson
                      , pandoc-types
                      , pandoc-citeproc
                      , containers
@@ -61,7 +62,27 @@ executable decker
                      , pandoc
                      , yaml
                      , mustache
-                     , io-memoize
+  default-language:    Haskell2010
+
+executable tester
+  hs-source-dirs:      app
+  main-is:             tester.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , slides
+                     , shake
+                     , Glob
+                     , bytestring
+                     , directory
+                     , filepath
+                     , pandoc
+                     , pandoc-types
+                     , text
+                     , yaml
+                     , mustache
+                     , highlighting-kate
+                     , random
+                     , random-shuffle
   default-language:    Haskell2010
 
 executable include-pandoc-filter

src/embed.hs

@@ -2,7 +2,7 @@
 
 module Embed
        (deckerHelpText, deckerExampleDir, deckerSupportDir, deckTemplate, pageTemplate,
-        pageLatexTemplate, handoutTemplate, handoutLatexTemplate)
+        pageLatexTemplate, handoutTemplate, handoutLatexTemplate, testerMultipleChoiceTemplate, testLatexTemplate)
        where
 
 import Data.FileEmbed
@@ -37,3 +37,11 @@ handoutTemplate =
 handoutLatexTemplate :: String
 handoutLatexTemplate =
   B.unpack $(makeRelativeToProject "resource/handout.tex" >>= embedFile)
+
+testerMultipleChoiceTemplate :: B.ByteString
+testerMultipleChoiceTemplate =
+  $(makeRelativeToProject "resource/test-question.md" >>= embedFile)
+
+testLatexTemplate :: B.ByteString
+testLatexTemplate =
+  $(makeRelativeToProject "resource/test.tex" >>= embedFile)

src/test.hs

+{-# LANGUAGE TemplateHaskell #-}
+
+module Test (Question(..), Answer(..), Difficulty(..), Templates, compileTesterTemplates, selectTemplate) where
+
+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
+
+data Question =
+  Question {qstId :: String
+           ,qstLecture :: Int
+           ,qstTitle :: String
+           ,qstPoints :: Int
+           ,qstQuestion :: String
+           ,qstAnswer :: Answer
+           ,qstDifficulty :: Difficulty
+           ,qstComment :: String}
+  deriving (Show,Typeable)
+
+data Answer
+  = MultipleChoice {answChoices :: [String]
+                   ,answCorrectChoices :: [Bool]}
+  | FillText {answFillText :: String
+             ,answCorrectWords :: [String]}
+  | Free {answHeightInMm :: Int,
+          answCorrectAnswer :: String}
+  deriving (Show,Typeable)
+
+data Difficulty = Easy | Medium | Hard
+  deriving (Show,Typeable)
+
+$(deriveJSON defaultOptions{fieldLabelModifier = drop 4} ''Answer)
+
+$(deriveJSON defaultOptions{fieldLabelModifier = drop 3} ''Question)
+
+$(deriveJSON defaultOptions ''Difficulty)
+
+mcKey = typeOf $ MultipleChoice [] []
+ftKey = typeOf $ FillText "" []
+fKey =  typeOf $ Free 0 ""
+
+type Templates = [(TypeRep,M.Template)]
+
+selectTemplate
+  :: Templates -> Question -> M.Template
+selectTemplate templates question = fromJust $ lookup (typeOf $ qstAnswer question) templates
+
+compileTesterTemplates :: Templates
+compileTesterTemplates =
+  [(mcKey, compileMustacheTemplate testerMultipleChoiceTemplate)
+  ,(ftKey, compileMustacheTemplate testerMultipleChoiceTemplate)
+  ,(fKey, compileMustacheTemplate testerMultipleChoiceTemplate)]
+
+compileMustacheTemplate :: B.ByteString -> M.Template
+compileMustacheTemplate string =
+  case (M.compileTemplate "" . E.decodeUtf8) string of
+    Left err -> throw $ MustacheException $ show err
+    Right template -> template

src/utilities.hs

@@ -7,7 +7,8 @@ module Utilities
         markdownToHtmlHandout, markdownToPdfHandout, markdownToHtmlPage,
         markdownToPdfPage, writeExampleProject, metaValueAsString, (<++>),
         markNeeded, replaceSuffixWith, writeEmbeddedFiles,
-        getRelativeSupportDir, collectIncludes, DeckerException(..))
+        getRelativeSupportDir, collectIncludes, pandocMakePdf,
+        absoluteIncludePath, DeckerException(..))
        where
 
 import Control.Monad.Loops
@@ -209,11 +210,11 @@ writeIndex out baseUrl decks handouts pages =
                , "subtitle: {{course}} ({{semester}})"
                ,"---"
                ,"# Slide decks"
-               ,unlines $ map makeLink decksLinks
+               ,unlines $ map makeLink $ sort decksLinks
                ,"# Handouts"
-               ,unlines $ map makeLink handoutsLinks
+               ,unlines $ map makeLink $ sort handoutsLinks
                ,"# Supporting Documents"
-               ,unlines $ map makeLink pagesLinks]
+               ,unlines $ map makeLink $ sort pagesLinks]
   where makeLink path = "-    [" ++ takeFileName path ++ "](" ++ path ++ ")"
 
 -- | Decodes an array of YAML files and combines the data into one object.
@@ -311,7 +312,7 @@ readAndPreprocessMarkdown metaData markdownFile =
      let baseDir = takeDirectory markdownFile
      includes <- collectIncludes markdownFile
      pandoc <- readMetaMarkdown markdownFile metaData
-     need (markdownFile : includes)
+     need includes
      liftIO $ processIncludes projectDir baseDir metaData pandoc
 
 -- | Write a markdown file to a HTML file using the page template.
@@ -362,8 +363,7 @@ pandocMakePdf options processed out =
 markdownToHtmlHandout
   :: FilePath -> [FilePath] -> FilePath -> Action ()
 markdownToHtmlHandout markdownFile metaFiles out =
-  do need $ markdownFile : metaFiles
-     metaData <- readMetaData metaFiles
+  do metaData <- readMetaData metaFiles
      pandoc <- readMetaMarkdown markdownFile metaData
      processed <- processPandocHandout "html" pandoc
      supportDir <- getRelativeSupportDir out
@@ -385,8 +385,7 @@ markdownToHtmlHandout markdownFile metaFiles out =
 markdownToPdfHandout
   :: FilePath -> [FilePath] -> FilePath -> Action ()
 markdownToPdfHandout markdownFile metaFiles out =
-  do need $ markdownFile : metaFiles
-     metaData <- readMetaData metaFiles
+  do metaData <- readMetaData metaFiles
      pandoc <- readMetaMarkdown markdownFile metaData
      processed <- processPandocHandout "latex" pandoc
      let options =
@@ -436,17 +435,17 @@ collectIncludes markdownFile =
 collectIncludesIO :: FilePath -> FilePath -> IO [FilePath]
 collectIncludesIO rootDir markdownFile =
   do markdown <- readFile markdownFile
-     let pandoc =
+     let Pandoc _ blocks =
            case readMarkdown def markdown of
              Right p -> p
              Left e -> throw $ PandocException (show e)
      let baseDir = takeDirectory markdownFile
-     let direct = map (absoluteIncludePath rootDir baseDir) (Text.Pandoc.Walk.query include pandoc)
+     let direct = map (absoluteIncludePath rootDir baseDir) (foldl include [] blocks)
      transitive <- mapM (collectIncludesIO rootDir) direct
      return $ direct ++ concat transitive
-  where include :: Block -> [FilePath]
-        include (Para [Image _ [Str "#include"] (url,_)]) = [url]
-        include _ = []
+  where include :: [FilePath] -> Block -> [FilePath]
+        include result (Para [Image _ [Str "#include"] (url,_)]) = url : result
+        include result _ = result
 
 -- Transitively splices all include files into the pandoc document.
 processIncludes :: FilePath -> FilePath -> Y.Value -> Pandoc -> IO Pandoc
@@ -556,7 +555,7 @@ data DeckerException
   | YamlException String
   | RsyncUrlException
   | DecktapeException String
-  deriving (((Typeable)))
+  deriving Typeable
 
 instance Exception DeckerException