Typst property output

doc/typst-property-output.md

@@ -0,0 +1,154 @@
+---
+title: Typst property output
+author: Gordon Woodhull
+---
+
+Pandoc Typst property output
+============================
+
+In addition to the output of structural properties built into Pandoc's Typst Writer, the Writer can also output non-structural Typst properties. This is enabled by setting attributes with keys of the form `typst:prop` or `typst:text:prop` on supported elements.
+
+
+Typst properties
+----------------
+
+[Typst](https://typst.app/) allows specification of visual and layout properties as parameters to elements
+
+```typst
+#block(fill=orange)[Hello]
+```
+
+and set-rules
+
+```typst
+#set text(fill=blue); Hello
+```
+
+The parameter values are [Typst code](https://typst.app/docs/reference/syntax/#modes) that can use any features of the Typst language.
+
+Pandoc Typst property output
+----------------------------
+
+For the set of supported Pandoc elements, the Pandoc Typst Writer will output attributes as parameters to corresponding Typst elements or set-text rules. 
+
+The Typst Writer looks for attributes with keys of the form `typst:prop` or `typst:text:prop` and assumes the values are raw Typst code.
+
+`prop` is the name of the property to set.
+
+For example, `pandoc -f html -t typst` with HTML input
+
+```html
+<div typst:inset="10pt">foo</div>
+```
+
+produces Typst output
+
+```typst
+#block(inset: 10pt)[
+foo
+]
+```
+
+and with HTML input
+
+```html
+<div typst:text:fill="purple">foo</div>
+```
+
+it produces Typst output
+
+```typst
+#block[
+#set text(fill: purple); foo
+]
+```
+
+The Typst Writer does not check the validity of `prop` or the value. Since Typst is a statically typed language, improper property names or values usually result in compilation failure.
+
+Supported elements
+------------------
+
+The following Pandoc AST elements are currently supported. More may be supported in the future.
+
+- [Span](https://pandoc.org/lua-filters.html#type-span)
+
+  `typst:text:prop`
+
+  : The content is wrapped in a Typst [text element](https://typst.app/docs/reference/text/text/) with the specified properties set.
+
+- [Div](https://pandoc.org/lua-filters.html#type-div)
+
+  `typst:prop`
+
+  : The `prop` is output as a parameter to the Typst [block element](https://typst.app/docs/reference/layout/block/).
+
+  `typst:text:prop`
+
+  : The `prop` is output as a parameter to a set-text rule at the start of the block content.
+
+- [Table](https://pandoc.org/lua-filters.html#type-table)
+
+  `typst:prop`
+
+  : The `prop` is output as a parameter to the Typst [table element](https://typst.app/docs/reference/model/table/).
+
+  `typst:text:prop`
+
+  : The table is wrapped in a Typst [text element](https://typst.app/docs/reference/text/text/) with `prop` as one of its parameters.
+
+- Table [Cell](https://pandoc.org/lua-filters.html#type-cell)
+
+  `typst:prop`
+
+  : The `prop` is output as a parameter to the Typst table [cell element](https://typst.app/docs/reference/model/table/#definitions-cell).
+
+  `typst:text:prop`
+
+  : The `prop` is output as a parameter to a set-text rule at the start of the cell content.
+
+
+Lua filter example
+------------------
+
+Here is a minimal example of a Lua filter which translates the CSS [color property](https://developer.mozilla.org/en-US/docs/Web/CSS/color) on a span element to the equivalent [fill parameter](https://typst.app/docs/reference/text/text/#parameters-fill) on a Typst text element.
+
+```lua
+function styleToTable(style)
+  if not style then return nil end
+  local ret = {}
+  for clause in style:gmatch('([^;]+)') do
+    k,v = clause:match("([%w-]+)%s*:%s*(.*)$")
+    ret[k] = v
+  end
+  return ret
+end
+
+function Span(span)
+  local style = styleToTable(span.attributes['style'])
+  if not style then return end
+  if style['color'] then
+    span.attributes['typst:text:fill'] = style['color']
+  end
+  return span
+end
+```
+
+Given the HTML input
+
+```html
+<p>Here is some <span style="color:orange">orange text</span>.</p>
+```
+
+the command
+
+```sh
+pandoc -f html -t typst --lua-filter ./typst-property-example.lua
+```
+
+will produce the Typst output
+
+```typst
+Here is some #text(fill: orange)[orange text].
+```
+
+Of course, this simple filter will only work for Typst's [predefined colors](https://typst.app/docs/reference/visualize/color/#predefined-colors). A more complete filter would need to translate the value as well.

src/Text/Pandoc/Writers/Typst.hs

@@ -21,6 +21,7 @@ import Text.Pandoc.Class ( PandocMonad)
 import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..), isEnabled )
 import Data.Text (Text)
 import Data.List (intercalate, intersperse)
+import Data.Bifunctor (first, second)
 import Network.URI (unEscapeString)
 import qualified Data.Text as T
 import Control.Monad.State ( StateT, evalStateT, gets, modify )
@@ -88,6 +89,37 @@ pandocToTypst options (Pandoc meta blocks) = do
        Nothing  -> main
        Just tpl -> renderTemplate tpl context
 
+pickTypstAttrs :: [(Text, Text)] -> ([(Text, Text)],[(Text, Text)])
+pickTypstAttrs = foldr go ([],[])
+  where
+    go (k,v) =
+      case T.splitOn ":" k of
+        "typst":"text":x:[] -> second ((x,v):)
+        "typst":x:[] -> first ((x,v):)
+        _ -> id
+
+formatTypstProp :: (Text, Text) -> Text
+formatTypstProp (k,v) = k <> ": " <> v
+
+toTypstPropsListSep :: [(Text, Text)] -> Doc Text
+toTypstPropsListSep = hsep . intersperse "," . (map $ literal . formatTypstProp)
+
+toTypstPropsListTerm :: [(Text, Text)] -> Doc Text
+toTypstPropsListTerm [] = ""
+toTypstPropsListTerm typstAttrs = toTypstPropsListSep typstAttrs <> ","
+
+toTypstPropsListParens :: [(Text, Text)] -> Doc Text
+toTypstPropsListParens [] = ""
+toTypstPropsListParens typstAttrs = parens $ toTypstPropsListSep typstAttrs
+
+toTypstTextElement :: [(Text, Text)] -> Doc Text -> Doc Text
+toTypstTextElement [] content = content
+toTypstTextElement typstTextAttrs content = "#text" <> toTypstPropsListParens typstTextAttrs <> brackets content
+
+toTypstSetText :: [(Text, Text)] -> Doc Text
+toTypstSetText [] = ""
+toTypstSetText typstTextAttrs = "#set text" <> parens (toTypstPropsListSep typstTextAttrs) <> "; " -- newline?
+
 blocksToTypst :: PandocMonad m => [Block] -> TW m (Doc Text)
 blocksToTypst blocks = vcat <$> mapM blockToTypst blocks
 
@@ -163,7 +195,7 @@ blockToTypst block =
                    else vsep items') $$ blankline
     DefinitionList items ->
       ($$ blankline) . vsep <$> mapM defListItemToTypst items
-    Table (ident,_,_) (Caption _ caption) colspecs thead tbodies tfoot -> do
+    Table (ident,_,tabkvs) (Caption _ caption) colspecs thead tbodies tfoot -> do
       let lab = toLabel FreestandingLabel ident
       capt' <- if null caption
                   then return mempty
@@ -185,26 +217,40 @@ blockToTypst block =
           formatalign AlignCenter = "center,"
           formatalign AlignDefault = "auto,"
       let alignarray = parens $ mconcat $ map formatalign aligns
-      let fromCell (Cell _attr alignment rowspan colspan bs) = do
-            let cellattrs =
+
+      let fromCell (Cell (_,_,kvs) alignment rowspan colspan bs) = do
+            let (typstAttrs, typstTextAttrs) = pickTypstAttrs kvs
+            let valign =
+                  (case lookup "typst:align" typstAttrs of
+                    Just va -> [va]
+                    _ -> [])
+            let typstAttrs2 = filter ((/="typst:align") . fst) typstAttrs
+            let halign =
                   (case alignment of
-                     AlignDefault -> []
-                     AlignLeft -> [ "align: left" ]
-                     AlignRight -> [ "align: right" ]
-                     AlignCenter -> [ "align: center" ]) ++
+                    AlignDefault -> []
+                    AlignLeft -> [ "left" ]
+                    AlignRight -> [ "right" ]
+                    AlignCenter -> [ "center" ])
+            let cellaligns = valign ++ halign
+            let cellattrs =
+                  (case cellaligns of
+                    [] -> []
+                    _ -> [ "align: " <> T.intercalate " + " cellaligns ]) ++
                   (case rowspan of
                      RowSpan 1 -> []
                      RowSpan n -> [ "rowspan: " <> tshow n ]) ++
                   (case colspan of
                      ColSpan 1 -> []
-                     ColSpan n -> [ "colspan: " <> tshow n ])
+                     ColSpan n -> [ "colspan: " <> tshow n ]) ++
+                  map formatTypstProp typstAttrs2
             cellContents <- blocksToTypst bs
+            let contents2 = brackets (toTypstSetText typstTextAttrs <> cellContents)
             pure $ if null cellattrs
-                      then brackets cellContents
+                      then contents2
                       else "table.cell" <>
                             parens
                              (literal (T.intercalate ", " cellattrs)) <>
-                            brackets cellContents
+                            contents2
       let fromRow (Row _ cs) =
             (<> ",") . commaSep <$> mapM fromCell cs
       let fromHead (TableHead _attr headRows) =
@@ -223,22 +269,24 @@ blockToTypst block =
             hrows <- mapM fromRow headRows
             brows <- mapM fromRow bodyRows
             pure $ vcat (hrows ++ ["table.hline()," | not (null hrows)] ++ brows)
+      let (typstAttrs, typstTextAttrs) = pickTypstAttrs tabkvs
       header <- fromHead thead
       footer <- fromFoot tfoot
       body <- vcat <$> mapM fromTableBody tbodies
       return $
         "#figure("
         $$
         nest 2
-         ("align(center)[#table("
+         ("align(center)[" <> toTypstTextElement typstTextAttrs ("#table("
           $$ nest 2
              (  "columns: " <> columns <> ","
              $$ "align: " <> alignarray <> ","
+             $$ toTypstPropsListTerm typstAttrs
              $$ header
              $$ body
              $$ footer
              )
-          $$ ")]"
+          $$ ")]")
           $$ capt'
           $$ ", kind: table"
           $$ ")")
@@ -261,10 +309,13 @@ blockToTypst block =
                           $$ ")" $$ lab $$ blankline
     Div (ident,_,_) (Header lev ("",cls,kvs) ils:rest) ->
       blocksToTypst (Header lev (ident,cls,kvs) ils:rest)
-    Div (ident,_,_) blocks -> do
+    Div (ident,_,kvs) blocks -> do
       let lab = toLabel FreestandingLabel ident
+      let (typstAttrs,typstTextAttrs) = pickTypstAttrs kvs
       contents <- blocksToTypst blocks
-      return $ "#block[" $$ contents $$ ("]" <+> lab)
+      return $ "#block" <> toTypstPropsListParens typstAttrs <> "["
+        $$ toTypstSetText typstTextAttrs <> contents
+        $$ ("]" <+> lab)
 
 defListItemToTypst :: PandocMonad m => ([Inline], [[Block]]) -> TW m (Doc Text)
 defListItemToTypst (term, defns) = do
@@ -323,9 +374,14 @@ inlineToTypst inline =
     Superscript inlines -> textstyle "#super" inlines
     Subscript inlines -> textstyle "#sub" inlines
     SmallCaps inlines -> textstyle "#smallcaps" inlines
-    Span (ident,_,_) inlines -> do
+    Span (ident,_,kvs) inlines -> do
       let lab = toLabel FreestandingLabel ident
-      (<> lab) <$> inlinesToTypst inlines
+      let (_, typstTextAttrs) = pickTypstAttrs kvs
+      case typstTextAttrs of
+        [] -> (<> lab) <$> inlinesToTypst inlines
+        _ -> do
+          contents <- inlinesToTypst inlines
+          return $ toTypstTextElement typstTextAttrs contents <> lab
     Quoted quoteType inlines -> do
       let q = case quoteType of
                    DoubleQuote -> literal "\""