found solution for quiz

This commit is contained in:
Nicole Dresselhaus 2017-07-27 11:55:07 +02:00
parent c9b495d410
commit 5fabc0aae9
Signed by: Drezil
GPG Key ID: 057D94F356F41E25

View File

@ -6,42 +6,36 @@ import Text.Pandoc.Walk
import Control.Exception
import Data.Monoid ((<>))
import Data.List (partition)
import Data.Maybe (isNothing, mapMaybe, listToMaybe)
main :: IO ()
main = toJSONFilter quizLift
-- Move bottom-Up through the structure, find quiz-answers and remove the
-- incorrect formattet ones from the Block they came from.
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]
findQuiz :: Inline -> [(Attr, [Inline], Maybe [Inline])]
-- If we have []{.answer} then we have a quiz-answer
-- maybe with a tooltip
findQuiz :: Inline -> [(Attr, [Inline], Maybe ([Inline],Attr))]
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])]
| "answer" `elem` att = [(attributes, answerText', tooltip)]
where
answerText' = filter (isNothing . findTooltip) answerText --filter everything that is a tooltip
tooltip = listToMaybe $ mapMaybe findTooltip answerText --get the first span that is labled tooltip
findQuiz x = []
makeQuiz :: (Attr, [Inline], Maybe [Inline]) -> Block
-- If we have []{.tooltip} we have a tooltip ;)
-- we save the text and the attributes in a tuple
findTooltip :: Inline -> Maybe ([Inline],Attr)
findTooltip (Span attr@(_,att,_) tooltipText)
| "tooltip" `elem` att = Just (tooltipText, attr)
findTooltip _ = Nothing
-- Generate Divs for the quiz
makeQuiz :: (Attr, [Inline], Maybe ([Inline],Attr)) -> 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 $ "<div " <> attToString attributes <> ">"]
-- ++ answerText
-- ++ [toHtml $ "</div>"]
-- quiz (Link attributes@(id, att, att') answerText (tooltip,_))
-- | "answer" `elem` att = [toHtml $ "<div " <> attToString attributes <> ">"]
-- ++ answerText
-- ++ [toHtml $ "<div class=\"tooltip\">" <> tooltip <> "</div>"]
-- ++ [toHtml $ "</div>"]
-- quiz x = [x]
attToString :: Attr -> String
attToString (ident, classes, kvpairs) = ident <> " class=\"" <> unwords classes <> "\" " <> unwords ((\(k,v) -> k <> "=\"" <> v <> "\"") <$> kvpairs)
toHtml :: String -> Inline
toHtml = RawInline (Format "html")
makeQuiz (att, answer, Just (tooltip,a)) = Div att [Plain answer, Div a [Plain tooltip]]