{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.ODT.ContentReader
   Copyright   : Copyright (C) 2015 Martin Linnemann
   License     : GNU GPL, version 2 or above

   Maintainer  : Martin Linnemann <theCodingMarlin@googlemail.com>
   Stability   : alpha
   Portability : portable

The core of the odt reader that converts odt features into Pandoc types.
-}

module Text.Pandoc.Readers.ODT.ContentReader
( readerState
, read_body
) where

import Control.Applicative ((<|>))
import Control.Monad ((<=<))

import Data.ByteString.Base64 (decodeLenient)
import qualified Data.ByteString.Lazy as B
import Data.Char (isSpace)
import Data.Foldable (fold)
import Data.List (find)
import Data.List.NonEmpty (nonEmpty)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Maybe
import Data.Monoid (Alt (..))

import Text.TeXMath (readMathML, writeTeX)
import qualified Text.Pandoc.XML.Light as XML

import Text.Pandoc.Builder hiding (underline)
import Text.Pandoc.ImageSize (ImageType(..), imageType)
import Text.Pandoc.MediaBag (MediaBag, insertMedia, mediaItems)
import Text.Pandoc.MIME (extensionFromMimeType)
import Text.Pandoc.Shared
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Extensions (extensionsFromList, Extension(..))
import qualified Text.Pandoc.UTF8 as UTF8

import Text.Pandoc.Readers.Docx.Combine (combineBlocks)

import Text.Pandoc.Readers.ODT.Namespaces
import Text.Pandoc.Readers.ODT.StyleReader

import Text.Pandoc.Readers.ODT.Generic.Utils (findBy)
import Text.Pandoc.Readers.ODT.Generic.XMLConverter

import Network.URI (parseRelativeReference, URI(uriPath))
import qualified Data.Set as Set

--------------------------------------------------------------------------------
-- State
--------------------------------------------------------------------------------

type Anchor = T.Text
type Media = M.Map FilePath B.ByteString

data ReaderState
   = ReaderState { -- | A collection of styles read somewhere else.
                   -- It is only queried here, not modified.
                   ReaderState -> Styles
styleSet         :: Styles
                   -- | A stack of the styles of parent elements.
                   -- Used to look up inherited style properties.
                 , ReaderState -> [Style]
styleTrace       :: [Style]
                   -- | Keeps track of the current depth in nested lists
                 , ReaderState -> Int
currentListLevel :: ListLevel
                   -- | Keeps track of the previous list start counters
                   -- for each list style and level, so whenever a new
                   -- list continues numbering, we know what number to
                   -- start from. The counters for deeper levels are
                   -- reset whenever a new list item starts.
                 , ReaderState -> Map (Maybe Text, Int) Int
listContinuationStartCounters
                     :: M.Map (Maybe StyleName, ListLevel) Int
                   -- | Lists may provide their own style, but they don't have
                   -- to. If they do not, the style of a parent list may be used
                   -- or even a default list style from the paragraph style.
                   -- This value keeps track of the closest list style there
                   -- currently is.
                 , ReaderState -> Maybe ListStyle
currentListStyle :: Maybe ListStyle
                   -- | The name of 'currentListStyle', if known.
                 , ReaderState -> Maybe Text
currentListStyleName :: Maybe StyleName
                   -- | A map from internal anchor names to "pretty" ones.
                   -- The mapping is a purely cosmetic one.
                 , ReaderState -> Map Text Text
bookmarkAnchors  :: M.Map Anchor Anchor
                   -- | The "pretty" anchors handed out so far, i.e. the
                   -- values of 'bookmarkAnchors'. Kept separately so that
                   -- checking an anchor for uniqueness does not cost a
                   -- traversal of the whole map.
                 , ReaderState -> Set Text
usedAnchors      :: Set.Set Anchor
                   -- | A map of files / binary data from the archive
                 , ReaderState -> Media
envMedia         :: Media
                   -- | Hold binary resources used in the document
                 , ReaderState -> MediaBag
odtMediaBag      :: MediaBag
                 }
  deriving ( Int -> ReaderState -> ShowS
[ReaderState] -> ShowS
ReaderState -> FilePath
(Int -> ReaderState -> ShowS)
-> (ReaderState -> FilePath)
-> ([ReaderState] -> ShowS)
-> Show ReaderState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReaderState -> ShowS
showsPrec :: Int -> ReaderState -> ShowS
$cshow :: ReaderState -> FilePath
show :: ReaderState -> FilePath
$cshowList :: [ReaderState] -> ShowS
showList :: [ReaderState] -> ShowS
Show )

readerState :: Styles -> [(FilePath, B.ByteString)] -> ReaderState
readerState :: Styles -> [(FilePath, ByteString)] -> ReaderState
readerState Styles
styles [(FilePath, ByteString)]
media =
  Styles
-> [Style]
-> Int
-> Map (Maybe Text, Int) Int
-> Maybe ListStyle
-> Maybe Text
-> Map Text Text
-> Set Text
-> Media
-> MediaBag
-> ReaderState
ReaderState Styles
styles [] Int
0 Map (Maybe Text, Int) Int
forall k a. Map k a
M.empty Maybe ListStyle
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Map Text Text
forall k a. Map k a
M.empty Set Text
forall a. Set a
Set.empty
              ([(FilePath, ByteString)] -> Media
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FilePath, ByteString)]
media) MediaBag
forall a. Monoid a => a
mempty

--
pushStyle'  :: Style -> ReaderState -> ReaderState
pushStyle' :: Style -> ReaderState -> ReaderState
pushStyle' Style
style ReaderState
state = ReaderState
state { styleTrace = style : styleTrace state }

--
popStyle'   :: ReaderState -> ReaderState
popStyle' :: ReaderState -> ReaderState
popStyle' ReaderState
state = case ReaderState -> [Style]
styleTrace ReaderState
state of
                   Style
_:[Style]
trace -> ReaderState
state  { styleTrace = trace  }
                   [Style]
_       -> ReaderState
state
--
modifyListLevel :: (ListLevel -> ListLevel) -> (ReaderState -> ReaderState)
modifyListLevel :: (Int -> Int) -> ReaderState -> ReaderState
modifyListLevel Int -> Int
f ReaderState
state = ReaderState
state { currentListLevel = f (currentListLevel state) }

--
modifyListContinuationStartCounter :: Maybe StyleName -> ListLevel -> Int
                                   -> (ReaderState -> ReaderState)
modifyListContinuationStartCounter :: Maybe Text -> Int -> Int -> ReaderState -> ReaderState
modifyListContinuationStartCounter Maybe Text
mStyleName Int
listLevel Int
count ReaderState
state =
    ReaderState
state { listContinuationStartCounters =
              M.insert (mStyleName, listLevel) count
                (listContinuationStartCounters state) }

-- | Reset the counters of all list levels deeper than the given one.
resetDeeperListContinuationStartCounters :: ListLevel
                                         -> (ReaderState -> ReaderState)
resetDeeperListContinuationStartCounters :: Int -> ReaderState -> ReaderState
resetDeeperListContinuationStartCounters Int
listLevel ReaderState
state =
    ReaderState
state { listContinuationStartCounters =
              M.filterWithKey (\(Maybe Text
_, Int
lvl) Int
_ -> Int
lvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
listLevel)
                (listContinuationStartCounters state) }

--
shiftListLevel :: ListLevel -> (ReaderState -> ReaderState)
shiftListLevel :: Int -> ReaderState -> ReaderState
shiftListLevel Int
diff = (Int -> Int) -> ReaderState -> ReaderState
modifyListLevel (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
diff)

--
lookupPrettyAnchor :: Anchor -> ReaderState -> Maybe Anchor
lookupPrettyAnchor :: Text -> ReaderState -> Maybe Text
lookupPrettyAnchor Text
anchor ReaderState{Int
[Style]
Maybe Text
Maybe ListStyle
Media
Map (Maybe Text, Int) Int
Map Text Text
Set Text
Styles
MediaBag
styleSet :: ReaderState -> Styles
styleTrace :: ReaderState -> [Style]
currentListLevel :: ReaderState -> Int
listContinuationStartCounters :: ReaderState -> Map (Maybe Text, Int) Int
currentListStyle :: ReaderState -> Maybe ListStyle
currentListStyleName :: ReaderState -> Maybe Text
bookmarkAnchors :: ReaderState -> Map Text Text
usedAnchors :: ReaderState -> Set Text
envMedia :: ReaderState -> Media
odtMediaBag :: ReaderState -> MediaBag
styleSet :: Styles
styleTrace :: [Style]
currentListLevel :: Int
listContinuationStartCounters :: Map (Maybe Text, Int) Int
currentListStyle :: Maybe ListStyle
currentListStyleName :: Maybe Text
bookmarkAnchors :: Map Text Text
usedAnchors :: Set Text
envMedia :: Media
odtMediaBag :: MediaBag
..} = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
anchor Map Text Text
bookmarkAnchors

--
putPrettyAnchor :: Anchor -> Anchor -> ReaderState -> ReaderState
putPrettyAnchor :: Text -> Text -> ReaderState -> ReaderState
putPrettyAnchor Text
ugly Text
pretty state :: ReaderState
state@ReaderState{Int
[Style]
Maybe Text
Maybe ListStyle
Media
Map (Maybe Text, Int) Int
Map Text Text
Set Text
Styles
MediaBag
styleSet :: ReaderState -> Styles
styleTrace :: ReaderState -> [Style]
currentListLevel :: ReaderState -> Int
listContinuationStartCounters :: ReaderState -> Map (Maybe Text, Int) Int
currentListStyle :: ReaderState -> Maybe ListStyle
currentListStyleName :: ReaderState -> Maybe Text
bookmarkAnchors :: ReaderState -> Map Text Text
usedAnchors :: ReaderState -> Set Text
envMedia :: ReaderState -> Media
odtMediaBag :: ReaderState -> MediaBag
styleSet :: Styles
styleTrace :: [Style]
currentListLevel :: Int
listContinuationStartCounters :: Map (Maybe Text, Int) Int
currentListStyle :: Maybe ListStyle
currentListStyleName :: Maybe Text
bookmarkAnchors :: Map Text Text
usedAnchors :: Set Text
envMedia :: Media
odtMediaBag :: MediaBag
..}
  = ReaderState
state { bookmarkAnchors = M.insert ugly pretty bookmarkAnchors
          , usedAnchors     = Set.insert pretty usedAnchors
          }

getMediaBag :: ReaderState -> MediaBag
getMediaBag :: ReaderState -> MediaBag
getMediaBag ReaderState{Int
[Style]
Maybe Text
Maybe ListStyle
Media
Map (Maybe Text, Int) Int
Map Text Text
Set Text
Styles
MediaBag
styleSet :: ReaderState -> Styles
styleTrace :: ReaderState -> [Style]
currentListLevel :: ReaderState -> Int
listContinuationStartCounters :: ReaderState -> Map (Maybe Text, Int) Int
currentListStyle :: ReaderState -> Maybe ListStyle
currentListStyleName :: ReaderState -> Maybe Text
bookmarkAnchors :: ReaderState -> Map Text Text
usedAnchors :: ReaderState -> Set Text
envMedia :: ReaderState -> Media
odtMediaBag :: ReaderState -> MediaBag
styleSet :: Styles
styleTrace :: [Style]
currentListLevel :: Int
listContinuationStartCounters :: Map (Maybe Text, Int) Int
currentListStyle :: Maybe ListStyle
currentListStyleName :: Maybe Text
bookmarkAnchors :: Map Text Text
usedAnchors :: Set Text
envMedia :: Media
odtMediaBag :: MediaBag
..} = MediaBag
odtMediaBag

getMediaEnv :: ReaderState -> Media
getMediaEnv :: ReaderState -> Media
getMediaEnv ReaderState{Int
[Style]
Maybe Text
Maybe ListStyle
Media
Map (Maybe Text, Int) Int
Map Text Text
Set Text
Styles
MediaBag
styleSet :: ReaderState -> Styles
styleTrace :: ReaderState -> [Style]
currentListLevel :: ReaderState -> Int
listContinuationStartCounters :: ReaderState -> Map (Maybe Text, Int) Int
currentListStyle :: ReaderState -> Maybe ListStyle
currentListStyleName :: ReaderState -> Maybe Text
bookmarkAnchors :: ReaderState -> Map Text Text
usedAnchors :: ReaderState -> Set Text
envMedia :: ReaderState -> Media
odtMediaBag :: ReaderState -> MediaBag
styleSet :: Styles
styleTrace :: [Style]
currentListLevel :: Int
listContinuationStartCounters :: Map (Maybe Text, Int) Int
currentListStyle :: Maybe ListStyle
currentListStyleName :: Maybe Text
bookmarkAnchors :: Map Text Text
usedAnchors :: Set Text
envMedia :: Media
odtMediaBag :: MediaBag
..} = Media
envMedia

insertMedia' :: (FilePath, B.ByteString) -> ReaderState ->  ReaderState
insertMedia' :: (FilePath, ByteString) -> ReaderState -> ReaderState
insertMedia' (FilePath
fp, ByteString
bs) state :: ReaderState
state@ReaderState{Int
[Style]
Maybe Text
Maybe ListStyle
Media
Map (Maybe Text, Int) Int
Map Text Text
Set Text
Styles
MediaBag
styleSet :: ReaderState -> Styles
styleTrace :: ReaderState -> [Style]
currentListLevel :: ReaderState -> Int
listContinuationStartCounters :: ReaderState -> Map (Maybe Text, Int) Int
currentListStyle :: ReaderState -> Maybe ListStyle
currentListStyleName :: ReaderState -> Maybe Text
bookmarkAnchors :: ReaderState -> Map Text Text
usedAnchors :: ReaderState -> Set Text
envMedia :: ReaderState -> Media
odtMediaBag :: ReaderState -> MediaBag
styleSet :: Styles
styleTrace :: [Style]
currentListLevel :: Int
listContinuationStartCounters :: Map (Maybe Text, Int) Int
currentListStyle :: Maybe ListStyle
currentListStyleName :: Maybe Text
bookmarkAnchors :: Map Text Text
usedAnchors :: Set Text
envMedia :: Media
odtMediaBag :: MediaBag
..}
  = ReaderState
state { odtMediaBag = insertMedia fp Nothing bs odtMediaBag }

--------------------------------------------------------------------------------
-- Reader type and associated tools
--------------------------------------------------------------------------------

type ODTReader a = XMLConverter Namespace ReaderState a

-- | Extract the styles from the reader state
getStyles :: ODTReader Styles
getStyles :: ODTReader Styles
getStyles = ReaderState -> Styles
styleSet (ReaderState -> Styles)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) ReaderState
-> ODTReader Styles
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState

--
getStyleByName :: StyleName -> ODTReader Style
getStyleByName :: Text -> ODTReader Style
getStyleByName Text
name = ODTReader Styles
getStyles ODTReader Styles -> (Styles -> ODTReader Style) -> ODTReader Style
forall a b.
ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> (a
    -> ExceptT () (State (XMLConverterState Namespace ReaderState)) b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Style -> ODTReader Style
forall a nsID extraState. Maybe a -> XMLConverter nsID extraState a
fromMaybeF (Maybe Style -> ODTReader Style)
-> (Styles -> Maybe Style) -> Styles -> ODTReader Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Styles -> Maybe Style
lookupStyle Text
name

--
--
lookupListStyle :: StyleName -> ODTReader ListStyle
lookupListStyle :: Text -> ODTReader ListStyle
lookupListStyle Text
name = ODTReader Styles
getStyles ODTReader Styles
-> (Styles -> ODTReader ListStyle) -> ODTReader ListStyle
forall a b.
ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> (a
    -> ExceptT () (State (XMLConverterState Namespace ReaderState)) b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe ListStyle -> ODTReader ListStyle
forall a nsID extraState. Maybe a -> XMLConverter nsID extraState a
fromMaybeF (Maybe ListStyle -> ODTReader ListStyle)
-> (Styles -> Maybe ListStyle) -> Styles -> ODTReader ListStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Styles -> Maybe ListStyle
lookupListStyleByName Text
name

--
switchCurrentListStyle :: Maybe (StyleName, ListStyle)
                       -> ODTReader (Maybe (StyleName, ListStyle))
switchCurrentListStyle :: Maybe (Text, ListStyle) -> ODTReader (Maybe (Text, ListStyle))
switchCurrentListStyle Maybe (Text, ListStyle)
mListStyle = do
  state <- ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState
  setExtraState $ state { currentListStyle = snd <$> mListStyle
                        , currentListStyleName = fst <$> mListStyle }
  return $ (,) <$> currentListStyleName state <*> currentListStyle state

--
pushStyle :: Style -> ODTReader ()
pushStyle :: Style -> XMLConverter Namespace ReaderState ()
pushStyle Style
style = (ReaderState -> ReaderState)
-> XMLConverter Namespace ReaderState ()
forall extraState nsID.
(extraState -> extraState) -> XMLConverter nsID extraState ()
modifyExtraState (Style -> ReaderState -> ReaderState
pushStyle' Style
style)

--
popStyle :: ODTReader ()
popStyle :: XMLConverter Namespace ReaderState ()
popStyle = (ReaderState -> ReaderState)
-> XMLConverter Namespace ReaderState ()
forall extraState nsID.
(extraState -> extraState) -> XMLConverter nsID extraState ()
modifyExtraState ReaderState -> ReaderState
popStyle'

--
getCurrentListLevel :: ODTReader ListLevel
getCurrentListLevel :: ODTReader Int
getCurrentListLevel = ReaderState -> Int
currentListLevel (ReaderState -> Int)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) ReaderState
-> ODTReader Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState

--
getPreviousListStartCounter :: Maybe StyleName -> ListLevel
                            -> ODTReader (Maybe Int)
getPreviousListStartCounter :: Maybe Text -> Int -> ODTReader (Maybe Int)
getPreviousListStartCounter Maybe Text
mStyleName Int
listLevel =
  (Maybe Text, Int) -> Map (Maybe Text, Int) Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Maybe Text
mStyleName, Int
listLevel) (Map (Maybe Text, Int) Int -> Maybe Int)
-> (ReaderState -> Map (Maybe Text, Int) Int)
-> ReaderState
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderState -> Map (Maybe Text, Int) Int
listContinuationStartCounters
    (ReaderState -> Maybe Int)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) ReaderState
-> ODTReader (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState

--
updateMediaWithResource :: (FilePath, B.ByteString) -> ODTReader ()
updateMediaWithResource :: (FilePath, ByteString) -> XMLConverter Namespace ReaderState ()
updateMediaWithResource (FilePath, ByteString)
resource = (ReaderState -> ReaderState)
-> XMLConverter Namespace ReaderState ()
forall extraState nsID.
(extraState -> extraState) -> XMLConverter nsID extraState ()
modifyExtraState ((FilePath, ByteString) -> ReaderState -> ReaderState
insertMedia' (FilePath, ByteString)
resource)

--
lookupResource :: FilePath -> ODTReader (Maybe B.ByteString)
lookupResource :: FilePath -> ODTReader (Maybe ByteString)
lookupResource FilePath
target = FilePath -> Media -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
target (Media -> Maybe ByteString)
-> (ReaderState -> Media) -> ReaderState -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderState -> Media
getMediaEnv (ReaderState -> Maybe ByteString)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) ReaderState
-> ODTReader (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState

type AnchorPrefix = T.Text

-- | An adaptation of 'uniqueIdent' from "Text.Pandoc.Shared" that generates a
-- unique identifier but without assuming that the id should be for a header.
-- Second argument is a list of already used identifiers.
uniqueIdentFrom :: AnchorPrefix -> Set.Set Anchor -> Anchor
uniqueIdentFrom :: Text -> Set Text -> Text
uniqueIdentFrom Text
baseIdent Set Text
usedIdents =
  let  numIdent :: a -> Text
numIdent a
n = Text
baseIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (a -> FilePath
forall a. Show a => a -> FilePath
show a
n)
  in  if Text
baseIdent Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
usedIdents
        then Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
baseIdent Int -> Text
forall {a}. Show a => a -> Text
numIdent
             (Maybe Int -> Text) -> Maybe Int -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> Maybe Int
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Int
x -> Int -> Text
forall {a}. Show a => a -> Text
numIdent Int
x Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
usedIdents)
                 ([Int
1..Int
60000] :: [Int])
               -- if we have more than 60,000, allow repeats
        else Text
baseIdent

-- | First argument: basis for a new "pretty" anchor if none exists yet
-- Second argument: a key ("ugly" anchor)
-- Returns: saved "pretty" anchor or created new one
getPrettyAnchor :: AnchorPrefix -> Anchor -> ODTReader Anchor
getPrettyAnchor :: Text -> Text -> ODTReader Text
getPrettyAnchor Text
baseIdent Text
uglyAnchor = do
  state <- ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState
  case lookupPrettyAnchor uglyAnchor state of
    Just Text
prettyAnchor -> Text -> ODTReader Text
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
prettyAnchor
    Maybe Text
Nothing           -> do
      let newPretty :: Text
newPretty = Text -> Set Text -> Text
uniqueIdentFrom Text
baseIdent (ReaderState -> Set Text
usedAnchors ReaderState
state)
      (ReaderState -> ReaderState)
-> XMLConverter Namespace ReaderState ()
forall extraState nsID.
(extraState -> extraState) -> XMLConverter nsID extraState ()
modifyExtraState (Text -> Text -> ReaderState -> ReaderState
putPrettyAnchor Text
uglyAnchor Text
newPretty)
      Text -> ODTReader Text
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
newPretty

-- | Input: basis for a new header anchor
-- Output: saved new anchor
getHeaderAnchor :: Inlines -> ODTReader Anchor
getHeaderAnchor :: Inlines -> ODTReader Text
getHeaderAnchor Inlines
title = do
  state <- ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState
  let exts = [Extension] -> Extensions
extensionsFromList [Extension
Ext_auto_identifiers]
  let anchor = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
title) (ReaderState -> Set Text
usedAnchors ReaderState
state)
  modifyExtraState (putPrettyAnchor anchor anchor)
  return anchor


--------------------------------------------------------------------------------
-- Working with styles
--------------------------------------------------------------------------------

-- | Read the style referenced by the current element's
-- style-name attribute. Fails if there is no such attribute or if the
-- style cannot be found.
readStyleByName :: ODTReader (StyleName, Style)
readStyleByName :: ODTReader (Text, Style)
readStyleByName = do
  name  <- Namespace -> Text -> ODTReader Text
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState Text
findAttr Namespace
NsText Text
"style-name"
  style <- getStyleByName name
  return (name, style)

--
withNewStyle :: ODTReader Inlines -> ODTReader Inlines
withNewStyle :: ODTReader Inlines -> ODTReader Inlines
withNewStyle ODTReader Inlines
reader = do
  fStyle <- ODTReader (Text, Style)
-> XMLConverter Namespace ReaderState (Fallible (Text, Style))
forall nsID extraState a.
XMLConverter nsID extraState a
-> XMLConverter nsID extraState (Fallible a)
tryC ODTReader (Text, Style)
readStyleByName
  case fStyle of
    Right (Text
styleName, Style
_) | Text -> Bool
isCodeStyle Text
styleName ->
      Inlines -> Inlines
inlineCode (Inlines -> Inlines) -> ODTReader Inlines -> ODTReader Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ODTReader Inlines
reader
    Right (Text
_, Style
style)
      | Just TextProperties
textProps <- StyleProperties -> Maybe TextProperties
textProperties (Style -> StyleProperties
styleProperties Style
style) -> do
          state <- ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState
          let mFamily  = Style -> Maybe StyleFamily
styleFamily Style
style
              modifier = PropertyTriple -> Inlines -> Inlines
modifierFromStyleDiff (ReaderState
state, TextProperties
textProps, Maybe StyleFamily
mFamily)
          pushStyle style
          inlines <- reader
          popStyle
          return $ modifier inlines
    Fallible (Text, Style)
_ -> ODTReader Inlines
reader
  where
    isCodeStyle :: StyleName -> Bool
    isCodeStyle :: Text -> Bool
isCodeStyle Text
"Source_Text" = Bool
True
    isCodeStyle Text
"Source_20_Text" = Bool
True
    isCodeStyle Text
_             = Bool
False

    inlineCode :: Inlines -> Inlines
    inlineCode :: Inlines -> Inlines
inlineCode = Text -> Inlines
code (Text -> Inlines) -> (Inlines -> Text) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall (t :: * -> *). Foldable t => t Inline -> Text
stringifyInlines

type PropertyTriple = (ReaderState, TextProperties, Maybe StyleFamily)
type InlineModifier = Inlines -> Inlines

-- | Given data about the local style changes, calculates how to modify
-- an instance of 'Inlines'
modifierFromStyleDiff :: PropertyTriple -> InlineModifier
modifierFromStyleDiff :: PropertyTriple -> Inlines -> Inlines
modifierFromStyleDiff PropertyTriple
propertyTriple  =
  ((Inlines -> Inlines)
 -> (Inlines -> Inlines) -> Inlines -> Inlines)
-> (Inlines -> Inlines)
-> [Inlines -> Inlines]
-> Inlines
-> Inlines
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Inlines -> Inlines
forall a. a -> a
id ([Inlines -> Inlines] -> Inlines -> Inlines)
-> [Inlines -> Inlines] -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$
  PropertyTriple -> Inlines -> Inlines
getVPosModifier PropertyTriple
propertyTriple
  (Inlines -> Inlines)
-> [Inlines -> Inlines] -> [Inlines -> Inlines]
forall a. a -> [a] -> [a]
: ((PropertyTriple -> Bool, Inlines -> Inlines)
 -> Inlines -> Inlines)
-> [(PropertyTriple -> Bool, Inlines -> Inlines)]
-> [Inlines -> Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (\(PropertyTriple -> Bool
hasChanged', Inlines -> Inlines
modifier) ->
           if PropertyTriple -> Bool
hasChanged' PropertyTriple
propertyTriple then Inlines -> Inlines
modifier else Inlines -> Inlines
ignore)
        [ (PropertyTriple -> Bool
hasEmphChanged           , Inlines -> Inlines
emph      )
        , ((TextProperties -> Bool) -> PropertyTriple -> Bool
forall {a}. Eq a => (TextProperties -> a) -> PropertyTriple -> Bool
hasChanged TextProperties -> Bool
isStrong      , Inlines -> Inlines
strong    )
        , ((TextProperties -> Maybe UnderlineMode) -> PropertyTriple -> Bool
forall {a}. Eq a => (TextProperties -> a) -> PropertyTriple -> Bool
hasChanged TextProperties -> Maybe UnderlineMode
strikethrough , Inlines -> Inlines
strikeout )
        ]
  where
    ignore :: Inlines -> Inlines
ignore = Inlines -> Inlines
forall a. a -> a
id :: InlineModifier

    getVPosModifier :: PropertyTriple -> InlineModifier
    getVPosModifier :: PropertyTriple -> Inlines -> Inlines
getVPosModifier triple :: PropertyTriple
triple@(ReaderState
_,TextProperties
textProps,Maybe StyleFamily
_) =
        let getVPos :: TextProperties -> Maybe VerticalTextPosition
getVPos = VerticalTextPosition -> Maybe VerticalTextPosition
forall a. a -> Maybe a
Just (VerticalTextPosition -> Maybe VerticalTextPosition)
-> (TextProperties -> VerticalTextPosition)
-> TextProperties
-> Maybe VerticalTextPosition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextProperties -> VerticalTextPosition
verticalPosition
        in  case (TextProperties -> Maybe VerticalTextPosition)
-> PropertyTriple -> Maybe VerticalTextPosition
forall {a} {b}.
(TextProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousValueM TextProperties -> Maybe VerticalTextPosition
getVPos PropertyTriple
triple of
              Maybe VerticalTextPosition
Nothing      -> Inlines -> Inlines
ignore
              Just VerticalTextPosition
oldVPos -> (VerticalTextPosition, VerticalTextPosition) -> Inlines -> Inlines
getVPosModifier' (VerticalTextPosition
oldVPos, TextProperties -> VerticalTextPosition
verticalPosition TextProperties
textProps)

    getVPosModifier' :: (VerticalTextPosition, VerticalTextPosition) -> Inlines -> Inlines
getVPosModifier' (VerticalTextPosition
oldVPos , VerticalTextPosition
newVPos   ) | VerticalTextPosition
oldVPos VerticalTextPosition -> VerticalTextPosition -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalTextPosition
newVPos = Inlines -> Inlines
ignore
    getVPosModifier' ( VerticalTextPosition
_      , VerticalTextPosition
VPosSub   ) = Inlines -> Inlines
subscript
    getVPosModifier' ( VerticalTextPosition
_      , VerticalTextPosition
VPosSuper ) = Inlines -> Inlines
superscript
    getVPosModifier' ( VerticalTextPosition
_      ,  VerticalTextPosition
_        ) = Inlines -> Inlines
ignore

    hasEmphChanged :: PropertyTriple -> Bool
    hasEmphChanged :: PropertyTriple -> Bool
hasEmphChanged PropertyTriple
triple = ((PropertyTriple -> Bool) -> Bool)
-> [PropertyTriple -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((PropertyTriple -> Bool) -> PropertyTriple -> Bool
forall a b. (a -> b) -> a -> b
$ PropertyTriple
triple) [ (TextProperties -> Bool) -> PropertyTriple -> Bool
forall {a}. Eq a => (TextProperties -> a) -> PropertyTriple -> Bool
hasChanged  TextProperties -> Bool
isEmphasised
                                           , (TextProperties -> Maybe UnderlineMode) -> PropertyTriple -> Bool
forall {a}. Eq a => (TextProperties -> a) -> PropertyTriple -> Bool
hasChanged  TextProperties -> Maybe UnderlineMode
underline
                                           ]

    hasChanged :: (TextProperties -> a) -> PropertyTriple -> Bool
hasChanged TextProperties -> a
property triple :: PropertyTriple
triple@(ReaderState
_, TextProperties -> a
property -> a
newProperty, Maybe StyleFamily
_) =
        (Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> Maybe a
forall a. a -> Maybe a
Just a
newProperty) ((TextProperties -> a) -> PropertyTriple -> Maybe a
forall {a} {b}.
(TextProperties -> a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousValue TextProperties -> a
property PropertyTriple
triple)

    lookupPreviousValue :: (TextProperties -> a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousValue TextProperties -> a
f = (StyleProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
forall {a} {b}.
(StyleProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousStyleValue ((TextProperties -> a) -> Maybe TextProperties -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextProperties -> a
f (Maybe TextProperties -> Maybe a)
-> (StyleProperties -> Maybe TextProperties)
-> StyleProperties
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleProperties -> Maybe TextProperties
textProperties)

    lookupPreviousValueM :: (TextProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousValueM TextProperties -> Maybe a
f = (StyleProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
forall {a} {b}.
(StyleProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousStyleValue (TextProperties -> Maybe a
f (TextProperties -> Maybe a)
-> (StyleProperties -> Maybe TextProperties)
-> StyleProperties
-> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< StyleProperties -> Maybe TextProperties
textProperties)

    lookupPreviousStyleValue :: (StyleProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousStyleValue StyleProperties -> Maybe a
f (ReaderState{Int
[Style]
Maybe Text
Maybe ListStyle
Media
Map (Maybe Text, Int) Int
Map Text Text
Set Text
Styles
MediaBag
styleSet :: ReaderState -> Styles
styleTrace :: ReaderState -> [Style]
currentListLevel :: ReaderState -> Int
listContinuationStartCounters :: ReaderState -> Map (Maybe Text, Int) Int
currentListStyle :: ReaderState -> Maybe ListStyle
currentListStyleName :: ReaderState -> Maybe Text
bookmarkAnchors :: ReaderState -> Map Text Text
usedAnchors :: ReaderState -> Set Text
envMedia :: ReaderState -> Media
odtMediaBag :: ReaderState -> MediaBag
styleSet :: Styles
styleTrace :: [Style]
currentListLevel :: Int
listContinuationStartCounters :: Map (Maybe Text, Int) Int
currentListStyle :: Maybe ListStyle
currentListStyleName :: Maybe Text
bookmarkAnchors :: Map Text Text
usedAnchors :: Set Text
envMedia :: Media
odtMediaBag :: MediaBag
..},b
_,Maybe StyleFamily
mFamily)
      =     (StyleProperties -> Maybe a) -> [StyleProperties] -> Maybe a
forall a b. (a -> Maybe b) -> [a] -> Maybe b
findBy StyleProperties -> Maybe a
f ([Style] -> Styles -> [StyleProperties]
extendedStylePropertyChain [Style]
styleTrace Styles
styleSet)
        Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StyleProperties -> Maybe a
f (StyleProperties -> Maybe a)
-> (StyleFamily -> StyleProperties) -> StyleFamily -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Styles -> StyleFamily -> StyleProperties
lookupDefaultStyle' Styles
styleSet (StyleFamily -> Maybe a) -> Maybe StyleFamily -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe StyleFamily
mFamily)


type ParaModifier = Blocks -> Blocks

_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_      :: Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_ :: Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_ :: Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_      = Int
5
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_ :: Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_ = Int
5

-- | Returns either 'id' or 'blockQuote' depending if any of the StyleProperties
-- are indented at quote level.
getParaModifier :: ListLevel -> [StyleProperties] -> ParaModifier
getParaModifier :: Int -> [StyleProperties] -> ParaModifier
getParaModifier Int
listLevel [StyleProperties]
props
  | Int
listLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = ParaModifier
forall a. a -> a
id -- see #9505, list paragraphs need indentation
  | (StyleProperties -> Bool) -> [StyleProperties] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StyleProperties -> Bool
isBlockQuote [StyleProperties]
props = ParaModifier
blockQuote
  | Bool
otherwise = ParaModifier
forall a. a -> a
id
  where
  isBlockQuote :: StyleProperties -> Bool
isBlockQuote SProps {Maybe ParaProperties
Maybe TextProperties
textProperties :: StyleProperties -> Maybe TextProperties
textProperties :: Maybe TextProperties
paraProperties :: Maybe ParaProperties
paraProperties :: StyleProperties -> Maybe ParaProperties
..} | Just ParaProperties
paraProps <- Maybe ParaProperties
paraProperties
                                    , LengthOrPercent -> Bool
isQuoteWidth (ParaProperties -> LengthOrPercent
margin_left ParaProperties
paraProps)
                                    = Bool
True
                                    | Bool
otherwise
                                    = Bool
False
  isQuoteWidth :: LengthOrPercent -> Bool
isQuoteWidth LengthOrPercent
mMargin
    | LengthValueMM Int
margin <- LengthOrPercent
mMargin
    ,           Int
margin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_
     = Bool
True
    | PercentValue  Int
margin <- LengthOrPercent
mMargin
    ,           Int
margin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_
     = Bool
True
    | Bool
otherwise
     = Bool
False

--
constructPara :: ODTReader Blocks -> ODTReader Blocks
constructPara :: ODTReader Blocks -> ODTReader Blocks
constructPara ODTReader Blocks
reader = do
  fStyle <- ODTReader (Text, Style)
-> XMLConverter Namespace ReaderState (Fallible (Text, Style))
forall nsID extraState a.
XMLConverter nsID extraState a
-> XMLConverter nsID extraState (Fallible a)
tryC ODTReader (Text, Style)
readStyleByName
  case fStyle of
    Left   ()
_    -> ODTReader Blocks
reader
    Right (Text
styleName, Style
_) | Text -> Bool
isTableCaptionStyle Text
styleName ->
      ParaModifier
tableCaptionP ParaModifier -> ODTReader Blocks -> ODTReader Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ODTReader Blocks
reader
    Right (Text
_, Style
style) -> do
      styles <- ODTReader Styles
getStyles
      let props = [Style] -> Styles -> [StyleProperties]
extendedStylePropertyChain [Style
style] Styles
styles
      listLevel <- getCurrentListLevel
      getParaModifier listLevel props <$> reader
  where
    isTableCaptionStyle :: StyleName -> Bool
    isTableCaptionStyle :: Text -> Bool
isTableCaptionStyle Text
"Table" = Bool
True
    isTableCaptionStyle Text
_       = Bool
False
    tableCaptionP :: ParaModifier
tableCaptionP Blocks
b = Attr -> ParaModifier
divWith (Text
"", [Text
"caption"], []) Blocks
b

type ListConstructor = [Blocks] -> Blocks

getListConstructor :: ListLevelStyle -> Int -> ListConstructor
getListConstructor :: ListLevelStyle -> Int -> ListConstructor
getListConstructor ListLevelStyle{Int
Maybe Text
ListItemNumberFormat
ListLevelType
listLevelType :: ListLevelType
listItemPrefix :: Maybe Text
listItemSuffix :: Maybe Text
listItemFormat :: ListItemNumberFormat
listItemStart :: Int
listItemStart :: ListLevelStyle -> Int
listItemFormat :: ListLevelStyle -> ListItemNumberFormat
listItemSuffix :: ListLevelStyle -> Maybe Text
listItemPrefix :: ListLevelStyle -> Maybe Text
listLevelType :: ListLevelStyle -> ListLevelType
..} Int
startNum =
  case ListLevelType
listLevelType of
    ListLevelType
LltBullet   -> ListConstructor
bulletList
    ListLevelType
LltImage    -> ListConstructor
bulletList
    ListLevelType
LltNumbered -> let listNumberStyle :: ListNumberStyle
listNumberStyle = ListItemNumberFormat -> ListNumberStyle
toListNumberStyle ListItemNumberFormat
listItemFormat
                       listNumberDelim :: ListNumberDelim
listNumberDelim = Maybe Text -> Maybe Text -> ListNumberDelim
forall {a} {a}.
(Eq a, Eq a, IsString a, IsString a) =>
Maybe a -> Maybe a -> ListNumberDelim
toListNumberDelim Maybe Text
listItemPrefix
                                                           Maybe Text
listItemSuffix
                   in  ListAttributes -> ListConstructor
orderedListWith (Int
startNum, ListNumberStyle
listNumberStyle, ListNumberDelim
listNumberDelim)
  where
    toListNumberStyle :: ListItemNumberFormat -> ListNumberStyle
toListNumberStyle  ListItemNumberFormat
LinfNone      = ListNumberStyle
DefaultStyle
    toListNumberStyle  ListItemNumberFormat
LinfNumber    = ListNumberStyle
Decimal
    toListNumberStyle  ListItemNumberFormat
LinfRomanLC   = ListNumberStyle
LowerRoman
    toListNumberStyle  ListItemNumberFormat
LinfRomanUC   = ListNumberStyle
UpperRoman
    toListNumberStyle  ListItemNumberFormat
LinfAlphaLC   = ListNumberStyle
LowerAlpha
    toListNumberStyle  ListItemNumberFormat
LinfAlphaUC   = ListNumberStyle
UpperAlpha
    toListNumberStyle (LinfString FilePath
_) = ListNumberStyle
Example

    toListNumberDelim :: Maybe a -> Maybe a -> ListNumberDelim
toListNumberDelim  Maybe a
Nothing   (Just a
".") = ListNumberDelim
Period
    toListNumberDelim (Just a
"" ) (Just a
".") = ListNumberDelim
Period
    toListNumberDelim  Maybe a
Nothing   (Just a
")") = ListNumberDelim
OneParen
    toListNumberDelim (Just a
"" ) (Just a
")") = ListNumberDelim
OneParen
    toListNumberDelim (Just a
"(") (Just a
")") = ListNumberDelim
TwoParens
    toListNumberDelim     Maybe a
_          Maybe a
_      = ListNumberDelim
DefaultDelim

-- | Determines which style to use for a list, which level to use of that
-- style, and which type of list to create as a result of this information.
-- Then prepares the state for eventual child lists and constructs the list from
-- the results.
-- Two main cases are handled: The list may provide its own style or it may
-- rely on a parent list's style. In the former case the current style in the
-- state must be switched before and after the call to the child converter
-- while in the latter the child converter can be called directly.
-- If anything goes wrong, a default ordered-list-constructor is used.
constructList :: ODTReader [Blocks] -> ODTReader Blocks
constructList :: ODTReader [Blocks] -> ODTReader Blocks
constructList ODTReader [Blocks]
reader = do
  (ReaderState -> ReaderState)
-> XMLConverter Namespace ReaderState ()
forall extraState nsID.
(extraState -> extraState) -> XMLConverter nsID extraState ()
modifyExtraState (Int -> ReaderState -> ReaderState
shiftListLevel Int
1)
  listLevel                    <- ODTReader Int
getCurrentListLevel
  fStyleName                   <- tryC (findAttr NsText "style-name")
  fContNumbering               <- tryC (findAttr NsText "continue-numbering")
  inheritedStyleName           <- currentListStyleName <$> getExtraState

  -- Numbering is continued from the previous list with the same
  -- list style (and level), if there is one:
  let mStyleName = (() -> Maybe Text)
-> (Text -> Maybe Text) -> Fallible Text -> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> () -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
inheritedStyleName) Text -> Maybe Text
forall a. a -> Maybe a
Just Fallible Text
fStyleName
  listContinuationStartCounter <- getPreviousListStartCounter mStyleName
                                    listLevel

  let continueNumbering = Fallible Text
fContNumbering Fallible Text -> Fallible Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Fallible Text
forall a b. b -> Either a b
Right Text
"true"

      startNumForListLevelStyle Maybe ListLevelStyle
mListLevelStyle
        | Bool
continueNumbering
        , Just Int
n <- Maybe Int
listContinuationStartCounter = Int
n
        | Bool
otherwise = Int -> (ListLevelStyle -> Int) -> Maybe ListLevelStyle -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 ListLevelStyle -> Int
listItemStart Maybe ListLevelStyle
mListLevelStyle

      constructWith Int
startNum [Blocks] -> b
constructor = do
        items <- ODTReader [Blocks]
reader
        modifyExtraState (shiftListLevel (-1))
        modifyExtraState (modifyListContinuationStartCounter mStyleName
                           listLevel (startNum + length items))
        return $ constructor items

      constructOrderedList =
        let startNum :: Int
startNum = Maybe ListLevelStyle -> Int
startNumForListLevelStyle Maybe ListLevelStyle
forall a. Maybe a
Nothing
        in  Int -> ListConstructor -> ODTReader Blocks
forall {b}.
Int
-> ([Blocks] -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
constructWith Int
startNum
              (ListAttributes -> ListConstructor
orderedListWith (Int
startNum, ListNumberStyle
DefaultStyle, ListNumberDelim
DefaultDelim))

      constructListWith ListLevelStyle
listLevelStyle =
        let startNum :: Int
startNum = Maybe ListLevelStyle -> Int
startNumForListLevelStyle (ListLevelStyle -> Maybe ListLevelStyle
forall a. a -> Maybe a
Just ListLevelStyle
listLevelStyle)
        in  Int -> ListConstructor -> ODTReader Blocks
forall {b}.
Int
-> ([Blocks] -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
constructWith Int
startNum (ListLevelStyle -> Int -> ListConstructor
getListConstructor ListLevelStyle
listLevelStyle Int
startNum)

  case fStyleName of
    Right Text
styleName -> do
      fListStyle <- ODTReader ListStyle
-> XMLConverter Namespace ReaderState (Fallible ListStyle)
forall nsID extraState a.
XMLConverter nsID extraState a
-> XMLConverter nsID extraState (Fallible a)
tryC (Text -> ODTReader ListStyle
lookupListStyle Text
styleName)
      case fListStyle of
        Right ListStyle
listStyle ->
          case Int -> ListStyle -> Maybe ListLevelStyle
getListLevelStyle Int
listLevel ListStyle
listStyle of
            Just ListLevelStyle
listLevelStyle -> do
              oldListStyle <- Maybe (Text, ListStyle) -> ODTReader (Maybe (Text, ListStyle))
switchCurrentListStyle
                                ((Text, ListStyle) -> Maybe (Text, ListStyle)
forall a. a -> Maybe a
Just (Text
styleName, ListStyle
listStyle))
              blocks       <- constructListWith listLevelStyle
              _            <- switchCurrentListStyle oldListStyle
              return blocks
            Maybe ListLevelStyle
Nothing             -> ODTReader Blocks
constructOrderedList
        Left ()
_                  -> ODTReader Blocks
constructOrderedList
    Left ()
_ -> do
      mListStyle <- ReaderState -> Maybe ListStyle
currentListStyle (ReaderState -> Maybe ListStyle)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) ReaderState
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (Maybe ListStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState
      case mListStyle of
        Just ListStyle
listStyle ->
          case Int -> ListStyle -> Maybe ListLevelStyle
getListLevelStyle Int
listLevel ListStyle
listStyle of
            Just ListLevelStyle
listLevelStyle -> ListLevelStyle -> ODTReader Blocks
constructListWith ListLevelStyle
listLevelStyle
            Maybe ListLevelStyle
Nothing             -> ODTReader Blocks
constructOrderedList
        Maybe ListStyle
Nothing                 -> ODTReader Blocks
constructOrderedList

--------------------------------------------------------------------------------
-- Readers
--------------------------------------------------------------------------------

type Matcher result = ElementMatcher Namespace ReaderState result

type InlineMatcher = Matcher Inlines

type BlockMatcher  = Matcher Blocks

newtype FirstMatch a = FirstMatch (Alt Maybe a)
  deriving ((forall m. Monoid m => FirstMatch m -> m)
-> (forall m a. Monoid m => (a -> m) -> FirstMatch a -> m)
-> (forall m a. Monoid m => (a -> m) -> FirstMatch a -> m)
-> (forall a b. (a -> b -> b) -> b -> FirstMatch a -> b)
-> (forall a b. (a -> b -> b) -> b -> FirstMatch a -> b)
-> (forall b a. (b -> a -> b) -> b -> FirstMatch a -> b)
-> (forall b a. (b -> a -> b) -> b -> FirstMatch a -> b)
-> (forall a. (a -> a -> a) -> FirstMatch a -> a)
-> (forall a. (a -> a -> a) -> FirstMatch a -> a)
-> (forall a. FirstMatch a -> [a])
-> (forall a. FirstMatch a -> Bool)
-> (forall a. FirstMatch a -> Int)
-> (forall a. Eq a => a -> FirstMatch a -> Bool)
-> (forall a. Ord a => FirstMatch a -> a)
-> (forall a. Ord a => FirstMatch a -> a)
-> (forall a. Num a => FirstMatch a -> a)
-> (forall a. Num a => FirstMatch a -> a)
-> Foldable FirstMatch
forall a. Eq a => a -> FirstMatch a -> Bool
forall a. Num a => FirstMatch a -> a
forall a. Ord a => FirstMatch a -> a
forall m. Monoid m => FirstMatch m -> m
forall a. FirstMatch a -> Bool
forall a. FirstMatch a -> Int
forall a. FirstMatch a -> [a]
forall a. (a -> a -> a) -> FirstMatch a -> a
forall m a. Monoid m => (a -> m) -> FirstMatch a -> m
forall b a. (b -> a -> b) -> b -> FirstMatch a -> b
forall a b. (a -> b -> b) -> b -> FirstMatch a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => FirstMatch m -> m
fold :: forall m. Monoid m => FirstMatch m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FirstMatch a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FirstMatch a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FirstMatch a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> FirstMatch a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> FirstMatch a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FirstMatch a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FirstMatch a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FirstMatch a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FirstMatch a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FirstMatch a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FirstMatch a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> FirstMatch a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> FirstMatch a -> a
foldr1 :: forall a. (a -> a -> a) -> FirstMatch a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FirstMatch a -> a
foldl1 :: forall a. (a -> a -> a) -> FirstMatch a -> a
$ctoList :: forall a. FirstMatch a -> [a]
toList :: forall a. FirstMatch a -> [a]
$cnull :: forall a. FirstMatch a -> Bool
null :: forall a. FirstMatch a -> Bool
$clength :: forall a. FirstMatch a -> Int
length :: forall a. FirstMatch a -> Int
$celem :: forall a. Eq a => a -> FirstMatch a -> Bool
elem :: forall a. Eq a => a -> FirstMatch a -> Bool
$cmaximum :: forall a. Ord a => FirstMatch a -> a
maximum :: forall a. Ord a => FirstMatch a -> a
$cminimum :: forall a. Ord a => FirstMatch a -> a
minimum :: forall a. Ord a => FirstMatch a -> a
$csum :: forall a. Num a => FirstMatch a -> a
sum :: forall a. Num a => FirstMatch a -> a
$cproduct :: forall a. Num a => FirstMatch a -> a
product :: forall a. Num a => FirstMatch a -> a
Foldable, Semigroup (FirstMatch a)
FirstMatch a
Semigroup (FirstMatch a) =>
FirstMatch a
-> (FirstMatch a -> FirstMatch a -> FirstMatch a)
-> ([FirstMatch a] -> FirstMatch a)
-> Monoid (FirstMatch a)
[FirstMatch a] -> FirstMatch a
FirstMatch a -> FirstMatch a -> FirstMatch a
forall a. Semigroup (FirstMatch a)
forall a. FirstMatch a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [FirstMatch a] -> FirstMatch a
forall a. FirstMatch a -> FirstMatch a -> FirstMatch a
$cmempty :: forall a. FirstMatch a
mempty :: FirstMatch a
$cmappend :: forall a. FirstMatch a -> FirstMatch a -> FirstMatch a
mappend :: FirstMatch a -> FirstMatch a -> FirstMatch a
$cmconcat :: forall a. [FirstMatch a] -> FirstMatch a
mconcat :: [FirstMatch a] -> FirstMatch a
Monoid, NonEmpty (FirstMatch a) -> FirstMatch a
FirstMatch a -> FirstMatch a -> FirstMatch a
(FirstMatch a -> FirstMatch a -> FirstMatch a)
-> (NonEmpty (FirstMatch a) -> FirstMatch a)
-> (forall b. Integral b => b -> FirstMatch a -> FirstMatch a)
-> Semigroup (FirstMatch a)
forall b. Integral b => b -> FirstMatch a -> FirstMatch a
forall a. NonEmpty (FirstMatch a) -> FirstMatch a
forall a. FirstMatch a -> FirstMatch a -> FirstMatch a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> FirstMatch a -> FirstMatch a
$c<> :: forall a. FirstMatch a -> FirstMatch a -> FirstMatch a
<> :: FirstMatch a -> FirstMatch a -> FirstMatch a
$csconcat :: forall a. NonEmpty (FirstMatch a) -> FirstMatch a
sconcat :: NonEmpty (FirstMatch a) -> FirstMatch a
$cstimes :: forall a b. Integral b => b -> FirstMatch a -> FirstMatch a
stimes :: forall b. Integral b => b -> FirstMatch a -> FirstMatch a
Semigroup)

firstMatch :: a -> FirstMatch a
firstMatch :: forall a. a -> FirstMatch a
firstMatch = Alt Maybe a -> FirstMatch a
forall a. Alt Maybe a -> FirstMatch a
FirstMatch (Alt Maybe a -> FirstMatch a)
-> (a -> Alt Maybe a) -> a -> FirstMatch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Alt Maybe a
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Maybe a -> Alt Maybe a) -> (a -> Maybe a) -> a -> Alt Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just

newtype CombiningBlocks = CombiningBlocks { CombiningBlocks -> Blocks
unCombiningBlocks :: Blocks }

instance Semigroup CombiningBlocks where
  CombiningBlocks Blocks
l <> :: CombiningBlocks -> CombiningBlocks -> CombiningBlocks
<> CombiningBlocks Blocks
r = Blocks -> CombiningBlocks
CombiningBlocks (Blocks -> ParaModifier
combineBlocks Blocks
l Blocks
r)

instance Monoid CombiningBlocks where
  mempty :: CombiningBlocks
mempty = Blocks -> CombiningBlocks
CombiningBlocks Blocks
forall a. Monoid a => a
mempty

--
matchingElement :: Namespace -> ElementName
                -> ODTReader e
                -> Matcher e
matchingElement :: forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
ns Text
name ODTReader e
reader = (Namespace
ns, Text
name, ODTReader e
reader)

--
matchSmushedChildBlocks' :: [Matcher CombiningBlocks] -> ODTReader Blocks
matchSmushedChildBlocks' :: [Matcher CombiningBlocks] -> ODTReader Blocks
matchSmushedChildBlocks' [Matcher CombiningBlocks]
ls = CombiningBlocks -> Blocks
unCombiningBlocks (CombiningBlocks -> Blocks)
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> ODTReader Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Matcher CombiningBlocks]
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [Matcher CombiningBlocks]
ls

--------------------------------------------
-- Matchers
--------------------------------------------

----------------------
-- Basics
----------------------

--
-- | Open Document allows several consecutive spaces if they are marked up.
-- Text content of the current element is read with this fallback converter.
read_plain_text :: XML.Content -> ODTReader Inlines
read_plain_text :: Content -> ODTReader Inlines
read_plain_text (XML.Text CData
cData) = Inlines -> ODTReader Inlines
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ODTReader Inlines) -> Inlines -> ODTReader Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ CData -> Text
XML.cdData CData
cData
read_plain_text Content
_                = Inlines -> ODTReader Inlines
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty

read_text_seq :: InlineMatcher
read_text_seq :: InlineMatcher
read_text_seq  = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"sequence"
                 (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ [InlineMatcher]
-> (Content -> ODTReader Inlines) -> ODTReader Inlines
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [] Content -> ODTReader Inlines
read_plain_text


-- specifically. I honor that, although the current implementation of 'mappend'
-- for 'Inlines' in "Text.Pandoc.Builder" will collapse them again.
-- The rational is to be prepared for future modifications.
-- The repeat count is attacker-controlled and unbounded in ODF, so cap
-- it: a 832-byte document with @text:c="200000000"@ would otherwise
-- exhaust memory.
_MAX_SPACES_     :: Int
_MAX_SPACES_ :: Int
_MAX_SPACES_      = Int
1000

read_spaces      :: InlineMatcher
read_spaces :: InlineMatcher
read_spaces       = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"s" (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ do
                      count <- Namespace -> Text -> Int -> ODTReader Int
forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> attrValue -> XMLConverter nsID extraState attrValue
readAttrWithDefault Namespace
NsText Text
"c" Int
1 -- how many spaces?
                      return $ fromList (replicate (min count _MAX_SPACES_) Space)
--
read_line_break  :: InlineMatcher
read_line_break :: InlineMatcher
read_line_break   = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"line-break"
                    (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ Inlines -> ODTReader Inlines
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
--
read_tab         :: InlineMatcher
read_tab :: InlineMatcher
read_tab          = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"tab"
                    (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ Inlines -> ODTReader Inlines
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
space
--
read_span        :: InlineMatcher
read_span :: InlineMatcher
read_span         = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"span"
                    (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ ODTReader Inlines -> ODTReader Inlines
withNewStyle ODTReader Inlines
matchInlineContent

-- | ODF wraps inline content in a few elements that carry nothing but
-- metadata: @text:meta@ holds RDFa annotations, @text:meta-field@ marks
-- up bibliographic data. They are transparent as far as we are concerned.
read_meta        :: InlineMatcher
read_meta :: InlineMatcher
read_meta         = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"meta" ODTReader Inlines
matchInlineContent

read_meta_field  :: InlineMatcher
read_meta_field :: InlineMatcher
read_meta_field   = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"meta-field" ODTReader Inlines
matchInlineContent

-- | A ruby annotation glosses a base text. Pandoc cannot represent the
-- gloss, so keep the base text rather than dropping both.
read_ruby        :: InlineMatcher
read_ruby :: InlineMatcher
read_ruby         = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"ruby"
                    (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ [InlineMatcher] -> ODTReader Inlines
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"ruby-base"
                                        ODTReader Inlines
matchInlineContent ]

-- | Fields hold a value that the producing application computes, such as
-- a page number, a document property or a user variable. The element
-- content is the text that application last displayed for the field,
-- which is the best rendering available to us.
read_fields      :: [InlineMatcher]
read_fields :: [InlineMatcher]
read_fields       = [ Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
name ([InlineMatcher]
-> (Content -> ODTReader Inlines) -> ODTReader Inlines
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [] Content -> ODTReader Inlines
read_plain_text)
                    | Text
name <- [Text]
fieldElements ]

fieldElements    :: [ElementName]
fieldElements :: [Text]
fieldElements     =
  [ Text
"page-number", Text
"page-count", Text
"page-continuation", Text
"page-variable-get"
  , Text
"date", Text
"time", Text
"creation-date", Text
"creation-time"
  , Text
"modification-date", Text
"modification-time"
  , Text
"print-date", Text
"print-time", Text
"printed-by"
  , Text
"editing-cycles", Text
"editing-duration"
  , Text
"author-name", Text
"author-initials", Text
"initial-creator", Text
"creator"
  , Text
"title", Text
"subject", Text
"description", Text
"keywords"
  , Text
"chapter", Text
"file-name", Text
"template-name", Text
"sheet-name"
  , Text
"variable-get", Text
"variable-set", Text
"variable-input"
  , Text
"user-defined", Text
"user-field-get", Text
"user-field-input"
  , Text
"expression", Text
"text-input", Text
"placeholder"
  , Text
"word-count", Text
"character-count", Text
"paragraph-count"
  , Text
"table-count", Text
"image-count", Text
"object-count"
  , Text
"database-display", Text
"database-name", Text
"database-row-number"
  , Text
"sequence-ref", Text
"note-ref"
  , Text
"sender-firstname", Text
"sender-lastname", Text
"sender-initials"
  , Text
"sender-title", Text
"sender-position", Text
"sender-email"
  , Text
"sender-company", Text
"sender-street", Text
"sender-city"
  , Text
"sender-postal-code", Text
"sender-country", Text
"sender-state-or-province"
  , Text
"sender-phone-private", Text
"sender-phone-work", Text
"sender-fax"
  ]

--
read_paragraph   :: Matcher CombiningBlocks
read_paragraph :: Matcher CombiningBlocks
read_paragraph    = Namespace
-> Text
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"p" (ExceptT
   ()
   (State (XMLConverterState Namespace ReaderState))
   CombiningBlocks
 -> Matcher CombiningBlocks)
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall a b. (a -> b) -> a -> b
$ (Blocks -> CombiningBlocks)
-> ODTReader Blocks
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
forall a b.
(a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Blocks -> CombiningBlocks
CombiningBlocks (ODTReader Blocks
 -> ExceptT
      ()
      (State (XMLConverterState Namespace ReaderState))
      CombiningBlocks)
-> ODTReader Blocks
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
forall a b. (a -> b) -> a -> b
$ do
                      fStyle <- ODTReader (Text, Style)
-> XMLConverter Namespace ReaderState (Fallible (Text, Style))
forall nsID extraState a.
XMLConverter nsID extraState a
-> XMLConverter nsID extraState (Fallible a)
tryC ODTReader (Text, Style)
readStyleByName
                      case fStyle of
                        Right (Text, Style)
style | (Text, Style) -> Bool
isPreformattedStyle (Text, Style)
style ->
                          Text -> Blocks
codeBlock (Text -> Blocks) -> (Inlines -> Text) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Text
forall (t :: * -> *). Foldable t => t Inline -> Text
stringifyInlines (Inlines -> Blocks) -> ODTReader Inlines -> ODTReader Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ODTReader Inlines
matchInlineContent
                        Fallible (Text, Style)
_ ->
                          ODTReader Blocks -> ODTReader Blocks
constructPara (Inlines -> Blocks
para (Inlines -> Blocks) -> ODTReader Inlines -> ODTReader Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ODTReader Inlines -> ODTReader Inlines
withNewStyle ODTReader Inlines
matchInlineContent)
                    where
                      isPreformattedStyle :: (StyleName, Style) -> Bool
                      isPreformattedStyle :: (Text, Style) -> Bool
isPreformattedStyle (Text
"Preformatted_20_Text", Style
_) = Bool
True
                      isPreformattedStyle (Text
_, Style { styleParentName :: Style -> Maybe Text
styleParentName = Just Text
"Preformatted_20_Text" }) = Bool
True
                      isPreformattedStyle (Text, Style)
_ = Bool
False


-- | Reads the inline content of a paragraph, heading or span.
matchInlineContent :: ODTReader Inlines
matchInlineContent :: ODTReader Inlines
matchInlineContent = [InlineMatcher]
-> (Content -> ODTReader Inlines) -> ODTReader Inlines
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [InlineMatcher]
inlineMatchers Content -> ODTReader Inlines
read_plain_text

inlineMatchers :: [InlineMatcher]
inlineMatchers :: [InlineMatcher]
inlineMatchers = [ InlineMatcher
read_span
                 , InlineMatcher
read_spaces
                 , InlineMatcher
read_line_break
                 , InlineMatcher
read_tab
                 , InlineMatcher
read_link
                 , InlineMatcher
read_note
                 , InlineMatcher
read_citation
                 , InlineMatcher
read_bookmark
                 , InlineMatcher
read_bookmark_start
                 , InlineMatcher
read_reference_start
                 , InlineMatcher
read_bookmark_ref
                 , InlineMatcher
read_reference_ref
                 , InlineMatcher
read_frame
                 , InlineMatcher
read_text_seq
                 , InlineMatcher
read_meta
                 , InlineMatcher
read_meta_field
                 , InlineMatcher
read_ruby
                 ] [InlineMatcher] -> [InlineMatcher] -> [InlineMatcher]
forall a. [a] -> [a] -> [a]
++ [InlineMatcher]
read_fields

-- | Reads the block-level content that ODF permits wherever it permits a
-- paragraph: in the body of the document, and in a section, a list item, a
-- footnote or a table cell.
matchBlockContent :: ODTReader Blocks
matchBlockContent :: ODTReader Blocks
matchBlockContent = [Matcher CombiningBlocks] -> ODTReader Blocks
matchSmushedChildBlocks' [Matcher CombiningBlocks]
blockMatchers

blockMatchers :: [Matcher CombiningBlocks]
blockMatchers :: [Matcher CombiningBlocks]
blockMatchers = [ Matcher CombiningBlocks
read_paragraph
                , Matcher CombiningBlocks
read_header
                , Matcher CombiningBlocks
read_list
                , Matcher CombiningBlocks
read_table
                , Matcher CombiningBlocks
read_section
                ]


----------------------
-- Headers
----------------------

--
read_header      :: Matcher CombiningBlocks
read_header :: Matcher CombiningBlocks
read_header       = Namespace
-> Text
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"h" (ExceptT
   ()
   (State (XMLConverterState Namespace ReaderState))
   CombiningBlocks
 -> Matcher CombiningBlocks)
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall a b. (a -> b) -> a -> b
$ do
  level    <- Namespace -> Text -> Int -> ODTReader Int
forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> attrValue -> XMLConverter nsID extraState attrValue
readAttrWithDefault Namespace
NsText Text
"outline-level" Int
1
  children <- matchInlineContent
  anchor   <- getHeaderAnchor children
  let idAttr = (Text
anchor, [], []) -- no classes, no key-value pairs
  return $ CombiningBlocks $ headerWith idAttr level children

----------------------
-- Lists
----------------------

--
read_list        :: Matcher CombiningBlocks
read_list :: Matcher CombiningBlocks
read_list         = Namespace
-> Text
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"list"
                    (ExceptT
   ()
   (State (XMLConverterState Namespace ReaderState))
   CombiningBlocks
 -> Matcher CombiningBlocks)
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall a b. (a -> b) -> a -> b
$ Blocks -> CombiningBlocks
CombiningBlocks
                    (Blocks -> CombiningBlocks)
-> ODTReader Blocks
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ODTReader [Blocks] -> ODTReader Blocks
constructList
                        ( [ElementMatcher Namespace ReaderState [Blocks]]
-> ODTReader [Blocks]
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ ElementMatcher Namespace ReaderState [Blocks]
read_list_item
                                        , ElementMatcher Namespace ReaderState [Blocks]
read_list_header
                                        ] )
--
read_list_item   :: Matcher [Blocks]
read_list_item :: ElementMatcher Namespace ReaderState [Blocks]
read_list_item    = Text -> ElementMatcher Namespace ReaderState [Blocks]
read_list_element Text
"list-item"

read_list_header :: Matcher [Blocks]
read_list_header :: ElementMatcher Namespace ReaderState [Blocks]
read_list_header  = Text -> ElementMatcher Namespace ReaderState [Blocks]
read_list_element Text
"list-header"

read_list_element               :: ElementName -> Matcher [Blocks]
read_list_element :: Text -> ElementMatcher Namespace ReaderState [Blocks]
read_list_element Text
listElement   = Namespace
-> Text
-> ODTReader [Blocks]
-> ElementMatcher Namespace ReaderState [Blocks]
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
listElement
                                  (ODTReader [Blocks]
 -> ElementMatcher Namespace ReaderState [Blocks])
-> ODTReader [Blocks]
-> ElementMatcher Namespace ReaderState [Blocks]
forall a b. (a -> b) -> a -> b
$ do
                                    -- a new item restarts the numbering
                                    -- of nested lists:
                                    listLevel <- ODTReader Int
getCurrentListLevel
                                    modifyExtraState
                                      (resetDeeperListContinuationStartCounters
                                        listLevel)
                                    compactify . (:[]) <$> matchBlockContent

----------------------
-- Sections
----------------------

read_section :: Matcher CombiningBlocks
read_section :: Matcher CombiningBlocks
read_section = Namespace
-> Text
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"section"
                 (ExceptT
   ()
   (State (XMLConverterState Namespace ReaderState))
   CombiningBlocks
 -> Matcher CombiningBlocks)
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall a b. (a -> b) -> a -> b
$ Blocks -> CombiningBlocks
CombiningBlocks (Blocks -> CombiningBlocks)
-> ParaModifier -> Blocks -> CombiningBlocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> ParaModifier
divWith Attr
nullAttr
                 (Blocks -> CombiningBlocks)
-> ODTReader Blocks
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ODTReader Blocks
matchBlockContent


----------------------
-- Links
----------------------

read_link        :: InlineMatcher
read_link :: InlineMatcher
read_link         = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"a"
                    (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link
                      (Text -> Text -> Inlines -> Inlines)
-> ODTReader Text
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (Text -> Inlines -> Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Text
fixRelativeLink
                             (Text -> Text) -> ODTReader Text -> ODTReader Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> Text -> Text -> ODTReader Text
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState Text
findAttrWithDefault Namespace
NsXLink  Text
"href"  Text
"")
                      ExceptT
  ()
  (State (XMLConverterState Namespace ReaderState))
  (Text -> Inlines -> Inlines)
-> ODTReader Text
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (Inlines -> Inlines)
forall a b.
ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Namespace -> Text -> Text -> ODTReader Text
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState Text
findAttrWithDefault Namespace
NsOffice Text
"title" Text
""
                      ExceptT
  ()
  (State (XMLConverterState Namespace ReaderState))
  (Inlines -> Inlines)
-> ODTReader Inlines -> ODTReader Inlines
forall a b.
ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [InlineMatcher]
-> (Content -> ODTReader Inlines) -> ODTReader Inlines
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [ InlineMatcher
read_span
                                       , InlineMatcher
read_note
                                       , InlineMatcher
read_citation
                                       , InlineMatcher
read_bookmark
                                       , InlineMatcher
read_bookmark_start
                                       , InlineMatcher
read_reference_start
                                       , InlineMatcher
read_bookmark_ref
                                       , InlineMatcher
read_reference_ref
                                       ] Content -> ODTReader Inlines
read_plain_text

fixRelativeLink :: T.Text -> T.Text
fixRelativeLink :: Text -> Text
fixRelativeLink Text
uri =
    case FilePath -> Maybe URI
parseRelativeReference (Text -> FilePath
T.unpack Text
uri) of
      Maybe URI
Nothing -> Text
uri
      Just URI
u  ->
        case URI -> FilePath
uriPath URI
u of
          Char
'.':Char
'.':Char
'/':FilePath
xs -> URI -> Text
forall {a}. Show a => a -> Text
tshow (URI -> Text) -> URI -> Text
forall a b. (a -> b) -> a -> b
$ URI
u{ uriPath = xs }
          FilePath
_ -> Text
uri

-------------------------
-- Footnotes
-------------------------

read_note        :: InlineMatcher
read_note :: InlineMatcher
read_note         = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"note"
                    (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ Blocks -> Inlines
note (Blocks -> Inlines) -> ODTReader Blocks -> ODTReader Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ElementMatcher Namespace ReaderState Blocks] -> ODTReader Blocks
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ ElementMatcher Namespace ReaderState Blocks
read_note_body ]

read_note_body   :: BlockMatcher
read_note_body :: ElementMatcher Namespace ReaderState Blocks
read_note_body    = Namespace
-> Text
-> ODTReader Blocks
-> ElementMatcher Namespace ReaderState Blocks
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"note-body" ODTReader Blocks
matchBlockContent

-------------------------
-- Citations
-------------------------

read_citation    :: InlineMatcher
read_citation :: InlineMatcher
read_citation     = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"bibliography-mark"
                    (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ [Citation] -> Inlines -> Inlines
cite
                      ([Citation] -> Inlines -> Inlines)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [Citation]
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (Inlines -> Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> Int -> [Citation]
makeCitation
                              (Text -> Int -> [Citation])
-> ODTReader Text
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (Int -> [Citation])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> Text -> Text -> ODTReader Text
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState Text
findAttrWithDefault Namespace
NsText Text
"identifier" Text
""
                              ExceptT
  ()
  (State (XMLConverterState Namespace ReaderState))
  (Int -> [Citation])
-> ODTReader Int
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [Citation]
forall a b.
ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Namespace -> Text -> Int -> ODTReader Int
forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> attrValue -> XMLConverter nsID extraState attrValue
readAttrWithDefault Namespace
NsText Text
"number" Int
0 )
                      ExceptT
  ()
  (State (XMLConverterState Namespace ReaderState))
  (Inlines -> Inlines)
-> ODTReader Inlines -> ODTReader Inlines
forall a b.
ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [InlineMatcher]
-> (Content -> ODTReader Inlines) -> ODTReader Inlines
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [] Content -> ODTReader Inlines
read_plain_text
  where
   makeCitation :: T.Text -> Int -> [Citation]
   makeCitation :: Text -> Int -> [Citation]
makeCitation Text
citeId Int
num = [Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Citation Text
citeId [] [] CitationMode
NormalCitation Int
num Int
0]


----------------------
-- Tables
----------------------

--
read_table        :: Matcher CombiningBlocks
read_table :: Matcher CombiningBlocks
read_table         = Namespace
-> Text
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsTable Text
"table"
                     (ExceptT
   ()
   (State (XMLConverterState Namespace ReaderState))
   CombiningBlocks
 -> Matcher CombiningBlocks)
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
-> Matcher CombiningBlocks
forall a b. (a -> b) -> a -> b
$ (([[Cell]], [[Cell]]) -> CombiningBlocks)
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     ([[Cell]], [[Cell]])
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
forall a b.
(a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Blocks -> CombiningBlocks
CombiningBlocks (Blocks -> CombiningBlocks)
-> (([[Cell]], [[Cell]]) -> Blocks)
-> ([[Cell]], [[Cell]])
-> CombiningBlocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Cell]], [[Cell]]) -> Blocks
table')
                     (ExceptT
   ()
   (State (XMLConverterState Namespace ReaderState))
   ([[Cell]], [[Cell]])
 -> ExceptT
      ()
      (State (XMLConverterState Namespace ReaderState))
      CombiningBlocks)
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     ([[Cell]], [[Cell]])
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     CombiningBlocks
forall a b. (a -> b) -> a -> b
$ (,) ([[Cell]] -> [[Cell]] -> ([[Cell]], [[Cell]]))
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     ([[Cell]] -> ([[Cell]], [[Cell]]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ElementMatcher Namespace ReaderState [[Cell]]]
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ElementMatcher Namespace ReaderState [[Cell]]]
read_header_rows
                           ExceptT
  ()
  (State (XMLConverterState Namespace ReaderState))
  ([[Cell]] -> ([[Cell]], [[Cell]]))
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     ([[Cell]], [[Cell]])
forall a b.
ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ElementMatcher Namespace ReaderState [[Cell]]]
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ElementMatcher Namespace ReaderState [[Cell]]]
read_body_rows

-- | A table without a caption.
table' :: ([[Cell]], [[Cell]]) -> Blocks
table' :: ([[Cell]], [[Cell]]) -> Blocks
table' ([[Cell]]
headers, [[Cell]]
rows) = ParaModifier
forall a.
(Walkable Block a, Walkable [Block] a, Walkable Inline a) =>
a -> a
compactifyTable ParaModifier -> ParaModifier
forall a b. (a -> b) -> a -> b
$
    Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
table Caption
emptyCaption (Int -> ColSpec -> [ColSpec]
forall a. Int -> a -> [a]
replicate Int
numcols ColSpec
defaults) TableHead
th [TableBody
tb] TableFoot
tf
  where
    defaults :: ColSpec
defaults = (Alignment
AlignDefault, ColWidth
ColWidthDefault)
    -- A table element need not contain any rows, so guard against
    -- taking the maximum of an empty list.
    numcols :: Int
numcols = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ ([Cell] -> Int) -> [[Cell]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Cell] -> Int
rowWidth ([[Cell]] -> [Int]) -> [[Cell]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Cell]]
headers [[Cell]] -> [[Cell]] -> [[Cell]]
forall a. [a] -> [a] -> [a]
++ [[Cell]]
rows
    -- A cell spanning several columns occupies all of them.
    rowWidth :: [Cell] -> Int
rowWidth = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Cell] -> [Int]) -> [Cell] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell -> Int) -> [Cell] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Cell Attr
_ Alignment
_ RowSpan
_ (ColSpan Int
cs) [Block]
_) -> Int
cs)
    toRow :: [Cell] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr
    th :: TableHead
th = Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ ([Cell] -> Row) -> [[Cell]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Cell] -> Row
toRow [[Cell]]
headers
    tb :: TableBody
tb = Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Cell] -> Row) -> [[Cell]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Cell] -> Row
toRow [[Cell]]
rows
    tf :: TableFoot
tf = Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr []

-- | Rows need not be immediate children of the table: ODF lets them be
-- wrapped in any number of @table:table-row-group@ and @table:table-rows@
-- elements, which only group them for the benefit of outlining and
-- formatting. The children are walked twice, once picking up the rows that a
-- @table:table-header-rows@ marks as headers and once the remaining ones.
read_header_rows  :: [Matcher [[Cell]]]
read_header_rows :: [ElementMatcher Namespace ReaderState [[Cell]]]
read_header_rows   = [ Namespace
-> Text
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsTable Text
"table-header-rows"
                         (ExceptT
   () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
 -> ElementMatcher Namespace ReaderState [[Cell]])
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall a b. (a -> b) -> a -> b
$ [ElementMatcher Namespace ReaderState [[Cell]]]
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ ElementMatcher Namespace ReaderState [[Cell]]
read_table_row ]
                     , Namespace
-> Text
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsTable Text
"table-row-group"
                         (ExceptT
   () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
 -> ElementMatcher Namespace ReaderState [[Cell]])
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall a b. (a -> b) -> a -> b
$ [ElementMatcher Namespace ReaderState [[Cell]]]
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ElementMatcher Namespace ReaderState [[Cell]]]
read_header_rows
                     ]

read_body_rows    :: [Matcher [[Cell]]]
read_body_rows :: [ElementMatcher Namespace ReaderState [[Cell]]]
read_body_rows     = [ ElementMatcher Namespace ReaderState [[Cell]]
read_table_row
                     , Namespace
-> Text
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsTable Text
"table-rows"
                         (ExceptT
   () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
 -> ElementMatcher Namespace ReaderState [[Cell]])
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall a b. (a -> b) -> a -> b
$ [ElementMatcher Namespace ReaderState [[Cell]]]
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ ElementMatcher Namespace ReaderState [[Cell]]
read_table_row ]
                     , Namespace
-> Text
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsTable Text
"table-row-group"
                         (ExceptT
   () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
 -> ElementMatcher Namespace ReaderState [[Cell]])
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall a b. (a -> b) -> a -> b
$ [ElementMatcher Namespace ReaderState [[Cell]]]
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ElementMatcher Namespace ReaderState [[Cell]]]
read_body_rows
                     ]

-- | ODF abbreviates a run of identical rows or cells with a repeat count.
-- The counts are unbounded in the format -- spreadsheets pad out to the end
-- of the sheet with them -- so a handful of bytes could otherwise ask for an
-- arbitrarily large table. Bound both the width a single cell element stands
-- for and the number of cells a single row element expands to; capping the
-- two counts separately would not do, as they multiply.
_MAX_COLUMNS_, _MAX_ROW_CELLS_ :: Int
_MAX_COLUMNS_ :: Int
_MAX_COLUMNS_      = Int
1000
_MAX_ROW_CELLS_ :: Int
_MAX_ROW_CELLS_    = Int
10000

repeated          :: ElementName -> ODTReader Int
repeated :: Text -> ODTReader Int
repeated Text
attrName  = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> ODTReader Int -> ODTReader Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> Text -> Int -> ODTReader Int
forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> attrValue -> XMLConverter nsID extraState attrValue
readAttrWithDefault Namespace
NsTable Text
attrName Int
1

--
read_table_row    :: Matcher [[Cell]]
read_table_row :: ElementMatcher Namespace ReaderState [[Cell]]
read_table_row     = Namespace
-> Text
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsTable Text
"table-row"
                     (ExceptT
   () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
 -> ElementMatcher Namespace ReaderState [[Cell]])
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
-> ElementMatcher Namespace ReaderState [[Cell]]
forall a b. (a -> b) -> a -> b
$ [Cell] -> Int -> [[Cell]]
forall {t :: * -> *} {a}. Foldable t => t a -> Int -> [t a]
row'
                     ([Cell] -> Int -> [[Cell]])
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [Cell]
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (Int -> [[Cell]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ElementMatcher Namespace ReaderState [Cell]]
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [Cell]
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> XMLConverter nsID extraState a
matchContent' [ ElementMatcher Namespace ReaderState [Cell]
read_table_cell
                                       ]
                     ExceptT
  ()
  (State (XMLConverterState Namespace ReaderState))
  (Int -> [[Cell]])
-> ODTReader Int
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [[Cell]]
forall a b.
ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ODTReader Int
repeated Text
"number-rows-repeated"
  where
    row' :: t a -> Int -> [t a]
row' t a
cells Int
repeat' =
      Int -> t a -> [t a]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
repeat'
                       (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
_MAX_ROW_CELLS_ Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
cells)) t a
cells

--
read_table_cell   :: Matcher [Cell]
read_table_cell :: ElementMatcher Namespace ReaderState [Cell]
read_table_cell    = Namespace
-> Text
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [Cell]
-> ElementMatcher Namespace ReaderState [Cell]
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsTable Text
"table-cell"
                     (ExceptT
   () (State (XMLConverterState Namespace ReaderState)) [Cell]
 -> ElementMatcher Namespace ReaderState [Cell])
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [Cell]
-> ElementMatcher Namespace ReaderState [Cell]
forall a b. (a -> b) -> a -> b
$ RowSpan -> ColSpan -> Int -> Blocks -> [Cell]
cell'
                       (RowSpan -> ColSpan -> Int -> Blocks -> [Cell])
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) RowSpan
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (ColSpan -> Int -> Blocks -> [Cell])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> RowSpan
RowSpan (Int -> RowSpan)
-> ODTReader Int
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) RowSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> Text -> Int -> ODTReader Int
forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> attrValue -> XMLConverter nsID extraState attrValue
readAttrWithDefault Namespace
NsTable Text
"number-rows-spanned" Int
1)
                       ExceptT
  ()
  (State (XMLConverterState Namespace ReaderState))
  (ColSpan -> Int -> Blocks -> [Cell])
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) ColSpan
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (Int -> Blocks -> [Cell])
forall a b.
ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ColSpan
ColSpan (Int -> ColSpan)
-> ODTReader Int
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) ColSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace -> Text -> Int -> ODTReader Int
forall nsID attrValue extraState.
(NameSpaceID nsID, Read attrValue) =>
nsID -> Text -> attrValue -> XMLConverter nsID extraState attrValue
readAttrWithDefault Namespace
NsTable Text
"number-columns-spanned" Int
1)
                       ExceptT
  ()
  (State (XMLConverterState Namespace ReaderState))
  (Int -> Blocks -> [Cell])
-> ODTReader Int
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (Blocks -> [Cell])
forall a b.
ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
_MAX_COLUMNS_ (Int -> Int) -> ODTReader Int -> ODTReader Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ODTReader Int
repeated Text
"number-columns-repeated")
                       ExceptT
  ()
  (State (XMLConverterState Namespace ReaderState))
  (Blocks -> [Cell])
-> ODTReader Blocks
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) [Cell]
forall a b.
ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (a -> b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ODTReader Blocks
matchBlockContent
  where
    cell' :: RowSpan -> ColSpan -> Int -> Blocks -> [Cell]
cell' RowSpan
rowSpan ColSpan
colSpan Int
repeat' Blocks
blocks =
      [[Cell]] -> [Cell]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Cell]] -> [Cell]) -> [[Cell]] -> [Cell]
forall a b. (a -> b) -> a -> b
$ Int -> [Cell] -> [[Cell]]
forall a. Int -> a -> [a]
replicate Int
repeat'
             ([Cell] -> [[Cell]]) -> [Cell] -> [[Cell]]
forall a b. (a -> b) -> a -> b
$ (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
cell Alignment
AlignDefault RowSpan
rowSpan ColSpan
colSpan) ([Blocks] -> [Blocks]
compactify [Blocks
blocks])

----------------------
-- Frames
----------------------

--
read_frame :: InlineMatcher
read_frame :: InlineMatcher
read_frame = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsDraw Text
"frame" (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ do
  children <- Namespace
-> (Text -> Bool) -> XMLConverter Namespace ReaderState [Element]
forall nsID extraState.
NameSpaceID nsID =>
nsID -> (Text -> Bool) -> XMLConverter nsID extraState [Element]
filterChildrenName' Namespace
NsDraw (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"image", Text
"object", Text
"text-box"])
  fold . mconcat <$> mapM read_frame_child children

read_frame_child :: XML.Element -> ODTReader (FirstMatch Inlines)
read_frame_child :: Element
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
read_frame_child Element
child =
  case Element -> Text
elName Element
child of
    Text
"image"    -> Element
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
read_frame_img      Element
child
    Text
"object"   -> Element
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
read_frame_mathml   Element
child
    Text
"text-box" -> Element
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
read_frame_text_box Element
child
    Text
_          -> FirstMatch Inlines
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return FirstMatch Inlines
forall a. Monoid a => a
mempty

read_frame_img :: XML.Element -> ODTReader (FirstMatch Inlines)
read_frame_img :: Element
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
read_frame_img Element
img = do
  mbSrc <- Element
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
forall nsID extraState a.
Element
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
executeIn Element
img ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
resolveImageSrc
  case mbSrc of
    Maybe Text
Nothing  -> FirstMatch Inlines
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return FirstMatch Inlines
forall a. Monoid a => a
mempty
    Just Text
src -> do
      -- note: the remaining attributes are read in the context of the
      -- enclosing draw:frame, not of the draw:image
      let exts :: Extensions
exts = [Extension] -> Extensions
extensionsFromList [Extension
Ext_auto_identifiers]
      w          <- Namespace
-> Text
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
findAttr' Namespace
NsSVG Text
"width"
      h          <- findAttr' NsSVG "height"
      titleNodes <- matchContent' [ read_frame_title ]
      -- trimmed because a pretty-printed file indents the children of
      -- the frame, and that whitespace is not alt text
      alt        <- trimInlines <$> matchContent [] read_plain_text
      return $ firstMatch
             $ imageWith (image_attributes w h) src
                         (inlineListToIdentifier exts (toList titleNodes))
                         alt

-- | Determine the media bag path of the image of the current
-- @draw:image@ element.  The image data is either in another file of the
-- archive, referenced by @xlink:href@, or embedded in the element as
-- base64 in an @office:binary-data@ child (which is how a flat
-- OpenDocument file must carry it).
resolveImageSrc :: ODTReader (Maybe T.Text)
resolveImageSrc :: ExceptT
  () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
resolveImageSrc = do
  href <- Maybe Text -> Text
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe Text -> Text)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
-> ODTReader Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespace
-> Text
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
findAttr' Namespace
NsXLink Text
"href"
  if not (T.null href)
     then do
       let src = Text -> Text
fixRelativeLink Text
href
       -- The archive need not actually contain the referenced file; if it
       -- does not, leave the media bag alone and just emit the link.
       mapM_ (updateMediaWithResource . (,) (T.unpack src))
         =<< lookupResource (T.unpack src)
       return (Just src)
     else do
       drawImage <- getCurrentElement
       findChild' NsOffice "binary-data"
         >>= traverse (embedBase64Image drawImage)

-- | Add the base64-encoded image data of an @office:binary-data@ element
-- to the media bag and return the path under which it was filed.  The
-- mime type is declared on the enclosing @draw:image@.
embedBase64Image :: XML.Element -> XML.Element -> ODTReader T.Text
embedBase64Image :: Element -> Element -> ODTReader Text
embedBase64Image Element
drawImage Element
binaryData = do
  let bytes :: ByteString
bytes = ByteString -> ByteString
decodeLenient (ByteString -> ByteString)
-> (Element -> ByteString) -> Element -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
UTF8.fromText
            (Text -> ByteString) -> (Element -> Text) -> Element -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
XML.strContent (Element -> ByteString) -> Element -> ByteString
forall a b. (a -> b) -> a -> b
$ Element
binaryData
  -- the attribute is draw:mime-type in ODF 1.3 but loext:mime-type in
  -- older LibreOffice output, so match on the local name only
  let mbExtension :: Maybe Text
mbExtension =
        (((Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Text -> Maybe Text)
-> (Text -> Maybe Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
extensionFromMimeType
          (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (QName -> Bool) -> Element -> Maybe Text
XML.findAttrBy ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"mime-type") (Text -> Bool) -> (QName -> Text) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Text
XML.qName) Element
drawImage)
        Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ImageType -> Text
extensionForImageType (ImageType -> Text) -> Maybe ImageType -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe ImageType
imageType ByteString
bytes)
  n <- [(FilePath, Text, ByteString)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(FilePath, Text, ByteString)] -> Int)
-> (ReaderState -> [(FilePath, Text, ByteString)])
-> ReaderState
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaBag -> [(FilePath, Text, ByteString)]
mediaItems (MediaBag -> [(FilePath, Text, ByteString)])
-> (ReaderState -> MediaBag)
-> ReaderState
-> [(FilePath, Text, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderState -> MediaBag
getMediaBag (ReaderState -> Int)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) ReaderState
-> ODTReader Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  () (State (XMLConverterState Namespace ReaderState)) ReaderState
forall nsID extraState. XMLConverter nsID extraState extraState
getExtraState
  let path = FilePath
"Pictures/image" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
".bin" Maybe Text
mbExtension)
  updateMediaWithResource (path, B.fromStrict bytes)
  return (T.pack path)

extensionForImageType :: ImageType -> T.Text
extensionForImageType :: ImageType -> Text
extensionForImageType ImageType
imgType =
  case ImageType
imgType of
    ImageType
Png  -> Text
".png"
    ImageType
Jpeg -> Text
".jpeg"
    ImageType
Gif  -> Text
".gif"
    ImageType
Pdf  -> Text
".pdf"
    ImageType
Eps  -> Text
".eps"
    ImageType
Svg  -> Text
".svg"
    ImageType
Emf  -> Text
".emf"
    ImageType
Tiff -> Text
".tiff"
    ImageType
Webp -> Text
".webp"
    ImageType
Avif -> Text
".avif"

read_frame_title :: InlineMatcher
read_frame_title :: InlineMatcher
read_frame_title = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsSVG Text
"title" ([InlineMatcher]
-> (Content -> ODTReader Inlines) -> ODTReader Inlines
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [] Content -> ODTReader Inlines
read_plain_text)

image_attributes :: Maybe T.Text -> Maybe T.Text -> Attr
image_attributes :: Maybe Text -> Maybe Text -> Attr
image_attributes Maybe Text
x Maybe Text
y =
  ( Text
"", [], Text -> Maybe Text -> [(Text, Text)]
forall {b} {a}. (Eq b, IsString b) => a -> Maybe b -> [(a, b)]
dim Text
"width" Maybe Text
x [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text -> Maybe Text -> [(Text, Text)]
forall {b} {a}. (Eq b, IsString b) => a -> Maybe b -> [(a, b)]
dim Text
"height" Maybe Text
y)
  where
    dim :: a -> Maybe b -> [(a, b)]
dim a
_ (Just b
"")   = []
    dim a
name (Just b
v) = [(a
name, b
v)]
    dim a
_ Maybe b
Nothing     = []

read_frame_mathml :: XML.Element -> ODTReader (FirstMatch Inlines)
read_frame_mathml :: Element
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
read_frame_mathml Element
obj = do
  href <- Maybe Text -> Text
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe Text -> Text)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
-> ODTReader Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
forall nsID extraState a.
Element
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
executeIn Element
obj (Namespace
-> Text
-> ExceptT
     () (State (XMLConverterState Namespace ReaderState)) (Maybe Text)
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState (Maybe Text)
findAttr' Namespace
NsXLink Text
"href")
  mbMathML <-
    if T.null href
       then -- a flat OpenDocument file has to embed the formula in the
            -- draw:object itself
            return $ XML.showElement . addMathMLNamespace <$> findMathML obj
       else do
         -- note that pandoc's own odt writer uses a trailing slash
         let dir = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                     Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
href (Text -> Text -> Maybe Text
T.stripPrefix Text
"./" Text
href)
         fmap (UTF8.toText . B.toStrict) <$>
           lookupResource (T.unpack (dir <> "/content.xml"))
  case readMathML <$> mbMathML of
    Just (Right [Exp]
exps) -> FirstMatch Inlines
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FirstMatch Inlines
 -> ExceptT
      ()
      (State (XMLConverterState Namespace ReaderState))
      (FirstMatch Inlines))
-> FirstMatch Inlines
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
forall a b. (a -> b) -> a -> b
$ Inlines -> FirstMatch Inlines
forall a. a -> FirstMatch a
firstMatch (Inlines -> FirstMatch Inlines) -> Inlines -> FirstMatch Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
displayMath (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ [Exp] -> Text
writeTeX [Exp]
exps
    Maybe (Either Text [Exp])
_                 -> FirstMatch Inlines
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return FirstMatch Inlines
forall a. Monoid a => a
mempty

-- | Find the MathML of a formula embedded in a @draw:object@.  It is
-- searched for as a descendant, not as a direct child, because the
-- @math@ element may be wrapped in an @office:document@ element
-- describing an embedded formula document.
findMathML :: XML.Element -> Maybe XML.Element
findMathML :: Element -> Maybe Element
findMathML = (QName -> Bool) -> Element -> Maybe Element
XML.filterElementName ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"math") (Text -> Bool) -> (QName -> Text) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Text
XML.qName)

-- | XML.Light carries namespace prefixes literally and does not
-- synthesise declarations, so the declaration of the MathML namespace
-- may have been left behind on the root of the flat file.
addMathMLNamespace :: XML.Element -> XML.Element
addMathMLNamespace :: Element -> Element
addMathMLNamespace Element
el =
  Element
el{ XML.elAttribs =
        XML.Attr (XML.QName "xmlns" Nothing Nothing)
                 "http://www.w3.org/1998/Math/MathML"
        : filter (not . isDefaultNS . XML.attrKey) (XML.elAttribs el) }
 where
  isDefaultNS :: QName -> Bool
isDefaultNS QName
qn = QName -> Text
XML.qName QName
qn Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"xmlns" Bool -> Bool -> Bool
&& Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (QName -> Maybe Text
XML.qPrefix QName
qn)

read_frame_text_box :: XML.Element -> ODTReader (FirstMatch Inlines)
read_frame_text_box :: Element
-> ExceptT
     ()
     (State (XMLConverterState Namespace ReaderState))
     (FirstMatch Inlines)
read_frame_text_box Element
box = do
  paragraphs <- Element -> ODTReader Blocks -> ODTReader Blocks
forall nsID extraState a.
Element
-> XMLConverter nsID extraState a -> XMLConverter nsID extraState a
executeIn Element
box ([Matcher CombiningBlocks] -> ODTReader Blocks
matchSmushedChildBlocks' [ Matcher CombiningBlocks
read_paragraph ])
  return $ read_img_with_caption $ toList paragraphs

read_img_with_caption :: [Block] -> FirstMatch Inlines
read_img_with_caption :: [Block] -> FirstMatch Inlines
read_img_with_caption (Para [Image Attr
attr [Inline]
alt (Text
src,Text
title)] : [Block]
_) =
  Inlines -> FirstMatch Inlines
forall a. a -> FirstMatch a
firstMatch (Inlines -> FirstMatch Inlines) -> Inlines -> FirstMatch Inlines
forall a b. (a -> b) -> a -> b
$ Inline -> Inlines
forall a. a -> Many a
singleton (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
alt (Text
src, Text
"fig:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
title))   -- no text, default caption
read_img_with_caption (Para (Image Attr
attr [Inline]
_ (Text
src,Text
title) : [Inline]
txt) : [Block]
_) =
  Inlines -> FirstMatch Inlines
forall a. a -> FirstMatch a
firstMatch (Inlines -> FirstMatch Inlines) -> Inlines -> FirstMatch Inlines
forall a b. (a -> b) -> a -> b
$ Inline -> Inlines
forall a. a -> Many a
singleton (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
txt (Text
src, Text
"fig:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
title) )  -- override caption with the text that follows
read_img_with_caption  ( Para (Inline
_ : [Inline]
xs) : [Block]
ys) =
  [Block] -> FirstMatch Inlines
read_img_with_caption ([Inline] -> Block
Para [Inline]
xs Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
ys)
read_img_with_caption [Block]
_ =
  FirstMatch Inlines
forall a. Monoid a => a
mempty

----------------------
-- Internal links
----------------------

_ANCHOR_PREFIX_ :: T.Text
_ANCHOR_PREFIX_ :: Text
_ANCHOR_PREFIX_ = Text
"anchor"

--
readAnchorAttr :: ODTReader Anchor
readAnchorAttr :: ODTReader Text
readAnchorAttr = Namespace -> Text -> ODTReader Text
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState Text
findAttr Namespace
NsText Text
"name"

-- | Beware: may fail
findAnchorName :: AnchorPrefix -> ODTReader Anchor
findAnchorName :: Text -> ODTReader Text
findAnchorName Text
anchorPrefix = do
  uglyAnchor <- ODTReader Text
readAnchorAttr
  getPrettyAnchor anchorPrefix uglyAnchor

--
maybeAddAnchorFrom :: ODTReader AnchorPrefix -> ODTReader Inlines
maybeAddAnchorFrom :: ODTReader Text -> ODTReader Inlines
maybeAddAnchorFrom ODTReader Text
anchorReader =
      (Text -> Inlines
toAnchorElem (Text -> Inlines) -> ODTReader Text -> ODTReader Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ODTReader Text
anchorReader ODTReader Text -> (Text -> ODTReader Text) -> ODTReader Text
forall a b.
ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> (a
    -> ExceptT () (State (XMLConverterState Namespace ReaderState)) b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ODTReader Text
findAnchorName))
  ODTReader Inlines -> ODTReader Inlines -> ODTReader Inlines
forall a.
ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Inlines -> ODTReader Inlines
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
  where
    toAnchorElem :: Anchor -> Inlines
    toAnchorElem :: Text -> Inlines
toAnchorElem Text
anchorID = Attr -> Inlines -> Inlines
spanWith (Text
anchorID, [], []) Inlines
forall a. Monoid a => a
mempty
                            -- no classes, no key-value pairs

--
read_bookmark     :: InlineMatcher
read_bookmark :: InlineMatcher
read_bookmark      = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"bookmark"
                     (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ ODTReader Text -> ODTReader Inlines
maybeAddAnchorFrom (Text -> ODTReader Text
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
_ANCHOR_PREFIX_)

--
read_bookmark_start :: InlineMatcher
read_bookmark_start :: InlineMatcher
read_bookmark_start = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"bookmark-start"
                     (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ ODTReader Text -> ODTReader Inlines
maybeAddAnchorFrom (Text -> ODTReader Text
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
_ANCHOR_PREFIX_)

--
read_reference_start :: InlineMatcher
read_reference_start :: InlineMatcher
read_reference_start = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"reference-mark-start"
                     (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ ODTReader Text -> ODTReader Inlines
maybeAddAnchorFrom ODTReader Text
readAnchorAttr

-- | Beware: may fail
findAnchorRef :: ODTReader Anchor
findAnchorRef :: ODTReader Text
findAnchorRef = do
  uglyAnchor <- Namespace -> Text -> ODTReader Text
forall nsID extraState.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState Text
findAttr Namespace
NsText Text
"ref-name"
  getPrettyAnchor _ANCHOR_PREFIX_ uglyAnchor

--
maybeInAnchorRef :: Inlines -> ODTReader Inlines
maybeInAnchorRef :: Inlines -> ODTReader Inlines
maybeInAnchorRef Inlines
inlines = do
  fRef <- ODTReader Text
-> XMLConverter Namespace ReaderState (Fallible Text)
forall nsID extraState a.
XMLConverter nsID extraState a
-> XMLConverter nsID extraState (Fallible a)
tryC ODTReader Text
findAnchorRef
  case fRef of
    Right Text
anchor -> Inlines -> ODTReader Inlines
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ODTReader Inlines) -> Inlines -> ODTReader Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> Inlines
toAnchorRef Text
anchor Inlines
inlines
    Left ()
_       -> Inlines -> ODTReader Inlines
forall a.
a -> ExceptT () (State (XMLConverterState Namespace ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
inlines
  where
    toAnchorRef :: Anchor -> Inlines -> Inlines
    toAnchorRef :: Text -> Inlines -> Inlines
toAnchorRef Text
anchor = Text -> Text -> Inlines -> Inlines
link (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
anchor) Text
"" -- no title

--
read_bookmark_ref :: InlineMatcher
read_bookmark_ref :: InlineMatcher
read_bookmark_ref = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"bookmark-ref"
                    (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ [InlineMatcher]
-> (Content -> ODTReader Inlines) -> ODTReader Inlines
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [] Content -> ODTReader Inlines
read_plain_text ODTReader Inlines
-> (Inlines -> ODTReader Inlines) -> ODTReader Inlines
forall a b.
ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> (a
    -> ExceptT () (State (XMLConverterState Namespace ReaderState)) b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> ODTReader Inlines
maybeInAnchorRef

--
read_reference_ref :: InlineMatcher
read_reference_ref :: InlineMatcher
read_reference_ref = Namespace -> Text -> ODTReader Inlines -> InlineMatcher
forall e. Namespace -> Text -> ODTReader e -> Matcher e
matchingElement Namespace
NsText Text
"reference-ref"
                    (ODTReader Inlines -> InlineMatcher)
-> ODTReader Inlines -> InlineMatcher
forall a b. (a -> b) -> a -> b
$ [InlineMatcher]
-> (Content -> ODTReader Inlines) -> ODTReader Inlines
forall nsID a extraState.
(NameSpaceID nsID, Monoid a) =>
[ElementMatcher nsID extraState a]
-> (Content -> XMLConverter nsID extraState a)
-> XMLConverter nsID extraState a
matchContent [] Content -> ODTReader Inlines
read_plain_text ODTReader Inlines
-> (Inlines -> ODTReader Inlines) -> ODTReader Inlines
forall a b.
ExceptT () (State (XMLConverterState Namespace ReaderState)) a
-> (a
    -> ExceptT () (State (XMLConverterState Namespace ReaderState)) b)
-> ExceptT () (State (XMLConverterState Namespace ReaderState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inlines -> ODTReader Inlines
maybeInAnchorRef


----------------------
-- Entry point
----------------------

read_text :: ODTReader Pandoc
read_text :: ODTReader Pandoc
read_text = Blocks -> Pandoc
doc (Blocks -> Pandoc) -> ODTReader Blocks -> ODTReader Pandoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ODTReader Blocks
matchBlockContent

post_process :: Pandoc -> Pandoc
post_process :: Pandoc -> Pandoc
post_process = ([Block] -> [Block]) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk ([Block] -> [Block]
unwrapCaptions ([Block] -> [Block]) -> ([Block] -> [Block]) -> [Block] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Block]
attachCaptions)

-- | Paragraphs styled as table captions are read as a Div with class
-- @caption@ (see 'constructPara'). Attach each of them to the adjacent
-- table; ODF puts the caption either before or after its table.
attachCaptions :: [Block] -> [Block]
attachCaptions :: [Block] -> [Block]
attachCaptions (Table Attr
attr Caption
_ [ColSpec]
specs TableHead
th [TableBody]
tb TableFoot
tf : Block
b : [Block]
xs)
  | Just [Block]
blks <- Block -> Maybe [Block]
captionBlocks Block
b
  = Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr (Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing [Block]
blks) [ColSpec]
specs TableHead
th [TableBody]
tb TableFoot
tf Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
attachCaptions [Block]
xs
attachCaptions (Block
b : Table Attr
attr Caption
_ [ColSpec]
specs TableHead
th [TableBody]
tb TableFoot
tf : [Block]
xs)
  | Just [Block]
blks <- Block -> Maybe [Block]
captionBlocks Block
b
  = Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr (Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing [Block]
blks) [ColSpec]
specs TableHead
th [TableBody]
tb TableFoot
tf Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
attachCaptions [Block]
xs
attachCaptions (Block
b : [Block]
bs) = Block
b Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
attachCaptions [Block]
bs
attachCaptions []       = []

-- | The Div is only an internal marker, so a caption paragraph that
-- turned out not to belong to a table is emitted as an ordinary
-- paragraph rather than leaking the marker into the output.
unwrapCaptions :: [Block] -> [Block]
unwrapCaptions :: [Block] -> [Block]
unwrapCaptions = (Block -> [Block]) -> [Block] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Block
b -> [Block] -> Maybe [Block] -> [Block]
forall a. a -> Maybe a -> a
fromMaybe [Block
b] (Block -> Maybe [Block]
captionBlocks Block
b))

captionBlocks :: Block -> Maybe [Block]
captionBlocks :: Block -> Maybe [Block]
captionBlocks (Div (Text
"", [Text
"caption"], [(Text, Text)]
_) [Block]
blks) = [Block] -> Maybe [Block]
forall a. a -> Maybe a
Just [Block]
blks
captionBlocks Block
_                               = Maybe [Block]
forall a. Maybe a
Nothing

read_body :: ODTReader (Pandoc, MediaBag)
read_body :: ODTReader (Pandoc, MediaBag)
read_body = Namespace
-> Text
-> ODTReader (Pandoc, MediaBag)
-> ODTReader (Pandoc, MediaBag)
forall nsID extraState a.
NameSpaceID nsID =>
nsID
-> Text
-> XMLConverter nsID extraState a
-> XMLConverter nsID extraState a
executeInSub Namespace
NsOffice Text
"body"
          (ODTReader (Pandoc, MediaBag) -> ODTReader (Pandoc, MediaBag))
-> ODTReader (Pandoc, MediaBag) -> ODTReader (Pandoc, MediaBag)
forall a b. (a -> b) -> a -> b
$ Namespace
-> Text
-> ODTReader (Pandoc, MediaBag)
-> ODTReader (Pandoc, MediaBag)
forall nsID extraState a.
NameSpaceID nsID =>
nsID
-> Text
-> XMLConverter nsID extraState a
-> XMLConverter nsID extraState a
executeInSub Namespace
NsOffice Text
"text"
          (ODTReader (Pandoc, MediaBag) -> ODTReader (Pandoc, MediaBag))
-> ODTReader (Pandoc, MediaBag) -> ODTReader (Pandoc, MediaBag)
forall a b. (a -> b) -> a -> b
$ do
             txt   <- ODTReader Pandoc
read_text
             state <- getExtraState
             return (post_process txt, getMediaBag state)