{-# LANGUAGE OverloadedStrings   #-}
{- |
Module      : Text.Pandoc.Writers.Docx
Copyright   : Copyright (C) 2012-2023 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
                | 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 (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 -> Text
envChangesAuthor  :: Text
  , WriterEnv -> Text
envChangesDate    :: Text
  , WriterEnv -> Integer
envPrintWidth     :: Integer
  , WriterEnv -> Maybe Text
envLang           :: Maybe Text
  }

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
  , 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
  }


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 :: Bool
stFirstPara = Bool
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
  ParaStyleNameMap
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' :: StyleId ParStyle
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
  Element -> WS m Element
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> WS m Element) -> Element -> WS m Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pStyle" [(Text
"w:val", ParaStyleId -> Text
forall a. FromStyleId a => a -> Text
fromStyleId ParaStyleId
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 :: EnvProps
envParaProperties = EnvProps
ep EnvProps -> EnvProps -> EnvProps
forall a. Semigroup a => a -> a -> a
<> WriterEnv -> EnvProps
envParaProperties WriterEnv
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
  Element
d <- WS m Element
md
  Element -> WS m a -> WS m a
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withParaProp Element
d WS m a
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