aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Extensions.hs1
-rw-r--r--src/Text/Pandoc/Format.hs1
-rw-r--r--src/Text/Pandoc/Readers.hs4
-rw-r--r--src/Text/Pandoc/Readers/Djot.hs274
-rw-r--r--src/Text/Pandoc/Writers.hs3
-rw-r--r--src/Text/Pandoc/Writers/Djot.hs296
6 files changed, 578 insertions, 1 deletions
diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs
index 22e7cc845..c23f6f1f8 100644
--- a/src/Text/Pandoc/Extensions.hs
+++ b/src/Text/Pandoc/Extensions.hs
@@ -654,4 +654,5 @@ getAllExtensions f = universalExtensions <> getAll f
extensionsFromList
[ Ext_smart ]
getAll "typst" = extensionsFromList [Ext_citations]
+ getAll "djot" = extensionsFromList [Ext_sourcepos]
getAll _ = mempty
diff --git a/src/Text/Pandoc/Format.hs b/src/Text/Pandoc/Format.hs
index 5f9459e3e..96f905b35 100644
--- a/src/Text/Pandoc/Format.hs
+++ b/src/Text/Pandoc/Format.hs
@@ -179,6 +179,7 @@ formatFromFilePath x =
".csv" -> defFlavor "csv"
".ctx" -> defFlavor "context"
".db" -> defFlavor "docbook"
+ ".dj" -> defFlavor "djot"
".doc" -> defFlavor "doc" -- so we get an "unknown reader" error
".docx" -> defFlavor "docx"
".dokuwiki" -> defFlavor "dokuwiki"
diff --git a/src/Text/Pandoc/Readers.hs b/src/Text/Pandoc/Readers.hs
index 1b7be5163..83f0d3c2e 100644
--- a/src/Text/Pandoc/Readers.hs
+++ b/src/Text/Pandoc/Readers.hs
@@ -112,6 +112,7 @@ import Text.Pandoc.Readers.EndNote
import Text.Pandoc.Readers.RIS
import Text.Pandoc.Readers.RTF
import Text.Pandoc.Readers.Typst
+import Text.Pandoc.Readers.Djot
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Sources (ToSources(..), sourcesToText)
@@ -165,7 +166,8 @@ readers = [("native" , TextReader readNative)
,("ris" , TextReader readRIS)
,("rtf" , TextReader readRTF)
,("typst" , TextReader readTypst)
- ]
+ ,("djot" , TextReader readDjot)
+ ]
-- | Retrieve reader, extensions based on format spec (format+extensions).
getReader :: PandocMonad m => Format.FlavoredFormat -> m (Reader m, Extensions)
diff --git a/src/Text/Pandoc/Readers/Djot.hs b/src/Text/Pandoc/Readers/Djot.hs
new file mode 100644
index 000000000..6cb67f41e
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Djot.hs
@@ -0,0 +1,274 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- |
+ Module : Text.Pandoc.Readers.Djot
+ Copyright : Copyright (C) 2024 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <[email protected]>
+ Stability : alpha
+ Portability : portable
+
+Reads and evaluates a Djot document as a Pandoc AST.
+-}
+module Text.Pandoc.Readers.Djot
+ ( readDjot
+ )
+where
+
+import Text.Pandoc.Class
+import Text.Pandoc.Sources
+import Text.Parsec.Pos (newPos)
+import Text.Pandoc.Options
+import Text.Pandoc.Definition
+import Text.Pandoc.Shared (addPandocAttributes, tshow)
+import qualified Text.Pandoc.UTF8 as UTF8
+import Djot (ParseOptions(..), SourcePosOption(..), parseDoc, Pos(..))
+import qualified Djot.AST as D
+import Text.Pandoc.Error (PandocError(..))
+import Control.Monad.Except (throwError)
+import qualified Data.Text as T
+import Text.Pandoc.Builder
+import Text.Pandoc.Logging
+import Text.Pandoc.Emoji (emojiToInline)
+import Control.Monad.Reader
+import qualified Data.Foldable as F
+import Data.List (foldl')
+import Data.ByteString (ByteString)
+-- import Debug.Trace
+
+-- | Read Djot from an input string and return a Pandoc document.
+readDjot :: (PandocMonad m, ToSources a) => ReaderOptions -> a -> m Pandoc
+readDjot opts inp = do
+ let sources = toSources inp
+ case parseDoc ParseOptions{ sourcePositions =
+ if isEnabled Ext_sourcepos opts
+ then AllSourcePos
+ else NoSourcePos }
+ (UTF8.fromText $ sourcesToText sources) of
+ Left e -> throwError $ PandocParseError $ T.pack $ show e
+ Right d ->
+ runReaderT (doc <$> convertBlocks (D.docBlocks d))
+ Env{ references = D.docReferences d <> D.docAutoReferences d
+ , footnotes = D.docFootnotes d
+ }
+
+data Env =
+ Env{ references :: D.ReferenceMap
+ , footnotes :: D.NoteMap
+ }
+ deriving (Show, Ord, Eq)
+
+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 pos attr bl) = addAttrToBlock pos attr <$>
+ case bl of
+ D.Para ils -> para <$> convertInlines ils
+ D.Section bls -> divWith ("",["section"],[]) <$> convertBlocks bls
+ D.Heading lev ils -> header lev <$> convertInlines ils
+ D.BlockQuote bls -> blockQuote <$> convertBlocks bls
+ D.CodeBlock lang bs -> pure $
+ codeBlockWith ("", [UTF8.toText lang], []) $ UTF8.toText bs
+ D.Div bls -> divWith nullAttr <$> convertBlocks bls
+ D.OrderedList olattr listSpacing items ->
+ orderedListWith olattr' .
+ (case listSpacing of
+ D.Tight -> map toTight
+ D.Loose -> id) <$> mapM convertBlocks items
+ where
+ olattr' = ( D.orderedListStart olattr
+ , case D.orderedListStyle olattr of
+ D.Decimal -> Decimal
+ D.LetterUpper -> UpperAlpha
+ D.LetterLower -> LowerAlpha
+ D.RomanUpper -> UpperRoman
+ D.RomanLower -> LowerRoman
+ , case D.orderedListDelim olattr of
+ D.RightPeriod -> Period
+ D.RightParen -> OneParen
+ D.LeftRightParen -> TwoParens
+ )
+ D.BulletList listSpacing items ->
+ bulletList .
+ (case listSpacing of
+ D.Tight -> map toTight
+ D.Loose -> id) <$> mapM convertBlocks items
+ D.TaskList listSpacing items ->
+ bulletList .
+ (case listSpacing of
+ D.Tight -> map toTight
+ D.Loose -> id) <$> mapM toTaskListItem items
+ D.DefinitionList listSpacing items ->
+ definitionList .
+ (case listSpacing of
+ D.Tight -> map (\(t,d) -> (t, map toTight d))
+ D.Loose -> id) <$> mapM toDlItem items
+ where
+ toDlItem (ils,bls) = (,) <$> convertInlines ils
+ <*> ((:[]) <$> convertBlocks bls)
+ D.ThematicBreak -> pure horizontalRule
+ D.Table mbCaption rows -> do
+ capt <- case mbCaption of
+ Just (D.Caption bls') ->
+ Caption Nothing . toList <$> convertBlocks bls'
+ Nothing -> pure $ Caption Nothing mempty
+ let toAlign D.AlignLeft = AlignLeft
+ toAlign D.AlignRight = AlignRight
+ toAlign D.AlignCenter = AlignCenter
+ toAlign D.AlignDefault = AlignDefault
+ let toColSpec (D.Cell _ align _) = (toAlign align, ColWidthDefault)
+ let colspecs = case rows of
+ [] -> []
+ (cells:_) -> map toColSpec cells
+ let (headrow, rest) =
+ case rows of
+ (r@(D.Cell D.HeadCell _ _ : _) : rs) -> (r, rs)
+ _ -> ([],rows)
+ let getBody bods row =
+ case row of
+ (D.Cell D.HeadCell _ _ : _) ->
+ case bods of
+ [] -> [([row],[])]
+ ([],_):_ -> (([row],[]):bods)
+ (hs,bs):rs -> (hs,row:bs):rs
+ _ -> case bods of
+ (hs,bs):rs -> (hs,row:bs):rs
+ [] -> [([],[row])]
+ let reverseSnd (as,bs) = (as,reverse bs)
+ let bodies = reverse $ map reverseSnd $ foldl' getBody [] rest
+ let toCell (D.Cell _ al ils) =
+ Cell nullAttr (toAlign al) (RowSpan 1) (ColSpan 1)
+ . (\is -> [Para $ toList is]) <$> convertInlines ils
+ let toRow = fmap (Row nullAttr) . mapM toCell
+ thead <- TableHead mempty <$> mapM toRow [headrow]
+ let toTableBody (hs, rs) =
+ TableBody mempty (RowHeadColumns 0) <$>
+ mapM toRow hs <*> mapM toRow rs
+ tbodies <- mapM toTableBody bodies
+ let tfoot = TableFoot mempty []
+ pure $ singleton $ Table mempty capt colspecs thead tbodies tfoot
+ D.RawBlock (D.Format fmt) bs -> pure $
+ rawBlock (UTF8.toText fmt) (UTF8.toText bs)
+
+addAttrToBlock :: Pos -> D.Attr -> Blocks -> Blocks
+addAttrToBlock pos (D.Attr as) =
+ addPandocAttributes $
+ case pos of
+ NoPos -> textkvs
+ Pos sl sc el ec ->
+ ("data-pos", tshow sl <> ":" <> tshow sc <>
+ "-" <> tshow el <> ":" <> tshow ec) : textkvs
+ where
+ textkvs = (map (\(k,v) -> (UTF8.toText k, UTF8.toText v))
+ (filter (not . internalAttribute) as))
+
+addAttrToInline :: Pos -> D.Attr -> Inlines -> Inlines
+addAttrToInline pos (D.Attr as) =
+ addPandocAttributes $
+ case pos of
+ NoPos -> textkvs
+ Pos sl sc el ec ->
+ ("data-pos", tshow sl <> ":" <> tshow sc <>
+ "-" <> tshow el <> ":" <> tshow ec) : textkvs
+ where
+ textkvs = (map (\(k,v) -> (UTF8.toText k, UTF8.toText v))
+ (filter (not . internalAttribute) as))
+
+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 pos attr il) = addAttrToInline pos attr <$>
+ case il of
+ D.Str bs -> pure $ str (UTF8.toText bs)
+ D.Emph ils -> emph <$> convertInlines ils
+ D.Strong ils -> strong <$> convertInlines ils
+ D.Highlight ils -> spanWith ("",["highlighted"],[]) <$> convertInlines ils
+ D.Insert ils -> spanWith ("",["inserted"],[]) <$> convertInlines ils
+ D.Delete ils -> spanWith ("",["deleted"],[]) <$> convertInlines ils
+ D.Subscript ils -> subscript <$> convertInlines ils
+ D.Superscript ils -> superscript <$> convertInlines ils
+ D.Span ils -> spanWith nullAttr <$> convertInlines ils
+ D.Quoted D.DoubleQuotes ils -> doubleQuoted <$> convertInlines ils
+ D.Quoted D.SingleQuotes ils -> singleQuoted <$> convertInlines ils
+ D.Verbatim bs -> pure $ code (UTF8.toText bs)
+ D.Symbol bs -> pure $
+ let s = UTF8.toText bs
+ in maybe (spanWith ("",["symbol"],[]) (str s)) singleton $ emojiToInline s
+ D.Math sty bs -> pure $
+ (case sty of
+ D.DisplayMath -> displayMath
+ D.InlineMath -> math) (UTF8.toText bs)
+ D.Link ils target ->
+ case target of
+ D.Direct url -> link (UTF8.toText url) "" <$> convertInlines ils
+ D.Reference label -> do
+ refs <- asks references
+ case D.lookupReference label refs of
+ Just (url, lattr) ->
+ addAttrToInline pos lattr .
+ link (UTF8.toText url) "" <$> convertInlines ils
+ Nothing -> do
+ report $ ReferenceNotFound (UTF8.toText label) (newPos "" 0 0)
+ link "" "" <$> convertInlines ils
+ D.Image ils target ->
+ case target of
+ D.Direct url -> image (UTF8.toText url) "" <$> convertInlines ils
+ D.Reference label -> do
+ refs <- asks references
+ case D.lookupReference label refs of
+ Just (url, lattr) ->
+ addAttrToInline pos lattr .
+ image (UTF8.toText url) "" <$> convertInlines ils
+ Nothing -> do
+ report $ ReferenceNotFound (UTF8.toText label) (newPos "" 0 0)
+ image "" "" <$> convertInlines ils
+ D.FootnoteReference bs -> do
+ notes <- asks footnotes
+ case D.lookupNote bs notes of
+ Just bls -> note <$> convertBlocks bls
+ Nothing -> do
+ -- TODO consider new warning for this?
+ report $ IgnoredElement ("Undefined footnote reference " <> tshow bs)
+ pure mempty
+ D.UrlLink bs -> do
+ let url = UTF8.toText bs
+ pure $ linkWith ("",["uri"],[]) url "" (str url)
+ D.EmailLink bs -> do
+ let email = UTF8.toText bs
+ pure $ linkWith ("",["email"],[]) ("mailto:" <> email) "" (str email)
+ D.RawInline (D.Format fbs) bs -> pure $
+ rawInline (UTF8.toText fbs) (UTF8.toText bs)
+ D.NonBreakingSpace -> pure $ str "\160"
+ D.SoftBreak -> pure softbreak
+ D.HardBreak -> pure linebreak
+
+internalAttribute :: (ByteString, ByteString) -> Bool
+internalAttribute ("_implicit",_) = True
+internalAttribute ("_autogen",_) = True
+internalAttribute _ = False
+
+toTight :: Blocks -> Blocks
+toTight (Many bls) = Many $ paraToPlain <$> bls
+ where
+ paraToPlain (Para ils) = Plain ils
+ paraToPlain x = x
+
+toTaskListItem :: PandocMonad m
+ => (D.TaskStatus, D.Blocks) -> ReaderT Env m Blocks
+toTaskListItem (status, bls) = do
+ bls' <- convertBlocks bls
+ case toList bls' of
+ (Para ils : rest) -> pure $
+ fromList $ Para (Str taskmarker : Space : ils) : rest
+ _ -> pure $ para (str taskmarker) <> bls'
+ where
+ taskmarker
+ | status == D.Complete = "[X]"
+ | otherwise = "[ ]"
diff --git a/src/Text/Pandoc/Writers.hs b/src/Text/Pandoc/Writers.hs
index bc0f9bb2a..9443c2003 100644
--- a/src/Text/Pandoc/Writers.hs
+++ b/src/Text/Pandoc/Writers.hs
@@ -30,6 +30,7 @@ module Text.Pandoc.Writers
, writeConTeXt
, writeCslJson
, writeDZSlides
+ , writeDjot
, writeDocBook4
, writeDocBook5
, writeDocx
@@ -95,6 +96,7 @@ import Text.Pandoc.Writers.ChunkedHTML
import Text.Pandoc.Writers.CommonMark
import Text.Pandoc.Writers.ConTeXt
import Text.Pandoc.Writers.CslJson
+import Text.Pandoc.Writers.Djot
import Text.Pandoc.Writers.DocBook
import Text.Pandoc.Writers.Docx
import Text.Pandoc.Writers.DokuWiki
@@ -197,6 +199,7 @@ writers = [
,("biblatex" , TextWriter writeBibLaTeX)
,("markua" , TextWriter writeMarkua)
,("chunkedhtml" , ByteStringWriter writeChunkedHTML)
+ ,("djot" , TextWriter writeDjot)
]
-- | Retrieve writer, extensions based on formatSpec (format+extensions).
diff --git a/src/Text/Pandoc/Writers/Djot.hs b/src/Text/Pandoc/Writers/Djot.hs
new file mode 100644
index 000000000..0e605398e
--- /dev/null
+++ b/src/Text/Pandoc/Writers/Djot.hs
@@ -0,0 +1,296 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{- |
+ Module : Text.Pandoc.Writers.Djot
+ Copyright : Copyright (C) 2024 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <[email protected]>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' format into Djot markup (<https://djot.net>).
+-}
+module Text.Pandoc.Writers.Djot (
+ writeDjot
+ ) where
+import Text.Pandoc.Definition
+import Text.Pandoc.Logging
+import Text.Pandoc.Class ( PandocMonad , report )
+import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..))
+import Data.Text (Text)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B8
+import Data.List (intersperse)
+import qualified Data.Text as T
+import qualified Data.Map as M
+import qualified Text.Pandoc.UTF8 as UTF8
+import Text.Pandoc.Writers.Shared ( metaToContext, defField, toLegacyTable )
+import Text.Pandoc.Shared (isTightList, tshow, stringify, onlySimpleTableCells,
+ makeSections)
+import Text.DocLayout
+import Text.DocTemplates (renderTemplate)
+
+import Control.Monad.State
+import Control.Monad (zipWithM, when)
+import Data.Maybe (fromMaybe)
+import qualified Djot.AST as D
+import Djot (renderDjot, RenderOptions(..), toIdentifier)
+import Text.Pandoc.UTF8 (fromText)
+
+-- | Convert Pandoc to Djot.
+writeDjot :: PandocMonad m => WriterOptions -> Pandoc -> m Text
+writeDjot opts (Pandoc meta blocks) = do
+ let colwidth = if writerWrapText opts == WrapAuto
+ then Just $ writerColumns opts
+ else Nothing
+ let ropts = RenderOptions{ preserveSoftBreaks =
+ writerWrapText opts == WrapPreserve }
+ metadata <- metaToContext opts
+ (fmap (renderDjot ropts) . bodyToDjot opts)
+ (fmap (chomp . renderDjot ropts) . bodyToDjot opts .
+ (:[]) . Plain)
+ meta
+ main <- renderDjot ropts <$>
+ bodyToDjot opts (makeSections False Nothing blocks)
+ let context = defField "body" main metadata
+ return $ render colwidth $
+ case writerTemplate opts of
+ Nothing -> main
+ Just tpl -> renderTemplate tpl context
+
+data DjotState =
+ DjotState
+ { footnotes :: D.NoteMap
+ , references :: D.ReferenceMap
+ , autoReferences :: D.ReferenceMap
+ , autoIds :: Set B.ByteString
+ , options :: WriterOptions }
+
+bodyToDjot :: PandocMonad m => WriterOptions -> [Block] -> m D.Doc
+bodyToDjot opts bls = do
+ (bs, st) <- runStateT (blocksToDjot bls)
+ (DjotState mempty mempty mempty mempty opts)
+ let D.ReferenceMap autos = autoReferences st
+ let D.ReferenceMap refs = references st
+ pure $ D.Doc{ D.docBlocks = bs
+ , D.docFootnotes = footnotes st
+ , D.docReferences = D.ReferenceMap $ M.difference refs autos
+ , D.docAutoReferences = D.ReferenceMap autos
+ , D.docAutoIdentifiers = autoIds st
+ }
+
+blocksToDjot :: PandocMonad m => [Block] -> StateT DjotState m D.Blocks
+blocksToDjot = fmap mconcat . mapM blockToDjot
+
+blockToDjot :: PandocMonad m => Block -> StateT DjotState m D.Blocks
+blockToDjot (Para ils) = D.para <$> inlinesToDjot ils
+blockToDjot (Plain ils) = D.para <$> inlinesToDjot ils
+blockToDjot (LineBlock ls) =
+ D.para . mconcat . intersperse D.hardBreak <$> mapM inlinesToDjot 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)
+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) =
+ 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
+ let ident' = toIdentifier ilsBs
+ let label = D.normalizeLabel ilsBs
+ let autoid = UTF8.toText ident' == ident
+ when autoid $
+ modify $ \st -> st{ autoIds = Set.insert ident' (autoIds st) }
+ modify $ \st -> st{ autoReferences = D.insertReference label
+ (B8.cons '#' ident', mempty) (autoReferences st) }
+ fmap
+ (D.addAttr (toDjotAttr (if autoid then "" else ident,
+ filter (/= "section") cls,
+ filter (\(k,_) -> k /= "wrapper") kvs))) . D.section
+ <$> blocksToDjot bls
+blockToDjot (Div attr@(ident,cls,kvs) bls)
+ | Just "1" <- lookup "wrapper" kvs
+ = fmap (D.addAttr
+ (toDjotAttr (ident,cls,filter (\(k,_) -> k /= "wrapper") kvs)))
+ <$> blocksToDjot bls
+ | otherwise
+ = fmap (D.addAttr (toDjotAttr attr)) . D.div <$> blocksToDjot bls
+blockToDjot (BulletList items) =
+ D.bulletList spacing <$> mapM blocksToDjot items
+ where
+ spacing = if isTightList items then D.Tight else D.Loose
+blockToDjot (OrderedList (start, sty, delim) items) =
+ D.orderedList listAttr spacing <$> mapM blocksToDjot items
+ where
+ spacing = if isTightList items then D.Tight else D.Loose
+ listAttr = D.OrderedListAttributes {
+ D.orderedListStyle =
+ case sty of
+ DefaultStyle -> D.Decimal
+ Example -> D.Decimal
+ Decimal -> D.Decimal
+ LowerRoman -> D.RomanLower
+ UpperRoman -> D.RomanUpper
+ LowerAlpha -> D.LetterLower
+ UpperAlpha -> D.LetterUpper,
+ D.orderedListDelim =
+ case delim of
+ DefaultDelim -> D.RightPeriod
+ Period -> D.RightPeriod
+ OneParen -> D.RightParen
+ TwoParens -> D.LeftRightParen,
+ D.orderedListStart = start }
+blockToDjot (DefinitionList items) =
+ D.definitionList spacing <$> mapM toDLItem items
+ where
+ spacing = if isTightList (map (concat . snd) items)
+ then D.Tight
+ else D.Loose
+ toDLItem (term, defs) = do
+ term' <- inlinesToDjot term
+ def' <- mconcat <$> mapM blocksToDjot defs
+ pure (term', def')
+blockToDjot (Figure attr (Caption _ capt) bls) = do
+ content <- blocksToDjot bls
+ caption <- fmap (D.addAttr (D.Attr [("class","caption")])) . D.div <$>
+ blocksToDjot capt
+ 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
+ if onlySimpleTableCells (headRow : bodyRows)
+ then do
+ let alignToAlign al = case al of
+ AlignDefault -> D.AlignDefault
+ AlignLeft -> D.AlignLeft
+ AlignRight -> D.AlignRight
+ AlignCenter -> D.AlignCenter
+ let defAligns = map alignToAlign aligns
+ let cellToCell isHeader bls al =
+ D.Cell (if isHeader then D.HeadCell else D.BodyCell) al
+ <$> case bls of
+ [Para ils] -> inlinesToDjot ils
+ [Plain ils] -> inlinesToDjot ils
+ [] -> pure mempty
+ bs -> do
+ mapM_ (report . BlockNotRendered) bs
+ pure $ D.str "((omitted))"
+ let rowToRow isHeader cells = zipWithM (cellToCell isHeader) cells defAligns
+ hrows <- if null headRow
+ then pure []
+ else (:[]) <$> rowToRow True headRow
+ rows <- mapM (rowToRow False) bodyRows
+ caption <- case capt of
+ [] -> pure Nothing
+ _ -> Just . D.Caption . D.para <$> inlinesToDjot capt
+ 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
+
+inlinesToDjot :: PandocMonad m => [Inline] -> StateT DjotState m D.Inlines
+inlinesToDjot = fmap mconcat . mapM inlineToDjot
+
+inlineToDjot :: PandocMonad m => Inline -> StateT DjotState m D.Inlines
+inlineToDjot (Str t) = pure $ D.str (fromText t)
+inlineToDjot Space = pure $ D.str " "
+inlineToDjot SoftBreak = pure D.softBreak
+inlineToDjot LineBreak = pure D.hardBreak
+inlineToDjot (Emph ils) = D.emph <$> inlinesToDjot ils
+inlineToDjot (Underline 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 "wrapper" kvs
+ = fmap (D.addAttr
+ (toDjotAttr (ident,cls,filter (\(k,_) -> k /= "wrapper") kvs)))
+ <$> inlinesToDjot ils
+ | otherwise
+ = fmap (D.addAttr (toDjotAttr attr)) . D.span_ <$> inlinesToDjot ils
+inlineToDjot (SmallCaps 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)
+inlineToDjot (Math mt t) =
+ pure $ (if mt == InlineMath
+ then D.inlineMath
+ else D.displayMath) (fromText t)
+inlineToDjot (RawInline (Format f) t) =
+ pure $ D.rawInline (D.Format (fromText f)) (fromText t)
+inlineToDjot (Link attr ils (src,tit)) = do
+ opts <- gets options
+ description <- inlinesToDjot ils
+ let ilstring = stringify ils
+ let autolink = ilstring == src
+ let email = ("mailto:" <> ilstring) == src
+ let removeClass name (ident, cls, kvs) = (ident, filter (/= name) cls, kvs)
+ let attr' = D.Attr [("title", fromText tit) | not (T.null tit)] <>
+ toDjotAttr ( (if autolink
+ then removeClass "uri"
+ else id) .
+ (if email
+ 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)
+ | writerReferenceLinks opts
+ -> do refs@(D.ReferenceMap m) <- gets references
+ autoRefs <- gets autoReferences
+ let lab' = D.inlinesToByteString description
+ lab <- case D.lookupReference lab' (refs <> autoRefs) of
+ Just _ -> pure lab'
+ Nothing -> do
+ let refnum = M.size m + 1
+ let lab = fromText $ tshow refnum
+ modify $ \st -> st{ references =
+ D.insertReference lab
+ (fromText src, attr') refs }
+ pure lab
+ pure $ D.addAttr attr' <$> D.link description (D.Reference lab)
+ | otherwise
+ -> pure $ D.addAttr attr' <$> D.link description (D.Direct (fromText src))
+inlineToDjot (Image attr ils (src,tit)) = do
+ opts <- gets options
+ description <- inlinesToDjot ils
+ let attr' = D.Attr [("title", fromText tit) | not (T.null tit)] <>
+ toDjotAttr attr
+ if writerReferenceLinks opts
+ then do
+ refs@(D.ReferenceMap m) <- gets references
+ let refnum = M.size m + 1
+ let lab = fromText $ tshow refnum
+ 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))
+inlineToDjot (Note bs) = do
+ notes@(D.NoteMap m) <- gets footnotes
+ let notenum = M.size m + 1
+ let lab = fromText $ tshow notenum
+ contents <- blocksToDjot bs
+ modify $ \st -> st{ footnotes = D.insertNote lab contents notes }
+ pure $ D.footnoteReference lab
+
+toDjotAttr :: (Text, [Text], [(Text, Text)]) -> D.Attr
+toDjotAttr (ident, classes, kvs) =
+ D.Attr $ [("id", fromText ident) | not (T.null ident)] ++
+ [("class", fromText (T.unwords classes)) | not (null classes)] ++
+ map (\(k,v) -> (fromText k, fromText v)) kvs
generated by cgit v1.2.3 (git 2.46.0) at 2026-01-27 07:24:51 +0000