aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Extensions.hs2
-rw-r--r--src/Text/Pandoc/Format.hs1
-rw-r--r--src/Text/Pandoc/Writers.hs3
-rw-r--r--src/Text/Pandoc/Writers/Typst.hs293
4 files changed, 299 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs
index 97ac8e77a..efc5202a2 100644
--- a/src/Text/Pandoc/Extensions.hs
+++ b/src/Text/Pandoc/Extensions.hs
@@ -466,6 +466,7 @@ getDefaultExtensions "jats_articleauthoring" = getDefaultExtensions "jats"
getDefaultExtensions "opml" = pandocExtensions -- affects notes
getDefaultExtensions "markua" = extensionsFromList
[]
+getDefaultExtensions "typst" = extensionsFromList [Ext_citations]
getDefaultExtensions _ = extensionsFromList
[Ext_auto_identifiers]
@@ -644,4 +645,5 @@ getAllExtensions f = universalExtensions <> getAll f
getAll "mediawiki" = autoIdExtensions <>
extensionsFromList
[ Ext_smart ]
+ getAll "typst" = extensionsFromList [Ext_citations]
getAll _ = mempty
diff --git a/src/Text/Pandoc/Format.hs b/src/Text/Pandoc/Format.hs
index f79742d3f..ca04d4bc2 100644
--- a/src/Text/Pandoc/Format.hs
+++ b/src/Text/Pandoc/Format.hs
@@ -221,6 +221,7 @@ formatFromFilePath x =
".textile" -> defFlavor "textile"
".tsv" -> defFlavor "tsv"
".txt" -> defFlavor "markdown"
+ ".typ" -> defFlavor "typst"
".wiki" -> defFlavor "mediawiki"
".xhtml" -> defFlavor "html"
['.',y] | y `elem` ['1'..'9'] -> defFlavor "man"
diff --git a/src/Text/Pandoc/Writers.hs b/src/Text/Pandoc/Writers.hs
index 7f7a03603..c78b00dcf 100644
--- a/src/Text/Pandoc/Writers.hs
+++ b/src/Text/Pandoc/Writers.hs
@@ -72,6 +72,7 @@ module Text.Pandoc.Writers
, writeTEI
, writeTexinfo
, writeTextile
+ , writeTypst
, writeXWiki
, writeZimWiki
, getWriter
@@ -121,6 +122,7 @@ import Text.Pandoc.Writers.RTF
import Text.Pandoc.Writers.TEI
import Text.Pandoc.Writers.Texinfo
import Text.Pandoc.Writers.Textile
+import Text.Pandoc.Writers.Typst
import Text.Pandoc.Writers.XWiki
import Text.Pandoc.Writers.ZimWiki
@@ -177,6 +179,7 @@ writers = [
,("xwiki" , TextWriter writeXWiki)
,("zimwiki" , TextWriter writeZimWiki)
,("textile" , TextWriter writeTextile)
+ ,("typst" , TextWriter writeTypst)
,("rtf" , TextWriter writeRTF)
,("org" , TextWriter writeOrg)
,("asciidoc" , TextWriter writeAsciiDoc)
diff --git a/src/Text/Pandoc/Writers/Typst.hs b/src/Text/Pandoc/Writers/Typst.hs
new file mode 100644
index 000000000..bcecda035
--- /dev/null
+++ b/src/Text/Pandoc/Writers/Typst.hs
@@ -0,0 +1,293 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
+{- |
+ Module : Text.Pandoc.Writers.Typst
+ Copyright : Copyright (C) 2023 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <[email protected]>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' format into Typst markup
+(<https://typst.app>).
+-}
+module Text.Pandoc.Writers.Typst (
+ writeTypst
+ ) where
+import Text.Pandoc.Definition
+import Text.Pandoc.Class.PandocMonad ( PandocMonad )
+import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..), isEnabled )
+import Data.Text (Text)
+import Data.List (intercalate, intersperse)
+import qualified Data.Text as T
+import Control.Monad.State ( StateT, evalStateT, gets, modify )
+import Text.Pandoc.Writers.Shared ( metaToContext, defField, toLegacyTable )
+import Text.Pandoc.Shared (isTightList, orderedListMarkers)
+import Text.Pandoc.Writers.Math (convertMath)
+import qualified Text.TeXMath as TM
+import Text.DocLayout
+import Text.DocTemplates (renderTemplate)
+import Text.Pandoc.Extensions (Extension(..))
+import Control.Monad (zipWithM)
+
+-- | Convert Pandoc to Typst.
+writeTypst :: PandocMonad m => WriterOptions -> Pandoc -> m Text
+writeTypst options document =
+ evalStateT (pandocToTypst options document)
+ WriterState{ stOptions = options, stNotes = [] }
+
+data WriterState =
+ WriterState {
+ stOptions :: WriterOptions,
+ stNotes :: [Doc Text]
+ }
+
+type TW m = StateT WriterState m
+
+pandocToTypst :: PandocMonad m
+ => WriterOptions -> Pandoc -> TW m Text
+pandocToTypst options (Pandoc meta blocks) = do
+ let colwidth = if writerWrapText options == WrapAuto
+ then Just $ writerColumns options
+ else Nothing
+ metadata <- metaToContext options
+ blocksToTypst
+ (fmap chomp . inlinesToTypst)
+ meta
+ main <- blocksToTypst blocks
+ noteContents <- reverse <$> gets stNotes
+ let notes = vsep $ zipWith
+ (\(num :: Int) cont ->
+ "#endnote" <> parens (brackets (text (show num))
+ <> ", " <> brackets (chomp cont)))
+ [1..] noteContents
+ let context = defField "body" main
+ $ defField "notes" notes
+ $ defField "toc" (writerTableOfContents options)
+ $ (if writerNumberSections options
+ then defField "numbering" ("1.1.1.1.1" :: Text)
+ else id)
+ $ metadata
+ return $ render colwidth $
+ case writerTemplate options of
+ Nothing -> main
+ Just tpl -> renderTemplate tpl context
+
+blocksToTypst :: PandocMonad m => [Block] -> TW m (Doc Text)
+blocksToTypst blocks = vcat <$> mapM blockToTypst blocks
+
+blockToTypst :: PandocMonad m => Block -> TW m (Doc Text)
+blockToTypst block =
+ case block of
+ Plain inlines -> inlinesToTypst inlines
+ Para inlines -> ($$ blankline) <$> inlinesToTypst inlines
+ Header level (ident,_,_) inlines -> do
+ contents <- inlinesToTypst inlines
+ let lab = toLabel ident
+ return $ literal (T.replicate level "=") <> space <> contents <> cr <> lab
+ RawBlock fmt str ->
+ case fmt of
+ Format "typst" -> return $ literal str
+ _ -> return mempty
+ CodeBlock (_,cls,_) code -> do
+ let go :: Char -> (Int, Int) -> (Int, Int)
+ go '`' (longest, current) =
+ let !new = current + 1 in (max longest new, new)
+ go _ (longest, _) = (longest, 0)
+ let (longestBacktickSequence, _) = T.foldr go (0,0) code
+ let fence = literal $ T.replicate (max 3 (longestBacktickSequence + 1)) "`"
+ let lang = case cls of
+ (cl:_) -> literal cl
+ _ -> mempty
+ return $ fence <> lang <> cr <> literal code <> cr <> fence <> blankline
+ LineBlock lns -> do
+ contents <- inlinesToTypst (intercalate [LineBreak] lns)
+ return $ contents <> blankline
+ BlockQuote blocks -> do
+ contents <- blocksToTypst blocks
+ return $ "#blockquote[" $$ chomp contents $$ "]" $$ blankline
+ HorizontalRule ->
+ return $ blankline <> "#horizontalrule" <> blankline
+ OrderedList attribs items -> do
+ items' <- zipWithM (\marker item ->
+ chomp <$> listItemToTypst 3 (literal marker) item)
+ (orderedListMarkers attribs) items
+ return $ (if isTightList items
+ then vcat items'
+ else vsep items') $$ blankline
+ BulletList items -> do
+ items' <- mapM (fmap chomp . listItemToTypst 2 "- ") items
+ return $ (if isTightList items
+ then vcat items'
+ else vsep items') $$ blankline
+ DefinitionList items ->
+ ($$ blankline) . vsep <$> mapM defListItemToTypst items
+ Table (ident,_,_) blkCapt colspecs thead tbodies tfoot -> do
+ let (caption, aligns, _, headers, rows) =
+ toLegacyTable blkCapt colspecs thead tbodies tfoot
+ let numcols = length aligns
+ headers' <- mapM blocksToTypst headers
+ rows' <- mapM (mapM blocksToTypst) rows
+ capt' <- if null caption
+ then return mempty
+ else do
+ captcontents <- inlinesToTypst caption
+ return $ "#align(center, " <> brackets captcontents <> ")"
+ let lab = toLabel ident
+ -- TODO figure out how to specify alignment
+ -- let formatalign AlignLeft = "left"
+ -- formatalign AlignRight = "right"
+ -- formatalign AlignCenter = "center"
+ -- formatalign AlignDefault = "left"
+ -- let alignspecs = map formatalign aligns
+ return $ "#align(center)[#table("
+ $$ nest 2
+ ( "columns: " <> text (show numcols) <> "," -- auto
+ $$ "inset: 6pt" <> ","
+ $$ "align: auto,"
+ $$ hsep (map ((<>",") . brackets) headers')
+ $$ vcat (map (\x -> brackets x <> ",") (concat rows'))
+ )
+ $$ ")"
+ $$ capt'
+ $$ lab
+ $$ "]"
+ $$ blankline
+ Figure (ident,_,_) (Caption _mbshort capt) blocks -> do
+ caption <- blocksToTypst capt
+ contents <- blocksToTypst blocks
+ let lab = toLabel ident
+ return $ "#figure(" <> nest 2 (brackets contents <> "," <> cr <>
+ ("caption: [" $$ nest 2 caption $$ "]"))
+ <> cr <> ")" <> lab <> blankline
+ Div (ident,_,_) blocks -> do
+ let lab = toLabel ident
+ contents <- blocksToTypst blocks
+ return $ lab <> contents
+
+defListItemToTypst :: PandocMonad m => ([Inline], [[Block]]) -> TW m (Doc Text)
+defListItemToTypst (term, defns) = do
+ term' <- inlinesToTypst term
+ defns' <- mapM blocksToTypst defns
+ return $ "#definition" <> brackets term' <> mconcat (map brackets defns')
+
+listItemToTypst :: PandocMonad m => Int -> Doc Text -> [Block] -> TW m (Doc Text)
+listItemToTypst ind marker blocks = do
+ contents <- blocksToTypst blocks
+ return $ hang ind (marker <> space) contents
+
+inlinesToTypst :: PandocMonad m => [Inline] -> TW m (Doc Text)
+inlinesToTypst ils = hcat <$> mapM inlineToTypst ils
+
+inlineToTypst :: PandocMonad m => Inline -> TW m (Doc Text)
+inlineToTypst inline =
+ case inline of
+ Str txt -> return $ literal $ escapeTypst txt
+ Space -> return space
+ SoftBreak -> do
+ wrapText <- gets $ writerWrapText . stOptions
+ case wrapText of
+ WrapPreserve -> return cr
+ WrapAuto -> return space
+ WrapNone -> return space
+ LineBreak -> return (space <> "\\" <> cr)
+ Math mathType str -> do
+ res <- convertMath TM.writeTypst mathType str
+ case res of
+ Left il -> inlineToTypst il
+ Right r ->
+ case mathType of
+ InlineMath -> return $ "$" <> literal r <> "$"
+ DisplayMath -> return $ "$ " <> literal r <> " $"
+ Code (_,cls,_) code -> return $
+ case cls of
+ (lang:_) -> "#raw(lang=" <> doubleQuotes (literal lang) <>
+ ", " <> doubleQuotes (literal code) <> ")"
+ _ | T.any (=='`') code -> "#raw(" <> doubleQuotes (literal code) <> ")"
+ | otherwise -> "`" <> literal code <> "`"
+ RawInline fmt str ->
+ case fmt of
+ Format "typst" -> return $ literal str
+ _ -> return mempty
+ Strikeout inlines -> textstyle "#strike" inlines
+ Emph inlines -> textstyle "#emph" inlines
+ Underline inlines -> textstyle "#underline" inlines
+ Strong inlines -> textstyle "#strong" inlines
+ Superscript inlines -> textstyle "#super" inlines
+ Subscript inlines -> textstyle "#sub" inlines
+ SmallCaps inlines -> textstyle "#smallcaps" inlines
+ Span (ident,_,_) inlines -> do
+ let lab = toLabel ident
+ (lab $$) <$> inlinesToTypst inlines
+ Quoted quoteType inlines -> do
+ let q = case quoteType of
+ DoubleQuote -> literal "\""
+ SingleQuote -> literal "'"
+ contents <- inlinesToTypst inlines
+ return $ q <> contents <> q
+ Cite citations inlines -> do
+ opts <- gets stOptions
+ if isEnabled Ext_citations opts
+ then return $ -- Note: this loses locators, prefix, suffix
+ "#cite" <> parens
+ (mconcat $ intersperse ", " $
+ map (doubleQuotes . literal . citationId) citations)
+ else inlinesToTypst inlines
+ Link _attrs inlines (src,_tit) -> do
+ contents <- inlinesToTypst inlines
+ return $ "#link" <> parens (doubleQuotes (literal src)) <>
+ if render Nothing contents == src
+ then mempty
+ else nowrap $ brackets contents
+ Image (_,_,kvs) _inlines (src,_tit) -> do
+ let width' = maybe mempty ((", width: " <>) . literal) $ lookup "width" kvs
+ let height' = maybe mempty ((", height: " <>) . literal) $
+ lookup "height" kvs
+ return $ "#image(" <> doubleQuotes (literal src) <> width' <> height' <> ")"
+ Note blocks -> do -- currently typst has no footnotes!
+ -- TODO create endnotes with manual typesetting
+ contents <- blocksToTypst blocks
+ modify $ \st -> st{ stNotes = contents : stNotes st }
+ num <- text . show . length <$> gets stNotes
+ return $ "#super" <> brackets num
+
+textstyle :: PandocMonad m => Doc Text -> [Inline] -> TW m (Doc Text)
+textstyle s inlines = (s <>) . brackets <$> inlinesToTypst inlines
+
+escapeTypst :: Text -> Text
+escapeTypst t =
+ if T.any needsEscape t
+ then T.concatMap escapeChar t
+ else t
+ where
+ escapeChar c
+ | needsEscape c = "\\" <> T.singleton c
+ | otherwise = T.singleton c
+ needsEscape '[' = True
+ needsEscape ']' = True
+ needsEscape '#' = True
+ needsEscape '<' = True
+ needsEscape '>' = True
+ needsEscape '@' = True
+ needsEscape '$' = True
+ needsEscape '\\' = True
+ needsEscape '\'' = True
+ needsEscape '"' = True
+ needsEscape '`' = True
+ needsEscape '=' = True
+ needsEscape '_' = True
+ needsEscape '*' = True
+ needsEscape _ = False
+
+toLabel :: Text -> Doc Text
+toLabel ident =
+ if T.null ident
+ then mempty
+ else "#label" <> parens (doubleQuotes (literal ident))
generated by cgit v1.2.3 (git 2.46.0) at 2026-01-27 09:53:13 +0000