Skip to content
Snippets Groups Projects
Commit 08a4d224 authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

tester begins to be useful

parent 82989249
No related branches found
No related tags found
No related merge requests found
......@@ -11,3 +11,5 @@ index.html
*-page.html
.shake
public/
private/
auto/
\ No newline at end of file
......@@ -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"}
......
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"}
......@@ -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
......
......@@ -9,7 +9,6 @@ structured:
- First
- Second
- Third
- Fourth
date: 14.5.2016
csl: chicago-author-date.csl
...
# Aufgabe N: {{Title}}
| | |
|---------------+-------------------|
| Titel | **{{Title}}** |
| Id | {{Id}} |
| Vorlesung | {{Lecture}} |
| Schwierigkeit | {{Difficulty}} |
| Punkte | {{Points}} |
| Kommentar | {{Comment}} |
{{Question}}
{{#Answer.Choices}}
- {{.}}
{{/Answer.Choices}}
\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}
---
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
...
---
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
...
......@@ -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
......
......@@ -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)
{-# 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
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment