pandoc-md-slides 1.0.0.0 → 1.1.0.0
raw patch · 4 files changed
+238/−45 lines, 4 files
Files
- CHANGELOG.md +17/−0
- README.md +80/−5
- app/Pandoc-filter.hs +137/−38
- pandoc-md-slides.cabal +4/−2
CHANGELOG.md view
@@ -12,3 +12,20 @@ - changed source dir (`-s`) and output dir (`-o`) into optional named arguments - added optional arguments slide lines (`-l`) and line width (`-w`) to configure slide split behavior++## 1.0.0.1 -- 2025-09-16++- fixed issue where last slide is not affected by split filter++## 1.0.0.2 -- 2025-09-16++- change slide title from h1 to h2++## 1.0.0.3 -- 2025-09-16++- fixed issue where `-o` argument is read as `-s` in the filter.++## 1.1.0.0 -- 2025-09-18++- add option for external configuration through `slides.yaml`,+- add new configuration options through `slides.yaml`, `unOrphanDisplayBlocks`, `keptSentences`
README.md view
@@ -103,7 +103,7 @@ ``` ```markdown-# Header+## Header - item1 - item2@@ -114,7 +114,7 @@ --- -# Header+## Header - item7 - item8@@ -123,7 +123,7 @@ --- -# Header+## Header - item11 - item12@@ -153,7 +153,7 @@ ``` ```markdown-# Header+## Header $$ \begin{aligned}@@ -166,7 +166,7 @@ --- -# Header+## Header $$ \begin{aligned}@@ -208,3 +208,78 @@ -t markdown-simple_tables-multiline_tables-grid_tables \ -o $(OUTPUT) ```++## Extra configuration options++You can optionally create a `slides.yaml` in the directory you are running the filter.+This file can contain your configuration for `maxSlideLines`, `maxLineWidth`, `sourceDirectory`, `outputDirectory`.+Program arguments applied to the filter will override the yaml configuration.++It also contains the following extra configurations that are currently only possible through `slides.yaml`:++### `keptSentences`++This is a list of strings that will be converted to a list of predicates that will be used to choose which sentences are kept in the `Para` to `BulletList` transformation.+Predicates that are available are:++- `all`: matches sentences+- `important`: matches sentences that contain either `Strong` or `Emph`. This is the default behavior if `keptSentences` is not used.+- `code`: matches sentences that contain inline `Code`+- `math`: matches sentences that contain inline `Math`+- `lastColon`: matches sentences that are positioned last in the paragraph and ends with `:`.+- `none`: overrides the default, and matches no sentence.+- `1`,`2`, `3` ...: matches the first, second, third or nth sentence++You can include multiple predicates. +These predicates will be combined through disjunction.++``` yaml+keptSentences:+ - code+ - math+ - important+```++Note that, for `none` to properly function as a predicate, there must be no other predicates added to the list.++### `unOrphanDisplayBlocks`++This is a boolean option when enabled, will use an optional transformation (applied last) that is applied on pairs of slides with the following characteristics:++- The first slide contains a plain `BulletList`.+- The last item in the `BulletList` is a sentence that ends with `:`.+- The second slide contains a DisplayBlock (`DisplayMath`, `CodeBlock`, `Figure`, `Table`, `BulletList`, `OrderedList`).++When this transformation is applied the last item from the first slide's list is transferred to the second slide.++Below we can see an example of this transformation applied after the other transformations.++```markdown+## Variables++- Apply universal instantiation to $\forall X q(X)$:++## Variables++$$+\begin{aligned}+q(a) \land \\+\neg q(a)+\end{aligned}+$$+```++```markdown+## Variables++- Apply universal instantiation to $\forall X q(X)$:++$$+\begin{aligned}+q(a) \land \\+\neg q(a)+\end{aligned}+$$+```++When enabling this option, you can make sure that colon ending sentences are kept by adding the `lastColon` predicate in `keptSentences`.
app/Pandoc-filter.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, PatternSynonyms #-}+{-# LANGUAGE OverloadedStrings, PatternSynonyms, ViewPatterns, DeriveGeneric #-} import Text.Pandoc.JSON import Text.Pandoc.Walk (walk, walkM)@@ -17,13 +17,13 @@ , stripStart ) import Text.Regex.Pcre2 (gsub, match, sub)--- import Debug.Trace (trace, traceM) import Data.Maybe (fromMaybe, listToMaybe) import Path (Path, Abs, Dir, File, toFilePath) import Path.IO (resolveDir', resolveFile) import System.FilePath (splitDirectories, (</>)) import System.Environment (withArgs) import Data.List (isSuffixOf)+import Debug.Trace (trace) import Options.Applicative ( Parser , strOption@@ -41,14 +41,25 @@ , auto , option , (<**>) )+import GHC.Generics (Generic)+import Data.Aeson (FromJSON)+import Data.Yaml (decodeFileEither, ParseException)+import Text.Read (readMaybe) data FilterArgs = FilterArgs- { sourceDirArg :: Maybe String- , outputDirArg :: Maybe String+ { sourceDir :: Maybe String+ , outputDir :: Maybe String , slidelinesArg :: Maybe Int , linewidthArg :: Maybe Int } deriving (Show) +data Config = Config+ { maxSlideLines :: Maybe Int+ , maxLineWidth :: Maybe Int+ , keptSentences :: Maybe [String]+ , unOrphanDisplayBlocks :: Maybe Bool+ } deriving (Show, Generic)+ argParser :: Parser FilterArgs argParser = FilterArgs <$> optional@@ -83,6 +94,19 @@ pattern SlideSep :: Block pattern SlideSep <- RawBlock (Format "markdown") "---" +isDisplayBlock :: Block -> Bool+isDisplayBlock (OrderedList _ _) = True+isDisplayBlock (BulletList _) = True+isDisplayBlock (Table _ _ _ _ _ _) = True+isDisplayBlock (BlockQuote _) = True+isDisplayBlock (CodeBlock _ _) = True+isDisplayBlock (Para [Math DisplayMath _]) = True+isDisplayBlock (Figure _ _ _) = True+isDisplayBlock _ = False++pattern DisplayBlock :: Block+pattern DisplayBlock <- (isDisplayBlock -> True)+ slideSep :: Block slideSep = RawBlock (Format "markdown") "---" @@ -112,12 +136,63 @@ isImportant (Emph _) = True isImportant _ = False -isImportantSentence :: [Inline] -> Bool-isImportantSentence inlines = any isImportant inlines+isInlineMath :: Inline -> Bool+isInlineMath (Math InlineMath _) = True+isInlineMath _ = False +isInlineCode :: Inline -> Bool+isInlineCode (Code _ _) = True+isInlineCode _ = False++isImportantSentence :: [[Inline]] -> [Inline] -> Bool+isImportantSentence _ inlines = any isImportant inlines++hasInlineMath :: [[Inline]] -> [Inline] -> Bool+hasInlineMath _ inlines = any isInlineMath inlines ++hasInlineCode :: [[Inline]] -> [Inline] -> Bool+hasInlineCode _ inlines = any isInlineCode inlines ++endsWithColon :: [[Inline]] -> [Inline] -> Bool+endsWithColon [] _ = False+endsWithColon _ [] = False+endsWithColon items inlines+ | Data.List.isSuffixOf [inlines] items =+ case (last inlines) of+ (Str text) -> (Data.Text.isSuffixOf (pack ":") text)+ _ -> False+ | otherwise = False++isNthSentence :: Int -> [[Inline]] -> [Inline] -> Bool+isNthSentence n' list' item' = go n' list' item' 0+ where+ go _ [] _ _ = False+ go n (x:xs) item acc+ | (x == item && n == acc) = True+ | otherwise = go n xs item (acc + 1)++keptSentencePredLookup :: String -> ([[Inline]] -> [Inline] -> Bool)+keptSentencePredLookup "important" = isImportantSentence+keptSentencePredLookup "all" = (\_ _ -> True)+keptSentencePredLookup "none" = (\_ _ -> False)+keptSentencePredLookup "math" = hasInlineMath+keptSentencePredLookup "code" = hasInlineCode+keptSentencePredLookup "lastColon" = endsWithColon+keptSentencePredLookup str =+ case (readMaybe str) :: Maybe Int of+ Just int -> isNthSentence int+ Nothing -> (\_ _ -> False)+++predicateDisjunction :: [a -> Bool] -> (a -> Bool)+predicateDisjunction preds = \x -> any (\p -> p x) preds+ endsWithPunctuation :: Inline -> Bool endsWithPunctuation (Str inline) =- (Data.Text.isSuffixOf (pack ".") inline) || (Data.Text.isSuffixOf (pack "!") inline) || (Data.Text.isSuffixOf (pack "?") inline)+ ( (Data.Text.isSuffixOf (pack ".") inline)+ || (Data.Text.isSuffixOf (pack "!") inline)+ || (Data.Text.isSuffixOf (pack "?") inline)+ || (Data.Text.isSuffixOf (pack ":") inline) ) endsWithPunctuation _ = False softBreakInlines :: [Inline] -> [Inline]@@ -131,15 +206,14 @@ softBreakParagraph block = block --replaces paragraphs with a bulletlist of only important sentences-itemize :: Block -> Block-itemize block@(OrderedList _ _) = block-itemize block@(BulletList _) = block-itemize block@(Para [Math DisplayMath _]) = block-itemize (Para inlines) = (BulletList (map (\x -> [Plain x]) importantItems))+itemize :: [[[Inline]] -> [Inline] -> Bool] -> Block -> Block+itemize _ block@(Para [Math DisplayMath _]) = block+itemize predicateList (Para inlines) = (BulletList (map (\x -> [Plain x]) importantItems)) where items = listSplit isSoftBreak inlines- importantItems = filter isImportantSentence items-itemize block = block+ predicate = predicateDisjunction (map (\p -> p items) predicateList)+ importantItems = filter predicate items+itemize _ block = block topDownBlockFilter :: (Block -> Block) -> Pandoc -> Pandoc topDownBlockFilter blockfilter (Pandoc meta blocks) = Pandoc meta (map blockfilter blocks)@@ -196,13 +270,13 @@ zipWith interleave betweeners (oddIndices ls) where betweeners = (map ((fromMaybe defaultHeader) . listToMaybe) (evenIndices ls))- defaultHeader = Header 1 ( "default-headerBlock" , [] , [] ) [ Str "Default" , Space , Str "Header" ]+ defaultHeader = Header 2 ( "default-headerBlock" , [] , [] ) [ Str "Default" , Space , Str "Header" ] -- interleaves a block in between the elements of a list of blocks -- also removes id metadata of headers interleave :: Block -> [Block] -> [Block]-interleave (Header _ (_, classes, kvattrs) inlines) [] = [Header 1 ("", classes, kvattrs) inlines]+interleave (Header _ (_, classes, kvattrs) inlines) [] = [Header 2 ("", classes, kvattrs) inlines] interleave (Header _ (_, classes, kvattrs) inlines) l = concatMap (\x -> [betweener,x]) l- where betweener = (Header 1 ("", classes, kvattrs) inlines)+ where betweener = (Header 2 ("", classes, kvattrs) inlines) interleave betweener l = concatMap (\x -> [betweener,x]) l -- applies combineHeaders list of blocks in the pandoc document@@ -346,7 +420,7 @@ -- replaces latex newlines with {{nl}} maskNewlines :: Text -> Text-maskNewlines mathBlock = replace (pack "\\") (pack "{{nl}}") mathBlock+maskNewlines mathBlock = replace (pack "\\\\") (pack "{{nl}}") mathBlock envs :: [String] envs = ["bmatrix", "matrix", "array"]@@ -523,12 +597,9 @@ -- replace image targets with new paths resolved from -- output directory resolveImagePaths :: Path Abs Dir -> Path Abs Dir -> Inline -> IO Inline-resolveImagePaths inputDir outputDir (Image attr alttext (target, title)) = do- absoluteImagePath <- resolveFile inputDir (unpack target)- -- traceM (show absoluteImagePath)- -- traceM (show outputDir)- -- traceM (show (relatePath outputDir absoluteImagePath))- let newPath = pack (relatePath outputDir absoluteImagePath)+resolveImagePaths inputAbsDir outputAbsDir (Image attr alttext (target, title)) = do+ absoluteImagePath <- resolveFile inputAbsDir (unpack target)+ let newPath = pack (relatePath outputAbsDir absoluteImagePath) return (Image attr alttext (newPath, title)) resolveImagePaths _ _ inline = return inline @@ -541,35 +612,53 @@ Pandoc meta (fromMaybe [] (initSafe blocks)) removeTrailingSep pandoc = pandoc +unOrphanBlocks :: [Block] -> [Block]+unOrphanBlocks (header1@(Header _ _ content1) : blist@(BulletList [items]) : SlideSep : header2@(Header _ _ content2) : dblock@DisplayBlock : SlideSep : rest) | content1 == content2 =+ case (last items) of+ (Plain inlines)+ | endsWithColon [inlines] inlines ->+ case [(init items)] of+ [[]] -> [header2, (Plain inlines), dblock, slideSep] ++ (unOrphanBlocks rest)+ initItems -> [header1, (BulletList initItems), slideSep, header2, (Plain inlines), dblock, slideSep] ++ (unOrphanBlocks rest)+ | otherwise -> [header1, blist, slideSep, header2, dblock, slideSep] ++ (unOrphanBlocks rest)+ _ -> [header1, blist, slideSep, header2, dblock, slideSep] ++ (unOrphanBlocks rest)+unOrphanBlocks (block : rest) = block : (unOrphanBlocks rest)+unOrphanBlocks [] = []+ -- validInt :: String -> Bool -- validInt str = case (readMaybe str :: Maybe Int) of -- Just int -> int > 0 -- Nothing -> False --- the main pandoc filter, returns IO Pandoc because+-- the main pandoc filter, returns IO Pandoc becaus]e -- of absolute path resolution-pandocFilterWithArgs :: FilterArgs -> Pandoc -> IO Pandoc-pandocFilterWithArgs args (Pandoc meta blocks) = do- let beforeSplitFilter =+pandocFilterWithArgs :: (Config, FilterArgs) -> Pandoc -> IO Pandoc+pandocFilterWithArgs (config, args) (Pandoc meta blocks) = do+ let slidelines = case (slidelinesArg args) of+ Just l -> l+ Nothing -> fromMaybe 6 (maxSlideLines config)+ let linewidth = case (linewidthArg args) of+ Just w -> w+ Nothing -> fromMaybe 100 (maxLineWidth config)+ let keptSentencesPredicates = map keptSentencePredLookup (fromMaybe ["important"] (keptSentences config))+ let optionalFilter = case (fromMaybe False (unOrphanDisplayBlocks config)) of+ True -> topDownBlockListFilter unOrphanBlocks+ False -> id+ let combinedFilter = removeTrailingSep+ . optionalFilter+ . (topDownBlockListFilter (split slidelines linewidth)) . walk dropNotes . topDownBlockFilter maskMath . topDownBlockListFilter sectionToSlides . insertHeaders . walk (concatMap dropStrayHRule) . walk (concatMap dropEmptyList)- . topDownBlockFilter itemize+ . topDownBlockFilter (itemize keptSentencesPredicates) . topDownBlockFilter normalizedAlignment . topDownBlockFilter stripIndentMath . topDownBlockFilter softBreakParagraph- let slidelines = case (slidelinesArg args) of- Just l -> l- Nothing -> 6- let linewidth = case (linewidthArg args) of- Just w -> w- Nothing -> 100- let combinedFilter = (topDownBlockListFilter (split slidelines linewidth)) . beforeSplitFilter- case (sourceDirArg args, sourceDirArg args) of+ case (sourceDir args, outputDir args) of (Just inputPathStr, Just outputPathStr) -> do inputPathAbs <- resolveDir' inputPathStr outputPathAbs <- resolveDir' outputPathStr@@ -577,10 +666,20 @@ return (combinedFilter (Pandoc meta replacedPathsBlocks)) _ -> return (combinedFilter (Pandoc meta blocks)) +instance FromJSON Config+ main :: IO () main = do+ decodeResult <- decodeFileEither "slides.yaml" :: IO (Either ParseException Config)+ config <- case decodeResult of+ Left _ -> pure (Config+ { maxSlideLines = Nothing+ , maxLineWidth = Nothing+ , keptSentences = Nothing+ , unOrphanDisplayBlocks = Nothing })+ Right c -> pure c args <- execParser opts- withArgs [] $ toJSONFilter (pandocFilterWithArgs args)+ withArgs [] $ toJSONFilter (pandocFilterWithArgs (config, args)) where opts = info (argParser <**> helper) ( fullDesc
pandoc-md-slides.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.16 name: pandoc-md-slides-version: 1.0.0.0+version: 1.1.0.0 synopsis: A pandoc filter to convert markdown notes to markdown slides description: A pandoc filter to convert markdown notes to markdown slides. Splits long slides and resolves image target paths license: MIT@@ -30,7 +30,9 @@ path ^>=0.9.6, path-io ^>=1.8.2, filepath ^>=1.5.5,- optparse-applicative ^>= 0.19.0+ optparse-applicative ^>= 0.19.0,+ aeson ^>= 2.3.2,+ yaml ^>= 0.11.11 hs-source-dirs: app default-language: Haskell2010