{-# 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 ( PandocMonad )
import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..), isEnabled )
import Data.Text (Text)
import Data.List (intercalate, intersperse)
import qualified Data.Text as T
import Control.Monad.State ( StateT, evalStateT, gets, modify )
import Text.Pandoc.Writers.Shared ( metaToContext, defField, resetField,
                                    toLegacyTable, lookupMetaString )
import Text.Pandoc.Shared (isTightList, orderedListMarkers)
import Text.Pandoc.Writers.Math (convertMath)
import qualified Text.TeXMath as TM
import Text.DocLayout
import Text.DocTemplates (renderTemplate)
import Text.Pandoc.Extensions (Extension(..))
import Text.Collate.Lang (Lang(..), parseLang)

-- | 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 =
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EscapeContext] -> ShowS
$cshowList :: [EscapeContext] -> ShowS
show :: EscapeContext -> String
$cshow :: EscapeContext -> String
showsPrec :: Int -> EscapeContext -> ShowS
$cshowsPrec :: Int -> EscapeContext -> ShowS
Show, EscapeContext -> EscapeContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EscapeContext -> EscapeContext -> Bool
$c/= :: EscapeContext -> EscapeContext -> Bool
== :: EscapeContext -> EscapeContext -> Bool
$c== :: 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 forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
options
                    else forall a. Maybe a
Nothing
  Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
options
              forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst
              (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst)
              Meta
meta
  Doc Text
main <- forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
  let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
options)
              forall a b. (a -> b) -> a -> b
$ (if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
options
                    then forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"citations" Bool
True
                    else forall a. a -> a
id)
              forall a b. (a -> b) -> a -> b
$ (case Text -> Meta -> Text
lookupMetaString Text
"lang" Meta
meta of
                    Text
"" -> forall a. a -> a
id
                    Text
lang ->
                      case Text -> Either String Lang
parseLang Text
lang of
                        Left String
_ -> forall a. a -> a
id
                        Right Lang
l ->
                          forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"lang" (Lang -> Text
langLanguage Lang
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"region") (Lang -> Maybe Text
langRegion Lang
l))
              forall a b. (a -> b) -> a -> b
$ (if WriterOptions -> Bool
writerNumberSections WriterOptions
options
                    then forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"numbering" (Text
"1.1.1.1.1" :: Text)
                    else forall a. a -> a
id)
              forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth 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 -> forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

blocksToTypst :: PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst :: forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks = forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 -> forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
    Para [Inline]
inlines -> (forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
      let lab :: Doc Text
lab = Text -> Doc Text
toLabel Text
ident
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        if Text
"unlisted" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls
           then forall a. HasChars a => a -> Doc a
literal Text
"#heading(outlined: false)" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
contents forall a. Semigroup a => a -> a -> a
<>
                 forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
lab
           else forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate Int
level Text
"=") forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<>
                 forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
lab
    RawBlock Format
fmt Text
str ->
      case Format
fmt of
        Format Text
"typst" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
        Format
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Num a => a -> a -> a
+ Int
1 in (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
_) = 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 = forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (forall a. Ord a => a -> a -> a
max Int
3 (Int
longestBacktickSequence forall a. Num a => a -> a -> a
+ Int
1)) Text
"`"
      let lang :: Doc Text
lang = case [Text]
cls of
                   (Text
cl:[Text]
_) -> forall a. HasChars a => a -> Doc a
literal Text
cl
                   [Text]
_ -> forall a. Monoid a => a
mempty
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
fence forall a. Semigroup a => a -> a -> a
<> Doc Text
lang forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
code forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
fence forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
    LineBlock [[Inline]]
lns -> do
      Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst (forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
lns)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
    BlockQuote [Block]
blocks -> do
      Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"#blockquote[" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a -> Doc a
chomp Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"]" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
    Block
HorizontalRule ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Semigroup a => a -> a -> a
<> Doc Text
"#horizontalrule" forall a. Semigroup a => a -> a -> a
<> 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) -> forall a. a -> a
id
                       (Int
1, ListNumberStyle
Decimal, ListNumberDelim
Period) -> forall a. a -> a
id
                       (Int
start, ListNumberStyle
sty, ListNumberDelim
delim) -> \Doc Text
x ->
                              Doc Text
"#block[" forall a. Doc a -> Doc a -> Doc a
$$
                               (Doc Text
"#set enum" forall a. Semigroup a => a -> a -> a
<>
                                  forall a. HasChars a => Doc a -> Doc a
parens (
                                    Doc Text
"numbering: " forall a. Semigroup a => a -> a -> a
<>
                                    Text -> Doc Text
doubleQuoted
                                      (forall a. [a] -> a
head (ListAttributes -> [Text]
orderedListMarkers
                                             (Int
1, ListNumberStyle
sty, ListNumberDelim
delim))) forall a. Semigroup a => a -> a -> a
<>
                                    Doc Text
", start: " forall a. Semigroup a => a -> a -> a
<>
                                      forall a. HasChars a => String -> Doc a
text (forall a. Show a => a -> String
show Int
start) )) forall a. Doc a -> Doc a -> Doc a
$$
                               Doc Text
x forall a. Doc a -> Doc a -> Doc a
$$
                               Doc Text
"]"
      [Doc Text]
items' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
Int -> Doc Text -> [Block] -> TW m (Doc Text)
listItemToTypst Int
2 (Doc Text
"+")) [[Block]]
items
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
addBlock
               (if [[Block]] -> Bool
isTightList [[Block]]
items
                   then forall a. [Doc a] -> Doc a
vcat [Doc Text]
items'
                   else forall a. [Doc a] -> Doc a
vsep [Doc Text]
items')
              forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
    BulletList [[Block]]
items -> do
      [Doc Text]
items' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
Int -> Doc Text -> [Block] -> TW m (Doc Text)
listItemToTypst Int
2 Doc Text
"-") [[Block]]
items
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if [[Block]] -> Bool
isTightList [[Block]]
items
                   then forall a. [Doc a] -> Doc a
vcat [Doc Text]
items'
                   else forall a. [Doc a] -> Doc a
vsep [Doc Text]
items') forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
    DefinitionList [([Inline], [[Block]])]
items ->
      (forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vsep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> TW m (Doc Text)
defListItemToTypst [([Inline], [[Block]])]
items
    Table (Text
ident,[Text]
_,[(Text, Text)]
_) Caption
blkCapt [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot -> do
      let ([Inline]
caption, [Alignment]
aligns, [Double]
_, [[Block]]
headers, [[[Block]]]
rows) =
            Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot
      let numcols :: Int
numcols = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns
      [Doc Text]
headers' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [[Block]]
headers
      [[Doc Text]]
rows' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst) [[[Block]]]
rows
      Doc Text
capt' <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
                  then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
                  else do
                    Doc Text
captcontents <- forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
caption
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"#align(center, " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
captcontents forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
      let lab :: Doc Text
lab = Text -> Doc Text
toLabel Text
ident
      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 = forall a. HasChars a => Doc a -> Doc a
parens forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. IsString a => Alignment -> a
formatalign [Alignment]
aligns
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"#align(center)[#table("
        forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2
           (  Doc Text
"columns: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => String -> Doc a
text (forall a. Show a => a -> String
show Int
numcols) forall a. Semigroup a => a -> a -> a
<> Doc Text
"," -- auto
           forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"align: (col, row) => " forall a. Semigroup a => a -> a -> a
<> Doc Text
alignarray forall a. Semigroup a => a -> a -> a
<> Doc Text
".at(col),"
           forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"inset: 6pt" forall a. Semigroup a => a -> a -> a
<> Doc Text
","
           forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
hsep (forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Semigroup a => a -> a -> a
<>Doc Text
",") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => Doc a -> Doc a
brackets) [Doc Text]
headers')
           forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat (forall a b. (a -> b) -> [a] -> [b]
map (\Doc Text
x -> forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
x forall a. Semigroup a => a -> a -> a
<> Doc Text
",") (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Doc Text]]
rows'))
           )
        forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
")"
        forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
capt'
        forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
lab
        forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"]"
        forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
    Figure (Text
ident,[Text]
_,[(Text, Text)]
_) (Caption Maybe [Inline]
_mbshort [Block]
capt) [Block]
blocks -> do
      Doc Text
caption <- forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
capt
      Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      let lab :: Doc Text
lab = Text -> Doc Text
toLabel Text
ident
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"#figure(" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"," forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<>
                                     (Doc Text
"caption: [" forall a. Doc a -> Doc a -> Doc a
$$ forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 Doc Text
caption forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"]"))
                          forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
")" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
lab forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
    Div (Text
ident,[Text]
_,[(Text, Text)]
_) (Header Int
lev (Text
"",[Text]
cls,[(Text, Text)]
kvs) [Inline]
ils:[Block]
rest) ->
      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]
ilsforall a. a -> [a] -> [a]
:[Block]
rest)
    Div (Text
ident,[Text]
_,[(Text, Text)]
_) [Block]
blocks -> do
      let lab :: Doc Text
lab = Text -> Doc Text
toLabel Text
ident
      Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"#block[" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ (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
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stEscapeContext :: EscapeContext
stEscapeContext = EscapeContext
TermContext }
  Doc Text
term' <- forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
term
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stEscapeContext :: EscapeContext
stEscapeContext = EscapeContext
NormalContext }
  [Doc Text]
defns' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [[Block]]
defns
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text
"/ " forall a. Semigroup a => a -> a -> a
<> Doc Text
term' forall a. Semigroup a => a -> a -> a
<> Doc Text
": " forall a. Semigroup a => a -> a -> a
<> Doc Text
"#block[") forall a. Doc a -> Doc a -> Doc a
$$
            forall a. Doc a -> Doc a
chomp (forall a. [Doc a] -> Doc a
vcat [Doc Text]
defns') 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 <- forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
ind (Doc Text
marker forall a. Semigroup a => a -> a -> a
<> 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 = forall a. [Doc a] -> Doc a
hcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> EscapeContext
stEscapeContext
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ EscapeContext -> Text -> Text
escapeTypst EscapeContext
context Text
txt
    Inline
Space -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
    Inline
SoftBreak -> do
      WrapOption
wrapText <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ WriterOptions -> WrapOption
writerWrapText forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
      case WrapOption
wrapText of
        WrapOption
WrapPreserve -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
cr
        WrapOption
WrapAuto     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
        WrapOption
WrapNone     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
    Inline
LineBreak -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr)
    Math MathType
mathType Text
str -> do
      Either Inline Text
res <- 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 -> forall (m :: * -> *). PandocMonad m => Inline -> TW m (Doc Text)
inlineToTypst Inline
il
          Right Text
r ->
            case MathType
mathType of
              MathType
InlineMath -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"$" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
r forall a. Semigroup a => a -> a -> a
<> Doc Text
"$"
              MathType
DisplayMath -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"$ " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
r forall a. Semigroup a => a -> a -> a
<> Doc Text
" $"
    Code (Text
_,[Text]
cls,[(Text, Text)]
_) Text
code -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      case [Text]
cls of
        (Text
lang:[Text]
_) -> Doc Text
"#raw(lang:" forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
lang forall a. Semigroup a => a -> a -> a
<>
                        Doc Text
", " forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
code forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
        [Text]
_ | (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
==Char
'`') Text
code -> Doc Text
"#raw(" forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
code forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
          | Bool
otherwise -> Doc Text
"`" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
code forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
    RawInline Format
fmt Text
str ->
      case Format
fmt of
        Format Text
"typst" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
        Format
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    Strikeout [Inline]
inlines -> forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#strike" [Inline]
inlines
    Emph [Inline]
inlines -> forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#emph" [Inline]
inlines
    Underline [Inline]
inlines -> forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#underline" [Inline]
inlines
    Strong [Inline]
inlines -> forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#strong" [Inline]
inlines
    Superscript [Inline]
inlines -> forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#super" [Inline]
inlines
    Subscript [Inline]
inlines -> forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#sub" [Inline]
inlines
    SmallCaps [Inline]
inlines -> forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#smallcaps" [Inline]
inlines
    Span (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
inlines -> do
      let lab :: Doc Text
lab = Text -> Doc Text
toLabel Text
ident
      (Doc Text
lab forall a. Doc a -> Doc a -> Doc a
$$) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
    Quoted QuoteType
quoteType [Inline]
inlines -> do
      let q :: Doc Text
q = case QuoteType
quoteType of
                   QuoteType
DoubleQuote -> forall a. HasChars a => a -> Doc a
literal Text
"\""
                   QuoteType
SingleQuote -> forall a. HasChars a => a -> Doc a
literal Text
"'"
      Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
q forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
q
    Cite [Citation]
citations [Inline]
inlines -> do
      WriterOptions
opts <-  forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
      if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
         then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ -- Note: this loses locators, prefix, suffix
              Doc Text
"#cite" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
parens
                (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Doc Text
", " forall a b. (a -> b) -> a -> b
$
                  forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
doubleQuoted forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Text
citationId) [Citation]
citations)
         else forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
    Link (Text, [Text], [(Text, Text)])
_attrs [Inline]
inlines (Text
src,Text
_tit) -> do
      Doc Text
contents <- 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) -> Doc Text
"<" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ident forall a. Semigroup a => a -> a -> a
<> Doc Text
">"
                   Maybe (Char, Text)
_ -> Text -> Doc Text
doubleQuoted Text
src
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"#link" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
parens Doc Text
dest forall a. Semigroup a => a -> a -> a
<>
                if [Inline]
inlines forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
src]
                   then forall a. Monoid a => a
mempty
                   else forall a. IsString a => Doc a -> Doc a
nowrap forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
contents
    Image (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
_inlines (Text
src,Text
_tit) -> do
      let width' :: Doc Text
width' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((Doc Text
", width: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => a -> Doc a
literal) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
kvs
      let height' :: Doc Text
height' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((Doc Text
", height: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => a -> Doc a
literal) forall a b. (a -> b) -> a -> b
$
                    forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"height" [(Text, Text)]
kvs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"#image(" forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
src forall a. Semigroup a => a -> a -> a
<> Doc Text
width' forall a. Semigroup a => a -> a -> a
<> Doc Text
height' forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
    Note [Block]
blocks -> do
      Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"#footnote" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Doc a -> Doc a
brackets (forall a. Doc a -> Doc a
chomp Doc Text
contents)

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
s forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => Doc a -> Doc a
brackets forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines

escapeTypst :: EscapeContext -> Text -> Text
escapeTypst :: EscapeContext -> Text -> Text
escapeTypst EscapeContext
context Text
t =
  Text -> Text -> Text -> Text
T.replace Text
"//" Text
"\\/\\/" forall a b. (a -> b) -> a -> b
$
  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 forall a. Eq a => a -> a -> Bool
== Char
'\160' = Text
"~"
      | Char -> Bool
needsEscape Char
c = 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
'~' = Bool
True
    needsEscape Char
':' = EscapeContext
context forall a. Eq a => a -> a -> Bool
== EscapeContext
TermContext
    needsEscape Char
_ = Bool
False

toLabel :: Text -> Doc Text
toLabel :: Text -> Doc Text
toLabel Text
ident =
  if Text -> Bool
T.null Text
ident
     then forall a. Monoid a => a
mempty
     else Doc Text
"<" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ident forall a. Semigroup a => a -> a -> a
<> Doc Text
">"

doubleQuoted :: Text -> Doc Text
doubleQuoted :: Text -> Doc Text
doubleQuoted = forall a. HasChars a => Doc a -> Doc a
doubleQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => a -> Doc a
literal 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