    {-# LANGUAGE OverloadedStrings   #-}
    {- |
    Module      : Text.Pandoc.Writers.Docx
    Copyright   : Copyright (C) 2012-2024 John MacFarlane
    License     : GNU GPL, version 2 or above
    Maintainer  : John MacFarlane <jgm@berkeley.edu>

    Conversion of table blocks to docx.
    -}
    module Text.Pandoc.Writers.Docx.Types
      ( EnvProps (..)
      , WriterEnv (..)
      , defaultWriterEnv
      , WriterState (..)
      , defaultWriterState
      , WS
      , ListMarker (..)
      , listMarkerToId
      , pStyleM
      , isStyle
      , setFirstPara
      , withParaProp
      , withParaPropM
      ) where

    import Control.Applicative ((<|>))
    import Control.Monad.Reader
    import Control.Monad.State.Strict
    import Data.Text (Text)
    import Text.Pandoc.Class.PandocMonad (PandocMonad)
    import Text.Pandoc.Definition
    import Text.Pandoc.MIME (MimeType)
    import Text.Pandoc.Writers.Docx.StyleMap
    import Text.Pandoc.Writers.OOXML
    import Text.Pandoc.XML.Light as XML
    import qualified Data.ByteString as B
    import qualified Data.Map as M
    import qualified Data.Set as Set
    import qualified Data.Text as T

    data ListMarker = NoMarker
                    | BulletMarker
                    | CheckboxMarker Bool
                    | NumberMarker ListNumberStyle ListNumberDelim Int
                    deriving (Int -> ListMarker -> ShowS
    [ListMarker] -> ShowS
    ListMarker -> String
    (Int -> ListMarker -> ShowS)
    -> (ListMarker -> String)
    -> ([ListMarker] -> ShowS)
    -> Show ListMarker
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ListMarker -> ShowS
    showsPrec :: Int -> ListMarker -> ShowS
    $cshow :: ListMarker -> String
    show :: ListMarker -> String
    $cshowList :: [ListMarker] -> ShowS
    showList :: [ListMarker] -> ShowS
    Show, ReadPrec [ListMarker]
    ReadPrec ListMarker
    Int -> ReadS ListMarker
    ReadS [ListMarker]
    (Int -> ReadS ListMarker)
    -> ReadS [ListMarker]
    -> ReadPrec ListMarker
    -> ReadPrec [ListMarker]
    -> Read ListMarker
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS ListMarker
    readsPrec :: Int -> ReadS ListMarker
    $creadList :: ReadS [ListMarker]
    readList :: ReadS [ListMarker]
    $creadPrec :: ReadPrec ListMarker
    readPrec :: ReadPrec ListMarker
    $creadListPrec :: ReadPrec [ListMarker]
    readListPrec :: ReadPrec [ListMarker]
    Read, ListMarker -> ListMarker -> Bool
    (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> Bool) -> Eq ListMarker
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ListMarker -> ListMarker -> Bool
    == :: ListMarker -> ListMarker -> Bool
    $c/= :: ListMarker -> ListMarker -> Bool
    /= :: ListMarker -> ListMarker -> Bool
    Eq, Eq ListMarker
    Eq ListMarker =>
    (ListMarker -> ListMarker -> Ordering)
    -> (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> Bool)
    -> (ListMarker -> ListMarker -> ListMarker)
    -> (ListMarker -> ListMarker -> ListMarker)
    -> Ord ListMarker
    ListMarker -> ListMarker -> Bool
    ListMarker -> ListMarker -> Ordering
    ListMarker -> ListMarker -> ListMarker
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ListMarker -> ListMarker -> Ordering
    compare :: ListMarker -> ListMarker -> Ordering
    $c< :: ListMarker -> ListMarker -> Bool
    < :: ListMarker -> ListMarker -> Bool
    $c<= :: ListMarker -> ListMarker -> Bool
    <= :: ListMarker -> ListMarker -> Bool
    $c> :: ListMarker -> ListMarker -> Bool
    > :: ListMarker -> ListMarker -> Bool
    $c>= :: ListMarker -> ListMarker -> Bool
    >= :: ListMarker -> ListMarker -> Bool
    $cmax :: ListMarker -> ListMarker -> ListMarker
    max :: ListMarker -> ListMarker -> ListMarker
    $cmin :: ListMarker -> ListMarker -> ListMarker
    min :: ListMarker -> ListMarker -> ListMarker
    Ord)

    listMarkerToId :: ListMarker -> Text
    listMarkerToId :: ListMarker -> Text
    listMarkerToId ListMarker
    NoMarker = Text
    "990"
    listMarkerToId ListMarker
    BulletMarker = Text
    "991"
    listMarkerToId (CheckboxMarker Bool
    False) = Text
    "992"
    listMarkerToId (CheckboxMarker Bool
    True) = Text
    "993"
    listMarkerToId (NumberMarker ListNumberStyle
    sty ListNumberDelim
    delim Int
    n) = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $
      Char
    '9' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Char
    '9' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Char
    styNum Char -> ShowS
    forall a. a -> [a] -> [a]
    : Char
    delimNum Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    n
      where styNum :: Char
    styNum = case ListNumberStyle
    sty of
                          ListNumberStyle
    DefaultStyle -> Char
    '2'
                          ListNumberStyle
    Example      -> Char
    '3'
                          ListNumberStyle
    Decimal      -> Char
    '4'
                          ListNumberStyle
    LowerRoman   -> Char
    '5'
                          ListNumberStyle
    UpperRoman   -> Char
    '6'
                          ListNumberStyle
    LowerAlpha   -> Char
    '7'
                          ListNumberStyle
    UpperAlpha   -> Char
    '8'
            delimNum :: Char
    delimNum = case ListNumberDelim
    delim of
                          ListNumberDelim
    DefaultDelim -> Char
    '0'
                          ListNumberDelim
    Period       -> Char
    '1'
                          ListNumberDelim
    OneParen     -> Char
    '2'
                          ListNumberDelim
    TwoParens    -> Char
    '3'

    data EnvProps = EnvProps{ EnvProps -> Maybe Element
    styleElement  :: Maybe Element
                            , EnvProps -> [Element]
    otherElements :: [Element]
                            }

    instance Semigroup EnvProps where
      EnvProps Maybe Element
    s [Element]
    es <> :: EnvProps -> EnvProps -> EnvProps
    <> EnvProps Maybe Element
    s' [Element]
    es' = Maybe Element -> [Element] -> EnvProps
    EnvProps (Maybe Element
    s Maybe Element -> Maybe Element -> Maybe Element
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe Element
    s') ([Element]
    es [Element] -> [Element] -> [Element]
    forall a. [a] -> [a] -> [a]
    ++ [Element]
    es')

    instance Monoid EnvProps where
      mempty :: EnvProps
    mempty = Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    forall a. Maybe a
    Nothing []
      mappend :: EnvProps -> EnvProps -> EnvProps
    mappend = EnvProps -> EnvProps -> EnvProps
    forall a. Semigroup a => a -> a -> a
    (<>)

    data WriterEnv = WriterEnv
      { WriterEnv -> EnvProps
    envTextProperties :: EnvProps
      , WriterEnv -> EnvProps
    envParaProperties :: EnvProps
      , WriterEnv -> Bool
    envRTL            :: Bool
      , WriterEnv -> Int
    envListLevel      :: Int
      , WriterEnv -> Int
    envListNumId      :: Int
      , WriterEnv -> Bool
    envInDel          :: Bool
      , WriterEnv -> Bool
    envInNote         :: Bool
      , WriterEnv -> Text
    envChangesAuthor  :: Text
      , WriterEnv -> Text
    envChangesDate    :: Text
      , WriterEnv -> Integer
    envPrintWidth     :: Integer
      , WriterEnv -> Maybe Text
    envLang           :: Maybe Text
      , WriterEnv -> Maybe Element
    envSectPr         :: Maybe Element
      }

    defaultWriterEnv :: WriterEnv
    defaultWriterEnv :: WriterEnv
    defaultWriterEnv = WriterEnv
      { envTextProperties :: EnvProps
    envTextProperties = EnvProps
    forall a. Monoid a => a
    mempty
      , envParaProperties :: EnvProps
    envParaProperties = EnvProps
    forall a. Monoid a => a
    mempty
      , envRTL :: Bool
    envRTL = Bool
    False
      , envListLevel :: Int
    envListLevel = -Int
    1
      , envListNumId :: Int
    envListNumId = Int
    1
      , envInDel :: Bool
    envInDel = Bool
    False
      , envInNote :: Bool
    envInNote = Bool
    False
      , envChangesAuthor :: Text
    envChangesAuthor  = Text
    "unknown"
      , envChangesDate :: Text
    envChangesDate    = Text
    "1969-12-31T19:00:00Z"
      , envPrintWidth :: Integer
    envPrintWidth     = Integer
    1
      , envLang :: Maybe Text
    envLang           = Maybe Text
    forall a. Maybe a
    Nothing
      , envSectPr :: Maybe Element
    envSectPr         = Maybe Element
    forall a. Maybe a
    Nothing
      }

    data WriterState = WriterState{
             WriterState -> [Element]
    stFootnotes      :: [Element]
           , WriterState -> [([(Text, Text)], [Inline])]
    stComments       :: [([(Text, Text)], [Inline])]
           , WriterState -> Set Text
    stSectionIds     :: Set.Set Text
           , WriterState -> Map Text Text
    stExternalLinks  :: M.Map Text Text
           , WriterState -> Map String (String, String, Maybe Text, ByteString)
    stImages         :: M.Map FilePath (String, String, Maybe MimeType, B.ByteString)
           , WriterState -> [ListMarker]
    stLists          :: [ListMarker]
           , WriterState -> Maybe Int
    stExampleId      :: Maybe Int
           , WriterState -> Int
    stInsId          :: Int
           , WriterState -> Int
    stDelId          :: Int
           , WriterState -> StyleMaps
    stStyleMaps      :: StyleMaps
           , WriterState -> Bool
    stFirstPara      :: Bool
           , WriterState -> Bool
    stNumIdUsed      :: Bool  -- ^ True if the current numId (envListNumId) has been used.
                                       --   Should only be used once, for the first paragraph.
           , WriterState -> Bool
    stInTable        :: Bool
           , WriterState -> Bool
    stInList         :: Bool
           , WriterState -> [Inline]
    stTocTitle       :: [Inline]
           , WriterState -> Set ParaStyleName
    stDynamicParaProps :: Set.Set ParaStyleName
           , WriterState -> Set CharStyleName
    stDynamicTextProps :: Set.Set CharStyleName
           , WriterState -> Int
    stCurId          :: Int
           , WriterState -> Int
    stNextFigureNum  :: Int
           , WriterState -> Int
    stNextTableNum   :: Int
           }

    defaultWriterState :: WriterState
    defaultWriterState :: WriterState
    defaultWriterState = WriterState{
            stFootnotes :: [Element]
    stFootnotes      = [Element]
    defaultFootnotes
          , stComments :: [([(Text, Text)], [Inline])]
    stComments       = []
          , stSectionIds :: Set Text
    stSectionIds     = Set Text
    forall a. Set a
    Set.empty
          , stExternalLinks :: Map Text Text
    stExternalLinks  = Map Text Text
    forall k a. Map k a
    M.empty
          , stImages :: Map String (String, String, Maybe Text, ByteString)
    stImages         = Map String (String, String, Maybe Text, ByteString)
    forall k a. Map k a
    M.empty
          , stLists :: [ListMarker]
    stLists          = [ListMarker
    NoMarker]
          , stExampleId :: Maybe Int
    stExampleId      = Maybe Int
    forall a. Maybe a
    Nothing
          , stInsId :: Int
    stInsId          = Int
    1
          , stDelId :: Int
    stDelId          = Int
    1
          , stStyleMaps :: StyleMaps
    stStyleMaps      = CharStyleNameMap -> ParaStyleNameMap -> StyleMaps
    StyleMaps CharStyleNameMap
    forall k a. Map k a
    M.empty ParaStyleNameMap
    forall k a. Map k a
    M.empty
          , stFirstPara :: Bool
    stFirstPara      = Bool
    False
          , stNumIdUsed :: Bool
    stNumIdUsed      = Bool
    False
          , stInTable :: Bool
    stInTable        = Bool
    False
          , stInList :: Bool
    stInList         = Bool
    False
          , stTocTitle :: [Inline]
    stTocTitle       = [Text -> Inline
    Str Text
    "Table of Contents"]
          , stDynamicParaProps :: Set ParaStyleName
    stDynamicParaProps = Set ParaStyleName
    forall a. Set a
    Set.empty
          , stDynamicTextProps :: Set CharStyleName
    stDynamicTextProps = Set CharStyleName
    forall a. Set a
    Set.empty
          , stCurId :: Int
    stCurId          = Int
    20
          , stNextFigureNum :: Int
    stNextFigureNum  = Int
    1
          , stNextTableNum :: Int
    stNextTableNum   = Int
    1
          }

    setFirstPara :: PandocMonad m => WS m ()
    setFirstPara :: forall (m :: * -> *). PandocMonad m => WS m ()
    setFirstPara =  (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((WriterState -> WriterState)
     -> ReaderT WriterEnv (StateT WriterState m) ())
    -> (WriterState -> WriterState)
    -> ReaderT WriterEnv (StateT WriterState m) ()
    forall a b. (a -> b) -> a -> b
    $ \WriterState
    s -> WriterState
    s { stFirstPara = True }

    type WS m = ReaderT WriterEnv (StateT WriterState m)

    -- Word will insert these footnotes into the settings.xml file
    -- (whether or not they're visible in the document). If they're in the
    -- file, but not in the footnotes.xml file, it will produce
    -- problems. So we want to make sure we insert them into our document.
    defaultFootnotes :: [Element]
    defaultFootnotes :: [Element]
    defaultFootnotes = [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:footnote"
                         [(Text
    "w:type", Text
    "separator"), (Text
    "w:id", Text
    "-1")]
                         [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:p" []
                           [Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:r" []
                            [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:separator" [] ()]]]
                       , Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:footnote"
                         [(Text
    "w:type", Text
    "continuationSeparator"), (Text
    "w:id", Text
    "0")]
                         [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:p" []
                           [ Text -> [(Text, Text)] -> [Element] -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:r" []
                             [ Text -> [(Text, Text)] -> () -> Element
    forall t. Node t => Text -> [(Text, Text)] -> t -> Element
    mknode Text
    "w:continuationSeparator" [] ()]]]]

    pStyleM :: (PandocMonad m) => ParaStyleName -> WS m XML.Element
    pStyleM :: forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM ParaStyleName
    styleName = do
      pStyleMap <- (WriterState -> ParaStyleNameMap)
    -> ReaderT WriterEnv (StateT WriterState m) ParaStyleNameMap
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StyleMaps -> ParaStyleNameMap
    smParaStyle (StyleMaps -> ParaStyleNameMap)
    -> (WriterState -> StyleMaps) -> WriterState -> ParaStyleNameMap
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WriterState -> StyleMaps
    stStyleMaps)
      let sty' = ParaStyleName -> ParaStyleNameMap -> StyleId ParStyle
    forall sn sty.
    (Ord sn, FromStyleName sn, IsString (StyleId sty),
     HasStyleId sty) =>
    sn -> Map sn sty -> StyleId sty
    getStyleIdFromName ParaStyleName
    styleName ParaStyleNameMap
    pStyleMap
      return $ mknode "w:pStyle" [("w:val", fromStyleId sty')] ()

    withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
    withParaProp :: forall (m :: * -> *) a.
    PandocMonad m =>
    Element -> WS m a -> WS m a
    withParaProp Element
    d WS m a
    p =
      (WriterEnv -> WriterEnv) -> WS m a -> WS m a
    forall a.
    (WriterEnv -> WriterEnv)
    -> ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\WriterEnv
    env -> WriterEnv
    env {envParaProperties = ep <> envParaProperties env}) WS m a
    p
      where ep :: EnvProps
    ep = if Element -> Bool
    isStyle Element
    d then Maybe Element -> [Element] -> EnvProps
    EnvProps (Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    d) [] else Maybe Element -> [Element] -> EnvProps
    EnvProps Maybe Element
    forall a. Maybe a
    Nothing [Element
    d]

    withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
    withParaPropM :: forall (m :: * -> *) a.
    PandocMonad m =>
    WS m Element -> WS m a -> WS m a
    withParaPropM WS m Element
    md WS m a
    p = do
      d <- WS m Element
    md
      withParaProp d p

    isStyle :: Element -> Bool
    isStyle :: Element -> Bool
    isStyle Element
    e = [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [] Text
    "w" Text
    "rStyle" Element
    e Bool -> Bool -> Bool
    ||
                [(Text, Text)] -> Text -> Text -> Element -> Bool
    isElem [] Text
    "w" Text
    "pStyle" Element
    e