summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/Docx.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers/Docx.hs')
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs145
1 files changed, 74 insertions, 71 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 26b1cfdf6..c182d42a3 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -1,5 +1,8 @@
-{-# LANGUAGE ScopedTypeVariables, PatternGuards, ViewPatterns, DeriveFunctor,
- ScopedTypeVariables, RankNTypes #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
{-
Copyright (C) 2012-2015 John MacFarlane <jgm@berkeley.edu>
@@ -30,45 +33,45 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion of 'Pandoc' documents to docx.
-}
module Text.Pandoc.Writers.Docx ( writeDocx ) where
-import Data.List ( intercalate, isPrefixOf, isSuffixOf )
+import Codec.Archive.Zip
+import Control.Applicative ((<|>))
+import Control.Monad.Except (catchError)
+import Control.Monad.Reader
+import Control.Monad.State
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
+import Data.Char (isSpace, ord, toLower)
+import Data.List (intercalate, isPrefixOf, isSuffixOf)
import qualified Data.Map as M
+import Data.Maybe (fromMaybe, isNothing, mapMaybe, maybeToList)
+import Data.Monoid ((<>))
import qualified Data.Set as Set
-import qualified Text.Pandoc.UTF8 as UTF8
-import Codec.Archive.Zip
+import qualified Data.Text as T
import Data.Time.Clock.POSIX
+import Skylighting
+import System.Random (randomR)
+import Text.Pandoc.Class (PandocMonad, report)
+import qualified Text.Pandoc.Class as P
import Text.Pandoc.Compat.Time
import Text.Pandoc.Definition
+import Text.Pandoc.Error
import Text.Pandoc.Generic
+import Text.Pandoc.Highlighting (highlight)
import Text.Pandoc.ImageSize
-import Text.Pandoc.Shared hiding (Element)
-import Text.Pandoc.Writers.Shared (fixDisplayMath)
+import Text.Pandoc.Logging
+import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType,
+ getMimeTypeDef)
import Text.Pandoc.Options
-import Text.Pandoc.Writers.Math
-import Text.Pandoc.Highlighting ( highlight )
-import Text.Pandoc.Walk
-import Text.XML.Light as XML
-import Text.TeXMath
import Text.Pandoc.Readers.Docx.StyleMap
-import Control.Monad.Reader
-import Control.Monad.State
-import Skylighting
-import Control.Monad.Except (catchError)
-import System.Random (randomR)
+import Text.Pandoc.Shared hiding (Element)
+import qualified Text.Pandoc.UTF8 as UTF8
+import Text.Pandoc.Walk
+import Text.Pandoc.Writers.Math
+import Text.Pandoc.Writers.Shared (fixDisplayMath)
import Text.Printf (printf)
-import Data.Monoid ((<>))
-import qualified Data.Text as T
-import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,
- extensionFromMimeType)
-import Control.Applicative ((<|>))
-import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing)
-import Data.Char (ord, isSpace, toLower)
-import Text.Pandoc.Class (PandocMonad, report)
-import qualified Text.Pandoc.Class as P
-import Text.Pandoc.Logging
-import Text.Pandoc.Error
+import Text.TeXMath
+import Text.XML.Light as XML
data ListMarker = NoMarker
| BulletMarker
@@ -81,28 +84,28 @@ listMarkerToId BulletMarker = "991"
listMarkerToId (NumberMarker sty delim n) =
'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'
+ 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'
+ DefaultDelim -> '0'
+ Period -> '1'
+ OneParen -> '2'
+ TwoParens -> '3'
data WriterEnv = WriterEnv{ envTextProperties :: [Element]
, envParaProperties :: [Element]
- , envRTL :: Bool
- , envListLevel :: Int
- , envListNumId :: Int
- , envInDel :: Bool
- , envChangesAuthor :: String
- , envChangesDate :: String
- , envPrintWidth :: Integer
+ , envRTL :: Bool
+ , envListLevel :: Int
+ , envListNumId :: Int
+ , envInDel :: Bool
+ , envChangesAuthor :: String
+ , envChangesDate :: String
+ , envPrintWidth :: Integer
}
defaultWriterEnv :: WriterEnv
@@ -209,11 +212,11 @@ isValidChar (ord -> c)
| otherwise = False
metaValueToInlines :: MetaValue -> [Inline]
-metaValueToInlines (MetaString s) = [Str s]
+metaValueToInlines (MetaString s) = [Str s]
metaValueToInlines (MetaInlines ils) = ils
-metaValueToInlines (MetaBlocks bs) = query return bs
-metaValueToInlines (MetaBool b) = [Str $ show b]
-metaValueToInlines _ = []
+metaValueToInlines (MetaBlocks bs) = query return bs
+metaValueToInlines (MetaBool b) = [Str $ show b]
+metaValueToInlines _ = []
@@ -452,8 +455,8 @@ writeDocx opts doc@(Pandoc meta _) = do
let newstyles = map newParaPropToOpenXml newDynamicParaProps ++
map newTextPropToOpenXml newDynamicTextProps ++
(case writerHighlightStyle opts of
- Nothing -> []
- Just sty -> (styleToOpenXml styleMaps sty))
+ Nothing -> []
+ Just sty -> (styleToOpenXml styleMaps sty))
let styledoc' = styledoc{ elContent = elContent styledoc ++
map Elem newstyles }
let styleEntry = toEntry stylepath epochtime $ renderXml styledoc'
@@ -675,21 +678,21 @@ mkLvl marker lvl =
bulletFor 4 = "\x2022"
bulletFor 5 = "\x2013"
bulletFor _ = "\x2022"
- styleFor UpperAlpha _ = "upperLetter"
- styleFor LowerAlpha _ = "lowerLetter"
- styleFor UpperRoman _ = "upperRoman"
- styleFor LowerRoman _ = "lowerRoman"
- styleFor Decimal _ = "decimal"
+ styleFor UpperAlpha _ = "upperLetter"
+ styleFor LowerAlpha _ = "lowerLetter"
+ styleFor UpperRoman _ = "upperRoman"
+ styleFor LowerRoman _ = "lowerRoman"
+ styleFor Decimal _ = "decimal"
styleFor DefaultStyle 1 = "decimal"
styleFor DefaultStyle 2 = "lowerLetter"
styleFor DefaultStyle 3 = "lowerRoman"
styleFor DefaultStyle 4 = "decimal"
styleFor DefaultStyle 5 = "lowerLetter"
styleFor DefaultStyle 6 = "lowerRoman"
- styleFor _ _ = "decimal"
- patternFor OneParen s = s ++ ")"
+ styleFor _ _ = "decimal"
+ patternFor OneParen s = s ++ ")"
patternFor TwoParens s = "(" ++ s ++ ")"
- patternFor _ s = s ++ "."
+ patternFor _ s = s ++ "."
getNumId :: (PandocMonad m) => WS m Int
getNumId = (((baseListId - 1) +) . length) `fmap` gets stLists
@@ -733,14 +736,14 @@ writeOpenXML opts (Pandoc meta blocks) = do
let auths = docAuthors meta
let dat = docDate meta
let abstract' = case lookupMeta "abstract" meta of
- Just (MetaBlocks bs) -> bs
+ Just (MetaBlocks bs) -> bs
Just (MetaInlines ils) -> [Plain ils]
- _ -> []
+ _ -> []
let subtitle' = case lookupMeta "subtitle" meta of
Just (MetaBlocks [Plain xs]) -> xs
Just (MetaBlocks [Para xs]) -> xs
Just (MetaInlines xs) -> xs
- _ -> []
+ _ -> []
title <- withParaPropM (pStyleM "Title") $ blocksToOpenXML opts [Para tit | not (null tit)]
subtitle <- withParaPropM (pStyleM "Subtitle") $ blocksToOpenXML opts [Para subtitle' | not (null subtitle')]
authors <- withParaProp (pCustomStyle "Author") $ blocksToOpenXML opts $
@@ -750,8 +753,8 @@ writeOpenXML opts (Pandoc meta blocks) = do
then return []
else withParaProp (pCustomStyle "Abstract") $ blocksToOpenXML opts abstract'
let convertSpace (Str x : Space : Str y : xs) = Str (x ++ " " ++ y) : xs
- convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs
- convertSpace xs = xs
+ convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs
+ convertSpace xs = xs
let blocks' = bottomUp convertSpace blocks
doc' <- (setFirstPara >> blocksToOpenXML opts blocks')
notes' <- reverse `fmap` gets stFootnotes
@@ -981,9 +984,9 @@ listItemToOpenXML opts numid (first:rest) = do
alignmentToString :: Alignment -> [Char]
alignmentToString alignment = case alignment of
- AlignLeft -> "left"
- AlignRight -> "right"
- AlignCenter -> "center"
+ AlignLeft -> "left"
+ AlignRight -> "right"
+ AlignCenter -> "center"
AlignDefault -> "left"
-- | Convert a list of inline elements to OpenXML.
@@ -1063,7 +1066,7 @@ inlineToOpenXML' opts (Span (ident,classes,kvs) ils) = do
let dirmod = case lookup "dir" kvs of
Just "rtl" -> local (\env -> env { envRTL = True })
Just "ltr" -> local (\env -> env { envRTL = False })
- _ -> id
+ _ -> id
let off x = withTextProp (mknode x [("w:val","0")] ())
let pmod = (if "csl-no-emph" `elem` classes then off "w:i" else id) .
(if "csl-no-strong" `elem` classes then off "w:b" else id) .
@@ -1154,8 +1157,8 @@ inlineToOpenXML' opts (Code attrs str) = do
, mknode "w:t" [("xml:space","preserve")] (T.unpack tok) ]
withTextProp (rCustomStyle "VerbatimChar")
$ case writerHighlightStyle opts >> highlight formatOpenXML attrs str of
- Just h -> return h
- Nothing -> unhighlighted
+ Just h -> return h
+ Nothing -> unhighlighted
inlineToOpenXML' opts (Note bs) = do
notes <- gets stFootnotes
notenum <- (lift . lift) getUniqueId
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-09 21:37:19 +0000