    {-# 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 { WriterState -> Bool
    stHasInlineMath :: Bool
                                   , WriterState -> Bool
    stFirstPara     :: Bool
                                   , WriterState -> [Note]
    stNotes         :: [Note]
                                   , WriterState -> Bool
    stSmallCaps     :: Bool
                                   , WriterState -> Bool
    stHighlighting  :: Bool
                                   , WriterState -> Bool
    stInHeader      :: Bool
                                   , WriterState -> Map Char Bool
    stFontFeatures  :: Map.Map Char Bool
                                   , WriterState -> Bool
    stHasTables     :: Bool
                                   }

    defaultWriterState :: WriterState
    defaultWriterState :: WriterState
    defaultWriterState = WriterState{ stHasInlineMath :: Bool
    stHasInlineMath = Bool
    False
                                    , stFirstPara :: Bool
    stFirstPara     = Bool
    True
                                    , stNotes :: [Note]
    stNotes         = []
                                    , stSmallCaps :: Bool
    stSmallCaps     = Bool
    False
                                    , stHighlighting :: Bool
    stHighlighting  = Bool
    False
                                    , stInHeader :: Bool
    stInHeader      = Bool
    False
                                    , stFontFeatures :: Map Char Bool
    stFontFeatures  = [(Char, Bool)] -> Map Char Bool
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [
                                                           (Char
    'I',Bool
    False)
                                                         , (Char
    'B',Bool
    False)
                                                         , (Char
    'C',Bool
    False)
                                                         , (Char
    'V',Bool
    False)
                                                         ]
                                    , stHasTables :: Bool
    stHasTables     = Bool
    False
                                    }

    type Note = [Block]

    type MS = StateT WriterState

    data EscapeMode = AllowUTF8        -- ^ use preferred man escapes
                    | AsciiOnly        -- ^ escape everything
                    deriving Int -> EscapeMode -> ShowS
    [EscapeMode] -> ShowS
    EscapeMode -> String
    (Int -> EscapeMode -> ShowS)
    -> (EscapeMode -> String)
    -> ([EscapeMode] -> ShowS)
    -> Show EscapeMode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> EscapeMode -> ShowS
    showsPrec :: Int -> EscapeMode -> ShowS
    $cshow :: EscapeMode -> String
    show :: EscapeMode -> String
    $cshowList :: [EscapeMode] -> ShowS
    showList :: [EscapeMode] -> ShowS
    Show

    essentialEscapes :: Map.Map Char Text
    essentialEscapes :: Map Char Text
    essentialEscapes = [(Char, Text)] -> Map Char Text
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Char, Text)]
    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 :: Bool -> EscapeMode -> Text -> Text
    escapeString Bool
    escapeHyphen EscapeMode
    e = [Text] -> Text
    Text.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    e (String -> [Text]) -> (Text -> String) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    Text.unpack
      where
        escapeString' :: EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    _ [] = []
        escapeString' EscapeMode
    escapeMode (Char
    '\n':Char
    '.':String
    xs) =
          Text
    "\n\\&." Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    escapeMode String
    xs
        -- see #10533; we need to escape hyphens as \- in man but not in ms:
        escapeString' EscapeMode
    escapeMode (Char
    '-':String
    xs) | Bool
    escapeHyphen =
          Text
    "\\-" Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    escapeMode String
    xs
        escapeString' EscapeMode
    escapeMode (Char
    x:String
    xs) =
          case Char -> Map Char Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Char
    x Map Char Text
    essentialEscapes of
            Just Text
    s  -> Text
    s Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    escapeMode String
    xs
            Maybe Text
    Nothing
              | Char -> Bool
    isAscii Char
    x -> Char -> Text
    Text.singleton Char
    x Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    escapeMode String
    xs
              | Bool
    otherwise ->
                  (case EscapeMode
    escapeMode of
                    EscapeMode
    AllowUTF8 -> Char -> Text
    Text.singleton Char
    x
                    EscapeMode
    AsciiOnly ->
                       case Char -> Map Char Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Char
    x Map Char Text
    characterCodeMap of
                          Just Text
    t
                            | Text -> Int
    Text.length Text
    t Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2 -> Text
    "\\(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t -- see #10716
                            | Bool
    otherwise -> Text
    "\\C'" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'"
                          Maybe Text
    Nothing ->
                            Text
    "\\C'" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    Text.pack (String -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "u%04X" (Char -> Int
    ord Char
    x)) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'")
                   Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    escapeMode String
    xs

    characterCodeMap :: Map.Map Char Text
    characterCodeMap :: Map Char Text
    characterCodeMap = [(Char, Text)] -> Map Char Text
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Char, Text)]
    characterCodes

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

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