content: {-# 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
  