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

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

Conversion of 'Pandoc' documents to OpenDocument XML.
-}
module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where
import Control.Monad (unless, liftM, when)
import Control.Monad.State.Strict ( StateT(..), modify, gets, lift )
import Data.Char (chr, isDigit)
import Data.List (sortOn, sortBy)
import qualified Data.List as L
import qualified Data.Map as Map
import Data.Ord (comparing, Down (Down))
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Text.Collate.Lang (Lang (..), parseLang)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Translations (translateTerm)
import Text.Pandoc.Definition
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout hiding (link)
import Text.Pandoc.Shared (linesToPara, plainToPara, tshow, blocksToInlines)
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 (FormatOptions(..), SourceLine, Token)

-- Names of predefined styles in the reference.odt; see data/odt/styles.xml.
defaultBulletListStyleName, defaultNumberedListStyleName :: Text
defaultBulletListStyleName :: Text
defaultBulletListStyleName   = Text
"List_20_1"
defaultNumberedListStyleName :: Text
defaultNumberedListStyleName = Text
"Numbering_20_1"

bulletItemStyleName, bulletItemTightStyleName,
  numberItemStyleName, numberItemTightStyleName :: Text
bulletItemStyleName :: Text
bulletItemStyleName      = Text
"List_20_Bullet"
bulletItemTightStyleName :: Text
bulletItemTightStyleName = Text
"List_20_Bullet_20_Tight"
numberItemStyleName :: Text
numberItemStyleName      = Text
"List_20_Number"
numberItemTightStyleName :: Text
numberItemTightStyleName = Text
"List_20_Number_20_Tight"

-- | Predefined inline style names for single-style spans.
wellKnownTextStyle :: Set.Set TextStyle -> Maybe Text
wellKnownTextStyle :: Set TextStyle -> Maybe Text
wellKnownTextStyle Set TextStyle
s = case Set TextStyle -> [TextStyle]
forall a. Set a -> [a]
Set.toList Set TextStyle
s of
  [TextStyle
Italic] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Emphasis"
  [TextStyle
Bold]   -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Strong_20_Emphasis"
  [TextStyle
Strike] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Strikeout"
  [TextStyle
Sub]    -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Subscript"
  [TextStyle
Sup]    -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Superscript"
  [TextStyle
Pre]    -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Source_20_Text"
  [TextStyle]
_        -> Maybe Text
forall a. Maybe a
Nothing

--
-- OpenDocument writer
--

type OD m = StateT WriterState m

data ReferenceType
  = HeaderRef
  | TableRef
  | FigureRef

data Direction = LTR | RTL
  deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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
$ccompare :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord)

data WriterState =
    WriterState { WriterState -> Int
stNoteCount      :: Int
                , WriterState -> [Doc Text]
stTableStyles    :: [Doc Text]
                , WriterState -> Int
stTableStyleCount :: Int
                , WriterState -> [Doc Text]
stParaStyles     :: [Doc Text]
                , WriterState -> Int
stParaStyleCount :: Int
                , WriterState -> Map ([(Text, Text)], [(Text, Text)]) Text
stParaStyleCache :: Map.Map ([(Text,Text)],[(Text,Text)]) Text
                  -- ^ cache of automatic paragraph styles, keyed on
                  -- (style attributes, paragraph properties)
                , WriterState
-> Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text)
stListOverrides  :: Map.Map (ListNumberStyle,ListNumberDelim)
                                        (Text, Doc Text)
                , WriterState -> Map (Set TextStyle) (Int, Doc Text)
stTextStyles     :: Map.Map (Set.Set TextStyle)
                                        (Int, Doc Text)
                  -- ^ automatic text styles, with the number that
                  -- makes up the style's @Tn@ name
                , WriterState -> Set TextStyle
stTextStyleAttr  :: Set.Set TextStyle
                , WriterState -> Int
stIndentPara     :: Int
                , WriterState -> Bool
stInDefinition   :: Bool
                , WriterState -> Bool
stFirstPara      :: Bool
                , WriterState -> Int
stImageId        :: Int
                , WriterState -> Int
stTableCaptionId :: Int
                , WriterState -> Int
stImageCaptionId :: Int
                , WriterState -> Map Text ReferenceType
stIdentTypes     :: Map.Map Text ReferenceType
                , WriterState -> Maybe Direction
stDirection      :: Maybe Direction
                  -- ^ active writing mode
                }

defaultWriterState :: WriterState
defaultWriterState :: WriterState
defaultWriterState =
    WriterState { stNoteCount :: Int
stNoteCount      = Int
0
                , stTableStyles :: [Doc Text]
stTableStyles    = []
                , stTableStyleCount :: Int
stTableStyleCount = Int
0
                , stParaStyles :: [Doc Text]
stParaStyles     = []
                , stParaStyleCount :: Int
stParaStyleCount = Int
0
                , stParaStyleCache :: Map ([(Text, Text)], [(Text, Text)]) Text
stParaStyleCache = Map ([(Text, Text)], [(Text, Text)]) Text
forall k a. Map k a
Map.empty
                , stListOverrides :: Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text)
stListOverrides  = Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text)
forall k a. Map k a
Map.empty
                , stTextStyles :: Map (Set TextStyle) (Int, Doc Text)
stTextStyles     = Map (Set TextStyle) (Int, 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
                , stFirstPara :: Bool
stFirstPara      = Bool
False
                , stImageId :: Int
stImageId        = Int
1
                , stTableCaptionId :: Int
stTableCaptionId = Int
1
                , stImageCaptionId :: Int
stImageCaptionId = Int
1
                , stIdentTypes :: Map Text ReferenceType
stIdentTypes     = Map Text ReferenceType
forall k a. Map k a
Map.empty
                , stDirection :: Maybe Direction
stDirection      = Maybe Direction
forall a. Maybe a
Nothing
                }

addTableStyle :: PandocMonad m => Doc Text -> OD m ()
addTableStyle :: forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addTableStyle Doc Text
i = (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 { stTableStyles = i : stTableStyles s
    , stTableStyleCount = stTableStyleCount s + 1 }

addParaStyle :: PandocMonad m => Doc Text -> OD m ()
addParaStyle :: forall (m :: * -> *). PandocMonad m => Doc Text -> OD m ()
addParaStyle Doc Text
i = (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 { stParaStyles = i : stParaStyles s
    , stParaStyleCount = stParaStyleCount s + 1 }

addTextStyle :: PandocMonad m
             => Set.Set TextStyle -> (Int, Doc Text) -> OD m ()
addTextStyle :: forall (m :: * -> *).
PandocMonad m =>
Set TextStyle -> (Int, Doc Text) -> OD m ()
addTextStyle Set TextStyle
attrs (Int, Doc Text)
i = (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 { stTextStyles = Map.insert attrs i (stTextStyles s) }

increaseIndent :: PandocMonad m => OD m ()
increaseIndent :: forall (m :: * -> *). PandocMonad m => OD m ()
increaseIndent = (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 { stIndentPara = 1 + stIndentPara s }

resetIndent :: PandocMonad m => OD m ()
resetIndent :: forall (m :: * -> *). PandocMonad m => OD m ()
resetIndent = (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 { stIndentPara = stIndentPara s - 1 }

setInDefinitionList :: PandocMonad m => Bool -> OD m ()
setInDefinitionList :: forall (m :: * -> *). PandocMonad m => Bool -> OD m ()
setInDefinitionList Bool
b = (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 { stInDefinition = b }

setFirstPara :: PandocMonad m => OD m ()
setFirstPara :: forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara =  (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 { stFirstPara = True }

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

withAlteredTextStyles :: PandocMonad m
                       => (Set.Set TextStyle -> Set.Set TextStyle) -> OD m a -> OD m a
withAlteredTextStyles :: forall (m :: * -> *) a.
PandocMonad m =>
(Set TextStyle -> Set TextStyle) -> OD m a -> OD m a
withAlteredTextStyles Set TextStyle -> Set TextStyle
f OD m a
action = do
  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
  modify $ \WriterState
st -> WriterState
st{ stTextStyleAttr = f oldTextStyleAttr }
  res <- action
  modify $ \WriterState
st -> WriterState
st{ stTextStyleAttr = oldTextStyleAttr }
  return res

withTextStyle :: PandocMonad m => TextStyle -> OD m a -> OD m a
withTextStyle :: forall (m :: * -> *) a.
PandocMonad m =>
TextStyle -> OD m a -> OD m a
withTextStyle TextStyle
s = (Set TextStyle -> Set TextStyle) -> OD m a -> OD m a
forall (m :: * -> *) a.
PandocMonad m =>
(Set TextStyle -> Set TextStyle) -> OD m a -> OD m a
withAlteredTextStyles (TextStyle -> Set TextStyle -> Set TextStyle
forall a. Ord a => a -> Set a -> Set a
Set.insert TextStyle
s)

withDirection :: PandocMonad m => Maybe Direction -> OD m a -> OD m a
withDirection :: forall (m :: * -> *) a.
PandocMonad m =>
Maybe Direction -> OD m a -> OD m a
withDirection Maybe Direction
mbdir OD m a
action = do
  olddir <- (WriterState -> Maybe Direction)
-> StateT WriterState m (Maybe Direction)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe Direction
stDirection
  modify $ \WriterState
st -> WriterState
st{ stDirection = mbdir }
  res <- action
  modify $ \WriterState
st -> WriterState
st{ stDirection = olddir }
  return res

-- | Apply the writing direction from a @dir@ attribute, if present.
withDirFromAttr :: PandocMonad m => Attr -> OD m a -> OD m a
withDirFromAttr :: forall (m :: * -> *) a. PandocMonad m => Attr -> OD m a -> OD m a
withDirFromAttr (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
"dir" [(Text, Text)]
kvs of
    Just Text
"rtl" -> Maybe Direction -> OD m a -> OD m a
forall (m :: * -> *) a.
PandocMonad m =>
Maybe Direction -> OD m a -> OD m a
withDirection (Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
RTL) OD m a
action
    Just Text
"ltr" -> Maybe Direction -> OD m a -> OD m a
forall (m :: * -> *) a.
PandocMonad m =>
Maybe Direction -> OD m a -> OD m a
withDirection (Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
LTR) OD m a
action
    Maybe Text
_          -> OD m a
action

inTextStyle :: PandocMonad m => Doc Text -> OD m (Doc Text)
inTextStyle :: forall (m :: * -> *). PandocMonad m => Doc Text -> OD m (Doc Text)
inTextStyle Doc Text
d = do
  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.null at
     then return d
     else case wellKnownTextStyle at of
       Just Text
styleName -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$
         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
Nothing -> do
         styles <- (WriterState -> Map (Set TextStyle) (Int, Doc Text))
-> StateT WriterState m (Map (Set TextStyle) (Int, Doc Text))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map (Set TextStyle) (Int, Doc Text)
stTextStyles
         case Map.lookup at styles of
              Just (Int
num, Doc Text
_) -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                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", Int -> Text
textStyleName Int
num)] Doc Text
d
              Maybe (Int, Doc Text)
Nothing -> do
                let num :: Int
num = Map (Set TextStyle) (Int, Doc Text) -> Int
forall k a. Map k a -> Int
Map.size Map (Set TextStyle) (Int, Doc Text)
styles Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    styleName :: Text
styleName = Int -> Text
textStyleName Int
num
                Set TextStyle -> (Int, Doc Text) -> OD m ()
forall (m :: * -> *).
PandocMonad m =>
Set TextStyle -> (Int, Doc Text) -> OD m ()
addTextStyle Set TextStyle
at (Int
num,
                       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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.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 -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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

-- | Name of the @n@th automatic text style.
textStyleName :: Int -> Text
textStyleName :: Int -> Text
textStyleName Int
num = Text
"T" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
num

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
"text")
                                                  ,(Text
"style:horizontal-pos", Text
"center")
                                                  ,(Text
"style:horizontal-rel", Text
"paragraph-content")
                                                  ,(Text
"style:wrap",           Text
"none")]

inBookmarkTags :: Text -> Doc Text -> Doc Text
inBookmarkTags :: Text -> Doc Text -> Doc Text
inBookmarkTags Text
ident Doc Text
d =
  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 :: forall (m :: * -> *).
PandocMonad m =>
Int -> Text -> Doc Text -> OD m (Doc Text)
inHeaderTags Int
i Text
ident Doc Text
d = do
  sty <- Text -> OD m Text
forall (m :: * -> *). PandocMonad m => Text -> OD m Text
dirStyleFor (Text
"Heading_20_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i)
  return $ inTags False "text:h" [ ("text:style-name", sty)
                                 , ("text:outline-level", tshow i)]
         $ if T.null ident
              then d
              else inBookmarkTags ident 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) -> Doc Text
tabTag 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
    tabTag :: Doc Text
tabTag = Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"text:tab" []
    -- collapse a run of spaces into a single <text:s>
    genTag :: Text -> Doc Text
genTag Text
t = let (Text
spaces, Text
t') = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
t
               in  Int -> Doc Text
forall {a} {a}. (Eq a, Num a, HasChars a, Show a) => a -> Doc a
tag (Text -> Int
T.length Text
spaces) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
rm Text
t'
    tag :: a -> Doc a
tag a
0  = Doc a
forall a. Doc a
empty
    tag a
n  = Text -> [(Text, Text)] -> Doc a
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)]
    -- emit text verbatim up to the next space or tab; a lone space is
    -- kept literal and any further ones become a <text:s>
    rm :: Text -> Doc Text
rm Text
t = let (Text
chunk, Text
t') = (Char -> Bool) -> Text -> (Text, Text)
T.break (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') Text
t
               pre :: Doc Text
pre = if Text -> Bool
T.null Text
chunk then Doc Text
forall a. Doc a
empty else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
chunk
           in  case Text -> Maybe (Char, Text)
T.uncons Text
t' of
                 Just (Char
' ', Text
xs) -> Doc Text
pre 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
' ' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
genTag Text
xs
                 Just (Char
_  , Text
xs) -> Doc Text
pre Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
tabTag Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
genTag Text
xs
                 Maybe (Char, Text)
Nothing        -> Doc Text
pre

-- | Convert Pandoc document to string in OpenDocument format.
writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOpenDocument WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  Meta -> m ()
forall (m :: * -> *). PandocMonad m => Meta -> m ()
setupTranslations Meta
meta
  -- The abstract is the one template field that takes block-level
  -- content, so it is rendered separately; everything else in the
  -- metadata goes in a context where only inlines are allowed.
  let abstractBlocks :: [Block]
abstractBlocks = case Text -> Meta -> [Block]
lookupMetaBlocks Text
"abstract" Meta
meta of
                         [] -> []
                         [Block]
xs -> [Attr -> [Block] -> Block
Div (Text
"",[],[(Text
"custom-style",Text
"Abstract")]) [Block]
xs]
  let meta' :: Meta
meta' = Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
B.deleteMeta Text
"abstract" Meta
meta
  -- Set the default writing direction from the "dir" metadata field;
  -- in its absence, a right-to-left main language implies RTL.
  let mbDir :: Maybe Direction
mbDir = case Text -> Meta -> Text
lookupMetaString Text
"dir" Meta
meta of
                Text
"rtl" -> Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
RTL
                Text
"ltr" -> Maybe Direction
forall a. Maybe a
Nothing
                Text
_     -> case WriterOptions -> Meta -> Maybe Text
getLang WriterOptions
opts Meta
meta of
                           Just Text
l | Right Lang
lang <- Text -> Either String Lang
parseLang Text
l
                                  , Lang -> Bool
isRTLLang Lang
lang -> Direction -> Maybe Direction
forall a. a -> Maybe a
Just Direction
RTL
                           Maybe Text
_ -> Maybe Direction
forall a. Maybe a
Nothing
  ((body, abstract, metadata),s) <- (StateT WriterState m (Doc Text, Doc Text, Context Text)
 -> WriterState
 -> m ((Doc Text, Doc Text, Context Text), WriterState))
-> WriterState
-> StateT WriterState m (Doc Text, Doc Text, Context Text)
-> m ((Doc Text, Doc Text, Context Text), WriterState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT WriterState m (Doc Text, Doc Text, Context Text)
-> WriterState
-> m ((Doc Text, Doc Text, Context Text), WriterState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
        WriterState
defaultWriterState{ stDirection = mbDir } (StateT WriterState m (Doc Text, Doc Text, Context Text)
 -> m ((Doc Text, Doc Text, Context Text), WriterState))
-> StateT WriterState m (Doc Text, Doc Text, Context Text)
-> m ((Doc Text, Doc Text, Context Text), WriterState)
forall a b. (a -> b) -> a -> b
$ do
           let collectBlockIdent :: Block -> [(Text, ReferenceType)]
collectBlockIdent (Header Int
_ Attr
attr [Inline]
_)      = ReferenceType -> Attr -> [(Text, ReferenceType)]
forall {b} {b} {c}. b -> (Text, b, c) -> [(Text, b)]
identRef ReferenceType
HeaderRef Attr
attr
               collectBlockIdent (Figure Attr
attr Caption
_ [Block]
_ )     = ReferenceType -> Attr -> [(Text, ReferenceType)]
forall {b} {b} {c}. b -> (Text, b, c) -> [(Text, b)]
identRef ReferenceType
FigureRef Attr
attr
               collectBlockIdent (Table Attr
attr Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_) = ReferenceType -> Attr -> [(Text, ReferenceType)]
forall {b} {b} {c}. b -> (Text, b, c) -> [(Text, b)]
identRef ReferenceType
TableRef Attr
attr
               collectBlockIdent Block
_                      = []
               identRef :: b -> (Text, b, c) -> [(Text, b)]
identRef b
ty (Text
ident,b
_,c
_)
                 | Text -> Bool
T.null Text
ident = []
                 | Bool
otherwise    = [(Text
ident, b
ty)]
           -- only needed to resolve cross references
           Bool -> StateT WriterState m () -> StateT WriterState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_name WriterOptions
opts Bool -> Bool -> Bool
||
                 Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_xrefs_number WriterOptions
opts) (StateT WriterState m () -> StateT WriterState m ())
-> StateT WriterState m () -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$
             (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 =
                                 Map.fromListWith (\ReferenceType
_ ReferenceType
old -> ReferenceType
old)
                                   (query collectBlockIdent blocks) }
           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 -> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m (Doc Text)
inlinesToOpenDocument WriterOptions
opts ([Inline] -> StateT WriterState m (Doc Text))
-> ([Block] -> [Inline])
-> [Block]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Inline]
blocksToInlines)
                  ((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
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'
           a <- blocksToOpenDocument opts abstractBlocks
           b <- blocksToOpenDocument opts blocks
           return (b, a, m)
  -- 'styles' is reversed below, so the text styles are put in
  -- descending order here to come out as T1, T2, ..., T10
  let 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]
++
                     ((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 b. (a, b) -> b
snd (((Int, Doc Text) -> (Int, Doc Text) -> Ordering)
-> [(Int, Doc Text)] -> [(Int, Doc Text)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, Doc Text) -> Down Int)
-> (Int, Doc Text) -> (Int, Doc Text) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int)
-> ((Int, Doc Text) -> Int) -> (Int, Doc Text) -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Doc Text) -> Int
forall a b. (a, b) -> a
fst)) (
                        Map (Set TextStyle) (Int, Doc Text) -> [(Int, Doc Text)]
forall k a. Map k a -> [a]
Map.elems (WriterState -> Map (Set TextStyle) (Int, Doc Text)
stTextStyles WriterState
s)))
  let listStyles  = ((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 (Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text)
-> [(Text, Doc Text)]
forall k a. Map k a -> [a]
Map.elems (WriterState
-> Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text)
stListOverrides WriterState
s))
  let 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]
styles [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Doc Text]
listStyles
  let 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) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
abstractBlocks
                    then Context Text -> Context Text
forall a. a -> a
id
                    else Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"abstract" Doc Text
abstract)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  return $ renderWithTemplate opts context body

withParagraphStyle :: PandocMonad m
                   => WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
s [Block]
bs = do
  s' <- Text -> OD m Text
forall (m :: * -> *). PandocMonad m => Text -> OD m Text
dirStyleFor Text
s
  -- 'Plain' is treated like 'Para' so that the requested style is not
  -- lost (e.g. for metadata fields, figure bodies, or tight list items)
  let go (Block
b:[Block]
bs')
        | Para  [Inline]
l <- Block
b = [Block] -> Doc Text -> StateT WriterState m (Doc Text)
cont [Block]
bs' (Doc Text -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Inline] -> StateT WriterState m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
[Inline] -> StateT WriterState m (Doc Text)
styled [Inline]
l
        | Plain [Inline]
l <- Block
b = [Block] -> Doc Text -> StateT WriterState m (Doc Text)
cont [Block]
bs' (Doc Text -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Inline] -> StateT WriterState m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
[Inline] -> StateT WriterState m (Doc Text)
styled [Inline]
l
        | Bool
otherwise    = [Block] -> Doc Text -> StateT WriterState m (Doc Text)
cont [Block]
bs' (Doc Text -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WriterOptions -> Block -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument WriterOptions
o Block
b
      go [] = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
      cont [Block]
bs' 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
<$> [Block] -> StateT WriterState m (Doc Text)
go [Block]
bs'
      styled [Inline]
l = Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle Text
s' (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 bs

inPreformattedTags :: [Doc Text] -> Doc Text
inPreformattedTags :: [Doc Text] -> Doc Text
inPreformattedTags [Doc Text]
s =
  Text -> Doc Text -> Doc Text
inParagraphTagsWithStyle Text
"Preformatted_20_Text" (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]
s

-- | Get the list-style name to use for an ordered list with the given
-- numbering style and delimiter, registering an override automatic style
-- if needed.  Lists with default style/delimiter use the predefined
-- @Numbering_20_1@ style and no override is generated.
orderedListStyleName :: PandocMonad m
                     => ListNumberStyle -> ListNumberDelim -> OD m Text
orderedListStyleName :: forall (m :: * -> *).
PandocMonad m =>
ListNumberStyle -> ListNumberDelim -> OD m Text
orderedListStyleName ListNumberStyle
ns ListNumberDelim
nd
  | (ListNumberStyle
ns ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
DefaultStyle Bool -> Bool -> Bool
|| ListNumberStyle
ns ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
Decimal) Bool -> Bool -> Bool
&&
    (ListNumberDelim
nd ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
DefaultDelim Bool -> Bool -> Bool
|| ListNumberDelim
nd ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
Period) =
      Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
defaultNumberedListStyleName
  | Bool
otherwise = do
      overrides <- (WriterState
 -> Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text))
-> StateT
     WriterState
     m
     (Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState
-> Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text)
stListOverrides
      case Map.lookup (ns, nd) overrides of
        Just (Text
name, Doc Text
_) -> Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
name
        Maybe (Text, Doc Text)
Nothing -> do
          let name :: Text
name = Text
"Pandoc_5f_Numbering_5f_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                       Int -> Text
forall a. Show a => a -> Text
tshow (Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text) -> Int
forall k a. Map k a -> Int
Map.size Map (ListNumberStyle, ListNumberDelim) (Text, Doc Text)
overrides Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              doc :: Doc Text
doc = 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-style"
                      [(Text
"style:name", Text
name)]
                      ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ((Int -> Doc Text) -> [Int] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (ListNumberStyle -> ListNumberDelim -> Int -> Doc Text
orderedListLevel ListNumberStyle
ns ListNumberDelim
nd) [Int
1..Int
10]))
          (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 { stListOverrides =
                               Map.insert (ns, nd) (name, doc)
                                          (stListOverrides s) }
          Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
name

orderedListLevel :: ListNumberStyle -> ListNumberDelim -> Int -> Doc Text
orderedListLevel :: ListNumberStyle -> ListNumberDelim -> Int -> Doc Text
orderedListLevel ListNumberStyle
ns ListNumberDelim
nd Int
lvl =
    let suffix :: [(Text, Text)]
suffix = case ListNumberDelim
nd 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
ns of
                   ListNumberStyle
UpperAlpha -> Text
"A"
                   ListNumberStyle
LowerAlpha -> Text
"a"
                   ListNumberStyle
UpperRoman -> Text
"I"
                   ListNumberStyle
LowerRoman -> Text
"i"
                   ListNumberStyle
_          -> Text
"1"
    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
"text:list-level-style-number"
              ([ (Text
"text:level"      , Int -> Text
forall a. Show a => a -> Text
tshow Int
lvl)
               , (Text
"text:style-name" , Text
"Numbering_20_Symbols")
               , (Text
"style:num-format", Text
format)
               ] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
suffix)
              (Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"style:list-level-properties"
                 [ (Text
"text:space-before",
                      String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.4fin" (Double
0.1972 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) :: Double)))
                 , (Text
"text:min-label-width", Text
"0.1965in")
                 , (Text
"text:min-label-distance", Text
"0.1in")
                 ])

orderedListToOpenDocument :: PandocMonad m
                          => WriterOptions -> Text -> [[Block]]
                          -> OD m (Doc Text)
orderedListToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [[Block]] -> OD m (Doc Text)
orderedListToOpenDocument WriterOptions
o Text
paraName [[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]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ([Block] -> StateT WriterState m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Text -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
orderedItemToOpenDocument WriterOptions
o Text
paraName ([Block] -> StateT WriterState m (Doc Text))
-> ([Block] -> [Block])
-> [Block]
-> StateT WriterState 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 -> Text -> [Block]
                          -> OD m (Doc Text)
orderedItemToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
orderedItemToOpenDocument  WriterOptions
o Text
paraName [Block]
bs = [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
<$> (Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> StateT WriterState 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)
orderedList ListAttributes
a [[Block]]
l
       go (Para          [Inline]
l) = do
         sty <- Text -> OD m Text
forall (m :: * -> *). PandocMonad m => Text -> OD m Text
dirStyleFor Text
paraName
         inParagraphTagsWithStyle sty <$> inlinesToOpenDocument o 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
       orderedList :: ListAttributes -> [[Block]] -> StateT WriterState m (Doc Text)
orderedList a :: ListAttributes
a@(Int
_,ListNumberStyle
ns,ListNumberDelim
nd) [[Block]]
l = do
         lstName <- ListNumberStyle -> ListNumberDelim -> OD m Text
forall (m :: * -> *).
PandocMonad m =>
ListNumberStyle -> ListNumberDelim -> OD m Text
orderedListStyleName ListNumberStyle
ns ListNumberDelim
nd
         let pn = if [[Block]] -> Bool
isTightList [[Block]]
l then Text
numberItemTightStyleName
                                   else Text
numberItemStyleName
         let listAttrs = (Text
"text:style-name", Text
lstName) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: ListAttributes -> [(Text, Text)]
startValueAttr ListAttributes
a
         inTags True "text:list" listAttrs <$>
           orderedListToOpenDocument o pn l

-- | Generate a @text:start-value@ attribute when the start value is not 1.
startValueAttr :: ListAttributes -> [(Text, Text)]
startValueAttr :: ListAttributes -> [(Text, Text)]
startValueAttr (Int
s,ListNumberStyle
_,ListNumberDelim
_) | Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 = [(Text
"text:start-value", Int -> Text
forall a. Show a => a -> Text
tshow Int
s)]
startValueAttr ListAttributes
_                = []

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

bulletListToOpenDocument :: PandocMonad m
                         => WriterOptions -> [[Block]] -> OD m (Doc Text)
bulletListToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> OD m (Doc Text)
bulletListToOpenDocument WriterOptions
o [[Block]]
b = do
  let pn :: Text
pn = if [[Block]] -> Bool
isTightList [[Block]]
b then Text
bulletItemTightStyleName
                            else Text
bulletItemStyleName
  is <- Text -> WriterOptions -> [[Block]] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> WriterOptions -> [[Block]] -> OD m (Doc Text)
listItemsToOpenDocument Text
pn WriterOptions
o [[Block]]
b
  return $ inTags True "text:list"
             [("text:style-name", defaultBulletListStyleName)] is

listItemsToOpenDocument :: PandocMonad m
                        => Text -> WriterOptions -> [[Block]] -> OD m (Doc Text)
listItemsToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
Text -> WriterOptions -> [[Block]] -> OD m (Doc Text)
listItemsToOpenDocument Text
s WriterOptions
o [[Block]]
is =
    [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]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> StateT WriterState m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (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] -> StateT WriterState m (Doc Text))
-> ([Block] -> [Block])
-> [Block]
-> StateT WriterState 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> OD m (Doc Text)
deflistItemToOpenDocument WriterOptions
o ([Inline]
t,[[Block]]
d) = do
  let ts :: Text
ts = if [[Block]] -> Bool
isTightList [[Block]]
d
           then Text
"Definition_20_Term_20_Tight"       else Text
"Definition_20_Term"
      ds :: Text
ds = if [[Block]] -> Bool
isTightList [[Block]]
d
           then Text
"Definition_20_Definition_20_Tight" else Text
"Definition_20_Definition"
  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]
  d' <- liftM vcat $ mapM (withParagraphStyle o ds . map plainToPara) d
  return $ t' $$ d'

inBlockQuote :: PandocMonad m
             => WriterOptions -> Text -> [Block] -> OD m (Doc Text)
inBlockQuote :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
inBlockQuote  WriterOptions
o Text
sty (Block
b:[Block]
bs)
    | BlockQuote [Block]
l <- Block
b = do OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
increaseIndent
                             ni <- [(Text, Text)] -> OD m Text
forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Text
paraStyle
                                   [(Text
"style:parent-style-name",Text
"Quotations")]
                             inner <- inBlockQuote o ni (map plainToPara l)
                             resetIndent
                             go inner
    | Para       [Inline]
l <- Block
b = Doc Text -> OD m (Doc Text)
forall (m :: * -> *). PandocMonad m => Doc Text -> OD 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
sty (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 -> OD 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 -> Text -> [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
inBlockQuote WriterOptions
o Text
sty [Block]
bs
inBlockQuote     WriterOptions
_ Text
_ [] = Doc Text -> OD m (Doc Text)
forall a. a -> StateT WriterState m a
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 :: forall (m :: * -> *).
PandocMonad m =>
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]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> StateT WriterState 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> OD m (Doc Text)
blockToOpenDocument WriterOptions
o = \case
    Plain          [Inline]
b -> if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
b
                        then Doc Text -> OD m (Doc Text)
forall a. a -> StateT WriterState m a
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 -> OD 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           [Inline]
b -> if [Inline] -> Bool
forall a. [a] -> 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 a. a -> StateT WriterState m a
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 -> OD 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 -> 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      -> 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 -> do
      OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara
      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 -> OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall a b.
StateT WriterState m a
-> StateT WriterState m b -> StateT WriterState m b
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 -> OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall a b.
StateT WriterState m a
-> StateT WriterState m b -> StateT WriterState m b
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 -> OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall a b.
StateT WriterState m a
-> StateT WriterState m b -> StateT WriterState m b
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 -> OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall a b.
StateT WriterState m a
-> StateT WriterState m b -> StateT WriterState m b
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
attrs Text
s -> do
      OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara
      let highlighted :: OD m (Doc Text)
highlighted =
            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 a. a -> StateT WriterState m a
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. 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) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (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:p"
                                          [(Text
"text:style-name",
                                            Text
"Preformatted_20_Text")] (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
hcat) [[Doc Text]]
h
                Left Text
msg -> do
                  Bool -> OD m () -> OD m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg) (OD m () -> OD m ()) -> OD m () -> OD m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> OD m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> OD m ()) -> LogMessage -> OD m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotHighlight Text
msg
                  Text -> OD m (Doc Text)
forall {f :: * -> *}. Applicative f => Text -> f (Doc Text)
unhighlighted Text
s
      case WriterOptions -> HighlightMethod
writerHighlightMethod WriterOptions
o of
        Skylighting {} -> OD m (Doc Text)
highlighted
        HighlightMethod
DefaultHighlighting -> OD m (Doc Text)
highlighted
        HighlightMethod
_ -> Text -> OD m (Doc Text)
forall {f :: * -> *}. Applicative f => Text -> f (Doc Text)
unhighlighted Text
s
    Table Attr
a Caption
bc [ColSpec]
s TableHead
th [TableBody]
tb TableFoot
tf -> OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall a b.
StateT WriterState m a
-> StateT WriterState m b -> StateT WriterState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                              WriterOptions -> Table -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Table -> OD m (Doc Text)
table WriterOptions
o (Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Ann.toTable Attr
a Caption
bc [ColSpec]
s TableHead
th [TableBody]
tb TableFoot
tf)
    Block
HorizontalRule   -> OD m ()
forall (m :: * -> *). PandocMonad m => OD m ()
setFirstPara OD m () -> OD m (Doc Text) -> OD m (Doc Text)
forall a b.
StateT WriterState m a
-> StateT WriterState m b -> StateT WriterState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Doc Text -> OD m (Doc Text)
forall a. a -> StateT WriterState m a
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") ])
    b :: Block
b@(RawBlock 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 a. a -> StateT WriterState m a
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
forall a. HasChars a => a -> Doc a
literal Text
s
                        else Doc Text
forall a. Doc a
empty Doc Text -> OD m () -> OD m (Doc Text)
forall a b. a -> StateT WriterState m b -> StateT WriterState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> OD m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
    Figure Attr
a Caption
capt [Block]
b  -> WriterOptions -> Attr -> Caption -> [Block] -> OD m (Doc Text)
forall {m :: * -> *} {b} {c}.
PandocMonad m =>
WriterOptions
-> (Text, b, c) -> Caption -> [Block] -> OD m (Doc Text)
figure WriterOptions
o Attr
a Caption
capt [Block]
b
    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
                           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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
                           setInDefinitionList False
                           return r
      unhighlighted :: Text -> f (Doc Text)
unhighlighted Text
s = Doc Text -> f (Doc Text)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> f (Doc Text)) -> Doc Text -> f (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$
            ((Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (([Doc Text] -> Doc Text
inPreformattedTags ([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]
forall a. a -> [a] -> [a]
:[])) (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
preformatted) (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
withDirFromAttr 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
$ 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 a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
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 sty <- [(Text, Text)] -> OD m Text
forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Text
paraStyle
                                    [(Text
"style:parent-style-name",Text
"Quotations")]
                           inBlockQuote o sty (map plainToPara b)
      orderedList :: ListAttributes -> [[Block]] -> StateT WriterState m (Doc Text)
orderedList a :: ListAttributes
a@(Int
_,ListNumberStyle
ns,ListNumberDelim
nd) [[Block]]
b = do
        lstName <- ListNumberStyle -> ListNumberDelim -> OD m Text
forall (m :: * -> *).
PandocMonad m =>
ListNumberStyle -> ListNumberDelim -> OD m Text
orderedListStyleName ListNumberStyle
ns ListNumberDelim
nd
        let pn = if [[Block]] -> Bool
isTightList [[Block]]
b then Text
numberItemTightStyleName
                                  else Text
numberItemStyleName
        let listAttrs = (Text
"text:style-name", Text
lstName) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: ListAttributes -> [(Text, Text)]
startValueAttr ListAttributes
a
        inTags True "text:list" listAttrs <$>
          orderedListToOpenDocument o pn b
      table :: PandocMonad m => WriterOptions -> Ann.Table -> OD m (Doc Text)
      table :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Table -> OD m (Doc Text)
table WriterOptions
opts
          (Ann.Table (Text
ident, [Text]
_, [(Text, Text)]
_) (Caption Maybe [Inline]
_ [Block]
c) [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) = do
        tn <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stTableStyleCount
        pn <- gets stParaStyleCount
        let  genIds      = (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
colLetters [Int
0..]
             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)
             (aligns, mwidths) = unzip colspecs
             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 = (ColWidth -> Double) -> [ColWidth] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ColWidth -> Double
fromWidth [ColWidth]
mwidths
             textWidth   = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
             columnIds   = [Text] -> [Double] -> [(Text, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
genIds [Double]
widths
             mkColumn  (Text, 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
<> (Text, b) -> Text
forall a b. (a, b) -> a
fst (Text, b)
n)]
             columns     = ((Text, Double) -> Doc Text) -> [(Text, Double)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Double) -> Doc Text
forall {a} {b}. HasChars a => (Text, b) -> Doc a
mkColumn [(Text, Double)]
columnIds
             paraHStyles = Text -> Int -> [Alignment] -> [(Text, Doc Text)]
paraTableStyles Text
"Heading"  Int
pn [Alignment]
aligns
             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 a. [a] -> 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) -> [(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)
        addTableStyle $ tableStyle tn textWidth columnIds
        mapM_ addParaStyle . newPara $ paraHStyles ++ paraStyles
        captionDoc <- if null c
                      then return empty
                      else inlinesToOpenDocument o (blocksToInlines c) >>=
                             if isEnabled Ext_native_numbering o
                                then numberedTableCaption ident
                                else unNumberedCaption "TableCaption"
        th <- colHeadsToOpenDocument o (map fst paraHStyles) thead
        tr <- mapM (tableBodyToOpenDocument o (map fst paraHStyles) (map fst paraStyles)) tbodies
        tf <- tableFootToOpenDocument o (map fst paraStyles) tfoot
        let 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 -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
tf)
        return $
          case writerTableCaptionPosition opts of
            CaptionPosition
CaptionAbove -> Doc Text
captionDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
tableDoc
            CaptionPosition
CaptionBelow -> Doc Text
tableDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
captionDoc
      figure :: WriterOptions
-> (Text, b, c) -> Caption -> [Block] -> OD m (Doc Text)
figure WriterOptions
opts (Text
ident, b
_, c
_) (Caption Maybe [Inline]
_ [Block]
longcapt) [Block]
body =
        case [Block] -> [Inline]
blocksToInlines [Block]
longcapt of
          [] ->
            WriterOptions -> Text -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
"Figure" [Block]
body
          [Inline]
caption -> do
            imageDoc <- WriterOptions -> Text -> [Block] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> [Block] -> OD m (Doc Text)
withParagraphStyle WriterOptions
o Text
"FigureWithCaption" [Block]
body
            captionDoc <- inlinesToOpenDocument o caption >>=
                          if isEnabled Ext_native_numbering o
                          then numberedFigureCaption ident
                          else unNumberedCaption "FigureCaption"
            return $
              case writerFigureCaptionPosition opts of
                CaptionPosition
CaptionAbove -> Doc Text
captionDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
imageDoc
                CaptionPosition
CaptionBelow -> 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 :: forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> OD m (Doc Text)
numberedTableCaption Text
ident Doc Text
caption = do
    id' <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stTableCaptionId
    modify (\WriterState
st -> WriterState
st{ stTableCaptionId = id' + 1 })
    capterm <- translateTerm Term.Table
    sty <- dirStyleFor "TableCaption"
    return $ numberedCaption sty capterm "Table" id' ident caption

numberedFigureCaption :: PandocMonad m => Text -> Doc Text -> OD m (Doc Text)
numberedFigureCaption :: forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> OD m (Doc Text)
numberedFigureCaption Text
ident Doc Text
caption = do
    id' <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stImageCaptionId
    modify (\WriterState
st -> WriterState
st{ stImageCaptionId = id' + 1 })
    capterm <- translateTerm Term.Figure
    sty <- dirStyleFor "FigureCaption"
    return $ numberedCaption sty capterm  "Illustration" id' ident 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 = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal 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 :: PandocMonad m => Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption :: forall (m :: * -> *).
PandocMonad m =>
Text -> Doc Text -> OD m (Doc Text)
unNumberedCaption Text
style Doc Text
caption = do
  sty <- Text -> OD m Text
forall (m :: * -> *). PandocMonad m => Text -> OD m Text
dirStyleFor Text
style
  return $ inParagraphTagsWithStyle sty caption

colHeadsToOpenDocument :: PandocMonad m
                       => WriterOptions -> [Text] -> Ann.TableHead
                       -> OD m (Doc Text)
colHeadsToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> TableHead -> OD m (Doc Text)
colHeadsToOpenDocument WriterOptions
o [Text]
ns (Ann.TableHead Attr
_ [HeaderRow]
hs) =
  case [HeaderRow]
hs of
    [] -> Doc Text -> OD m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
    [HeaderRow]
xs -> 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) -> OD m (Doc Text) -> OD m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      WriterOptions -> [Text] -> Text -> [HeaderRow] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [HeaderRow] -> OD m (Doc Text)
tableHeaderRowsToOpenDocument WriterOptions
o [Text]
ns Text
"TableHeaderRowCell" [HeaderRow]
xs

tableHeaderRowsToOpenDocument :: PandocMonad m
                              => WriterOptions -> [Text] -> Text -> [Ann.HeaderRow]
                              -> OD m (Doc Text)
tableHeaderRowsToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [HeaderRow] -> OD m (Doc Text)
tableHeaderRowsToOpenDocument WriterOptions
o [Text]
ns Text
s [HeaderRow]
headerRows =
  [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
<$> (HeaderRow -> StateT WriterState m (Doc Text))
-> [HeaderRow] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HeaderRow -> StateT WriterState m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
HeaderRow -> StateT WriterState m (Doc Text)
headerRowToOpenDocument [HeaderRow]
headerRows
  where
    headerRowToOpenDocument :: HeaderRow -> StateT WriterState m (Doc Text)
headerRowToOpenDocument (Ann.HeaderRow Attr
_ RowNumber
_ [Cell]
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]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Cell) -> StateT WriterState 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions
-> Text -> (Text, Cell) -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> (Text, Cell) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o Text
s) ([Text] -> [Cell] -> [(Text, Cell)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ns [Cell]
c)

tableBodyToOpenDocument:: PandocMonad m
                       => WriterOptions -> [Text] -> [Text] -> Ann.TableBody
                       -> OD m (Doc Text)
tableBodyToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Text] -> TableBody -> OD m (Doc Text)
tableBodyToOpenDocument WriterOptions
o [Text]
headns [Text]
bodyns TableBody
tb = do
    let (Ann.TableBody Attr
_ RowHeadColumns
_ [HeaderRow]
hs [BodyRow]
r) = TableBody
tb
    tableRowHeaders <- WriterOptions -> [Text] -> Text -> [HeaderRow] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [HeaderRow] -> OD m (Doc Text)
tableHeaderRowsToOpenDocument WriterOptions
o [Text]
headns Text
"TableRowCell" [HeaderRow]
hs
    tableRows <- mapM (tableRowToOpenDocument o headns bodyns) r
    return $ tableRowHeaders $$ vcat tableRows

tableFootToOpenDocument :: PandocMonad m
                        => WriterOptions -> [Text] -> Ann.TableFoot
                        -> OD m (Doc Text)
tableFootToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> TableFoot -> OD m (Doc Text)
tableFootToOpenDocument WriterOptions
o [Text]
ns (Ann.TableFoot Attr
_ [HeaderRow]
r) =
  WriterOptions -> [Text] -> Text -> [HeaderRow] -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> Text -> [HeaderRow] -> OD m (Doc Text)
tableHeaderRowsToOpenDocument WriterOptions
o [Text]
ns Text
"TableRowCell" [HeaderRow]
r

tableRowToOpenDocument :: PandocMonad m
                       => WriterOptions -> [Text] -> [Text] -> Ann.BodyRow
                       -> OD m (Doc Text)

tableRowToOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Text] -> [Text] -> BodyRow -> OD m (Doc Text)
tableRowToOpenDocument WriterOptions
o [Text]
headns [Text]
bodyns BodyRow
r =
    let (Ann.BodyRow Attr
_ RowNumber
_ [Cell]
rowheaders [Cell]
cs) = 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]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ((Text, Cell) -> StateT WriterState 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions
-> Text -> (Text, Cell) -> StateT WriterState 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]
headns [Cell]
rowheaders) [(Text, Cell)] -> [(Text, Cell)] -> [(Text, Cell)]
forall a. [a] -> [a] -> [a]
++ ([Text] -> [Cell] -> [(Text, Cell)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop ([Cell] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cell]
rowheaders) [Text]
bodyns) [Cell]
cs))

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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> (Text, Cell) -> OD m (Doc Text)
tableItemToOpenDocument WriterOptions
o Text
s (Text
n,Cell
c) = do
  let (Ann.Cell NonEmpty ColSpec
_colspecs ColNumber
_colnum (Cell Attr
_ Alignment
align RowSpan
rs ColSpan
cs [Block]
i) ) = Cell
c
      csa :: [(Text, Text)]
csa = ColSpan -> [(Text, Text)]
colspanAttrib ColSpan
cs
      rsa :: [(Text, Text)]
rsa = RowSpan -> [(Text, Text)]
rowspanAttrib RowSpan
rs
      aa :: [(Text, Text)]
aa = Alignment -> [(Text, Text)]
alignAttrib Alignment
align
      a :: [(Text, Text)]
a = [ (Text
"table:style-name" , Text
s )
          , (Text
"office:value-type", Text
"string" ) ] [(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
  itemParaStyle <- Text -> [(Text, Text)] -> OD m Text
forall (m :: * -> *).
PandocMonad m =>
Text -> [(Text, Text)] -> OD m Text
paraStyleFromParent Text
n [(Text, Text)]
aa
  inTags True "table:table-cell" a <$>
    withParagraphStyle o itemParaStyle (map plainToPara i)

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

toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> OD m [Doc Text]
toChunks WriterOptions
_ [] = [Doc Text] -> StateT WriterState m [Doc Text]
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
toChunks WriterOptions
o (Inline
x : [Inline]
xs)
  | Inline -> Bool
isChunkable Inline
x = do
        contents <- (Doc Text -> OD m (Doc Text)
forall (m :: * -> *). PandocMonad m => Doc Text -> OD 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))
-> StateT WriterState 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] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
        rest <- toChunks o zs
        return (contents : rest)
  | Bool
otherwise     = do
        contents <- WriterOptions -> Inline -> OD m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument WriterOptions
o Inline
x
        rest <- toChunks o xs
        return (contents : 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> OD m (Doc Text)
inlineToOpenDocument WriterOptions
o Inline
ils
  = case Inline
ils of
    Inline
Space         -> Doc Text -> OD m (Doc Text)
forall a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
    Span (Text
"", [Text
"mark"], []) [Inline]
xs ->
      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
"Highlighted")] (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]
xs
    Span Attr
attr [Inline]
xs  -> Attr -> [Inline] -> OD m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Attr -> [Inline] -> StateT WriterState m (Doc Text)
mkSpan Attr
attr [Inline]
xs
    Inline
LineBreak     -> Doc Text -> OD m (Doc Text)
forall a. a -> StateT WriterState m a
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 a. a -> StateT WriterState m a
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 ->
      let highlighted :: OD m (Doc Text)
highlighted =
            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, HasChars a) =>
Doc a -> m (Doc a)
inlinedCode (Doc Text -> OD m (Doc Text)) -> Doc Text -> OD m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [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
      in case WriterOptions -> HighlightMethod
writerHighlightMethod WriterOptions
o of
           Skylighting {} -> OD m (Doc Text)
highlighted
           HighlightMethod
DefaultHighlighting -> OD m (Doc Text)
highlighted
           HighlightMethod
_ -> 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 (m :: * -> *) a. Monad m => m a -> StateT WriterState m a
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 a b.
StateT WriterState m a
-> (a -> StateT WriterState m b) -> StateT WriterState m b
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 a. a -> StateT WriterState m a
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
forall a. HasChars a => a -> Doc a
literal 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 a. a -> StateT WriterState m a
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
      identTypes <- (WriterState -> Map Text ReferenceType)
-> StateT WriterState m (Map Text ReferenceType)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map Text ReferenceType
stIdentTypes
      mkLink o identTypes s t <$> inlinesToOpenDocument o 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
      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
      inlinedCode :: Doc a -> m (Doc a)
inlinedCode Doc a
s = Doc a -> m (Doc a)
forall a. a -> m 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_20_Text")] Doc a
s
      mkImg :: (a, b, [(a, Text)]) -> Text -> p -> m (Doc a)
mkImg (a
_, b
_, [(a, Text)]
kvs) Text
s p
_ = do
               id' <- (WriterState -> Int) -> m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stImageId
               modify (\WriterState
st -> WriterState
st{ stImageId = id' + 1 })
               let 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
               -- Image is an Inline: anchor the frame as a character so
               -- it flows with the text.  Without an explicit anchor,
               -- consumers default to paragraph anchoring and float the
               -- frame beside the following text.
               return $ inTags False "draw:frame"
                        (("draw:name", "img" <> tshow id')
                         : ("text:anchor-type", "as-char")
                         : getDims kvs) $
                     selfClosingTag "draw:image" [ ("xlink:href"   , s       )
                                                 , ("xlink:type"   , "simple")
                                                 , ("xlink:show"   , "embed" )
                                                 , ("xlink:actuate", "onLoad")]
      mkSpan :: Attr -> [Inline] -> StateT WriterState m (Doc Text)
mkSpan Attr
attr [Inline]
xs =  do
        let (Text
ident,[Text]
_,[(Text, Text)]
kvs) = Attr
attr
            i :: StateT WriterState m (Doc Text)
i = (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> (Text
    -> StateT WriterState m (Doc Text)
    -> StateT WriterState m (Doc Text))
-> Maybe Text
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT WriterState m (Doc Text) -> StateT WriterState m (Doc Text)
forall a. a -> a
id (\Text
sty ->
                           (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
sty) ]))
                  (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"custom-style" [(Text, Text)]
kvs) (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> (StateT WriterState m (Doc Text)
    -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 Attr
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr Attr
attr (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> [Inline] -> StateT WriterState 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 StateT WriterState m (Doc Text)
i
          else (Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
mkBookmarkedSpan StateT WriterState m (Doc Text)
i
      mkNote :: [Block] -> StateT WriterState m (Doc Text)
mkNote     [Block]
l = do
        n <- (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNoteCount
        -- bump the counter before rendering the body, so that a note
        -- nested inside this one does not reuse the same text:id
        modify $ \WriterState
st -> WriterState
st{ stNoteCount = n + 1 }
        let 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
        footNote <$> withAlteredTextStyles (const mempty)
                       (withParagraphStyle o "Footnote" l)

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

preformatted :: Text -> Doc Text
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

mkLink :: WriterOptions -> Map.Map Text ReferenceType -> Text -> Text
       -> Doc Text -> Doc Text
mkLink :: WriterOptions
-> Map Text ReferenceType -> Text -> Text -> Doc Text -> Doc Text
mkLink WriterOptions
o Map Text ReferenceType
identTypes Text
s Text
t Doc Text
d =
  let 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 Text -> Maybe (Char, Text)
T.uncons Text
s of
                          Just (Char
'#', Text
ident) ->
                            case Text -> Map Text ReferenceType -> Maybe ReferenceType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
ident Map Text ReferenceType
identTypes of
                              Just ReferenceType
HeaderRef -> Text -> Doc Text
bookmarkRef' Text
ident
                              Just ReferenceType
TableRef  -> Text -> Doc Text
sequenceRef' Text
ident
                              Just ReferenceType
FigureRef -> Text -> Doc Text
sequenceRef' Text
ident
                              Maybe ReferenceType
Nothing        -> Doc Text
link
                          Maybe (Char, Text)
_ -> 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

-- | Spreadsheet-style column names (@A@, @B@, ..., @Z@, @AA@, @AB@, ...).
-- Plain @chr@ arithmetic would run past @Z@ into characters like @[@
-- and @\\@, which are not legal in a @style:name@.
colLetters :: Int -> Text
colLetters :: Int -> Text
colLetters Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
26    = Char -> Text
T.singleton (Int -> Char
chr (Int
65 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n))
  | Bool
otherwise = Int -> Text
colLetters (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton (Int -> Char
chr (Int
65 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
26))

tableStyle :: Int -> Double -> [(Text,Double)] -> Doc Text
tableStyle :: Int -> Double -> [(Text, Double)] -> Doc Text
tableStyle Int
num Double
textWidth [(Text, 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 b. Integral b => Double -> b
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 -> ShowS
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 :: (Text, a) -> Doc a
colStyle (Text
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
<> Text
c)
                         , (Text
"style:family", Text
"table-column"       )]
        colStyle (Text
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
<> Text
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 b. Integral b => a -> b
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   = ((Text, Double) -> Doc Text) -> [(Text, Double)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Double) -> Doc Text
forall {a} {a}. (HasChars a, RealFrac a) => (Text, a) -> Doc a
colStyle [(Text, 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

-- | Generate (or reuse) a paragraph style with the given attributes.
-- When the only attribute is @style:parent-style-name@ and no
-- indent/tight overrides are active, the parent name is returned
-- directly (no @Pn@ automatic style is created), so that the
-- predefined style passes through unchanged.
paraStyle :: PandocMonad m => [(Text,Text)] -> OD m Text
paraStyle :: forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> OD m Text
paraStyle [(Text, Text)]
attrs = do
  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)
-> StateT WriterState m Int -> StateT WriterState m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stIndentPara
  b  <- gets stInDefinition
  dirAttrs <- getDirAttrs
  let 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
      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)]
indent [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
dirAttrs
  case (attributes, attrs) of
    ([], [(Text
"style:parent-style-name", Text
parent)]) -> Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
parent
    ([(Text, Text)], [(Text, Text)])
_ -> [(Text, Text)] -> [(Text, Text)] -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> [(Text, Text)] -> OD m Text
mkParaStyle [(Text, Text)]
attrs [(Text, Text)]
attributes

paraStyleFromParent :: PandocMonad m => Text -> [(Text,Text)] -> OD m Text
paraStyleFromParent :: forall (m :: * -> *).
PandocMonad m =>
Text -> [(Text, Text)] -> OD m Text
paraStyleFromParent Text
parent [(Text, Text)]
attrs = do
  dirAttrs <- OD m [(Text, Text)]
forall (m :: * -> *). PandocMonad m => OD m [(Text, Text)]
getDirAttrs
  let attrs' = [(Text, Text)]
attrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
dirAttrs
  if null attrs'
     then return parent
     else mkParaStyle [("style:parent-style-name", parent)] attrs'

-- | Create an automatic paragraph style with the given @style:style@
-- attributes and @style:paragraph-properties@, reusing an identical
-- style if one has already been created.
mkParaStyle :: PandocMonad m => [(Text,Text)] -> [(Text,Text)] -> OD m Text
mkParaStyle :: forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> [(Text, Text)] -> OD m Text
mkParaStyle [(Text, Text)]
attrs [(Text, Text)]
props = do
  cache <- (WriterState -> Map ([(Text, Text)], [(Text, Text)]) Text)
-> StateT WriterState m (Map ([(Text, Text)], [(Text, Text)]) Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Map ([(Text, Text)], [(Text, Text)]) Text
stParaStyleCache
  case Map.lookup (attrs, props) cache of
    Just Text
name -> Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
name
    Maybe Text
Nothing -> do
      name <- (Text
"P" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> (Int -> Int) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Text)
-> StateT WriterState m Int -> StateT WriterState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> Int) -> StateT WriterState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stParaStyleCount
      let styleAttr = (Text
"style:name"  , Text
name)
                    (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: (Text
"style:family", Text
"paragraph")
                    (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs
          paraProps = if [(Text, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
props
                         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)]
props
      addParaStyle $ inTags True "style:style" styleAttr paraProps
      modify $ \WriterState
st -> WriterState
st{ stParaStyleCache =
                            Map.insert (attrs, props) name
                                       (stParaStyleCache st) }
      return name

getDirAttrs :: PandocMonad m => OD m [(Text, Text)]
getDirAttrs :: forall (m :: * -> *). PandocMonad m => OD m [(Text, Text)]
getDirAttrs = do
  wm <- (WriterState -> Maybe Direction)
-> StateT WriterState m (Maybe Direction)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Maybe Direction
stDirection
  pure $
    case wm of
      Maybe Direction
Nothing -> []
      Just Direction
RTL -> [(Text
"style:writing-mode", Text
"rl-tb"),
                        (Text
"fo:text-align", Text
"right")]
      Just Direction
LTR -> [(Text
"style:writing-mode", Text
"lr-tb"),
                        (Text
"fo:text-align", Text
"left")]

-- | Adjust a named paragraph style for the current writing direction.
-- When a direction is active, an automatic style derived from the
-- given style with the appropriate @style:writing-mode@ is created.
-- With no direction active the name passes through unchanged, as do
-- automatic style names (@P1@, @P2@, ...), since automatic styles are
-- always created with the current direction included.
dirStyleFor :: PandocMonad m => Text -> OD m Text
dirStyleFor :: forall (m :: * -> *). PandocMonad m => Text -> OD m Text
dirStyleFor Text
parent
  | Text -> Bool
isAutoStyleName Text
parent = Text -> StateT WriterState m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
parent
  | Bool
otherwise              = Text -> [(Text, Text)] -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
Text -> [(Text, Text)] -> OD m Text
paraStyleFromParent Text
parent []
  where
    isAutoStyleName :: Text -> Bool
isAutoStyleName Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Just (Char
'P', Text
ds) -> Bool -> Bool
not (Text -> Bool
T.null Text
ds) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
ds
      Maybe (Char, Text)
_              -> Bool
False

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
$c== :: TextStyle -> TextStyle -> Bool
== :: TextStyle -> TextStyle -> Bool
$c/= :: TextStyle -> TextStyle -> Bool
/= :: 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
$ccompare :: TextStyle -> TextStyle -> Ordering
compare :: TextStyle -> TextStyle -> Ordering
$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
>= :: TextStyle -> TextStyle -> Bool
$cmax :: TextStyle -> TextStyle -> TextStyle
max :: TextStyle -> TextStyle -> TextStyle
$cmin :: TextStyle -> TextStyle -> TextStyle
min :: TextStyle -> TextStyle -> 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 = \case
  TextStyle
Italic -> 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   -> 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  -> 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 -> 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    -> 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    -> 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 -> 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    -> 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 -> Lang -> Map Text Text -> Map Text Text
addLanguage Lang
lang Map Text Text
m

addLanguage :: Lang -> Map.Map Text Text -> Map.Map Text Text
addLanguage :: Lang -> Map Text Text -> Map Text Text
addLanguage Lang
lang
  | Lang -> Bool
isRTLLang Lang
lang =
     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:language-complex" (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
.
     (Map Text Text -> Map Text Text)
-> (Text -> Map Text Text -> Map Text Text)
-> Maybe Text
-> Map Text Text
-> Map Text Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text Text -> Map Text Text
forall a. a -> a
id (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:country-complex") (Lang -> Maybe Text
langRegion Lang
lang)
  | Bool
otherwise =
     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
.
     (Map Text Text -> Map Text Text)
-> (Text -> Map Text Text -> Map Text Text)
-> Maybe Text
-> Map Text Text
-> Map Text Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Text Text -> Map Text Text
forall a. a -> a
id (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 -> Maybe Text
langRegion Lang
lang)

-- | Returns True if the language is conventionally written right-to-left.
isRTLLang :: Lang -> Bool
isRTLLang :: Lang -> Bool
isRTLLang Lang{ langLanguage :: Lang -> Text
langLanguage = Text
l } =
  Text
l Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"ar", Text
"he", Text
"fa", Text
"ur", Text
"sd", Text
"ckb", Text
"yi", Text
"dv"]

withLangFromAttr :: PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr :: forall (m :: * -> *) a. PandocMonad m => Attr -> OD m a -> OD m a
withLangFromAttr (Text
_,[Text]
_,[(Text, Text)]
kvs) OD m a
action =
  case 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 String Lang
parseLang 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 String
_ -> 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