From 2d29af0efbdf56242b8b7ebe2eb4441e7211a001 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 11 Feb 2024 22:27:28 -0800 Subject: [PATCH] Updates for latest djoths. --- cabal.project | 2 +- src/Text/Pandoc/Readers/Djot.hs | 9 ++++--- src/Text/Pandoc/Writers/Djot.hs | 48 ++++++++++++++++++--------------- stack.yaml | 2 +- 4 files changed, 33 insertions(+), 28 deletions(-) diff --git a/cabal.project b/cabal.project index 98825dbef232b..29cbd7cc6ebe1 100644 --- a/cabal.project +++ b/cabal.project @@ -27,4 +27,4 @@ source-repository-package source-repository-package type: git location: https://github.com/jgm/djoths - tag: 4c151bf0a690bd75bd5e17d19169029c8e41b121 + tag: 3d53e40442d22726430b6a89bfb7fba92cd99a91 diff --git a/src/Text/Pandoc/Readers/Djot.hs b/src/Text/Pandoc/Readers/Djot.hs index 54271aacc9094..b9d5674ba0ded 100644 --- a/src/Text/Pandoc/Readers/Djot.hs +++ b/src/Text/Pandoc/Readers/Djot.hs @@ -27,7 +27,7 @@ import Text.Pandoc.Options import Text.Pandoc.Definition import Text.Pandoc.Shared (addPandocAttributes, tshow) import qualified Text.Pandoc.UTF8 as UTF8 -import Djot (ParseOptions(..), parseDoc) +import Djot (ParseOptions(..), SourcePosOption(..), parseDoc) import qualified Djot.AST as D import Text.Pandoc.Error (PandocError(..)) import Control.Monad.Except (throwError) @@ -45,7 +45,8 @@ import Data.ByteString (ByteString) readDjot :: (PandocMonad m, ToSources a) => ReaderOptions -> a -> m Pandoc readDjot _opts inp = do let sources = toSources inp - case parseDoc ParseOptions (UTF8.fromText $ sourcesToText sources) of + case parseDoc ParseOptions{ sourcePositions = NoSourcePos } + (UTF8.fromText $ sourcesToText sources) of Left e -> throwError $ PandocParseError $ T.pack $ show e Right d -> runReaderT (doc <$> convertBlocks (D.docBlocks d)) @@ -61,7 +62,7 @@ convertBlocks :: PandocMonad m => D.Blocks -> ReaderT Env m Blocks convertBlocks = fmap mconcat . mapM convertBlock . F.toList . D.unMany convertBlock :: PandocMonad m => D.Node D.Block -> ReaderT Env m Blocks -convertBlock (D.Node attr bl) = addAttrToBlock attr <$> +convertBlock (D.Node _pos attr bl) = addAttrToBlock attr <$> case bl of D.Para ils -> para <$> convertInlines ils D.Section bls -> divWith ("",["section"],[]) <$> convertBlocks bls @@ -162,7 +163,7 @@ convertInlines :: PandocMonad m => D.Inlines -> ReaderT Env m Inlines convertInlines = fmap mconcat . mapM convertInline . F.toList . D.unMany convertInline :: PandocMonad m => D.Node D.Inline -> ReaderT Env m Inlines -convertInline (D.Node attr il) = addAttrToInline attr <$> +convertInline (D.Node _pos attr il) = addAttrToInline attr <$> case il of D.Str bs -> pure $ str (UTF8.toText bs) D.Emph ils -> emph <$> convertInlines ils diff --git a/src/Text/Pandoc/Writers/Djot.hs b/src/Text/Pandoc/Writers/Djot.hs index b28f5a4451203..01c8951db5d7e 100644 --- a/src/Text/Pandoc/Writers/Djot.hs +++ b/src/Text/Pandoc/Writers/Djot.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {- | Module : Text.Pandoc.Writers.Djot @@ -94,12 +93,12 @@ blockToDjot (LineBlock ls) = blockToDjot (CodeBlock attr@(_,_,kvs) t) = do let lang = fromMaybe mempty $ lookup "lang" kvs pure $ D.addAttr (toDjotAttr attr) - $ D.codeBlock (fromText lang) (fromText t) + <$> D.codeBlock (fromText lang) (fromText t) blockToDjot (RawBlock (Format f) t) = pure $ D.rawBlock (D.Format (fromText f)) (fromText t) blockToDjot (BlockQuote bls) = D.blockQuote <$> blocksToDjot bls blockToDjot (Header lev attr ils) = - D.addAttr (toDjotAttr attr) . D.heading lev <$> inlinesToDjot ils + fmap (D.addAttr (toDjotAttr attr)) . D.heading lev <$> inlinesToDjot ils blockToDjot HorizontalRule = pure D.thematicBreak blockToDjot (Div (ident,"section":cls,kvs) bls@(Header _ _ ils : _)) = do ilsBs <- D.inlinesToByteString <$> inlinesToDjot ils @@ -110,16 +109,18 @@ blockToDjot (Div (ident,"section":cls,kvs) bls@(Header _ _ ils : _)) = do modify $ \st -> st{ autoIds = Set.insert ident' (autoIds st) } modify $ \st -> st{ autoReferences = D.insertReference label (B8.cons '#' ident', mempty) (autoReferences st) } - D.addAttr (toDjotAttr (if autoid then "" else ident, + fmap + (D.addAttr (toDjotAttr (if autoid then "" else ident, filter (/= "section") cls, - filter (\(k,_) -> k /= "wrap") kvs)) . D.section + filter (\(k,_) -> k /= "wrap") kvs))) . D.section <$> blocksToDjot bls blockToDjot (Div attr@(ident,cls,kvs) bls) | Just "1" <- lookup "wrap" kvs - = D.addAttr (toDjotAttr (ident,cls,filter (\(k,_) -> k /= "wrap") kvs)) + = fmap (D.addAttr + (toDjotAttr (ident,cls,filter (\(k,_) -> k /= "wrap") kvs))) <$> blocksToDjot bls | otherwise - = D.addAttr (toDjotAttr attr) . D.div <$> blocksToDjot bls + = fmap (D.addAttr (toDjotAttr attr)) . D.div <$> blocksToDjot bls blockToDjot (BulletList items) = D.bulletList spacing <$> mapM blocksToDjot items where @@ -157,9 +158,9 @@ blockToDjot (DefinitionList items) = pure (term', def') blockToDjot (Figure attr (Caption _ capt) bls) = do content <- blocksToDjot bls - caption <- D.addAttr (D.Attr [("class","caption")]) . D.div <$> + caption <- fmap (D.addAttr (D.Attr [("class","caption")])) . D.div <$> blocksToDjot capt - pure $ D.addAttr (toDjotAttr attr) $ D.div $ content <> caption + pure $ fmap (D.addAttr (toDjotAttr attr)) $ D.div $ content <> caption blockToDjot (Table attr capt' colspecs thead tbodies tfoot) = do let (capt, aligns, _, headRow, bodyRows) = toLegacyTable capt' colspecs thead tbodies tfoot @@ -188,12 +189,12 @@ blockToDjot (Table attr capt' colspecs thead tbodies tfoot) = do caption <- case capt of [] -> pure Nothing _ -> Just . D.Caption . D.para <$> inlinesToDjot capt - pure $ D.addAttr (toDjotAttr attr) $ D.table caption (hrows <> rows) + pure $ D.addAttr (toDjotAttr attr) <$> D.table caption (hrows <> rows) else do -- table can't be represented as a simple pipe table, use list tableList <- D.bulletList D.Loose <$> mapM (fmap (D.bulletList D.Loose) . mapM blocksToDjot) (headRow:bodyRows) - pure $ D.addAttr (D.Attr [("class", "table")]) tableList + pure $ D.addAttr (D.Attr [("class", "table")]) <$> tableList inlinesToDjot :: PandocMonad m => [Inline] -> StateT DjotState m D.Inlines inlinesToDjot = fmap mconcat . mapM inlineToDjot @@ -205,24 +206,27 @@ inlineToDjot SoftBreak = pure D.softBreak inlineToDjot LineBreak = pure D.hardBreak inlineToDjot (Emph ils) = D.emph <$> inlinesToDjot ils inlineToDjot (Underline ils) = - D.addAttr (D.Attr [("class","underline")]) . D.span_ <$> inlinesToDjot ils + fmap (D.addAttr (D.Attr [("class","underline")])) . D.span_ + <$> inlinesToDjot ils inlineToDjot (Strong ils) = D.strong <$> inlinesToDjot ils inlineToDjot (Strikeout ils) = D.delete <$> inlinesToDjot ils inlineToDjot (Subscript ils) = D.subscript <$> inlinesToDjot ils inlineToDjot (Superscript ils) = D.superscript <$> inlinesToDjot ils inlineToDjot (Span attr@(ident,cls,kvs) ils) | Just "1" <- lookup "wrap" kvs - = D.addAttr (toDjotAttr (ident,cls,filter (\(k,_) -> k /= "wrap") kvs)) + = fmap (D.addAttr + (toDjotAttr (ident,cls,filter (\(k,_) -> k /= "wrap") kvs))) <$> inlinesToDjot ils | otherwise - = D.addAttr (toDjotAttr attr) . D.span_ <$> inlinesToDjot ils + = fmap (D.addAttr (toDjotAttr attr)) . D.span_ <$> inlinesToDjot ils inlineToDjot (SmallCaps ils) = - D.addAttr (D.Attr [("class","smallcaps")]) . D.span_ <$> inlinesToDjot ils + fmap (D.addAttr (D.Attr [("class","smallcaps")])) . D.span_ + <$> inlinesToDjot ils inlineToDjot (Quoted DoubleQuote ils) = D.doubleQuoted <$> inlinesToDjot ils inlineToDjot (Quoted SingleQuote ils) = D.singleQuoted <$> inlinesToDjot ils inlineToDjot (Cite _cs ils) = inlinesToDjot ils inlineToDjot (Code attr t) = - pure $ D.addAttr (toDjotAttr attr) $ D.verbatim (fromText t) + pure $ D.addAttr (toDjotAttr attr) <$> D.verbatim (fromText t) inlineToDjot (Math mt t) = pure $ (if mt == InlineMath then D.inlineMath @@ -244,8 +248,8 @@ inlineToDjot (Link attr ils (src,tit)) = do then removeClass "email" else id) $ attr) case () of - _ | autolink -> pure $ D.addAttr attr' $ D.urlLink (fromText ilstring) - | email -> pure $ D.addAttr attr' $ D.emailLink (fromText ilstring) + _ | autolink -> pure $ D.addAttr attr' <$> D.urlLink (fromText ilstring) + | email -> pure $ D.addAttr attr' <$> D.emailLink (fromText ilstring) | writerReferenceLinks opts -> do refs@(D.ReferenceMap m) <- gets references autoRefs <- gets autoReferences @@ -259,9 +263,9 @@ inlineToDjot (Link attr ils (src,tit)) = do D.insertReference lab (fromText src, attr') refs } pure lab - pure $ D.addAttr attr' $ D.link description (D.Reference lab) + pure $ D.addAttr attr' <$> D.link description (D.Reference lab) | otherwise - -> pure $ D.addAttr attr' $ D.link description (D.Direct (fromText src)) + -> pure $ D.addAttr attr' <$> D.link description (D.Direct (fromText src)) inlineToDjot (Image attr ils (src,tit)) = do opts <- gets options description <- inlinesToDjot ils @@ -275,8 +279,8 @@ inlineToDjot (Image attr ils (src,tit)) = do modify $ \st -> st{ references = D.insertReference lab (fromText src, attr') refs } - pure $ D.addAttr attr' $ D.image description (D.Reference lab) - else pure $ D.addAttr attr' $ D.image description (D.Direct (fromText src)) + pure $ D.addAttr attr' <$> D.image description (D.Reference lab) + else pure $ D.addAttr attr' <$> D.image description (D.Direct (fromText src)) inlineToDjot (Note bs) = do notes@(D.NoteMap m) <- gets footnotes let notenum = M.size m + 1 diff --git a/stack.yaml b/stack.yaml index 0948441d6b1f1..b97e673276bf1 100644 --- a/stack.yaml +++ b/stack.yaml @@ -33,7 +33,7 @@ extra-deps: subdirs: [commonmark-pandoc, commonmark-extensions] commit: f0b96532e36f31f47cc34602ecac694ffde8a27a - git: https://github.com/jgm/djoths - commit: 4c151bf0a690bd75bd5e17d19169029c8e41b121 + commit: 3d53e40442d22726430b6a89bfb7fba92cd99a91 ghc-options: "$locals": -fhide-source-paths -Wno-missing-home-modules