diff --git a/pandoc.cabal b/pandoc.cabal index c9e7d1ced..27be0fadb 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -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 diff --git a/src/Text/Pandoc/Readers/Typst.hs b/src/Text/Pandoc/Readers/Typst.hs index 2307920be..d6ea1b036 100644 --- a/src/Text/Pandoc/Readers/Typst.hs +++ b/src/Text/Pandoc/Readers/Typst.hs @@ -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)) ] diff --git a/test/command/11090.md b/test/command/11090.md new file mode 100644 index 000000000..d32c52b7d --- /dev/null +++ b/test/command/11090.md @@ -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" , "" ) + ] + ] +] +``` diff --git a/test/command/11090/ch1.typ b/test/command/11090/ch1.typ new file mode 100644 index 000000000..ae88ecfc9 --- /dev/null +++ b/test/command/11090/ch1.typ @@ -0,0 +1,6 @@ +== Chapter One + +#figure( + image("media/image1.png"), + caption: [An image.] +)