{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Writers.Typst
   Copyright   : Copyright (C) 2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   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)
import Text.Pandoc.ImageSize ( dimension, Dimension(Pixel), Direction(..),
                               showInInch )
import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..), isEnabled,
                             CaptionPosition(..) )
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 )
import Text.Pandoc.Writers.Shared ( metaToContext, defField, resetField,
                                    lookupMetaString,
                                    isOrderedListMarker )
import Text.Pandoc.Shared (isTightList, orderedListMarkers, tshow)
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 Text.Collate.Lang (Lang(..), parseLang)
import Text.Printf (printf)
import Data.Char (isAlphaNum)
import Data.Maybe (fromMaybe)

-- | Convert Pandoc to Typst.
writeTypst :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTypst :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTypst WriterOptions
options Pandoc
document =
  StateT WriterState m Text -> WriterState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions -> Pandoc -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> TW m Text
pandocToTypst WriterOptions
options Pandoc
document)
    WriterState{ stOptions :: WriterOptions
stOptions = WriterOptions
options,
                 stEscapeContext :: EscapeContext
stEscapeContext = EscapeContext
NormalContext }

data EscapeContext = NormalContext | TermContext
  deriving (Int -> EscapeContext -> ShowS
[EscapeContext] -> ShowS
EscapeContext -> String
(Int -> EscapeContext -> ShowS)
-> (EscapeContext -> String)
-> ([EscapeContext] -> ShowS)
-> Show EscapeContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EscapeContext -> ShowS
showsPrec :: Int -> EscapeContext -> ShowS
$cshow :: EscapeContext -> String
show :: EscapeContext -> String
$cshowList :: [EscapeContext] -> ShowS
showList :: [EscapeContext] -> ShowS
Show, EscapeContext -> EscapeContext -> Bool
(EscapeContext -> EscapeContext -> Bool)
-> (EscapeContext -> EscapeContext -> Bool) -> Eq EscapeContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EscapeContext -> EscapeContext -> Bool
== :: EscapeContext -> EscapeContext -> Bool
$c/= :: EscapeContext -> EscapeContext -> Bool
/= :: EscapeContext -> EscapeContext -> Bool
Eq)

data WriterState =
  WriterState {
    WriterState -> WriterOptions
stOptions :: WriterOptions,
    WriterState -> EscapeContext
stEscapeContext :: EscapeContext }

type TW m = StateT WriterState m

pandocToTypst :: PandocMonad m
              => WriterOptions -> Pandoc -> TW m Text
pandocToTypst :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> TW m Text
pandocToTypst WriterOptions
options (Pandoc Meta
meta [Block]
blocks) = do
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
options WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
options
                    else Maybe Int
forall a. Maybe a
Nothing
  metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
options
              [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst
              ((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst)
              Meta
meta
  main <- blocksToTypst blocks
  let toPosition :: CaptionPosition -> Text
      toPosition CaptionPosition
CaptionAbove = Text
"top"
      toPosition CaptionPosition
CaptionBelow = Text
"bottom"
  let context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
options)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
options
                    then Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"citations" Bool
True
                    else Context Text -> Context Text
forall a. a -> a
id)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (case Text -> Meta -> Text
lookupMetaString Text
"lang" Meta
meta of
                    Text
"" -> Context Text -> Context Text
forall a. a -> a
id
                    Text
lang ->
                      case Text -> Either String Lang
parseLang Text
lang of
                        Left String
_ -> Context Text -> Context Text
forall a. a -> a
id
                        Right Lang
l ->
                          Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"lang" (Lang -> Text
langLanguage Lang
l) (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          (Context Text -> Context Text)
-> (Text -> Context Text -> Context Text)
-> Maybe Text
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"region") (Lang -> Maybe Text
langRegion Lang
l))
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"smart" (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
options)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc-depth" (Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerTOCDepth WriterOptions
options)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"figure-caption-position"
                   (CaptionPosition -> Text
toPosition (CaptionPosition -> Text) -> CaptionPosition -> Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> CaptionPosition
writerFigureCaptionPosition WriterOptions
options)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"table-caption-position"
                   (CaptionPosition -> Text
toPosition (CaptionPosition -> Text) -> CaptionPosition -> Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> CaptionPosition
writerTableCaptionPosition WriterOptions
options)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"page-numbering" (Text
"1" :: Text)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ (if WriterOptions -> Bool
writerNumberSections WriterOptions
options
                    then Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"numbering" (Text
"1.1.1.1.1" :: Text)
                    else Context Text -> Context Text
forall a. a -> a
id)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  return $ render colwidth $
    case writerTemplate options of
       Maybe (Template Text)
Nothing  -> Doc Text
main
       Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

pickTypstAttrs :: [(Text, Text)] -> ([(Text, Text)],[(Text, Text)])
pickTypstAttrs :: [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
pickTypstAttrs = ((Text, Text)
 -> ([(Text, Text)], [(Text, Text)])
 -> ([(Text, Text)], [(Text, Text)]))
-> ([(Text, Text)], [(Text, Text)])
-> [(Text, Text)]
-> ([(Text, Text)], [(Text, Text)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, Text)
-> ([(Text, Text)], [(Text, Text)])
-> ([(Text, Text)], [(Text, Text)])
forall {p :: * -> * -> *} {b}.
Bifunctor p =>
(Text, b) -> p [(Text, b)] [(Text, b)] -> p [(Text, b)] [(Text, b)]
go ([],[])
  where
    go :: (Text, b) -> p [(Text, b)] [(Text, b)] -> p [(Text, b)] [(Text, b)]
go (Text
k,b
v) =
      case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
":" Text
k of
        Text
"typst":Text
"text":Text
x:[] -> ([(Text, b)] -> [(Text, b)])
-> p [(Text, b)] [(Text, b)] -> p [(Text, b)] [(Text, b)]
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Text
x,b
v)(Text, b) -> [(Text, b)] -> [(Text, b)]
forall a. a -> [a] -> [a]
:)
        Text
"typst":Text
x:[] -> ([(Text, b)] -> [(Text, b)])
-> p [(Text, b)] [(Text, b)] -> p [(Text, b)] [(Text, b)]
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
x,b
v)(Text, b) -> [(Text, b)] -> [(Text, b)]
forall a. a -> [a] -> [a]
:)
        [Text]
_ -> p [(Text, b)] [(Text, b)] -> p [(Text, b)] [(Text, b)]
forall a. a -> a
id

formatTypstProp :: (Text, Text) -> Text
formatTypstProp :: (Text, Text) -> Text
formatTypstProp (Text
k,Text
v) = Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v

toTypstPropsListSep :: [(Text, Text)] -> Doc Text
toTypstPropsListSep :: [(Text, Text)] -> Doc Text
toTypstPropsListSep = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ([Doc Text] -> Doc Text)
-> ([(Text, Text)] -> [Doc Text]) -> [(Text, Text)] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
"," ([Doc Text] -> [Doc Text])
-> ([(Text, Text)] -> [Doc Text]) -> [(Text, Text)] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text])
-> ((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text)
-> ((Text, Text) -> Text) -> (Text, Text) -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
formatTypstProp)

toTypstPropsListTerm :: [(Text, Text)] -> Doc Text
toTypstPropsListTerm :: [(Text, Text)] -> Doc Text
toTypstPropsListTerm [] = Doc Text
""
toTypstPropsListTerm [(Text, Text)]
typstAttrs = [(Text, Text)] -> Doc Text
toTypstPropsListSep [(Text, Text)]
typstAttrs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
","

toTypstPropsListParens :: [(Text, Text)] -> Doc Text
toTypstPropsListParens :: [(Text, Text)] -> Doc Text
toTypstPropsListParens [] = Doc Text
""
toTypstPropsListParens [(Text, Text)]
typstAttrs = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Doc Text
toTypstPropsListSep [(Text, Text)]
typstAttrs

toTypstTextElement :: [(Text, Text)] -> Doc Text -> Doc Text
toTypstTextElement :: [(Text, Text)] -> Doc Text -> Doc Text
toTypstTextElement [] Doc Text
content = Doc Text
content
toTypstTextElement [(Text, Text)]
typstTextAttrs Doc Text
content = Doc Text
"#text" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)] -> Doc Text
toTypstPropsListParens [(Text, Text)]
typstTextAttrs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
content

toTypstSetText :: [(Text, Text)] -> Doc Text
toTypstSetText :: [(Text, Text)] -> Doc Text
toTypstSetText [] = Doc Text
""
toTypstSetText [(Text, Text)]
typstTextAttrs = Doc Text
"#set text" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens ([(Text, Text)] -> Doc Text
toTypstPropsListSep [(Text, Text)]
typstTextAttrs) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"; " -- newline?

blocksToTypst :: PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst :: forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TW m (Doc Text)
blockToTypst [Block]
blocks

blockToTypst :: PandocMonad m => Block -> TW m (Doc Text)
blockToTypst :: forall (m :: * -> *). PandocMonad m => Block -> TW m (Doc Text)
blockToTypst Block
block =
  case Block
block of
    Plain [Inline]
inlines -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
    Para [Inline]
inlines -> (Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline) (Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
    Header Int
level (Text
ident,[Text]
cls,[(Text, Text)]
_) [Inline]
inlines -> do
      contents <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
      let lab = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel Text
ident
      let headingAttrs =
            [Text
"outlined: false" | Text
"unlisted" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
            [Text
"numbering: none" | Text
"unnumbered" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls]
      return $
        if null headingAttrs
           then nowrap
                 (literal (T.replicate level "=") <> space <> contents) <>
                 cr <> lab
           else literal "#heading" <>
                  parens (literal (T.intercalate ", "
                              ("level: " <> tshow level : headingAttrs))) <>
                  brackets contents <> cr <> lab
    RawBlock Format
fmt Text
str ->
      case Format
fmt of
        Format Text
"typst" -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
        Format
_ -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
    CodeBlock (Text
_,[Text]
cls,[(Text, Text)]
_) Text
code -> do
      let go :: Char -> (Int, Int) -> (Int, Int)
          go :: Char -> (Int, Int) -> (Int, Int)
go Char
'`' (Int
longest, Int
current) =
            let !new :: Int
new = Int
current Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 in (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
longest Int
new, Int
new)
          go Char
_ (Int
longest, Int
_) = (Int
longest, Int
0)
      let (Int
longestBacktickSequence, Int
_) = (Char -> (Int, Int) -> (Int, Int))
-> (Int, Int) -> Text -> (Int, Int)
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> (Int, Int) -> (Int, Int)
go (Int
0,Int
0) Text
code
      let fence :: Doc Text
fence = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
3 (Int
longestBacktickSequence Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Text
"`"
      let lang :: Doc Text
lang = case [Text]
cls of
                   (Text
cl:[Text]
_) -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
cl
                   [Text]
_ -> Doc Text
forall a. Monoid a => a
mempty
      Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
fence Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
lang Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
fence Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
    LineBlock [[Inline]]
lns -> do
      contents <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst ([Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
lns)
      return $ contents <> blankline
    BlockQuote [Block]
blocks -> do
      contents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      return $ "#quote(block: true)[" $$ chomp contents $$ "]" $$ blankline
    Block
HorizontalRule ->
      Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"#horizontalrule" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
    OrderedList ListAttributes
attribs [[Block]]
items -> do
      let addBlock :: Doc Text -> Doc Text
addBlock = case ListAttributes
attribs of
                       (Int
1, ListNumberStyle
DefaultStyle, ListNumberDelim
DefaultDelim) -> Doc Text -> Doc Text
forall a. a -> a
id
                       (Int
1, ListNumberStyle
Decimal, ListNumberDelim
Period) -> Doc Text -> Doc Text
forall a. a -> a
id
                       (Int
start, ListNumberStyle
sty, ListNumberDelim
delim) -> \Doc Text
x ->
                              Doc Text
"#block[" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                               (Doc Text
"#set enum" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                  Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (
                                    Doc Text
"numbering: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                    Text -> Doc Text
doubleQuoted
                                     (case ListAttributes -> [Text]
orderedListMarkers (Int
1, ListNumberStyle
sty, ListNumberDelim
delim) of
                                          (Text
m:[Text]
_) -> Text
m
                                          [] -> Text
"1.") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                    Doc Text
", start: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                                      String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
start) )) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                               Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                               Doc Text
"]"
      items' <- ([Block] -> TW m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (TW m (Doc Text) -> TW m (Doc Text))
-> ([Block] -> TW m (Doc Text)) -> [Block] -> TW m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Int -> Doc Text -> [Block] -> TW m (Doc Text)
listItemToTypst Int
2 (Doc Text
"+")) [[Block]]
items
      return $ addBlock
               (if isTightList items
                   then vcat items'
                   else vsep items')
              $$ blankline
    BulletList [[Block]]
items -> do
      items' <- ([Block] -> TW m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (TW m (Doc Text) -> TW m (Doc Text))
-> ([Block] -> TW m (Doc Text)) -> [Block] -> TW m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> [Block] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Int -> Doc Text -> [Block] -> TW m (Doc Text)
listItemToTypst Int
2 Doc Text
"-") [[Block]]
items
      return $ (if isTightList items
                   then vcat items'
                   else vsep items') $$ blankline
    DefinitionList [([Inline], [[Block]])]
items ->
      (Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline) (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]]) -> TW m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Inline], [[Block]]) -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> TW m (Doc Text)
defListItemToTypst [([Inline], [[Block]])]
items
    Table (Text
ident,[Text]
tabclasses,[(Text, Text)]
tabkvs) (Caption Maybe [Inline]
_ [Block]
caption) [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot -> do
      let lab :: Doc Text
lab = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel Text
ident
      capt' <- if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
caption
                  then Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
                  else do
                    captcontents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
caption
                    return $ ", caption: " <> brackets captcontents
      let typstFigureKind = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
", kind: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"table" (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"typst:figure:kind" [(Text, Text)]
tabkvs))
      let numcols = [ColSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
colspecs
      let (aligns, widths) = unzip colspecs
      let commaSep = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
", "
      let toPercentage (ColWidth Double
w) =
            Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ ((Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0'))
                         (String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%0.2f" (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100))) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
          toPercentage ColWidth
ColWidthDefault = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"auto"
      let columns = if (ColWidth -> Bool) -> [ColWidth] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ColWidth -> ColWidth -> Bool
forall a. Eq a => a -> a -> Bool
== ColWidth
ColWidthDefault) [ColWidth]
widths
                       then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
numcols
                       else Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens ([Doc Text] -> Doc Text
commaSep ((ColWidth -> Doc Text) -> [ColWidth] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map ColWidth -> Doc Text
toPercentage [ColWidth]
widths))
      let formatalign Alignment
AlignLeft = a
"left,"
          formatalign Alignment
AlignRight = a
"right,"
          formatalign Alignment
AlignCenter = a
"center,"
          formatalign Alignment
AlignDefault = a
"auto,"
      let alignarray = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Alignment -> Doc Text) -> [Alignment] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Alignment -> Doc Text
forall {a}. IsString a => Alignment -> a
formatalign [Alignment]
aligns

      let fromCell (Cell (Text
_,[Text]
_,[(Text, Text)]
kvs) Alignment
alignment RowSpan
rowspan ColSpan
colspan [Block]
bs) = do
            let ([(Text, Text)]
typstAttrs, [(Text, Text)]
typstTextAttrs) = [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
pickTypstAttrs [(Text, Text)]
kvs
            let valign :: [Text]
valign =
                  (case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"align" [(Text, Text)]
typstAttrs of
                    Just Text
va -> [Text
va]
                    Maybe Text
_ -> [])
            let typstAttrs2 :: [(Text, Text)]
typstAttrs2 = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
"align") (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, Text)]
typstAttrs
            let halign :: [Text]
halign =
                  (case Alignment
alignment of
                    Alignment
AlignDefault -> []
                    Alignment
AlignLeft -> [ Text
"left" ]
                    Alignment
AlignRight -> [ Text
"right" ]
                    Alignment
AlignCenter -> [ Text
"center" ])
            let cellaligns :: [Text]
cellaligns = [Text]
valign [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
halign
            let cellattrs :: [Text]
cellattrs =
                  (case [Text]
cellaligns of
                    [] -> []
                    [Text]
_ -> [ Text
"align: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" + " [Text]
cellaligns ]) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                  (case RowSpan
rowspan of
                     RowSpan Int
1 -> []
                     RowSpan Int
n -> [ Text
"rowspan: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n ]) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                  (case ColSpan
colspan of
                     ColSpan Int
1 -> []
                     ColSpan Int
n -> [ Text
"colspan: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n ]) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                  ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
formatTypstProp [(Text, Text)]
typstAttrs2
            cellContents <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
bs
            let contents2 = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets ([(Text, Text)] -> Doc Text
toTypstSetText [(Text, Text)]
typstTextAttrs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
cellContents)
            pure $ if null cellattrs
                      then contents2
                      else "table.cell" <>
                            parens
                             (literal (T.intercalate ", " cellattrs)) <>
                            contents2
      let fromRow (Row (Text, [Text], [(Text, Text)])
_ [Cell]
cs) =
            (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
",") (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
commaSep ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cell -> StateT WriterState m (Doc Text))
-> [Cell] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Cell -> StateT WriterState m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Cell -> StateT WriterState m (Doc Text)
fromCell [Cell]
cs
      let fromHead (TableHead (Text, [Text], [(Text, Text)])
_attr [Row]
headRows) =
            if [Row] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Row]
headRows
               then Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
               else ((Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"table.hline(),") (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
",") (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text
"table.header" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat)
                      ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Row -> StateT WriterState m (Doc Text))
-> [Row] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Row -> StateT WriterState m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Row -> StateT WriterState m (Doc Text)
fromRow [Row]
headRows
      let fromFoot (TableFoot (Text, [Text], [(Text, Text)])
_attr [Row]
footRows) =
            if [Row] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Row]
footRows
               then Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
               else ((Doc Text
"table.hline()," Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$) (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
",") (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text
"table.footer" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat)
                      ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Row -> StateT WriterState m (Doc Text))
-> [Row] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Row -> StateT WriterState m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Row -> StateT WriterState m (Doc Text)
fromRow [Row]
footRows
      let fromTableBody (TableBody (Text, [Text], [(Text, Text)])
_attr RowHeadColumns
_rowHeadCols [Row]
headRows [Row]
bodyRows) = do
            hrows <- (Row -> StateT WriterState m (Doc Text))
-> [Row] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Row -> StateT WriterState m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Row -> StateT WriterState m (Doc Text)
fromRow [Row]
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
      let table = [(Text, Text)] -> Doc Text
toTypstSetText [(Text, Text)]
typstTextAttrs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"#table("
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2
                (  Doc Text
"columns: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
columns Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
","
                Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"align: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
alignarray Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
","
                Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [(Text, Text)] -> Doc Text
toTypstPropsListTerm [(Text, Text)]
typstAttrs
                Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
header
                Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body
                Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
footer
            )
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
")"
      return $ if "typst:no-figure" `elem` tabclasses
        then table
        else "#figure("
            $$
            nest 2
            ("align(center)[" <> table <> "]"
              $$ capt'
              $$ typstFigureKind
              $$ ")")
            $$ lab
          $$ blankline
    Figure (Text
ident,[Text]
_,[(Text, Text)]
_) (Caption Maybe [Inline]
_mbshort [Block]
capt) [Block]
blocks -> do
      caption <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
capt
      opts <-  gets stOptions
      contents <- case blocks of
                     -- don't need #box around block-level image
                     [Para [Image (Text, [Text], [(Text, Text)])
attr [Inline]
_ (Text
src, Text
_)]]
                       -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> Bool -> Text -> (Text, [Text], [(Text, Text)]) -> Doc Text
mkImage WriterOptions
opts Bool
False Text
src (Text, [Text], [(Text, Text)])
attr
                     [Plain [Image (Text, [Text], [(Text, Text)])
attr [Inline]
_ (Text
src, Text
_)]]
                       -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions
-> Bool -> Text -> (Text, [Text], [(Text, Text)]) -> Doc Text
mkImage WriterOptions
opts Bool
False Text
src (Text, [Text], [(Text, Text)])
attr
                     [Block]
_ -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      let lab = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel Text
ident
      return $ "#figure(" <> nest 2 ((contents <> ",")
                                     $$
                                     ("caption: [" $$ nest 2 caption $$ "]")
                                    )
                          $$ ")" $$ lab $$ blankline
    Div (Text
ident,[Text]
_,[(Text, Text)]
_) (Header Int
lev (Text
"",[Text]
cls,[(Text, Text)]
kvs) [Inline]
ils:[Block]
rest) ->
      [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst (Int -> (Text, [Text], [(Text, Text)]) -> [Inline] -> Block
Header Int
lev (Text
ident,[Text]
cls,[(Text, Text)]
kvs) [Inline]
ilsBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
rest)
    Div (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Block]
blocks -> do
      let lab :: Doc Text
lab = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel Text
ident
      let ([(Text, Text)]
typstAttrs,[(Text, Text)]
typstTextAttrs) = [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
pickTypstAttrs [(Text, Text)]
kvs
      contents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      return $ "#block" <> toTypstPropsListParens typstAttrs <> "["
        $$ toTypstSetText typstTextAttrs <> contents
        $$ ("]" <+> lab)

defListItemToTypst :: PandocMonad m => ([Inline], [[Block]]) -> TW m (Doc Text)
defListItemToTypst :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> TW m (Doc Text)
defListItemToTypst ([Inline]
term, [[Block]]
defns) = do
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stEscapeContext = TermContext }
  term' <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
term
  modify $ \WriterState
st -> WriterState
st{ stEscapeContext = NormalContext }
  defns' <- mapM blocksToTypst defns
  return $ nowrap ("/ " <> term' <> ": " <> "#block[") $$
            chomp (vsep defns') $$ "]"

listItemToTypst :: PandocMonad m => Int -> Doc Text -> [Block] -> TW m (Doc Text)
listItemToTypst :: forall (m :: * -> *).
PandocMonad m =>
Int -> Doc Text -> [Block] -> TW m (Doc Text)
listItemToTypst Int
ind Doc Text
marker [Block]
blocks = do
  contents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
  return $ hang ind (marker <> space) contents

inlinesToTypst :: PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst :: forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
ils = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT WriterState m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> TW m (Doc Text)
inlineToTypst [Inline]
ils

inlineToTypst :: PandocMonad m => Inline -> TW m (Doc Text)
inlineToTypst :: forall (m :: * -> *). PandocMonad m => Inline -> TW m (Doc Text)
inlineToTypst Inline
inline =
  case Inline
inline of
    Str Text
txt -> do
      opts <-  (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
      context <- gets stEscapeContext
      return $ escapeTypst (isEnabled Ext_smart opts) context txt
    Inline
Space -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
    Inline
SoftBreak -> do
      wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> WrapOption) -> StateT WriterState m WrapOption)
-> (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall a b. (a -> b) -> a -> b
$ WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
      case wrapText of
        WrapOption
WrapPreserve -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
        WrapOption
WrapAuto     -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
        WrapOption
WrapNone     -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
    Inline
LineBreak -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr)
    Math MathType
mathType Text
str -> do
      res <- (DisplayType -> [Exp] -> Text)
-> MathType -> Text -> StateT WriterState m (Either Inline Text)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Text
TM.writeTypst MathType
mathType Text
str
      case res of
          Left Inline
il -> Inline -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> TW m (Doc Text)
inlineToTypst Inline
il
          Right Text
r ->
            case MathType
mathType of
              MathType
InlineMath -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"$" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
r Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"$"
              MathType
DisplayMath -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"$ " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
r Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" $"
    Code (Text
_,[Text]
cls,[(Text, Text)]
_) Text
code -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
      case [Text]
cls of
        (Text
lang:[Text]
_) -> Doc Text
"#raw(lang:" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
lang Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                        Doc Text
", " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
code Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
        [Text]
_ | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'`') Text
code -> Doc Text
"#raw(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
code Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
                                     Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
          | Bool
otherwise -> Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
    RawInline Format
fmt Text
str ->
      case Format
fmt of
        Format Text
"typst" -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
        Format
_ -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
    Strikeout [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#strike" [Inline]
inlines
    Emph [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#emph" [Inline]
inlines
    Underline [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#underline" [Inline]
inlines
    Strong [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#strong" [Inline]
inlines
    Superscript [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#super" [Inline]
inlines
    Subscript [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#sub" [Inline]
inlines
    SmallCaps [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#smallcaps" [Inline]
inlines
    Span (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
inlines -> do
      let lab :: Doc Text
lab = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel Text
ident
      let ([(Text, Text)]
_, [(Text, Text)]
typstTextAttrs) = [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
pickTypstAttrs [(Text, Text)]
kvs
      case [(Text, Text)]
typstTextAttrs of
        [] -> (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
lab) (Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
        [(Text, Text)]
_ -> do
          contents <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
          return $ toTypstTextElement typstTextAttrs contents <> lab
    Quoted QuoteType
quoteType [Inline]
inlines -> do
      opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
      let smart = Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts
      contents <- inlinesToTypst inlines
      return $
        case quoteType of
           QuoteType
DoubleQuote
             | Bool
smart -> Doc Text
"\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
             | Bool
otherwise -> Doc Text
"“" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"”"
           QuoteType
SingleQuote
             | Bool
smart -> Doc Text
"'" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"'"
             | Bool
otherwise -> Doc Text
"‘" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"’"
    Cite [Citation]
citations [Inline]
inlines -> do
      opts <-  (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
      if isEnabled Ext_citations opts
         -- Note: this loses prefix
         then mconcat <$> mapM toCite citations
         else inlinesToTypst inlines
    Link (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
inlines (Text
src,Text
_tit) -> do
      case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"reference-type" [(Text, Text)]
kvs of
        Just Text
"ref"
          | Just (Char
'#', Text
ident) <- Text -> Maybe (Char, Text)
T.uncons Text
src
          -> if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isIdentChar Text
ident
                then Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident
                else Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"#ref" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (LabelType -> Text -> Doc Text
toLabel LabelType
ArgumentLabel Text
ident)
                            Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
        Maybe Text
_ -> do
          contents <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
          let dest = case Text -> Maybe (Char, Text)
T.uncons Text
src of
                       Just (Char
'#', Text
ident) -> LabelType -> Text -> Doc Text
toLabel LabelType
ArgumentLabel Text
ident
                       Maybe (Char, Text)
_ -> Text -> Doc Text
doubleQuoted Text
src
          pure $ "#link" <> parens dest <>
                    (if inlines == [Str src]
                          then mempty
                          else nowrap $ brackets contents) <> endCode
    Image (Text, [Text], [(Text, Text)])
attr [Inline]
_inlines (Text
src,Text
_tit) -> do
      opts <-  (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
      pure $ mkImage opts True src attr
    Note [Block]
blocks -> do
      contents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      return $ "#footnote" <> brackets (chomp contents) <> endCode

-- see #9104; need box or image is treated as block-level
mkImage :: WriterOptions -> Bool -> Text -> Attr -> Doc Text
mkImage :: WriterOptions
-> Bool -> Text -> (Text, [Text], [(Text, Text)]) -> Doc Text
mkImage WriterOptions
opts Bool
useBox Text
src (Text, [Text], [(Text, Text)])
attr
  | Bool
useBox = Doc Text
"#box" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens Doc Text
coreImage
  | Bool
otherwise = Doc Text
coreImage
 where
  src' :: Text
src' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src -- #9389
  showDim :: Dimension -> Doc Text
showDim (Pixel Integer
a) = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Dimension -> Text
showInInch WriterOptions
opts (Integer -> Dimension
Pixel Integer
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in")
  showDim Dimension
dim = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Dimension -> String
forall a. Show a => a -> String
show Dimension
dim)
  dimAttrs :: Doc Text
dimAttrs =
     (case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Height (Text, [Text], [(Text, Text)])
attr of
        Maybe Dimension
Nothing -> Doc Text
forall a. Monoid a => a
mempty
        Just Dimension
dim -> Doc Text
", height: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Dimension -> Doc Text
showDim Dimension
dim) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
     (case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
Width (Text, [Text], [(Text, Text)])
attr of
        Maybe Dimension
Nothing -> Doc Text
forall a. Monoid a => a
mempty
        Just Dimension
dim -> Doc Text
", width: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Dimension -> Doc Text
showDim Dimension
dim)
  isData :: Bool
isData = Text
"data:" Text -> Text -> Bool
`T.isPrefixOf` Text
src'
  dataSvg :: Text
dataSvg = Text
"<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><image xlink:href=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" /></svg>"
  coreImage :: Doc Text
coreImage
    | Bool
isData = Doc Text
"image.decode" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens(Text -> Doc Text
doubleQuoted Text
dataSvg Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
dimAttrs)
    | Bool
otherwise = Doc Text
"image" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Text -> Doc Text
doubleQuoted Text
src' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
dimAttrs)

textstyle :: PandocMonad m => Doc Text -> [Inline] -> TW m (Doc Text)
textstyle :: forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
s [Inline]
inlines =
  (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text
s Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
addEscape (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
 where
   addEscape :: Doc Text -> Doc Text
addEscape =
     case [Inline]
inlines of
       (Str Text
t : [Inline]
_)
         | Text -> Bool
isOrderedListMarker Text
t -> (Doc Text
"\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>)
         | Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
t
         , Char -> Bool
needsEscapeAtLineStart Char
c -> (Doc Text
"\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>)
       [Inline]
_ -> Doc Text -> Doc Text
forall a. a -> a
id

escapeTypst :: Bool -> EscapeContext -> Text -> Doc Text
escapeTypst :: Bool -> EscapeContext -> Text -> Doc Text
escapeTypst Bool
smart EscapeContext
context Text
t =
  (case Text -> Maybe (Char, Text)
T.uncons Text
t of
    Just (Char
c, Text
_)
      | Char -> Bool
needsEscapeAtLineStart Char
c
        -> Text -> Doc Text
forall a. Text -> Doc a
afterBreak Text
"\\"
    Maybe (Char, Text)
_ -> Doc Text
forall a. Monoid a => a
mempty) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
  (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"//" Text
"\\/\\/"
    (if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
needsEscape Text
t
        then (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar Text
t
        else Text
t)))
  where
    escapeChar :: Char -> Text
escapeChar Char
c
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\160' = Text
"~"
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\8217', Bool
smart = Text
"'" -- apostrophe
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\8212', Bool
smart = Text
"---" -- em dash
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\8211', Bool
smart = Text
"--" -- en dash
      | Char -> Bool
needsEscape Char
c = Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
      | Bool
otherwise = Char -> Text
T.singleton Char
c
    needsEscape :: Char -> Bool
needsEscape Char
'\160' = Bool
True
    needsEscape Char
'\8217' = Bool
smart
    needsEscape Char
'\8212' = Bool
smart
    needsEscape Char
'\8211' = Bool
smart
    needsEscape Char
'\'' = Bool
smart
    needsEscape Char
'"' = Bool
smart
    needsEscape Char
'[' = Bool
True
    needsEscape Char
']' = Bool
True
    needsEscape Char
'#' = Bool
True
    needsEscape Char
'<' = Bool
True
    needsEscape Char
'>' = Bool
True
    needsEscape Char
'@' = Bool
True
    needsEscape Char
'$' = Bool
True
    needsEscape Char
'\\' = Bool
True
    needsEscape Char
'`' = Bool
True
    needsEscape Char
'_' = Bool
True
    needsEscape Char
'*' = Bool
True
    needsEscape Char
'~' = Bool
True
    needsEscape Char
':' = EscapeContext
context EscapeContext -> EscapeContext -> Bool
forall a. Eq a => a -> a -> Bool
== EscapeContext
TermContext
    needsEscape Char
_ = Bool
False

needsEscapeAtLineStart :: Char -> Bool
needsEscapeAtLineStart :: Char -> Bool
needsEscapeAtLineStart Char
'/' = Bool
True
needsEscapeAtLineStart Char
'+' = Bool
True
needsEscapeAtLineStart Char
'-' = Bool
True
needsEscapeAtLineStart Char
'=' = Bool
True
needsEscapeAtLineStart Char
_ = Bool
False

data LabelType =
    FreestandingLabel
  | ArgumentLabel
  deriving (Int -> LabelType -> ShowS
[LabelType] -> ShowS
LabelType -> String
(Int -> LabelType -> ShowS)
-> (LabelType -> String)
-> ([LabelType] -> ShowS)
-> Show LabelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LabelType -> ShowS
showsPrec :: Int -> LabelType -> ShowS
$cshow :: LabelType -> String
show :: LabelType -> String
$cshowList :: [LabelType] -> ShowS
showList :: [LabelType] -> ShowS
Show, LabelType -> LabelType -> Bool
(LabelType -> LabelType -> Bool)
-> (LabelType -> LabelType -> Bool) -> Eq LabelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LabelType -> LabelType -> Bool
== :: LabelType -> LabelType -> Bool
$c/= :: LabelType -> LabelType -> Bool
/= :: LabelType -> LabelType -> Bool
Eq)

toLabel :: LabelType -> Text -> Doc Text
toLabel :: LabelType -> Text -> Doc Text
toLabel LabelType
labelType Text
ident
  | Text -> Bool
T.null Text
ident = Doc Text
forall a. Monoid a => a
mempty
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isIdentChar Text
ident'
    = Doc Text
"<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">"
  | Bool
otherwise
     = case LabelType
labelType of
          LabelType
FreestandingLabel -> Doc Text
"#label" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Text -> Doc Text
doubleQuoted Text
ident')
          LabelType
ArgumentLabel -> Doc Text
"label" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Text -> Doc Text
doubleQuoted Text
ident')
 where
   ident' :: Text
ident' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ident

isIdentChar :: Char -> Bool
isIdentChar :: Char -> Bool
isIdentChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'

toCite :: PandocMonad m => Citation -> TW m (Doc Text)
toCite :: forall (m :: * -> *). PandocMonad m => Citation -> TW m (Doc Text)
toCite Citation
cite = do
  let ident' :: Text
ident' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Citation -> Text
citationId Citation
cite
  -- typst inserts comma and we get a doubled one if supplement contains it:
  let eatComma :: [Inline] -> [Inline]
eatComma (Str Text
"," : Inline
Space : [Inline]
xs) = [Inline]
xs
      eatComma [Inline]
xs = [Inline]
xs
  if Citation -> CitationMode
citationMode Citation
cite CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
NormalCitation Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isIdentChar Text
ident'
     then do
       suppl <- case Citation -> [Inline]
citationSuffix Citation
cite of
                  [] -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
                  [Inline]
suff -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst ([Inline] -> [Inline]
eatComma [Inline]
suff)
       pure $ "@" <> literal ident' <> suppl
     else do
       let label :: Doc Text
label = if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isIdentChar Text
ident'
                      then Doc Text
"<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">"
                      else Doc Text
"label" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Text -> Doc Text
doubleQuoted Text
ident')
       let form :: Doc Text
form = case Citation -> CitationMode
citationMode Citation
cite of
                     CitationMode
NormalCitation -> Doc Text
forall a. Monoid a => a
mempty
                     CitationMode
SuppressAuthor -> Doc Text
", form: \"year\""
                     CitationMode
AuthorInText -> Doc Text
", form: \"prose\""
       suppl <- case Citation -> [Inline]
citationSuffix Citation
cite of
                  [] -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
                  [Inline]
suff -> (Doc Text
", supplement: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets
                             (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst ([Inline] -> [Inline]
eatComma [Inline]
suff)
       pure $ "#cite" <> parens (label <> form <> suppl) <> endCode

doubleQuoted :: Text -> Doc Text
doubleQuoted :: Text -> Doc Text
doubleQuoted = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escape
 where
  escape :: Text -> Text
escape = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar
  escapeChar :: Char -> Text
escapeChar Char
'\\' = Text
"\\\\"
  escapeChar Char
'"' = Text
"\\\""
  escapeChar Char
c = Char -> Text
T.singleton Char
c

endCode :: Doc Text
endCode :: Doc Text
endCode = Doc Text -> Doc Text
forall a. Doc a -> Doc a
beforeNonBlank Doc Text
";"