diff --git a/app/Clean.hs b/app/Clean.hs
new file mode 100644
index 0000000..fcb5f71
--- /dev/null
+++ b/app/Clean.hs
@@ -0,0 +1,21 @@
+#!/usr/bin/env runhaskell
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import Text.Pandoc.JSON
+import Control.Exception
+import Data.Monoid ((<>))
+import Data.List (partition, isInfixOf)
+
+main :: IO ()
+main = toJSONFilter clean
+
+clean :: Block -> [Block]
+clean (Plain []) = []
+clean (Para []) = []
+clean (LineBlock []) = []
+clean (BlockQuote []) = []
+clean (OrderedList _ []) = []
+clean (BulletList []) = []
+clean (DefinitionList []) = []
+clean x = [x]
+
diff --git a/app/Quiz.hs b/app/Quiz.hs
index e2a71c8..c4687bb 100644
--- a/app/Quiz.hs
+++ b/app/Quiz.hs
@@ -2,90 +2,46 @@
{-# LANGUAGE ScopedTypeVariables #-}
import Text.Pandoc.JSON
+import Text.Pandoc.Walk
import Control.Exception
import Data.Monoid ((<>))
import Data.List (partition)
main :: IO ()
-main = toJSONFilter media
+main = toJSONFilter quizLift
-media :: Inline -> IO [Inline]
-media (Image ("audio",att,att') [] (filename,_)) = return $ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
-media (Image ("audio",att,att') alt (filename,_)) = return $ [toHtml $ ""]
- ++ [toHtml $ ""]
- ++ alt
- ++ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
---no description of video
-media (Image ("video", att, att') [] (filename,_)) = return $ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
---with description of video
-media (Image ("video", att, att') alt (filename,_)) = return $ [toHtml $ ""]
- ++ [toHtml $ ""]
- ++ [toHtml $ ""]
- ++ alt
- ++ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
---no description of image
-media (Image ("img", att, att') [] (filename,_)) = return $ [toHtml $ ""]
- ++ [toHtml $ "![]()
unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> ">"]
- ++ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
---with description of image
-media (Image ("img", att, att') alt (filename,_)) = return $ [toHtml $ ""]
- ++ [toHtml $ "![]()
unwords direct <> " src=\"" <> filename <> "\"" <> attToString ("",css,att') <> ">"]
- ++ [toHtml $ ""]
- ++ alt
- ++ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
-media (Image ("svg", att, att') [] (filename,_)) = handle (\(fileerror :: IOException) -> return [toHtml $ "Could not read file: " <> filename <> "
" <> show fileerror]) $
- do
- svg <- readFile filename
- return $ [toHtml $ " unwords direct <> " " <> attToString ("", css, att') <> ">"] -- use attributes on figure, as svg gets dumped in..
- ++ [toHtml $ svg]
- ++ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
-media (Image ("svg", att, att') alt (filename,_)) = handle (\(fileerror :: IOException) -> return $ [toHtml $ "Could not read file: " <> filename <> "
" <> show filename]) $
- do
- svg <- readFile filename
- return $ [toHtml $ " unwords direct <> " " <> attToString ("", css, att') <> ">"] -- use attributes on figure, as svg gets dumped in..
- ++ [toHtml $ svg]
- ++ [toHtml $ ""]
- ++ alt
- ++ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
-media (Image ("demo", att, att') [] (filename,_)) = return $ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
-media (Image ("demo", att, att') alt (filename,_)) = return $ [toHtml $ ""]
- ++ [toHtml $ ""]
- ++ [toHtml $ ""]
- ++ alt
- ++ [toHtml $ ""]
- where
- (direct, css) = classToPlain att
+quizLift :: Block -> [Block]
+quizLift pb@(Plain b) = fmap makeQuiz (query findQuiz pb) ++ [Plain (filter ((==) [] . findQuiz) b)]
+quizLift pb@(Para b) = fmap makeQuiz (query findQuiz pb) ++ [Plain (filter ((==) [] . findQuiz) b)]
+quizLift x = [x]
-media x = return [x]
+
+findQuiz :: Inline -> [(Attr, [Inline], Maybe [Inline])]
+findQuiz (Span attributes@(id, att, att') answerText)
+ | "answer" `elem` att = [(attributes, answerText, Nothing)]
+findQuiz (Link attributes@(id, att, att') answerText (tooltip,_))
+ | "answer" `elem` att = [(attributes, answerText, Just [toHtml tooltip])]
+findQuiz x = []
+
+makeQuiz :: (Attr, [Inline], Maybe [Inline]) -> Block
+makeQuiz (att, answer, Nothing) = Div att [Plain answer]
+makeQuiz (att, answer, Just tooltip) = Div att [Plain answer, Div ("",["tooltip"],[]) [Plain tooltip]]
+
+-- quiz :: Inline -> [Inline]
+-- quiz (Span attributes@(id, att, att') answerText)
+-- | "answer" `elem` att = [toHtml $ " attToString attributes <> ">"]
+-- ++ answerText
+-- ++ [toHtml $ "
"]
+-- quiz (Link attributes@(id, att, att') answerText (tooltip,_))
+-- | "answer" `elem` att = [toHtml $ " attToString attributes <> ">"]
+-- ++ answerText
+-- ++ [toHtml $ "
" <> tooltip <> "
"]
+-- ++ [toHtml $ "