{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.OpenDocument
   Copyright   : Copyright (C) 2008-2019 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 Prelude
import Control.Arrow ((***), (>>>))
import Control.Monad.State.Strict hiding (when)
import Data.Char (chr)
import Data.List (sortBy, foldl')
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.BCP47 (Lang (..), parseBCP47)
import Text.Pandoc.Class (PandocMonad, report, translateTerm,
                          setTranslations, toLang)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared (linesToPara, tshow)
import Text.Pandoc.Templates (renderTemplate)
import qualified Text.Pandoc.Translations as Term (Term(Figure, Table))
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
import Text.Printf (printf)

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

--
-- OpenDocument writer
--

type OD m = StateT WriterState m

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
                }

defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState =
    WriterState :: [Doc Text]
-> [Doc Text]
-> [Doc Text]
-> [(Int, [Doc Text])]
-> Map (Set TextStyle) (Text, Doc Text)
-> Set TextStyle
-> Int
-> Bool
-> Bool
-> Bool
-> Int
-> Int
-> Int
-> WriterState
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     = Map (Set TextStyle) (Text, Doc Text)
forall k a. Map k a
Map.empty
                , stTextStyleAttr :: Set TextStyle
stTextStyleAttr  = Set TextStyle
forall a. Set a
Set.empty
                , stIndentPara :: Int
stIndentPara     = 0
                , stInDefinition :: Bool
stInDefinition   = Bool
False
                , stTight :: Bool
stTight          = Bool
False
                , stFirstPara :: Bool
stFirstPara      = Bool
False
                , stImageId :: Int
stImageId        = 1
                , stTableCaptionId :: Int
stTableCaptionId = 1
                , stImageCaptionId :: Int
stImageCaptionId = 1
                }

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

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

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

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

addTextStyle :: PandocMonad m
             => Set.Set TextStyle -> (Text, Doc Text) -> OD m ()
addTextStyle :: Set TextStyle -> (Text, Doc Text) -> OD m ()
addTextStyle attrs :: Set TextStyle
attrs i :: (Text, Doc Text)
i = (WriterState -> WriterState) -> OD m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> OD m ())
-> (WriterState -> WriterState) -> OD m ()
forall a b. (a -> b) -> a -> b
$ \s :: WriterState
s ->
  WriterState
s { stTextStyles :: Map (Set TextStyle) (Text, Doc Text)
stTextStyles = Set TextStyle
-> (Text, Doc Text)
-> Map (Set TextStyle) (Text, Doc Text)
-> Map (Set TextStyle) (Text, Doc Text)
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 :: TextStyle -> OD m ()
addTextStyleAttr t :: TextStyle
t = (WriterState -> WriterState) -> OD m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> OD m ())
-> (WriterState -> WriterState) -> OD m ()
forall a b. (a -> b) -> a -> b
$ \s :: WriterState
s ->
  WriterState
s { stTextStyleAttr :: Set TextStyle
stTextStyleAttr = TextStyle -> Set TextStyle -> Set TextStyle
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 :: OD m ()
increaseIndent = (WriterState -> WriterState) -> OD m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> OD m ())
-> (WriterState -> WriterState) -> OD m ()
forall a b. (a -> b) -> a -> b
$ \s :: WriterState
s -> WriterState
s { stIndentPara :: Int
stIndentPara = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WriterState -> Int
stIndentPara WriterState
s }

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

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

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

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

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

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

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

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

inTextStyle :: PandocMonad m => Doc Text -> OD m (Doc Text)
inTextStyle :: Doc Text -> OD m (Doc Text)
inTextStyle d :: Doc Text
d = do
  Set TextStyle
at <- (WriterState -> Set TextStyle)
-> StateT WriterState m (Set TextStyle)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Set TextStyle
stTextStyleAttr
  if Set TextStyle -> Bool
forall a. Set a -> Bool
Set.null Set TextStyle
at
     then Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
d
     else do
       Map (Set TextStyle) (Text, Doc Text)
styles <- (WriterState -> Map (Set TextStyle) (Text, Doc Text))
-> StateT WriterState m (Map (Set TextStyle) (Text, Doc Text))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map (Set TextStyle) (Text, Doc Text)
stTextStyles
       case Set TextStyle
-> Map (Set TextStyle) (Text, Doc Text) -> Maybe (Text, Doc Text)
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 (styleName :: Text
styleName, _) -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
              Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False "text:span" [("text:style-name",Text
styleName)] Doc Text
d
            Nothing -> do
              let styleName :: Text
styleName = "T" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Map (Set TextStyle) (Text, Doc Text) -> Int
forall k a. Map k a -> Int
Map.size Map (Set TextStyle) (Text, Doc Text)
styles Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
              Set TextStyle -> (Text, Doc Text) -> OD m ()
forall (m :: * -> *).
PandocMonad m =>
Set TextStyle -> (Text, Doc Text) -> OD m ()
addTextStyle Set TextStyle
at (Text
styleName,
                     Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False "style:style"
                       [("style:name", Text
styleName)
                       ,("style:family", "text")]
                       (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "style:text-properties"
                          (((Text, Text) -> (Text, Text) -> Ordering)
-> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Text, Text) -> Text) -> (Text, Text) -> (Text, Text) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Text, Text) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Text)] -> [(Text, Text)])
-> (Map Text Text -> [(Text, Text)])
-> Map Text Text
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList
                                (Map Text Text -> [(Text, Text)])
-> Map Text Text -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Map Text Text -> TextStyle -> Map Text Text)
-> Map Text Text -> [TextStyle] -> Map Text Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Text Text -> TextStyle -> Map Text Text
textStyleAttr Map Text Text
forall a. Monoid a => a
mempty (Set TextStyle -> [TextStyle]
forall a. Set a -> [a]
Set.toList Set TextStyle
at)))
              Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False
                  "text:span" [("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 mt :: MathType
mt = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False "style:style"
  [("style:name", if MathType
mt MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
InlineMath then "fr1" else "fr2")
  ,("style:family", "graphic")
  ,("style:parent-style-name", "Formula")]
  (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "style:graphic-properties" ([(Text, Text)] -> Doc Text) -> [(Text, Text)] -> Doc Text
forall a b. (a -> b) -> a -> b
$ if MathType
mt MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
InlineMath then
                                                  [("style:vertical-pos", "middle")
                                                  ,("style:vertical-rel", "text")]
                                                else
                                                  [("style:vertical-pos",   "middle")
                                                  ,("style:vertical-rel",   "paragraph-content")
                                                  ,("style:horizontal-pos", "center")
                                                  ,("style:horizontal-rel", "paragraph-content")
                                                  ,("style:wrap",           "none")]

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

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

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

-- | Convert Pandoc document to string in OpenDocument format.
writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeOpenDocument :: WriterOptions -> Pandoc -> m Text
writeOpenDocument opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
  let defLang :: Lang
defLang = Text -> Text -> Text -> [Text] -> Lang
Lang "en" "US" "" []
  Lang
lang <- case Text -> Meta -> Text
lookupMetaString "lang" Meta
meta of
            "" -> Lang -> m Lang
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lang
defLang
            s :: Text
s  -> Lang -> Maybe Lang -> Lang
forall a. a -> Maybe a -> a
fromMaybe Lang
defLang (Maybe Lang -> Lang) -> m (Maybe Lang) -> m Lang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s)
  Lang -> m ()
forall (m :: * -> *). PandocMonad m => Lang -> m ()
setTranslations Lang
lang
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Maybe Int
forall a. Maybe a
Nothing
  ((body :: Doc Text
body, metadata :: Context Text
metadata),s :: WriterState
s) <- (StateT WriterState m (Doc Text, Context Text)
 -> WriterState -> m ((Doc Text, Context Text), WriterState))
-> WriterState
-> StateT WriterState m (Doc Text, Context Text)
-> m ((Doc Text, Context Text), WriterState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT WriterState m (Doc Text, Context Text)
-> WriterState -> m ((Doc Text, Context Text), WriterState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
        WriterState
defaultWriterState (StateT WriterState m (Doc Text, Context Text)
 -> m ((Doc Text, Context Text), WriterState))
-> StateT WriterState m (Doc Text, Context Text)
-> m ((Doc Text, Context Text), WriterState)
forall a b. (a -> b) -> a -> b
$ do
           Context Text
m <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
                  (WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument WriterOptions
opts)
                  ((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
opts)
                  Meta
meta
           Doc Text
b <- WriterOptions -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument WriterOptions
opts [Block]
blocks
           (Doc Text, Context Text)
-> StateT WriterState m (Doc Text, Context Text)
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 [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ WriterState -> [Doc Text]
stParaStyles WriterState
s [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Doc Text]
formulaStyles [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++
                     ((Text, Doc Text) -> Doc Text) -> [(Text, Doc Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Doc Text) -> Doc Text
forall a b. (a, b) -> b
snd (((Text, Doc Text) -> (Text, Doc Text) -> Ordering)
-> [(Text, Doc Text)] -> [(Text, Doc Text)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Text, Doc Text) -> (Text, Doc Text) -> Ordering)
-> (Text, Doc Text) -> (Text, Doc Text) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Text, Doc Text) -> Text)
-> (Text, Doc Text) -> (Text, Doc Text) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Text, Doc Text) -> Text
forall a b. (a, b) -> a
fst)) (
                        Map (Set TextStyle) (Text, Doc Text) -> [(Text, Doc Text)]
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 (n :: a
n,l :: [Doc a]
l) = Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True "text:list-style"
                          [("style:name", "L" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
n)] ([Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vcat [Doc a]
l)
  let listStyles :: [Doc Text]
listStyles  = ((Int, [Doc Text]) -> Doc Text)
-> [(Int, [Doc Text])] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Doc Text]) -> Doc Text
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 = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> [Doc Text]
forall a. [a] -> [a]
reverse ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ [Doc Text]
styles [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Doc Text]
listStyles
  let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "body" Doc Text
body
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "automatic-styles" Doc Text
automaticStyles
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Nothing  -> Doc Text
body
       Just tpl :: Template Text
tpl -> Template Text -> Context Text -> Doc Text
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 :: WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle  o :: WriterOptions
o s :: Text
s (b :: Block
b:bs :: [Block]
bs)
    | Para l :: [Inline]
l <- Block
b = Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> StateT WriterState m (Doc Text)
go (Doc Text -> OD m (Doc Text)) -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle Text
s (Doc Text -> Doc Text) -> OD m (Doc Text) -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    | Bool
otherwise   = Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> StateT WriterState m (Doc Text)
go (Doc Text -> OD m (Doc Text)) -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WriterOptions -> Block -> OD m (Doc Text)
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 i :: Doc Text
i = Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
(<>) Doc Text
i (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  WriterOptions -> Text -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
s [Block]
bs
withParagraphStyle _ _ [] = Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty

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

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

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

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

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

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

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

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

-- | Convert a list of Pandoc blocks to OpenDocument.
blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument :: WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument o :: WriterOptions
o b :: [Block]
b = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> OD m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> OD m (Doc Text)
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 :: WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument o :: WriterOptions
o bs :: Block
bs
    | Plain          b :: [Inline]
b <- Block
bs = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
b
                                  then Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                                  else Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> StateT WriterState m (Doc Text)
inParagraphTags (Doc Text -> OD m (Doc Text)) -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
b
    | Para [Image attr :: Attr
attr c :: [Inline]
c (s :: Text
s,Text -> Text -> Maybe Text
T.stripPrefix "fig:" -> Just t :: Text
t)] <- Block
bs
                             = Attr -> [Inline] -> Text -> Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Text -> Text -> OD m (Doc Text)
figure Attr
attr [Inline]
c Text
s Text
t
    | Para           b :: [Inline]
b <- Block
bs = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
b Bool -> Bool -> Bool
&&
                                    Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_empty_paragraphs WriterOptions
o)
                                  then Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                                  else Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> StateT WriterState m (Doc Text)
inParagraphTags (Doc Text -> OD m (Doc Text)) -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
b
    | LineBlock      b :: [[Inline]]
b <- Block
bs = WriterOptions -> Block -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument WriterOptions
o (Block -> OD m (Doc Text)) -> Block -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
b
    | Div attr :: Attr
attr xs :: [Block]
xs      <- Block
bs = Attr -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a. PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr Attr
attr
                                  (WriterOptions -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument WriterOptions
o [Block]
xs)
    | Header     i :: Int
i (ident :: Text
ident,_,_) b :: [Inline]
b
                       <- Block
bs = OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> Text -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Int -> Text -> Doc Text -> OD m (Doc Text)
inHeaderTags Int
i Text
ident
                                  (Doc Text -> OD m (Doc Text)) -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
b)
    | BlockQuote     b :: [Block]
b <- Block
bs = OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT WriterState m (Doc Text)
mkBlockQuote [Block]
b
    | DefinitionList b :: [([Inline], [[Block]])]
b <- Block
bs = OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [([Inline], [[Block]])] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[([Inline], [[Block]])] -> StateT WriterState m (Doc Text)
defList [([Inline], [[Block]])]
b
    | BulletList     b :: [[Block]]
b <- Block
bs = OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterOptions -> [[Block]] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> OD m (Doc Text)
bulletListToOpenDocument WriterOptions
o [[Block]]
b
    | OrderedList  a :: ListAttributes
a b :: [[Block]]
b <- Block
bs = OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ListAttributes -> [[Block]] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> StateT WriterState m (Doc Text)
orderedList ListAttributes
a [[Block]]
b
    | CodeBlock    _ s :: Text
s <- Block
bs = OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> StateT WriterState m (Doc Text)
preformatted Text
s
    | Table  c :: [Inline]
c a :: [Alignment]
a w :: [Double]
w h :: [[Block]]
h r :: [[[Block]]]
r <- Block
bs = OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Inline]
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Inline]
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> StateT WriterState m (Doc Text)
table [Inline]
c [Alignment]
a [Double]
w [[Block]]
h [[[Block]]]
r
    | Block
HorizontalRule   <- Block
bs = OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "text:p"
                                [ ("text:style-name", "Horizontal_20_Line") ])
    | RawBlock f :: Format
f     s :: Text
s <- Block
bs = if Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "opendocument"
                                  then Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
                                  else do
                                    LogMessage -> OD m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> OD m ()) -> LogMessage -> OD m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
bs
                                    Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
    | Block
Null             <- Block
bs = Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
    | Bool
otherwise              = Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
    where
      defList :: [([Inline], [[Block]])] -> StateT WriterState m (Doc Text)
defList       b :: [([Inline], [[Block]])]
b = do Bool -> OD m ()
forall (m :: * -> *). PandocMonad m => Bool -> OD m ()
setInDefinitionList Bool
True
                           Doc Text
r <- [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat  ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]]) -> StateT WriterState m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions
-> ([Inline], [[Block]]) -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> OD m (Doc Text)
deflistItemToOpenDocument WriterOptions
o) [([Inline], [[Block]])]
b
                           Bool -> OD m ()
forall (m :: * -> *). PandocMonad m => Bool -> OD m ()
setInDefinitionList Bool
False
                           Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
r
      preformatted :: Text -> StateT WriterState m (Doc Text)
preformatted  s :: Text
s = (Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat) ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> StateT WriterState m (Doc Text))
-> [Text] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> StateT WriterState m (Doc Text)
inPreformattedTags (Text -> StateT WriterState m (Doc Text))
-> (Text -> Text) -> Text -> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeStringForXML) (Text -> [Text]
T.lines Text
s)
      mkBlockQuote :: [Block] -> StateT WriterState m (Doc Text)
mkBlockQuote  b :: [Block]
b = do OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
increaseIndent
                           Int
i <- [(Text, Text)] -> OD m Int
forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Int
paraStyle
                                 [("style:parent-style-name","Quotations")]
                           WriterOptions -> Int -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> OD m (Doc Text)
inBlockQuote WriterOptions
o Int
i ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
b)
      orderedList :: ListAttributes -> [[Block]] -> StateT WriterState m (Doc Text)
orderedList a :: ListAttributes
a b :: [[Block]]
b = do (ln :: Int
ln,pn :: Int
pn) <- Bool -> ListAttributes -> OD m (Int, Int)
forall (m :: * -> *).
PandocMonad m =>
Bool -> ListAttributes -> OD m (Int, Int)
newOrderedListStyle ([[Block]] -> Bool
isTightList [[Block]]
b) ListAttributes
a
                           Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True "text:list" [ ("text:style-name", "L" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
ln)]
                                      (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> Int -> [[Block]] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [[Block]] -> OD m (Doc Text)
orderedListToOpenDocument WriterOptions
o Int
pn [[Block]]
b
      table :: [Inline]
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> StateT WriterState m (Doc Text)
table c :: [Inline]
c a :: [Alignment]
a w :: [Double]
w h :: [[Block]]
h r :: [[[Block]]]
r = do
        Int
tn <- [Doc Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Doc Text] -> Int)
-> StateT WriterState m [Doc Text] -> StateT WriterState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stTableStyles
        Int
pn <- [Doc Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Doc Text] -> Int)
-> StateT WriterState m [Doc Text] -> StateT WriterState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stParaStyles
        let  genIds :: String
genIds      = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr [65..]
             name :: Text
name        = "Table" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
tn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
             columnIds :: [(Char, Double)]
columnIds   = String -> [Double] -> [(Char, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
genIds [Double]
w
             mkColumn :: (Char, b) -> Doc a
mkColumn  n :: (Char, b)
n = Text -> [(Text, Text)] -> Doc a
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "table:table-column" [("table:style-name", Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton ((Char, b) -> Char
forall a b. (a, b) -> a
fst (Char, b)
n))]
             columns :: [Doc Text]
columns     = ((Char, Double) -> Doc Text) -> [(Char, Double)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Double) -> Doc Text
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 "Heading"  Int
pn [Alignment]
a
             paraStyles :: [(Text, Doc Text)]
paraStyles  = Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles "Contents" (Int
pn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Doc Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Text, Doc Text)] -> [Doc Text]
forall a a. [(a, Doc a)] -> [Doc a]
newPara [(Text, Doc Text)]
paraHStyles)) [Alignment]
a
             newPara :: [(a, Doc a)] -> [Doc a]
newPara     = ((a, Doc a) -> Doc a) -> [(a, Doc a)] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Doc a) -> Doc a
forall a b. (a, b) -> b
snd ([(a, Doc a)] -> [Doc a])
-> ([(a, Doc a)] -> [(a, Doc a)]) -> [(a, Doc a)] -> [Doc a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Doc a) -> Bool) -> [(a, Doc a)] -> [(a, Doc a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((a, Doc a) -> Bool) -> (a, Doc a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> Bool
forall a. Doc a -> Bool
isEmpty (Doc a -> Bool) -> ((a, Doc a) -> Doc a) -> (a, Doc a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Doc a) -> Doc a
forall a b. (a, b) -> b
snd)
        Doc Text -> OD m ()
forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addTableStyle (Doc Text -> OD m ()) -> Doc Text -> OD m ()
forall a b. (a -> b) -> a -> b
$ Int -> [(Char, Double)] -> Doc Text
tableStyle Int
tn [(Char, Double)]
columnIds
        (Doc Text -> OD m ()) -> [Doc Text] -> OD m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Doc Text -> OD m ()
forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addParaStyle ([Doc Text] -> OD m ())
-> ([(Text, Doc Text)] -> [Doc Text])
-> [(Text, Doc Text)]
-> OD m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Doc Text)] -> [Doc Text]
forall a a. [(a, Doc a)] -> [Doc a]
newPara ([(Text, Doc Text)] -> OD m ()) -> [(Text, Doc Text)] -> OD m ()
forall a b. (a -> b) -> a -> b
$ [(Text, Doc Text)]
paraHStyles [(Text, Doc Text)] -> [(Text, Doc Text)] -> [(Text, Doc Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Doc Text)]
paraStyles
        Doc Text
captionDoc <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
c
                      then Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                      else WriterOptions -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
c StateT WriterState m (Doc Text)
-> (Doc Text -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                             if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_numbering WriterOptions
o
                                then Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> StateT WriterState m (Doc Text)
numberedTableCaption
                                else Text -> Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
Monad m =>
Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption "TableCaption"
        Doc Text
th <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
h
                 then Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                 else WriterOptions
-> [Text] -> [[Block]] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [[Block]] -> OD m (Doc Text)
colHeadsToOpenDocument WriterOptions
o (((Text, Doc Text) -> Text) -> [(Text, Doc Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Doc Text) -> Text
forall a b. (a, b) -> a
fst [(Text, Doc Text)]
paraHStyles) [[Block]]
h
        [Doc Text]
tr <- ([[Block]] -> StateT WriterState m (Doc Text))
-> [[[Block]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions
-> [Text] -> [[Block]] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [[Block]] -> OD m (Doc Text)
tableRowToOpenDocument WriterOptions
o (((Text, Doc Text) -> Text) -> [(Text, Doc Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Doc Text) -> Text
forall a b. (a, b) -> a
fst [(Text, Doc Text)]
paraStyles)) [[[Block]]]
r
        let tableDoc :: Doc Text
tableDoc = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True "table:table" [
                            ("table:name"      , Text
name)
                          , ("table:style-name", Text
name)
                          ] ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
columns Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
th Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
tr)
        Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
captionDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
tableDoc
      figure :: Attr -> [Inline] -> Text -> Text -> OD m (Doc Text)
figure attr :: Attr
attr caption :: [Inline]
caption source :: Text
source title :: Text
title | [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption =
        WriterOptions -> Text -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o "Figure" [[Inline] -> Block
Para [Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
caption (Text
source,Text
title)]]
                                  | Bool
otherwise    = do
        Doc Text
imageDoc <- WriterOptions -> Text -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o "FigureWithCaption" [[Inline] -> Block
Para [Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
caption (Text
source,Text
title)]]
        Doc Text
captionDoc <- WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
caption OD m (Doc Text) -> (Doc Text -> OD m (Doc Text)) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_numbering WriterOptions
o
                            then Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> StateT WriterState m (Doc Text)
numberedFigureCaption
                            else Text -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
Monad m =>
Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption "FigureCaption"
        Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
imageDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
captionDoc


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

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

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

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

colHeadsToOpenDocument :: PandocMonad m
                       => WriterOptions -> [Text] -> [[Block]]
                       -> OD m (Doc Text)
colHeadsToOpenDocument :: WriterOptions -> [Text] -> [[Block]] -> OD m (Doc Text)
colHeadsToOpenDocument o :: WriterOptions
o ns :: [Text]
ns hs :: [[Block]]
hs =
    Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "table:table-header-rows" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "table:table-row" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ((Text, [Block]) -> OD m (Doc Text))
-> [(Text, [Block])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Text -> (Text, [Block]) -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> (Text, [Block]) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o "TableHeaderRowCell") ([Text] -> [[Block]] -> [(Text, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ns [[Block]]
hs)

tableRowToOpenDocument :: PandocMonad m
                       => WriterOptions -> [Text] -> [[Block]]
                       -> OD m (Doc Text)
tableRowToOpenDocument :: WriterOptions -> [Text] -> [[Block]] -> OD m (Doc Text)
tableRowToOpenDocument o :: WriterOptions
o ns :: [Text]
ns cs :: [[Block]]
cs =
    Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "table:table-row" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ((Text, [Block]) -> OD m (Doc Text))
-> [(Text, [Block])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Text -> (Text, [Block]) -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> (Text, [Block]) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o "TableRowCell") ([Text] -> [[Block]] -> [(Text, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ns [[Block]]
cs)

tableItemToOpenDocument :: PandocMonad m
                        => WriterOptions -> Text -> (Text,[Block])
                        -> OD m (Doc Text)
tableItemToOpenDocument :: WriterOptions -> Text -> (Text, [Block]) -> OD m (Doc Text)
tableItemToOpenDocument o :: WriterOptions
o s :: Text
s (n :: Text
n,i :: [Block]
i) =
  let a :: [(Text, Text)]
a = [ ("table:style-name" , Text
s )
          , ("office:value-type", "string"     )
          ]
  in  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True "table:table-cell" [(Text, Text)]
a (Doc Text -> Doc Text) -> OD m (Doc Text) -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      WriterOptions -> Text -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
n ((Block -> Block) -> [Block] -> [Block]
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 :: WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument o :: WriterOptions
o l :: [Inline]
l = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> StateT WriterState m [Doc Text]
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 :: WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks _ [] = [Doc Text] -> OD m [Doc Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
toChunks o :: WriterOptions
o (x :: Inline
x : xs :: [Inline]
xs)
  | Inline -> Bool
isChunkable Inline
x = do
        Doc Text
contents <- (Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Doc Text -> StateT WriterState m (Doc Text)
inTextStyle (Doc Text -> OD m (Doc Text))
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> OD m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat) ([Doc Text] -> OD m (Doc Text))
-> OD m [Doc Text] -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                     (Inline -> OD m (Doc Text)) -> [Inline] -> OD m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Inline -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument WriterOptions
o) (Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
ys)
        [Doc Text]
rest <- WriterOptions -> [Inline] -> OD m [Doc Text]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks WriterOptions
o [Inline]
zs
        [Doc Text] -> OD m [Doc Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
contents Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: [Doc Text]
rest)
  | Bool
otherwise     = do
        Doc Text
contents <- WriterOptions -> Inline -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument WriterOptions
o Inline
x
        [Doc Text]
rest <- WriterOptions -> [Inline] -> OD m [Doc Text]
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks WriterOptions
o [Inline]
xs
        [Doc Text] -> OD m [Doc Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
contents Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: [Doc Text]
rest)
  where (ys :: [Inline]
ys, zs :: [Inline]
zs) = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Inline -> Bool
isChunkable [Inline]
xs

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

-- | Convert an inline element to OpenDocument.
inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument :: WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument o :: WriterOptions
o ils :: Inline
ils
  = case Inline
ils of
    Space         -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
    SoftBreak
     | WriterOptions -> WrapOption
writerWrapText WriterOptions
o WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve
                  -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
preformatted "\n"
     | Bool
otherwise  ->Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
    Span attr :: Attr
attr xs :: [Inline]
xs  -> Attr -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a. PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr Attr
attr (WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
xs)
    LineBreak     -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "text:line-break" []
    Str         s :: Text
s -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
handleSpaces (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
s
    Emph        l :: [Inline]
l -> TextStyle -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Italic (OD m (Doc Text) -> OD m (Doc Text))
-> OD m (Doc Text) -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Strong      l :: [Inline]
l -> TextStyle -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Bold   (OD m (Doc Text) -> OD m (Doc Text))
-> OD m (Doc Text) -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Strikeout   l :: [Inline]
l -> TextStyle -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Strike (OD m (Doc Text) -> OD m (Doc Text))
-> OD m (Doc Text) -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Superscript l :: [Inline]
l -> TextStyle -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Sup    (OD m (Doc Text) -> OD m (Doc Text))
-> OD m (Doc Text) -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Subscript   l :: [Inline]
l -> TextStyle -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
Sub    (OD m (Doc Text) -> OD m (Doc Text))
-> OD m (Doc Text) -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    SmallCaps   l :: [Inline]
l -> TextStyle -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
SmallC (OD m (Doc Text) -> OD m (Doc Text))
-> OD m (Doc Text) -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Quoted    t :: QuoteType
t l :: [Inline]
l -> QuoteType -> Doc Text -> Doc Text
inQuotes QuoteType
t (Doc Text -> Doc Text) -> OD m (Doc Text) -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Code      _ s :: Text
s -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. (Monad m, HasChars a) => Doc a -> m (Doc a)
inlinedCode (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
preformatted Text
s
    Math      t :: MathType
t s :: Text
s -> m [Inline] -> StateT WriterState m [Inline]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MathType -> Text -> m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
s) StateT WriterState m [Inline]
-> ([Inline] -> OD m (Doc Text)) -> OD m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o
    Cite      _ l :: [Inline]
l -> WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    RawInline f :: Format
f s :: Text
s -> if Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format "opendocument"
                       then Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
                       else do
                         LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
ils
                         Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
    Link _ l :: [Inline]
l (s :: Text
s,t :: Text
t) ->  Text -> Text -> Doc Text -> Doc Text
mkLink Text
s Text
t (Doc Text -> Doc Text) -> OD m (Doc Text) -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    Image attr :: Attr
attr _ (s :: Text
s,t :: Text
t) -> Attr -> Text -> Text -> OD m (Doc Text)
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        l :: [Block]
l  -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT WriterState m (Doc Text)
mkNote [Block]
l
    where
      preformatted :: Text -> Doc Text
preformatted s :: Text
s = Text -> Doc Text
handleSpaces (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
s
      inlinedCode :: Doc a -> m (Doc a)
inlinedCode s :: Doc a
s = Doc a -> m (Doc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc a -> m (Doc a)) -> Doc a -> m (Doc a)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False "text:span" [("text:style-name", "Source_Text")] Doc a
s
      mkLink :: Text -> Text -> Doc Text -> Doc Text
mkLink   s :: Text
s t :: Text
t = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False "text:a" [ ("xlink:type" , "simple")
                                           , ("xlink:href" , Text
s       )
                                           , ("office:name", Text
t       )
                                           ] (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
inSpanTags "Definition"
      mkImg :: (a, b, [(a, Text)]) -> Text -> p -> m (Doc a)
mkImg (_, _, kvs :: [(a, Text)]
kvs) s :: Text
s _ = do
               Int
id' <- (WriterState -> Int) -> m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stImageId
               (WriterState -> WriterState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: WriterState
st -> WriterState
st{ stImageId :: Int
stImageId = Int
id' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 })
               let getDims :: [(a, b)] -> [(a, b)]
getDims [] = []
                   getDims (("width", w :: b
w) :xs :: [(a, b)]
xs) = ("svg:width", b
w)  (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims (("rel-width", w :: b
w):xs :: [(a, b)]
xs) = ("style:rel-width", b
w) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims (("height", h :: b
h):xs :: [(a, b)]
xs) = ("svg:height", b
h) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims (("rel-height", w :: b
w):xs :: [(a, b)]
xs) = ("style:rel-height", b
w) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims (_:xs :: [(a, b)]
xs) =                             [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
               Doc a -> m (Doc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc a -> m (Doc a)) -> Doc a -> m (Doc a)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False "draw:frame"
                        (("draw:name", "img" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
id') (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(a, Text)] -> [(Text, Text)]
forall a a b.
(Eq a, IsString a, IsString a) =>
[(a, b)] -> [(a, b)]
getDims [(a, Text)]
kvs) (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
                     Text -> [(Text, Text)] -> Doc a
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "draw:image" [ ("xlink:href"   , Text
s       )
                                                 , ("xlink:type"   , "simple")
                                                 , ("xlink:show"   , "embed" )
                                                 , ("xlink:actuate", "onLoad")]
      mkNote :: [Block] -> StateT WriterState m (Doc Text)
mkNote     l :: [Block]
l = do
        Int
n <- [Doc Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Doc Text] -> Int)
-> StateT WriterState m [Doc Text] -> StateT WriterState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> [Doc Text]) -> StateT WriterState m [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [Doc Text]
stNotes
        let footNote :: Doc a -> Doc a
footNote t :: Doc a
t = Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False "text:note"
                         [ ("text:id"        , "ftn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n)
                         , ("text:note-class", "footnote"     )] (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$
                         Text -> Doc a -> Doc a
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "text:note-citation" (String -> Doc a
forall a. HasChars a => String -> Doc a
text (String -> Doc a) -> (Int -> String) -> Int -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Doc a) -> Int -> Doc a
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
                         Text -> Doc a -> Doc a
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "text:note-body" Doc a
t
        Doc Text
nn <- Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
footNote (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Text -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o "Footnote" [Block]
l
        Doc Text -> OD m ()
forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addNote Doc Text
nn
        Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
nn

bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc Text]))
bulletListStyle :: Int -> OD m (Int, (Int, [Doc Text]))
bulletListStyle l :: Int
l = do
  let doStyles :: Int -> Doc Text
doStyles  i :: Int
i = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True "text:list-level-style-bullet"
                    [ ("text:level"      , Int -> Text
forall a. Show a => a -> Text
tshow (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
                    , ("text:style-name" , "Bullet_20_Symbols"  )
                    , ("style:num-suffix", "."                  )
                    , ("text:bullet-char", Char -> Text
T.singleton (String
bulletList String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
i))
                    ] (Int -> Doc Text
listLevelStyle (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i))
      bulletList :: String
bulletList  = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
cycle [8226,9702,9642]
      listElStyle :: [Doc Text]
listElStyle = (Int -> Doc Text) -> [Int] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc Text
doStyles [0..9]
  Int
pn <- Int -> OD m Int
forall (m :: * -> *). PandocMonad m => Int -> OD m Int
paraListStyle Int
l
  (Int, (Int, [Doc Text])) -> OD m (Int, (Int, [Doc Text]))
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 (s :: Int
s,n :: ListNumberStyle
n, d :: ListNumberDelim
d) (l :: Int
l,ls :: [Doc Text]
ls) =
    let suffix :: [(Text, Text)]
suffix    = case ListNumberDelim
d of
                      OneParen  -> [("style:num-suffix", ")")]
                      TwoParens -> [("style:num-prefix", "(")
                                   ,("style:num-suffix", ")")]
                      _         -> [("style:num-suffix", ".")]
        format :: Text
format    = case ListNumberStyle
n of
                      UpperAlpha -> "A"
                      LowerAlpha -> "a"
                      UpperRoman -> "I"
                      LowerRoman -> "i"
                      _          -> "1"
        listStyle :: Doc Text
listStyle = Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True "text:list-level-style-number"
                    ([ ("text:level"      , Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Doc Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
ls )
                     , ("text:style-name" , "Numbering_20_Symbols")
                     , ("style:num-format", Text
format                )
                     , ("text:start-value", Int -> Text
forall a. Show a => a -> Text
tshow Int
s               )
                     ] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
suffix) (Int -> Doc Text
listLevelStyle (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Doc Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
ls))
    in  (Int
l, [Doc Text]
ls [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Doc Text
listStyle])

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

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

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

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

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

data TextStyle = Italic
               | Bold
               | Strike
               | Sub
               | Sup
               | SmallC
               | Pre
               | Language Lang
               deriving ( TextStyle -> TextStyle -> Bool
(TextStyle -> TextStyle -> Bool)
-> (TextStyle -> TextStyle -> Bool) -> Eq TextStyle
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
Eq TextStyle =>
(TextStyle -> TextStyle -> Ordering)
-> (TextStyle -> TextStyle -> Bool)
-> (TextStyle -> TextStyle -> Bool)
-> (TextStyle -> TextStyle -> Bool)
-> (TextStyle -> TextStyle -> Bool)
-> (TextStyle -> TextStyle -> TextStyle)
-> (TextStyle -> TextStyle -> TextStyle)
-> Ord 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
$cp1Ord :: Eq TextStyle
Ord )

textStyleAttr :: Map.Map Text Text
              -> TextStyle
              -> Map.Map Text Text
textStyleAttr :: Map Text Text -> TextStyle -> Map Text Text
textStyleAttr m :: Map Text Text
m s :: TextStyle
s
    | TextStyle
Italic <- TextStyle
s = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "fo:font-style" "italic" (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:font-style-asian" "italic" (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:font-style-complex" "italic" (Map Text Text -> Map Text Text) -> Map Text Text -> Map Text Text
forall a b. (a -> b) -> a -> b
$ Map Text Text
m
    | TextStyle
Bold   <- TextStyle
s = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "fo:font-weight" "bold" (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:font-weight-asian" "bold" (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:font-weight-complex" "bold" (Map Text Text -> Map Text Text) -> Map Text Text -> Map Text Text
forall a b. (a -> b) -> a -> b
$ Map Text Text
m
    | TextStyle
Strike <- TextStyle
s = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:text-line-through-style" "solid" Map Text Text
m
    | TextStyle
Sub    <- TextStyle
s = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:text-position" "sub 58%" Map Text Text
m
    | TextStyle
Sup    <- TextStyle
s = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:text-position" "super 58%" Map Text Text
m
    | TextStyle
SmallC <- TextStyle
s = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "fo:font-variant" "small-caps" Map Text Text
m
    | TextStyle
Pre    <- TextStyle
s = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:font-name" "Courier New" (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:font-name-asian" "Courier New" (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "style:font-name-complex" "Courier New" (Map Text Text -> Map Text Text) -> Map Text Text -> Map Text Text
forall a b. (a -> b) -> a -> b
$ Map Text Text
m
    | Language lang :: Lang
lang <- TextStyle
s
                  = Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "fo:language" (Lang -> Text
langLanguage Lang
lang) (Map Text Text -> Map Text Text)
-> (Map Text Text -> Map Text Text)
-> Map Text Text
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "fo:country" (Lang -> Text
langRegion Lang
lang) (Map Text Text -> Map Text Text) -> Map Text Text -> Map Text Text
forall a b. (a -> b) -> a -> b
$ Map Text Text
m
    | Bool
otherwise   = Map Text Text
m

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