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

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

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

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

--
-- OpenDocument writer
--

type OD m = StateT WriterState m

data ReferenceType
  = HeaderRef
  | TableRef
  | ImageRef

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

defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState =
    WriterState :: [Doc Text]
-> [Doc Text]
-> [Doc Text]
-> [(Int, [Doc Text])]
-> Map (Set TextStyle) (Text, Doc Text)
-> Set TextStyle
-> Int
-> Bool
-> Bool
-> Bool
-> Int
-> Int
-> Int
-> [(Text, ReferenceType)]
-> 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     = Int
0
                , stInDefinition :: Bool
stInDefinition   = Bool
False
                , stTight :: Bool
stTight          = Bool
False
                , stFirstPara :: Bool
stFirstPara      = Bool
False
                , stImageId :: Int
stImageId        = Int
1
                , stTableCaptionId :: Int
stTableCaptionId = Int
1
                , stImageCaptionId :: Int
stImageCaptionId = Int
1
                , stIdentTypes :: [(Text, ReferenceType)]
stIdentTypes     = []
                }

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

addTableStyle :: PandocMonad m => Doc Text -> OD m ()
addTableStyle :: Doc Text -> OD m ()
addTableStyle 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
$ \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 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
$ \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 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
$ \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 Set TextStyle
attrs (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
$ \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 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
$ \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
$ \WriterState
s -> WriterState
s { stIndentPara :: Int
stIndentPara = Int
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
$ \WriterState
s -> WriterState
s { stIndentPara :: Int
stIndentPara = WriterState -> Int
stIndentPara WriterState
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }

inTightList :: PandocMonad m => OD m a -> OD m a
inTightList :: OD m a -> OD m a
inTightList  OD m a
f = (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\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
>>= \a
r ->
                 (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\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 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
$  \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
$  \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 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
$ \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
"text:style-name", Text
"First_20_paragraph")]
       else    [(Text, Text)] -> StateT WriterState m [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return   [(Text
"text:style-name", Text
"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
"text:p" [(Text, Text)]
a Doc Text
d

inParagraphTagsWithStyle :: Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle :: Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle 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
"text:p" [(Text
"text:style-name", Text
sty)]

inSpanTags :: Text -> Doc Text -> Doc Text
inSpanTags :: Text -> Doc Text -> Doc Text
inSpanTags 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
"text:span" [(Text
"text:style-name",Text
s)]

withTextStyle :: PandocMonad m => TextStyle -> OD m a -> OD m a
withTextStyle :: TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
s 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
$ \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 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 (Text
styleName, Doc Text
_) -> 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
"text:span" [(Text
"text:style-name",Text
styleName)] Doc Text
d
            Maybe (Text, Doc Text)
Nothing -> do
              let styleName :: Text
styleName = Text
"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
+ Int
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 Text
"style:style"
                       [(Text
"style:name", Text
styleName)
                       ,(Text
"style:family", Text
"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 Text
"style:text-properties"
                          (((Text, Text) -> Text) -> [(Text, Text)] -> [(Text, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (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
"text:span" [(Text
"text:style-name",Text
styleName)] Doc Text
d

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

formulaStyle :: MathType -> Doc Text
formulaStyle :: MathType -> Doc Text
formulaStyle MathType
mt = 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
"style:style"
  [(Text
"style:name", if MathType
mt MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
InlineMath then Text
"fr1" else Text
"fr2")
  ,(Text
"style:family", Text
"graphic")
  ,(Text
"style:parent-style-name", Text
"Formula")]
  (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
"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
                                                  [(Text
"style:vertical-pos", Text
"middle")
                                                  ,(Text
"style:vertical-rel", Text
"text")]
                                                else
                                                  [(Text
"style:vertical-pos",   Text
"middle")
                                                  ,(Text
"style:vertical-rel",   Text
"paragraph-content")
                                                  ,(Text
"style:horizontal-pos", Text
"center")
                                                  ,(Text
"style:horizontal-rel", Text
"paragraph-content")
                                                  ,(Text
"style:wrap",           Text
"none")]

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

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

inHeaderTags :: PandocMonad m => Int -> Text -> Doc Text -> OD m (Doc Text)
inHeaderTags :: Int -> Text -> Doc Text -> OD m (Doc Text)
inHeaderTags Int
i Text
ident 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
"text:h" [ (Text
"text:style-name", Text
"Heading_20_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i)
                                 , (Text
"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 -> Doc Text -> Doc Text
inBookmarkTags Text
ident Doc Text
d

inQuotes :: QuoteType -> Doc Text -> Doc Text
inQuotes :: QuoteType -> Doc Text -> Doc Text
inQuotes QuoteType
SingleQuote Doc Text
s = Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char 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 Char
'\8217'
inQuotes QuoteType
DoubleQuote Doc Text
s = Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char 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 Char
'\8221'

handleSpaces :: Text -> Doc Text
handleSpaces :: Text -> Doc Text
handleSpaces Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
  Just (Char
' ', Text
_) -> Text -> Doc Text
genTag Text
s
  Just (Char
'\t',Text
x) -> Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:tab" [] Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
rm Text
x
  Maybe (Char, Text)
_             -> Text -> Doc Text
rm Text
s
  where
    genTag :: Text -> Doc Text
genTag = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') (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 a
n  = Bool -> Doc Text -> Doc Text
when (a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
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
"text:s" [(Text
"text:c", a -> Text
forall a. Show a => a -> Text
tshow a
n)]
    rm :: Text -> Doc Text
rm Text
t   = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Just ( Char
' ',Text
xs) -> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
' ' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
genTag Text
xs
      Just (Char
'\t',Text
xs) -> Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:tab" [] Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
genTag Text
xs
      Just (   Char
x,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
      Maybe (Char, Text)
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 WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  let defLang :: Lang
defLang = Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"US" Text
"" []
  Lang
lang <- case Text -> Meta -> Text
lookupMetaString Text
"lang" Meta
meta of
            Text
"" -> Lang -> m Lang
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lang
defLang
            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
  let meta' :: Meta
meta' = case Text -> Meta -> [Block]
lookupMetaBlocks Text
"abstract" Meta
meta of
                [] -> Meta
meta
                [Block]
xs -> Text -> Blocks -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"abstract"
                        (Attr -> Blocks -> Blocks
B.divWith (Text
"",[],[(Text
"custom-style",Text
"Abstract")])
                          ([Block] -> Blocks
forall a. [a] -> Many a
B.fromList [Block]
xs))
                        Meta
meta
  ((Doc Text
body, Context Text
metadata),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
           let collectInlineIdent :: Inline -> [(Text, ReferenceType)]
collectInlineIdent (Image (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
_ (Text, Text)
_) = [(Text
ident,ReferenceType
ImageRef)]
               collectInlineIdent Inline
_                       = []
           let collectBlockIdent :: Block -> [(Text, ReferenceType)]
collectBlockIdent (Header Int
_ (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
_)      = [(Text
ident,ReferenceType
HeaderRef)]
               collectBlockIdent (Table (Text
ident,[Text]
_,[(Text, Text)]
_) Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_) = [(Text
ident,ReferenceType
TableRef)]
               collectBlockIdent Block
_                             = []
           (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
$ \WriterState
s -> WriterState
s{ stIdentTypes :: [(Text, ReferenceType)]
stIdentTypes = (Block -> [(Text, ReferenceType)])
-> [Block] -> [(Text, ReferenceType)]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [(Text, ReferenceType)]
collectBlockIdent [Block]
blocks [(Text, ReferenceType)]
-> [(Text, ReferenceType)] -> [(Text, ReferenceType)]
forall a. [a] -> [a] -> [a]
++ (Inline -> [(Text, ReferenceType)])
-> [Block] -> [(Text, ReferenceType)]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [(Text, ReferenceType)]
collectInlineIdent [Block]
blocks }
           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 (a
n,[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
"text:list-style"
                          [(Text
"style:name", Text
"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 Text
"body" Doc Text
body
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts)
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc-depth" (Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerTOCDepth WriterOptions
opts)
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"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
       Maybe (Template Text)
Nothing  -> Doc Text
body
       Just 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  WriterOptions
o Text
s (Block
b:[Block]
bs)
    | Para [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 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 WriterOptions
_ Text
_ [] = 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 Text
s = do
  Int
n <- [(Text, Text)] -> OD m Int
forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Int
paraStyle [(Text
"style:parent-style-name",Text
"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 (Text
"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 WriterOptions
o Int
pn [[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
"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  WriterOptions
o Int
n [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 ListAttributes
a [[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          [Inline]
l) = Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle (Text
"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 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 ListAttributes
a [[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
$ \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 Int
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
"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 ([Block]
b:[[Block]]
_)
    | Plain {} : [Block]
_ <- [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 Bool
b ListAttributes
a = do
  Int
ln <- Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
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
$ \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 WriterOptions
o [[Block]]
b = do
  Int
ln <- Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
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
  (Int
pn,(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
$ \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 (Text
"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
"text:list" [(Text
"text:style-name", Text
"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 Text
s WriterOptions
o [[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
"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 WriterOptions
o ([Inline]
t,[[Block]]
d) = do
  let ts :: Text
ts = if [[Block]] -> Bool
isTightList [[Block]]
d
           then Text
"Definition_20_Term_20_Tight"       else Text
"Definition_20_Term"
      ds :: Text
ds = if [[Block]] -> Bool
isTightList [[Block]]
d
           then Text
"Definition_20_Definition_20_Tight" else Text
"Definition_20_Definition"
  Doc Text
t' <- 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  WriterOptions
o Int
i (Block
b:[Block]
bs)
    | BlockQuote [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
                                   [(Text
"style:parent-style-name",Text
"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       [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
"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  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     WriterOptions
_ Int
_ [] =  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 WriterOptions
o [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 WriterOptions
o Block
bs
    | Plain          [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 [Inline]
c (Text
s,Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" -> Just 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           [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      [[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 [Block]
xs      <- Block
bs = Attr -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Block] -> OD m (Doc Text)
mkDiv Attr
attr [Block]
xs
    | Header     Int
i (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
b
                       <- 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     [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 [([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     [[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  ListAttributes
a [[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    Attr
_ 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 Attr
a Caption
bc [ColSpec]
s TableHead
th [TableBody]
tb TableFoot
tf <- 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
>> Table -> OD m (Doc Text)
forall (m :: * -> *). PandocMonad m => Table -> OD m (Doc Text)
table (Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Ann.toTable Attr
a Caption
bc [ColSpec]
s TableHead
th [TableBody]
tb TableFoot
tf)
    | Block
HorizontalRule   <- 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
"text:p"
                                [ (Text
"text:style-name", Text
"Horizontal_20_Line") ])
    | RawBlock Format
f     Text
s <- Block
bs = if Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"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       [([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  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)
      mkDiv :: Attr -> [Block] -> OD m (Doc Text)
mkDiv    Attr
attr [Block]
s = do
        let (Text
ident,[Text]
_,[(Text, Text)]
kvs) = Attr
attr
            i :: OD m (Doc Text)
i = Attr -> OD m (Doc Text) -> OD m (Doc Text)
forall (m :: * -> *) a. PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr Attr
attr (OD m (Doc Text) -> OD m (Doc Text))
-> OD m (Doc Text) -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"custom-style" [(Text, Text)]
kvs of
                  Just Text
sty -> WriterOptions -> Text -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
sty [Block]
s
                  Maybe Text
_        -> WriterOptions -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> OD m (Doc Text)
blocksToOpenDocument WriterOptions
o [Block]
s
            mkBookmarkedDiv :: Doc Text -> Doc Text
mkBookmarkedDiv = 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
"text:section" [(Text
"text:name", Text
ident)]
        if Text -> Bool
T.null Text
ident
          then OD m (Doc Text)
i
          else (Doc Text -> Doc Text) -> OD m (Doc Text) -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
mkBookmarkedDiv OD m (Doc Text)
i
      mkBlockQuote :: [Block] -> StateT WriterState m (Doc Text)
mkBlockQuote  [Block]
b = do 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
                                 [(Text
"style:parent-style-name",Text
"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 ListAttributes
a [[Block]]
b = do (Int
ln,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
"text:list" [ (Text
"text:style-name", Text
"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 :: PandocMonad m => Ann.Table -> OD m (Doc Text)
      table :: Table -> OD m (Doc Text)
table (Ann.Table (Text
ident, [Text]
_, [(Text, Text)]
_) (Caption Maybe [Inline]
_ [Block]
c) [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
_) = do
        Int
tn <- [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 [Int
65..]
             name :: Text
name        = Text
"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
+ Int
1)
             ([Alignment]
aligns, [ColWidth]
mwidths) = [ColSpec] -> ([Alignment], [ColWidth])
forall a b. [(a, b)] -> ([a], [b])
unzip [ColSpec]
colspecs
             fromWidth :: ColWidth -> Double
fromWidth (ColWidth Double
w) | Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double
w
             fromWidth ColWidth
_                    = Double
0
             widths :: [Double]
widths = (ColWidth -> Double) -> [ColWidth] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ColWidth -> Double
fromWidth [ColWidth]
mwidths
             textWidth :: Double
textWidth   = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
             columnIds :: [(Char, Double)]
columnIds   = String -> [Double] -> [(Char, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
genIds [Double]
widths
             mkColumn :: (Char, b) -> Doc a
mkColumn  (Char, b)
n = Text -> [(Text, Text)] -> Doc a
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"table:table-column" [(Text
"table:style-name", Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." 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 Text
"Heading"  Int
pn [Alignment]
aligns
             paraStyles :: [(Text, Doc Text)]
paraStyles  = Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles Text
"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]
aligns
             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 -> Double -> [(Char, Double)] -> Doc Text
tableStyle Int
tn Double
textWidth [(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 [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
c
                      then Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                      else WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o ([Block] -> [Inline]
blocksToInlines [Block]
c) 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 Text -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> OD m (Doc Text)
numberedTableCaption Text
ident
                                else Text -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
Monad m =>
Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption Text
"TableCaption"
        Doc Text
th <- WriterOptions -> [Text] -> TableHead -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> TableHead -> 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) TableHead
thead
        [Doc Text]
tr <- (TableBody -> OD m (Doc Text))
-> [TableBody] -> 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] -> TableBody -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> TableBody -> OD m (Doc Text)
tableBodyToOpenDocument 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)) [TableBody]
tbodies
        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 Text
"table:table" [
                            (Text
"table:name"      , Text
name)
                          , (Text
"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 -> 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
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@(Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
caption Text
source 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 Text
"Figure" [[Inline] -> Block
Para [Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
caption (Text
source,Text
title)]]
                                  | Bool
otherwise    = do
        Doc Text
imageDoc <- WriterOptions -> Text -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
"FigureWithCaption" [[Inline] -> Block
Para [Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
caption (Text
source,Text
title)]]
        Doc Text
captionDoc <- 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 Text -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> OD m (Doc Text)
numberedFigureCaption Text
ident
                            else Text -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *).
Monad m =>
Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption Text
"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 => Text -> Doc Text -> OD m (Doc Text)
numberedTableCaption :: Text -> Doc Text -> OD m (Doc Text)
numberedTableCaption Text
ident 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 (\WriterState
st -> WriterState
st{ stTableCaptionId :: Int
stTableCaptionId = Int
id' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 -> Text -> Doc Text -> Doc Text
numberedCaption Text
"TableCaption" Text
capterm Text
"Table" Int
id' Text
ident Doc Text
caption

numberedFigureCaption :: PandocMonad m => Text -> Doc Text -> OD m (Doc Text)
numberedFigureCaption :: Text -> Doc Text -> OD m (Doc Text)
numberedFigureCaption Text
ident 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 (\WriterState
st -> WriterState
st{ stImageCaptionId :: Int
stImageCaptionId = Int
id' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 -> Text -> Doc Text -> Doc Text
numberedCaption Text
"FigureCaption" Text
capterm  Text
"Illustration" Int
id' Text
ident Doc Text
caption

numberedCaption :: Text -> Text -> Text -> Int -> Text -> Doc Text -> Doc Text
numberedCaption :: Text -> Text -> Text -> Int -> Text -> Doc Text -> Doc Text
numberedCaption Text
style Text
term Text
name Int
num Text
ident Doc Text
caption =
    let t :: Doc Text
t = 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
- Int
1
        ident' :: Text
ident' = case Text
ident of
          Text
"" -> Text
"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
_ -> Text
ident
        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
"text:sequence" [ (Text
"text:ref-name", Text
ident'),
                                           (Text
"text:name", Text
name),
                                           (Text
"text:formula", Text
"ooow:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+1"),
                                           (Text
"style:num-format", Text
"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 String
": "
    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 String
" ", 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 Text
style 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] -> Ann.TableHead
                       -> OD m (Doc Text)
colHeadsToOpenDocument :: WriterOptions -> [Text] -> TableHead -> OD m (Doc Text)
colHeadsToOpenDocument WriterOptions
o [Text]
ns (Ann.TableHead Attr
_ [HeaderRow]
hs) =
  case [HeaderRow]
hs of
    [] -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
    (HeaderRow
x:[HeaderRow]
_) ->
        let (Ann.HeaderRow Attr
_ RowNumber
_ [Cell]
c) = HeaderRow
x
        in Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"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 Text
"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, Cell) -> OD m (Doc Text))
-> [(Text, Cell)] -> 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, Cell) -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> (Text, Cell) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o Text
"TableHeaderRowCell") ([Text] -> [Cell] -> [(Text, Cell)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ns [Cell]
c)

tableBodyToOpenDocument:: PandocMonad m
                       => WriterOptions -> [Text] -> Ann.TableBody
                       -> OD m (Doc Text)
tableBodyToOpenDocument :: WriterOptions -> [Text] -> TableBody -> OD m (Doc Text)
tableBodyToOpenDocument WriterOptions
o [Text]
ns TableBody
tb =
    let (Ann.TableBody Attr
_ RowHeadColumns
_ [HeaderRow]
_ [BodyRow]
r) = TableBody
tb
    in [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
<$> (BodyRow -> OD m (Doc Text))
-> [BodyRow] -> 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] -> BodyRow -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> BodyRow -> OD m (Doc Text)
tableRowToOpenDocument WriterOptions
o [Text]
ns) [BodyRow]
r

tableRowToOpenDocument :: PandocMonad m
                       => WriterOptions -> [Text] -> Ann.BodyRow
                       -> OD m (Doc Text)
tableRowToOpenDocument :: WriterOptions -> [Text] -> BodyRow -> OD m (Doc Text)
tableRowToOpenDocument WriterOptions
o [Text]
ns BodyRow
r =
    let (Ann.BodyRow Attr
_ RowNumber
_ [Cell]
_ [Cell]
c ) = BodyRow
r
    in Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"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, Cell) -> OD m (Doc Text))
-> [(Text, Cell)] -> 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, Cell) -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> (Text, Cell) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o Text
"TableRowCell") ([Text] -> [Cell] -> [(Text, Cell)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ns [Cell]
c)

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

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

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

tableItemToOpenDocument :: PandocMonad m
                        => WriterOptions -> Text -> (Text,Ann.Cell)
                        -> OD m (Doc Text)
tableItemToOpenDocument :: WriterOptions -> Text -> (Text, Cell) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o Text
s (Text
n,Cell
c) = do
  let (Ann.Cell NonEmpty ColSpec
_colspecs ColNumber
_colnum (Cell Attr
_ Alignment
align RowSpan
rs ColSpan
cs [Block]
i) ) = Cell
c
      csa :: [(Text, Text)]
csa = ColSpan -> [(Text, Text)]
colspanAttrib ColSpan
cs
      rsa :: [(Text, Text)]
rsa = RowSpan -> [(Text, Text)]
rowspanAttrib RowSpan
rs
      aa :: [(Text, Text)]
aa = Alignment -> [(Text, Text)]
alignAttrib Alignment
align
      a :: [(Text, Text)]
a = [ (Text
"table:style-name" , Text
s )
          , (Text
"office:value-type", Text
"string" ) ] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
csa [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
rsa
  Int
itemParaStyle <- case [(Text, Text)]
aa of
                     [] -> Int -> StateT WriterState m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
                     [(Text, Text)]
_  -> Text -> [(Text, Text)] -> StateT WriterState m Int
forall (m :: * -> *).
PandocMonad m =>
Text -> [(Text, Text)] -> OD m Int
paraStyleFromParent Text
n [(Text, Text)]
aa
  let itemParaStyle' :: Text
itemParaStyle' = case Int
itemParaStyle of
                         Int
0 -> Text
n
                         Int
x -> Text
"P" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
x
  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
"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
itemParaStyle' ((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 WriterOptions
o [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 WriterOptions
_ [] = [Doc Text] -> OD m [Doc Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
toChunks WriterOptions
o (Inline
x : [Inline]
xs)
  | Inline -> Bool
isChunkable Inline
x = do
        Doc Text
contents <- (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 ([Inline]
ys, [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 Text
_)   = Bool
True
isChunkable Inline
Space     = Bool
True
isChunkable Inline
SoftBreak = Bool
True
isChunkable Inline
_         = Bool
False

-- | Convert an inline element to OpenDocument.
inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument :: WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument WriterOptions
o Inline
ils
  = case Inline
ils of
    Inline
Space         -> Doc Text -> OD m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
    Inline
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 Text
"\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 [Inline]
xs  -> Attr -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> OD m (Doc Text)
mkSpan Attr
attr [Inline]
xs
    Inline
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
"text:line-break" []
    Str         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        [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
    Underline   [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
Under  (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      [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   [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 [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   [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   [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    QuoteType
t [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      Attr
attrs Text
s -> if Maybe Style -> Bool
forall a. Maybe a -> Bool
isNothing (WriterOptions -> Maybe Style
writerHighlightStyle WriterOptions
o)
      then Text -> OD m (Doc Text)
forall (m :: * -> *). Monad m => Text -> m (Doc Text)
unhighlighted Text
s
      else case SyntaxMap
-> (FormatOptions -> [SourceLine] -> [[Doc Text]])
-> Attr
-> Text
-> Either Text [[Doc Text]]
forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight (WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
o)
                  FormatOptions -> [SourceLine] -> [[Doc Text]]
formatOpenDocument Attr
attrs Text
s of
                Right [[Doc Text]]
h  -> 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] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ [[Doc Text]] -> [Doc Text]
forall a. Monoid a => [a] -> a
mconcat [[Doc Text]]
h
                Left Text
msg -> do
                  Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ 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
CouldNotHighlight Text
msg
                  Text -> OD m (Doc Text)
forall (m :: * -> *). Monad m => Text -> m (Doc Text)
unhighlighted Text
s
    Math      MathType
t 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      [Citation]
_ [Inline]
l -> WriterOptions -> [Inline] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
o [Inline]
l
    RawInline Format
f Text
s -> if Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"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 Attr
_ [Inline]
l (Text
s,Text
t) -> do
      [(Text, ReferenceType)]
identTypes <- (WriterState -> [(Text, ReferenceType)])
-> StateT WriterState m [(Text, ReferenceType)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [(Text, ReferenceType)]
stIdentTypes
      WriterOptions
-> [(Text, ReferenceType)] -> Text -> Text -> Doc Text -> Doc Text
mkLink WriterOptions
o [(Text, ReferenceType)]
identTypes Text
s Text
t (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 [Inline]
_ (Text
s,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        [Block]
l  -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT WriterState m (Doc Text)
mkNote [Block]
l
    where
      formatOpenDocument :: FormatOptions -> [SourceLine] -> [[Doc Text]]
      formatOpenDocument :: FormatOptions -> [SourceLine] -> [[Doc Text]]
formatOpenDocument FormatOptions
_fmtOpts = (SourceLine -> [Doc Text]) -> [SourceLine] -> [[Doc Text]]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> Doc Text) -> SourceLine -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Token -> Doc Text
toHlTok)
      toHlTok :: Token -> Doc Text
      toHlTok :: Token -> Doc Text
toHlTok (TokenType
toktype,Text
tok) =
        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
"text:span" [(Text
"text:style-name", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TokenType -> String
forall a. Show a => a -> String
show TokenType
toktype)] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
preformatted Text
tok
      unhighlighted :: Text -> m (Doc Text)
unhighlighted Text
s = Doc Text -> m (Doc Text)
forall (m :: * -> *) a. (Monad m, HasChars a) => Doc a -> m (Doc a)
inlinedCode (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
preformatted Text
s
      preformatted :: Text -> Doc Text
preformatted 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 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
"text:span" [(Text
"text:style-name", Text
"Source_Text")] Doc a
s
      mkImg :: (a, b, [(a, Text)]) -> Text -> p -> m (Doc a)
mkImg (a
_, b
_, [(a, Text)]
kvs) Text
s p
_ = do
               Int
id' <- (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 (\WriterState
st -> WriterState
st{ stImageId :: Int
stImageId = Int
id' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 })
               let getDims :: [(a, b)] -> [(a, b)]
getDims [] = []
                   getDims ((a
"width", b
w) :[(a, b)]
xs) = (a
"svg:width", b
w)  (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims ((a
"rel-width", b
w):[(a, b)]
xs) = (a
"style:rel-width", b
w) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims ((a
"height", b
h):[(a, b)]
xs) = (a
"svg:height", b
h) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims ((a
"rel-height", b
w):[(a, b)]
xs) = (a
"style:rel-height", b
w) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
                   getDims ((a, b)
_:[(a, b)]
xs) =                             [(a, b)] -> [(a, b)]
getDims [(a, b)]
xs
               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
"draw:frame"
                        ((Text
"draw:name", Text
"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 Text
"draw:image" [ (Text
"xlink:href"   , Text
s       )
                                                 , (Text
"xlink:type"   , Text
"simple")
                                                 , (Text
"xlink:show"   , Text
"embed" )
                                                 , (Text
"xlink:actuate", Text
"onLoad")]
      mkSpan :: Attr -> [Inline] -> OD m (Doc Text)
mkSpan Attr
attr [Inline]
xs =  do
        let (Text
ident,[Text]
_,[(Text, Text)]
_) = Attr
attr
            i :: OD m (Doc Text)
i = 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)
            mkBookmarkedSpan :: Doc Text -> Doc Text
mkBookmarkedSpan Doc Text
b =
              if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
b
                then Text -> Doc Text
selfClosingBookmark Text
ident
                else Text -> Doc Text -> Doc Text
inBookmarkTags Text
ident Doc Text
b
        if Text -> Bool
T.null Text
ident
          then OD m (Doc Text)
i
          else (Doc Text -> Doc Text) -> OD m (Doc Text) -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
mkBookmarkedSpan OD m (Doc Text)
i
      mkNote :: [Block] -> StateT WriterState m (Doc Text)
mkNote     [Block]
l = do
        Int
n <- [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 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
"text:note"
                         [ (Text
"text:id"        , Text
"ftn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n)
                         , (Text
"text:note-class", Text
"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
"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
+ Int
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
"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 Text
"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

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

bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc Text]))
bulletListStyle :: Int -> OD m (Int, (Int, [Doc Text]))
bulletListStyle Int
l = do
  let doStyles :: Int -> Doc Text
doStyles  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
"text:list-level-style-bullet"
                    [ (Text
"text:level"      , Int -> Text
forall a. Show a => a -> Text
tshow (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
                    , (Text
"text:style-name" , Text
"Bullet_20_Symbols"  )
                    , (Text
"style:num-suffix", Text
"."                  )
                    , (Text
"text:bullet-char", Char -> Text
T.singleton (String
bulletList String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
i))
                    ] (Int -> Doc Text
listLevelStyle (Int
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 [Int
8226,Int
9702,Int
9642]
      listElStyle :: [Doc Text]
listElStyle = (Int -> Doc Text) -> [Int] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc Text
doStyles [Int
0..Int
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 (Int
s,ListNumberStyle
n, ListNumberDelim
d) (Int
l,[Doc Text]
ls) =
    let suffix :: [(Text, Text)]
suffix    = case ListNumberDelim
d of
                      ListNumberDelim
OneParen  -> [(Text
"style:num-suffix", Text
")")]
                      ListNumberDelim
TwoParens -> [(Text
"style:num-prefix", Text
"(")
                                   ,(Text
"style:num-suffix", Text
")")]
                      ListNumberDelim
_         -> [(Text
"style:num-suffix", Text
".")]
        format :: Text
format    = case ListNumberStyle
n of
                      ListNumberStyle
UpperAlpha -> Text
"A"
                      ListNumberStyle
LowerAlpha -> Text
"a"
                      ListNumberStyle
UpperRoman -> Text
"I"
                      ListNumberStyle
LowerRoman -> Text
"i"
                      ListNumberStyle
_          -> Text
"1"
        listStyle :: Doc Text
listStyle = 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
"text:list-level-style-number"
                    ([ (Text
"text:level"      , Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
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
"text:style-name" , Text
"Numbering_20_Symbols")
                     , (Text
"style:num-format", Text
format                )
                     , (Text
"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 (Int
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 Int
i =
    let indent :: Text
indent = Double -> Text
forall a. Show a => a -> Text
tshow (Double
0.25 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
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 Text
"style:list-level-properties"
                       [ (Text
"text:list-level-position-and-space-mode",
                          Text
"label-alignment")
                       , (Text
"fo:text-align", Text
"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 Text
"style:list-level-label-alignment"
                      [ (Text
"text:label-followed-by", Text
"listtab")
                      , (Text
"text:list-tab-stop-position", Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in")
                      , (Text
"fo:text-indent", Text
"-0.25in")
                      , (Text
"fo:margin-left", Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"in")
                      ]

tableStyle :: Int -> Double -> [(Char,Double)] -> Doc Text
tableStyle :: Int -> Double -> [(Char, Double)] -> Doc Text
tableStyle Int
num Double
textWidth [(Char, Double)]
wcs =
    let tableId :: Text
tableId        = Text
"Table" 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
+ Int
1)
        tableWidthAttr :: [(Text,Text)]
        tableWidthAttr :: [(Text, Text)]
tableWidthAttr
          | Double
textWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1 Bool -> Bool -> Bool
&& Double
textWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = [(Text
"style:rel-width",
                                                String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
textWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) :: Int) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"%"))]
          | Bool
otherwise    = []
        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 Text
"style:style"
                         [(Text
"style:name", Text
tableId)
                         ,(Text
"style:family", Text
"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 Text
"style:table-properties"
                         ((Text
"table:align", Text
"center") (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
tableWidthAttr)
        colStyle :: (Char, a) -> Doc a
colStyle (Char
c,a
0) = Text -> [(Text, Text)] -> Doc a
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:style"
                         [ (Text
"style:name"  , Text
tableId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c)
                         , (Text
"style:family", Text
"table-column"       )]
        colStyle (Char
c,a
w) = 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
"style:style"
                         [ (Text
"style:name"  , Text
tableId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c)
                         , (Text
"style:family", Text
"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 Text
"style:table-column-properties"
                         [(Text
"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 String
"%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
* 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 Text
"style:style"
                         [ (Text
"style:name"  , Text
"TableHeaderRowCell")
                         , (Text
"style:family", Text
"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 Text
"style:table-cell-properties"
                         [ (Text
"fo:border", Text
"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 Text
"style:style"
                         [ (Text
"style:name"  , Text
"TableRowCell")
                         , (Text
"style:family", Text
"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 Text
"style:table-cell-properties"
                         [ (Text
"fo:border", Text
"none")]
        cellStyles :: Doc Text
cellStyles = if Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 [(Text, Text)]
attrs = do
  Int
pn <- Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)   Int
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
(*) (Double
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 = [ (Text
"style:name"             , Text
"P" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
pn)
                  , (Text
"style:family"           , Text
"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
(<>) Text
"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 Double
0.5 Double
i else Double
i
      tight :: [(Text, Text)]
tight     = if Bool
t then [ (Text
"fo:margin-top"          , Text
"0in"    )
                            , (Text
"fo:margin-bottom"       , Text
"0in"    )]
                       else []
      indent :: [(Text, Text)]
indent    = if Double
i Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0 Bool -> Bool -> Bool
|| Bool
b
                      then [ (Text
"fo:margin-left"         , Text
indentVal)
                           , (Text
"fo:margin-right"        , Text
"0in"    )
                           , (Text
"fo:text-indent"         , Text
"0in"    )
                           , (Text
"style:auto-text-indent" , Text
"false"  )]
                      else []
      attributes :: [(Text, Text)]
attributes = [(Text, Text)]
indent [(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
                             Text
"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 Text
"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

paraStyleFromParent :: PandocMonad m => Text -> [(Text,Text)] -> OD m Int
paraStyleFromParent :: Text -> [(Text, Text)] -> OD m Int
paraStyleFromParent Text
parent [(Text, Text)]
attrs = do
  Int
pn <- Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
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
  let styleAttr :: [(Text, Text)]
styleAttr = [ (Text
"style:name"             , Text
"P" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
pn)
                  , (Text
"style:family"           , Text
"paragraph")
                  , (Text
"style:parent-style-name", Text
parent)]
      paraProps :: Doc Text
paraProps = if [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
attrs
                     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
                          Text
"style:paragraph-properties" [(Text, Text)]
attrs
  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 Text
"style:style" [(Text, Text)]
styleAttr 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 Int
l = [(Text, Text)] -> OD m Int
forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Int
paraStyle
  [(Text
"style:parent-style-name",Text
"Text_20_body")
  ,(Text
"style:list-style-name", Text
"L" 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 Text
_ Int
_ [] = []
paraTableStyles Text
t Int
s (Alignment
a:[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 Text
"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
+ Int
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 Text
"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
+ Int
1) [Alignment]
xs
    | Bool
otherwise        = (Text
"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 a
sn = Text
"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
+ a
1)
          res :: a -> Text -> Doc a
res a
sn 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 Text
"style:style"
                     [ (Text
"style:name"             , a -> Text
forall a. (Show a, Num a) => a -> Text
pName a
sn        )
                     , (Text
"style:family"           , Text
"paragraph"     )
                     , (Text
"style:parent-style-name", Text
"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 Text
"style:paragraph-properties"
                     [ (Text
"fo:text-align", Text
x)
                     , (Text
"style:justify-single-word", Text
"false")]

data TextStyle = Italic
               | Bold
               | Under
               | Strike
               | Sub
               | Sup
               | SmallC
               | Pre
               | Language Lang
               deriving ( TextStyle -> TextStyle -> Bool
(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 Map Text Text
m 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 Text
"fo:font-style" Text
"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 Text
"style:font-style-asian" Text
"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 Text
"style:font-style-complex" Text
"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 Text
"fo:font-weight" Text
"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 Text
"style:font-weight-asian" Text
"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 Text
"style:font-weight-complex" Text
"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
Under  <- 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 Text
"style:text-underline-style" Text
"solid" (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 Text
"style:text-underline-width" Text
"auto" (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 Text
"style:text-underline-color" Text
"font-color" (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 Text
"style:text-line-through-style" Text
"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 Text
"style:text-position" Text
"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 Text
"style:text-position" Text
"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 Text
"fo:font-variant" Text
"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 Text
"style:font-name" Text
"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 Text
"style:font-name-asian" Text
"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 Text
"style:font-name-complex" Text
"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 <- 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 Text
"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 Text
"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 (Text
_,[Text]
_,[(Text, Text)]
kvs) OD m a
action =
  case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs of
       Maybe Text
Nothing -> OD m a
action
       Just Text
l  ->
         case Text -> Either Text Lang
parseBCP47 Text
l of
              Right 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 Text
_ -> 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