{-# 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 {
    stIndent      :: Text  -- Indentation prefix for the current list nesting level
  , stBackSlashLB :: Bool  -- True inside table cells (use \\ for line breaks)
  }

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

type Txt2Tags m = ReaderT WriterEnvironment m

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

runTxt2Tags :: PandocMonad m => Txt2Tags m a -> m a
runTxt2Tags = flip runReaderT def

-- | Return Txt2Tags representation of document.
pandocToTxt2Tags :: PandocMonad m
                 => WriterOptions -> Pandoc -> Txt2Tags m Text
pandocToTxt2Tags opts (Pandoc meta blocks) = do
  metadata <- metaToContext opts
              (fmap (literal . trimr) . blockListToTxt2Tags opts)
              (fmap (literal . trimr) . inlineListToTxt2Tags opts)
              meta
  body <- blockListToTxt2Tags opts blocks
  let context = defField "body" body
              $ defField "toc" (writerTableOfContents opts) metadata
  return $
    case writerTemplate opts of
       Nothing  -> body
       Just tpl -> render Nothing $ renderTemplate tpl context

-- | Escape special characters for Txt2Tags.
-- The %%text%% syntax disables Txt2Tags formatting interpretation.
escapeString :: Text -> Text
escapeString = T.replace "``" "%%``%%" .
               T.replace "--" "%%--%%" .
               T.replace "__" "%%__%%" .
               T.replace "**" "%%**%%" .
               T.replace "//" "%%//%%"

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

blockToTxt2Tags opts (Div _attrs bs) = do
  contents <- blockListToTxt2Tags opts bs
  indent <- asks stIndent
  return $ contents <> if T.null indent then "\n" else ""

blockToTxt2Tags opts (Plain inlines) =
  inlineListToTxt2Tags opts inlines

blockToTxt2Tags opts (Para inlines) = do
  indent <- asks stIndent
  contents <- inlineListToTxt2Tags opts inlines
  return $ contents <> if T.null indent then "\n" else ""

blockToTxt2Tags opts (LineBlock lns) =
  blockToTxt2Tags opts $ linesToPara lns

blockToTxt2Tags _ b@(RawBlock f str)
  | f == Format "txt2tags" = return str
  -- Use the Txt2Tags raw area syntax (""") for block-level HTML pass-through:
  | f == Format "html" = return $ "\"\"\"\n" <> str <> "\n\"\"\"\n"
  | otherwise = "" <$ report (BlockNotRendered b)

blockToTxt2Tags _ HorizontalRule = return "\n--------------------\n"

blockToTxt2Tags opts (Header level _ inlines) = do
  -- Formatting is not allowed in headers, so strip it
  contents <- inlineListToTxt2Tags opts $ removeFormatting inlines
  let eqs = T.replicate level "="
  return $ eqs <> " " <> contents <> " " <> eqs <> "\n"

-- | Txt2Tags verbatim area uses ``` delimiters.
blockToTxt2Tags _ (CodeBlock _ str) =
  return $ "```\n" <> str <>
           (if "\n" `T.isSuffixOf` str then "" else "\n") <> "```\n"

-- | Txt2Tags has no blockquote syntax; render content without special markup.
blockToTxt2Tags opts (BlockQuote blocks) =
  blockListToTxt2Tags opts blocks

blockToTxt2Tags opts (Table _ blkCapt specs thead tbody tfoot) = do
  let (capt, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
  captionDoc <- if null capt
                   then return ""
                   else do
                      c <- inlineListToTxt2Tags opts 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 = map (maybe 0 maximum . nonEmpty . map T.length)
                   $ transpose (headers':rows')
  let padTo (width, al) s =
          case width - T.length s of
               x | x > 0 ->
                 if al == AlignLeft || al == AlignDefault
                    then s <> T.replicate x " "
                    else if al == AlignRight
                            then T.replicate x " " <> s
                            else T.replicate (x `div` 2) " " <>
                                 s <> T.replicate (x - x `div` 2) " "
                 | otherwise -> s
  let renderRow sep cells =
        sep <> T.intercalate sep (zipWith padTo (zip widths aligns) cells) <> sep
  return $ captionDoc <>
           (if null headers' then "" else renderRow "|" headers' <> "\n") <>
           T.unlines (map (renderRow "|") rows')

blockToTxt2Tags opts (BulletList items) = do
  indent <- asks stIndent
  contents <- local (\s -> s { stIndent = stIndent s <> "  " })
                (mapM (listItemToTxt2Tags opts) items)
  return $ vcat contents <> if T.null indent then "\n" else ""

blockToTxt2Tags opts (OrderedList _attribs items) = do
  indent <- asks stIndent
  contents <- local (\s -> s { stIndent = stIndent s <> "  " })
                (mapM (orderedListItemToTxt2Tags opts) items)
  return $ vcat contents <> if T.null indent then "\n" else ""

blockToTxt2Tags opts (Figure attr capt body) =
  blockToTxt2Tags opts $ figureDiv attr capt body

blockToTxt2Tags opts (DefinitionList items) = do
  indent <- asks stIndent
  contents <- local (\s -> 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 opts items = do
  bs <- mapM (blockToTxt2Tags opts) items
  indent <- asks stIndent
  -- BulletList increments indent by "  ", so T.drop 2 gives the marker position:
  -- level 1 -> "", level 2 -> "  ", etc.
  let markerIndent = T.drop 2 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 = T.intercalate "\n" (map T.stripEnd bs)
  return $ markerIndent <> "- " <> contents

-- | Convert ordered list item (list of blocks) to Txt2Tags.
orderedListItemToTxt2Tags :: PandocMonad m => WriterOptions -> [Block] -> Txt2Tags m Text
orderedListItemToTxt2Tags opts items = do
  bs <- mapM (blockToTxt2Tags opts) items
  indent <- asks stIndent
  -- OrderedList increments indent by "  ", so T.drop 2 gives the marker position
  let markerIndent = T.drop 2 indent
  let contents = T.intercalate "\n" (map T.stripEnd 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 opts (label, items) = do
  labelText <- inlineListToTxt2Tags opts label
  contents  <- mapM (blockListToTxt2Tags opts) items
  indent    <- asks stIndent
  let markerIndent = T.drop 2 indent
  let defIndent    = markerIndent <> "  "
  let fmtItem c    = defIndent <> T.stripEnd c
  return $ markerIndent <> ": **" <> labelText <> "**\n" <>
           T.intercalate "\n" (map fmtItem contents)

-- | Concatenates strings with newlines between them.
vcat :: [Text] -> Text
vcat = T.intercalate "\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 ls = vcatBackSlash $ map (T.pack . escape . T.unpack) ls
  where
    vcatBackSlash = T.intercalate "\\\\ \\\\ " -- simulate paragraph break
    escape ['\n']    = "" -- remove trailing newlines
    escape ('\n':cs) = "\\\\ " <> escape cs
    escape (c:cs)    = c : escape cs
    escape []        = []

-- Auxiliary functions for tables:

tableItemToTxt2Tags :: PandocMonad m
                    => WriterOptions
                    -> Alignment
                    -> [Block]
                    -> Txt2Tags m Text
tableItemToTxt2Tags opts align' item = do
  -- In Txt2Tags, alignment is indicated by spaces around cell content:
  -- leading space -> right, trailing space -> left, both -> center.
  let mkcell x = (if align' == AlignRight || align' == AlignCenter
                     then "  "
                     else "") <> x <>
                 (if align' == AlignLeft || align' == AlignCenter
                     then "  "
                     else "")
  contents <- local (\s -> s { stBackSlashLB = True }) $
                blockListToTxt2Tags opts 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 opts blocks = do
  backSlash <- asks stBackSlashLB
  let blocks' = consolidateRawBlocks blocks
  if backSlash
    then backSlashLineBreaks <$> mapM (blockToTxt2Tags opts) blocks'
    else vcat <$> mapM (blockToTxt2Tags opts) blocks'

consolidateRawBlocks :: [Block] -> [Block]
consolidateRawBlocks [] = []
consolidateRawBlocks (RawBlock f1 b1 : RawBlock f2 b2 : xs)
  | f1 == f2 = consolidateRawBlocks (RawBlock f1 (b1 <> "\n" <> b2) : xs)
consolidateRawBlocks (x:xs) = x : consolidateRawBlocks xs

-- | Convert list of Pandoc inline elements to Txt2Tags.
inlineListToTxt2Tags :: PandocMonad m
                     => WriterOptions -> [Inline] -> Txt2Tags m Text
inlineListToTxt2Tags opts lst =
  T.concat <$> mapM (inlineToTxt2Tags opts) lst

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

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

inlineToTxt2Tags opts (Span _attrs ils) =
  inlineListToTxt2Tags opts ils

inlineToTxt2Tags opts (Emph lst) = surroundInlines opts "//" "//" lst

inlineToTxt2Tags opts (Underline lst) = surroundInlines opts "__" "__" lst

inlineToTxt2Tags opts (Strong lst) = surroundInlines opts "**" "**" lst

inlineToTxt2Tags opts (Strikeout lst) = surroundInlines opts "--" "--" lst

-- Txt2Tags has no superscript/subscript syntax; fall back to HTML tags.
inlineToTxt2Tags opts (Superscript lst) = surroundInlines opts "<sup>" "</sup>" lst

inlineToTxt2Tags opts (Subscript lst) = surroundInlines opts "<sub>" "</sub>" lst

inlineToTxt2Tags opts (SmallCaps lst) = inlineListToTxt2Tags opts lst

inlineToTxt2Tags opts (Quoted SingleQuote lst) = surroundInlines opts "\8216" "\8217" lst

inlineToTxt2Tags opts (Quoted DoubleQuote lst) = surroundInlines opts "\8220" "\8221" lst

inlineToTxt2Tags opts (Cite _ lst) = inlineListToTxt2Tags opts lst

-- | Inline code uses Txt2Tags verbatim syntax (double backticks).
inlineToTxt2Tags _ (Code _ str) =
  return $ "``" <> str <> "``"

inlineToTxt2Tags _ (Str str) = return $ escapeString str

inlineToTxt2Tags _ (Math mathType str) = return $ delim <> str <> delim
                                 -- note: str should NOT be escaped
  where delim = case mathType of
                     DisplayMath -> "$$"
                     InlineMath  -> "$"

inlineToTxt2Tags _ il@(RawInline f str)
  | f == Format "txt2tags" = return str
  -- Use the Txt2Tags inline raw syntax ("") for HTML pass-through:
  | f == Format "html" = return $ "\"\"" <> str <> "\"\""
  | otherwise = "" <$ report (InlineNotRendered il)

inlineToTxt2Tags _ LineBreak = do
  backSlash <- asks stBackSlashLB
  return $ if backSlash then "\n" else "\\\\\n"

inlineToTxt2Tags opts SoftBreak =
  case writerWrapText opts of
       WrapNone     -> return " "
       WrapAuto     -> return " "
       WrapPreserve -> return "\n"

inlineToTxt2Tags _ Space = return " "

inlineToTxt2Tags opts (Link _ txt (src, _)) = do
  label <- inlineListToTxt2Tags opts txt
  case txt of
     [Str s] | "mailto:" `T.isPrefixOf` src -> return $ "<" <> s <> ">"
             | escapeURI s == src -> return src
     _ -> if isURI src
             then return $ "[" <> label <> " " <> src <> "]"
             else return $ "[" <> label <> " " <> src' <> "]"
                    where src' = case T.uncons src of
                                    Just ('/', xs) -> xs
                                    _              -> src

inlineToTxt2Tags opts (Image attr alt (source, tit)) = do
  alt' <- inlineListToTxt2Tags opts alt
  let txt = case (tit, alt) of
              ("", []) -> ""
              ("", _ ) -> "|" <> alt'
              (_ , _ ) -> "|" <> tit
  return $ "[" <> source <> imageDims opts attr <> txt <> "]"

-- | Txt2Tags has no footnote syntax; render note content inline in parentheses.
inlineToTxt2Tags opts (Note contents) = do
  contents' <- blockListToTxt2Tags opts contents
  return $ "(" <> T.strip contents' <> ")"

imageDims :: WriterOptions -> Attr -> Text
imageDims opts attr = go (toPx $ dimension Width attr) (toPx $ dimension Height attr)
  where
    toPx = fmap (showInPixel opts) . checkPct
    checkPct (Just (Percent _)) = Nothing
    checkPct maybeDim           = maybeDim
    go (Just w) Nothing  = "?" <> w
    go (Just w) (Just h) = "?" <> w <> "x" <> h
    go Nothing  (Just h) = "?0x" <> h
    go Nothing  Nothing  = ""
