diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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`. diff --git a/app/Pandoc-filter.hs b/app/Pandoc-filter.hs --- a/app/Pandoc-filter.hs +++ b/app/Pandoc-filter.hs @@ -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 diff --git a/pandoc-md-slides.cabal b/pandoc-md-slides.cabal --- a/pandoc-md-slides.cabal +++ b/pandoc-md-slides.cabal @@ -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