{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
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)
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,
stNotes :: [Doc Text]
stNotes = [] }
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,
WriterState -> [Doc Text]
stNotes :: [Doc Text]
}
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
[Doc Text]
noteContents <- [Doc Text] -> [Doc Text]
forall a. [a] -> [a]
reverse ([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
<$> (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stNotes
let notes :: Doc Text
notes = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Int -> Doc Text -> Doc Text) -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\(Int
num :: Int) Doc Text
cont ->
Doc Text
"#endnote" 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 -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
num))
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 -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
cont Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr)))
[Int
1..] [Doc Text]
noteContents
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 -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"notes" Doc Text
notes
(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
$ (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
$ (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]
_,[(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
$ 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
"#blockquote[" 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
"#align(center, " 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 Doc Text -> Doc Text -> Doc Text
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 = 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
"#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
","
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
lab
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
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)]
_) [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
lab Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
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 :: EscapeContext
stEscapeContext = EscapeContext
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 :: EscapeContext
stEscapeContext = EscapeContext
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
")"
[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
")"
| 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
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
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 -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Doc Text
"#cite" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens
([Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
", " ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$
(Citation -> Doc Text) -> [Citation] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
doubleQuoted (Text -> Doc Text) -> (Citation -> Text) -> Citation -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Text
citationId) [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
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 (Text -> Doc Text
doubleQuoted Text
src) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
if Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
contents Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== 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
Image (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
_inlines (Text
src,Text
_tit) -> do
let width' :: Doc Text
width' = Doc Text -> (Text -> Doc Text) -> Maybe Text -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Monoid a => a
mempty ((Doc Text
", width: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (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) (Maybe Text -> Doc Text) -> Maybe Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
kvs
let height' :: Doc Text
height' = Doc Text -> (Text -> Doc Text) -> Maybe Text -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Monoid a => a
mempty ((Doc Text
", height: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (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) (Maybe Text -> Doc Text) -> Maybe Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"height" [(Text, Text)]
kvs
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
"#image(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
src Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
width' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
height' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
Note [Block]
blocks -> do
Doc Text
contents <- [Block] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TW m (Doc Text)
blocksToTypst [Block]
blocks
(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{ stNotes :: [Doc Text]
stNotes = Doc Text
contents Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: WriterState -> [Doc Text]
stNotes WriterState
st }
Doc Text
num <- String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text)
-> ([Doc Text] -> String) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> ([Doc Text] -> Int) -> [Doc Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([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
<$> (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stNotes
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
"#super" 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
num
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 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 =
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 -> 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
'[' = Bool
True
needsEscape Char
']' = Bool
True
needsEscape Char
'#' = Bool
True
needsEscape Char
'<' = Bool
True
needsEscape Char
'>' = Bool
True
needsEscape Char
'@' = Bool
True
needsEscape Char
'$' = Bool
True
needsEscape Char
'\\' = Bool
True
needsEscape Char
'\'' = Bool
True
needsEscape Char
'"' = Bool
True
needsEscape Char
'`' = Bool
True
needsEscape Char
'=' = Bool
True
needsEscape Char
'_' = Bool
True
needsEscape Char
'*' = Bool
True
needsEscape Char
':' = EscapeContext
context EscapeContext -> EscapeContext -> Bool
forall a. Eq a => a -> a -> Bool
== EscapeContext
TermContext
needsEscape Char
_ = Bool
False
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
"#label" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident))
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