{-# 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.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 )
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
  Context Text
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
  Doc Text
main <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
  let context :: Context Text
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 -> 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
$ (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
  Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
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
      Doc Text
contents <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
      let lab :: Doc Text
lab = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel Text
ident
      let headingAttrs :: [Text]
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]
      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
$
        if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
headingAttrs
           then Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap
                 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
level Text
"=") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space 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
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
lab
           else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"#heading" 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
forall a. HasChars a => a -> Doc a
literal (Text -> [Text] -> Text
T.intercalate Text
", "
                              (Text
"level: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
level Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
headingAttrs))) 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
contents 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
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
      Doc Text
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)
      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
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
    BlockQuote [Block]
blocks -> do
      Doc Text
contents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      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
"#quote(block: true)[" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
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
                                      ([Text] -> Text
forall a. HasCallStack => [a] -> a
head (ListAttributes -> [Text]
orderedListMarkers
                                             (Int
1, ListNumberStyle
sty, ListNumberDelim
delim))) 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
"]"
      [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
      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
addBlock
               (if [[Block]] -> Bool
isTightList [[Block]]
items
                   then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items'
                   else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [Doc Text]
items')
              Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
    BulletList [[Block]]
items -> do
      [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
      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
$ (if [[Block]] -> Bool
isTightList [[Block]]
items
                   then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items'
                   else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [Doc Text]
items') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
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
      Doc Text
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
                    Doc Text
captcontents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
caption
                    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
", caption: " 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
captcontents
      let typstFigureKind :: Doc Text
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 :: Int
numcols = [ColSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
colspecs
      let ([Alignment]
aligns, [ColWidth]
widths) = [ColSpec] -> ([Alignment], [ColWidth])
forall a b. [(a, b)] -> ([a], [b])
unzip [ColSpec]
colspecs
      let commaSep :: [Doc Text] -> Doc Text
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 -> Doc Text
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 :: Doc Text
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 -> a
formatalign Alignment
AlignLeft = a
"left,"
          formatalign Alignment
AlignRight = a
"right,"
          formatalign Alignment
AlignCenter = a
"center,"
          formatalign Alignment
AlignDefault = a
"auto,"
      let alignarray :: Doc Text
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 -> StateT WriterState m (Doc Text)
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
            Doc Text
cellContents <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
bs
            let contents2 :: Doc Text
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)
            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 -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cellattrs
                      then Doc Text
contents2
                      else Doc Text
"table.cell" 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
forall a. HasChars a => a -> Doc a
literal (Text -> [Text] -> Text
T.intercalate Text
", " [Text]
cellattrs)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                            Doc Text
contents2
      let fromRow :: Row -> StateT WriterState m (Doc Text)
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 -> StateT WriterState m (Doc Text)
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 -> StateT WriterState m (Doc Text)
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 -> StateT WriterState m (Doc Text)
fromTableBody (TableBody (Text, [Text], [(Text, Text)])
_attr RowHeadColumns
_rowHeadCols [Row]
headRows [Row]
bodyRows) = do
            [Doc Text]
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
            [Doc Text]
brows <- (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]
bodyRows
            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 -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text]
hrows [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Doc Text
"table.hline()," | Bool -> Bool
not ([Doc Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
hrows)] [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Doc Text]
brows)
      let ([(Text, Text)]
typstAttrs, [(Text, Text)]
typstTextAttrs) = [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
pickTypstAttrs [(Text, Text)]
tabkvs
      Doc Text
header <- TableHead -> TW m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
TableHead -> StateT WriterState m (Doc Text)
fromHead TableHead
thead
      Doc Text
footer <- TableFoot -> TW m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
TableFoot -> StateT WriterState m (Doc Text)
fromFoot TableFoot
tfoot
      Doc Text
body <- [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([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
<$> (TableBody -> TW m (Doc Text))
-> [TableBody] -> 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 TableBody -> TW m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
TableBody -> StateT WriterState m (Doc Text)
fromTableBody [TableBody]
tbodies
      let table :: Doc Text
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
")"
      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
$ if Text
"typst:no-figure" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
tabclasses
        then Doc Text
table
        else Doc Text
"#figure("
            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
"align(center)[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
table 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
capt'
              Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
typstFigureKind
              Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
")")
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
lab
          Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
    Figure (Text
ident,[Text]
_,[(Text, Text)]
_) (Caption Maybe [Inline]
_mbshort [Block]
capt) [Block]
blocks -> do
      Doc Text
caption <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
capt
      Doc Text
contents <- case [Block]
blocks of
                     -- don't need #box around block-level image
                     [Para [Image (Text
_,[Text]
_,[(Text, Text)]
kvs) [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
$ Bool -> Text -> [(Text, Text)] -> Doc Text
mkImage Bool
False Text
src [(Text, Text)]
kvs
                     [Plain [Image (Text
_,[Text]
_,[(Text, Text)]
kvs) [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
$ Bool -> Text -> [(Text, Text)] -> Doc Text
mkImage Bool
False Text
src [(Text, Text)]
kvs
                     [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 :: Doc Text
lab = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel Text
ident
      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
"#figure(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 ((Doc Text
contents 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
"caption: [" 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
caption Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"]")
                                    )
                          Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
")" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
lab Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
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
      Doc Text
contents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      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
"#block" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)] -> Doc Text
toTypstPropsListParens [(Text, Text)]
typstAttrs 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
toTypstSetText [(Text, Text)]
typstTextAttrs Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
        Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (Doc Text
"]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Doc Text
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 }
  Doc Text
term' <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
term
  (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 = NormalContext }
  [Doc Text]
defns' <- ([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 [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [[Block]]
defns
  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
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text
"/ " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
term' 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
"#block[") Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
            Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [Doc Text]
defns') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"]"

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
  Doc Text
contents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
  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
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
ind (Doc Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space) Doc Text
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
      EscapeContext
context <- (WriterState -> EscapeContext)
-> StateT WriterState m EscapeContext
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> EscapeContext
stEscapeContext
      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
$ EscapeContext -> Text -> Doc Text
escapeTypst EscapeContext
context Text
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
      WrapOption
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 WrapOption
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
      Either Inline Text
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 Either Inline Text
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
          Doc Text
contents <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
          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, Text)] -> Doc Text -> Doc Text
toTypstTextElement [(Text, Text)]
typstTextAttrs Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
lab
    Quoted QuoteType
quoteType [Inline]
inlines -> do
      let q :: Doc Text
q = case QuoteType
quoteType of
                   QuoteType
DoubleQuote -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\""
                   QuoteType
SingleQuote -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"'"
      Doc Text
contents <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
      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
q 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
q
    Cite [Citation]
citations [Inline]
inlines -> do
      WriterOptions
opts <-  (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
      if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
         -- Note: this loses prefix
         then [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([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
<$> (Citation -> TW m (Doc Text))
-> [Citation] -> 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 Citation -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Citation -> TW m (Doc Text)
toCite [Citation]
citations
         else [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
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
          Doc Text
contents <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
          let dest :: Doc Text
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
          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
"#link" 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
dest Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                    (if [Inline]
inlines [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
src]
                          then Doc Text
forall a. Monoid a => a
mempty
                          else Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
    Image (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
_inlines (Text
src,Text
_tit) -> 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
$ Bool -> Text -> [(Text, Text)] -> Doc Text
mkImage Bool
True Text
src [(Text, Text)]
kvs
    Note [Block]
blocks -> do
      Doc Text
contents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      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
"#footnote" 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 -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode

-- see #9104; need box or image is treated as block-level
mkImage :: Bool -> Text -> [(Text, Text)] -> Doc Text
mkImage :: Bool -> Text -> [(Text, Text)] -> Doc Text
mkImage Bool
useBox Text
src [(Text, Text)]
kvs
  | 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
  toDimAttr :: Text -> Doc Text
toDimAttr Text
k =
     case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Text)]
kvs of
       Just Text
v -> 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
k 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
forall a. HasChars a => a -> Doc a
literal Text
v
       Maybe Text
Nothing -> Doc Text
forall a. Monoid a => a
mempty
  dimAttrs :: Doc Text
dimAttrs = [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
$ (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
toDimAttr [Text
"height", Text
"width"]
  coreImage :: Doc Text
coreImage = 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 :: EscapeContext -> Text -> Doc Text
escapeTypst :: EscapeContext -> Text -> Doc Text
escapeTypst 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 -> 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
'[' = 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
'*' = 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
       Doc Text
suppl <- case Citation -> [Inline]
citationSuffix Citation
cite of
                  [] -> Doc Text -> TW 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 -> 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 -> 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
<$> [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst ([Inline] -> [Inline]
eatComma [Inline]
suff)
       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
"@" 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
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\""
       Doc Text
suppl <- case Citation -> [Inline]
citationSuffix Citation
cite of
                  [] -> Doc Text -> TW 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) -> 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] -> [Inline]
eatComma [Inline]
suff)
       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
"#cite" 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
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
form Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
suppl) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
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
";"