{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where
import Control.Monad (zipWithM, unless)
import Control.Monad.Except (throwError)
import Control.Monad.State.Strict
( StateT, MonadState(get), gets, modify, evalStateT )
import Data.Char (chr, ord, isAlphaNum)
import Data.List (maximumBy, transpose, foldl')
import Data.List.NonEmpty (nonEmpty)
import Data.Ord (comparing)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (unEscapeString)
import System.FilePath
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Walk (walkM)
import Text.Pandoc.Error
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
data WriterState =
WriterState { WriterState -> Bool
stStrikeout :: Bool
, WriterState -> Context
stContext :: Context
, WriterState -> Map Text Int
stNodes :: M.Map Text Int
, WriterState -> Map Text Text
stHeadings :: M.Map Text Text
, WriterState -> WriterOptions
stOptions :: WriterOptions
}
data Context = NormalContext | NodeContext
deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
/= :: Context -> Context -> Bool
Eq, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Context -> ShowS
showsPrec :: Int -> Context -> ShowS
$cshow :: Context -> String
show :: Context -> String
$cshowList :: [Context] -> ShowS
showList :: [Context] -> ShowS
Show)
withContext :: PandocMonad m => Context -> TI m a -> TI m a
withContext :: forall (m :: * -> *) a.
PandocMonad m =>
Context -> TI m a -> TI m a
withContext Context
context TI m a
pa = do
oldContext <- (WriterState -> Context) -> StateT WriterState m Context
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Context
stContext
modify $ \WriterState
s -> WriterState
s{ stContext = context }
res <- pa
modify $ \WriterState
s -> WriterState
s{ stContext = oldContext }
pure res
disallowedInNode :: Char -> Bool
disallowedInNode :: Char -> Bool
disallowedInNode Char
c = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'.',Char
':',Char
',',Char
'(',Char
')']
type TI m = StateT WriterState m
writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTexinfo :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTexinfo 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 -> TI m Text
pandocToTexinfo WriterOptions
options (Pandoc -> StateT WriterState m Text)
-> Pandoc -> StateT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Pandoc -> Pandoc
wrapTop Pandoc
document)
WriterState { stStrikeout :: Bool
stStrikeout = Bool
False,
stContext :: Context
stContext = Context
NormalContext,
stNodes :: Map Text Int
stNodes = Map Text Int
forall a. Monoid a => a
mempty,
stHeadings :: Map Text Text
stHeadings = Map Text Text
forall a. Monoid a => a
mempty,
stOptions :: WriterOptions
stOptions = WriterOptions
options}
wrapTop :: Pandoc -> Pandoc
wrapTop :: Pandoc -> Pandoc
wrapTop (Pandoc Meta
meta [Block]
blocks) =
Meta -> [Block] -> Pandoc
Pandoc Meta
meta (Int -> Attr -> [Inline] -> Block
Header Int
0 Attr
nullAttr (Meta -> [Inline]
docTitle Meta
meta) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blocks)
addNodeText :: PandocMonad m => Block -> TI m Block
addNodeText :: forall (m :: * -> *). PandocMonad m => Block -> TI m Block
addNodeText (Header Int
lev (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
ils) | Int
lev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
lev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4 = do
node <- Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text)
-> StateT WriterState m (Doc Text) -> StateT WriterState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
Context -> TI m a -> TI m a
withContext Context
NodeContext ([Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
ils)
nodes <- gets stNodes
node' <- case M.lookup node nodes of
Just Int
i -> 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{ stNodes = M.adjust (+ 1) node nodes }
Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> StateT WriterState m Text)
-> Text -> StateT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
node Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Maybe Int
Nothing -> 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{ stNodes = M.insert node 1 nodes }
Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
node
unless (T.null ident) $
modify $ \WriterState
st -> WriterState
st{ stHeadings = M.insert ident node' (stHeadings st) }
pure $ Header lev (ident,[],[("node", node')]) ils
addNodeText Block
x = Block -> StateT WriterState m Block
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
x
pandocToTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> TI m Text
pandocToTexinfo :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> TI m Text
pandocToTexinfo WriterOptions
options (Pandoc Meta
meta [Block]
blocks') = do
blocks <- (Block -> StateT WriterState m Block)
-> [Block] -> StateT WriterState m [Block]
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Block -> m Block) -> [Block] -> m [Block]
walkM Block -> StateT WriterState m Block
forall (m :: * -> *). PandocMonad m => Block -> TI m Block
addNodeText [Block]
blocks'
let titlePage = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Inline] -> Bool) -> [[Inline]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
([[Inline]] -> Bool) -> [[Inline]] -> Bool
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta [Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
: Meta -> [Inline]
docDate Meta
meta [Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
: Meta -> [[Inline]]
docAuthors Meta
meta
let 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
metadata <- metaToContext options
blockListToTexinfo
(fmap chomp .inlineListToTexinfo)
meta
body <- blockListToTexinfo blocks
st <- get
let 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
body
(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
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"titlepage" Bool
titlePage
(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
"strikeout" (WriterState -> Bool
stStrikeout WriterState
st) Context Text
metadata
return $ render colwidth $
case writerTemplate options of
Maybe (Template Text)
Nothing -> Doc Text
body
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
stringToTexinfo :: PandocMonad m => Text -> TI m Text
stringToTexinfo :: forall (m :: * -> *). PandocMonad m => Text -> TI m Text
stringToTexinfo Text
t
| (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
t = Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
| Bool
otherwise = do
context <- (WriterState -> Context) -> StateT WriterState m Context
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Context
stContext
let escChar Char
'{' = Text
"@{"
escChar Char
'}' = Text
"@}"
escChar Char
'@' = Text
"@@"
escChar Char
'\160' = Text
"@ "
escChar Char
'\x2014' = Text
"---"
escChar Char
'\x2013' = Text
"--"
escChar Char
'\x2026' = Text
"@dots{}"
escChar Char
'\x2019' = Text
"'"
escChar Char
',' | Context
context Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
NodeContext = Text
""
escChar Char
':' | Context
context Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
NodeContext = Text
""
escChar Char
'.' | Context
context Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
NodeContext = Text
""
escChar Char
'(' | Context
context Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
NodeContext = Text
""
escChar Char
')' | Context
context Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
NodeContext = Text
""
escChar Char
c = Char -> Text
T.singleton Char
c
pure $ T.concatMap escChar t
inCmd :: Text -> Doc Text -> Doc Text
inCmd :: Text -> Doc Text -> Doc Text
inCmd Text
cmd Doc Text
contents = Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'@' 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
cmd 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
braces Doc Text
contents
blockToTexinfo :: PandocMonad m
=> Block
-> TI m (Doc Text)
blockToTexinfo :: forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
blockToTexinfo (Div Attr
_ [Block]
bs) = [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
bs
blockToTexinfo (Plain [Inline]
lst) =
[Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
blockToTexinfo (Para [Inline]
lst) =
[Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
blockToTexinfo (LineBlock [[Inline]]
lns) =
Block -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
blockToTexinfo (Block -> TI m (Doc Text)) -> Block -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToTexinfo (BlockQuote [Block]
lst) = do
contents <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
lst
return $ text "@quotation" $$
contents $$
text "@end quotation"
blockToTexinfo (CodeBlock Attr
_ Text
str) =
Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI 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. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@verbatim" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@end verbatim" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToTexinfo b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"texinfo" = Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"tex" =
Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@tex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@end tex"
| Bool
otherwise = do
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
Doc Text -> TI 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
empty
blockToTexinfo (BulletList [[Block]]
lst) = do
items <- ([Block] -> TI 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] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
listItemToTexinfo [[Block]]
lst
return $ text "@itemize" $$
vcat items $$
text "@end itemize" <> blankline
blockToTexinfo (OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
_) [[Block]]
lst) = do
items <- ([Block] -> TI 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] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
listItemToTexinfo [[Block]]
lst
return $ text "@enumerate " <> exemplar $$
vcat items $$
text "@end enumerate" <> blankline
where
exemplar :: Doc Text
exemplar = case ListNumberStyle
numstyle of
ListNumberStyle
DefaultStyle -> Doc Text
decimal
ListNumberStyle
Decimal -> Doc Text
decimal
ListNumberStyle
Example -> Doc Text
decimal
ListNumberStyle
UpperRoman -> Doc Text
decimal
ListNumberStyle
LowerRoman -> Doc Text
decimal
ListNumberStyle
UpperAlpha -> Doc Text
upperAlpha
ListNumberStyle
LowerAlpha -> Doc Text
lowerAlpha
decimal :: Doc Text
decimal = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then Doc Text
forall a. Doc a
empty
else String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
start)
upperAlpha :: Doc Text
upperAlpha = String -> Doc Text
forall a. HasChars a => String -> Doc a
text [Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
lowerAlpha :: Doc Text
lowerAlpha = String -> Doc Text
forall a. HasChars a => String -> Doc a
text [Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
blockToTexinfo (DefinitionList [([Inline], [[Block]])]
lst) = do
items <- (([Inline], [[Block]]) -> TI 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]]) -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> TI m (Doc Text)
defListItemToTexinfo [([Inline], [[Block]])]
lst
return $ text "@table @asis" $$
vcat items $$
text "@end table" <> blankline
blockToTexinfo Block
HorizontalRule =
Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@iftex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@bigskip@hrule@bigskip" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@end iftex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@ifnottex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
72 Char
'-') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@end ifnottex"
blockToTexinfo (Header Int
0 Attr
_ [Inline]
lst) = do
txt <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst
then Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"Top"
else [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
return $ text "@node Top" $$
text "@top " <> txt <> blankline
blockToTexinfo (Header Int
level (Text
_,[Text]
_,[(Text
"node",Text
node)]) [Inline]
lst) = do
txt <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
sec <- seccmd level
return $ if (level > 0) && (level <= 4)
then blankline <> text "@node " <> literal node $$
literal sec <> txt
else txt
where
seccmd :: PandocMonad m => Int -> TI m Text
seccmd :: forall (m :: * -> *). PandocMonad m => Int -> TI m Text
seccmd Int
1 = Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"@chapter "
seccmd Int
2 = Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"@section "
seccmd Int
3 = Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"@subsection "
seccmd Int
4 = Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"@subsubsection "
seccmd Int
_ = PandocError -> StateT WriterState m Text
forall a. PandocError -> StateT WriterState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT WriterState m Text)
-> PandocError -> StateT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError Text
"illegal seccmd level"
blockToTexinfo (Header Int
_ Attr
_ [Inline]
lst) = Block -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
blockToTexinfo ([Inline] -> Block
Para [Inline]
lst)
blockToTexinfo (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
heads, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
headers <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
heads
then Doc Text -> TI 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
empty
else [Alignment] -> [[Block]] -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Alignment] -> [[Block]] -> TI m (Doc Text)
tableHeadToTexinfo [Alignment]
aligns [[Block]]
heads
captionText <- inlineListToTexinfo caption
rowsText <- mapM (tableRowToTexinfo aligns) rows
colDescriptors <-
if all (== 0) widths
then do
cols <- mapM (mapM (fmap (T.unpack . render Nothing . hcat) .
mapM blockToTexinfo)) $
transpose $ heads : rows
return $ concatMap
((\String
x -> String
"{"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
xString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"} ") .
maybe "" (maximumBy (comparing length)) . nonEmpty)
cols
else return $ "@columnfractions " ++ concatMap (printf "%.2f ") widths
let tableBody = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String
"@multitable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
colDescriptors) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
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]
rowsText Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@end multitable"
return $ if isEmpty captionText
then tableBody <> blankline
else text "@float Table" $$
tableBody $$
inCmd "caption" captionText $$
text "@end float"
blockToTexinfo (Figure Attr
_ Caption
caption [SimpleFigure Attr
attr [Inline]
figCaption (Text, Text)
tgt]) = do
let capt :: [Inline]
capt = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
figCaption
then let (Caption Maybe [Inline]
_ [Block]
cblks) = Caption
caption
in [Block] -> [Inline]
blocksToInlines [Block]
cblks
else [Inline]
figCaption
captionText <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
capt
then Doc Text -> TI 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
empty
else (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@caption" 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
braces (Doc Text -> Doc Text) -> TI m (Doc Text) -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
capt
img <- inlineToTexinfo (Image attr figCaption tgt)
return $ text "@float Figure" $$ img $$ captionText $$ text "@end float"
blockToTexinfo (Figure Attr
_ Caption
fCaption [
Table Attr
attr tCaption :: Caption
tCaption@(Caption Maybe [Inline]
_ [Block]
cbody) [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot]) = do
let caption :: Caption
caption = case [Block]
cbody of
[] -> Caption
fCaption
[Block]
_ -> Caption
tCaption
Block -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
blockToTexinfo (Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
caption [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot)
blockToTexinfo (Figure Attr
_ (Caption Maybe [Inline]
_ [Block]
caption) [Block]
body) = do
captionText <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo ([Inline] -> TI m (Doc Text)) -> [Inline] -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Block] -> [Inline]
blocksToInlines [Block]
caption
content <- blockListToTexinfo body
return $ text ("@float" ++ floatType body) $$ content $$ (
if isEmpty captionText
then empty
else inCmd "caption" captionText
) $$ text "@end float"
where
floatType :: [Block] -> a
floatType [SimpleFigure {}] = a
" Figure"
floatType [Table {}] = a
" Table"
floatType [Block]
_ = a
""
tableHeadToTexinfo :: PandocMonad m
=> [Alignment]
-> [[Block]]
-> TI m (Doc Text)
tableHeadToTexinfo :: forall (m :: * -> *).
PandocMonad m =>
[Alignment] -> [[Block]] -> TI m (Doc Text)
tableHeadToTexinfo = Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
tableAnyRowToTexinfo Text
"@headitem "
tableRowToTexinfo :: PandocMonad m
=> [Alignment]
-> [[Block]]
-> TI m (Doc Text)
tableRowToTexinfo :: forall (m :: * -> *).
PandocMonad m =>
[Alignment] -> [[Block]] -> TI m (Doc Text)
tableRowToTexinfo = Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
tableAnyRowToTexinfo Text
"@item "
tableAnyRowToTexinfo :: PandocMonad m
=> Text
-> [Alignment]
-> [[Block]]
-> TI m (Doc Text)
tableAnyRowToTexinfo :: forall (m :: * -> *).
PandocMonad m =>
Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
tableAnyRowToTexinfo Text
itemtype [Alignment]
aligns [[Block]]
cols =
(Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
itemtype Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$) (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Doc Text -> Doc Text)
-> Doc Text -> [Doc Text] -> Doc Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Doc Text
row Doc Text
item -> Doc Text
row Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
(if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
row then Doc Text
forall a. Doc a
empty else String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
" @tab ") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
item) Doc Text
forall a. Doc a
empty ([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
<$> (Alignment -> [Block] -> StateT WriterState m (Doc Text))
-> [Alignment] -> [[Block]] -> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Alignment -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Alignment -> [Block] -> TI m (Doc Text)
alignedBlock [Alignment]
aligns [[Block]]
cols
alignedBlock :: PandocMonad m
=> Alignment
-> [Block]
-> TI m (Doc Text)
alignedBlock :: forall (m :: * -> *).
PandocMonad m =>
Alignment -> [Block] -> TI m (Doc Text)
alignedBlock Alignment
_ = [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo
blockListToTexinfo :: PandocMonad m
=> [Block]
-> TI m (Doc Text)
blockListToTexinfo :: forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [] = Doc Text -> StateT WriterState 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
empty
blockListToTexinfo (Block
x:[Block]
xs) = do
x' <- Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
blockToTexinfo Block
x
case x of
Header Int
level Attr
_ [Inline]
_ -> do
let ([Block]
before, [Block]
after) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isHeaderBlock [Block]
xs
before' <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
before
let menu = if Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4
then Int -> [Block] -> [Block]
collectNodes (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Block]
after
else []
lines' <- mapM makeMenuLine menu
let menu' = if [Doc Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
lines'
then Doc Text
forall a. Doc a
empty
else Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@menu" 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]
lines' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@end menu"
after' <- blockListToTexinfo after
return $ x' $$ before' $$ menu' $$ after'
Para [Inline]
_ -> do
xs' <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
xs
case xs of
(CodeBlock Attr
_ Text
_:[Block]
_) -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
x' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
xs'
[Block]
_ -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
x' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
xs'
Block
_ -> do
xs' <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
xs
return $ x' $$ xs'
collectNodes :: Int -> [Block] -> [Block]
collectNodes :: Int -> [Block] -> [Block]
collectNodes Int
_ [] = []
collectNodes Int
level (Block
x:[Block]
xs) =
case Block
x of
(Header Int
hl Attr
_ [Inline]
_)
| Int
hl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
level -> []
| Int
hl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
level -> Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Int -> [Block] -> [Block]
collectNodes Int
level [Block]
xs
| Bool
otherwise -> Int -> [Block] -> [Block]
collectNodes Int
level [Block]
xs
Block
_ ->
Int -> [Block] -> [Block]
collectNodes Int
level [Block]
xs
makeMenuLine :: PandocMonad m
=> Block
-> TI m (Doc Text)
(Header Int
_ (Text
_,[Text]
_,[(Text
"node", Text
node)]) [Inline]
lst) = do
txt <- Context -> TI m (Doc Text) -> TI m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
Context -> TI m a -> TI m a
withContext Context
NodeContext (TI m (Doc Text) -> TI m (Doc Text))
-> TI m (Doc Text) -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
pure $ nowrap $ text "* " <>
if render Nothing txt == node
then literal node <> "::"
else txt <> ": " <> literal node <> "."
makeMenuLine Block
_ = PandocError -> TI m (Doc Text)
forall a. PandocError -> StateT WriterState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> TI m (Doc Text)) -> PandocError -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError Text
"makeMenuLine called with non-node"
listItemToTexinfo :: PandocMonad m
=> [Block]
-> TI m (Doc Text)
listItemToTexinfo :: forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
listItemToTexinfo [Block]
lst = do
contents <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
lst
let spacer = case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
lst of
(Para{}:[Block]
_) -> Doc a
forall a. Doc a
blankline
[Block]
_ -> Doc a
forall a. Doc a
empty
return $ text "@item" $$ contents <> spacer
defListItemToTexinfo :: PandocMonad m
=> ([Inline], [[Block]])
-> TI m (Doc Text)
defListItemToTexinfo :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> TI m (Doc Text)
defListItemToTexinfo ([Inline]
term, [[Block]]
defs) = do
term' <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
term
let defToTexinfo [Block]
bs = do d <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
bs
case reverse bs of
(Para{}:[Block]
_) -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
[Block]
_ -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
d
defs' <- mapM defToTexinfo defs
return $ text "@item " <> term' $+$ vcat defs'
inlineListToTexinfo :: PandocMonad m
=> [Inline]
-> TI m (Doc Text)
inlineListToTexinfo :: forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst = [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 -> TI m (Doc Text)
inlineToTexinfo [Inline]
lst
inlineToTexinfo :: PandocMonad m
=> Inline
-> TI m (Doc Text)
inlineToTexinfo :: forall (m :: * -> *). PandocMonad m => Inline -> TI m (Doc Text)
inlineToTexinfo (Span Attr
_ [Inline]
lst) =
[Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
inlineToTexinfo (Emph [Inline]
lst) =
Text -> Doc Text -> Doc Text
inCmd Text
"emph" (Doc Text -> Doc Text) -> TI m (Doc Text) -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
inlineToTexinfo (Underline [Inline]
lst) =
Inline -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> TI m (Doc Text)
inlineToTexinfo ([Inline] -> Inline
Emph [Inline]
lst)
inlineToTexinfo (Strong [Inline]
lst) =
Text -> Doc Text -> Doc Text
inCmd Text
"strong" (Doc Text -> Doc Text) -> TI m (Doc Text) -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
inlineToTexinfo (Strikeout [Inline]
lst) = 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{ stStrikeout = True }
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
return $ text "@textstrikeout{" <> contents <> text "}"
inlineToTexinfo (Superscript [Inline]
lst) = do
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
return $ text "@sup{" <> contents <> char '}'
inlineToTexinfo (Subscript [Inline]
lst) = do
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
return $ text "@sub{" <> contents <> char '}'
inlineToTexinfo (SmallCaps [Inline]
lst) =
Text -> Doc Text -> Doc Text
inCmd Text
"sc" (Doc Text -> Doc Text) -> TI m (Doc Text) -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
inlineToTexinfo (Code (Text
_, [Text]
cls , [(Text, Text)]
_) Text
str) | String -> Text
T.pack String
"variable" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls = do
code <- Text -> TI m Text
forall (m :: * -> *). PandocMonad m => Text -> TI m Text
stringToTexinfo Text
str
return $ literal $ "@code{@var{" <> code <> "}}"
inlineToTexinfo (Code Attr
_ Text
str) = do
code <- Text -> TI m Text
forall (m :: * -> *). PandocMonad m => Text -> TI m Text
stringToTexinfo Text
str
return $ literal $ "@code{" <> code <> "}"
inlineToTexinfo (Quoted QuoteType
SingleQuote [Inline]
lst) = do
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
return $ char '`' <> contents <> char '\''
inlineToTexinfo (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
return $ text "``" <> contents <> text "''"
inlineToTexinfo (Cite [Citation]
_ [Inline]
lst) =
[Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
inlineToTexinfo (Str Text
str) = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> TI m Text -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> TI m Text
forall (m :: * -> *). PandocMonad m => Text -> TI m Text
stringToTexinfo Text
str
inlineToTexinfo (Math MathType
_ Text
str) = Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
inCmd Text
"math" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
inlineToTexinfo il :: Inline
il@(RawInline Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"tex" =
Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@tex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@end tex"
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"texinfo" = Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
| Bool
otherwise = do
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
Doc Text -> TI 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
empty
inlineToTexinfo Inline
LineBreak = Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"@*" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToTexinfo Inline
SoftBreak = do
wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions)
case wrapText of
WrapOption
WrapAuto -> Doc Text -> TI 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 -> TI 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
WrapPreserve -> Doc Text -> TI 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
inlineToTexinfo Inline
Space = Doc Text -> TI 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
inlineToTexinfo (Link Attr
_ [Inline]
txt (Text
src, Text
_))
| Just (Char
'#', Text
ident) <- Text -> Maybe (Char, Text)
T.uncons Text
src = do
headings <- (WriterState -> Map Text Text)
-> StateT WriterState m (Map Text Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Text Text
stHeadings
target <- case M.lookup ident headings of
Maybe Text
Nothing -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> TI m Text -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> TI m Text
forall (m :: * -> *). PandocMonad m => Text -> TI m Text
stringToTexinfo
((Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
disallowedInNode) Text
src)
Just Text
node -> Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
node
contents <- withContext NodeContext $ inlineListToTexinfo txt
return $ text "@ref"
<> braces (target <> if contents == target
then mempty
else text ",," <> contents)
| Bool
otherwise = case [Inline]
txt of
[Str Text
x] | Text -> Text
escapeURI Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src ->
Doc Text -> TI m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI 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
"@url{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
[Inline]
_ -> do
contents <- Context -> TI m (Doc Text) -> TI m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
Context -> TI m a -> TI m a
withContext Context
NodeContext (TI m (Doc Text) -> TI m (Doc Text))
-> TI m (Doc Text) -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
txt
src1 <- stringToTexinfo src
return $ literal ("@uref{" <> src1 <> ",") <> contents <>
char '}'
inlineToTexinfo (Image Attr
attr [Inline]
alternate (Text
source, Text
_)) = do
content <- Context -> TI m (Doc Text) -> TI m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
Context -> TI m a -> TI m a
withContext Context
NodeContext (TI m (Doc Text) -> TI m (Doc Text))
-> TI m (Doc Text) -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
alternate
opts <- gets stOptions
let showDim Direction
dim = case Direction -> Attr -> Maybe Dimension
dimension Direction
dim Attr
attr of
(Just (Pixel Integer
a)) -> WriterOptions -> Dimension -> Text
showInInch WriterOptions
opts (Integer -> Dimension
Pixel Integer
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in"
(Just (Percent Double
_)) -> Text
""
(Just Dimension
d) -> Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
d
Maybe Dimension
Nothing -> Text
""
return $ literal ("@image{" <> base <> "," <> showDim Width <> "," <> showDim Height <> ",")
<> content <> text "," <> literal (ext <> "}")
where
ext :: Text
ext = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
takeExtension String
source'
base :: Text
base = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension String
source'
source' :: String
source' = if Text -> Bool
isURI Text
source
then Text -> String
T.unpack Text
source
else ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
source
inlineToTexinfo (Note [Block]
contents) = do
contents' <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
contents
return $ text "@footnote" <> braces contents'