{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.Textile
   Copyright   : Copyright (C) 2010-2022 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to Textile markup.

Textile:  <http://thresholdstate.com/articles/4312/the-textile-reference-manual>
-}
module Text.Pandoc.Writers.Textile ( writeTextile ) where
import Control.Monad.State.Strict
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]        -- Footnotes
  , WriterState -> [Char]
stListLevel :: [Char]        -- String at beginning of list items, e.g. "**"
  , WriterState -> Maybe Int
stStartNum  :: Maybe Int     -- Start number if first list item
  , WriterState -> Bool
stUseTags   :: Bool          -- True if we should use HTML tags because we're in a complex list
  }

type TW = StateT WriterState

-- | Convert Pandoc to Textile.
writeTextile :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTextile :: WriterOptions -> Pandoc -> m Text
writeTextile opts :: WriterOptions
opts document :: 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 :: [Text] -> [Char] -> Maybe Int -> Bool -> WriterState
WriterState { stNotes :: [Text]
stNotes = [],
                          stListLevel :: [Char]
stListLevel = [],
                          stStartNum :: Maybe Int
stStartNum = Maybe Int
forall a. Maybe a
Nothing,
                          stUseTags :: Bool
stUseTags = Bool
False }

-- | Return Textile representation of document.
pandocToTextile :: PandocMonad m
                => WriterOptions -> Pandoc -> TW m Text
pandocToTextile :: WriterOptions -> Pandoc -> TW m Text
pandocToTextile opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [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 (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 (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 "" else "\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 "body" Text
main Context Text
metadata
  Text -> TW m Text
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
         Nothing  -> Text
main
         Just tpl :: 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 :: TW m a -> TW m a
withUseTags action :: 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
$ \s :: 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
$ \s :: WriterState
s -> WriterState
s { stUseTags :: Bool
stUseTags = Bool
oldUseTags }
  a -> TW m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Escape one character as needed for Textile.
escapeCharForTextile :: Char -> Text
escapeCharForTextile :: Char -> Text
escapeCharForTextile x :: Char
x = case Char
x of
                         '&'      -> "&amp;"
                         '<'      -> "&lt;"
                         '>'      -> "&gt;"
                         '"'      -> "&quot;"
                         '*'      -> "&#42;"
                         '_'      -> "&#95;"
                         '@'      -> "&#64;"
                         '+'      -> "&#43;"
                         '-'      -> "&#45;"
                         '|'      -> "&#124;"
                         '\x2014' -> " -- "
                         '\x2013' -> " - "
                         '\x2019' -> "'"
                         '\x2026' -> "..."
                         c :: Char
c        -> Char -> Text
T.singleton Char
c

-- | Escape string as needed for Textile.
escapeTextForTextile :: Text -> Text
escapeTextForTextile :: Text -> Text
escapeTextForTextile = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeCharForTextile

-- | Convert Pandoc block element to Textile.
blockToTextile :: PandocMonad m
               => WriterOptions -- ^ Options
               -> Block         -- ^ Block element
               -> TW m Text

blockToTextile :: WriterOptions -> Block -> TW m Text
blockToTextile _ Null = Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""

blockToTextile opts :: WriterOptions
opts (Div attr :: Attr
attr bs :: [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 => Text -> Attr -> Doc a
tagWithAttrs "div" Attr
attr
  let endTag :: Text
endTag = "</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 (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
<> "\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"

blockToTextile opts :: WriterOptions
opts (Plain inlines :: [Inline]
inlines) =
  WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
inlines

blockToTextile opts :: WriterOptions
opts (SimpleFigure attr :: Attr
attr txt :: [Inline]
txt (src :: Text
src, tit :: Text
tit)) = do
  Text
capt <- WriterOptions -> Block -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> TW m Text
blockToTextile WriterOptions
opts ([Inline] -> Block
Para [Inline]
txt)
  Text
im <- WriterOptions -> Inline -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> TW m Text
inlineToTextile WriterOptions
opts (Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
txt (Text
src,Text
tit))
  Text -> TW m Text
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
im Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
capt

blockToTextile opts :: WriterOptions
opts (Para inlines :: [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 (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 "<p>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</p>"
              else Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
listLevel then "\n" else ""

blockToTextile opts :: WriterOptions
opts (LineBlock lns :: [[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 _ b :: Block
b@(RawBlock f :: Format
f str :: Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "html" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "textile" = Text -> TW m Text
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 (m :: * -> *) a. Monad m => a -> m a
return ""

blockToTextile _ HorizontalRule = Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "<hr />\n"

blockToTextile opts :: WriterOptions
opts (Header level :: Int
level (ident :: Text
ident,classes :: [Text]
classes,keyvals :: [Target]
keyvals) inlines :: [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 "" else "#" 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
                   then ""
                   else "(" 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
<> ")"
  let lang :: Text
lang = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (\x :: Text
x -> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "lang" [Target]
keyvals
  let styles :: Text
styles = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (\x :: Text
x -> "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}") (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Target] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "style" [Target]
keyvals
  let prefix :: Text
prefix = "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 -> TW m Text
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
<> "\n"

blockToTextile _ (CodeBlock (_,classes :: [Text]
classes,_) str :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<pre"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
classes' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">\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
<>
           "\n</pre>\n"
    where classes' :: Text
classes' = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
                        then ""
                        else " 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
<> "\""

blockToTextile _ (CodeBlock (_,classes :: [Text]
classes,_) str :: Text
str) =
  Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "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
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n\n"
    where classes' :: Text
classes' = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
                        then ""
                        else "(" 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
<> ")"

blockToTextile opts :: WriterOptions
opts (BlockQuote bs :: [Block]
bs@[Para _]) = 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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "bq. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n\n"

blockToTextile opts :: WriterOptions
opts (BlockQuote blocks :: [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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<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
<> "\n</blockquote>\n"

blockToTextile opts :: WriterOptions
opts (Table _ blkCapt :: Caption
blkCapt specs :: [ColSpec]
specs thead :: TableHead
thead tbody :: [TableBody]
tbody tfoot :: 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
      ([], aligns :: [Alignment]
aligns, widths :: [Double]
widths, headers :: [[Block]]
headers, rows' :: [[[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
==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)
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
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 cells :: [Text]
cells = "|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate "|" [Text]
cells Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "|"
        let header :: Text
header = if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers then "" else [Text] -> Text
cellsToRow [Text]
hs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
        let blocksToCell :: (Alignment, [Block]) -> StateT WriterState m Text
blocksToCell (align :: Alignment
align, bs :: [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
                                     AlignLeft    -> "<. "
                                     AlignRight   -> ">. "
                                     AlignCenter  -> "=. "
                                     AlignDefault -> ""
              Text -> StateT WriterState m Text
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)
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)
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 (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
      (capt :: [Inline]
capt, aligns :: [Alignment]
aligns, widths :: [Double]
widths, headers :: [[Block]]
headers, rows' :: [[[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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
capt
                         then Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
                         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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<caption>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</caption>\n"
        let percent :: a -> Text
percent w :: a
w = Integer -> Text
forall a. Show a => a -> Text
tshow (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (100a -> a -> a
forall a. Num a => a -> a -> a
*a
w) :: Integer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%"
        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
== 0.0) [Double]
widths
                         then ""
                         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
                               (\w :: Double
w -> "<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
<> "\" />") [Double]
widths
        Text
head' <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
                    then Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return ""
                    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 0 [[Block]]
headers
                       Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<thead>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\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) [1..] [[[Block]]]
rows'
        Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<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
<>
                  "<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
<> "</tbody>\n</table>\n"

blockToTextile opts :: WriterOptions
opts x :: Block
x@(BulletList items :: [[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)
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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<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
<> "\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
$ \s :: WriterState
s -> WriterState
s { stListLevel :: [Char]
stListLevel = WriterState -> [Char]
stListLevel WriterState
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> "*" }
        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 (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)
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
$ \s :: WriterState
s -> WriterState
s { stListLevel :: [Char]
stListLevel = [Char] -> [Char]
forall a. [a] -> [a]
init (WriterState -> [Char]
stListLevel WriterState
s) }
        Text -> TW m Text
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
> 1 then "" else "\n")

blockToTextile opts :: WriterOptions
opts x :: Block
x@(OrderedList attribs :: ListAttributes
attribs@(start :: Int
start, _, _) items :: [[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)
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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<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
<> ">\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
<>
                   "\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
$ \s :: WriterState
s -> WriterState
s { stListLevel :: [Char]
stListLevel = WriterState -> [Char]
stListLevel WriterState
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> "#"
                         , stStartNum :: Maybe Int
stStartNum = if Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 (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)
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
$ \s :: WriterState
s -> WriterState
s { stListLevel :: [Char]
stListLevel = [Char] -> [Char]
forall a. [a] -> [a]
init (WriterState -> [Char]
stListLevel WriterState
s),
                           stStartNum :: Maybe Int
stStartNum = Maybe Int
forall a. Maybe a
Nothing }
        Text -> TW m Text
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
> 1 then "" else "\n")

blockToTextile opts :: WriterOptions
opts (DefinitionList items :: [([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)
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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<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
<> "\n</dl>\n"

-- Auxiliary functions for lists:

-- | Convert ordered list attributes to HTML attribute string
listAttribsToString :: ListAttributes -> Text
listAttribsToString :: ListAttributes -> Text
listAttribsToString (startnum :: Int
startnum, numstyle :: ListNumberStyle
numstyle, _) =
  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
/= 1
          then " 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
<> "\""
          else "") 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 " 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
<> ";\""
          else "")

-- | Convert bullet or ordered list item (list of blocks) to Textile.
listItemToTextile :: PandocMonad m
                  => WriterOptions -> [Block] -> TW m Text
listItemToTextile :: WriterOptions -> [Block] -> TW m Text
listItemToTextile opts :: WriterOptions
opts items :: [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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<li>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</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 n :: 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
$ \s :: WriterState
s -> WriterState
s{ stStartNum :: Maybe Int
stStartNum = Maybe Int
forall a. Maybe a
Nothing }
              Text -> TW m Text
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
forall a. Semigroup a => a -> a -> a
<> Text
contents
            Nothing -> Text -> TW m Text
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
forall a. Semigroup a => a -> a -> a
<> Text
contents

-- | Convert definition list item (label, list of blocks) to Textile.
definitionListItemToTextile :: PandocMonad m
                            => WriterOptions
                             -> ([Inline],[[Block]])
                             -> TW m Text
definitionListItemToTextile :: WriterOptions -> ([Inline], [[Block]]) -> TW m Text
definitionListItemToTextile opts :: WriterOptions
opts (label :: [Inline]
label, items :: [[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)
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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<dt>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
labelText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</dt>\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text -> [Text] -> Text
T.intercalate "\n" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\d :: Text
d -> "<dd>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</dd>") [Text]
contents)

-- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed.
isSimpleList :: Block -> Bool
isSimpleList :: Block -> Bool
isSimpleList x :: Block
x =
  case Block
x of
       BulletList items :: [[Block]]
items                 -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleListItem [[Block]]
items
       OrderedList (_, sty :: ListNumberStyle
sty, _) items :: [[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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ListNumberStyle
DefaultStyle, ListNumberStyle
Decimal]
       _                                -> Bool
False

-- | True if list item can be handled with the simple wiki syntax.  False if
--   HTML tags will be needed.
isSimpleListItem :: [Block] -> Bool
isSimpleListItem :: [Block] -> Bool
isSimpleListItem []  = Bool
True
isSimpleListItem [x :: Block
x] =
  case Block
x of
       Plain _         -> Bool
True
       Para  _         -> Bool
True
       BulletList _    -> Block -> Bool
isSimpleList Block
x
       OrderedList _ _ -> Block -> Bool
isSimpleList Block
x
       _               -> Bool
False
isSimpleListItem [x :: Block
x, y :: Block
y] | Block -> Bool
isPlainOrPara Block
x =
  case Block
y of
       BulletList _    -> Block -> Bool
isSimpleList Block
y
       OrderedList _ _ -> Block -> Bool
isSimpleList Block
y
       _               -> Bool
False
isSimpleListItem _ = Bool
False

isPlainOrPara :: Block -> Bool
isPlainOrPara :: Block -> Bool
isPlainOrPara (Plain _) = Bool
True
isPlainOrPara (Para  _) = Bool
True
isPlainOrPara _         = Bool
False

-- | Concatenates strings with line breaks between them.
vcat :: [Text] -> Text
vcat :: [Text] -> Text
vcat = Text -> [Text] -> Text
T.intercalate "\n"

-- Auxiliary functions for tables. (TODO: these are common to HTML, MediaWiki,
-- and Textile writers, and should be abstracted out.)

tableRowToTextile :: PandocMonad m
                  => WriterOptions
                  -> [Text]
                  -> Int
                  -> [[Block]]
                  -> TW m Text
tableRowToTextile :: WriterOptions -> [Text] -> Int -> [[Block]] -> TW m Text
tableRowToTextile opts :: WriterOptions
opts alignStrings :: [Text]
alignStrings rownum :: Int
rownum cols' :: [[Block]]
cols' = do
  let celltype :: Text
celltype = if Int
rownum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "th" else "td"
  let rowclass :: Text
rowclass = case Int
rownum of
                      0 -> "header"
                      x :: Int
x | Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` 2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> "odd"
                      _ -> "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
            (\alignment :: Text
alignment item :: [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 (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<tr class=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rowclass Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\">\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
<> "</tr>"

alignmentToText :: Alignment -> Text
alignmentToText :: Alignment -> Text
alignmentToText alignment :: Alignment
alignment = case Alignment
alignment of
                                 AlignLeft    -> "left"
                                 AlignRight   -> "right"
                                 AlignCenter  -> "center"
                                 AlignDefault -> "left"

tableItemToTextile :: PandocMonad m
                   => WriterOptions
                   -> Text
                   -> Text
                   -> [Block]
                   -> TW m Text
tableItemToTextile :: WriterOptions -> Text -> Text -> [Block] -> TW m Text
tableItemToTextile opts :: WriterOptions
opts celltype :: Text
celltype align' :: Text
align' item :: [Block]
item = do
  let mkcell :: Text -> Text
mkcell x :: Text
x = "<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
celltype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " 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
forall a. Semigroup a => a -> a -> a
<>
                    Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
celltype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">"
  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 (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

-- | Convert list of Pandoc block elements to Textile.
blockListToTextile :: PandocMonad m
                   => WriterOptions -- ^ Options
                   -> [Block]       -- ^ List of block elements
                   -> TW m Text
blockListToTextile :: WriterOptions -> [Block] -> TW m Text
blockListToTextile opts :: WriterOptions
opts blocks :: [Block]
blocks =
  [Text] -> Text
vcat ([Text] -> Text) -> StateT WriterState m [Text] -> TW m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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)
mapM (WriterOptions -> Block -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> TW m Text
blockToTextile WriterOptions
opts) [Block]
blocks

-- | Convert list of Pandoc inline elements to Textile.
inlineListToTextile :: PandocMonad m
                    => WriterOptions -> [Inline] -> TW m Text
inlineListToTextile :: WriterOptions -> [Inline] -> TW m Text
inlineListToTextile opts :: WriterOptions
opts lst :: [Inline]
lst =
  [Text] -> Text
T.concat ([Text] -> Text) -> StateT WriterState m [Text] -> TW m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> TW m Text) -> [Inline] -> StateT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Inline -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> TW m Text
inlineToTextile WriterOptions
opts) [Inline]
lst

-- | Convert Pandoc inline element to Textile.
inlineToTextile :: PandocMonad m => WriterOptions -> Inline -> TW m Text

inlineToTextile :: WriterOptions -> Inline -> TW m Text
inlineToTextile opts :: WriterOptions
opts (Span _ lst :: [Inline]
lst) =
  WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst

inlineToTextile opts :: WriterOptions
opts (Emph lst :: [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 (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 -> Text -> Bool
`elemText` Text
contents
              then "<em>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</em>"
              else "_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "_"

inlineToTextile opts :: WriterOptions
opts (Underline lst :: [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 (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 -> Text -> Bool
`elemText` Text
contents
              then "<u>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</u>"
              else "+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "+"

inlineToTextile opts :: WriterOptions
opts (Strong lst :: [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 (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 -> Text -> Bool
`elemText` Text
contents
              then "<strong>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</strong>"
              else "*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "*"

inlineToTextile opts :: WriterOptions
opts (Strikeout lst :: [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 (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 -> Text -> Bool
`elemText` Text
contents
              then "<del>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</del>"
              else "-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-"

inlineToTextile opts :: WriterOptions
opts (Superscript lst :: [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 (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 -> Text -> Bool
`elemText` Text
contents
              then "<sup>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</sup>"
              else "[^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "^]"

inlineToTextile opts :: WriterOptions
opts (Subscript lst :: [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 (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 -> Text -> Bool
`elemText` Text
contents
              then "<sub>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "</sub>"
              else "[~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "~]"

inlineToTextile opts :: WriterOptions
opts (SmallCaps lst :: [Inline]
lst) = WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst

inlineToTextile opts :: WriterOptions
opts (Quoted SingleQuote lst :: [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 (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
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "'"

inlineToTextile opts :: WriterOptions
opts (Quoted DoubleQuote lst :: [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 (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
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""

inlineToTextile opts :: WriterOptions
opts (Cite _  lst :: [Inline]
lst) = WriterOptions -> [Inline] -> TW m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> TW m Text
inlineListToTextile WriterOptions
opts [Inline]
lst

inlineToTextile _ (Code _ str :: Text
str) =
  Text -> TW m Text
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 -> Text -> Bool
`elemText` Text
str
           then "<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
<> "</tt>"
           else "@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "@"

inlineToTextile _ (Str str :: Text
str) = Text -> TW m Text
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 _ (Math _ str :: Text
str) =
  Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TW m Text) -> Text -> TW m Text
forall a b. (a -> b) -> a -> b
$ "<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
<> "</span>"

inlineToTextile opts :: WriterOptions
opts il :: Inline
il@(RawInline f :: Format
f str :: Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "html" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "textile" = Text -> TW m Text
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 "latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "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 (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 (m :: * -> *) a. Monad m => a -> m a
return ""

inlineToTextile _ LineBreak = Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "\n"

inlineToTextile _ SoftBreak = Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return " "

inlineToTextile _ Space = Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return " "

inlineToTextile opts :: WriterOptions
opts (Link (_, cls :: [Text]
cls, _) txt :: [Inline]
txt (src :: Text
src, _)) = do
  Text
label <- case [Inline]
txt of
                [Code _ s :: Text
s]
                 | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src -> Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "$"
                [Str s :: Text
s]
                 | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src -> Text -> TW m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "$"
                _           -> 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 (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
== ["uri"] Bool -> Bool -> Bool
&& Text
label Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "$"
                   then ""
                   else "(" 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 -> TW m Text
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
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
forall a. Semigroup a => a -> a -> a
<> Text
src

inlineToTextile opts :: WriterOptions
opts (Image attr :: Attr
attr@(_, cls :: [Text]
cls, _) alt :: [Inline]
alt (source :: Text
source, tit :: 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 ""
                       else "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
alt' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
               else "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
      classes :: Text
classes = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls
                   then ""
                   else "(" 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
<> ")"
      showDim :: Direction -> Maybe Text
showDim dir :: Direction
dir = let toCss :: Text -> Maybe Text
toCss str :: 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
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ";"
                    in case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
                         Just (Percent a :: 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 dim :: 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
<> "px"
                         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 w :: Text
w, Just h :: Text
h)   -> "{" 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
<> "}"
                 (Just w :: Text
w, Nothing)  -> "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "height:auto;}"
                 (Nothing, Just h :: Text
h)  -> "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "width:auto;" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"
                 (Nothing, Nothing) -> ""
  Text -> TW m Text
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
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
<> "!"

inlineToTextile opts :: WriterOptions
opts (Note contents :: [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 (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
curNotes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 = "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
forall a. Semigroup a => a -> a -> a
<> Text
contents' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\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
$ \s :: WriterState
s -> WriterState
s { stNotes :: [Text]
stNotes = Text
thisnote Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
curNotes }
  Text -> TW m Text
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
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
<> "]"
  -- note - may not work for notes with multiple blocks