{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
{- |
   Module      : Text.Pandoc.Writers.OpenDocument
   Copyright   : Copyright (C) 2008-2020 Andrea Rossato and John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : Andrea Rossato <andrea.rossato@ing.unitn.it>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to OpenDocument XML.
-}
module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where
import Control.Arrow ((***), (>>>))
import Control.Monad.State.Strict hiding (when)
import Data.Char (chr)
import Data.Foldable (find)
import Data.List (sortOn, sortBy, foldl')
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, isNothing)
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Text.Collate.Lang (Lang (..), parseLang)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report, translateTerm,
                                      setTranslations, toLang)
import Text.Pandoc.Definition
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared (linesToPara, tshow, blocksToInlines)
import Text.Pandoc.Templates (renderTemplate)
import qualified Text.Pandoc.Translations as Term (Term(Figure, Table))
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
import Text.Pandoc.XML
import Text.Printf (printf)
import Text.Pandoc.Highlighting (highlight)
import Skylighting

-- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain [Inline]
x) = [Inline] -> Block
Para [Inline]
x
plainToPara Block
x         = Block
x

--
-- OpenDocument writer
--

type OD m = StateT WriterState m

data ReferenceType
  = HeaderRef
  | TableRef
  | ImageRef

data WriterState =
    WriterState { WriterState -> [Doc Text]
stNotes          :: [Doc Text]
                , WriterState -> [Doc Text]
stTableStyles    :: [Doc Text]
                , WriterState -> [Doc Text]
stParaStyles     :: [Doc Text]
                , WriterState -> [(Int, [Doc Text])]
stListStyles     :: [(Int, [Doc Text])]
                , WriterState -> Map (Set TextStyle) (Text, Doc Text)
stTextStyles     :: Map.Map (Set.Set TextStyle)
                                        (Text, Doc Text)
                , WriterState -> Set TextStyle
stTextStyleAttr  :: Set.Set TextStyle
                , WriterState -> Int
stIndentPara     :: Int
                , WriterState -> Bool
stInDefinition   :: Bool
                , WriterState -> Bool
stTight          :: Bool
                , WriterState -> Bool
stFirstPara      :: Bool
                , WriterState -> Int
stImageId        :: Int
                , WriterState -> Int
stTableCaptionId :: Int
                , WriterState -> Int
stImageCaptionId :: Int
                , WriterState -> [(Text, ReferenceType)]
stIdentTypes     :: [(Text,ReferenceType)]
                }

defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState =
    WriterState { stNotes :: [Doc Text]
stNotes          = []
                , stTableStyles :: [Doc Text]
stTableStyles    = []
                , stParaStyles :: [Doc Text]
stParaStyles     = []
                , stListStyles :: [(Int, [Doc Text])]
stListStyles     = []
                , stTextStyles :: Map (Set TextStyle) (Text, Doc Text)
stTextStyles     = forall k a. Map k a
Map.empty
                , stTextStyleAttr :: Set TextStyle
stTextStyleAttr  = forall a. Set a
Set.empty
                , stIndentPara :: Int
stIndentPara     = Int
0
                , stInDefinition :: Bool
stInDefinition   = Bool
False
                , stTight :: Bool
stTight          = Bool
False
                , stFirstPara :: Bool
stFirstPara      = Bool
False
                , stImageId :: Int
stImageId        = Int
1
                , stTableCaptionId :: Int
stTableCaptionId = Int
1
                , stImageCaptionId :: Int
stImageCaptionId = Int
1
                , stIdentTypes :: [(Text, ReferenceType)]
stIdentTypes     = []
                }

when :: Bool -> Doc Text -> Doc Text
when :: Bool -> Doc Text -> Doc Text
when Bool
p Doc Text
a = if Bool
p then Doc Text
a else forall a. Doc a
empty

addTableStyle :: PandocMonad m => Doc Text -> OD m ()
addTableStyle :: forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addTableStyle Doc Text
i = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stTableStyles :: [Doc Text]
stTableStyles = Doc Text
i forall a. a -> [a] -> [a]
: WriterState -> [Doc Text]
stTableStyles WriterState
s }

addNote :: PandocMonad m => Doc Text -> OD m ()
addNote :: forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addNote Doc Text
i = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stNotes :: [Doc Text]
stNotes = Doc Text
i forall a. a -> [a] -> [a]
: WriterState -> [Doc Text]
stNotes WriterState
s }

addParaStyle :: PandocMonad m => Doc Text -> OD m ()
addParaStyle :: forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addParaStyle Doc Text
i = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stParaStyles :: [Doc Text]
stParaStyles = Doc Text
i forall a. a -> [a] -> [a]
: WriterState -> [Doc Text]
stParaStyles WriterState
s }

addTextStyle :: PandocMonad m
             => Set.Set TextStyle -> (Text, Doc Text) -> OD m ()
addTextStyle :: forall (m :: * -> *).
PandocMonad m =>
Set TextStyle -> (Text, Doc Text) -> OD m ()
addTextStyle Set TextStyle
attrs (Text, Doc Text)
i = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s ->
  WriterState
s { stTextStyles :: Map (Set TextStyle) (Text, Doc Text)
stTextStyles = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Set TextStyle
attrs (Text, Doc Text)
i (WriterState -> Map (Set TextStyle) (Text, Doc Text)
stTextStyles WriterState
s) }

addTextStyleAttr :: PandocMonad m => TextStyle -> OD m ()
addTextStyleAttr :: forall (m :: * -> *). PandocMonad m => TextStyle -> OD m ()
addTextStyleAttr TextStyle
t = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s ->
  WriterState
s { stTextStyleAttr :: Set TextStyle
stTextStyleAttr = forall a. Ord a => a -> Set a -> Set a
Set.insert TextStyle
t (WriterState -> Set TextStyle
stTextStyleAttr WriterState
s) }

increaseIndent :: PandocMonad m => OD m ()
increaseIndent :: forall (m :: * -> *). PandocMonad m => OD m ()
increaseIndent = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stIndentPara :: Int
stIndentPara = Int
1 forall a. Num a => a -> a -> a
+ WriterState -> Int
stIndentPara WriterState
s }

resetIndent :: PandocMonad m => OD m ()
resetIndent :: forall (m :: * -> *). PandocMonad m => OD m ()
resetIndent = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stIndentPara :: Int
stIndentPara = WriterState -> Int
stIndentPara WriterState
s forall a. Num a => a -> a -> a
- Int
1 }

inTightList :: PandocMonad m => OD m a -> OD m a
inTightList :: forall (m :: * -> *) a. PandocMonad m => OD m a -> OD m a
inTightList  OD m a
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s { stTight :: Bool
stTight = Bool
True  }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OD m a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
r ->
                 forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
s -> WriterState
s { stTight :: Bool
stTight = Bool
False }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
r

setInDefinitionList :: PandocMonad m => Bool -> OD m ()
setInDefinitionList :: forall (m :: * -> *). PandocMonad m => Bool -> OD m ()
setInDefinitionList Bool
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$  \WriterState
s -> WriterState
s { stInDefinition :: Bool
stInDefinition = Bool
b }

setFirstPara :: PandocMonad m => OD m ()
setFirstPara :: forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara =  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$  \WriterState
s -> WriterState
s { stFirstPara :: Bool
stFirstPara = Bool
True }

inParagraphTags :: PandocMonad m => Doc Text -> OD m (Doc Text)
inParagraphTags :: forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
inParagraphTags Doc Text
d = do
  Bool
b <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stFirstPara
  [(Text, Text)]
a <- if Bool
b
       then do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stFirstPara :: Bool
stFirstPara = Bool
False }
               forall (m :: * -> *) a. Monad m => a -> m a
return [(Text
"text:style-name", Text
"First_20_paragraph")]
       else    forall (m :: * -> *) a. Monad m => a -> m a
return   [(Text
"text:style-name", Text
"Text_20_body")]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:p" [(Text, Text)]
a Doc Text
d

inParagraphTagsWithStyle :: Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle :: Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle Text
sty = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:p" [(Text
"text:style-name", Text
sty)]

inSpanTags :: Text -> Doc Text -> Doc Text
inSpanTags :: Text -> Doc Text -> Doc Text
inSpanTags Text
s = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:span" [(Text
"text:style-name",Text
s)]

withTextStyle :: PandocMonad m => TextStyle -> OD m a -> OD m a
withTextStyle :: forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
s OD m a
f = do
  Set TextStyle
oldTextStyleAttr <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Set TextStyle
stTextStyleAttr
  forall (m :: * -> *). PandocMonad m => TextStyle -> OD m ()
addTextStyleAttr TextStyle
s
  a
res <- OD m a
f
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stTextStyleAttr :: Set TextStyle
stTextStyleAttr = Set TextStyle
oldTextStyleAttr }
  forall (m :: * -> *) a. Monad m => a -> m a
return a
res

inTextStyle :: PandocMonad m => Doc Text -> OD m (Doc Text)
inTextStyle :: forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
inTextStyle Doc Text
d = do
  Set TextStyle
at <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Set TextStyle
stTextStyleAttr
  if forall a. Set a -> Bool
Set.null Set TextStyle
at
     then forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
d
     else do
       Map (Set TextStyle) (Text, Doc Text)
styles <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map (Set TextStyle) (Text, Doc Text)
stTextStyles
       case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Set TextStyle
at Map (Set TextStyle) (Text, Doc Text)
styles of
            Just (Text
styleName, Doc Text
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
              forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:span" [(Text
"text:style-name",Text
styleName)] Doc Text
d
            Maybe (Text, Doc Text)
Nothing -> do
              let styleName :: Text
styleName = Text
"T" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall k a. Map k a -> Int
Map.size Map (Set TextStyle) (Text, Doc Text)
styles forall a. Num a => a -> a -> a
+ Int
1)
              forall (m :: * -> *).
PandocMonad m =>
Set TextStyle -> (Text, Doc Text) -> OD m ()
addTextStyle Set TextStyle
at (Text
styleName,
                     forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"style:style"
                       [(Text
"style:name", Text
styleName)
                       ,(Text
"style:family", Text
"text")]
                       forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:text-properties"
                          (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList
                                forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Text Text -> TextStyle -> Map Text Text
textStyleAttr forall a. Monoid a => a
mempty (forall a. Set a -> [a]
Set.toList Set TextStyle
at)))
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False
                  Text
"text:span" [(Text
"text:style-name",Text
styleName)] Doc Text
d

formulaStyles :: [Doc Text]
formulaStyles :: [Doc Text]
formulaStyles = [MathType -> Doc Text
formulaStyle MathType
InlineMath, MathType -> Doc Text
formulaStyle MathType
DisplayMath]

formulaStyle :: MathType -> Doc Text
formulaStyle :: MathType -> Doc Text
formulaStyle MathType
mt = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"style:style"
  [(Text
"style:name", if MathType
mt forall a. Eq a => a -> a -> Bool
== MathType
InlineMath then Text
"fr1" else Text
"fr2")
  ,(Text
"style:family", Text
"graphic")
  ,(Text
"style:parent-style-name", Text
"Formula")]
  forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:graphic-properties" forall a b. (a -> b) -> a -> b
$ if MathType
mt forall a. Eq a => a -> a -> Bool
== MathType
InlineMath then
                                                  [(Text
"style:vertical-pos", Text
"middle")
                                                  ,(Text
"style:vertical-rel", Text
"text")]
                                                else
                                                  [(Text
"style:vertical-pos",   Text
"middle")
                                                  ,(Text
"style:vertical-rel",   Text
"text")
                                                  ,(Text
"style:horizontal-pos", Text
"center")
                                                  ,(Text
"style:horizontal-rel", Text
"paragraph-content")
                                                  ,(Text
"style:wrap",           Text
"none")]

inBookmarkTags :: Text -> Doc Text -> Doc Text
inBookmarkTags :: Text -> Doc Text -> Doc Text
inBookmarkTags Text
ident Doc Text
d =
  forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:bookmark-start" [ (Text
"text:name", Text
ident) ]
  forall a. Semigroup a => a -> a -> a
<> Doc Text
d forall a. Semigroup a => a -> a -> a
<>
  forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:bookmark-end" [ (Text
"text:name", Text
ident) ]

selfClosingBookmark :: Text -> Doc Text
selfClosingBookmark :: Text -> Doc Text
selfClosingBookmark Text
ident =
  forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:bookmark" [(Text
"text:name", Text
ident)]

inHeaderTags :: PandocMonad m => Int -> Text -> Doc Text -> OD m (Doc Text)
inHeaderTags :: forall (m :: * -> *).
PandocMonad m =>
Int -> Text -> Doc Text -> OD m (Doc Text)
inHeaderTags Int
i Text
ident Doc Text
d =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:h" [ (Text
"text:style-name", Text
"Heading_20_" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
i)
                                 , (Text
"text:outline-level", forall a. Show a => a -> Text
tshow Int
i)]
         forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
ident
              then Doc Text
d
              else Text -> Doc Text -> Doc Text
inBookmarkTags Text
ident Doc Text
d

inQuotes :: QuoteType -> Doc Text -> Doc Text
inQuotes :: QuoteType -> Doc Text -> Doc Text
inQuotes QuoteType
SingleQuote Doc Text
s = forall a. HasChars a => Char -> Doc a
char Char
'\8216' forall a. Semigroup a => a -> a -> a
<> Doc Text
s forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'\8217'
inQuotes QuoteType
DoubleQuote Doc Text
s = forall a. HasChars a => Char -> Doc a
char Char
'\8220' forall a. Semigroup a => a -> a -> a
<> Doc Text
s forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'\8221'

handleSpaces :: Text -> Doc Text
handleSpaces :: Text -> Doc Text
handleSpaces Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
  Just (Char
' ', Text
_) -> Text -> Doc Text
genTag Text
s
  Just (Char
'\t',Text
x) -> forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:tab" [] forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
rm Text
x
  Maybe (Char, Text)
_             -> Text -> Doc Text
rm Text
s
  where
    genTag :: Text -> Doc Text
genTag = (Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
==Char
' ') forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {a}. (Eq a, Num a, Show a) => a -> Doc Text
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Text -> Doc Text
rm forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Semigroup a => a -> a -> a
(<>)
    tag :: a -> Doc Text
tag a
n  = Bool -> Doc Text -> Doc Text
when (a
n forall a. Eq a => a -> a -> Bool
/= a
0) forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:s" [(Text
"text:c", forall a. Show a => a -> Text
tshow a
n)]
    rm :: Text -> Doc Text
rm Text
t   = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Just ( Char
' ',Text
xs) -> forall a. HasChars a => Char -> Doc a
char Char
' ' forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
genTag Text
xs
      Just (Char
'\t',Text
xs) -> forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:tab" [] forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
genTag Text
xs
      Just (   Char
x,Text
xs) -> forall a. HasChars a => Char -> Doc a
char Char
x forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
rm Text
xs
      Maybe (Char, Text)
Nothing        -> forall a. Doc a
empty

-- | Convert Pandoc document to string in OpenDocument format.
writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOpenDocument WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  let defLang :: Lang
defLang = Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> [(Text, [(Text, Text)])]
-> [Text]
-> Lang
Lang Text
"en" (forall a. a -> Maybe a
Just Text
"US") forall a. Maybe a
Nothing [] [] []
  Lang
lang <- case Text -> Meta -> Text
lookupMetaString Text
"lang" Meta
meta of
            Text
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Lang
defLang
            Text
s  -> forall a. a -> Maybe a -> a
fromMaybe Lang
defLang forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang (forall a. a -> Maybe a
Just Text
s)
  forall (m :: * -> *). PandocMonad m => Lang -> m ()
setTranslations Lang
lang
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing
  let meta' :: Meta
meta' = case Text -> Meta -> [Block]
lookupMetaBlocks Text
"abstract" Meta
meta of
                [] -> Meta
meta
                [Block]
xs -> forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"abstract"
                        (Attr -> Blocks -> Blocks
B.divWith (Text
"",[],[(Text
"custom-style",Text
"Abstract")])
                          (forall a. [a] -> Many a
B.fromList [Block]
xs))
                        Meta
meta
  ((Doc Text
body, Context Text
metadata),WriterState
s) <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
        WriterState
defaultWriterState forall a b. (a -> b) -> a -> b
$ do
           let collectInlineIdent :: Inline -> [(Text, ReferenceType)]
collectInlineIdent (Image (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
_ (Text, Text)
_) = [(Text
ident,ReferenceType
ImageRef)]
               collectInlineIdent Inline
_                       = []
           let collectBlockIdent :: Block -> [(Text, ReferenceType)]
collectBlockIdent (Header Int
_ (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
_)      = [(Text
ident,ReferenceType
HeaderRef)]
               collectBlockIdent (Table (Text
ident,[Text]
_,[(Text, Text)]
_) Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_) = [(Text
ident,ReferenceType
TableRef)]
               collectBlockIdent Block
_                             = []
           forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stIdentTypes :: [(Text, ReferenceType)]
stIdentTypes = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [(Text, ReferenceType)]
collectBlockIdent [Block]
blocks forall a. [a] -> [a] -> [a]
++ forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [(Text, ReferenceType)]
collectInlineIdent [Block]
blocks }
           Context Text
m <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
                  (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument WriterOptions
opts)
                  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
opts)
                  Meta
meta'
           Doc Text
b <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument WriterOptions
opts [Block]
blocks
           forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
b, Context Text
m)
  let styles :: [Doc Text]
styles   = WriterState -> [Doc Text]
stTableStyles WriterState
s forall a. [a] -> [a] -> [a]
++ WriterState -> [Doc Text]
stParaStyles WriterState
s forall a. [a] -> [a] -> [a]
++ [Doc Text]
formulaStyles forall a. [a] -> [a] -> [a]
++
                     forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst)) (
                        forall k a. Map k a -> [a]
Map.elems (WriterState -> Map (Set TextStyle) (Text, Doc Text)
stTextStyles WriterState
s)))
      listStyle :: (a, [Doc a]) -> Doc a
listStyle (a
n,[Doc a]
l) = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"text:list-style"
                          [(Text
"style:name", Text
"L" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow a
n)] (forall a. [Doc a] -> Doc a
vcat [Doc a]
l)
  let listStyles :: [Doc Text]
listStyles  = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (HasChars a, Show a) => (a, [Doc a]) -> Doc a
listStyle (WriterState -> [(Int, [Doc Text])]
stListStyles WriterState
s)
  let automaticStyles :: Doc Text
automaticStyles = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Doc Text]
styles forall a. [a] -> [a] -> [a]
++ [Doc Text]
listStyles
  let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
body
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc-depth" (forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerTOCDepth WriterOptions
opts)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"automatic-styles" Doc Text
automaticStyles
              forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Maybe (Template Text)
Nothing  -> Doc Text
body
       Just Template Text
tpl -> forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

withParagraphStyle :: PandocMonad m
                   => WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle  WriterOptions
o Text
s (Block
b:[Block]
bs)
    | Para [Inline]
l <- Block
b = forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    | Bool
otherwise   = forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument WriterOptions
o Block
b
    where go :: Doc Text -> StateT WriterState m (Doc Text)
go Doc Text
i = forall a. Semigroup a => a -> a -> a
(<>) Doc Text
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
s [Block]
bs
withParagraphStyle WriterOptions
_ Text
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty

inPreformattedTags :: PandocMonad m => Text -> OD m (Doc Text)
inPreformattedTags :: forall (m :: * -> *). PandocMonad m => Text -> OD m (Doc Text)
inPreformattedTags Text
s = do
  Int
n <- forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Int
paraStyle [(Text
"style:parent-style-name",Text
"Preformatted_20_Text")]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle (Text
"P" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
handleSpaces forall a b. (a -> b) -> a -> b
$ Text
s

orderedListToOpenDocument :: PandocMonad m
                          => WriterOptions -> Int -> [[Block]] -> OD m (Doc Text)
orderedListToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [[Block]] -> OD m (Doc Text)
orderedListToOpenDocument WriterOptions
o Int
pn [[Block]]
bs =
    forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"text:list-item") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> OD m (Doc Text)
orderedItemToOpenDocument WriterOptions
o Int
pn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
bs

orderedItemToOpenDocument :: PandocMonad m
                          => WriterOptions -> Int -> [Block] -> OD m (Doc Text)
orderedItemToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> OD m (Doc Text)
orderedItemToOpenDocument  WriterOptions
o Int
n [Block]
bs = forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
PandocMonad m =>
Block -> StateT WriterState m (Doc Text)
go [Block]
bs
 where go :: Block -> StateT WriterState m (Doc Text)
go (OrderedList ListAttributes
a [[Block]]
l) = forall {m :: * -> *}.
PandocMonad m =>
ListAttributes -> [[Block]] -> StateT WriterState m (Doc Text)
newLevel ListAttributes
a [[Block]]
l
       go (Para          [Inline]
l) = Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle (Text
"P" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
       go Block
b                 = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument WriterOptions
o Block
b
       newLevel :: ListAttributes -> [[Block]] -> StateT WriterState m (Doc Text)
newLevel ListAttributes
a [[Block]]
l = do
         Int
nn <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stParaStyles
         (Int, [Doc Text])
ls <- forall a. [a] -> a
head   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [(Int, [Doc Text])]
stListStyles
         forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stListStyles :: [(Int, [Doc Text])]
stListStyles = ListAttributes -> (Int, [Doc Text]) -> (Int, [Doc Text])
orderedListLevelStyle ListAttributes
a (Int, [Doc Text])
ls forall a. a -> [a] -> [a]
:
                                 forall a. Int -> [a] -> [a]
drop Int
1 (WriterState -> [(Int, [Doc Text])]
stListStyles WriterState
s) }
         forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"text:list" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [[Block]] -> OD m (Doc Text)
orderedListToOpenDocument WriterOptions
o Int
nn [[Block]]
l

isTightList :: [[Block]] -> Bool
isTightList :: [[Block]] -> Bool
isTightList []          = Bool
False
isTightList ([Block]
b:[[Block]]
_)
    | Plain {} : [Block]
_ <- [Block]
b = Bool
True
    | Bool
otherwise         = Bool
False

newOrderedListStyle :: PandocMonad m
                    => Bool -> ListAttributes -> OD m (Int,Int)
newOrderedListStyle :: forall (m :: * -> *).
PandocMonad m =>
Bool -> ListAttributes -> OD m (Int, Int)
newOrderedListStyle Bool
b ListAttributes
a = do
  Int
ln <- forall a. Num a => a -> a -> a
(+) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [(Int, [Doc Text])]
stListStyles
  let nbs :: (Int, [Doc Text])
nbs = ListAttributes -> (Int, [Doc Text]) -> (Int, [Doc Text])
orderedListLevelStyle ListAttributes
a (Int
ln, [])
  Int
pn <- if Bool
b then forall (m :: * -> *) a. PandocMonad m => OD m a -> OD m a
inTightList (forall (m :: * -> *). PandocMonad m => Int -> OD m Int
paraListStyle Int
ln) else forall (m :: * -> *). PandocMonad m => Int -> OD m Int
paraListStyle Int
ln
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stListStyles :: [(Int, [Doc Text])]
stListStyles = (Int, [Doc Text])
nbs forall a. a -> [a] -> [a]
: WriterState -> [(Int, [Doc Text])]
stListStyles WriterState
s }
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ln,Int
pn)

bulletListToOpenDocument :: PandocMonad m
                         => WriterOptions -> [[Block]] -> OD m (Doc Text)
bulletListToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> OD m (Doc Text)
bulletListToOpenDocument WriterOptions
o [[Block]]
b = do
  Int
ln <- forall a. Num a => a -> a -> a
(+) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [(Int, [Doc Text])]
stListStyles
  (Int
pn,(Int, [Doc Text])
ns) <- if [[Block]] -> Bool
isTightList [[Block]]
b then forall (m :: * -> *) a. PandocMonad m => OD m a -> OD m a
inTightList (forall (m :: * -> *).
PandocMonad m =>
Int -> OD m (Int, (Int, [Doc Text]))
bulletListStyle Int
ln) else forall (m :: * -> *).
PandocMonad m =>
Int -> OD m (Int, (Int, [Doc Text]))
bulletListStyle Int
ln
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stListStyles :: [(Int, [Doc Text])]
stListStyles = (Int, [Doc Text])
ns forall a. a -> [a] -> [a]
: WriterState -> [(Int, [Doc Text])]
stListStyles WriterState
s }
  Doc Text
is <- forall (m :: * -> *).
PandocMonad m =>
Text -> WriterOptions -> [[Block]] -> OD m (Doc Text)
listItemsToOpenDocument (Text
"P" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
pn) WriterOptions
o [[Block]]
b
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"text:list" [(Text
"text:style-name", Text
"L" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
ln)] Doc Text
is

listItemsToOpenDocument :: PandocMonad m
                        => Text -> WriterOptions -> [[Block]] -> OD m (Doc Text)
listItemsToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
Text -> WriterOptions -> [[Block]] -> OD m (Doc Text)
listItemsToOpenDocument Text
s WriterOptions
o [[Block]]
is =
    forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"text:list-item") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
is

deflistItemToOpenDocument :: PandocMonad m
                          => WriterOptions -> ([Inline],[[Block]]) -> OD m (Doc Text)
deflistItemToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> OD m (Doc Text)
deflistItemToOpenDocument WriterOptions
o ([Inline]
t,[[Block]]
d) = do
  let ts :: Text
ts = if [[Block]] -> Bool
isTightList [[Block]]
d
           then Text
"Definition_20_Term_20_Tight"       else Text
"Definition_20_Term"
      ds :: Text
ds = if [[Block]] -> Bool
isTightList [[Block]]
d
           then Text
"Definition_20_Definition_20_Tight" else Text
"Definition_20_Definition"
  Doc Text
t' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
ts [[Inline] -> Block
Para [Inline]
t]
  Doc Text
d' <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
ds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
d
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
t' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
d'

inBlockQuote :: PandocMonad m
             => WriterOptions -> Int -> [Block] -> OD m (Doc Text)
inBlockQuote :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> OD m (Doc Text)
inBlockQuote  WriterOptions
o Int
i (Block
b:[Block]
bs)
    | BlockQuote [Block]
l <- Block
b = do forall (m :: * -> *). PandocMonad m => OD m ()
increaseIndent
                             Int
ni <- forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Int
paraStyle
                                   [(Text
"style:parent-style-name",Text
"Quotations")]
                             forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> OD m (Doc Text)
inBlockQuote WriterOptions
o Int
ni (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
l)
    | Para       [Inline]
l <- Block
b = forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle (Text
"P" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    | Bool
otherwise         = forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument WriterOptions
o Block
b
    where go :: Doc Text -> StateT WriterState m (Doc Text)
go  Doc Text
block  = forall a. Doc a -> Doc a -> Doc a
($$) Doc Text
block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> OD m (Doc Text)
inBlockQuote WriterOptions
o Int
i [Block]
bs
inBlockQuote     WriterOptions
_ Int
_ [] =  forall (m :: * -> *). PandocMonad m => OD m ()
resetIndent forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty

-- | Convert a list of Pandoc blocks to OpenDocument.
blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument WriterOptions
o [Block]
b = forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument WriterOptions
o) [Block]
b

-- | Convert a Pandoc block element to OpenDocument.
blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument WriterOptions
o = \case
    Plain          [Inline]
b -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
b
                        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
                        else forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
inParagraphTags forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
b
    SimpleFigure Attr
attr [Inline]
c (Text
s, Text
t) -> forall {m :: * -> *}.
PandocMonad m =>
Attr -> [Inline] -> Text -> Text -> OD m (Doc Text)
figure Attr
attr [Inline]
c Text
s Text
t
    Para           [Inline]
b -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
b Bool -> Bool -> Bool
&&
                           Bool -> Bool
not (forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_empty_paragraphs WriterOptions
o)
                        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
                        else forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
inParagraphTags forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
b
    LineBlock      [[Inline]]
b -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument WriterOptions
o forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
b
    Div Attr
attr [Block]
xs      -> forall {m :: * -> *}.
PandocMonad m =>
Attr -> [Block] -> OD m (Doc Text)
mkDiv Attr
attr [Block]
xs
    Header     Int
i (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
b -> do
      forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara
      forall (m :: * -> *).
PandocMonad m =>
Int -> Text -> Doc Text -> OD m (Doc Text)
inHeaderTags Int
i Text
ident forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
b
    BlockQuote     [Block]
b -> forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {m :: * -> *}.
PandocMonad m =>
[Block] -> StateT WriterState m (Doc Text)
mkBlockQuote [Block]
b
    DefinitionList [([Inline], [[Block]])]
b -> forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {m :: * -> *}.
PandocMonad m =>
[([Inline], [[Block]])] -> StateT WriterState m (Doc Text)
defList [([Inline], [[Block]])]
b
    BulletList     [[Block]]
b -> forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> OD m (Doc Text)
bulletListToOpenDocument WriterOptions
o [[Block]]
b
    OrderedList  ListAttributes
a [[Block]]
b -> forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {m :: * -> *}.
PandocMonad m =>
ListAttributes -> [[Block]] -> StateT WriterState m (Doc Text)
orderedList ListAttributes
a [[Block]]
b
    CodeBlock    Attr
_ Text
s -> forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). PandocMonad m => Text -> OD m (Doc Text)
preformatted Text
s
    Table Attr
a Caption
bc [ColSpec]
s TableHead
th [TableBody]
tb TableFoot
tf -> forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). PandocMonad m => Table -> OD m (Doc Text)
table (Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Ann.toTable Attr
a Caption
bc [ColSpec]
s TableHead
th [TableBody]
tb TableFoot
tf)
    Block
HorizontalRule   -> forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:p"
                         [ (Text
"text:style-name", Text
"Horizontal_20_Line") ])
    b :: Block
b@(RawBlock Format
f Text
s) -> if Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"opendocument"
                        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
                        else forall a. Doc a
empty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
    Block
Null             -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
    where
      defList :: [([Inline], [[Block]])] -> StateT WriterState m (Doc Text)
defList       [([Inline], [[Block]])]
b = do forall (m :: * -> *). PandocMonad m => Bool -> OD m ()
setInDefinitionList Bool
True
                           Doc Text
r <- forall a. [Doc a] -> Doc a
vcat  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> OD m (Doc Text)
deflistItemToOpenDocument WriterOptions
o) [([Inline], [[Block]])]
b
                           forall (m :: * -> *). PandocMonad m => Bool -> OD m ()
setInDefinitionList Bool
False
                           forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
r
      preformatted :: Text -> StateT WriterState m (Doc Text)
preformatted  Text
s = forall a. Doc a -> Doc a
flush forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). PandocMonad m => Text -> OD m (Doc Text)
inPreformattedTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeStringForXML) (Text -> [Text]
T.lines Text
s)
      mkDiv :: Attr -> [Block] -> OD m (Doc Text)
mkDiv    Attr
attr [Block]
s = do
        let (Text
ident,[Text]
_,[(Text, Text)]
kvs) = Attr
attr
            i :: OD m (Doc Text)
i = forall (m :: * -> *) a. PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr Attr
attr forall a b. (a -> b) -> a -> b
$
                case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"custom-style" [(Text, Text)]
kvs of
                  Just Text
sty -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
sty [Block]
s
                  Maybe Text
_        -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument WriterOptions
o [Block]
s
            mkBookmarkedDiv :: Doc Text -> Doc Text
mkBookmarkedDiv = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:section" [(Text
"text:name", Text
ident)]
        if Text -> Bool
T.null Text
ident
          then OD m (Doc Text)
i
          else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
mkBookmarkedDiv OD m (Doc Text)
i
      mkBlockQuote :: [Block] -> StateT WriterState m (Doc Text)
mkBlockQuote  [Block]
b = do forall (m :: * -> *). PandocMonad m => OD m ()
increaseIndent
                           Int
i <- forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Int
paraStyle
                                 [(Text
"style:parent-style-name",Text
"Quotations")]
                           forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> OD m (Doc Text)
inBlockQuote WriterOptions
o Int
i (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
b)
      orderedList :: ListAttributes -> [[Block]] -> StateT WriterState m (Doc Text)
orderedList ListAttributes
a [[Block]]
b = do (Int
ln,Int
pn) <- forall (m :: * -> *).
PandocMonad m =>
Bool -> ListAttributes -> OD m (Int, Int)
newOrderedListStyle ([[Block]] -> Bool
isTightList [[Block]]
b) ListAttributes
a
                           forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"text:list" [ (Text
"text:style-name", Text
"L" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
ln)]
                                      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [[Block]] -> OD m (Doc Text)
orderedListToOpenDocument WriterOptions
o Int
pn [[Block]]
b
      table :: PandocMonad m => Ann.Table -> OD m (Doc Text)
      table :: forall (m :: * -> *). PandocMonad m => Table -> OD m (Doc Text)
table (Ann.Table (Text
ident, [Text]
_, [(Text, Text)]
_) (Caption Maybe [Inline]
_ [Block]
c) [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
_) = do
        Int
tn <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stTableStyles
        Int
pn <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stParaStyles
        let  genIds :: String
genIds      = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr [Int
65..]
             name :: Text
name        = Text
"Table" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (Int
tn forall a. Num a => a -> a -> a
+ Int
1)
             ([Alignment]
aligns, [ColWidth]
mwidths) = forall a b. [(a, b)] -> ([a], [b])
unzip [ColSpec]
colspecs
             fromWidth :: ColWidth -> Double
fromWidth (ColWidth Double
w) | Double
w forall a. Ord a => a -> a -> Bool
> Double
0 = Double
w
             fromWidth ColWidth
_                    = Double
0
             widths :: [Double]
widths = forall a b. (a -> b) -> [a] -> [b]
map ColWidth -> Double
fromWidth [ColWidth]
mwidths
             textWidth :: Double
textWidth   = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
             columnIds :: [(Char, Double)]
columnIds   = forall a b. [a] -> [b] -> [(a, b)]
zip String
genIds [Double]
widths
             mkColumn :: (Char, b) -> Doc a
mkColumn  (Char, b)
n = forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"table:table-column" [(Text
"table:style-name", Text
name forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton (forall a b. (a, b) -> a
fst (Char, b)
n))]
             columns :: [Doc Text]
columns     = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. HasChars a => (Char, b) -> Doc a
mkColumn [(Char, Double)]
columnIds
             paraHStyles :: [(Text, Doc Text)]
paraHStyles = Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles Text
"Heading"  Int
pn [Alignment]
aligns
             paraStyles :: [(Text, Doc Text)]
paraStyles  = Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles Text
"Contents" (Int
pn forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall {a} {a}. [(a, Doc a)] -> [Doc a]
newPara [(Text, Doc Text)]
paraHStyles)) [Alignment]
aligns
             newPara :: [(a, Doc a)] -> [Doc a]
newPara     = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Doc a -> Bool
isEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
        forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addTableStyle forall a b. (a -> b) -> a -> b
$ Int -> Double -> [(Char, Double)] -> Doc Text
tableStyle Int
tn Double
textWidth [(Char, Double)]
columnIds
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addParaStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a}. [(a, Doc a)] -> [Doc a]
newPara forall a b. (a -> b) -> a -> b
$ [(Text, Doc Text)]
paraHStyles forall a. [a] -> [a] -> [a]
++ [(Text, Doc Text)]
paraStyles
        Doc Text
captionDoc <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
c
                      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
                      else forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o ([Block] -> [Inline]
blocksToInlines [Block]
c) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                             if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_numbering WriterOptions
o
                                then forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> OD m (Doc Text)
numberedTableCaption Text
ident
                                else forall (m :: * -> *).
Monad m =>
Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption Text
"TableCaption"
        Doc Text
th <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> TableHead -> OD m (Doc Text)
colHeadsToOpenDocument WriterOptions
o (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Text, Doc Text)]
paraHStyles) TableHead
thead
        [Doc Text]
tr <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> TableBody -> OD m (Doc Text)
tableBodyToOpenDocument WriterOptions
o (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Text, Doc Text)]
paraStyles)) [TableBody]
tbodies
        let tableDoc :: Doc Text
tableDoc = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"table:table" [
                            (Text
"table:name"      , Text
name)
                          , (Text
"table:style-name", Text
name)
                          ] (forall a. [Doc a] -> Doc a
vcat [Doc Text]
columns forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
th forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
tr)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
captionDoc forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
tableDoc
      figure :: Attr -> [Inline] -> Text -> Text -> OD m (Doc Text)
figure attr :: Attr
attr@(Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
caption Text
source Text
title | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption =
        forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
"Figure" [[Inline] -> Block
Para [Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
caption (Text
source,Text
title)]]
                                  | Bool
otherwise    = do
        Doc Text
imageDoc <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
"FigureWithCaption" [[Inline] -> Block
Para [Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
caption (Text
source,Text
title)]]
        Doc Text
captionDoc <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
caption forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_numbering WriterOptions
o
                            then forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> OD m (Doc Text)
numberedFigureCaption Text
ident
                            else forall (m :: * -> *).
Monad m =>
Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption Text
"FigureCaption"
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
imageDoc forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
captionDoc


numberedTableCaption :: PandocMonad m => Text -> Doc Text -> OD m (Doc Text)
numberedTableCaption :: forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> OD m (Doc Text)
numberedTableCaption Text
ident Doc Text
caption = do
    Int
id' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stTableCaptionId
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stTableCaptionId :: Int
stTableCaptionId = Int
id' forall a. Num a => a -> a -> a
+ Int
1 })
    Text
capterm <- forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Term.Table
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Int -> Text -> Doc Text -> Doc Text
numberedCaption Text
"TableCaption" Text
capterm Text
"Table" Int
id' Text
ident Doc Text
caption

numberedFigureCaption :: PandocMonad m => Text -> Doc Text -> OD m (Doc Text)
numberedFigureCaption :: forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> OD m (Doc Text)
numberedFigureCaption Text
ident Doc Text
caption = do
    Int
id' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stImageCaptionId
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stImageCaptionId :: Int
stImageCaptionId = Int
id' forall a. Num a => a -> a -> a
+ Int
1 })
    Text
capterm <- forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Term.Figure
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Int -> Text -> Doc Text -> Doc Text
numberedCaption Text
"FigureCaption" Text
capterm  Text
"Illustration" Int
id' Text
ident Doc Text
caption

numberedCaption :: Text -> Text -> Text -> Int -> Text -> Doc Text -> Doc Text
numberedCaption :: Text -> Text -> Text -> Int -> Text -> Doc Text -> Doc Text
numberedCaption Text
style Text
term Text
name Int
num Text
ident Doc Text
caption =
    let t :: Doc Text
t = forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
term
        r :: Int
r = Int
num forall a. Num a => a -> a -> a
- Int
1
        ident' :: Text
ident' = case Text
ident of
          Text
"" -> Text
"ref" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
r
          Text
_ -> Text
ident
        s :: Doc Text
s = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:sequence" [ (Text
"text:ref-name", Text
ident'),
                                           (Text
"text:name", Text
name),
                                           (Text
"text:formula", Text
"ooow:" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"+1"),
                                           (Text
"style:num-format", Text
"1") ] forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
num
        c :: Doc Text
c = forall a. HasChars a => String -> Doc a
text String
": "
    in Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle Text
style forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
hcat [ Doc Text
t, forall a. HasChars a => String -> Doc a
text String
" ", Doc Text
s, Doc Text
c, Doc Text
caption ]

unNumberedCaption :: Monad m => Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption :: forall (m :: * -> *).
Monad m =>
Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption Text
style Doc Text
caption = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle Text
style Doc Text
caption

colHeadsToOpenDocument :: PandocMonad m
                       => WriterOptions -> [Text] -> Ann.TableHead
                       -> OD m (Doc Text)
colHeadsToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> TableHead -> OD m (Doc Text)
colHeadsToOpenDocument WriterOptions
o [Text]
ns (Ann.TableHead Attr
_ [HeaderRow]
hs) =
  case [HeaderRow]
hs of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
    (HeaderRow
x:[HeaderRow]
_) ->
        let (Ann.HeaderRow Attr
_ RowNumber
_ [Cell]
c) = HeaderRow
x
        in forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"table:table-header-rows" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"table:table-row" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> (Text, Cell) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o Text
"TableHeaderRowCell") (forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ns [Cell]
c)

tableBodyToOpenDocument:: PandocMonad m
                       => WriterOptions -> [Text] -> Ann.TableBody
                       -> OD m (Doc Text)
tableBodyToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> TableBody -> OD m (Doc Text)
tableBodyToOpenDocument WriterOptions
o [Text]
ns TableBody
tb =
    let (Ann.TableBody Attr
_ RowHeadColumns
_ [HeaderRow]
_ [BodyRow]
r) = TableBody
tb
    in forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> BodyRow -> OD m (Doc Text)
tableRowToOpenDocument WriterOptions
o [Text]
ns) [BodyRow]
r

tableRowToOpenDocument :: PandocMonad m
                       => WriterOptions -> [Text] -> Ann.BodyRow
                       -> OD m (Doc Text)
tableRowToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> BodyRow -> OD m (Doc Text)
tableRowToOpenDocument WriterOptions
o [Text]
ns BodyRow
r =
    let (Ann.BodyRow Attr
_ RowNumber
_ [Cell]
_ [Cell]
c ) = BodyRow
r
    in forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"table:table-row" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> (Text, Cell) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o Text
"TableRowCell") (forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ns [Cell]
c)

colspanAttrib :: ColSpan -> [(Text, Text)]
colspanAttrib :: ColSpan -> [(Text, Text)]
colspanAttrib ColSpan
cs =
  case ColSpan
cs of
    ColSpan Int
1 -> forall a. Monoid a => a
mempty
    ColSpan Int
n -> [(Text
"table:number-columns-spanned", forall a. Show a => a -> Text
tshow Int
n)]

rowspanAttrib :: RowSpan -> [(Text, Text)]
rowspanAttrib :: RowSpan -> [(Text, Text)]
rowspanAttrib RowSpan
rs =
  case RowSpan
rs of
    RowSpan Int
1 -> forall a. Monoid a => a
mempty
    RowSpan Int
n -> [(Text
"table:number-rows-spanned", forall a. Show a => a -> Text
tshow Int
n)]

alignAttrib :: Alignment -> [(Text,Text)]
alignAttrib :: Alignment -> [(Text, Text)]
alignAttrib Alignment
a = case Alignment
a of
  Alignment
AlignRight  -> (Text
"fo:text-align",Text
"end") forall a. a -> [a] -> [a]
: [(Text, Text)]
style
  Alignment
AlignCenter -> (Text
"fo:text-align",Text
"center") forall a. a -> [a] -> [a]
: [(Text, Text)]
style
  Alignment
_ -> []
  where
    style :: [(Text, Text)]
style = [(Text
"style:justify-single-word",Text
"false")]

tableItemToOpenDocument :: PandocMonad m
                        => WriterOptions -> Text -> (Text,Ann.Cell)
                        -> OD m (Doc Text)
tableItemToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> (Text, Cell) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o Text
s (Text
n,Cell
c) = do
  let (Ann.Cell NonEmpty ColSpec
_colspecs ColNumber
_colnum (Cell Attr
_ Alignment
align RowSpan
rs ColSpan
cs [Block]
i) ) = Cell
c
      csa :: [(Text, Text)]
csa = ColSpan -> [(Text, Text)]
colspanAttrib ColSpan
cs
      rsa :: [(Text, Text)]
rsa = RowSpan -> [(Text, Text)]
rowspanAttrib RowSpan
rs
      aa :: [(Text, Text)]
aa = Alignment -> [(Text, Text)]
alignAttrib Alignment
align
      a :: [(Text, Text)]
a = [ (Text
"table:style-name" , Text
s )
          , (Text
"office:value-type", Text
"string" ) ] forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
csa forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
rsa
  Int
itemParaStyle <- case [(Text, Text)]
aa of
                     [] -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
                     [(Text, Text)]
_  -> forall (m :: * -> *).
PandocMonad m =>
Text -> [(Text, Text)] -> OD m Int
paraStyleFromParent Text
n [(Text, Text)]
aa
  let itemParaStyle' :: Text
itemParaStyle' = case Int
itemParaStyle of
                         Int
0 -> Text
n
                         Int
x -> Text
"P" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
x
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"table:table-cell" [(Text, Text)]
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
itemParaStyle' (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
i)

-- | Convert a list of inline elements to OpenDocument.
inlinesToOpenDocument :: PandocMonad m => WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l = forall a. [Doc a] -> Doc a
hcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks WriterOptions
o [Inline]
l

toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks WriterOptions
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
toChunks WriterOptions
o (Inline
x : [Inline]
xs)
  | Inline -> Bool
isChunkable Inline
x = do
        Doc Text
contents <- (forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
inTextStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
hcat) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                     forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument WriterOptions
o) (Inline
xforall a. a -> [a] -> [a]
:[Inline]
ys)
        [Doc Text]
rest <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks WriterOptions
o [Inline]
zs
        forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
contents forall a. a -> [a] -> [a]
: [Doc Text]
rest)
  | Bool
otherwise     = do
        Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument WriterOptions
o Inline
x
        [Doc Text]
rest <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks WriterOptions
o [Inline]
xs
        forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
contents forall a. a -> [a] -> [a]
: [Doc Text]
rest)
  where ([Inline]
ys, [Inline]
zs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span Inline -> Bool
isChunkable [Inline]
xs

isChunkable :: Inline -> Bool
isChunkable :: Inline -> Bool
isChunkable (Str Text
_)   = Bool
True
isChunkable Inline
Space     = Bool
True
isChunkable Inline
SoftBreak = Bool
True
isChunkable Inline
_         = Bool
False

-- | Convert an inline element to OpenDocument.
inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument WriterOptions
o Inline
ils
  = case Inline
ils of
    Inline
Space         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
    Inline
SoftBreak
     | WriterOptions -> WrapOption
writerWrapText WriterOptions
o forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve
                  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
preformatted Text
"\n"
     | Bool
otherwise  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
    Span Attr
attr [Inline]
xs  -> forall {m :: * -> *}.
PandocMonad m =>
Attr -> [Inline] -> OD m (Doc Text)
mkSpan Attr
attr [Inline]
xs
    Inline
LineBreak     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:line-break" []
    Str         Text
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
handleSpaces forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
s
    Emph        [Inline]
l -> forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Italic forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Underline   [Inline]
l -> forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Under  forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Strong      [Inline]
l -> forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Bold   forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Strikeout   [Inline]
l -> forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Strike forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Superscript [Inline]
l -> forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Sup    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Subscript   [Inline]
l -> forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Sub    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    SmallCaps   [Inline]
l -> forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
SmallC forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Quoted    QuoteType
t [Inline]
l -> QuoteType -> Doc Text -> Doc Text
inQuotes QuoteType
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Code      Attr
attrs Text
s -> if forall a. Maybe a -> Bool
isNothing (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
o)
      then forall {m :: * -> *}. Monad m => Text -> m (Doc Text)
unhighlighted Text
s
      else case forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
o)
                  FormatOptions -> [SourceLine] -> [[Doc Text]]
formatOpenDocument Attr
attrs Text
s of
                Right [[Doc Text]]
h  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[Doc Text]]
h
                Left Text
msg -> do
                  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
                  forall {m :: * -> *}. Monad m => Text -> m (Doc Text)
unhighlighted Text
s
    Math      MathType
t Text
s -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o
    Cite      [Citation]
_ [Inline]
l -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    RawInline Format
f Text
s -> if Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"opendocument"
                       then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
                       else do
                         forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
ils
                         forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
    Link Attr
_ [Inline]
l (Text
s,Text
t) -> do
      [(Text, ReferenceType)]
identTypes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [(Text, ReferenceType)]
stIdentTypes
      WriterOptions
-> [(Text, ReferenceType)] -> Text -> Text -> Doc Text -> Doc Text
mkLink WriterOptions
o [(Text, ReferenceType)]
identTypes Text
s Text
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Image Attr
attr [Inline]
_ (Text
s,Text
t) -> forall {m :: * -> *} {a} {a} {a} {b} {p}.
(MonadState WriterState m, HasChars a, Eq a, IsString a) =>
(a, b, [(a, Text)]) -> Text -> p -> m (Doc a)
mkImg Attr
attr Text
s Text
t
    Note        [Block]
l  -> forall {m :: * -> *}.
PandocMonad m =>
[Block] -> StateT WriterState m (Doc Text)
mkNote [Block]
l
    where
      formatOpenDocument :: FormatOptions -> [SourceLine] -> [[Doc Text]]
      formatOpenDocument :: FormatOptions -> [SourceLine] -> [[Doc Text]]
formatOpenDocument FormatOptions
_fmtOpts = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Token -> Doc Text
toHlTok)
      toHlTok :: Token -> Doc Text
      toHlTok :: Token -> Doc Text
toHlTok (TokenType
toktype,Text
tok) =
        forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:span" [(Text
"text:style-name", String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show TokenType
toktype)] forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
preformatted Text
tok
      unhighlighted :: Text -> m (Doc Text)
unhighlighted Text
s = forall {m :: * -> *} {a}.
(Monad m, HasChars a) =>
Doc a -> m (Doc a)
inlinedCode forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
preformatted Text
s
      preformatted :: Text -> Doc Text
preformatted Text
s = Text -> Doc Text
handleSpaces forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
s
      inlinedCode :: Doc a -> m (Doc a)
inlinedCode Doc a
s = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:span" [(Text
"text:style-name", Text
"Source_Text")] Doc a
s
      mkImg :: (a, b, [(a, Text)]) -> Text -> p -> m (Doc a)
mkImg (a
_, b
_, [(a, Text)]
kvs) Text
s p
_ = do
               Int
id' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stImageId
               forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\WriterState
st -> WriterState
st{ stImageId :: Int
stImageId = Int
id' forall a. Num a => a -> a -> a
+ Int
1 })
               let getDims :: [(a, b)] -> [(a, b)]
getDims [] = []
                   getDims ((a
"width", b
w) :[(a, b)]
xs) = (a
"svg:width", b
w)  forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims ((a
"rel-width", b
w):[(a, b)]
xs) = (a
"style:rel-width", b
w) forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims ((a
"height", b
h):[(a, b)]
xs) = (a
"svg:height", b
h) forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims ((a
"rel-height", b
w):[(a, b)]
xs) = (a
"style:rel-height", b
w) forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims ((a, b)
_:[(a, b)]
xs) =                             [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"draw:frame"
                        ((Text
"draw:name", Text
"img" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
id') forall a. a -> [a] -> [a]
: forall {a} {a} {b}.
(Eq a, IsString a, IsString a) =>
[(a, b)] -> [(a, b)]
getDims [(a, Text)]
kvs) forall a b. (a -> b) -> a -> b
$
                     forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"draw:image" [ (Text
"xlink:href"   , Text
s       )
                                                 , (Text
"xlink:type"   , Text
"simple")
                                                 , (Text
"xlink:show"   , Text
"embed" )
                                                 , (Text
"xlink:actuate", Text
"onLoad")]
      mkSpan :: Attr -> [Inline] -> OD m (Doc Text)
mkSpan Attr
attr [Inline]
xs =  do
        let (Text
ident,[Text]
_,[(Text, Text)]
_) = Attr
attr
            i :: OD m (Doc Text)
i = forall (m :: * -> *) a. PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr Attr
attr (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
xs)
            mkBookmarkedSpan :: Doc Text -> Doc Text
mkBookmarkedSpan Doc Text
b =
              if forall a. Doc a -> Bool
isEmpty Doc Text
b
                then Text -> Doc Text
selfClosingBookmark Text
ident
                else Text -> Doc Text -> Doc Text
inBookmarkTags Text
ident Doc Text
b
        if Text -> Bool
T.null Text
ident
          then OD m (Doc Text)
i
          else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
mkBookmarkedSpan OD m (Doc Text)
i
      mkNote :: [Block] -> StateT WriterState m (Doc Text)
mkNote     [Block]
l = do
        Int
n <- forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stNotes
        let footNote :: Doc a -> Doc a
footNote Doc a
t = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:note"
                         [ (Text
"text:id"        , Text
"ftn" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
n)
                         , (Text
"text:note-class", Text
"footnote"     )] forall a b. (a -> b) -> a -> b
$
                         forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"text:note-citation" (forall a. HasChars a => String -> Doc a
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
n forall a. Num a => a -> a -> a
+ Int
1) forall a. Semigroup a => a -> a -> a
<>
                         forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"text:note-body" Doc a
t
        Doc Text
nn <- forall {a}. HasChars a => Doc a -> Doc a
footNote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
"Footnote" [Block]
l
        forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addNote Doc Text
nn
        forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
nn

mkLink :: WriterOptions -> [(Text,ReferenceType)] -> Text -> Text -> Doc Text -> Doc Text
mkLink :: WriterOptions
-> [(Text, ReferenceType)] -> Text -> Text -> Doc Text -> Doc Text
mkLink WriterOptions
o [(Text, ReferenceType)]
identTypes Text
s Text
t Doc Text
d =
  let maybeIdentAndType :: Maybe (Text, ReferenceType)
maybeIdentAndType = case Text -> Maybe (Char, Text)
T.uncons Text
s of
                            Just (Char
'#', Text
ident) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text
ident forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, ReferenceType)]
identTypes
                            Maybe (Char, Text)
_                 -> forall a. Maybe a
Nothing
      d' :: Doc Text
d' = Text -> Doc Text -> Doc Text
inSpanTags Text
"Definition" Doc Text
d
      ref :: Text -> Text -> Text -> Doc a -> Doc a
ref Text
refType Text
format Text
ident       = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
refType
                                       [ (Text
"text:reference-format", Text
format ),
                                         (Text
"text:ref-name", Text
ident) ]
      inlineSpace :: Doc Text
inlineSpace                    = forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:s" []
      bookmarkRef :: Text -> Text -> Doc Text -> Doc Text
bookmarkRef                    = forall {a}. HasChars a => Text -> Text -> Text -> Doc a -> Doc a
ref Text
"text:bookmark-ref"
      bookmarkRefNumber :: Text -> Doc Text
bookmarkRefNumber Text
ident        = Text -> Text -> Doc Text -> Doc Text
bookmarkRef Text
"number" Text
ident forall a. Monoid a => a
mempty
      bookmarkRefName :: Text -> Doc Text
bookmarkRefName Text
ident          = Text -> Text -> Doc Text -> Doc Text
bookmarkRef Text
"text" Text
ident Doc Text
d
      bookmarkRefNameNumber :: Text -> Doc Text
bookmarkRefNameNumber Text
ident    = Text -> Doc Text
bookmarkRefNumber Text
ident forall a. Semigroup a => a -> a -> a
<> Doc Text
inlineSpace forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
bookmarkRefName Text
ident
      bookmarkRef' :: Text -> Doc Text
bookmarkRef'
        | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_number WriterOptions
o Bool -> Bool -> Bool
&& forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_name WriterOptions
o = Text -> Doc Text
bookmarkRefNameNumber
        | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_name WriterOptions
o                                 = Text -> Doc Text
bookmarkRefName
        | Bool
otherwise                                                  = Text -> Doc Text
bookmarkRefNumber
      sequenceRef :: Text -> Text -> Doc Text -> Doc Text
sequenceRef                    = forall {a}. HasChars a => Text -> Text -> Text -> Doc a -> Doc a
ref Text
"text:sequence-ref"
      sequenceRefNumber :: Text -> Doc Text
sequenceRefNumber Text
ident        = Text -> Text -> Doc Text -> Doc Text
sequenceRef Text
"value" Text
ident forall a. Monoid a => a
mempty
      sequenceRefName :: Text -> Doc Text
sequenceRefName Text
ident          = Text -> Text -> Doc Text -> Doc Text
sequenceRef Text
"caption" Text
ident Doc Text
d
      sequenceRefNameNumber :: Text -> Doc Text
sequenceRefNameNumber Text
ident    = Text -> Doc Text
sequenceRefNumber Text
ident forall a. Semigroup a => a -> a -> a
<> Doc Text
inlineSpace forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
sequenceRefName Text
ident
      sequenceRef' :: Text -> Doc Text
sequenceRef'
        | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_number WriterOptions
o Bool -> Bool -> Bool
&& forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_name WriterOptions
o = Text -> Doc Text
sequenceRefNameNumber
        | forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_name WriterOptions
o                                 = Text -> Doc Text
sequenceRefName
        | Bool
otherwise                                                  = Text -> Doc Text
sequenceRefNumber
      link :: Doc Text
link = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"text:a" [ (Text
"xlink:type" , Text
"simple")
                                          , (Text
"xlink:href" , Text
s       )
                                          , (Text
"office:name", Text
t       )
                                          ] Doc Text
d'
      linkOrReference :: Doc Text
linkOrReference = case Maybe (Text, ReferenceType)
maybeIdentAndType of
                          Just (Text
ident, ReferenceType
HeaderRef) -> Text -> Doc Text
bookmarkRef' Text
ident
                          Just (Text
ident, ReferenceType
TableRef)  -> Text -> Doc Text
sequenceRef' Text
ident
                          Just (Text
ident, ReferenceType
ImageRef)  -> Text -> Doc Text
sequenceRef' Text
ident
                          Maybe (Text, ReferenceType)
_                       -> Doc Text
link
      in if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_name WriterOptions
o Bool -> Bool -> Bool
|| forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_number WriterOptions
o
            then Doc Text
linkOrReference
            else Doc Text
link

bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc Text]))
bulletListStyle :: forall (m :: * -> *).
PandocMonad m =>
Int -> OD m (Int, (Int, [Doc Text]))
bulletListStyle Int
l = do
  let doStyles :: Int -> Doc Text
doStyles  Int
i = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"text:list-level-style-bullet"
                    [ (Text
"text:level"      , forall a. Show a => a -> Text
tshow (Int
i forall a. Num a => a -> a -> a
+ Int
1))
                    , (Text
"text:style-name" , Text
"Bullet_20_Symbols"  )
                    , (Text
"style:num-suffix", Text
"."                  )
                    , (Text
"text:bullet-char", Char -> Text
T.singleton (String
bulletList forall a. [a] -> Int -> a
!! Int
i))
                    ] (Int -> Doc Text
listLevelStyle (Int
1 forall a. Num a => a -> a -> a
+ Int
i))
      bulletList :: String
bulletList  = forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Int
8226,Int
9702,Int
9642]
      listElStyle :: [Doc Text]
listElStyle = forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc Text
doStyles [Int
0..Int
9]
  Int
pn <- forall (m :: * -> *). PandocMonad m => Int -> OD m Int
paraListStyle Int
l
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
pn, (Int
l, [Doc Text]
listElStyle))

orderedListLevelStyle :: ListAttributes -> (Int, [Doc Text]) -> (Int,[Doc Text])
orderedListLevelStyle :: ListAttributes -> (Int, [Doc Text]) -> (Int, [Doc Text])
orderedListLevelStyle (Int
s,ListNumberStyle
n, ListNumberDelim
d) (Int
l,[Doc Text]
ls) =
    let suffix :: [(Text, Text)]
suffix    = case ListNumberDelim
d of
                      ListNumberDelim
OneParen  -> [(Text
"style:num-suffix", Text
")")]
                      ListNumberDelim
TwoParens -> [(Text
"style:num-prefix", Text
"(")
                                   ,(Text
"style:num-suffix", Text
")")]
                      ListNumberDelim
_         -> [(Text
"style:num-suffix", Text
".")]
        format :: Text
format    = case ListNumberStyle
n of
                      ListNumberStyle
UpperAlpha -> Text
"A"
                      ListNumberStyle
LowerAlpha -> Text
"a"
                      ListNumberStyle
UpperRoman -> Text
"I"
                      ListNumberStyle
LowerRoman -> Text
"i"
                      ListNumberStyle
_          -> Text
"1"
        listStyle :: Doc Text
listStyle = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"text:list-level-style-number"
                    ([ (Text
"text:level"      , forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
ls )
                     , (Text
"text:style-name" , Text
"Numbering_20_Symbols")
                     , (Text
"style:num-format", Text
format                )
                     , (Text
"text:start-value", forall a. Show a => a -> Text
tshow Int
s               )
                     ] forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
suffix) (Int -> Doc Text
listLevelStyle (Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
ls))
    in  (Int
l, [Doc Text]
ls forall a. [a] -> [a] -> [a]
++ [Doc Text
listStyle])

listLevelStyle :: Int -> Doc Text
listLevelStyle :: Int -> Doc Text
listLevelStyle Int
i =
    let indent :: Text
indent = forall a. Show a => a -> Text
tshow (Double
0.25 forall a. Num a => a -> a -> a
+ (Double
0.25 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Double)) in
    forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"style:list-level-properties"
                       [ (Text
"text:list-level-position-and-space-mode",
                          Text
"label-alignment")
                       , (Text
"fo:text-align", Text
"right")
                       ] forall a b. (a -> b) -> a -> b
$
       forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:list-level-label-alignment"
                      [ (Text
"text:label-followed-by", Text
"listtab")
                      , (Text
"text:list-tab-stop-position", Text
indent forall a. Semigroup a => a -> a -> a
<> Text
"in")
                      , (Text
"fo:text-indent", Text
"-0.25in")
                      , (Text
"fo:margin-left", Text
indent forall a. Semigroup a => a -> a -> a
<> Text
"in")
                      ]

tableStyle :: Int -> Double -> [(Char,Double)] -> Doc Text
tableStyle :: Int -> Double -> [(Char, Double)] -> Doc Text
tableStyle Int
num Double
textWidth [(Char, Double)]
wcs =
    let tableId :: Text
tableId        = Text
"Table" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (Int
num forall a. Num a => a -> a -> a
+ Int
1)
        tableWidthAttr :: [(Text,Text)]
        tableWidthAttr :: [(Text, Text)]
tableWidthAttr
          | Double
textWidth forall a. Ord a => a -> a -> Bool
<= Double
1 Bool -> Bool -> Bool
&& Double
textWidth forall a. Ord a => a -> a -> Bool
> Double
0 = [(Text
"style:rel-width",
                                                String -> Text
T.pack (forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
round (Double
textWidth forall a. Num a => a -> a -> a
* Double
100) :: Int) forall a. Semigroup a => a -> a -> a
<> String
"%"))]
          | Bool
otherwise    = []
        table :: Doc Text
table          = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"style:style"
                         [(Text
"style:name", Text
tableId)
                         ,(Text
"style:family", Text
"table")] forall a b. (a -> b) -> a -> b
$
                         forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:table-properties"
                         ((Text
"table:align", Text
"center") forall a. a -> [a] -> [a]
: [(Text, Text)]
tableWidthAttr)
        colStyle :: (Char, a) -> Doc a
colStyle (Char
c,a
0) = forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:style"
                         [ (Text
"style:name"  , Text
tableId forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c)
                         , (Text
"style:family", Text
"table-column"       )]
        colStyle (Char
c,a
w) = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"style:style"
                         [ (Text
"style:name"  , Text
tableId forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c)
                         , (Text
"style:family", Text
"table-column"       )] forall a b. (a -> b) -> a -> b
$
                         forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:table-column-properties"
                         [(Text
"style:rel-column-width", String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%d*" (forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
* a
65535 :: Integer))]
        headerRowCellStyle :: Doc Text
headerRowCellStyle = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"style:style"
                         [ (Text
"style:name"  , Text
"TableHeaderRowCell")
                         , (Text
"style:family", Text
"table-cell"    )] forall a b. (a -> b) -> a -> b
$
                         forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:table-cell-properties"
                         [ (Text
"fo:border", Text
"none")]
        rowCellStyle :: Doc Text
rowCellStyle = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"style:style"
                         [ (Text
"style:name"  , Text
"TableRowCell")
                         , (Text
"style:family", Text
"table-cell"    )] forall a b. (a -> b) -> a -> b
$
                         forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:table-cell-properties"
                         [ (Text
"fo:border", Text
"none")]
        cellStyles :: Doc Text
cellStyles = if Int
num forall a. Eq a => a -> a -> Bool
== Int
0
                     then Doc Text
headerRowCellStyle forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
rowCellStyle
                     else forall a. Doc a
empty
        columnStyles :: [Doc Text]
columnStyles   = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (HasChars a, RealFrac a) => (Char, a) -> Doc a
colStyle [(Char, Double)]
wcs
    in Doc Text
cellStyles forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
table forall a. Doc a -> Doc a -> Doc a
$$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
columnStyles

paraStyle :: PandocMonad m => [(Text,Text)] -> OD m Int
paraStyle :: forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Int
paraStyle [(Text, Text)]
attrs = do
  Int
pn <- forall a. Num a => a -> a -> a
(+)   Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stParaStyles
  Double
i  <- forall a. Num a => a -> a -> a
(*) (Double
0.5 :: Double) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stIndentPara
  Bool
b  <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInDefinition
  Bool
t  <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stTight
  let styleAttr :: [(Text, Text)]
styleAttr = [ (Text
"style:name"             , Text
"P" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
pn)
                  , (Text
"style:family"           , Text
"paragraph"   )]
      indentVal :: Text
indentVal = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Semigroup a => a -> a -> a
(<>) Text
"in" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ if Bool
b then forall a. Ord a => a -> a -> a
max Double
0.5 Double
i else Double
i
      tight :: [(Text, Text)]
tight     = if Bool
t then [ (Text
"fo:margin-top"          , Text
"0in"    )
                            , (Text
"fo:margin-bottom"       , Text
"0in"    )]
                       else []
      indent :: [(Text, Text)]
indent    = if Double
i forall a. Eq a => a -> a -> Bool
/= Double
0 Bool -> Bool -> Bool
|| Bool
b
                      then [ (Text
"fo:margin-left"         , Text
indentVal)
                           , (Text
"fo:margin-right"        , Text
"0in"    )
                           , (Text
"fo:text-indent"         , Text
"0in"    )
                           , (Text
"style:auto-text-indent" , Text
"false"  )]
                      else []
      attributes :: [(Text, Text)]
attributes = [(Text, Text)]
indent forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
tight
      paraProps :: Doc Text
paraProps = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
attributes
                     then forall a. Monoid a => a
mempty
                     else forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag
                             Text
"style:paragraph-properties" [(Text, Text)]
attributes
  forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addParaStyle forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"style:style" ([(Text, Text)]
styleAttr forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
attrs) Doc Text
paraProps
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
pn

paraStyleFromParent :: PandocMonad m => Text -> [(Text,Text)] -> OD m Int
paraStyleFromParent :: forall (m :: * -> *).
PandocMonad m =>
Text -> [(Text, Text)] -> OD m Int
paraStyleFromParent Text
parent [(Text, Text)]
attrs = do
  Int
pn <- forall a. Num a => a -> a -> a
(+) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stParaStyles
  let styleAttr :: [(Text, Text)]
styleAttr = [ (Text
"style:name"             , Text
"P" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
pn)
                  , (Text
"style:family"           , Text
"paragraph")
                  , (Text
"style:parent-style-name", Text
parent)]
      paraProps :: Doc Text
paraProps = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
attrs
                     then forall a. Monoid a => a
mempty
                     else forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag
                          Text
"style:paragraph-properties" [(Text, Text)]
attrs
  forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addParaStyle forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"style:style" [(Text, Text)]
styleAttr Doc Text
paraProps
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
pn


paraListStyle :: PandocMonad m => Int -> OD m Int
paraListStyle :: forall (m :: * -> *). PandocMonad m => Int -> OD m Int
paraListStyle Int
l = forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Int
paraStyle
  [(Text
"style:parent-style-name",Text
"Text_20_body")
  ,(Text
"style:list-style-name", Text
"L" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
l)]

paraTableStyles :: Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles :: Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles Text
_ Int
_ [] = []
paraTableStyles Text
t Int
s (Alignment
a:[Alignment]
xs)
    | Alignment
AlignRight  <- Alignment
a = (         forall {a}. (Show a, Num a) => a -> Text
pName Int
s, forall {a} {a}. (HasChars a, Num a, Show a) => a -> Text -> Doc a
res Int
s Text
"end"   ) forall a. a -> [a] -> [a]
: Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles Text
t (Int
s forall a. Num a => a -> a -> a
+ Int
1) [Alignment]
xs
    | Alignment
AlignCenter <- Alignment
a = (         forall {a}. (Show a, Num a) => a -> Text
pName Int
s, forall {a} {a}. (HasChars a, Num a, Show a) => a -> Text -> Doc a
res Int
s Text
"center") forall a. a -> [a] -> [a]
: Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles Text
t (Int
s forall a. Num a => a -> a -> a
+ Int
1) [Alignment]
xs
    | Bool
otherwise        = (Text
"Table_20_" forall a. Semigroup a => a -> a -> a
<> Text
t, forall a. Doc a
empty         ) forall a. a -> [a] -> [a]
: Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles Text
t  Int
s      [Alignment]
xs
    where pName :: a -> Text
pName a
sn = Text
"P" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (a
sn forall a. Num a => a -> a -> a
+ a
1)
          res :: a -> Text -> Doc a
res a
sn Text
x = forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"style:style"
                     [ (Text
"style:name"             , forall {a}. (Show a, Num a) => a -> Text
pName a
sn        )
                     , (Text
"style:family"           , Text
"paragraph"     )
                     , (Text
"style:parent-style-name", Text
"Table_20_" forall a. Semigroup a => a -> a -> a
<> Text
t)] forall a b. (a -> b) -> a -> b
$
                     forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:paragraph-properties"
                     [ (Text
"fo:text-align", Text
x)
                     , (Text
"style:justify-single-word", Text
"false")]

data TextStyle = Italic
               | Bold
               | Under
               | Strike
               | Sub
               | Sup
               | SmallC
               | Pre
               | Language Lang
               deriving ( TextStyle -> TextStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextStyle -> TextStyle -> Bool
$c/= :: TextStyle -> TextStyle -> Bool
== :: TextStyle -> TextStyle -> Bool
$c== :: TextStyle -> TextStyle -> Bool
Eq,Eq TextStyle
TextStyle -> TextStyle -> Bool
TextStyle -> TextStyle -> Ordering
TextStyle -> TextStyle -> TextStyle
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 :: TextStyle -> TextStyle -> TextStyle
$cmin :: TextStyle -> TextStyle -> TextStyle
max :: TextStyle -> TextStyle -> TextStyle
$cmax :: TextStyle -> TextStyle -> TextStyle
>= :: TextStyle -> TextStyle -> Bool
$c>= :: TextStyle -> TextStyle -> Bool
> :: TextStyle -> TextStyle -> Bool
$c> :: TextStyle -> TextStyle -> Bool
<= :: TextStyle -> TextStyle -> Bool
$c<= :: TextStyle -> TextStyle -> Bool
< :: TextStyle -> TextStyle -> Bool
$c< :: TextStyle -> TextStyle -> Bool
compare :: TextStyle -> TextStyle -> Ordering
$ccompare :: TextStyle -> TextStyle -> Ordering
Ord )

textStyleAttr :: Map.Map Text Text
              -> TextStyle
              -> Map.Map Text Text
textStyleAttr :: Map Text Text -> TextStyle -> Map Text Text
textStyleAttr Map Text Text
m = \case
  TextStyle
Italic -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"fo:font-style" Text
"italic" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:font-style-asian" Text
"italic" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:font-style-complex" Text
"italic" forall a b. (a -> b) -> a -> b
$ Map Text Text
m
  TextStyle
Bold   -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"fo:font-weight" Text
"bold" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:font-weight-asian" Text
"bold" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:font-weight-complex" Text
"bold" forall a b. (a -> b) -> a -> b
$ Map Text Text
m
  TextStyle
Under  -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:text-underline-style" Text
"solid" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:text-underline-width" Text
"auto" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:text-underline-color" Text
"font-color" forall a b. (a -> b) -> a -> b
$ Map Text Text
m
  TextStyle
Strike -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:text-line-through-style" Text
"solid" Map Text Text
m
  TextStyle
Sub    -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:text-position" Text
"sub 58%" Map Text Text
m
  TextStyle
Sup    -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:text-position" Text
"super 58%" Map Text Text
m
  TextStyle
SmallC -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"fo:font-variant" Text
"small-caps" Map Text Text
m
  TextStyle
Pre    -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:font-name" Text
"Courier New" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:font-name-asian" Text
"Courier New" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"style:font-name-complex" Text
"Courier New" forall a b. (a -> b) -> a -> b
$ Map Text Text
m
  Language Lang
lang ->
            forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"fo:language" (Lang -> Text
langLanguage Lang
lang) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"fo:country") (Lang -> Maybe Text
langRegion Lang
lang) forall a b. (a -> b) -> a -> b
$ Map Text Text
m

withLangFromAttr :: PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr :: forall (m :: * -> *) a. PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr (Text
_,[Text]
_,[(Text, Text)]
kvs) OD m a
action =
  case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs of
       Maybe Text
Nothing -> OD m a
action
       Just Text
l  ->
         case Text -> Either String Lang
parseLang Text
l of
              Right Lang
lang -> forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle (Lang -> TextStyle
Language Lang
lang) OD m a
action
              Left String
_ -> do
                forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
InvalidLang Text
l
                OD m a
action