    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Writers.Roff
       Copyright   : Copyright (C) 2007-2020 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, isJust, catMaybes)
    import Text.Pandoc.Class.PandocMonad (PandocMonad)
    import Text.Pandoc.Definition
    import Text.DocLayout
    import Text.Printf (printf)
    import Text.Pandoc.RoffChar (standardEscapes,
                                  characterCodes, combiningAccents)

    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 :: Bool
    -> Bool
    -> [Note]
    -> Bool
    -> Bool
    -> Bool
    -> Map Char Bool
    -> Bool
    -> WriterState
    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 [
                                                           ('I',Bool
    False)
                                                         , ('B',Bool
    False)
                                                         , ('C',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
    showList :: [EscapeMode] -> ShowS
    $cshowList :: [EscapeMode] -> ShowS
    show :: EscapeMode -> String
    $cshow :: EscapeMode -> String
    showsPrec :: Int -> EscapeMode -> ShowS
    $cshowsPrec :: Int -> EscapeMode -> ShowS
    Show

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

    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.
    escapeString :: EscapeMode -> Text -> Text
    escapeString :: EscapeMode -> Text -> Text
    escapeString e :: 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' _ [] = []
        escapeString' escapeMode :: EscapeMode
    escapeMode ('\n':'.':xs :: String
    xs) =
          "\n\\&." Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    escapeMode String
    xs
        escapeString' escapeMode :: EscapeMode
    escapeMode (x :: Char
    x:xs :: 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 s :: Text
    s  -> Text
    s Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    escapeMode String
    xs
            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
                    AllowUTF8 -> Char -> Text
    Text.singleton Char
    x Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    escapeMode String
    xs
                    AsciiOnly ->
                      let accents :: [Text]
    accents = [Maybe Text] -> [Text]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe Text] -> [Text]) -> [Maybe Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ (Maybe Text -> Bool) -> [Maybe Text] -> [Maybe Text]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Maybe Text -> Bool
    forall a. Maybe a -> Bool
    isJust
                            ((Char -> Maybe Text) -> String -> [Maybe Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (\c :: Char
    c -> Char -> Map Char Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Char
    c Map Char Text
    combiningAccentsMap) String
    xs)
                          rest :: String
    rest = Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop ([Text] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    accents) String
    xs
                          s :: Text
    s = 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 t :: Text
    t  -> "\\[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    Text.unwords (Text
    tText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    accents) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "]"
                                Nothing -> "\\[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    Text.unwords
                                  (String -> Text
    Text.pack (String -> Int -> String
    forall r. PrintfType r => String -> r
    printf "u%04X" (Char -> Int
    ord Char
    x)) Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    accents) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "]"
                      in  Text
    s Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : EscapeMode -> String -> [Text]
    escapeString' EscapeMode
    escapeMode String
    rest

    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 :: MS m (Doc a)
    fontChange = do
      Map Char Bool
    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
      Bool
    inHeader <- (WriterState -> Bool) -> StateT WriterState m Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Bool
    stInHeader
      let filling :: String
    filling = ['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 'C' Map Char Bool
    features] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                    ['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 'B' Map Char Bool
    features)] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                    ['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 'I' Map Char Bool
    features]
      Doc a -> MS m (Doc a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc a -> MS m (Doc a)) -> Doc a -> MS m (Doc a)
    forall a b. (a -> b) -> a -> b
    $
        if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    filling
           then String -> Doc a
    forall a. HasChars a => String -> Doc a
    text "\\f[R]"
           else String -> Doc a
    forall a. HasChars a => String -> Doc a
    text (String -> Doc a) -> String -> Doc a
    forall a b. (a -> b) -> a -> b
    $ "\\f[" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    filling String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "]"

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