Updates for latest djoths.

jgm · Feb 12, 2024 · 2d29af0 · 2d29af0
1 parent 1220809
commit 2d29af0
Show file tree

Hide file tree

Showing 4 changed files with 33 additions and 28 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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