{-# LANGUAGE OverloadedStrings #-}
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
showList :: [ListMarker] -> ShowS
$cshowList :: [ListMarker] -> ShowS
show :: ListMarker -> String
$cshow :: ListMarker -> String
showsPrec :: Int -> ListMarker -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [ListMarker]
$creadListPrec :: ReadPrec [ListMarker]
readPrec :: ReadPrec ListMarker
$creadPrec :: ReadPrec ListMarker
readList :: ReadS [ListMarker]
$creadList :: ReadS [ListMarker]
readsPrec :: Int -> ReadS ListMarker
$creadsPrec :: Int -> ReadS ListMarker
Read, ListMarker -> ListMarker -> Bool
(ListMarker -> ListMarker -> Bool)
-> (ListMarker -> ListMarker -> Bool) -> Eq ListMarker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMarker -> ListMarker -> Bool
$c/= :: ListMarker -> ListMarker -> Bool
== :: ListMarker -> ListMarker -> Bool
$c== :: 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
min :: ListMarker -> ListMarker -> ListMarker
$cmin :: ListMarker -> ListMarker -> ListMarker
max :: ListMarker -> ListMarker -> ListMarker
$cmax :: ListMarker -> ListMarker -> ListMarker
>= :: ListMarker -> ListMarker -> Bool
$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
compare :: ListMarker -> ListMarker -> Ordering
$ccompare :: ListMarker -> ListMarker -> Ordering
$cp1Ord :: Eq ListMarker
Ord)
listMarkerToId :: ListMarker -> Text
listMarkerToId :: ListMarker -> Text
listMarkerToId NoMarker = "990"
listMarkerToId BulletMarker = "991"
listMarkerToId (NumberMarker sty :: ListNumberStyle
sty delim :: ListNumberDelim
delim n :: Int
n) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
'9' Char -> ShowS
forall a. a -> [a] -> [a]
: '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
DefaultStyle -> '2'
Example -> '3'
Decimal -> '4'
LowerRoman -> '5'
UpperRoman -> '6'
LowerAlpha -> '7'
UpperAlpha -> '8'
delimNum :: Char
delimNum = case ListNumberDelim
delim of
DefaultDelim -> '0'
Period -> '1'
OneParen -> '2'
TwoParens -> '3'
data EnvProps = EnvProps{ EnvProps -> Maybe Element
styleElement :: Maybe Element
, EnvProps -> [Element]
otherElements :: [Element]
}
instance Semigroup EnvProps where
EnvProps s :: Maybe Element
s es :: [Element]
es <> :: EnvProps -> EnvProps -> EnvProps
<> EnvProps s' :: Maybe Element
s' es' :: [Element]
es' = Maybe Element -> [Element] -> EnvProps
EnvProps (Maybe Element
s Maybe Element -> Maybe Element -> Maybe Element
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
}
defaultWriterEnv :: WriterEnv
defaultWriterEnv :: WriterEnv
defaultWriterEnv = WriterEnv :: EnvProps
-> EnvProps
-> Bool
-> Int
-> Int
-> Bool
-> Text
-> Text
-> Integer
-> WriterEnv
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 = -1
, envListNumId :: Int
envListNumId = 1
, envInDel :: Bool
envInDel = Bool
False
, envChangesAuthor :: Text
envChangesAuthor = "unknown"
, envChangesDate :: Text
envChangesDate = "1969-12-31T19:00:00Z"
, envPrintWidth :: Integer
envPrintWidth = 1
}
data WriterState = WriterState{
:: [Element]
, :: [([(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 -> Int
stInsId :: Int
, WriterState -> Int
stDelId :: Int
, WriterState -> StyleMaps
stStyleMaps :: StyleMaps
, WriterState -> Bool
stFirstPara :: Bool
, WriterState -> Bool
stNumIdUsed :: Bool
, 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 :: [Element]
-> [([(Text, Text)], [Inline])]
-> Set Text
-> Map Text Text
-> Map String (String, String, Maybe Text, ByteString)
-> [ListMarker]
-> Int
-> Int
-> StyleMaps
-> Bool
-> Bool
-> Bool
-> Bool
-> [Inline]
-> Set ParaStyleName
-> Set CharStyleName
-> Int
-> Int
-> Int
-> WriterState
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]
, stInsId :: Int
stInsId = 1
, stDelId :: Int
stDelId = 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 "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 = 20
, stNextFigureNum :: Int
stNextFigureNum = 1
, stNextTableNum :: Int
stNextTableNum = 1
}
setFirstPara :: PandocMonad m => WS m ()
setFirstPara :: WS m ()
setFirstPara = (WriterState -> WriterState) -> WS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> WS m ())
-> (WriterState -> WriterState) -> WS m ()
forall a b. (a -> b) -> a -> b
$ \s :: WriterState
s -> WriterState
s { stFirstPara :: Bool
stFirstPara = Bool
True }
type WS m = ReaderT WriterEnv (StateT WriterState m)
defaultFootnotes :: [Element]
= [ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:footnote"
[("w:type", "separator"), ("w:id", "-1")]
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:p" []
[Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:r" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:separator" [] ()]]]
, Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:footnote"
[("w:type", "continuationSeparator"), ("w:id", "0")]
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:p" []
[ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:r" []
[ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:continuationSeparator" [] ()]]]]
pStyleM :: (PandocMonad m) => ParaStyleName -> WS m XML.Element
pStyleM :: ParaStyleName -> WS m Element
pStyleM styleName :: 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 (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 "w:pStyle" [("w:val", ParaStyleId -> Text
forall a. FromStyleId a => a -> Text
fromStyleId ParaStyleId
sty')] ()
withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
withParaProp :: Element -> WS m a -> WS m a
withParaProp d :: Element
d p :: WS m a
p =
(WriterEnv -> WriterEnv) -> WS m a -> WS m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\env :: 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 :: WS m Element -> WS m a -> WS m a
withParaPropM md :: WS m Element
md p :: 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 e :: Element
e = [(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [] "w" "rStyle" Element
e Bool -> Bool -> Bool
||
[(Text, Text)] -> Text -> Text -> Element -> Bool
isElem [] "w" "pStyle" Element
e