opensource/pandoc
3
0
Fork 0
mirror of https://github.com/jgm/pandoc.git synced 2026-08-28 17:20:47 +08:00
Code Issues Packages Projects Releases Wiki Activity

Typst reader: properly resolve image paths in included files.

Browse Source 
Closes #11090.
This commit is contained in:
John MacFarlane
2025-08-29 23:48:08 +02:00
parent 729c12394c
commit f865b3bc4b
4 changed files with 133 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files
pandoc.cabal
+1
View File
@@ -232,6 +232,7 @@ extra-source-files:
test/command/file1.txt
test/command/file2.txt
test/command/three.txt
test/command/11090/ch1.typ
test/command/01.csv
test/command/chap1/spider.png
test/command/chap2/spider.png
src/Text/Pandoc/Readers/Typst.hs
+77 -64
View File
@@ -50,6 +50,9 @@ import Text.Pandoc.Readers.Typst.Parsing (pTok, ignored, getField, P,
import Typst.Methods (formatNumber, applyPureFunction)
import Typst.Types
import qualified Data.Vector as V
import System.FilePath (takeDirectory, (</>))
import qualified System.FilePath.Windows as Windows
import qualified System.FilePath.Posix as Posix
-- | Read Typst from an input string and return a Pandoc document.
readTypst :: (PandocMonad m, ToSources a)
@@ -89,7 +92,7 @@ pBlockElt = try $ do
ignored ("unknown block element " <> tname <>
" at " <> tshow pos)
pure mempty
Just handler -> handler mbident fields
Just handler -> handler pos mbident fields
_ -> pure mempty
pInline :: PandocMonad m => P m B.Inlines
@@ -119,14 +122,14 @@ pInline = try $ do
ignored ("unknown inline element " <> tname <>
" at " <> tshow pos)
pure mempty
Just handler -> handler Nothing (M.mapKeys targetToKey fields)
Just handler -> handler pos Nothing (M.mapKeys targetToKey fields)
else do
case M.lookup name inlineHandlers of
Nothing -> do
ignored ("unknown inline element " <> tname <>
" at " <> tshow pos)
pure mempty
Just handler -> handler Nothing fields
Just handler -> handler pos Nothing fields
-- Pull block elements out of inline elements, e.g.
-- Elt "smallcaps" [ Elt "heading" [..] ] ->
@@ -230,31 +233,34 @@ isInline Txt{} = True
blockKeys :: Set.Set Identifier
blockKeys = Set.fromList $ M.keys
(blockHandlers :: M.Map Identifier
(Maybe Text -> M.Map Identifier Val -> P PandocPure B.Blocks))
(Maybe SourcePos -> Maybe Text ->
M.Map Identifier Val -> P PandocPure B.Blocks))
inlineKeys :: Set.Set Identifier
inlineKeys = Set.fromList $ M.keys
(inlineHandlers :: M.Map Identifier
(Maybe Text -> M.Map Identifier Val -> P PandocPure B.Inlines))
(Maybe SourcePos -> Maybe Text ->
M.Map Identifier Val -> P PandocPure B.Inlines))
blockHandlers :: PandocMonad m =>
M.Map Identifier
(Maybe Text -> M.Map Identifier Val -> P m B.Blocks)
(Maybe SourcePos -> Maybe Text ->
M.Map Identifier Val -> P m B.Blocks)
blockHandlers = M.fromList
[("text", \_ fields -> do
[("text", \_ _ fields -> do
body <- getField "body" fields
-- sometimes text elements include para breaks
notFollowedBy $ void $ pWithContents pInlines body
pWithContents pBlocks body)
,("box", \_ fields -> do
,("box", \_ _ fields -> do
body <- getField "body" fields
B.divWith ("", ["box"], []) <$> pWithContents pBlocks body)
,("heading", \mbident fields -> do
,("heading", \_ mbident fields -> do
body <- getField "body" fields
lev <- getField "level" fields <|> pure 1
B.headerWith (fromMaybe "" mbident,[],[]) lev
<$> pWithContents pInlines body)
,("quote", \_ fields -> do
,("quote", \_ _ fields -> do
getField "block" fields >>= guard
body <- getField "body" fields >>= pWithContents pBlocks
attribution' <- getField "attribution" fields
@@ -263,11 +269,11 @@ blockHandlers = M.fromList
else (\x -> B.para ("\x2014\xa0" <> x)) <$>
(pWithContents pInlines attribution')
pure $ B.blockQuote $ body <> attribution)
,("list", \_ fields -> do
,("list", \_ _ fields -> do
children <- V.toList <$> getField "children" fields
B.bulletList <$> mapM (pWithContents pBlocks) children)
,("list.item", \_ fields -> getField "body" fields >>= pWithContents pBlocks)
,("enum", \_ fields -> do
,("list.item", \_ _ fields -> getField "body" fields >>= pWithContents pBlocks)
,("enum", \_ _ fields -> do
children <- V.toList <$> getField "children" fields
mbstart <- getField "start" fields
start <- case mbstart of
@@ -296,8 +302,8 @@ blockHandlers = M.fromList
_ -> (B.DefaultStyle, B.DefaultDelim)
let listAttr = (start, sty, delim)
B.orderedListWith listAttr <$> mapM (pWithContents pBlocks) children)
,("enum.item", \_ fields -> getField "body" fields >>= pWithContents pBlocks)
,("terms", \_ fields -> do
,("enum.item", \_ _ fields -> getField "body" fields >>= pWithContents pBlocks)
,("terms", \_ _ fields -> do
children <- V.toList <$> getField "children" fields
B.definitionList
<$> mapM
@@ -309,38 +315,38 @@ blockHandlers = M.fromList
_ -> pure (mempty, [])
)
children)
,("terms.item", \_ fields -> getField "body" fields >>= pWithContents pBlocks)
,("raw", \mbident fields -> do
,("terms.item", \_ _ fields -> getField "body" fields >>= pWithContents pBlocks)
,("raw", \_ mbident fields -> do
txt <- T.filter (/= '\r') <$> getField "text" fields
mblang <- getField "lang" fields
let attr = (fromMaybe "" mbident, maybe [] (\l -> [l]) mblang, [])
pure $ B.codeBlockWith attr txt)
,("parbreak", \_ _ -> pure mempty)
,("block", \mbident fields ->
,("parbreak", \_ _ _ -> pure mempty)
,("block", \_ mbident fields ->
maybe id (\ident -> B.divWith (ident, [], [])) mbident
<$> (getField "body" fields >>= pWithContents pBlocks))
,("place", \_ fields -> do
,("place", \_ _ fields -> do
ignored "parameters of place"
getField "body" fields >>= pWithContents pBlocks)
,("columns", \_ fields -> do
,("columns", \_ _ fields -> do
(cnt :: Integer) <- getField "count" fields
B.divWith ("", ["columns-flow"], [("count", T.pack (show cnt))])
<$> (getField "body" fields >>= pWithContents pBlocks))
,("rect", \_ fields ->
,("rect", \_ _ fields ->
B.divWith ("", ["rect"], []) <$> (getField "body" fields >>= pWithContents pBlocks))
,("circle", \_ fields ->
,("circle", \_ _ fields ->
B.divWith ("", ["circle"], []) <$> (getField "body" fields >>= pWithContents pBlocks))
,("ellipse", \_ fields ->
,("ellipse", \_ _ fields ->
B.divWith ("", ["ellipse"], []) <$> (getField "body" fields >>= pWithContents pBlocks))
,("polygon", \_ fields ->
,("polygon", \_ _ fields ->
B.divWith ("", ["polygon"], []) <$> (getField "body" fields >>= pWithContents pBlocks))
,("square", \_ fields ->
,("square", \_ _ fields ->
B.divWith ("", ["square"], []) <$> (getField "body" fields >>= pWithContents pBlocks))
,("align", \_ fields -> do
,("align", \_ _ fields -> do
alignment <- getField "alignment" fields
B.divWith ("", [], [("align", repr alignment)])
<$> (getField "body" fields >>= pWithContents pBlocks))
,("stack", \_ fields -> do
,("stack", \_ _ fields -> do
(dir :: Direction) <- getField "dir" fields `mplus` pure Ltr
rawchildren <- getField "children" fields
children <-
@@ -355,9 +361,9 @@ blockHandlers = M.fromList
B.divWith ("", [], [("stack", repr (VDirection dir))]) $
mconcat $
map (B.divWith ("", [], [])) children)
,("grid", \mbident fields -> parseTable mbident fields)
,("table", \mbident fields -> parseTable mbident fields)
,("figure", \mbident fields -> do
,("grid", \_ mbident fields -> parseTable mbident fields)
,("table", \_ mbident fields -> parseTable mbident fields)
,("figure", \_ mbident fields -> do
body <- getField "body" fields >>= pWithContents pBlocks
(mbCaption :: Maybe (Seq Content)) <- getField "caption" fields
(caption :: B.Blocks) <- maybe mempty (pWithContents pBlocks) mbCaption
@@ -367,13 +373,13 @@ blockHandlers = M.fromList
(B.Table attr (B.Caption Nothing (B.toList caption)) colspecs thead tbodies tfoot)
_ -> B.figureWith (fromMaybe "" mbident, [], [])
(B.Caption Nothing (B.toList caption)) body)
,("line", \_ fields ->
,("line", \_ _ fields ->
case ( M.lookup "start" fields
>> M.lookup "end" fields
>> M.lookup "angle" fields ) of
Nothing -> pure B.horizontalRule
_ -> pure mempty)
,("numbering", \_ fields -> do
,("numbering", \_ _ fields -> do
numStyle <- getField "numbering" fields
(nums :: V.Vector Integer) <- getField "numbers" fields
let toText v = fromMaybe "" $ fromVal v
@@ -386,16 +392,17 @@ blockHandlers = M.fromList
Failure _ -> "?"
_ -> "?"
pure $ B.plain . B.text . mconcat . map toNum $ V.toList nums)
,("footnote.entry", \_ fields ->
,("footnote.entry", \_ _ fields ->
getField "body" fields >>= pWithContents pBlocks)
,("pad", \_ fields -> -- ignore paddingy
,("pad", \_ _ fields -> -- ignore paddingy
getField "body" fields >>= pWithContents pBlocks)
]
inlineHandlers :: PandocMonad m =>
M.Map Identifier (Maybe Text -> M.Map Identifier Val -> P m B.Inlines)
M.Map Identifier (Maybe SourcePos -> Maybe Text ->
M.Map Identifier Val -> P m B.Inlines)
inlineHandlers = M.fromList
[("ref", \_ fields -> do
[("ref", \_ _ fields -> do
VLabel target <- getField "target" fields
supplement' <- getField "supplement" fields
supplement <- case supplement' of
@@ -406,17 +413,17 @@ inlineHandlers = M.fromList
pure $ B.text ("[" <> target <> "]")
_ -> pure mempty
pure $ B.linkWith ("", ["ref"], []) ("#" <> target) "" supplement)
,("linebreak", \_ _ -> pure B.linebreak)
,("text", \_ fields -> do
,("linebreak", \_ _ _ -> pure B.linebreak)
,("text", \_ _ fields -> do
body <- getField "body" fields
(mbweight :: Maybe Text) <- getField "weight" fields
case mbweight of
Just "bold" -> B.strong <$> pWithContents pInlines body
_ -> pWithContents pInlines body)
,("raw", \_ fields -> B.code . T.filter (/= '\r') <$> getField "text" fields)
,("footnote", \_ fields ->
,("raw", \_ _ fields -> B.code . T.filter (/= '\r') <$> getField "text" fields)
,("footnote", \_ _ fields ->
B.note <$> (getField "body" fields >>= pWithContents pBlocks))
,("cite", \_ fields -> do
,("cite", \_ _ fields -> do
VLabel key <- getField "key" fields
(form :: Text) <- getField "form" fields <|> pure "normal"
let citation =
@@ -431,38 +438,38 @@ inlineHandlers = M.fromList
B.citationHash = 0
}
pure $ B.cite [citation] (B.text $ "[" <> key <> "]"))
,("lower", \_ fields -> do
,("lower", \_ _ fields -> do
body <- getField "text" fields
walk (modString T.toLower) <$> pWithContents pInlines body)
,("upper", \_ fields -> do
,("upper", \_ _ fields -> do
body <- getField "text" fields
walk (modString T.toUpper) <$> pWithContents pInlines body)
,("emph", \_ fields -> do
,("emph", \_ _ fields -> do
body <- getField "body" fields
B.emph <$> pWithContents pInlines body)
,("strong", \_ fields -> do
,("strong", \_ _ fields -> do
body <- getField "body" fields
B.strong <$> pWithContents pInlines body)
,("sub", \_ fields -> do
,("sub", \_ _ fields -> do
body <- getField "body" fields
B.subscript <$> pWithContents pInlines body)
,("super", \_ fields -> do
,("super", \_ _ fields -> do
body <- getField "body" fields
B.superscript <$> pWithContents pInlines body)
,("strike", \_ fields -> do
,("strike", \_ _ fields -> do
body <- getField "body" fields
B.strikeout <$> pWithContents pInlines body)
,("smallcaps", \_ fields -> do
,("smallcaps", \_ _ fields -> do
body <- getField "body" fields
B.smallcaps <$> pWithContents pInlines body)
,("underline", \_ fields -> do
,("underline", \_ _ fields -> do
body <- getField "body" fields
B.underline <$> pWithContents pInlines body)
,("quote", \_ fields -> do
,("quote", \_ _ fields -> do
(getField "block" fields <|> pure False) >>= guard . not
body <- getInlineBody fields >>= pWithContents pInlines
pure $ B.doubleQuoted $ B.trimInlines body)
,("link", \_ fields -> do
,("link", \_ _ fields -> do
dest <- getField "dest" fields
src <- case dest of
VString t -> pure t
@@ -470,7 +477,7 @@ inlineHandlers = M.fromList
VDict _ -> do
ignored "link to location, linking to #"
pure "#"
_ -> fail $ "Expected string or label for dest"
_ -> fail "Expected string or label for dest"
body <- getField "body" fields
description <-
if null body
@@ -487,9 +494,15 @@ inlineHandlers = M.fromList
pWithContents
(B.fromList . blocksToInlines . B.toList <$> pBlocks) body
pure $ B.link src "" description)
,("image", \_ fields -> do
,("image", \mbpos _ fields -> do
path <- getField "source" fields <|> getField "path" fields
alt <- (B.text <$> getField "alt" fields) `mplus` pure mempty
let basedir = maybe "." (takeDirectory . sourceName) mbpos
let isAbsolutePath p = Posix.isAbsolute p || Windows.isAbsolute p
let path' = T.pack $
if isAbsolutePath path || basedir == "."
then path
else basedir </> path
(mbwidth :: Maybe Text) <-
fmap (renderLength False) <$> getField "width" fields
(mbheight :: Maybe Text) <-
@@ -500,11 +513,11 @@ inlineHandlers = M.fromList
maybe [] (\x -> [("width", x)]) mbwidth
++ maybe [] (\x -> [("height", x)]) mbheight
)
pure $ B.imageWith attr path "" alt)
,("box", \_ fields -> do
pure $ B.imageWith attr path' "" alt)
,("box", \_ _ fields -> do
body <- getField "body" fields
B.spanWith ("", ["box"], []) <$> pWithContents pInlines body)
,("h", \_ fields -> do
,("h", \_ _ fields -> do
amount <- getField "amount" fields `mplus` pure (LExact 1 LEm)
let em = case amount of
LExact x LEm -> toRational x
@@ -512,21 +525,21 @@ inlineHandlers = M.fromList
LExact x LPt -> toRational x / 12
_ -> 1 / 3 -- guess!
pure $ B.text $ getSpaceChars em)
,("place", \_ fields -> do
,("place", \_ _ fields -> do
ignored "parameters of place"
getField "body" fields >>= pWithContents pInlines)
,("align", \_ fields -> do
,("align", \_ _ fields -> do
alignment <- getField "alignment" fields
B.spanWith ("", [], [("align", repr alignment)])
<$> (getField "body" fields >>= pWithContents pInlines))
,("sys.version", \_ _ -> pure $ B.text "typst-hs")
,("math.equation", \_ fields -> do
,("sys.version", \_ _ _ -> pure $ B.text "typst-hs")
,("math.equation", \_ _ fields -> do
body <- getField "body" fields
display <- getField "block" fields
(if display then B.displayMath else B.math) . writeTeX <$> pMathMany body)
,("pad", \_ fields -> -- ignore paddingy
,("pad", \_ _ fields -> -- ignore paddingy
getField "body" fields >>= pWithContents pInlines)
,("block", \mbident fields ->
,("block", \_ mbident fields ->
maybe id (\ident -> B.spanWith (ident, [], [])) mbident
<$> (getField "body" fields >>= pWithContents pInlines))
]
test/command/11090.md
+49
View File
@@ -0,0 +1,49 @@
```
% pandoc -f typst -t native
#include "command/11090/ch1.typ"
== Chapter Two
#figure(
image("command/11090/media/image1.png"),
caption: [This is an image.]
)
^D
[ Header
2 ( "" , [] , [] ) [ Str "Chapter" , Space , Str "One" ]
, Figure
( "" , [] , [] )
(Caption
Nothing [ Para [ Str "An" , Space , Str "image." ] ])
[ Para
[ Image
( "" , [] , [] )
[]
( "command/11090/media/image1.png" , "" )
]
]
, Header
2 ( "" , [] , [] ) [ Str "Chapter" , Space , Str "Two" ]
, Figure
( "" , [] , [] )
(Caption
Nothing
[ Para
[ Str "This"
, Space
, Str "is"
, Space
, Str "an"
, Space
, Str "image."
]
])
[ Para
[ Image
( "" , [] , [] )
[]
( "command/11090/media/image1.png" , "" )
]
]
]
```
test/command/11090/ch1.typ
+6
View File
@@ -0,0 +1,6 @@
== Chapter One
#figure(
image("media/image1.png"),
caption: [An image.]
)