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

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

Common functions for roff writers (man, ms).
-}

module Text.Pandoc.Writers.Roff (
      WriterState(..)
    , defaultWriterState
    , MS
    , Note
    , EscapeMode(..)
    , escapeString
    , withFontFeature
    ) where
import Data.Char (ord, isAscii)
import Control.Monad.State.Strict
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import Data.String
import Data.Maybe (fromMaybe)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.DocLayout
import Text.Printf (printf)
import Text.Pandoc.RoffChar (standardEscapes, characterCodes)

data WriterState = WriterState { stHasInlineMath :: Bool
                               , stFirstPara     :: Bool
                               , stNotes         :: [Note]
                               , stSmallCaps     :: Bool
                               , stHighlighting  :: Bool
                               , stInHeader      :: Bool
                               , stFontFeatures  :: Map.Map Char Bool
                               , stHasTables     :: Bool
                               }

defaultWriterState :: WriterState
defaultWriterState = WriterState{ stHasInlineMath = False
                                , stFirstPara     = True
                                , stNotes         = []
                                , stSmallCaps     = False
                                , stHighlighting  = False
                                , stInHeader      = False
                                , stFontFeatures  = Map.fromList [
                                                       ('I',False)
                                                     , ('B',False)
                                                     , ('C',False)
                                                     , ('V',False)
                                                     ]
                                , stHasTables     = False
                                }

type Note = [Block]

type MS = StateT WriterState

data EscapeMode = AllowUTF8        -- ^ use preferred man escapes
                | AsciiOnly        -- ^ escape everything
                deriving Show

essentialEscapes :: Map.Map Char Text
essentialEscapes = Map.fromList standardEscapes

-- | Escape special characters for roff. If the first parameter is
-- True, escape @-@ as @\-@, as required by current versions of groff man;
-- otherwise leave it unescaped, as neededfor ms.
escapeString :: Bool -> EscapeMode -> Text -> Text
escapeString escapeHyphen e = Text.concat . escapeString' e . Text.unpack
  where
    escapeString' _ [] = []
    escapeString' escapeMode ('\n':'.':xs) =
      "\n\\&." : escapeString' escapeMode xs
    -- see #10533; we need to escape hyphens as \- in man but not in ms:
    escapeString' escapeMode ('-':xs) | escapeHyphen =
      "\\-" : escapeString' escapeMode xs
    escapeString' escapeMode (x:xs) =
      case Map.lookup x essentialEscapes of
        Just s  -> s : escapeString' escapeMode xs
        Nothing
          | isAscii x -> Text.singleton x : escapeString' escapeMode xs
          | otherwise ->
              (case escapeMode of
                AllowUTF8 -> Text.singleton x
                AsciiOnly ->
                   case Map.lookup x characterCodeMap of
                      Just t
                        | Text.length t == 2 -> "\\(" <> t -- see #10716
                        | otherwise -> "\\C'" <> t <> "'"
                      Nothing ->
                        "\\C'" <> Text.pack (printf "u%04X" (ord x)) <> "'")
               : escapeString' escapeMode xs

characterCodeMap :: Map.Map Char Text
characterCodeMap = Map.fromList characterCodes

fontChange :: (HasChars a, IsString a, PandocMonad m) => MS m (Doc a)
fontChange = do
  features <- gets stFontFeatures
  inHeader <- gets stInHeader
  let filling = ['C' | fromMaybe False $ Map.lookup 'C' features] ++
                ['V' | fromMaybe False $ Map.lookup 'V' features] ++
                ['B' | inHeader ||
                       fromMaybe False (Map.lookup 'B' features)] ++
                ['I' | fromMaybe False $ Map.lookup 'I' features]
  return $
    case filling of
      [] -> text "\\f[R]"
      -- see #9020. C is not a font, use CR.
      ['C'] -> text "\\f[CR]"
      _ -> text $ "\\f[" ++ filling ++ "]"

withFontFeature :: (HasChars a, IsString a, PandocMonad m)
                => Char -> MS m (Doc a) -> MS m (Doc a)
withFontFeature c action = do
  modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
  begin <- fontChange
  d <- action
  modify $ \st -> st{ stFontFeatures = Map.adjust not c $ stFontFeatures st }
  end <- fontChange
  return $ begin <> d <> end