{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Writers.Textile ( writeTextile ) where
import Control.Monad (zipWithM, liftM)
import Control.Monad.State.Strict ( StateT, gets, modify, evalStateT )
import Data.Char (isSpace)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout (render, literal)
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML (escapeStringForXML)
data WriterState = WriterState {
WriterState -> [Text]
stNotes :: [Text]
, WriterState -> [Char]
stListLevel :: [Char]
, WriterState -> Maybe Int
stStartNum :: Maybe Int
, WriterState -> Bool
stUseTags :: Bool
}
type TW = StateT WriterState
writeTextile :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTextile WriterOptions
opts 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
pandocToTextile WriterOptions
opts Pandoc
document)
WriterState { stNotes :: [Text]
stNotes = [],
stListLevel :: [Char]
stListLevel = [],
stStartNum :: Maybe Int
stStartNum = Maybe Int
forall a. Maybe a
Nothing,
stUseTags :: Bool
stUseTags = Bool
False }
pandocToTextile :: PandocMonad m
=> WriterOptions -> Pandoc -> TW m Text
pandocToTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> TW m Text
pandocToTextile WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
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
opts
((Text -> Doc Text) -> TW m 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 Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (TW m Text -> StateT WriterState m (Doc Text))
-> ([Block] -> TW m Text)
-> [Block]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts)
((Text -> Doc Text) -> TW m 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 Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (TW m Text -> StateT WriterState m (Doc Text))
-> ([Inline] -> TW m Text)
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts) Meta
meta
Text
body <- WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
blocks
Text
notes <- (WriterState -> Text) -> TW m Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> Text) -> TW m Text)
-> (WriterState -> Text) -> TW m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> (WriterState -> [Text]) -> WriterState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text])
-> (WriterState -> [Text]) -> WriterState -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [Text]
stNotes
let main :: Text
main = Text
body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
notes then Text
"" else Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
notes
let context :: Context Text
context = Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Text
main 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
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Text
main
Just Template Text
tpl -> 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) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ 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
withUseTags :: PandocMonad m => TW m a -> TW m a
withUseTags :: forall (m :: * -> *) a. PandocMonad m => TW m a -> TW m a
withUseTags TW m a
action = do
Bool
oldUseTags <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
(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
s -> WriterState
s { stUseTags :: Bool
stUseTags = Bool
True }
a
result <- TW m a
action
(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
s -> WriterState
s { stUseTags :: Bool
stUseTags = Bool
oldUseTags }
a -> TW m a
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
escapeCharForTextile :: Char -> Text
escapeCharForTextile :: Char -> Text
escapeCharForTextile Char
x = case Char
x of
Char
'&' -> Text
"&"
Char
'<' -> Text
"<"
Char
'>' -> Text
">"
Char
'"' -> Text
"""
Char
'*' -> Text
"*"
Char
'_' -> Text
"_"
Char
'@' -> Text
"@"
Char
'+' -> Text
"+"
Char
'-' -> Text
"-"
Char
'|' -> Text
"|"
Char
'\x2014' -> Text
" -- "
Char
'\x2013' -> Text
" - "
Char
'\x2019' -> Text
"'"
Char
'\x2026' -> Text
"..."
Char
c -> Char -> Text
T.singleton Char
c
escapeTextForTextile :: Text -> Text
escapeTextForTextile :: Text -> Text
escapeTextForTextile = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeCharForTextile
blockToTextile :: PandocMonad m
=> WriterOptions
-> Block
-> TW m Text
blockToTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> TW m Text
blockToTextile WriterOptions
opts (Div Attr
attr [Block]
bs) = do
let startTag :: Text
startTag = 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) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attr -> Doc Text
forall a. HasChars a => a -> Attr -> Doc a
tagWithAttrs Text
"div" Attr
attr
let endTag :: Text
endTag = Text
"</div>"
Text
contents <- WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
bs
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
$ Text
startTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
blockToTextile WriterOptions
opts (Plain [Inline]
inlines) =
WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
inlines
blockToTextile WriterOptions
opts (Para [Inline]
inlines) = do
Bool
useTags <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
[Char]
listLevel <- (WriterState -> [Char]) -> StateT WriterState m [Char]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Char]
stListLevel
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
inlines
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
$ if Bool
useTags
then Text
"<p>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</p>"
else Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
listLevel then Text
"\n" else Text
""
blockToTextile WriterOptions
opts (LineBlock [[Inline]]
lns) =
WriterOptions -> Block -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> TW m Text
blockToTextile WriterOptions
opts (Block -> TW m Text) -> Block -> TW m Text
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToTextile WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"textile" = Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return 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
$ Block -> LogMessage
BlockNotRendered Block
b
Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
blockToTextile WriterOptions
_ Block
HorizontalRule = Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"<hr />\n"
blockToTextile WriterOptions
opts (Header Int
level (Text
ident,[Text]
classes,[(Text, Text)]
keyvals) [Inline]
inlines) = do
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
inlines
let identAttr :: Text
identAttr = if Text -> Bool
T.null Text
ident then Text
"" else Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident
let attribs :: Text
attribs = if Text -> Bool
T.null Text
identAttr Bool -> Bool -> Bool
&& [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
then Text
""
else Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
classes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identAttr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
let lang :: Text
lang = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
x -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
keyvals
let styles :: Text
styles = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
x -> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"style" [(Text, Text)]
keyvals
let prefix :: Text
prefix = Text
"h" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
level Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attribs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
styles Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". "
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
$ Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
blockToTextile WriterOptions
_ (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
str) | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace) (Text -> [Text]
T.lines Text
str) =
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
$ Text
"<pre" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
classes' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\n</pre>\n"
where classes' :: Text
classes' = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
then Text
""
else Text
" class=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
classes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
blockToTextile WriterOptions
_ (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
str) =
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
$ Text
"bc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
classes' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
where classes' :: Text
classes' = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
then Text
""
else Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
classes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
blockToTextile WriterOptions
opts (BlockQuote bs :: [Block]
bs@[Para [Inline]
_]) = do
Text
contents <- WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
bs
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
$ Text
"bq. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
blockToTextile WriterOptions
opts (BlockQuote [Block]
blocks) = do
Text
contents <- WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
blocks
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
$ Text
"<blockquote>\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n</blockquote>\n"
blockToTextile WriterOptions
opts (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot)
= case Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot of
([], [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows') | (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0) [Double]
widths -> do
[Text]
hs <- ([Block] -> TW m Text) -> [[Block]] -> StateT WriterState m [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 ((Text -> Text) -> TW m Text -> TW m Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Text
"_. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripTrailingNewlines) (TW m Text -> TW m Text)
-> ([Block] -> TW m Text) -> [Block] -> TW m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts) [[Block]]
headers
let cellsToRow :: [Text] -> Text
cellsToRow [Text]
cells = Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"|" [Text]
cells Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"
let header :: Text
header = 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]]
headers then Text
"" else [Text] -> Text
cellsToRow [Text]
hs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
let blocksToCell :: (Alignment, [Block]) -> StateT WriterState m Text
blocksToCell (Alignment
align, [Block]
bs) = do
Text
contents <- Text -> Text
stripTrailingNewlines (Text -> Text)
-> StateT WriterState m Text -> StateT WriterState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
bs
let alignMarker :: Text
alignMarker = case Alignment
align of
Alignment
AlignLeft -> Text
"<. "
Alignment
AlignRight -> Text
">. "
Alignment
AlignCenter -> Text
"=. "
Alignment
AlignDefault -> Text
""
Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT WriterState m Text)
-> Text -> StateT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
alignMarker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
let rowToCells :: [[Block]] -> StateT WriterState m [Text]
rowToCells = ((Alignment, [Block]) -> TW m Text)
-> [(Alignment, [Block])] -> StateT WriterState m [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 (Alignment, [Block]) -> TW m Text
forall {m :: * -> *}.
PandocMonad m =>
(Alignment, [Block]) -> StateT WriterState m Text
blocksToCell ([(Alignment, [Block])] -> StateT WriterState m [Text])
-> ([[Block]] -> [(Alignment, [Block])])
-> [[Block]]
-> StateT WriterState m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Alignment] -> [[Block]] -> [(Alignment, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns
[[Text]]
bs <- ([[Block]] -> StateT WriterState m [Text])
-> [[[Block]]] -> StateT WriterState m [[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 [Text]
rowToCells [[[Block]]]
rows'
let body :: Text
body = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
cellsToRow [[Text]]
bs
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
$ Text
header Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
body
([Inline]
capt, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows') -> do
let alignStrings :: [Text]
alignStrings = (Alignment -> Text) -> [Alignment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Alignment -> Text
alignmentToText [Alignment]
aligns
Text
captionDoc <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
capt
then Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
else do
Text
c <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
capt
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
$ Text
"<caption>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</caption>\n"
let percent :: a -> Text
percent a
w = Integer -> Text
forall a. Show a => a -> Text
tshow (a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
100a -> a -> a
forall a. Num a => a -> a -> a
*a
w) :: Integer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"
let coltags :: Text
coltags = if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0) [Double]
widths
then Text
""
else [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Double -> Text) -> [Double] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
(\Double
w -> Text
"<col width=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall {a}. RealFrac a => a -> Text
percent Double
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" />") [Double]
widths
Text
head' <- 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]]
headers
then Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
else do
Text
hs <- WriterOptions -> [Text] -> Int -> [[Block]] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Int -> [[Block]] -> TW m Text
tableRowToTextile WriterOptions
opts [Text]
alignStrings Int
0 [[Block]]
headers
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
$ Text
"<thead>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n</thead>\n"
[Text]
body' <- (Int -> [[Block]] -> TW m Text)
-> [Int] -> [[[Block]]] -> StateT WriterState m [Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (WriterOptions -> [Text] -> Int -> [[Block]] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Int -> [[Block]] -> TW m Text
tableRowToTextile WriterOptions
opts [Text]
alignStrings) [Int
1..] [[[Block]]]
rows'
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
$ Text
"<table>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
captionDoc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
coltags Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
head' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"<tbody>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines [Text]
body' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</tbody>\n</table>\n"
blockToTextile WriterOptions
opts x :: Block
x@(BulletList [[Block]]
items) = do
Bool
oldUseTags <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
let useTags :: Bool
useTags = Bool
oldUseTags Bool -> Bool -> Bool
|| Bool -> Bool
not (Block -> Bool
isSimpleList Block
x)
if Bool
useTags
then do
[Text]
contents <- StateT WriterState m [Text] -> StateT WriterState m [Text]
forall (m :: * -> *) a. PandocMonad m => TW m a -> TW m a
withUseTags (StateT WriterState m [Text] -> StateT WriterState m [Text])
-> StateT WriterState m [Text] -> StateT WriterState m [Text]
forall a b. (a -> b) -> a -> b
$ ([Block] -> TW m Text) -> [[Block]] -> StateT WriterState m [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 (WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
listItemToTextile WriterOptions
opts) [[Block]]
items
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
$ Text
"<ul>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
vcat [Text]
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n</ul>\n"
else 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
s -> WriterState
s { stListLevel :: [Char]
stListLevel = WriterState -> [Char]
stListLevel WriterState
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"*" }
Int
level <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> Int) -> StateT WriterState m Int)
-> (WriterState -> Int) -> StateT WriterState m Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> (WriterState -> [Char]) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [Char]
stListLevel
[Text]
contents <- ([Block] -> TW m Text) -> [[Block]] -> StateT WriterState m [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 (WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
listItemToTextile WriterOptions
opts) [[Block]]
items
(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
s -> WriterState
s { stListLevel :: [Char]
stListLevel = [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init (WriterState -> [Char]
stListLevel WriterState
s) }
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
$ [Text] -> Text
vcat [Text]
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then Text
"" else Text
"\n")
blockToTextile WriterOptions
opts x :: Block
x@(OrderedList attribs :: ListAttributes
attribs@(Int
start, ListNumberStyle
_, ListNumberDelim
_) [[Block]]
items) = do
Bool
oldUseTags <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
let useTags :: Bool
useTags = Bool
oldUseTags Bool -> Bool -> Bool
|| Bool -> Bool
not (Block -> Bool
isSimpleList Block
x)
if Bool
useTags
then do
[Text]
contents <- StateT WriterState m [Text] -> StateT WriterState m [Text]
forall (m :: * -> *) a. PandocMonad m => TW m a -> TW m a
withUseTags (StateT WriterState m [Text] -> StateT WriterState m [Text])
-> StateT WriterState m [Text] -> StateT WriterState m [Text]
forall a b. (a -> b) -> a -> b
$ ([Block] -> TW m Text) -> [[Block]] -> StateT WriterState m [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 (WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
listItemToTextile WriterOptions
opts) [[Block]]
items
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
$ Text
"<ol" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ListAttributes -> Text
listAttribsToString ListAttributes
attribs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
vcat [Text]
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\n</ol>\n"
else 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
s -> WriterState
s { stListLevel :: [Char]
stListLevel = WriterState -> [Char]
stListLevel WriterState
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"#"
, stStartNum :: Maybe Int
stStartNum = if Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
start
else Maybe Int
forall a. Maybe a
Nothing }
Int
level <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> Int) -> StateT WriterState m Int)
-> (WriterState -> Int) -> StateT WriterState m Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> (WriterState -> [Char]) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [Char]
stListLevel
[Text]
contents <- ([Block] -> TW m Text) -> [[Block]] -> StateT WriterState m [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 (WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
listItemToTextile WriterOptions
opts) [[Block]]
items
(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
s -> WriterState
s { stListLevel :: [Char]
stListLevel = [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init (WriterState -> [Char]
stListLevel WriterState
s),
stStartNum :: Maybe Int
stStartNum = Maybe Int
forall a. Maybe a
Nothing }
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
$ [Text] -> Text
vcat [Text]
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then Text
"" else Text
"\n")
blockToTextile WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
[Text]
contents <- StateT WriterState m [Text] -> StateT WriterState m [Text]
forall (m :: * -> *) a. PandocMonad m => TW m a -> TW m a
withUseTags (StateT WriterState m [Text] -> StateT WriterState m [Text])
-> StateT WriterState m [Text] -> StateT WriterState m [Text]
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> TW m Text)
-> [([Inline], [[Block]])] -> StateT WriterState m [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 (WriterOptions -> ([Inline], [[Block]]) -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> TW m Text
definitionListItemToTextile WriterOptions
opts) [([Inline], [[Block]])]
items
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
$ Text
"<dl>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
vcat [Text]
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n</dl>\n"
blockToTextile WriterOptions
opts (Figure Attr
attr (Caption Maybe [Inline]
_ [Block]
caption) [Block]
body) = do
let startTag :: Text
startTag = 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) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Attr -> Doc Text
forall a. HasChars a => a -> Attr -> Doc a
tagWithAttrs Text
"figure" Attr
attr
let endTag :: Text
endTag = Text
"</figure>"
let captionInlines :: [Inline]
captionInlines = [Block] -> [Inline]
blocksToInlines [Block]
caption
Text
captionMarkup <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
captionInlines
then Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
else ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n</figcaption>\n\n") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"<figcaption>\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) (Text -> Text) -> TW m Text -> TW m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts ([Block] -> [Inline]
blocksToInlines [Block]
caption)
Text
contents <- WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
body
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
$ Text
startTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
captionMarkup Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
listAttribsToString :: ListAttributes -> Text
listAttribsToString :: ListAttributes -> Text
listAttribsToString (Int
startnum, ListNumberStyle
numstyle, ListNumberDelim
_) =
let numstyle' :: Text
numstyle' = Text -> Text
camelCaseToHyphenated (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ListNumberStyle -> Text
forall a. Show a => a -> Text
tshow ListNumberStyle
numstyle
in (if Int
startnum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
then Text
" start=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
startnum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(if ListNumberStyle
numstyle ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
/= ListNumberStyle
DefaultStyle
then Text
" style=\"list-style-type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
numstyle' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";\""
else Text
"")
listItemToTextile :: PandocMonad m
=> WriterOptions -> [Block] -> TW m Text
listItemToTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
listItemToTextile WriterOptions
opts [Block]
items = do
Text
contents <- WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
items
Bool
useTags <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stUseTags
if Bool
useTags
then 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
$ Text
"<li>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</li>"
else do
[Char]
marker <- (WriterState -> [Char]) -> StateT WriterState m [Char]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Char]
stListLevel
Maybe Int
mbstart <- (WriterState -> Maybe Int) -> StateT WriterState m (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe Int
stStartNum
case Maybe Int
mbstart of
Just Int
n -> 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
s -> WriterState
s{ stStartNum :: Maybe Int
stStartNum = Maybe Int
forall a. Maybe a
Nothing }
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
$ [Char] -> Text
T.pack [Char]
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
Maybe Int
Nothing -> 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
$ [Char] -> Text
T.pack [Char]
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
definitionListItemToTextile :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> TW m Text
definitionListItemToTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> TW m Text
definitionListItemToTextile WriterOptions
opts ([Inline]
label, [[Block]]
items) = do
Text
labelText <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
label
[Text]
contents <- ([Block] -> TW m Text) -> [[Block]] -> StateT WriterState m [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 (WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts) [[Block]]
items
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
$ Text
"<dt>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
labelText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</dt>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
T.intercalate Text
"\n" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
d -> Text
"<dd>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</dd>") [Text]
contents)
isSimpleList :: Block -> Bool
isSimpleList :: Block -> Bool
isSimpleList Block
x =
case Block
x of
BulletList [[Block]]
items -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleListItem [[Block]]
items
OrderedList (Int
_, ListNumberStyle
sty, ListNumberDelim
_) [[Block]]
items -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleListItem [[Block]]
items Bool -> Bool -> Bool
&&
ListNumberStyle
sty ListNumberStyle -> [ListNumberStyle] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ListNumberStyle
DefaultStyle, ListNumberStyle
Decimal]
Block
_ -> Bool
False
isSimpleListItem :: [Block] -> Bool
isSimpleListItem :: [Block] -> Bool
isSimpleListItem [] = Bool
True
isSimpleListItem [Block
x] =
case Block
x of
Plain [Inline]
_ -> Bool
True
Para [Inline]
_ -> Bool
True
BulletList [[Block]]
_ -> Block -> Bool
isSimpleList Block
x
OrderedList ListAttributes
_ [[Block]]
_ -> Block -> Bool
isSimpleList Block
x
Block
_ -> Bool
False
isSimpleListItem [Block
x, Block
y] | Block -> Bool
isPlainOrPara Block
x =
case Block
y of
BulletList [[Block]]
_ -> Block -> Bool
isSimpleList Block
y
OrderedList ListAttributes
_ [[Block]]
_ -> Block -> Bool
isSimpleList Block
y
Block
_ -> Bool
False
isSimpleListItem [Block]
_ = Bool
False
isPlainOrPara :: Block -> Bool
isPlainOrPara :: Block -> Bool
isPlainOrPara (Plain [Inline]
_) = Bool
True
isPlainOrPara (Para [Inline]
_) = Bool
True
isPlainOrPara Block
_ = Bool
False
vcat :: [Text] -> Text
vcat :: [Text] -> Text
vcat = Text -> [Text] -> Text
T.intercalate Text
"\n"
tableRowToTextile :: PandocMonad m
=> WriterOptions
-> [Text]
-> Int
-> [[Block]]
-> TW m Text
tableRowToTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Int -> [[Block]] -> TW m Text
tableRowToTextile WriterOptions
opts [Text]
alignStrings Int
rownum [[Block]]
cols' = do
let celltype :: Text
celltype = if Int
rownum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Text
"th" else Text
"td"
let rowclass :: Text
rowclass = case Int
rownum of
Int
0 -> Text
"header"
Int
x | Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Text
"odd"
Int
_ -> Text
"even"
[Text]
cols'' <- (Text -> [Block] -> TW m Text)
-> [Text] -> [[Block]] -> StateT WriterState m [Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
(\Text
alignment [Block]
item -> WriterOptions -> Text -> Text -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Block] -> TW m Text
tableItemToTextile WriterOptions
opts Text
celltype Text
alignment [Block]
item)
[Text]
alignStrings [[Block]]
cols'
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
$ Text
"<tr class=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rowclass Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\">\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines [Text]
cols'' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</tr>"
alignmentToText :: Alignment -> Text
alignmentToText :: Alignment -> Text
alignmentToText Alignment
alignment = case Alignment
alignment of
Alignment
AlignLeft -> Text
"left"
Alignment
AlignRight -> Text
"right"
Alignment
AlignCenter -> Text
"center"
Alignment
AlignDefault -> Text
"left"
tableItemToTextile :: PandocMonad m
=> WriterOptions
-> Text
-> Text
-> [Block]
-> TW m Text
tableItemToTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Block] -> TW m Text
tableItemToTextile WriterOptions
opts Text
celltype Text
align' [Block]
item = do
let mkcell :: Text -> Text
mkcell Text
x = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
celltype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" align=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
align' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
celltype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
Text
contents <- WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
item
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
$ Text -> Text
mkcell Text
contents
blockListToTextile :: PandocMonad m
=> WriterOptions
-> [Block]
-> TW m Text
blockListToTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
blocks =
[Text] -> Text
vcat ([Text] -> Text)
-> StateT WriterState m [Text] -> StateT WriterState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState m Text)
-> [Block] -> StateT WriterState m [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 (WriterOptions -> Block -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> TW m Text
blockToTextile WriterOptions
opts) [Block]
blocks
inlineListToTextile :: PandocMonad m
=> WriterOptions -> [Inline] -> TW m Text
inlineListToTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst =
[Text] -> Text
T.concat ([Text] -> Text)
-> StateT WriterState m [Text] -> StateT WriterState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT WriterState m Text)
-> [Inline] -> StateT WriterState m [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 (WriterOptions -> Inline -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> TW m Text
inlineToTextile WriterOptions
opts) [Inline]
lst
inlineToTextile :: PandocMonad m => WriterOptions -> Inline -> TW m Text
inlineToTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> TW m Text
inlineToTextile WriterOptions
opts (Span Attr
_ [Inline]
lst) =
WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
inlineToTextile WriterOptions
opts (Emph [Inline]
lst) = do
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
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
$ if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
contents
then Text
"<em>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</em>"
else Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
inlineToTextile WriterOptions
opts (Underline [Inline]
lst) = do
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
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
$ if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+') Text
contents
then Text
"<u>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</u>"
else Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+"
inlineToTextile WriterOptions
opts (Strong [Inline]
lst) = do
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
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
$ if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*') Text
contents
then Text
"<strong>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</strong>"
else Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
inlineToTextile WriterOptions
opts (Strikeout [Inline]
lst) = do
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
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
$ if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Text
contents
then Text
"<del>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</del>"
else Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-"
inlineToTextile WriterOptions
opts (Superscript [Inline]
lst) = do
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
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
$ if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'^') Text
contents
then Text
"<sup>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</sup>"
else Text
"[^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^]"
inlineToTextile WriterOptions
opts (Subscript [Inline]
lst) = do
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
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
$ if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~') Text
contents
then Text
"<sub>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</sub>"
else Text
"[~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"~]"
inlineToTextile WriterOptions
opts (SmallCaps [Inline]
lst) = WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
inlineToTextile WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
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
$ Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
inlineToTextile WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
Text
contents <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
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
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
inlineToTextile WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) = WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst
inlineToTextile WriterOptions
_ (Code Attr
_ Text
str) =
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
$ if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@') Text
str
then Text
"<tt>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</tt>"
else Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@"
inlineToTextile WriterOptions
_ (Str Text
str) = 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
$ Text -> Text
escapeTextForTextile Text
str
inlineToTextile WriterOptions
_ (Math MathType
_ Text
str) =
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
$ Text
"<span class=\"math\">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</span>"
inlineToTextile WriterOptions
opts il :: Inline
il@(RawInline Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"textile" = Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
| (Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex") Bool -> Bool -> Bool
&&
Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_raw_tex WriterOptions
opts = Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return 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
Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
inlineToTextile WriterOptions
_ Inline
LineBreak = Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n"
inlineToTextile WriterOptions
_ Inline
SoftBreak = Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToTextile WriterOptions
_ Inline
Space = Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToTextile WriterOptions
opts (Link (Text
_, [Text]
cls, [(Text, Text)]
_) [Inline]
txt (Text
src, Text
_)) = do
Text
label <- case [Inline]
txt of
[Code Attr
_ Text
s]
| Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src -> Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"$"
[Str Text
s]
| Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src -> Text -> TW m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"$"
[Inline]
_ -> WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
txt
let classes :: Text
classes = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls Bool -> Bool -> Bool
|| [Text]
cls [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
"uri"] Bool -> Bool -> Bool
&& Text
label Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"$"
then Text
""
else Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
cls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
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
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
classes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src
inlineToTextile WriterOptions
opts (Image attr :: Attr
attr@(Text
_, [Text]
cls, [(Text, Text)]
_) [Inline]
alt (Text
source, Text
tit)) = do
Text
alt' <- WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
alt
let txt :: Text
txt = if Text -> Bool
T.null Text
tit
then if Text -> Bool
T.null Text
alt'
then Text
""
else Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
alt' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
else Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
classes :: Text
classes = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls
then Text
""
else Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
cls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
showDim :: Direction -> Maybe Text
showDim Direction
dir = let toCss :: Text -> Maybe Text
toCss Text
str = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Direction -> Text
forall a. Show a => a -> Text
tshow Direction
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
in case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
Just (Percent Double
a) -> Text -> Maybe Text
toCss (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Dimension -> Text
forall a. Show a => a -> Text
tshow (Double -> Dimension
Percent Double
a)
Just Dimension
dim -> Text -> Maybe Text
toCss (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Dimension -> Text
showInPixel WriterOptions
opts Dimension
dim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px"
Maybe Dimension
Nothing -> Maybe Text
forall a. Maybe a
Nothing
styles :: Text
styles = case (Direction -> Maybe Text
showDim Direction
Width, Direction -> Maybe Text
showDim Direction
Height) of
(Just Text
w, Just Text
h) -> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
(Just Text
w, Maybe Text
Nothing) -> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"height:auto;}"
(Maybe Text
Nothing, Just Text
h) -> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"width:auto;" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
(Maybe Text
Nothing, Maybe Text
Nothing) -> Text
""
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
$ Text
"!" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
classes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
styles Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
source Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!"
inlineToTextile WriterOptions
opts (Note [Block]
contents) = do
[Text]
curNotes <- (WriterState -> [Text]) -> StateT WriterState m [Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Text]
stNotes
let newnum :: Int
newnum = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
curNotes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Text
contents' <- WriterOptions -> [Block] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> TW m Text
blockListToTextile WriterOptions
opts [Block]
contents
let thisnote :: Text
thisnote = Text
"fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
newnum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
(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
s -> WriterState
s { stNotes :: [Text]
stNotes = Text
thisnote Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
curNotes }
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
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
newnum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"