{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.AsciiDoc
   Copyright   : Copyright (C) 2006-2024 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Conversion of 'Pandoc' documents to asciidoc.

Note that some information may be lost in conversion, due to
expressive limitations of asciidoc.  Footnotes and table cells with
paragraphs (or other block items) are not possible in asciidoc.
If pandoc encounters one of these, it will insert a message indicating
that it has omitted the construct.

AsciiDoc:  <http://www.methods.co.nz/asciidoc/>
-}
module Text.Pandoc.Writers.AsciiDoc (
  writeAsciiDoc,
  writeAsciiDocLegacy,
  writeAsciiDoctor
  ) where
import Control.Monad (foldM)
import Control.Monad.State.Strict
    ( StateT, MonadState(get), gets, modify, evalStateT )
import Data.Char (isPunctuation, isSpace)
import Data.List (delete, intercalate, intersperse)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text (Text)
import Network.URI (parseURI, URI(uriScheme))
import System.FilePath (dropExtension)
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.Pandoc.Parsing hiding (blankline, space)
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk (walk)

data WriterState = WriterState { WriterState -> Text
defListMarker       :: Text
                               , WriterState -> Int
orderedListLevel    :: Int
                               , WriterState -> Int
bulletListLevel     :: Int
                               , WriterState -> Bool
intraword           :: Bool
                               , WriterState -> Set Text
autoIds             :: Set.Set Text
                               , WriterState -> Bool
legacy              :: Bool
                               , WriterState -> Bool
inList              :: Bool
                               , WriterState -> Bool
hasMath             :: Bool
                               -- |0 is no table
                               -- 1 is top level table
                               -- 2 is a table in a table
                               , WriterState -> Int
tableNestingLevel   :: Int
                               }

defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState = WriterState { defListMarker :: Text
defListMarker      = Text
"::"
                                 , orderedListLevel :: Int
orderedListLevel   = Int
0
                                 , bulletListLevel :: Int
bulletListLevel    = Int
0
                                 , intraword :: Bool
intraword          = Bool
False
                                 , autoIds :: Set Text
autoIds            = Set Text
forall a. Set a
Set.empty
                                 , legacy :: Bool
legacy             = Bool
False
                                 , inList :: Bool
inList             = Bool
False
                                 , hasMath :: Bool
hasMath            = Bool
False
                                 , tableNestingLevel :: Int
tableNestingLevel  = Int
0
                                 }

-- | Convert Pandoc to AsciiDoc.
writeAsciiDoc :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeAsciiDoc 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 -> ADW m Text
pandocToAsciiDoc WriterOptions
opts Pandoc
document) WriterState
defaultWriterState

{-# DEPRECATED writeAsciiDoctor "Use writeAsciiDoc instead" #-}
-- | Deprecated synonym of 'writeAsciiDoc'.
writeAsciiDoctor :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeAsciiDoctor :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeAsciiDoctor = WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeAsciiDoc

-- | Convert Pandoc to legacy AsciiDoc.
writeAsciiDocLegacy :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeAsciiDocLegacy :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeAsciiDocLegacy 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 -> ADW m Text
pandocToAsciiDoc WriterOptions
opts Pandoc
document)
    WriterState
defaultWriterState{ legacy = True }

type ADW = StateT WriterState

-- | Return asciidoc representation of document.
pandocToAsciiDoc :: PandocMonad m => WriterOptions -> Pandoc -> ADW m Text
pandocToAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> ADW m Text
pandocToAsciiDoc WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  let titleblock :: Bool
titleblock = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Meta -> [Inline]
docTitle Meta
meta) Bool -> Bool -> Bool
&& [[Inline]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Meta -> [[Inline]]
docAuthors Meta
meta) Bool -> Bool -> Bool
&&
                         [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Meta -> [Inline]
docDate Meta
meta)
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Maybe Int
forall a. Maybe a
Nothing
  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
              (WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ADW m (Doc Text)
blockListToAsciiDoc WriterOptions
opts)
              ((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts)
              Meta
meta
  main <- blockListToAsciiDoc opts $ makeSections False Nothing blocks
  st <- get
  let context  = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
               (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc"
                  (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts Bool -> Bool -> Bool
&&
                   Maybe (Template Text) -> Bool
forall a. Maybe a -> Bool
isJust (WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts))
               (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"math" (WriterState -> Bool
hasMath WriterState
st Bool -> Bool -> Bool
&& Bool -> Bool
not (WriterState -> Bool
legacy WriterState
st))
               (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"titleblock" Bool
titleblock Context Text
metadata
  return $ render colwidth $
    case writerTemplate opts of
       Maybe (Template Text)
Nothing  -> Doc Text
main
       Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

data EscContext = Normal | InTable
  deriving (Int -> EscContext -> ShowS
[EscContext] -> ShowS
EscContext -> String
(Int -> EscContext -> ShowS)
-> (EscContext -> String)
-> ([EscContext] -> ShowS)
-> Show EscContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EscContext -> ShowS
showsPrec :: Int -> EscContext -> ShowS
$cshow :: EscContext -> String
show :: EscContext -> String
$cshowList :: [EscContext] -> ShowS
showList :: [EscContext] -> ShowS
Show, EscContext -> EscContext -> Bool
(EscContext -> EscContext -> Bool)
-> (EscContext -> EscContext -> Bool) -> Eq EscContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EscContext -> EscContext -> Bool
== :: EscContext -> EscContext -> Bool
$c/= :: EscContext -> EscContext -> Bool
/= :: EscContext -> EscContext -> Bool
Eq)

-- | Escape special characters for AsciiDoc.
escapeString :: EscContext -> Text -> Doc Text
escapeString :: EscContext -> Text -> Doc Text
escapeString EscContext
context Text
t
  | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
needsEscape Text
t
  = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
      case ((Bool, Text) -> Char -> (Bool, Text))
-> (Bool, Text) -> Text -> (Bool, Text)
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (Bool, Text) -> Char -> (Bool, Text)
go (Bool
False, Text
forall a. Monoid a => a
mempty) Text
t of
        (Bool
True, Text
x) -> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"++" -- close passthrough context
        (Bool
False, Text
x) -> Text
x
  | Bool
otherwise = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
t
 where
  -- Bool is True when we are in a ++ passthrough context
  go :: (Bool, Text) -> Char -> (Bool, Text)
  go :: (Bool, Text) -> Char -> (Bool, Text)
go (Bool
True, Text
x) Char
'+' = (Bool
False, Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"++" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{plus}") -- close context
  go (Bool
False, Text
x) Char
'+' = (Bool
False, Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{plus}")
  go (Bool
True, Text
x) Char
'|'
    | EscContext
context EscContext -> EscContext -> Bool
forall a. Eq a => a -> a -> Bool
== EscContext
InTable = (Bool
False, Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"++" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{vbar}") -- close context
  go (Bool
False, Text
x) Char
'|'
    | EscContext
context EscContext -> EscContext -> Bool
forall a. Eq a => a -> a -> Bool
== EscContext
InTable = (Bool
False, Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{vbar}")
  go (Bool
True, Text
x) Char
c
    | Char -> Bool
needsEscape Char
c = (Bool
True, Text -> Char -> Text
T.snoc Text
x Char
c)
    | Bool
otherwise = (Bool
False, Text -> Char -> Text
T.snoc (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"++") Char
c)
  go (Bool
False, Text
x) Char
c
    | Char -> Bool
needsEscape Char
c = (Bool
True, Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"++" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c)
    | Bool
otherwise = (Bool
False, Text -> Char -> Text
T.snoc Text
x Char
c)

  needsEscape :: Char -> Bool
needsEscape Char
'{' = Bool
True
  needsEscape Char
'+' = Bool
True
  needsEscape Char
'`' = Bool
True
  needsEscape Char
'*' = Bool
True
  needsEscape Char
'_' = Bool
True
  needsEscape Char
'<' = Bool
True
  needsEscape Char
'>' = Bool
True
  needsEscape Char
'[' = Bool
True
  needsEscape Char
']' = Bool
True
  needsEscape Char
'\\' = Bool
True
  needsEscape Char
'|' = Bool
True
  needsEscape Char
_ = Bool
False

-- | Ordered list start parser for use in Para below.
olMarker :: Parsec Text ParserState Char
olMarker :: Parsec Text ParserState Char
olMarker = do (start, style', delim) <- ParsecT
  Text ParserState Identity (Int, ListNumberStyle, ListNumberDelim)
forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s ParserState m (Int, ListNumberStyle, ListNumberDelim)
anyOrderedListMarker
              if delim == Period &&
                          (style' == UpperAlpha || (style' == UpperRoman &&
                          start `elem` [1, 5, 10, 50, 100, 500, 1000]))
                          then spaceChar >> spaceChar
                          else spaceChar

-- | True if string begins with an ordered list marker
-- or would be interpreted as an AsciiDoc option command
needsEscaping :: Text -> Bool
needsEscaping :: Text -> Bool
needsEscaping Text
s = Text -> Bool
beginsWithOrderedListMarker Text
s Bool -> Bool -> Bool
|| Text -> Bool
isBracketed Text
s
  where
    beginsWithOrderedListMarker :: Text -> Bool
beginsWithOrderedListMarker Text
str =
      case Parsec Text ParserState Char
-> ParserState -> String -> Text -> Either ParseError Char
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec Text ParserState Char
olMarker ParserState
defaultParserState String
"para start" (Int -> Text -> Text
T.take Int
10 Text
str) of
             Left  ParseError
_ -> Bool
False
             Right Char
_ -> Bool
True
    isBracketed :: Text -> Bool
isBracketed Text
t
      | Just (Char
'[', Text
t') <- Text -> Maybe (Char, Text)
T.uncons Text
t
      , Just (Text
_, Char
']')  <- Text -> Maybe (Text, Char)
T.unsnoc Text
t'
      = Bool
True
      | Bool
otherwise = Bool
False

-- | Convert Pandoc block element to asciidoc.
blockToAsciiDoc :: PandocMonad m
                => WriterOptions -- ^ Options
                -> Block         -- ^ Block element
                -> ADW m (Doc Text)
blockToAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ADW m (Doc Text)
blockToAsciiDoc WriterOptions
opts (Div (Text
id',Text
"section":[Text]
_,[(Text, Text)]
_)
                       (Header Int
level (Text
_,[Text]
cls,[(Text, Text)]
kvs) [Inline]
ils : [Block]
xs)) = do
  hdr <- WriterOptions -> Block -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ADW m (Doc Text)
blockToAsciiDoc WriterOptions
opts (Int -> (Text, [Text], [(Text, Text)]) -> [Inline] -> Block
Header Int
level (Text
id',[Text]
cls,[(Text, Text)]
kvs) [Inline]
ils)
  rest <- blockListToAsciiDoc opts xs
  return $ hdr $$ rest
blockToAsciiDoc WriterOptions
opts (Plain [Inline]
inlines) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
inlines
  return $ contents <> blankline
blockToAsciiDoc WriterOptions
opts (Para [Inline]
inlines) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
inlines
  -- escape if para starts with ordered list marker
  let esc = if Text -> Bool
needsEscaping (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
contents)
               then String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"{empty}"
               else Doc Text
forall a. Doc a
empty
  return $ esc <> contents <> blankline
blockToAsciiDoc WriterOptions
opts (LineBlock [[Inline]]
lns) = do
  let docify :: [Inline] -> StateT WriterState m (Doc Text)
docify [Inline]
line = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
line
                    then Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
blankline
                    else WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
line
  let joinWithLinefeeds :: [Doc Text] -> Doc Text
joinWithLinefeeds = Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
forall a. Doc a
cr
  contents <- [Doc Text] -> Doc Text
joinWithLinefeeds ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> ADW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> ADW m (Doc Text))
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> ADW m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
[Inline] -> StateT WriterState m (Doc Text)
docify [[Inline]]
lns
  return $ "[verse]" $$ text "--" $$ contents $$ text "--" $$ blankline
blockToAsciiDoc WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
s)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"asciidoc" = Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ADW m (Doc Text)) -> Doc Text -> ADW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
s
  | Bool
otherwise         = do
      LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToAsciiDoc WriterOptions
_ Block
HorizontalRule =
  Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ADW m (Doc Text)) -> Doc Text -> ADW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"'''''" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToAsciiDoc WriterOptions
opts (Header Int
level (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
inlines) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
inlines
  ids <- gets autoIds
  let autoId = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
inlines Set Text
ids
  modify $ \WriterState
st -> WriterState
st{ autoIds = Set.insert autoId ids }
  let identifier = if Text -> Bool
T.null Text
ident Bool -> Bool -> Bool
||
                      (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_auto_identifiers WriterOptions
opts Bool -> Bool -> Bool
&& Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
autoId)
                      then Doc Text
forall a. Doc a
empty
                      else Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
  return $ identifier $$
           nowrap (text (replicate (level + 1) '=') <> space <> contents) <>
           blankline
blockToAsciiDoc WriterOptions
opts (Figure (Text, [Text], [(Text, Text)])
attr (Caption Maybe [Inline]
_ [Block]
longcapt) [Block]
body) = do
  -- Images in figures all get rendered as individual block-level images
  -- with the given caption. Non-image elements are rendered unchanged.
  capt <- if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
longcapt
             then Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
             else (Doc Text
"." Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text) -> ADW m (Doc Text) -> ADW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts ([Block] -> [Inline]
blocksToInlines [Block]
longcapt)
  let renderFigElement = \case
        Plain [Image (Text, [Text], [(Text, Text)])
imgAttr [Inline]
alternate (Text
src, Text
tit)] -> do
          args <- WriterOptions
-> (Text, [Text], [(Text, Text)])
-> [Inline]
-> Text
-> Text
-> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (Text, [Text], [(Text, Text)])
-> [Inline]
-> Text
-> Text
-> ADW m (Doc Text)
imageArguments WriterOptions
opts (Text, [Text], [(Text, Text)])
imgAttr [Inline]
alternate Text
src Text
tit
          let figAttributes = case (Text, [Text], [(Text, Text)])
attr of
                (Text
"", [Text]
_, [(Text, Text)]
_)    -> Doc Text
forall a. Doc a
empty
                (Text
ident, [Text]
_, [(Text, Text)]
_) -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"[#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
          -- .Figure caption
          -- image::images/logo.png[Company logo, title="blah"]
          return $
            capt $$
            figAttributes $$
            "image::" <> args <> blankline
        Block
blk -> WriterOptions -> Block -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ADW m (Doc Text)
blockToAsciiDoc WriterOptions
opts Block
blk
  vcat <$> mapM renderFigElement body
blockToAsciiDoc WriterOptions
_ (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
str) = Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ADW m (Doc Text)) -> Doc Text -> ADW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (
  if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
     then Doc Text
"...." Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"...."
     else Doc Text
attrs Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"----" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"----")
  Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
    where attrs :: Doc Text
attrs = Doc Text
"[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> [Text] -> Text
T.intercalate Text
"," [Text]
classes') Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
          classes' :: [Text]
classes' = if Text
"numberLines" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                        then Text
"source%linesnum" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
delete Text
"numberLines" [Text]
classes
                        else Text
"source" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
classes
blockToAsciiDoc WriterOptions
opts (BlockQuote [Block]
blocks) = do
  contents <- WriterOptions -> [Block] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ADW m (Doc Text)
blockListToAsciiDoc WriterOptions
opts [Block]
blocks
  let isBlock (BlockQuote [Block]
_) = Bool
True
      isBlock Block
_              = Bool
False
  -- if there are nested block quotes, put in an open block
  let contents' = if (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isBlock [Block]
blocks
                     then Doc Text
"--" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"--"
                     else Doc Text
contents
  let bar = String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"____"
  return $ bar $$ chomp contents' $$ bar <> blankline
blockToAsciiDoc WriterOptions
opts block :: Block
block@(Table (Text, [Text], [(Text, Text)])
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
  let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) =
        Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
  caption' <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
caption
  let caption'' = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
                     then Doc Text
forall a. Doc a
empty
                     else Doc Text
"." Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
caption' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
  let isSimple = (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
  let relativePercentWidths = if Bool
isSimple
                                 then [Double]
widths
                                 else (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths) [Double]
widths
  let widths'' :: [Integer]
      widths'' = (Double -> Integer) -> [Double] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> (Double -> Double) -> Double -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)) [Double]
relativePercentWidths
  -- ensure that the widths sum to 100
  let widths' = case [Integer]
widths'' of
                     [Integer]
_ | Bool
isSimple -> [Integer]
widths''
                     (Integer
w:[Integer]
ws) | [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Integer
wInteger -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
ws) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
100
                               -> (Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Integer]
ws) Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ws
                     [Integer]
ws        -> [Integer]
ws
  let totalwidth :: Integer
      totalwidth = Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
  let colspec Alignment
al a
wi = (case Alignment
al of
                         Alignment
AlignLeft    -> String
"<"
                         Alignment
AlignCenter  -> String
"^"
                         Alignment
AlignRight   -> String
">"
                         Alignment
AlignDefault -> String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++
                      if a
wi a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then String
"" else a -> String
forall a. Show a => a -> String
show a
wi String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"%"
  let headerspec = 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 Doc Text
forall a. Doc a
empty
                      else String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"options=\"header\","
  let widthspec = if Integer
totalwidth Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
                     then Doc Text
forall a. Doc a
empty
                     else String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"width="
                          Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
totalwidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"%")
                          Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
","
  let tablespec = String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"["
         Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
widthspec
         Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"cols="
         Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
doubleQuotes (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
","
             ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Alignment -> Integer -> String)
-> [Alignment] -> [Integer] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Alignment -> Integer -> String
forall {a}. (Eq a, Num a, Show a) => Alignment -> a -> String
colspec [Alignment]
aligns [Integer]
widths')
         Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
","
         Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
headerspec Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"]"

  -- construct cells and recurse in case of nested tables
  parentTableLevel <- gets tableNestingLevel
  let currentNestingLevel = Int
parentTableLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

  modify $ \WriterState
st -> WriterState
st{ tableNestingLevel = currentNestingLevel }

  let separator = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (if Int
parentTableLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                          then String
"|"  -- top level separator
                          else String
"!") -- nested separator

  let makeCell [Plain [Inline]
x] = do d <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ADW m (Doc Text)
blockListToAsciiDoc WriterOptions
opts [[Inline] -> Block
Plain [Inline]
x]
                              return $ separator <> chomp d
      makeCell [Para [Inline]
x]  = [Block] -> StateT WriterState m (Doc Text)
makeCell [[Inline] -> Block
Plain [Inline]
x]
      makeCell []        = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
separator
      makeCell [Block]
bs        = if Int
currentNestingLevel Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
                             then do
                               --asciidoc only supports nesting once
                               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
block
                               Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
separator
                             else do
                               d <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ADW m (Doc Text)
blockListToAsciiDoc WriterOptions
opts [Block]
bs
                               return $ (text "a" <> separator) $$ d

  let makeRow [[Block]]
cells = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ([Block] -> StateT WriterState m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> StateT WriterState m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
[Block] -> StateT WriterState m (Doc Text)
makeCell [[Block]]
cells
  rows' <- mapM makeRow rows
  head' <- makeRow headers
  modify $ \WriterState
st -> WriterState
st{ tableNestingLevel = parentTableLevel }
  let 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 Doc Text
forall a. Doc a
empty else Doc Text
head'
  let colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Int
100000
  let maxwidth = NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NonEmpty Int -> Int) -> NonEmpty Int -> Int
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Int) -> NonEmpty (Doc Text) -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset (Doc Text
head' Doc Text -> [Doc Text] -> NonEmpty (Doc Text)
forall a. a -> [a] -> NonEmpty a
:| [Doc Text]
rows')
  let body = if Int
maxwidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
colwidth then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [Doc Text]
rows' else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
  let border = Doc Text
separator Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"==="
  return $
    caption'' $$ tablespec $$ border $$ head'' $$ body $$ border $$ blankline
blockToAsciiDoc WriterOptions
opts (BulletList [[Block]]
items) = do
  inlist <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
inList
  modify $ \WriterState
st -> WriterState
st{ inList = True }
  contents <- mapM (bulletListItemToAsciiDoc opts) items
  modify $ \WriterState
st -> WriterState
st{ inList = inlist }
  return $ mconcat contents <> blankline
blockToAsciiDoc WriterOptions
opts (OrderedList (Int
start, ListNumberStyle
sty, ListNumberDelim
_delim) [[Block]]
items) = do
  let listStyle :: [Text]
listStyle = case ListNumberStyle
sty of
                       ListNumberStyle
DefaultStyle -> []
                       ListNumberStyle
Decimal      -> [Text
"arabic"]
                       ListNumberStyle
Example      -> []
                       ListNumberStyle
_            -> [Text -> Text
T.toLower (ListNumberStyle -> Text
forall a. Show a => a -> Text
tshow ListNumberStyle
sty)]
  let listStart :: [Text]
listStart = [Text
"start=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
start | Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1]
  let listoptions :: Doc Text
listoptions = case Text -> [Text] -> Text
T.intercalate Text
", " ([Text]
listStyle [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
listStart) of
                          Text
"" -> Doc Text
forall a. Doc a
empty
                          Text
x  -> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x)
  inlist <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
inList
  modify $ \WriterState
st -> WriterState
st{ inList = True }
  contents <- mapM (orderedListItemToAsciiDoc opts) items
  modify $ \WriterState
st -> WriterState
st{ inList = inlist }
  return $ listoptions $$ mconcat contents <> blankline
blockToAsciiDoc WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
  inlist <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
inList
  modify $ \WriterState
st -> WriterState
st{ inList = True }
  contents <- mapM (definitionListItemToAsciiDoc opts) items
  modify $ \WriterState
st -> WriterState
st{ inList = inlist }
  return $ mconcat contents <> blankline
blockToAsciiDoc WriterOptions
opts (Div (Text
ident,[Text]
classes,[(Text, Text)]
_) [Block]
bs) = do
  let identifier :: Doc Text
identifier = if Text -> Bool
T.null Text
ident then Doc Text
forall a. Doc a
empty else Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
  let admonitions :: [Text]
admonitions = [Text
"attention",Text
"caution",Text
"danger",Text
"error",Text
"hint",
                     Text
"important",Text
"note",Text
"tip",Text
"warning"]
  contents <-
       case [Text]
classes of
         (Text
l:[Text]
_) | Text
l Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
admonitions -> do
             let ([Block]
titleBs, [Block]
bodyBs) =
                     case [Block]
bs of
                       (Div (Text
_,[Text
"title"],[(Text, Text)]
_) [Block]
ts : [Block]
rest) -> ([Block]
ts, [Block]
rest)
                       [Block]
_ -> ([], [Block]
bs)
             admonitionTitle <- if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
titleBs Bool -> Bool -> Bool
||
                                   -- If title matches class, omit
                                   (Text -> Text
T.toLower (Text -> Text
T.strip ([Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
titleBs))) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
l
                                   then Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
                                   else (Doc Text
"." Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> ADW m (Doc Text) -> ADW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                         WriterOptions -> [Block] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ADW m (Doc Text)
blockListToAsciiDoc WriterOptions
opts [Block]
titleBs
             admonitionBody <- blockListToAsciiDoc opts bodyBs
             return $ "[" <> literal (T.toUpper l) <> "]" $$
                      chomp admonitionTitle $$
                      "====" $$
                      chomp admonitionBody $$
                      "===="
         [Text]
_ -> WriterOptions -> [Block] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ADW m (Doc Text)
blockListToAsciiDoc WriterOptions
opts [Block]
bs
  return $ identifier $$ contents $$ blankline

-- | Convert bullet list item (list of blocks) to asciidoc.
bulletListItemToAsciiDoc :: PandocMonad m
                         => WriterOptions -> [Block] -> ADW m (Doc Text)
bulletListItemToAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ADW m (Doc Text)
bulletListItemToAsciiDoc WriterOptions
opts [Block]
blocks = do
  lev <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
bulletListLevel
  modify $ \WriterState
s -> WriterState
s{ bulletListLevel = lev + 1 }
  isLegacy <- gets legacy
  let blocksWithTasks = if Bool
isLegacy
                          then [Block]
blocks
                          else ([Block] -> [Block]
taskListItemToAsciiDoc [Block]
blocks)
  contents <- foldM (addBlock opts) empty blocksWithTasks
  modify $ \WriterState
s -> WriterState
s{ bulletListLevel = lev }
  let marker = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
lev Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
'*')
  return $ marker <> text " " <> listBegin blocksWithTasks <>
    contents <> cr

-- | Convert a list item containing text starting with @U+2610 BALLOT BOX@
-- or @U+2612 BALLOT BOX WITH X@ to asciidoctor checkbox syntax (e.g. @[x]@).
taskListItemToAsciiDoc :: [Block] -> [Block]
taskListItemToAsciiDoc :: [Block] -> [Block]
taskListItemToAsciiDoc = ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem [Inline] -> [Inline]
toAd Extensions
listExt
  where
    toAd :: [Inline] -> [Inline]
toAd (Str Text
"☐" : Inline
Space : [Inline]
is) = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"asciidoc") Text
"[ ]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    toAd (Str Text
"☒" : Inline
Space : [Inline]
is) = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"asciidoc") Text
"[x]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    toAd [Inline]
is = [Inline]
is
    listExt :: Extensions
listExt = [Extension] -> Extensions
extensionsFromList [Extension
Ext_task_lists]

addBlock :: PandocMonad m
         => WriterOptions -> Doc Text -> Block -> ADW m (Doc Text)
addBlock :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Doc Text -> Block -> ADW m (Doc Text)
addBlock WriterOptions
opts Doc Text
d Block
b = do
  x <- Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ADW m (Doc Text)
blockToAsciiDoc WriterOptions
opts Block
b
  return $
    case b of
        BulletList{} -> Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x
        OrderedList{} -> Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x
        Para (Math MathType
DisplayMath Text
_:[Inline]
_) -> Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x
        Plain (Math MathType
DisplayMath Text
_:[Inline]
_) -> Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x
        Para{} | Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
d -> Doc Text
x
        Plain{} | Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
d -> Doc Text
x
        Block
_ -> Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"+" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x

listBegin :: [Block] -> Doc Text
listBegin :: [Block] -> Doc Text
listBegin [Block]
blocks =
        case [Block]
blocks of
          Para (Math MathType
DisplayMath Text
_:[Inline]
_) : [Block]
_  -> Doc Text
"{blank}"
          Plain (Math MathType
DisplayMath Text
_:[Inline]
_) : [Block]
_ -> Doc Text
"{blank}"
          Para [Inline]
_ : [Block]
_                       -> Doc Text
forall a. Doc a
empty
          Plain [Inline]
_ : [Block]
_                      -> Doc Text
forall a. Doc a
empty
          Block
_ : [Block]
_                            -> Doc Text
"{blank}"
          []                               -> Doc Text
"{blank}"

-- | Convert ordered list item (a list of blocks) to asciidoc.
orderedListItemToAsciiDoc :: PandocMonad m
                          => WriterOptions -- ^ options
                          -> [Block]       -- ^ list item (list of blocks)
                          -> ADW m (Doc Text)
orderedListItemToAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ADW m (Doc Text)
orderedListItemToAsciiDoc WriterOptions
opts [Block]
blocks = do
  lev <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
orderedListLevel
  modify $ \WriterState
s -> WriterState
s{ orderedListLevel = lev + 1 }
  contents <- foldM (addBlock opts) empty blocks
  modify $ \WriterState
s -> WriterState
s{ orderedListLevel = lev }
  let marker = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
lev Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
'.')
  return $ marker <> text " " <> listBegin blocks <> contents <> cr

-- | Convert definition list item (label, list of blocks) to asciidoc.
definitionListItemToAsciiDoc :: PandocMonad m
                             => WriterOptions
                             -> ([Inline],[[Block]])
                             -> ADW m (Doc Text)
definitionListItemToAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> ADW m (Doc Text)
definitionListItemToAsciiDoc WriterOptions
opts ([Inline]
label, [[Block]]
defs) = do
  labelText <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
label
  marker <- gets defListMarker
  if marker == "::"
     then modify (\WriterState
st -> WriterState
st{ defListMarker = ";;"})
     else modify (\WriterState
st -> WriterState
st{ defListMarker = "::"})
  let divider = Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"+" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
  let defsToAsciiDoc :: PandocMonad m => [Block] -> ADW m (Doc Text)
      defsToAsciiDoc [Block]
ds = ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
divider ([Doc Text] -> [Doc Text])
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp)
           ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ADW m (Doc Text)
blockToAsciiDoc WriterOptions
opts) [Block]
ds
  defs' <- mapM defsToAsciiDoc defs
  modify (\WriterState
st -> WriterState
st{ defListMarker = marker })
  let contents = Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
divider ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp [Doc Text]
defs'
  return $ labelText <> literal marker <> cr <> contents <> cr

-- | Convert list of Pandoc block elements to asciidoc.
blockListToAsciiDoc :: PandocMonad m
                    => WriterOptions -- ^ Options
                    -> [Block]       -- ^ List of block elements
                    -> ADW m (Doc Text)
blockListToAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ADW m (Doc Text)
blockListToAsciiDoc WriterOptions
opts [Block]
blocks =
  [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ADW m (Doc Text)
blockToAsciiDoc WriterOptions
opts) [Block]
blocks

data SpacyLocation = End | Start

-- | Convert list of Pandoc inline elements to asciidoc.
inlineListToAsciiDoc :: PandocMonad m =>
                        WriterOptions ->
                        [Inline] ->
                        ADW m (Doc Text)
inlineListToAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
lst = do
  oldIntraword <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
intraword
  setIntraword False
  result <- go lst
  setIntraword oldIntraword
  return result
 where go :: [Inline] -> StateT WriterState m (Doc Text)
go [] = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
       go (Inline
y:Inline
x:[Inline]
xs)
         | Bool -> Bool
not (SpacyLocation -> Inline -> Bool
isSpacy SpacyLocation
End Inline
y) = do
           y' <- if SpacyLocation -> Inline -> Bool
isSpacy SpacyLocation
Start Inline
x
                    then WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc WriterOptions
opts Inline
y
                    else StateT WriterState m (Doc Text) -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. PandocMonad m => ADW m a -> ADW m a
withIntraword (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc WriterOptions
opts Inline
y
           x' <- withIntraword $ inlineToAsciiDoc opts x
           xs' <- go xs
           return (y' <> x' <> xs')
         | Bool -> Bool
not (SpacyLocation -> Inline -> Bool
isSpacy SpacyLocation
Start Inline
x) = do
           y' <- StateT WriterState m (Doc Text) -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. PandocMonad m => ADW m a -> ADW m a
withIntraword (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc WriterOptions
opts Inline
y
           xs' <- go (x:xs)
           return (y' <> xs')
       go (Inline
x:[Inline]
xs) = do
           x' <- WriterOptions -> Inline -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc WriterOptions
opts Inline
x
           xs' <- go xs
           return (x' <> xs')
       isSpacy :: SpacyLocation -> Inline -> Bool
       isSpacy :: SpacyLocation -> Inline -> Bool
isSpacy SpacyLocation
_ Inline
Space = Bool
True
       isSpacy SpacyLocation
_ Inline
LineBreak = Bool
True
       isSpacy SpacyLocation
_ Inline
SoftBreak = Bool
True
       -- Note that \W characters count as spacy in AsciiDoc
       -- for purposes of determining interword:
       isSpacy SpacyLocation
End (Str Text
xs) = case Text -> Maybe (Text, Char)
T.unsnoc Text
xs of
                                   Just (Text
_, Char
c) -> Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c
                                   Maybe (Text, Char)
_           -> Bool
False
       isSpacy SpacyLocation
Start (Str Text
xs)
         | Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
xs = Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c
       isSpacy SpacyLocation
_ Inline
_ = Bool
True

setIntraword :: PandocMonad m => Bool -> ADW m ()
setIntraword :: forall (m :: * -> *). PandocMonad m => Bool -> ADW m ()
setIntraword Bool
b = (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ intraword = b }

withIntraword :: PandocMonad m => ADW m a -> ADW m a
withIntraword :: forall (m :: * -> *) a. PandocMonad m => ADW m a -> ADW m a
withIntraword ADW m a
p = Bool -> ADW m ()
forall (m :: * -> *). PandocMonad m => Bool -> ADW m ()
setIntraword Bool
True ADW m () -> ADW m a -> ADW m a
forall a b.
StateT WriterState m a
-> StateT WriterState m b -> StateT WriterState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ADW m a
p ADW m a -> ADW m () -> ADW m a
forall a b.
StateT WriterState m a
-> StateT WriterState m b -> StateT WriterState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Bool -> ADW m ()
forall (m :: * -> *). PandocMonad m => Bool -> ADW m ()
setIntraword Bool
False

-- | Convert Pandoc inline element to asciidoc.
inlineToAsciiDoc :: PandocMonad m => WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc WriterOptions
opts (Emph [Strong [Inline]
xs]) =
  WriterOptions -> Inline -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc WriterOptions
opts ([Inline] -> Inline
Strong [[Inline] -> Inline
Emph [Inline]
xs])  -- see #5565
inlineToAsciiDoc WriterOptions
opts (Emph [Inline]
lst) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
lst
  isIntraword <- gets intraword
  let marker = if Bool
isIntraword then Doc Text
"__" else Doc Text
"_"
  return $ marker <> contents <> marker
inlineToAsciiDoc WriterOptions
opts (Underline [Inline]
lst) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
lst
  return $ "[.underline]#" <> contents <> "#"
inlineToAsciiDoc WriterOptions
opts (Strong [Inline]
lst) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
lst
  isIntraword <- gets intraword
  let marker = if Bool
isIntraword then Doc Text
"**" else Doc Text
"*"
  return $ marker <> contents <> marker
inlineToAsciiDoc WriterOptions
opts (Strikeout [Inline]
lst) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
lst
  return $ "[line-through]#" <> contents <> "#"
inlineToAsciiDoc WriterOptions
opts (Superscript [Inline]
lst) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
lst
  return $ "^" <> contents <> "^"
inlineToAsciiDoc WriterOptions
opts (Subscript [Inline]
lst) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
lst
  return $ "~" <> contents <> "~"
inlineToAsciiDoc WriterOptions
opts (SmallCaps [Inline]
lst) = WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
lst
inlineToAsciiDoc WriterOptions
opts (Quoted QuoteType
qt [Inline]
lst) = do
  isLegacy <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
legacy
  contents <- inlineListToAsciiDoc opts lst
  pure $ case qt of
    QuoteType
SingleQuote
      | Bool
isLegacy     -> Doc Text
"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"'"
      | Bool
otherwise    -> Doc Text
"'`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`'"
    QuoteType
DoubleQuote
      | Bool
isLegacy     -> Doc Text
"``" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"''"
      | Bool
otherwise    -> Doc Text
"\"`" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"`\""
inlineToAsciiDoc WriterOptions
_ (Code (Text, [Text], [(Text, Text)])
_ Text
str) = do
  isLegacy <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
legacy
  let escChar Char
'`' = Text
"\\'"
      escChar Char
c   = Char -> Text
T.singleton Char
c
  parentTableLevel <- gets tableNestingLevel
  let content
       | Bool
isLegacy = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ((Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escChar Text
str)
       | Bool
otherwise = EscContext -> Text -> Doc Text
escapeString
                       (if Int
parentTableLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then EscContext
InTable else EscContext
Normal) Text
str
  return $ text "`" <> content <> "`"
inlineToAsciiDoc WriterOptions
_ (Str Text
str) = do
  parentTableLevel <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
tableNestingLevel
  pure $ escapeString (if parentTableLevel > 0 then InTable else Normal) str
inlineToAsciiDoc WriterOptions
_ (Math MathType
InlineMath Text
str) = do
  isLegacy <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
legacy
  modify $ \WriterState
st -> WriterState
st{ hasMath = True }
  let content = if Bool
isLegacy
                then Doc Text
"$" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"$"
                else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
  return $ "latexmath:[" <> content <> "]"
inlineToAsciiDoc WriterOptions
_ (Math MathType
DisplayMath Text
str) = do
  isLegacy <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
legacy
  modify $ \WriterState
st -> WriterState
st{ hasMath = True }
  let content = if Bool
isLegacy
                   then Doc Text
"\\[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\]"
                   else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
  inlist <- gets inList
  let sepline = if Bool
inlist
                   then String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"+"
                   else Doc Text
forall a. Doc a
blankline
  return $
      (cr <> sepline) $$ "[latexmath]" $$ "++++" $$
      content $$ "++++" <> cr
inlineToAsciiDoc WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
s)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"asciidoc" = Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ADW m (Doc Text)) -> Doc Text -> ADW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
s
  | Bool
otherwise         = do
      LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToAsciiDoc WriterOptions
_ Inline
LineBreak = Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ADW m (Doc Text)) -> Doc Text -> ADW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
" +" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToAsciiDoc WriterOptions
_ Inline
Space = Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToAsciiDoc WriterOptions
opts Inline
SoftBreak =
  case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
       WrapOption
WrapAuto     -> Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
       WrapOption
WrapPreserve -> Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
       WrapOption
WrapNone     -> Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToAsciiDoc WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) = WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
lst
inlineToAsciiDoc WriterOptions
opts (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text
src, Text
_tit)) = do
-- relative:  link:downloads/foo.zip[download foo.zip]
-- abs:  http://google.cod[Google]
-- or my@email.com[email john]
  let fixCommas :: Inline -> [Inline]
fixCommas (Str Text
t) =
        Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
intersperse (Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"asciidoc") Text
"&#44;")
          ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ (Text -> Inline) -> [Text] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inline
Str ([Text] -> [Inline]) -> [Text] -> [Inline]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
t -- see #8070
      fixCommas Inline
x = [Inline
x]

  linktext <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts ([Inline] -> ADW m (Doc Text)) -> [Inline] -> ADW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk ((Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
fixCommas) [Inline]
txt
  let needsLinkPrefix = case String -> Maybe URI
parseURI (Text -> String
T.unpack Text
src) of
                          Just URI
u -> URI -> String
uriScheme URI
u String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"http:",String
"https:",
                                                           String
"ftp:", String
"irc:",
                                                            String
"mailto:"]
                          Maybe URI
_ -> Bool
True
  let needsPassthrough = Text
"--" Text -> Text -> Bool
`T.isInfixOf` Text
src
  let prefix = if Bool
needsLinkPrefix
                  then String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"link:"
                  else Doc Text
forall a. Doc a
empty
  let srcSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
src (Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src)
  let useAuto = case [Inline]
txt of
                      [Str Text
s] | Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
srcSuffix -> Bool
True
                      [Inline]
_       -> Bool
False
  return $
    if needsPassthrough
       then
         if useAuto
            then "link:++" <> literal srcSuffix <> "++[]"
            else "link:++" <> literal src <> "++[" <> linktext <> "]"
       else
         if useAuto
            then literal srcSuffix
            else prefix <> literal src <> "[" <> linktext <> "]"
inlineToAsciiDoc WriterOptions
opts (Image (Text, [Text], [(Text, Text)])
attr [Inline]
alternate (Text
src, Text
tit)) =
  (Doc Text
"image:" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> ADW m (Doc Text) -> ADW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> (Text, [Text], [(Text, Text)])
-> [Inline]
-> Text
-> Text
-> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (Text, [Text], [(Text, Text)])
-> [Inline]
-> Text
-> Text
-> ADW m (Doc Text)
imageArguments WriterOptions
opts (Text, [Text], [(Text, Text)])
attr [Inline]
alternate Text
src Text
tit
inlineToAsciiDoc WriterOptions
opts (Note [Para [Inline]
inlines]) =
  WriterOptions -> Inline -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> ADW m (Doc Text)
inlineToAsciiDoc WriterOptions
opts ([Block] -> Inline
Note [[Inline] -> Block
Plain [Inline]
inlines])
inlineToAsciiDoc WriterOptions
opts (Note [Plain [Inline]
inlines]) = do
  contents  <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
inlines
  return $ text "footnote:[" <> contents <> "]"
-- asciidoc can't handle blank lines in notes
inlineToAsciiDoc WriterOptions
_ (Note [Block]
_) = Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
"[multiblock footnote omitted]"
inlineToAsciiDoc WriterOptions
opts (Span (Text
ident,[Text]
classes,[(Text, Text)]
_) [Inline]
ils) = do
  contents <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
ils
  isIntraword <- gets intraword
  let marker = if Bool
isIntraword then Doc Text
"##" else Doc Text
"#"
  case classes of
    [] | Text -> Bool
T.null Text
ident -> Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
contents
    [Text
"mark"] | Text -> Bool
T.null Text
ident -> Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ADW m (Doc Text)) -> Doc Text -> ADW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
marker
    [Text]
_ -> do
       let modifier :: Doc Text
modifier = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
            [ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
classes
       Doc Text -> ADW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ADW m (Doc Text)) -> Doc Text -> ADW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
modifier Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
marker

-- | Provides the arguments for both `image:` and `image::`
-- e.g.: sunset.jpg[Sunset,300,200]
imageArguments :: PandocMonad m => WriterOptions ->
  Attr -> [Inline] -> Text -> Text ->
  ADW m (Doc Text)
imageArguments :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> (Text, [Text], [(Text, Text)])
-> [Inline]
-> Text
-> Text
-> ADW m (Doc Text)
imageArguments WriterOptions
opts (Text, [Text], [(Text, Text)])
attr [Inline]
altText Text
src Text
title = do
  let txt :: [Inline]
txt = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
altText Bool -> Bool -> Bool
|| ([Inline]
altText [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text -> Inline
Str Text
""])
               then [Text -> Inline
Str (Text -> Inline) -> (String -> Text) -> String -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropExtension (String -> Inline) -> String -> Inline
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src]
               else [Inline]
altText
  linktext <- WriterOptions -> [Inline] -> ADW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ADW m (Doc Text)
inlineListToAsciiDoc WriterOptions
opts [Inline]
txt
  let linktitle = if Text -> Bool
T.null Text
title
                     then Doc Text
forall a. Doc a
empty
                     else Doc Text
",title=\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
title Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
      showDim Direction
dir = case Direction -> (Text, [Text], [(Text, Text)]) -> Maybe Dimension
dimension Direction
dir (Text, [Text], [(Text, Text)])
attr of
                      Just (Percent Double
a) ->
                        [Doc Text
"scaledwidth=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Dimension -> String
forall a. Show a => a -> String
show (Double -> Dimension
Percent Double
a))]
                      Just Dimension
dim         ->
                        [String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Direction -> String
forall a. Show a => a -> String
show Direction
dir) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                          Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (WriterOptions -> Dimension -> Text
showInPixel WriterOptions
opts Dimension
dim)]
                      Maybe Dimension
Nothing          ->
                        []
      dimList = Direction -> [Doc Text]
showDim Direction
Width [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ Direction -> [Doc Text]
showDim Direction
Height
      dims = if [Doc Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
dimList
                then Doc Text
forall a. Doc a
empty
                else Doc Text
"," Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat (Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
"," [Doc Text]
dimList)
  return $ literal src <> "[" <> linktext <> linktitle <> dims <> "]"