found solution for quiz
This commit is contained in:
parent
c9b495d410
commit
5fabc0aae9
46
app/Quiz.hs
46
app/Quiz.hs
@ -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]]
|
||||
|
Loading…
Reference in New Issue
Block a user