diff options
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/Writers/Docx/Types.hs | 181 |
1 files changed, 181 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Writers/Docx/Types.hs b/src/Text/Pandoc/Writers/Docx/Types.hs new file mode 100644 index 000000000..006584c30 --- /dev/null +++ b/src/Text/Pandoc/Writers/Docx/Types.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | +Module : Text.Pandoc.Writers.Docx +Copyright : Copyright (C) 2012-2021 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 (Show, Read, Eq, Ord) + +listMarkerToId :: ListMarker -> Text +listMarkerToId NoMarker = "990" +listMarkerToId BulletMarker = "991" +listMarkerToId (NumberMarker sty delim n) = T.pack $ + '9' : '9' : styNum : delimNum : show n + where styNum = case sty of + DefaultStyle -> '2' + Example -> '3' + Decimal -> '4' + LowerRoman -> '5' + UpperRoman -> '6' + LowerAlpha -> '7' + UpperAlpha -> '8' + delimNum = case delim of + DefaultDelim -> '0' + Period -> '1' + OneParen -> '2' + TwoParens -> '3' + + +data EnvProps = EnvProps{ styleElement :: Maybe Element + , otherElements :: [Element] + } + +instance Semigroup EnvProps where + EnvProps s es <> EnvProps s' es' = EnvProps (s <|> s') (es ++ es') + +instance Monoid EnvProps where + mempty = EnvProps Nothing [] + mappend = (<>) + +data WriterEnv = WriterEnv + { envTextProperties :: EnvProps + , envParaProperties :: EnvProps + , envRTL :: Bool + , envListLevel :: Int + , envListNumId :: Int + , envInDel :: Bool + , envChangesAuthor :: Text + , envChangesDate :: Text + , envPrintWidth :: Integer + } + +defaultWriterEnv :: WriterEnv +defaultWriterEnv = WriterEnv + { envTextProperties = mempty + , envParaProperties = mempty + , envRTL = False + , envListLevel = -1 + , envListNumId = 1 + , envInDel = False + , envChangesAuthor = "unknown" + , envChangesDate = "1969-12-31T19:00:00Z" + , envPrintWidth = 1 + } + + +data WriterState = WriterState{ + stFootnotes :: [Element] + , stComments :: [([(Text, Text)], [Inline])] + , stSectionIds :: Set.Set Text + , stExternalLinks :: M.Map Text Text + , stImages :: M.Map FilePath (String, String, Maybe MimeType, B.ByteString) + , stLists :: [ListMarker] + , stInsId :: Int + , stDelId :: Int + , stStyleMaps :: StyleMaps + , stFirstPara :: Bool + , stInTable :: Bool + , stInList :: Bool + , stTocTitle :: [Inline] + , stDynamicParaProps :: Set.Set ParaStyleName + , stDynamicTextProps :: Set.Set CharStyleName + , stCurId :: Int + } + +defaultWriterState :: WriterState +defaultWriterState = WriterState{ + stFootnotes = defaultFootnotes + , stComments = [] + , stSectionIds = Set.empty + , stExternalLinks = M.empty + , stImages = M.empty + , stLists = [NoMarker] + , stInsId = 1 + , stDelId = 1 + , stStyleMaps = StyleMaps M.empty M.empty + , stFirstPara = False + , stInTable = False + , stInList = False + , stTocTitle = [Str "Table of Contents"] + , stDynamicParaProps = Set.empty + , stDynamicTextProps = Set.empty + , stCurId = 20 + } + +setFirstPara :: PandocMonad m => WS m () +setFirstPara = modify $ \s -> 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 = [ mknode "w:footnote" + [("w:type", "separator"), ("w:id", "-1")] + [ mknode "w:p" [] + [mknode "w:r" [] + [ mknode "w:separator" [] ()]]] + , mknode "w:footnote" + [("w:type", "continuationSeparator"), ("w:id", "0")] + [ mknode "w:p" [] + [ mknode "w:r" [] + [ mknode "w:continuationSeparator" [] ()]]]] + +pStyleM :: (PandocMonad m) => ParaStyleName -> WS m XML.Element +pStyleM styleName = do + pStyleMap <- gets (smParaStyle . stStyleMaps) + let sty' = getStyleIdFromName styleName pStyleMap + return $ mknode "w:pStyle" [("w:val", fromStyleId sty')] () + +withParaProp :: PandocMonad m => Element -> WS m a -> WS m a +withParaProp d p = + local (\env -> env {envParaProperties = ep <> envParaProperties env}) p + where ep = if isStyle d then EnvProps (Just d) [] else EnvProps Nothing [d] + +withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a +withParaPropM md p = do + d <- md + withParaProp d p + +isStyle :: Element -> Bool +isStyle e = isElem [] "w" "rStyle" e || + isElem [] "w" "pStyle" e |