{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.Txt2Tags
   Copyright   : Copyright (C) 2008-2024 Eric Forgeot, based on John MacFarlane DokuWiki writer
   License     : GNU GPL, version 2 or above

   Maintainer  : Eric Forgeot
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to Txt2Tags markup.

Txt2Tags:  <https://www.txt2tags.org/>
-}

module Text.Pandoc.Writers.Txt2Tags ( writeTxt2Tags ) where
import Control.Monad (zipWithM)
import Control.Monad.Reader (ReaderT, asks, local, runReaderT)
import Data.Default (Default (..))
import Data.List (transpose)
import Data.List.NonEmpty (nonEmpty)
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 (WrapOption (..), WriterOptions (writerTableOfContents,
                            writerTemplate, writerWrapText))
import Text.Pandoc.Shared (figureDiv, linesToPara, removeFormatting, trimr)
import Text.Pandoc.URI (escapeURI, isURI)
import Text.Pandoc.Templates (renderTemplate)
import Text.DocLayout (render, literal)
import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)

data WriterEnvironment = WriterEnvironment {
    WriterEnvironment -> Text
stIndent      :: Text  -- Indentation prefix for the current list nesting level
  , WriterEnvironment -> Bool
stBackSlashLB :: Bool  -- True inside table cells (use \\ for line breaks)
  }

instance Default WriterEnvironment where
  def :: WriterEnvironment
def = WriterEnvironment { stIndent :: Text
stIndent      = Text
""
                          , stBackSlashLB :: Bool
stBackSlashLB = Bool
False }

type Txt2Tags m = ReaderT WriterEnvironment m

-- | Convert Pandoc to Txt2Tags.
writeTxt2Tags :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTxt2Tags WriterOptions
opts Pandoc
document =
  Txt2Tags m Text -> m Text
forall (m :: * -> *) a. PandocMonad m => Txt2Tags m a -> m a
runTxt2Tags (WriterOptions -> Pandoc -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> Txt2Tags m Text
pandocToTxt2Tags WriterOptions
opts Pandoc
document)

runTxt2Tags :: PandocMonad m => Txt2Tags m a -> m a
runTxt2Tags :: forall (m :: * -> *) a. PandocMonad m => Txt2Tags m a -> m a
runTxt2Tags = (Txt2Tags m a -> WriterEnvironment -> m a)
-> WriterEnvironment -> Txt2Tags m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Txt2Tags m a -> WriterEnvironment -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT WriterEnvironment
forall a. Default a => a
def

-- | Return Txt2Tags representation of document.
pandocToTxt2Tags :: PandocMonad m
                 => WriterOptions -> Pandoc -> Txt2Tags m Text
pandocToTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> Txt2Tags m Text
pandocToTxt2Tags WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  metadata <- WriterOptions
-> ([Block] -> ReaderT WriterEnvironment m (Doc Text))
-> ([Inline] -> ReaderT WriterEnvironment m (Doc Text))
-> Meta
-> ReaderT WriterEnvironment 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)
-> ReaderT WriterEnvironment m Text
-> ReaderT WriterEnvironment m (Doc Text)
forall a b.
(a -> b)
-> ReaderT WriterEnvironment m a -> ReaderT WriterEnvironment m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimr) (ReaderT WriterEnvironment m Text
 -> ReaderT WriterEnvironment m (Doc Text))
-> ([Block] -> ReaderT WriterEnvironment m Text)
-> [Block]
-> ReaderT WriterEnvironment m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> ReaderT WriterEnvironment m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> Txt2Tags m Text
blockListToTxt2Tags WriterOptions
opts)
              ((Text -> Doc Text)
-> ReaderT WriterEnvironment m Text
-> ReaderT WriterEnvironment m (Doc Text)
forall a b.
(a -> b)
-> ReaderT WriterEnvironment m a -> ReaderT WriterEnvironment m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimr) (ReaderT WriterEnvironment m Text
 -> ReaderT WriterEnvironment m (Doc Text))
-> ([Inline] -> ReaderT WriterEnvironment m Text)
-> [Inline]
-> ReaderT WriterEnvironment m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> ReaderT WriterEnvironment m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts)
              Meta
meta
  body <- blockListToTxt2Tags opts blocks
  let context = Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Text
body
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts) Context Text
metadata
  return $
    case writerTemplate opts of
       Maybe (Template Text)
Nothing  -> Text
body
       Just Template Text
tpl -> Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

-- | Escape special characters for Txt2Tags.
-- The %%text%% syntax disables Txt2Tags formatting interpretation.
escapeString :: Text -> Text
escapeString :: Text -> Text
escapeString = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"``" Text
"%%``%%" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"--" Text
"%%--%%" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"__" Text
"%%__%%" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"**" Text
"%%**%%" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"//" Text
"%%//%%"

-- | Convert Pandoc block element to Txt2Tags.
blockToTxt2Tags :: PandocMonad m
                => WriterOptions -- ^ Options
                -> Block         -- ^ Block element
                -> Txt2Tags m Text

blockToTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> Txt2Tags m Text
blockToTxt2Tags WriterOptions
opts (Div Attr
_attrs [Block]
bs) = do
  contents <- WriterOptions -> [Block] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> Txt2Tags m Text
blockListToTxt2Tags WriterOptions
opts [Block]
bs
  indent <- asks stIndent
  return $ contents <> if T.null indent then "\n" else ""

blockToTxt2Tags WriterOptions
opts (Plain [Inline]
inlines) =
  WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
inlines

blockToTxt2Tags WriterOptions
opts (Para [Inline]
inlines) = do
  indent <- (WriterEnvironment -> Text) -> Txt2Tags m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnvironment -> Text
stIndent
  contents <- inlineListToTxt2Tags opts inlines
  return $ contents <> if T.null indent then "\n" else ""

blockToTxt2Tags WriterOptions
opts (LineBlock [[Inline]]
lns) =
  WriterOptions -> Block -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> Txt2Tags m Text
blockToTxt2Tags WriterOptions
opts (Block -> Txt2Tags m Text) -> Block -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns

blockToTxt2Tags WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"txt2tags" = Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
  -- Use the Txt2Tags raw area syntax (""") for block-level HTML pass-through:
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Txt2Tags m Text) -> Text -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Text
"\"\"\"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\"\"\"\n"
  | Bool
otherwise = Text
"" Text -> ReaderT WriterEnvironment m () -> Txt2Tags m Text
forall a b.
a -> ReaderT WriterEnvironment m b -> ReaderT WriterEnvironment m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> ReaderT WriterEnvironment m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)

blockToTxt2Tags WriterOptions
_ Block
HorizontalRule = Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n--------------------\n"

blockToTxt2Tags WriterOptions
opts (Header Int
level Attr
_ [Inline]
inlines) = do
  -- Formatting is not allowed in headers, so strip it
  contents <- WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts ([Inline] -> Txt2Tags m Text) -> [Inline] -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
forall a. Walkable Inline a => a -> [Inline]
removeFormatting [Inline]
inlines
  let eqs = Int -> Text -> Text
T.replicate Int
level Text
"="
  return $ eqs <> " " <> contents <> " " <> eqs <> "\n"

-- | Txt2Tags verbatim area uses ``` delimiters.
blockToTxt2Tags WriterOptions
_ (CodeBlock Attr
_ Text
str) =
  Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Txt2Tags m Text) -> Text -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Text
"```\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           (if Text
"\n" Text -> Text -> Bool
`T.isSuffixOf` Text
str then Text
"" else Text
"\n") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"```\n"

-- | Txt2Tags has no blockquote syntax; render content without special markup.
blockToTxt2Tags WriterOptions
opts (BlockQuote [Block]
blocks) =
  WriterOptions -> [Block] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> Txt2Tags m Text
blockListToTxt2Tags WriterOptions
opts [Block]
blocks

blockToTxt2Tags WriterOptions
opts (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
  let ([Inline]
capt, [Alignment]
aligns, [Double]
_, [[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
  captionDoc <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
capt
                   then Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
                   else do
                      c <- WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
capt
                      return $ c <> "\n"
  headers' <- if all null headers
                 then return []
                 else zipWithM (tableItemToTxt2Tags opts) aligns headers
  rows' <- mapM (zipWithM (tableItemToTxt2Tags opts) aligns) rows
  let widths = ([Text] -> Int) -> [[Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Text] -> Maybe (NonEmpty Int)) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Text] -> [Int]) -> [Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length)
                   ([[Text]] -> [Int]) -> [[Text]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose ([Text]
headers'[Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
:[[Text]]
rows')
  let padTo (Int
width, Alignment
al) Text
s =
          case Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s of
               Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
                 if Alignment
al Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignLeft Bool -> Bool -> Bool
|| Alignment
al Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignDefault
                    then Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
x Text
" "
                    else if Alignment
al Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignRight
                            then Int -> Text -> Text
T.replicate Int
x Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
                            else Int -> Text -> Text
T.replicate (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                 Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Text
" "
                 | Bool
otherwise -> Text
s
  let renderRow Text
sep [Text]
cells =
        Text
sep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
sep (((Int, Alignment) -> Text -> Text)
-> [(Int, Alignment)] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, Alignment) -> Text -> Text
padTo ([Int] -> [Alignment] -> [(Int, Alignment)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
widths [Alignment]
aligns) [Text]
cells) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep
  return $ captionDoc <>
           (if null headers' then "" else renderRow "|" headers' <> "\n") <>
           T.unlines (map (renderRow "|") rows')

blockToTxt2Tags WriterOptions
opts (BulletList [[Block]]
items) = do
  indent <- (WriterEnvironment -> Text) -> Txt2Tags m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnvironment -> Text
stIndent
  contents <- local (\WriterEnvironment
s -> WriterEnvironment
s { stIndent = stIndent s <> "  " })
                (mapM (listItemToTxt2Tags opts) items)
  return $ vcat contents <> if T.null indent then "\n" else ""

blockToTxt2Tags WriterOptions
opts (OrderedList ListAttributes
_attribs [[Block]]
items) = do
  indent <- (WriterEnvironment -> Text) -> Txt2Tags m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnvironment -> Text
stIndent
  contents <- local (\WriterEnvironment
s -> WriterEnvironment
s { stIndent = stIndent s <> "  " })
                (mapM (orderedListItemToTxt2Tags opts) items)
  return $ vcat contents <> if T.null indent then "\n" else ""

blockToTxt2Tags WriterOptions
opts (Figure Attr
attr Caption
capt [Block]
body) =
  WriterOptions -> Block -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> Txt2Tags m Text
blockToTxt2Tags WriterOptions
opts (Block -> Txt2Tags m Text) -> Block -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
body

blockToTxt2Tags WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
  indent <- (WriterEnvironment -> Text) -> Txt2Tags m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnvironment -> Text
stIndent
  contents <- local (\WriterEnvironment
s -> WriterEnvironment
s { stIndent = stIndent s <> "  " })
                (mapM (definitionListItemToTxt2Tags opts) items)
  return $ vcat contents <> if T.null indent then "\n" else ""

-- Auxiliary functions for lists:

-- | Convert bullet list item (list of blocks) to Txt2Tags.
listItemToTxt2Tags :: PandocMonad m
                   => WriterOptions -> [Block] -> Txt2Tags m Text
listItemToTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> Txt2Tags m Text
listItemToTxt2Tags WriterOptions
opts [Block]
items = do
  bs <- (Block -> ReaderT WriterEnvironment m Text)
-> [Block] -> ReaderT WriterEnvironment m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> ReaderT WriterEnvironment m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> Txt2Tags m Text
blockToTxt2Tags WriterOptions
opts) [Block]
items
  indent <- asks stIndent
  -- BulletList increments indent by "  ", so T.drop 2 gives the marker position:
  -- level 1 -> "", level 2 -> "  ", etc.
  let markerIndent = Int -> Text -> Text
T.drop Int
2 Text
indent
  -- Use newlines between blocks; T.stripEnd preserves leading spaces (e.g. nested
  -- list indentation) while removing trailing newlines that would create blank lines.
  let contents = Text -> [Text] -> Text
T.intercalate Text
"\n" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.stripEnd [Text]
bs)
  return $ markerIndent <> "- " <> contents

-- | Convert ordered list item (list of blocks) to Txt2Tags.
orderedListItemToTxt2Tags :: PandocMonad m => WriterOptions -> [Block] -> Txt2Tags m Text
orderedListItemToTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> Txt2Tags m Text
orderedListItemToTxt2Tags WriterOptions
opts [Block]
items = do
  bs <- (Block -> ReaderT WriterEnvironment m Text)
-> [Block] -> ReaderT WriterEnvironment m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> ReaderT WriterEnvironment m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> Txt2Tags m Text
blockToTxt2Tags WriterOptions
opts) [Block]
items
  indent <- asks stIndent
  -- OrderedList increments indent by "  ", so T.drop 2 gives the marker position
  let markerIndent = Int -> Text -> Text
T.drop Int
2 Text
indent
  let contents = Text -> [Text] -> Text
T.intercalate Text
"\n" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.stripEnd [Text]
bs)
  return $ markerIndent <> "+ " <> contents

-- | Convert definition list item (label, list of blocks) to Txt2Tags.
-- Txt2Tags has no native definition list syntax; we use ": **term**" as a
-- label followed by indented definition content.
definitionListItemToTxt2Tags :: PandocMonad m
                             => WriterOptions
                             -> ([Inline], [[Block]])
                             -> Txt2Tags m Text
definitionListItemToTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> Txt2Tags m Text
definitionListItemToTxt2Tags WriterOptions
opts ([Inline]
label, [[Block]]
items) = do
  labelText <- WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
label
  contents  <- mapM (blockListToTxt2Tags opts) items
  indent    <- asks stIndent
  let markerIndent = Int -> Text -> Text
T.drop Int
2 Text
indent
  let defIndent    = Text
markerIndent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"  "
  let fmtItem Text
c    = Text
defIndent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.stripEnd Text
c
  return $ markerIndent <> ": **" <> labelText <> "**\n" <>
           T.intercalate "\n" (map fmtItem contents)

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

-- | For each string in the input list, replace newlines with Txt2Tags line
-- breaks (\\). Then join the list using double line breaks to simulate
-- paragraph breaks in table cells.
backSlashLineBreaks :: [Text] -> Text
backSlashLineBreaks :: [Text] -> Text
backSlashLineBreaks [Text]
ls = [Text] -> Text
vcatBackSlash ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escape (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
ls
  where
    vcatBackSlash :: [Text] -> Text
vcatBackSlash = Text -> [Text] -> Text
T.intercalate Text
"\\\\ \\\\ " -- simulate paragraph break
    escape :: String -> String
escape [Char
'\n']    = String
"" -- remove trailing newlines
    escape (Char
'\n':String
cs) = String
"\\\\ " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
escape String
cs
    escape (Char
c:String
cs)    = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escape String
cs
    escape []        = []

-- Auxiliary functions for tables:

tableItemToTxt2Tags :: PandocMonad m
                    => WriterOptions
                    -> Alignment
                    -> [Block]
                    -> Txt2Tags m Text
tableItemToTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Alignment -> [Block] -> Txt2Tags m Text
tableItemToTxt2Tags WriterOptions
opts Alignment
align' [Block]
item = do
  -- In Txt2Tags, alignment is indicated by spaces around cell content:
  -- leading space -> right, trailing space -> left, both -> center.
  let mkcell :: a -> a
mkcell a
x = (if Alignment
align' Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignRight Bool -> Bool -> Bool
|| Alignment
align' Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter
                     then a
"  "
                     else a
"") a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
                 (if Alignment
align' Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignLeft Bool -> Bool -> Bool
|| Alignment
align' Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter
                     then a
"  "
                     else a
"")
  contents <- (WriterEnvironment -> WriterEnvironment)
-> ReaderT WriterEnvironment m Text
-> ReaderT WriterEnvironment m Text
forall a.
(WriterEnvironment -> WriterEnvironment)
-> ReaderT WriterEnvironment m a -> ReaderT WriterEnvironment m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterEnvironment
s -> WriterEnvironment
s { stBackSlashLB = True }) (ReaderT WriterEnvironment m Text
 -> ReaderT WriterEnvironment m Text)
-> ReaderT WriterEnvironment m Text
-> ReaderT WriterEnvironment m Text
forall a b. (a -> b) -> a -> b
$
                WriterOptions -> [Block] -> ReaderT WriterEnvironment m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> Txt2Tags m Text
blockListToTxt2Tags WriterOptions
opts [Block]
item
  return $ mkcell contents

-- | Convert list of Pandoc block elements to Txt2Tags.
blockListToTxt2Tags :: PandocMonad m
                    => WriterOptions -- ^ Options
                    -> [Block]       -- ^ List of block elements
                    -> Txt2Tags m Text
blockListToTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> Txt2Tags m Text
blockListToTxt2Tags WriterOptions
opts [Block]
blocks = do
  backSlash <- (WriterEnvironment -> Bool) -> ReaderT WriterEnvironment m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnvironment -> Bool
stBackSlashLB
  let blocks' = [Block] -> [Block]
consolidateRawBlocks [Block]
blocks
  if backSlash
    then backSlashLineBreaks <$> mapM (blockToTxt2Tags opts) blocks'
    else vcat <$> mapM (blockToTxt2Tags opts) blocks'

consolidateRawBlocks :: [Block] -> [Block]
consolidateRawBlocks :: [Block] -> [Block]
consolidateRawBlocks [] = []
consolidateRawBlocks (RawBlock Format
f1 Text
b1 : RawBlock Format
f2 Text
b2 : [Block]
xs)
  | Format
f1 Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
f2 = [Block] -> [Block]
consolidateRawBlocks (Format -> Text -> Block
RawBlock Format
f1 (Text
b1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b2) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs)
consolidateRawBlocks (Block
x:[Block]
xs) = Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
consolidateRawBlocks [Block]
xs

-- | Convert list of Pandoc inline elements to Txt2Tags.
inlineListToTxt2Tags :: PandocMonad m
                     => WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
lst =
  [Text] -> Text
T.concat ([Text] -> Text)
-> ReaderT WriterEnvironment m [Text]
-> ReaderT WriterEnvironment m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> ReaderT WriterEnvironment m Text)
-> [Inline] -> ReaderT WriterEnvironment m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Inline -> ReaderT WriterEnvironment m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> Txt2Tags m Text
inlineToTxt2Tags WriterOptions
opts) [Inline]
lst

-- | Render inlines wrapped in the given left and right delimiters.
surroundInlines :: PandocMonad m
                => WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines WriterOptions
opts Text
left Text
right [Inline]
lst = do
  contents <- WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
lst
  return $ left <> contents <> right

-- | Convert Pandoc inline element to Txt2Tags.
inlineToTxt2Tags :: PandocMonad m
                 => WriterOptions -> Inline -> Txt2Tags m Text

inlineToTxt2Tags :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> Txt2Tags m Text
inlineToTxt2Tags WriterOptions
opts (Span Attr
_attrs [Inline]
ils) =
  WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
ils

inlineToTxt2Tags WriterOptions
opts (Emph [Inline]
lst) = WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines WriterOptions
opts Text
"//" Text
"//" [Inline]
lst

inlineToTxt2Tags WriterOptions
opts (Underline [Inline]
lst) = WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines WriterOptions
opts Text
"__" Text
"__" [Inline]
lst

inlineToTxt2Tags WriterOptions
opts (Strong [Inline]
lst) = WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines WriterOptions
opts Text
"**" Text
"**" [Inline]
lst

inlineToTxt2Tags WriterOptions
opts (Strikeout [Inline]
lst) = WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines WriterOptions
opts Text
"--" Text
"--" [Inline]
lst

-- Txt2Tags has no superscript/subscript syntax; fall back to HTML tags.
inlineToTxt2Tags WriterOptions
opts (Superscript [Inline]
lst) = WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines WriterOptions
opts Text
"<sup>" Text
"</sup>" [Inline]
lst

inlineToTxt2Tags WriterOptions
opts (Subscript [Inline]
lst) = WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines WriterOptions
opts Text
"<sub>" Text
"</sub>" [Inline]
lst

inlineToTxt2Tags WriterOptions
opts (SmallCaps [Inline]
lst) = WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
lst

inlineToTxt2Tags WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines WriterOptions
opts Text
"\8216" Text
"\8217" [Inline]
lst

inlineToTxt2Tags WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> Text -> [Inline] -> Txt2Tags m Text
surroundInlines WriterOptions
opts Text
"\8220" Text
"\8221" [Inline]
lst

inlineToTxt2Tags WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) = WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
lst

-- | Inline code uses Txt2Tags verbatim syntax (double backticks).
inlineToTxt2Tags WriterOptions
_ (Code Attr
_ Text
str) =
  Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Txt2Tags m Text) -> Text -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Text
"``" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"``"

inlineToTxt2Tags WriterOptions
_ (Str Text
str) = Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Txt2Tags m Text) -> Text -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeString Text
str

inlineToTxt2Tags WriterOptions
_ (Math MathType
mathType Text
str) = Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Txt2Tags m Text) -> Text -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Text
delim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
delim
                                 -- note: str should NOT be escaped
  where delim :: Text
delim = case MathType
mathType of
                     MathType
DisplayMath -> Text
"$$"
                     MathType
InlineMath  -> Text
"$"

inlineToTxt2Tags WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"txt2tags" = Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
  -- Use the Txt2Tags inline raw syntax ("") for HTML pass-through:
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Txt2Tags m Text) -> Text -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Text
"\"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"\""
  | Bool
otherwise = Text
"" Text -> ReaderT WriterEnvironment m () -> Txt2Tags m Text
forall a b.
a -> ReaderT WriterEnvironment m b -> ReaderT WriterEnvironment m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> ReaderT WriterEnvironment m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
il)

inlineToTxt2Tags WriterOptions
_ Inline
LineBreak = do
  backSlash <- (WriterEnvironment -> Bool) -> ReaderT WriterEnvironment m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnvironment -> Bool
stBackSlashLB
  return $ if backSlash then "\n" else "\\\\\n"

inlineToTxt2Tags WriterOptions
opts Inline
SoftBreak =
  case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
       WrapOption
WrapNone     -> Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
       WrapOption
WrapAuto     -> Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
       WrapOption
WrapPreserve -> Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n"

inlineToTxt2Tags WriterOptions
_ Inline
Space = Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "

inlineToTxt2Tags WriterOptions
opts (Link Attr
_ [Inline]
txt (Text
src, Text
_)) = do
  label <- WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
txt
  case txt of
     [Str Text
s] | Text
"mailto:" Text -> Text -> Bool
`T.isPrefixOf` Text
src -> Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Txt2Tags m Text) -> Text -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
             | Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src -> Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
src
     [Inline]
_ -> if Text -> Bool
isURI Text
src
             then Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Txt2Tags m Text) -> Text -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
             else Text -> Txt2Tags m Text
forall a. a -> ReaderT WriterEnvironment m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Txt2Tags m Text) -> Text -> Txt2Tags m Text
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
                    where src' :: Text
src' = case Text -> Maybe (Char, Text)
T.uncons Text
src of
                                    Just (Char
'/', Text
xs) -> Text
xs
                                    Maybe (Char, Text)
_              -> Text
src

inlineToTxt2Tags WriterOptions
opts (Image Attr
attr [Inline]
alt (Text
source, Text
tit)) = do
  alt' <- WriterOptions -> [Inline] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags WriterOptions
opts [Inline]
alt
  let txt = case (Text
tit, [Inline]
alt) of
              (Text
"", []) -> Text
""
              (Text
"", [Inline]
_ ) -> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
alt'
              (Text
_ , [Inline]
_ ) -> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tit
  return $ "[" <> source <> imageDims opts attr <> txt <> "]"

-- | Txt2Tags has no footnote syntax; render note content inline in parentheses.
inlineToTxt2Tags WriterOptions
opts (Note [Block]
contents) = do
  contents' <- WriterOptions -> [Block] -> Txt2Tags m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> Txt2Tags m Text
blockListToTxt2Tags WriterOptions
opts [Block]
contents
  return $ "(" <> T.strip contents' <> ")"

imageDims :: WriterOptions -> Attr -> Text
imageDims :: WriterOptions -> Attr -> Text
imageDims WriterOptions
opts Attr
attr = Maybe Text -> Maybe Text -> Text
forall {a}. (Semigroup a, IsString a) => Maybe a -> Maybe a -> a
go (Maybe Dimension -> Maybe Text
toPx (Maybe Dimension -> Maybe Text) -> Maybe Dimension -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Direction -> Attr -> Maybe Dimension
dimension Direction
Width Attr
attr) (Maybe Dimension -> Maybe Text
toPx (Maybe Dimension -> Maybe Text) -> Maybe Dimension -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Direction -> Attr -> Maybe Dimension
dimension Direction
Height Attr
attr)
  where
    toPx :: Maybe Dimension -> Maybe Text
toPx = (Dimension -> Text) -> Maybe Dimension -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WriterOptions -> Dimension -> Text
showInPixel WriterOptions
opts) (Maybe Dimension -> Maybe Text)
-> (Maybe Dimension -> Maybe Dimension)
-> Maybe Dimension
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Dimension -> Maybe Dimension
checkPct
    checkPct :: Maybe Dimension -> Maybe Dimension
checkPct (Just (Percent Double
_)) = Maybe Dimension
forall a. Maybe a
Nothing
    checkPct Maybe Dimension
maybeDim           = Maybe Dimension
maybeDim
    go :: Maybe a -> Maybe a -> a
go (Just a
w) Maybe a
Nothing  = a
"?" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
w
    go (Just a
w) (Just a
h) = a
"?" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
w a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"x" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
h
    go Maybe a
Nothing  (Just a
h) = a
"?0x" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
h
    go Maybe a
Nothing  Maybe a
Nothing  = a
""