{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
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 Network.URI (unEscapeString)
import qualified Data.Text as T
import Control.Monad.State ( StateT, evalStateT, gets, modify )
import Text.Pandoc.Writers.Shared ( metaToContext, defField, resetField,
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)
import Data.Char (isAlphaNum)
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 = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel Text
ident
Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
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 = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel 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
","
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 = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel Text
ident
Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"#figure(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text -> 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 = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel 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
$ EscapeContext -> Text -> Doc Text
escapeTypst EscapeContext
context Text
txt
Inline
Space -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
Inline
SoftBreak -> do
WrapOption
wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> WrapOption) -> StateT WriterState m WrapOption)
-> (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall a b. (a -> b) -> a -> b
$ WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
case WrapOption
wrapText of
WrapOption
WrapPreserve -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
WrapOption
WrapAuto -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
WrapOption
WrapNone -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
Inline
LineBreak -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr)
Math MathType
mathType Text
str -> do
Either Inline Text
res <- (DisplayType -> [Exp] -> Text)
-> MathType -> Text -> StateT WriterState m (Either Inline Text)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Text
TM.writeTypst MathType
mathType Text
str
case Either Inline Text
res of
Left Inline
il -> Inline -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> TW m (Doc Text)
inlineToTypst Inline
il
Right Text
r ->
case MathType
mathType of
MathType
InlineMath -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"$" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
r Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"$"
MathType
DisplayMath -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"$ " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
r Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" $"
Code (Text
_,[Text]
cls,[(Text, Text)]
_) Text
code -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
case [Text]
cls of
(Text
lang:[Text]
_) -> Doc Text
"#raw(lang:" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
lang Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text
", " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
code Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
[Text]
_ | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'`') Text
code -> Doc Text
"#raw(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
doubleQuoted Text
code Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
")"
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
| Bool
otherwise -> Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`"
RawInline Format
fmt Text
str ->
case Format
fmt of
Format Text
"typst" -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
Format
_ -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
Strikeout [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#strike" [Inline]
inlines
Emph [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#emph" [Inline]
inlines
Underline [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#underline" [Inline]
inlines
Strong [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#strong" [Inline]
inlines
Superscript [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#super" [Inline]
inlines
Subscript [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#sub" [Inline]
inlines
SmallCaps [Inline]
inlines -> Doc Text -> [Inline] -> TW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> [Inline] -> TW m (Doc Text)
textstyle Doc Text
"#smallcaps" [Inline]
inlines
Span (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
inlines -> do
let lab :: Doc Text
lab = LabelType -> Text -> Doc Text
toLabel LabelType
FreestandingLabel 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] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Citation -> TW m (Doc Text))
-> [Citation] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Citation -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => Citation -> TW m (Doc Text)
toCite [Citation]
citations
else [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
Link (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
inlines (Text
src,Text
_tit) -> do
case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"reference-type" [(Text, Text)]
kvs of
Just Text
"ref"
| Just (Char
'#', Text
ident) <- Text -> Maybe (Char, Text)
T.uncons Text
src
-> if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isIdentChar Text
ident
then Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident
else Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"#ref" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (LabelType -> Text -> Doc Text
toLabel LabelType
ArgumentLabel Text
ident)
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
Maybe Text
_ -> do
Doc Text
contents <- [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst [Inline]
inlines
let dest :: Doc Text
dest = case Text -> Maybe (Char, Text)
T.uncons Text
src of
Just (Char
'#', Text
ident) -> LabelType -> Text -> Doc Text
toLabel LabelType
ArgumentLabel Text
ident
Maybe (Char, Text)
_ -> Text -> Doc Text
doubleQuoted Text
src
Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"#link" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens Doc Text
dest Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
(if [Inline]
inlines [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
src]
then Doc Text
forall a. Monoid a => a
mempty
else Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
Image (Text
_,[Text]
_,[(Text, Text)]
kvs) [Inline]
_inlines (Text
src,Text
_tit) -> 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 src' :: Text
src' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src
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')
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 -> Doc Text
escapeTypst :: EscapeContext -> Text -> Doc Text
escapeTypst EscapeContext
context Text
t =
(case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
c, Text
_)
| Char -> Bool
needsEscapeAtLineStart Char
c
-> Text -> Doc Text
forall a. Text -> Doc a
afterBreak Text
"\\"
Maybe (Char, Text)
_ -> Doc Text
forall a. Monoid a => a
mempty) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
(Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"//" Text
"\\/\\/"
(if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
needsEscape Text
t
then (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar Text
t
else Text
t)))
where
escapeChar :: Char -> Text
escapeChar Char
c
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\160' = Text
"~"
| Char -> Bool
needsEscape Char
c = Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
| Bool
otherwise = Char -> Text
T.singleton Char
c
needsEscape :: Char -> Bool
needsEscape Char
'\160' = Bool
True
needsEscape Char
'[' = Bool
True
needsEscape Char
']' = Bool
True
needsEscape Char
'#' = Bool
True
needsEscape Char
'<' = Bool
True
needsEscape Char
'>' = Bool
True
needsEscape Char
'@' = Bool
True
needsEscape Char
'$' = Bool
True
needsEscape Char
'\\' = Bool
True
needsEscape Char
'\'' = Bool
True
needsEscape Char
'"' = Bool
True
needsEscape Char
'`' = Bool
True
needsEscape Char
'_' = Bool
True
needsEscape Char
'*' = Bool
True
needsEscape Char
'~' = Bool
True
needsEscape Char
':' = EscapeContext
context EscapeContext -> EscapeContext -> Bool
forall a. Eq a => a -> a -> Bool
== EscapeContext
TermContext
needsEscape Char
_ = Bool
False
needsEscapeAtLineStart :: Char -> Bool
needsEscapeAtLineStart Char
'/' = Bool
True
needsEscapeAtLineStart Char
'+' = Bool
True
needsEscapeAtLineStart Char
'-' = Bool
True
needsEscapeAtLineStart Char
'=' = Bool
True
needsEscapeAtLineStart Char
_ = Bool
False
data LabelType =
FreestandingLabel
| ArgumentLabel
deriving (Int -> LabelType -> ShowS
[LabelType] -> ShowS
LabelType -> String
(Int -> LabelType -> ShowS)
-> (LabelType -> String)
-> ([LabelType] -> ShowS)
-> Show LabelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LabelType -> ShowS
showsPrec :: Int -> LabelType -> ShowS
$cshow :: LabelType -> String
show :: LabelType -> String
$cshowList :: [LabelType] -> ShowS
showList :: [LabelType] -> ShowS
Show, LabelType -> LabelType -> Bool
(LabelType -> LabelType -> Bool)
-> (LabelType -> LabelType -> Bool) -> Eq LabelType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LabelType -> LabelType -> Bool
== :: LabelType -> LabelType -> Bool
$c/= :: LabelType -> LabelType -> Bool
/= :: LabelType -> LabelType -> Bool
Eq)
toLabel :: LabelType -> Text -> Doc Text
toLabel :: LabelType -> Text -> Doc Text
toLabel LabelType
labelType Text
ident
| Text -> Bool
T.null Text
ident = Doc Text
forall a. Monoid a => a
mempty
| (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isIdentChar Text
ident'
= Doc Text
"<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">"
| Bool
otherwise
= case LabelType
labelType of
LabelType
FreestandingLabel -> Doc Text
"#label" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Text -> Doc Text
doubleQuoted Text
ident')
LabelType
ArgumentLabel -> Doc Text
"label" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Text -> Doc Text
doubleQuoted Text
ident')
where
ident' :: Text
ident' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
ident
isIdentChar :: Char -> Bool
isIdentChar :: Char -> Bool
isIdentChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'
toCite :: PandocMonad m => Citation -> TW m (Doc Text)
toCite :: forall (m :: * -> *). PandocMonad m => Citation -> TW m (Doc Text)
toCite Citation
cite = do
let ident' :: Text
ident' = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Citation -> Text
citationId Citation
cite
let eatComma :: [Inline] -> [Inline]
eatComma (Str Text
"," : Inline
Space : [Inline]
xs) = [Inline]
xs
eatComma [Inline]
xs = [Inline]
xs
if Citation -> CitationMode
citationMode Citation
cite CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
NormalCitation Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isIdentChar Text
ident'
then do
Doc Text
suppl <- case Citation -> [Inline]
citationSuffix Citation
cite of
[] -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
[Inline]
suff -> (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets
(Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst ([Inline] -> [Inline]
eatComma [Inline]
suff)
Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"@" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
suppl
else do
let label :: Doc Text
label = if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isIdentChar Text
ident'
then Doc Text
"<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">"
else Doc Text
"label" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Text -> Doc Text
doubleQuoted Text
ident')
let form :: Doc Text
form = case Citation -> CitationMode
citationMode Citation
cite of
CitationMode
NormalCitation -> Doc Text
forall a. Monoid a => a
mempty
CitationMode
SuppressAuthor -> Doc Text
", form: \"year\""
CitationMode
AuthorInText -> Doc Text
", form: \"prose\""
Doc Text
suppl <- case Citation -> [Inline]
citationSuffix Citation
cite of
[] -> Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
[Inline]
suff -> (Doc Text
", supplement: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets
(Doc Text -> Doc Text) -> TW m (Doc Text) -> TW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TW m (Doc Text)
inlinesToTypst ([Inline] -> [Inline]
eatComma [Inline]
suff)
Doc Text -> TW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TW m (Doc Text)) -> Doc Text -> TW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"#cite" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
parens (Doc Text
label Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
form Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
suppl) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
endCode
doubleQuoted :: Text -> Doc Text
doubleQuoted :: Text -> Doc Text
doubleQuoted = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escape
where
escape :: Text -> Text
escape = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar
escapeChar :: Char -> Text
escapeChar Char
'\\' = Text
"\\\\"
escapeChar Char
'"' = Text
"\\\""
escapeChar Char
c = Char -> Text
T.singleton Char
c
endCode :: Doc Text
endCode :: Doc Text
endCode = Doc Text -> Doc Text
forall a. Doc a -> Doc a
beforeNonBlank Doc Text
";"