1{-# LANGUAGE OverloadedStrings   #-}
2{- |
3Module      : Text.Pandoc.Writers.Docx
4Copyright   : Copyright (C) 2012-2021 John MacFarlane
5License     : GNU GPL, version 2 or above
6Maintainer  : John MacFarlane <jgm@berkeley.edu>
7
8Conversion of table blocks to docx.
9-}
10module Text.Pandoc.Writers.Docx.Types
11  ( EnvProps (..)
12  , WriterEnv (..)
13  , defaultWriterEnv
14  , WriterState (..)
15  , defaultWriterState
16  , WS
17  , ListMarker (..)
18  , listMarkerToId
19  , pStyleM
20  , isStyle
21  , setFirstPara
22  , withParaProp
23  , withParaPropM
24  ) where
25
26import Control.Applicative ((<|>))
27import Control.Monad.Reader
28import Control.Monad.State.Strict
29import Data.Text (Text)
30import Text.Pandoc.Class.PandocMonad (PandocMonad)
31import Text.Pandoc.Definition
32import Text.Pandoc.MIME (MimeType)
33import Text.Pandoc.Writers.Docx.StyleMap
34import Text.Pandoc.Writers.OOXML
35import Text.Pandoc.XML.Light as XML
36import qualified Data.ByteString as B
37import qualified Data.Map as M
38import qualified Data.Set as Set
39import qualified Data.Text as T
40
41data ListMarker = NoMarker
42                | BulletMarker
43                | NumberMarker ListNumberStyle ListNumberDelim Int
44                deriving (Show, Read, Eq, Ord)
45
46listMarkerToId :: ListMarker -> Text
47listMarkerToId NoMarker = "990"
48listMarkerToId BulletMarker = "991"
49listMarkerToId (NumberMarker sty delim n) = T.pack $
50  '9' : '9' : styNum : delimNum : show n
51  where styNum = case sty of
52                      DefaultStyle -> '2'
53                      Example      -> '3'
54                      Decimal      -> '4'
55                      LowerRoman   -> '5'
56                      UpperRoman   -> '6'
57                      LowerAlpha   -> '7'
58                      UpperAlpha   -> '8'
59        delimNum = case delim of
60                      DefaultDelim -> '0'
61                      Period       -> '1'
62                      OneParen     -> '2'
63                      TwoParens    -> '3'
64
65
66data EnvProps = EnvProps{ styleElement  :: Maybe Element
67                        , otherElements :: [Element]
68                        }
69
70instance Semigroup EnvProps where
71  EnvProps s es <> EnvProps s' es' = EnvProps (s <|> s') (es ++ es')
72
73instance Monoid EnvProps where
74  mempty = EnvProps Nothing []
75  mappend = (<>)
76
77data WriterEnv = WriterEnv
78  { envTextProperties :: EnvProps
79  , envParaProperties :: EnvProps
80  , envRTL            :: Bool
81  , envListLevel      :: Int
82  , envListNumId      :: Int
83  , envInDel          :: Bool
84  , envChangesAuthor  :: Text
85  , envChangesDate    :: Text
86  , envPrintWidth     :: Integer
87  }
88
89defaultWriterEnv :: WriterEnv
90defaultWriterEnv = WriterEnv
91  { envTextProperties = mempty
92  , envParaProperties = mempty
93  , envRTL = False
94  , envListLevel = -1
95  , envListNumId = 1
96  , envInDel = False
97  , envChangesAuthor  = "unknown"
98  , envChangesDate    = "1969-12-31T19:00:00Z"
99  , envPrintWidth     = 1
100  }
101
102
103data WriterState = WriterState{
104         stFootnotes      :: [Element]
105       , stComments       :: [([(Text, Text)], [Inline])]
106       , stSectionIds     :: Set.Set Text
107       , stExternalLinks  :: M.Map Text Text
108       , stImages         :: M.Map FilePath (String, String, Maybe MimeType, B.ByteString)
109       , stLists          :: [ListMarker]
110       , stInsId          :: Int
111       , stDelId          :: Int
112       , stStyleMaps      :: StyleMaps
113       , stFirstPara      :: Bool
114       , stInTable        :: Bool
115       , stInList         :: Bool
116       , stTocTitle       :: [Inline]
117       , stDynamicParaProps :: Set.Set ParaStyleName
118       , stDynamicTextProps :: Set.Set CharStyleName
119       , stCurId          :: Int
120       , stNextFigureNum  :: Int
121       , stNextTableNum   :: Int
122       }
123
124defaultWriterState :: WriterState
125defaultWriterState = WriterState{
126        stFootnotes      = defaultFootnotes
127      , stComments       = []
128      , stSectionIds     = Set.empty
129      , stExternalLinks  = M.empty
130      , stImages         = M.empty
131      , stLists          = [NoMarker]
132      , stInsId          = 1
133      , stDelId          = 1
134      , stStyleMaps      = StyleMaps M.empty M.empty
135      , stFirstPara      = False
136      , stInTable        = False
137      , stInList         = False
138      , stTocTitle       = [Str "Table of Contents"]
139      , stDynamicParaProps = Set.empty
140      , stDynamicTextProps = Set.empty
141      , stCurId          = 20
142      , stNextFigureNum  = 1
143      , stNextTableNum   = 1
144      }
145
146setFirstPara :: PandocMonad m => WS m ()
147setFirstPara =  modify $ \s -> s { stFirstPara = True }
148
149type WS m = ReaderT WriterEnv (StateT WriterState m)
150
151-- Word will insert these footnotes into the settings.xml file
152-- (whether or not they're visible in the document). If they're in the
153-- file, but not in the footnotes.xml file, it will produce
154-- problems. So we want to make sure we insert them into our document.
155defaultFootnotes :: [Element]
156defaultFootnotes = [ mknode "w:footnote"
157                     [("w:type", "separator"), ("w:id", "-1")]
158                     [ mknode "w:p" []
159                       [mknode "w:r" []
160                        [ mknode "w:separator" [] ()]]]
161                   , mknode "w:footnote"
162                     [("w:type", "continuationSeparator"), ("w:id", "0")]
163                     [ mknode "w:p" []
164                       [ mknode "w:r" []
165                         [ mknode "w:continuationSeparator" [] ()]]]]
166
167pStyleM :: (PandocMonad m) => ParaStyleName -> WS m XML.Element
168pStyleM styleName = do
169  pStyleMap <- gets (smParaStyle . stStyleMaps)
170  let sty' = getStyleIdFromName styleName pStyleMap
171  return $ mknode "w:pStyle" [("w:val", fromStyleId sty')] ()
172
173withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
174withParaProp d p =
175  local (\env -> env {envParaProperties = ep <> envParaProperties env}) p
176  where ep = if isStyle d then EnvProps (Just d) [] else EnvProps Nothing [d]
177
178withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
179withParaPropM md p = do
180  d <- md
181  withParaProp d p
182
183isStyle :: Element -> Bool
184isStyle e = isElem [] "w" "rStyle" e ||
185            isElem [] "w" "pStyle" e
186