From 2a547dddd861dcf790e4a82ccae38fe16e893b9e Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 30 Dec 2024 13:27:00 +0100 Subject: [PATCH] Refactor fromPandocBlock to produce lists --- lib/Patat/Presentation/Display.hs | 6 +- lib/Patat/Presentation/Read.hs | 7 +-- lib/Patat/Presentation/Syntax.hs | 98 ++++++++++++++++--------------- 3 files changed, 57 insertions(+), 54 deletions(-) diff --git a/lib/Patat/Presentation/Display.hs b/lib/Patat/Presentation/Display.hs index b9a3794..ddcd9d7 100644 --- a/lib/Patat/Presentation/Display.hs +++ b/lib/Patat/Presentation/Display.hs @@ -321,9 +321,7 @@ prettyBlock ds (LineBlock inliness) = PP.vcat $ map (prettyInlines ds) inliness -prettyBlock ds (Figure _attr blocks) = - -- TODO: the fromPandoc conversion here is weird - prettyBlocks ds blocks +prettyBlock ds (Figure _attr blocks) = prettyBlocks ds blocks prettyBlock ds (VarBlock var) = prettyBlocks ds $ dsResolve ds var prettyBlock _ (SpeakerNote _) = mempty @@ -388,7 +386,7 @@ prettyInline _ (RawInline _ t) = PP.text t -- These elements aren't really supported. prettyInline ds (Cite _ t) = prettyInlines ds t prettyInline ds (Span _ t) = prettyInlines ds t -prettyInline _ (Note _) = mempty +prettyInline _ (Note _) = mempty -- TODO: support notes? prettyInline ds (Superscript t) = prettyInlines ds t prettyInline ds (Subscript t) = prettyInlines ds t prettyInline ds (SmallCaps t) = prettyInlines ds t diff --git a/lib/Patat/Presentation/Read.hs b/lib/Patat/Presentation/Read.hs index b9b8d60..6fd8422 100644 --- a/lib/Patat/Presentation/Read.hs +++ b/lib/Patat/Presentation/Read.hs @@ -130,12 +130,11 @@ pandocToPresentation pVarGen pFilePath pEncodingFallback pSettings pSyntaxMap pandoc@(Pandoc.Pandoc meta _) = do let !pTitle = case Pandoc.docTitle meta of [] -> [Str . T.pack . snd $ splitFileName pFilePath] - title -> map fromPandocInline title + title -> fromPandocInlines title !pSlides = pandocToSlides pSettings pandoc !pBreadcrumbs = collectBreadcrumbs pSlides !pActiveFragment = (0, 0) - !pAuthor = map fromPandocInline $ - concat $ Pandoc.docAuthors meta + !pAuthor = fromPandocInlines $ concat $ Pandoc.docAuthors meta !pEvalBlocks = mempty !pVars = mempty pSlideSettings <- Seq.traverseWithIndex @@ -208,7 +207,7 @@ readSettings path = do -------------------------------------------------------------------------------- pandocToSlides :: PresentationSettings -> Pandoc.Pandoc -> Seq.Seq Slide pandocToSlides settings (Pandoc.Pandoc _meta pblocks) = - let blocks = map fromPandocBlock pblocks + let blocks = fromPandocBlocks pblocks slideLevel = fromMaybe (detectSlideLevel blocks) (psSlideLevel settings) unfragmented = splitSlides slideLevel blocks fragmented = map fragmentSlide unfragmented in diff --git a/lib/Patat/Presentation/Syntax.hs b/lib/Patat/Presentation/Syntax.hs index 89bca82..9197541 100644 --- a/lib/Patat/Presentation/Syntax.hs +++ b/lib/Patat/Presentation/Syntax.hs @@ -14,8 +14,8 @@ module Patat.Presentation.Syntax , dftBlocks , dftInlines - , fromPandocBlock - , fromPandocInline + , fromPandocBlocks + , fromPandocInlines , isHorizontalRule , isComment @@ -177,73 +177,79 @@ dftInlines fb fi = inlines Note blocks -> Note <$> dftBlocks fb fi blocks Span attr xs -> Span attr . concat <$> traverse inline xs -fromPandocBlock :: Pandoc.Block -> Block -fromPandocBlock (Pandoc.Plain xs) = Plain (map fromPandocInline xs) -fromPandocBlock (Pandoc.Para xs) = Para (map fromPandocInline xs) +fromPandocBlocks :: [Pandoc.Block] -> [Block] +fromPandocBlocks = concatMap fromPandocBlock + +fromPandocBlock :: Pandoc.Block -> [Block] +fromPandocBlock (Pandoc.Plain xs) = [Plain (fromPandocInlines xs)] +fromPandocBlock (Pandoc.Para xs) = [Para (fromPandocInlines xs)] fromPandocBlock (Pandoc.LineBlock xs) = - LineBlock (map (map fromPandocInline) xs) -fromPandocBlock (Pandoc.CodeBlock attrs body) = CodeBlock attrs body + [LineBlock (map fromPandocInlines xs)] +fromPandocBlock (Pandoc.CodeBlock attrs body) = [CodeBlock attrs body] fromPandocBlock (Pandoc.RawBlock fmt body) -- Parse config blocks. | fmt == "html" , Just t1 <- T.stripPrefix "" t1 = Config $ + , Just t2 <- T.stripSuffix "-->" t1 = pure $ Config $ case Yaml.decodeEither' (T.encodeUtf8 t2) of Left err -> Left (show err) Right obj -> Right obj -- Parse other comments. | Just t1 <- T.stripPrefix "" t1 = SpeakerNote $ T.strip t2 + , Just t2 <- T.stripSuffix "-->" t1 = pure $ SpeakerNote $ T.strip t2 -- Other raw blocks, leave as-is. - | otherwise = RawBlock fmt body + | otherwise = [RawBlock fmt body] fromPandocBlock (Pandoc.BlockQuote blocks) = - BlockQuote $ map fromPandocBlock blocks + [BlockQuote $ fromPandocBlocks blocks] fromPandocBlock (Pandoc.OrderedList attrs items) = - OrderedList attrs $ map (map fromPandocBlock) items + [OrderedList attrs $ map fromPandocBlocks items] fromPandocBlock (Pandoc.BulletList items) = - BulletList $ map (map fromPandocBlock) items -fromPandocBlock (Pandoc.DefinitionList items) = DefinitionList $ do + [BulletList $ map fromPandocBlocks items] +fromPandocBlock (Pandoc.DefinitionList items) = pure $ DefinitionList $ do (inlines, blockss) <- items - pure (map fromPandocInline inlines, map (map fromPandocBlock) blockss) + pure (fromPandocInlines inlines, map (fromPandocBlocks) blockss) fromPandocBlock (Pandoc.Header lvl attrs inlines) = - Header lvl attrs (map fromPandocInline inlines) -fromPandocBlock Pandoc.HorizontalRule = HorizontalRule -fromPandocBlock (Pandoc.Table _ caption specs thead tbodies tfoot) = Table - (map fromPandocInline caption') + [Header lvl attrs (fromPandocInlines inlines)] +fromPandocBlock Pandoc.HorizontalRule = [HorizontalRule] +fromPandocBlock (Pandoc.Table _ cptn specs thead tbodies tfoot) = pure $ Table + (fromPandocInlines cptn') aligns - (map (map fromPandocBlock) headers) - (map (map (map fromPandocBlock)) rows) + (map (fromPandocBlocks) headers) + (map (map fromPandocBlocks) rows) where - (caption', aligns, _, headers, rows) = Pandoc.toLegacyTable - caption specs thead tbodies tfoot + (cptn', aligns, _, headers, rows) = Pandoc.toLegacyTable + cptn specs thead tbodies tfoot fromPandocBlock (Pandoc.Figure attrs _caption blocks) = - Figure attrs $ map fromPandocBlock blocks + [Figure attrs $ fromPandocBlocks blocks] fromPandocBlock (Pandoc.Div attrs blocks) = - Div attrs $ map fromPandocBlock blocks + [Div attrs $ fromPandocBlocks blocks] + +fromPandocInlines :: [Pandoc.Inline] -> [Inline] +fromPandocInlines = concatMap fromPandocInline -fromPandocInline :: Pandoc.Inline -> Inline +fromPandocInline :: Pandoc.Inline -> [Inline] fromPandocInline inline = case inline of - Pandoc.Str txt -> Str txt - Pandoc.Emph xs -> Emph (map fromPandocInline xs) - Pandoc.Underline xs -> Underline (map fromPandocInline xs) - Pandoc.Strong xs -> Strong (map fromPandocInline xs) - Pandoc.Strikeout xs -> Strikeout (map fromPandocInline xs) - Pandoc.Superscript xs -> Superscript (map fromPandocInline xs) - Pandoc.Subscript xs -> Subscript (map fromPandocInline xs) - Pandoc.SmallCaps xs -> SmallCaps (map fromPandocInline xs) - Pandoc.Quoted ty xs -> Quoted ty (map fromPandocInline xs) - Pandoc.Cite c xs -> Cite c (map fromPandocInline xs) - Pandoc.Code attr txt -> Code attr txt - Pandoc.Space -> Space - Pandoc.SoftBreak -> SoftBreak - Pandoc.LineBreak -> LineBreak - Pandoc.Math ty txt -> Math ty txt - Pandoc.RawInline fmt txt -> RawInline fmt txt - Pandoc.Link attr xs tgt -> Link attr (map fromPandocInline xs) tgt - Pandoc.Image attr xs tgt -> Image attr (map fromPandocInline xs) tgt - Pandoc.Note xs -> Note (map fromPandocBlock xs) - Pandoc.Span attr xs -> Span attr (map fromPandocInline xs) + Pandoc.Str txt -> pure $ Str txt + Pandoc.Emph xs -> pure $ Emph (fromPandocInlines xs) + Pandoc.Underline xs -> pure $ Underline (fromPandocInlines xs) + Pandoc.Strong xs -> pure $ Strong (fromPandocInlines xs) + Pandoc.Strikeout xs -> pure $ Strikeout (fromPandocInlines xs) + Pandoc.Superscript xs -> pure $ Superscript (fromPandocInlines xs) + Pandoc.Subscript xs -> pure $ Subscript (fromPandocInlines xs) + Pandoc.SmallCaps xs -> pure $ SmallCaps (fromPandocInlines xs) + Pandoc.Quoted ty xs -> pure $ Quoted ty (fromPandocInlines xs) + Pandoc.Cite c xs -> pure $ Cite c (fromPandocInlines xs) + Pandoc.Code attr txt -> pure $ Code attr txt + Pandoc.Space -> pure $ Space + Pandoc.SoftBreak -> pure $ SoftBreak + Pandoc.LineBreak -> pure $ LineBreak + Pandoc.Math ty txt -> pure $ Math ty txt + Pandoc.RawInline fmt txt -> pure $ RawInline fmt txt + Pandoc.Link attr xs tgt -> pure $ Link attr (fromPandocInlines xs) tgt + Pandoc.Image attr xs tgt -> pure $ Image attr (fromPandocInlines xs) tgt + Pandoc.Note xs -> pure $ Note (fromPandocBlocks xs) + Pandoc.Span attr xs -> pure $ Span attr (fromPandocInlines xs) isHorizontalRule :: Block -> Bool isHorizontalRule HorizontalRule = True