{-# 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, fetchItem )
import Text.Pandoc.ImageSize (imageSize, sizeInPoints)
import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..), isEnabled )
import Data.Text (Text)
import Data.List (intercalate)
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, tshow)
import Text.Pandoc.Writers.Math (convertMath)
import qualified Text.TeXMath as TM
import Text.DocLayout
import Text.DocTemplates (renderTemplate)
import Control.Monad.Except (catchError)
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 =
  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

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 = Text -> Doc Text
toLabel 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
$
        if 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
           then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"#heading(outlined: false)" 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
           else 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
    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]
_,[(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 = [Alignment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns
      [Doc Text]
headers' <- ([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]]
headers
      [[Doc Text]]
rows' <- ([[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] -> 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]]]
rows
      Doc Text
capt' <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
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 <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
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 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 = 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
      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. Doc a -> Doc a -> Doc a
$$
        Doc Text
"align(center)[#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
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
numcols) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"," -- auto
           Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"align: (col, row) => " 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
".at(col),"
           Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"inset: 6pt" 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] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ((Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map ((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
forall a. HasChars a => Doc a -> Doc a
brackets) [Doc Text]
headers')
           Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Doc Text
x -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
",") ([[Doc Text]] -> [Doc Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Doc Text]]
rows'))
           )
        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
capt'
        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 <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
      let lab :: Doc Text
lab = Text -> Doc Text
toLabel 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 -> 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
"," 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
"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)]
_) [Block]
blocks -> do
      let lab :: Doc Text
lab = Text -> Doc Text
toLabel Text
ident
      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. Doc a -> Doc a -> Doc 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
vcat [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
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ EscapeContext -> Text -> 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)]
_) [Inline]
inlines -> do
      let lab :: Doc Text
lab = Text -> Doc Text
toLabel Text
ident
      (Doc Text
lab Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$) (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
    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
      let toCite :: Citation -> StateT WriterState m (Doc Text)
toCite Citation
cite = do
            Doc Text
suppl <- case Citation -> [Inline]
citationSuffix Citation
cite of
                       [] -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
                       [Inline]
suff -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
suff
            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
"#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 (Text -> Doc Text
toLabel (Citation -> Text
citationId Citation
cite)) 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
      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 -> StateT WriterState 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)])
_attrs [Inline]
inlines (Text
src,Text
_tit) -> 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) -> 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
">"
                   Maybe (Char, Text)
_ -> Text -> Doc Text
doubleQuoted Text
src
      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
"#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) -> do
      WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
      let mbHeight :: Maybe Text
mbHeight = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"height" [(Text, Text)]
kvs
      let mdWidth :: Maybe Text
mdWidth = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
kvs
      let 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)
      -- see #9104; we need a box or the image is treated as block-level:
      case (Maybe Text
mdWidth, Maybe Text
mbHeight) of
        (Maybe Text
Nothing, Maybe Text
Nothing) -> do
          Maybe Text
realWidth <- StateT WriterState m (Maybe Text)
-> (PandocError -> StateT WriterState m (Maybe Text))
-> StateT WriterState m (Maybe Text)
forall a.
StateT WriterState m a
-> (PandocError -> StateT WriterState m a)
-> StateT WriterState m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
                  (do (ByteString
bs, Maybe Text
_mt) <- Text -> StateT WriterState m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
                      case WriterOptions -> ByteString -> Either Text ImageSize
imageSize WriterOptions
opts ByteString
bs of
                        Right ImageSize
x -> Maybe Text -> StateT WriterState m (Maybe Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> StateT WriterState m (Maybe Text))
-> Maybe Text -> StateT WriterState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                                      Double -> String
forall a. Show a => a -> String
show ((Double, Double) -> Double
forall a b. (a, b) -> a
fst (ImageSize -> (Double, Double)
sizeInPoints ImageSize
x)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"pt"
                        Left Text
_ -> Maybe Text -> StateT WriterState m (Maybe Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing)
                    (\PandocError
_ -> Maybe Text -> StateT WriterState m (Maybe Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing)
          case Maybe Text
realWidth of
            Just Text
w -> 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
"#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
"width: " 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
w 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
coreImage)
                        Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
            Maybe Text
Nothing -> 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
<> Doc Text
coreImage Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
        (Just Text
w, Maybe 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
$ 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
"width: " 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
w 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
coreImage)
                        Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
        (Maybe Text
_, Just Text
h) -> 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
"#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
"height: " 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
h 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
coreImage)
                        Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
    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

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)
-> 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

escapeTypst :: EscapeContext -> Text -> Text
escapeTypst :: EscapeContext -> Text -> Text
escapeTypst EscapeContext
context Text
t =
  HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"//" Text
"\\/\\/" (Text -> Text) -> 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 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 -- see #9137
    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

toLabel :: Text -> Doc Text
toLabel :: Text -> Doc Text
toLabel Text
ident =
  if Text -> Bool
T.null Text
ident
     then Doc Text
forall a. Monoid a => a
mempty
     else 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
">"

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
";"