{-# LANGUAGE Arrows            #-}
{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# 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 hiding (liftA, liftA2, liftA3)
import Control.Arrow
import Control.Monad ((<=<))

import qualified Data.ByteString.Lazy as B
import Data.Foldable (fold)
import Data.List (find)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Maybe
import Data.Semigroup (First(..), Option(..))

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

import Text.Pandoc.Builder hiding (underline)
import Text.Pandoc.MediaBag (MediaBag, insertMedia)
import Text.Pandoc.Shared
import Text.Pandoc.Extensions (extensionsFromList, Extension(..))
import qualified Text.Pandoc.UTF8 as UTF8

import Text.Pandoc.Readers.Odt.Base
import Text.Pandoc.Readers.Odt.Namespaces
import Text.Pandoc.Readers.Odt.StyleReader

import Text.Pandoc.Readers.Odt.Arrows.State (foldS)
import Text.Pandoc.Readers.Odt.Arrows.Utils
import Text.Pandoc.Readers.Odt.Generic.Fallible
import Text.Pandoc.Readers.Odt.Generic.Utils
import Text.Pandoc.Readers.Odt.Generic.XMLConverter

import qualified Data.Set as Set

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

type Anchor = T.Text
type Media = [(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 -> ListLevel
currentListLevel :: ListLevel
                   -- | 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
                   -- | A map from internal anchor names to "pretty" ones.
                   -- The mapping is a purely cosmetic one.
                 , ReaderState -> Map Anchor Anchor
bookmarkAnchors  :: M.Map Anchor 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 ( ListLevel -> ReaderState -> ShowS
[ReaderState] -> ShowS
ReaderState -> String
(ListLevel -> ReaderState -> ShowS)
-> (ReaderState -> String)
-> ([ReaderState] -> ShowS)
-> Show ReaderState
forall a.
(ListLevel -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReaderState] -> ShowS
$cshowList :: [ReaderState] -> ShowS
show :: ReaderState -> String
$cshow :: ReaderState -> String
showsPrec :: ListLevel -> ReaderState -> ShowS
$cshowsPrec :: ListLevel -> ReaderState -> ShowS
Show )

readerState :: Styles -> Media -> ReaderState
readerState :: Styles -> Media -> ReaderState
readerState Styles
styles Media
media = Styles
-> [Style]
-> ListLevel
-> Maybe ListStyle
-> Map Anchor Anchor
-> Media
-> MediaBag
-> ReaderState
ReaderState Styles
styles [] ListLevel
0 Maybe ListStyle
forall a. Maybe a
Nothing Map Anchor Anchor
forall k a. Map k a
M.empty Media
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 = Style
style Style -> [Style] -> [Style]
forall a. a -> [a] -> [a]
: ReaderState -> [Style]
styleTrace ReaderState
state }

--
popStyle'   :: ReaderState -> ReaderState
popStyle' :: ReaderState -> ReaderState
popStyle' ReaderState
state = case ReaderState -> [Style]
styleTrace ReaderState
state of
                   Style
_:[Style]
trace -> ReaderState
state  { styleTrace :: [Style]
styleTrace = [Style]
trace  }
                   [Style]
_       -> ReaderState
state

--
modifyListLevel :: (ListLevel -> ListLevel) -> (ReaderState -> ReaderState)
modifyListLevel :: (ListLevel -> ListLevel) -> ReaderState -> ReaderState
modifyListLevel ListLevel -> ListLevel
f ReaderState
state = ReaderState
state { currentListLevel :: ListLevel
currentListLevel = ListLevel -> ListLevel
f (ReaderState -> ListLevel
currentListLevel ReaderState
state) }

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

--
swapCurrentListStyle :: Maybe ListStyle -> ReaderState
                     -> (ReaderState, Maybe ListStyle)
swapCurrentListStyle :: Maybe ListStyle -> ReaderState -> (ReaderState, Maybe ListStyle)
swapCurrentListStyle Maybe ListStyle
mListStyle ReaderState
state = ( ReaderState
state { currentListStyle :: Maybe ListStyle
currentListStyle = Maybe ListStyle
mListStyle }
                                        ,  ReaderState -> Maybe ListStyle
currentListStyle ReaderState
state
                                        )

--
lookupPrettyAnchor :: Anchor -> ReaderState -> Maybe Anchor
lookupPrettyAnchor :: Anchor -> ReaderState -> Maybe Anchor
lookupPrettyAnchor Anchor
anchor ReaderState{ListLevel
Media
[Style]
Maybe ListStyle
Map Anchor Anchor
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Anchor Anchor
currentListStyle :: Maybe ListStyle
currentListLevel :: ListLevel
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Anchor Anchor
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> ListLevel
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..} = Anchor -> Map Anchor Anchor -> Maybe Anchor
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Anchor
anchor Map Anchor Anchor
bookmarkAnchors

--
putPrettyAnchor :: Anchor -> Anchor -> ReaderState -> ReaderState
putPrettyAnchor :: Anchor -> Anchor -> ReaderState -> ReaderState
putPrettyAnchor Anchor
ugly Anchor
pretty state :: ReaderState
state@ReaderState{ListLevel
Media
[Style]
Maybe ListStyle
Map Anchor Anchor
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Anchor Anchor
currentListStyle :: Maybe ListStyle
currentListLevel :: ListLevel
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Anchor Anchor
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> ListLevel
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..}
  = ReaderState
state { bookmarkAnchors :: Map Anchor Anchor
bookmarkAnchors = Anchor -> Anchor -> Map Anchor Anchor -> Map Anchor Anchor
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Anchor
ugly Anchor
pretty Map Anchor Anchor
bookmarkAnchors }

--
usedAnchors :: ReaderState -> [Anchor]
usedAnchors :: ReaderState -> [Anchor]
usedAnchors ReaderState{ListLevel
Media
[Style]
Maybe ListStyle
Map Anchor Anchor
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Anchor Anchor
currentListStyle :: Maybe ListStyle
currentListLevel :: ListLevel
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Anchor Anchor
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> ListLevel
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..} = Map Anchor Anchor -> [Anchor]
forall k a. Map k a -> [a]
M.elems Map Anchor Anchor
bookmarkAnchors

getMediaBag :: ReaderState -> MediaBag
getMediaBag :: ReaderState -> MediaBag
getMediaBag ReaderState{ListLevel
Media
[Style]
Maybe ListStyle
Map Anchor Anchor
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Anchor Anchor
currentListStyle :: Maybe ListStyle
currentListLevel :: ListLevel
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Anchor Anchor
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> ListLevel
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..} = MediaBag
odtMediaBag

getMediaEnv :: ReaderState -> Media
getMediaEnv :: ReaderState -> Media
getMediaEnv ReaderState{ListLevel
Media
[Style]
Maybe ListStyle
Map Anchor Anchor
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Anchor Anchor
currentListStyle :: Maybe ListStyle
currentListLevel :: ListLevel
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Anchor Anchor
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> ListLevel
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..} = Media
envMedia

insertMedia' :: (FilePath, B.ByteString) -> ReaderState ->  ReaderState
insertMedia' :: (String, ByteString) -> ReaderState -> ReaderState
insertMedia' (String
fp, ByteString
bs) state :: ReaderState
state@ReaderState{ListLevel
Media
[Style]
Maybe ListStyle
Map Anchor Anchor
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Anchor Anchor
currentListStyle :: Maybe ListStyle
currentListLevel :: ListLevel
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Anchor Anchor
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> ListLevel
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..}
  = ReaderState
state { odtMediaBag :: MediaBag
odtMediaBag = String -> Maybe Anchor -> ByteString -> MediaBag -> MediaBag
insertMedia String
fp Maybe Anchor
forall a. Maybe a
Nothing ByteString
bs MediaBag
odtMediaBag }

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

type OdtReader      a b = XMLReader     ReaderState a b

type OdtReaderSafe  a b = XMLReaderSafe ReaderState a b

-- | Extract something from the styles
fromStyles :: (a -> Styles -> b) -> OdtReaderSafe a b
fromStyles :: (a -> Styles -> b) -> OdtReaderSafe a b
fromStyles a -> Styles -> b
f =     ArrowState (XMLConverterState Namespace ReaderState) a Styles
-> ArrowState
     (XMLConverterState Namespace ReaderState) a (a, Styles)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue
                     (XMLConverter Namespace ReaderState a ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState XMLConverter Namespace ReaderState a ReaderState
-> (ReaderState -> Styles)
-> ArrowState (XMLConverterState Namespace ReaderState) a Styles
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ReaderState -> Styles
styleSet)
               ArrowState (XMLConverterState Namespace ReaderState) a (a, Styles)
-> (a -> Styles -> b) -> OdtReaderSafe a b
forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% a -> Styles -> b
f

--
getStyleByName :: OdtReader StyleName Style
getStyleByName :: OdtReader Anchor Style
getStyleByName = (Anchor -> Styles -> Maybe Style)
-> OdtReaderSafe Anchor (Maybe Style)
forall a b. (a -> Styles -> b) -> OdtReaderSafe a b
fromStyles Anchor -> Styles -> Maybe Style
lookupStyle OdtReaderSafe Anchor (Maybe Style)
-> (Maybe Style -> Fallible Style) -> OdtReader Anchor Style
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ Maybe Style -> Fallible Style
forall (a :: * -> * -> *) b.
ArrowChoice a =>
a (Maybe b) (Fallible b)
maybeToChoice

--
findStyleFamily :: OdtReader Style StyleFamily
findStyleFamily :: OdtReader Style StyleFamily
findStyleFamily = (Style -> Styles -> Maybe StyleFamily)
-> OdtReaderSafe Style (Maybe StyleFamily)
forall a b. (a -> Styles -> b) -> OdtReaderSafe a b
fromStyles Style -> Styles -> Maybe StyleFamily
getStyleFamily OdtReaderSafe Style (Maybe StyleFamily)
-> (Maybe StyleFamily -> Fallible StyleFamily)
-> OdtReader Style StyleFamily
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ Maybe StyleFamily -> Fallible StyleFamily
forall (a :: * -> * -> *) b.
ArrowChoice a =>
a (Maybe b) (Fallible b)
maybeToChoice

--
lookupListStyle :: OdtReader StyleName ListStyle
lookupListStyle :: OdtReader Anchor ListStyle
lookupListStyle = (Anchor -> Styles -> Maybe ListStyle)
-> OdtReaderSafe Anchor (Maybe ListStyle)
forall a b. (a -> Styles -> b) -> OdtReaderSafe a b
fromStyles Anchor -> Styles -> Maybe ListStyle
lookupListStyleByName OdtReaderSafe Anchor (Maybe ListStyle)
-> (Maybe ListStyle -> Fallible ListStyle)
-> OdtReader Anchor ListStyle
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ Maybe ListStyle -> Fallible ListStyle
forall (a :: * -> * -> *) b.
ArrowChoice a =>
a (Maybe b) (Fallible b)
maybeToChoice

--
switchCurrentListStyle :: OdtReaderSafe (Maybe ListStyle) (Maybe ListStyle)
switchCurrentListStyle :: OdtReaderSafe (Maybe ListStyle) (Maybe ListStyle)
switchCurrentListStyle =     ArrowState
  (XMLConverterState Namespace ReaderState)
  (Maybe ListStyle)
  ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Maybe ListStyle)
     (Maybe ListStyle, ReaderState)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue ArrowState
  (XMLConverterState Namespace ReaderState)
  (Maybe ListStyle)
  ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState
                         ArrowState
  (XMLConverterState Namespace ReaderState)
  (Maybe ListStyle)
  (Maybe ListStyle, ReaderState)
-> (Maybe ListStyle
    -> ReaderState -> (ReaderState, Maybe ListStyle))
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Maybe ListStyle)
     (ReaderState, Maybe ListStyle)
forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% Maybe ListStyle -> ReaderState -> (ReaderState, Maybe ListStyle)
swapCurrentListStyle
                         ArrowState
  (XMLConverterState Namespace ReaderState)
  (Maybe ListStyle)
  (ReaderState, Maybe ListStyle)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (ReaderState, Maybe ListStyle)
     (Maybe ListStyle)
-> OdtReaderSafe (Maybe ListStyle) (Maybe ListStyle)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ArrowState
  (XMLConverterState Namespace ReaderState) ReaderState ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (ReaderState, Maybe ListStyle)
     (ReaderState, Maybe ListStyle)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ArrowState
  (XMLConverterState Namespace ReaderState) ReaderState ReaderState
forall nsID extraState.
XMLConverter nsID extraState extraState extraState
setExtraState
                         ArrowState
  (XMLConverterState Namespace ReaderState)
  (ReaderState, Maybe ListStyle)
  (ReaderState, Maybe ListStyle)
-> ((ReaderState, Maybe ListStyle) -> Maybe ListStyle)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (ReaderState, Maybe ListStyle)
     (Maybe ListStyle)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (ReaderState, Maybe ListStyle) -> Maybe ListStyle
forall a b. (a, b) -> b
snd

--
pushStyle :: OdtReaderSafe Style Style
pushStyle :: OdtReaderSafe Style Style
pushStyle =     ArrowState
  (XMLConverterState Namespace ReaderState) Style ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Style
     (Style, ReaderState)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue (
                  (     ArrowState
  (XMLConverterState Namespace ReaderState) Style ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Style
     (Style, ReaderState)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue ArrowState
  (XMLConverterState Namespace ReaderState) Style ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState
                    ArrowState
  (XMLConverterState Namespace ReaderState)
  Style
  (Style, ReaderState)
-> (Style -> ReaderState -> ReaderState)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Style ReaderState
forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% Style -> ReaderState -> ReaderState
pushStyle'
                  )
                  ArrowState
  (XMLConverterState Namespace ReaderState) Style ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState) ReaderState ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState) Style ReaderState
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ArrowState
  (XMLConverterState Namespace ReaderState) ReaderState ReaderState
forall nsID extraState.
XMLConverter nsID extraState extraState extraState
setExtraState
                )
            ArrowState
  (XMLConverterState Namespace ReaderState)
  Style
  (Style, ReaderState)
-> ((Style, ReaderState) -> Style) -> OdtReaderSafe Style Style
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (Style, ReaderState) -> Style
forall a b. (a, b) -> a
fst

--
popStyle :: OdtReaderSafe x x
popStyle :: OdtReaderSafe x x
popStyle =     ArrowState (XMLConverterState Namespace ReaderState) x ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState) x (x, ReaderState)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue (
                     ArrowState (XMLConverterState Namespace ReaderState) x ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState
                 ArrowState (XMLConverterState Namespace ReaderState) x ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState) ReaderState ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState) x ReaderState
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (ReaderState -> ReaderState)
-> ArrowState
     (XMLConverterState Namespace ReaderState) ReaderState ReaderState
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ReaderState -> ReaderState
popStyle'
                 ArrowState
  (XMLConverterState Namespace ReaderState) ReaderState ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState) ReaderState ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState) ReaderState ReaderState
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ArrowState
  (XMLConverterState Namespace ReaderState) ReaderState ReaderState
forall nsID extraState.
XMLConverter nsID extraState extraState extraState
setExtraState
               )
           ArrowState
  (XMLConverterState Namespace ReaderState) x (x, ReaderState)
-> ((x, ReaderState) -> x) -> OdtReaderSafe x x
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (x, ReaderState) -> x
forall a b. (a, b) -> a
fst

--
getCurrentListLevel :: OdtReaderSafe _x ListLevel
getCurrentListLevel :: OdtReaderSafe _x ListLevel
getCurrentListLevel = XMLConverter Namespace ReaderState _x ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState XMLConverter Namespace ReaderState _x ReaderState
-> (ReaderState -> ListLevel) -> OdtReaderSafe _x ListLevel
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ReaderState -> ListLevel
currentListLevel

--
updateMediaWithResource :: OdtReaderSafe (FilePath, B.ByteString) (FilePath, B.ByteString)
updateMediaWithResource :: OdtReaderSafe (String, ByteString) (String, ByteString)
updateMediaWithResource = ArrowState
  (XMLConverterState Namespace ReaderState)
  (String, ByteString)
  ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (String, ByteString)
     ((String, ByteString), ReaderState)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue (
                 (ArrowState
  (XMLConverterState Namespace ReaderState)
  (String, ByteString)
  ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (String, ByteString)
     ((String, ByteString), ReaderState)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue ArrowState
  (XMLConverterState Namespace ReaderState)
  (String, ByteString)
  ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState
                  ArrowState
  (XMLConverterState Namespace ReaderState)
  (String, ByteString)
  ((String, ByteString), ReaderState)
-> ((String, ByteString) -> ReaderState -> ReaderState)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (String, ByteString)
     ReaderState
forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% (String, ByteString) -> ReaderState -> ReaderState
insertMedia'
                  )
                 ArrowState
  (XMLConverterState Namespace ReaderState)
  (String, ByteString)
  ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState) ReaderState ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (String, ByteString)
     ReaderState
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ArrowState
  (XMLConverterState Namespace ReaderState) ReaderState ReaderState
forall nsID extraState.
XMLConverter nsID extraState extraState extraState
setExtraState
               )
           ArrowState
  (XMLConverterState Namespace ReaderState)
  (String, ByteString)
  ((String, ByteString), ReaderState)
-> (((String, ByteString), ReaderState) -> (String, ByteString))
-> OdtReaderSafe (String, ByteString) (String, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ((String, ByteString), ReaderState) -> (String, ByteString)
forall a b. (a, b) -> a
fst

lookupResource :: OdtReaderSafe FilePath (FilePath, B.ByteString)
lookupResource :: OdtReaderSafe String (String, ByteString)
lookupResource = proc String
target -> do
    ReaderState
state <- XMLConverter Namespace ReaderState () ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState -< ()
    case String -> Media -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
target (ReaderState -> Media
getMediaEnv ReaderState
state) of
      Just ByteString
bs -> (String, ByteString)
-> ArrowState
     (XMLConverterState Namespace ReaderState) () (String, ByteString)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV (String
target, ByteString
bs) -<< ()
      Maybe ByteString
Nothing -> (String, ByteString)
-> ArrowState
     (XMLConverterState Namespace ReaderState) () (String, ByteString)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV (String
"", ByteString
B.empty) -< ()

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 -> [Anchor] -> Anchor
uniqueIdentFrom :: Anchor -> [Anchor] -> Anchor
uniqueIdentFrom Anchor
baseIdent [Anchor]
usedIdents =
  let  numIdent :: a -> Anchor
numIdent a
n = Anchor
baseIdent Anchor -> Anchor -> Anchor
forall a. Semigroup a => a -> a -> a
<> Anchor
"-" Anchor -> Anchor -> Anchor
forall a. Semigroup a => a -> a -> a
<> String -> Anchor
T.pack (a -> String
forall a. Show a => a -> String
show a
n)
  in  if Anchor
baseIdent Anchor -> [Anchor] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Anchor]
usedIdents
        then Anchor -> (ListLevel -> Anchor) -> Maybe ListLevel -> Anchor
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Anchor
baseIdent ListLevel -> Anchor
forall a. Show a => a -> Anchor
numIdent
             (Maybe ListLevel -> Anchor) -> Maybe ListLevel -> Anchor
forall a b. (a -> b) -> a -> b
$ (ListLevel -> Bool) -> [ListLevel] -> Maybe ListLevel
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ListLevel
x -> ListLevel -> Anchor
forall a. Show a => a -> Anchor
numIdent ListLevel
x Anchor -> [Anchor] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Anchor]
usedIdents) ([ListLevel
1..ListLevel
60000] :: [Int])
               -- if we have more than 60,000, allow repeats
        else Anchor
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 :: OdtReaderSafe (AnchorPrefix, Anchor) Anchor
getPrettyAnchor :: OdtReaderSafe (Anchor, Anchor) Anchor
getPrettyAnchor = proc (Anchor
baseIdent, Anchor
uglyAnchor) -> do
  ReaderState
state <- XMLConverter Namespace ReaderState () ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState -< ()
  case Anchor -> ReaderState -> Maybe Anchor
lookupPrettyAnchor Anchor
uglyAnchor ReaderState
state of
    Just Anchor
prettyAnchor -> ArrowState (XMLConverterState Namespace ReaderState) Anchor Anchor
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Anchor
prettyAnchor
    Maybe Anchor
Nothing           -> do
      let newPretty :: Anchor
newPretty = Anchor -> [Anchor] -> Anchor
uniqueIdentFrom Anchor
baseIdent (ReaderState -> [Anchor]
usedAnchors ReaderState
state)
      (ReaderState -> ReaderState)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Anchor Anchor
forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (Anchor -> Anchor -> ReaderState -> ReaderState
putPrettyAnchor Anchor
uglyAnchor Anchor
newPretty) -<< Anchor
newPretty

-- | Input: basis for a new header anchor
-- Output: saved new anchor
getHeaderAnchor :: OdtReaderSafe Inlines Anchor
getHeaderAnchor :: OdtReaderSafe Inlines Anchor
getHeaderAnchor = proc Inlines
title -> do
  ReaderState
state <- XMLConverter Namespace ReaderState () ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState -< ()
  let exts :: Extensions
exts = [Extension] -> Extensions
extensionsFromList [Extension
Ext_auto_identifiers]
  let anchor :: Anchor
anchor = Extensions -> [Inline] -> Set Anchor -> Anchor
uniqueIdent Extensions
exts (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
title)
                ([Anchor] -> Set Anchor
forall a. Ord a => [a] -> Set a
Set.fromList ([Anchor] -> Set Anchor) -> [Anchor] -> Set Anchor
forall a b. (a -> b) -> a -> b
$ ReaderState -> [Anchor]
usedAnchors ReaderState
state)
  (ReaderState -> ReaderState)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Anchor Anchor
forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (Anchor -> Anchor -> ReaderState -> ReaderState
putPrettyAnchor Anchor
anchor Anchor
anchor) -<< Anchor
anchor


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

--
readStyleByName :: OdtReader _x (StyleName, Style)
readStyleByName :: OdtReader _x (Anchor, Style)
readStyleByName =
  Namespace
-> Anchor -> FallibleXMLConverter Namespace ReaderState _x Anchor
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> FallibleXMLConverter nsID extraState x Anchor
findAttr Namespace
NsText Anchor
"style-name" FallibleXMLConverter Namespace ReaderState _x Anchor
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     Anchor
     ()
     (Anchor, Style)
-> OdtReader _x (Anchor, Style)
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> FallibleArrow a success failure success'
-> FallibleArrow a x failure success'
>>? OdtReader Anchor Style
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Anchor
     (Anchor, Fallible Style)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue OdtReader Anchor Style
getStyleByName ArrowState
  (XMLConverterState Namespace ReaderState)
  Anchor
  (Anchor, Fallible Style)
-> ((Anchor, Fallible Style) -> Fallible (Anchor, Style))
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     Anchor
     ()
     (Anchor, Style)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (Anchor, Fallible Style) -> Fallible (Anchor, Style)
liftE
  where
    liftE :: (StyleName, Fallible Style) -> Fallible (StyleName, Style)
    liftE :: (Anchor, Fallible Style) -> Fallible (Anchor, Style)
liftE (Anchor
name, Right Style
v) = (Anchor, Style) -> Fallible (Anchor, Style)
forall a b. b -> Either a b
Right (Anchor
name, Style
v)
    liftE (Anchor
_, Left ()
v)     = () -> Fallible (Anchor, Style)
forall a b. a -> Either a b
Left ()
v

--
isStyleToTrace :: OdtReader Style Bool
isStyleToTrace :: OdtReader Style Bool
isStyleToTrace = OdtReader Style StyleFamily
findStyleFamily OdtReader Style StyleFamily
-> (StyleFamily -> Bool) -> OdtReader Style Bool
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> (success -> success') -> FallibleArrow a x failure success'
>>?^ (StyleFamily -> StyleFamily -> Bool
forall a. Eq a => a -> a -> Bool
==StyleFamily
FaText)

--
withNewStyle :: OdtReaderSafe x Inlines -> OdtReaderSafe x Inlines
withNewStyle :: OdtReaderSafe x Inlines -> OdtReaderSafe x Inlines
withNewStyle OdtReaderSafe x Inlines
a = proc x
x -> do
  Fallible (Anchor, Style)
fStyle <- OdtReader () (Anchor, Style)
forall _x. OdtReader _x (Anchor, Style)
readStyleByName -< ()
  case Fallible (Anchor, Style)
fStyle of
    Right (Anchor
styleName, Style
_) | Anchor -> Bool
isCodeStyle Anchor
styleName -> do
      Inlines
inlines <- OdtReaderSafe x Inlines
a -< x
x
      (Inlines -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Inlines -> Inlines
inlineCode -<< Inlines
inlines
    Right (Anchor
_, Style
style) -> do
      Maybe StyleFamily
mFamily    <- (Style -> Maybe StyleFamily)
-> OdtReaderSafe Style (Maybe StyleFamily)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Style -> Maybe StyleFamily
styleFamily -< Style
style
      Either () TextProperties
fTextProps <- (Style -> Either () TextProperties)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Style
     (Either () TextProperties)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ( Maybe TextProperties -> Either () TextProperties
forall (a :: * -> * -> *) b.
ArrowChoice a =>
a (Maybe b) (Fallible b)
maybeToChoice
                        (Maybe TextProperties -> Either () TextProperties)
-> (Style -> Maybe TextProperties)
-> Style
-> Either () TextProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleProperties -> Maybe TextProperties
textProperties
                        (StyleProperties -> Maybe TextProperties)
-> (Style -> StyleProperties) -> Style -> Maybe TextProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> StyleProperties
styleProperties
                        )           -< Style
style
      case Either () TextProperties
fTextProps of
        Right TextProperties
textProps -> do
          ReaderState
state        <- XMLConverter Namespace ReaderState () ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState             -< ()
          let triple :: (ReaderState, TextProperties, Maybe StyleFamily)
triple = (ReaderState
state, TextProperties
textProps, Maybe StyleFamily
mFamily)
          Inlines -> Inlines
modifier     <- ((ReaderState, TextProperties, Maybe StyleFamily)
 -> Inlines -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (ReaderState, TextProperties, Maybe StyleFamily)
     (Inlines -> Inlines)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (ReaderState, TextProperties, Maybe StyleFamily)
-> Inlines -> Inlines
modifierFromStyleDiff -< (ReaderState, TextProperties, Maybe StyleFamily)
triple
          Fallible Bool
fShouldTrace <- OdtReader Style Bool
isStyleToTrace            -< Style
style
          case Fallible Bool
fShouldTrace of
            Right Bool
shouldTrace ->
              if Bool
shouldTrace
                then do
                  OdtReaderSafe Style Style
pushStyle      -< Style
style
                  Inlines
inlines   <- OdtReaderSafe x Inlines
a -< x
x
                  OdtReaderSafe () ()
forall x. OdtReaderSafe x x
popStyle       -< ()
                  (Inlines -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Inlines -> Inlines
modifier   -<< Inlines
inlines
                else
    -- In case anything goes wrong
                      OdtReaderSafe x Inlines
a -< x
x
            Left ()
_ -> OdtReaderSafe x Inlines
a -< x
x
        Left ()
_     -> OdtReaderSafe x Inlines
a -< x
x
    Left ()
_         -> OdtReaderSafe x Inlines
a -< x
x
  where
    isCodeStyle :: StyleName -> Bool
    isCodeStyle :: Anchor -> Bool
isCodeStyle Anchor
"Source_Text" = Bool
True
    isCodeStyle Anchor
_             = Bool
False

    inlineCode :: Inlines -> Inlines
    inlineCode :: Inlines -> Inlines
inlineCode = Anchor -> Inlines
code (Anchor -> Inlines) -> (Inlines -> Anchor) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Anchor] -> Anchor
T.concat ([Anchor] -> Anchor) -> (Inlines -> [Anchor]) -> Inlines -> Anchor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Anchor) -> [Inline] -> [Anchor]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Anchor
forall a. Walkable Inline a => a -> Anchor
stringify ([Inline] -> [Anchor])
-> (Inlines -> [Inline]) -> Inlines -> [Anchor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
toList

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 :: (ReaderState, TextProperties, Maybe StyleFamily)
-> Inlines -> Inlines
modifierFromStyleDiff (ReaderState, TextProperties, Maybe StyleFamily)
propertyTriple  =
  [Inlines -> Inlines] -> Inlines -> Inlines
forall (cat :: * -> * -> *) (f :: * -> *) a.
(Category cat, Foldable f) =>
f (cat a a) -> cat a a
composition ([Inlines -> Inlines] -> Inlines -> Inlines)
-> [Inlines -> Inlines] -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$
  (ReaderState, TextProperties, Maybe StyleFamily)
-> Inlines -> Inlines
getVPosModifier (ReaderState, TextProperties, Maybe StyleFamily)
propertyTriple
  (Inlines -> Inlines)
-> [Inlines -> Inlines] -> [Inlines -> Inlines]
forall a. a -> [a] -> [a]
: (((ReaderState, TextProperties, Maybe StyleFamily) -> Bool,
  Inlines -> Inlines)
 -> Inlines -> Inlines)
-> [((ReaderState, TextProperties, Maybe StyleFamily) -> Bool,
     Inlines -> Inlines)]
-> [Inlines -> Inlines]
forall a b. (a -> b) -> [a] -> [b]
map ((((ReaderState, TextProperties, Maybe StyleFamily) -> Bool)
 -> Bool)
-> ((ReaderState, TextProperties, Maybe StyleFamily) -> Bool,
    Inlines -> Inlines)
-> (Bool, Inlines -> Inlines)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (((ReaderState, TextProperties, Maybe StyleFamily) -> Bool)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall a b. (a -> b) -> a -> b
$ (ReaderState, TextProperties, Maybe StyleFamily)
propertyTriple) (((ReaderState, TextProperties, Maybe StyleFamily) -> Bool,
  Inlines -> Inlines)
 -> (Bool, Inlines -> Inlines))
-> ((Bool, Inlines -> Inlines) -> Inlines -> Inlines)
-> ((ReaderState, TextProperties, Maybe StyleFamily) -> Bool,
    Inlines -> Inlines)
-> Inlines
-> Inlines
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Inlines -> Inlines)
-> (Bool, Inlines -> Inlines) -> Inlines -> Inlines
forall p. p -> (Bool, p) -> p
ifThen_else Inlines -> Inlines
ignore)
        [ ((ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasEmphChanged           , Inlines -> Inlines
emph      )
        , ((TextProperties -> Bool)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall b.
Eq b =>
(TextProperties -> b)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged TextProperties -> Bool
isStrong      , Inlines -> Inlines
strong    )
        , ((TextProperties -> Maybe UnderlineMode)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall b.
Eq b =>
(TextProperties -> b)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged TextProperties -> Maybe UnderlineMode
strikethrough , Inlines -> Inlines
strikeout )
        ]
  where
    ifThen_else :: p -> (Bool, p) -> p
ifThen_else p
else' (Bool
if',p
then') = if Bool
if' then p
then' else p
else'

    ignore :: Inlines -> Inlines
ignore = Inlines -> Inlines
forall a. a -> a
id :: InlineModifier

    getVPosModifier :: PropertyTriple -> InlineModifier
    getVPosModifier :: (ReaderState, TextProperties, Maybe StyleFamily)
-> Inlines -> Inlines
getVPosModifier triple :: (ReaderState, TextProperties, Maybe StyleFamily)
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)
-> (ReaderState, TextProperties, Maybe StyleFamily)
-> Maybe VerticalTextPosition
forall b b.
(TextProperties -> Maybe b)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe b
lookupPreviousValueM TextProperties -> Maybe VerticalTextPosition
getVPos (ReaderState, TextProperties, Maybe StyleFamily)
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 :: (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasEmphChanged = ((((ReaderState, TextProperties, Maybe StyleFamily) -> Bool)
  -> Bool)
 -> [(ReaderState, TextProperties, Maybe StyleFamily) -> Bool]
 -> Bool)
-> [(ReaderState, TextProperties, Maybe StyleFamily) -> Bool]
-> (ReaderState, TextProperties, Maybe StyleFamily)
-> Bool
forall a b c d. (((a -> b) -> b) -> c -> d) -> c -> a -> d
swing (((ReaderState, TextProperties, Maybe StyleFamily) -> Bool)
 -> Bool)
-> [(ReaderState, TextProperties, Maybe StyleFamily) -> Bool]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [ (TextProperties -> Bool)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall b.
Eq b =>
(TextProperties -> b)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged  TextProperties -> Bool
isEmphasised
                               , (TextProperties -> Maybe FontPitch)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall b.
Eq b =>
(TextProperties -> Maybe b)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChangedM TextProperties -> Maybe FontPitch
pitch
                               , (TextProperties -> Maybe UnderlineMode)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall b.
Eq b =>
(TextProperties -> b)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged  TextProperties -> Maybe UnderlineMode
underline
                               ]

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

    hasChangedM :: (TextProperties -> Maybe b)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChangedM TextProperties -> Maybe b
property triple :: (ReaderState, TextProperties, Maybe StyleFamily)
triple@(ReaderState
_, TextProperties
textProps,Maybe StyleFamily
_) =
      Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (b -> b -> Bool) -> Maybe b -> Maybe (b -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextProperties -> Maybe b
property TextProperties
textProps Maybe (b -> Bool) -> Maybe b -> Maybe Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TextProperties -> Maybe b)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Maybe b
forall b b.
(TextProperties -> Maybe b)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe b
lookupPreviousValueM TextProperties -> Maybe b
property (ReaderState, TextProperties, Maybe StyleFamily)
triple

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

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

    lookupPreviousStyleValue :: (StyleProperties -> Maybe b)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe b
lookupPreviousStyleValue StyleProperties -> Maybe b
f (ReaderState{ListLevel
Media
[Style]
Maybe ListStyle
Map Anchor Anchor
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Anchor Anchor
currentListStyle :: Maybe ListStyle
currentListLevel :: ListLevel
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Anchor Anchor
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> ListLevel
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..},b
_,Maybe StyleFamily
mFamily)
      =     (StyleProperties -> Maybe b) -> [StyleProperties] -> Maybe b
forall a b. (a -> Maybe b) -> [a] -> Maybe b
findBy StyleProperties -> Maybe b
f ([Style] -> Styles -> [StyleProperties]
extendedStylePropertyChain [Style]
styleTrace Styles
styleSet)
        Maybe b -> Maybe b -> Maybe b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StyleProperties -> Maybe b
f (StyleProperties -> Maybe b)
-> (StyleFamily -> StyleProperties) -> StyleFamily -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Styles -> StyleFamily -> StyleProperties
lookupDefaultStyle' Styles
styleSet (StyleFamily -> Maybe b) -> Maybe StyleFamily -> Maybe b
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_ :: ListLevel
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_      = ListLevel
5
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_ :: ListLevel
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_ = ListLevel
5

-- | Returns either 'id' or 'blockQuote' depending on the current indentation
getParaModifier :: Style -> ParaModifier
getParaModifier :: Style -> ParaModifier
getParaModifier Style{Maybe Anchor
Maybe StyleFamily
StyleProperties
listStyle :: Style -> Maybe Anchor
styleParentName :: Style -> Maybe Anchor
styleProperties :: StyleProperties
listStyle :: Maybe Anchor
styleParentName :: Maybe Anchor
styleFamily :: Maybe StyleFamily
styleProperties :: Style -> StyleProperties
styleFamily :: Style -> Maybe StyleFamily
..} | Just ParaProperties
props <- StyleProperties -> Maybe ParaProperties
paraProperties StyleProperties
styleProperties
                          , LengthOrPercent -> LengthOrPercent -> Bool
isBlockQuote (ParaProperties -> LengthOrPercent
indentation ParaProperties
props)
                                         (ParaProperties -> LengthOrPercent
margin_left ParaProperties
props)
                          = ParaModifier
blockQuote
                          | Bool
otherwise
                          = ParaModifier
forall a. a -> a
id
  where
  isBlockQuote :: LengthOrPercent -> LengthOrPercent -> Bool
isBlockQuote LengthOrPercent
mIndent LengthOrPercent
mMargin
    | LengthValueMM ListLevel
indent <- LengthOrPercent
mIndent
    ,  ListLevel
indent          ListLevel -> ListLevel -> Bool
forall a. Ord a => a -> a -> Bool
> ListLevel
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_
     = Bool
True
    | LengthValueMM ListLevel
margin <- LengthOrPercent
mMargin
    ,           ListLevel
margin ListLevel -> ListLevel -> Bool
forall a. Ord a => a -> a -> Bool
> ListLevel
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_
     = Bool
True
    | LengthValueMM ListLevel
indent <- LengthOrPercent
mIndent
    , LengthValueMM ListLevel
margin <- LengthOrPercent
mMargin
     = ListLevel
indent ListLevel -> ListLevel -> ListLevel
forall a. Num a => a -> a -> a
+ ListLevel
margin ListLevel -> ListLevel -> Bool
forall a. Ord a => a -> a -> Bool
> ListLevel
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_

    | PercentValue  ListLevel
indent <- LengthOrPercent
mIndent
    ,  ListLevel
indent          ListLevel -> ListLevel -> Bool
forall a. Ord a => a -> a -> Bool
> ListLevel
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_
     = Bool
True
    | PercentValue  ListLevel
margin <- LengthOrPercent
mMargin
    ,           ListLevel
margin ListLevel -> ListLevel -> Bool
forall a. Ord a => a -> a -> Bool
> ListLevel
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_
     = Bool
True
    | PercentValue  ListLevel
indent <- LengthOrPercent
mIndent
    , PercentValue  ListLevel
margin <- LengthOrPercent
mMargin
     = ListLevel
indent ListLevel -> ListLevel -> ListLevel
forall a. Num a => a -> a -> a
+ ListLevel
margin ListLevel -> ListLevel -> Bool
forall a. Ord a => a -> a -> Bool
> ListLevel
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_

    | Bool
otherwise
     = Bool
False

--
constructPara :: OdtReaderSafe Blocks Blocks -> OdtReaderSafe Blocks Blocks
constructPara :: OdtReaderSafe Blocks Blocks -> OdtReaderSafe Blocks Blocks
constructPara OdtReaderSafe Blocks Blocks
reader = proc Blocks
blocks -> do
  Fallible (Anchor, Style)
fStyle <- OdtReader Blocks (Anchor, Style)
forall _x. OdtReader _x (Anchor, Style)
readStyleByName -< Blocks
blocks
  case Fallible (Anchor, Style)
fStyle of
    Left   ()
_    -> OdtReaderSafe Blocks Blocks
reader -< Blocks
blocks
    Right (Anchor
styleName, Style
_) | Anchor -> Bool
isTableCaptionStyle Anchor
styleName -> do
      Blocks
blocks' <- OdtReaderSafe Blocks Blocks
reader   -< Blocks
blocks
      ParaModifier -> OdtReaderSafe Blocks Blocks
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ParaModifier
tableCaptionP  -< Blocks
blocks'
    Right (Anchor
_, Style
style) -> do
      let modifier :: ParaModifier
modifier = Style -> ParaModifier
getParaModifier Style
style
      Blocks
blocks' <- OdtReaderSafe Blocks Blocks
reader   -<  Blocks
blocks
      ParaModifier -> OdtReaderSafe Blocks Blocks
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ParaModifier
modifier        -<< Blocks
blocks'
  where
    isTableCaptionStyle :: StyleName -> Bool
    isTableCaptionStyle :: Anchor -> Bool
isTableCaptionStyle Anchor
"Table" = Bool
True
    isTableCaptionStyle Anchor
_       = Bool
False
    tableCaptionP :: ParaModifier
tableCaptionP Blocks
b = Attr -> ParaModifier
divWith (Anchor
"", [Anchor
"caption"], []) Blocks
b

type ListConstructor = [Blocks] -> Blocks

getListConstructor :: ListLevelStyle -> ListConstructor
getListConstructor :: ListLevelStyle -> ListConstructor
getListConstructor ListLevelStyle{ListLevel
Maybe Anchor
ListItemNumberFormat
ListLevelType
listItemStart :: ListLevelStyle -> ListLevel
listItemFormat :: ListLevelStyle -> ListItemNumberFormat
listItemSuffix :: ListLevelStyle -> Maybe Anchor
listItemPrefix :: ListLevelStyle -> Maybe Anchor
listLevelType :: ListLevelStyle -> ListLevelType
listItemStart :: ListLevel
listItemFormat :: ListItemNumberFormat
listItemSuffix :: Maybe Anchor
listItemPrefix :: Maybe Anchor
listLevelType :: ListLevelType
..} =
  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 Anchor -> Maybe Anchor -> ListNumberDelim
forall a a.
(Eq a, Eq a, IsString a, IsString a) =>
Maybe a -> Maybe a -> ListNumberDelim
toListNumberDelim Maybe Anchor
listItemPrefix
                                                           Maybe Anchor
listItemSuffix
                   in  ListAttributes -> ListConstructor
orderedListWith (ListLevel
listItemStart, 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 String
_) = 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. I 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 :: OdtReaderSafe x [Blocks] -> OdtReaderSafe x Blocks
constructList :: OdtReaderSafe x [Blocks] -> OdtReaderSafe x Blocks
constructList OdtReaderSafe x [Blocks]
reader = proc x
x -> do
  (ReaderState -> ReaderState) -> OdtReaderSafe () ()
forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (ListLevel -> ReaderState -> ReaderState
shiftListLevel ListLevel
1)        -< ()
  ListLevel
listLevel  <- OdtReaderSafe () ListLevel
forall _x. OdtReaderSafe _x ListLevel
getCurrentListLevel          -< ()
  Fallible Anchor
fStyleName <- Namespace
-> Anchor -> FallibleXMLConverter Namespace ReaderState () Anchor
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> FallibleXMLConverter nsID extraState x Anchor
findAttr Namespace
NsText Anchor
"style-name" -< ()
  case Fallible Anchor
fStyleName of
    Right Anchor
styleName -> do
      Fallible ListStyle
fListStyle <- OdtReader Anchor ListStyle
lookupListStyle -< Anchor
styleName
      case Fallible ListStyle
fListStyle of
        Right ListStyle
listStyle -> do
          Maybe ListLevelStyle
fLLS <- ((ListLevel, ListStyle) -> Maybe ListLevelStyle)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (ListLevel, ListStyle)
     (Maybe ListLevelStyle)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((ListLevel -> ListStyle -> Maybe ListLevelStyle)
-> (ListLevel, ListStyle) -> Maybe ListLevelStyle
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ListLevel -> ListStyle -> Maybe ListLevelStyle
getListLevelStyle) -< (ListLevel
listLevel,ListStyle
listStyle)
          case Maybe ListLevelStyle
fLLS of
            Just ListLevelStyle
listLevelStyle -> do
              Maybe ListStyle
oldListStyle <- OdtReaderSafe (Maybe ListStyle) (Maybe ListStyle)
switchCurrentListStyle           -<  ListStyle -> Maybe ListStyle
forall a. a -> Maybe a
Just ListStyle
listStyle
              Blocks
blocks       <- ListLevelStyle -> OdtReaderSafe x Blocks
constructListWith ListLevelStyle
listLevelStyle -<< x
x
              OdtReaderSafe (Maybe ListStyle) (Maybe ListStyle)
switchCurrentListStyle                           -<  Maybe ListStyle
oldListStyle
              OdtReaderSafe Blocks Blocks
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA                                          -<  Blocks
blocks
            Maybe ListLevelStyle
Nothing             -> OdtReaderSafe x Blocks
constructOrderedList        -< x
x
        Left ()
_                  -> OdtReaderSafe x Blocks
constructOrderedList        -< x
x
    Left ()
_ -> do
      ReaderState
state      <- XMLConverter Namespace ReaderState () ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState        -< ()
      Maybe ListStyle
mListStyle <- (ReaderState -> Maybe ListStyle)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     ReaderState
     (Maybe ListStyle)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ReaderState -> Maybe ListStyle
currentListStyle -< ReaderState
state
      case Maybe ListStyle
mListStyle of
        Just ListStyle
listStyle -> do
          Maybe ListLevelStyle
fLLS <- ((ListLevel, ListStyle) -> Maybe ListLevelStyle)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (ListLevel, ListStyle)
     (Maybe ListLevelStyle)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((ListLevel -> ListStyle -> Maybe ListLevelStyle)
-> (ListLevel, ListStyle) -> Maybe ListLevelStyle
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ListLevel -> ListStyle -> Maybe ListLevelStyle
getListLevelStyle) -< (ListLevel
listLevel,ListStyle
listStyle)
          case Maybe ListLevelStyle
fLLS of
            Just ListLevelStyle
listLevelStyle -> ListLevelStyle -> OdtReaderSafe x Blocks
constructListWith ListLevelStyle
listLevelStyle -<< x
x
            Maybe ListLevelStyle
Nothing             -> OdtReaderSafe x Blocks
constructOrderedList             -<  x
x
        Maybe ListStyle
Nothing                 -> OdtReaderSafe x Blocks
constructOrderedList             -<  x
x
  where
    constructOrderedList :: OdtReaderSafe x Blocks
constructOrderedList =
          OdtReaderSafe x [Blocks]
reader
      OdtReaderSafe x [Blocks]
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
-> OdtReaderSafe x Blocks
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (ReaderState -> ReaderState)
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (ListLevel -> ReaderState -> ReaderState
shiftListLevel (-ListLevel
1))
      XMLConverter Namespace ReaderState [Blocks] [Blocks]
-> ListConstructor
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ListConstructor
orderedList
    constructListWith :: ListLevelStyle -> OdtReaderSafe x Blocks
constructListWith ListLevelStyle
listLevelStyle =
          OdtReaderSafe x [Blocks]
reader
      OdtReaderSafe x [Blocks]
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
-> OdtReaderSafe x Blocks
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ListLevelStyle -> ListConstructor
getListConstructor ListLevelStyle
listLevelStyle
      ListConstructor
-> OdtReaderSafe Blocks Blocks
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> (ReaderState -> ReaderState) -> OdtReaderSafe Blocks Blocks
forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (ListLevel -> ReaderState -> ReaderState
shiftListLevel (-ListLevel
1))

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

type ElementMatcher result = (Namespace, ElementName, OdtReader result result)

type InlineMatcher = ElementMatcher Inlines

type BlockMatcher  = ElementMatcher Blocks


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

firstMatch :: a -> FirstMatch a
firstMatch :: a -> FirstMatch a
firstMatch = Option (First a) -> FirstMatch a
forall a. Option (First a) -> FirstMatch a
FirstMatch (Option (First a) -> FirstMatch a)
-> (a -> Option (First a)) -> a -> FirstMatch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (First a) -> Option (First a)
forall a. Maybe a -> Option a
Option (Maybe (First a) -> Option (First a))
-> (a -> Maybe (First a)) -> a -> Option (First a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. First a -> Maybe (First a)
forall a. a -> Maybe a
Just (First a -> Maybe (First a))
-> (a -> First a) -> a -> Maybe (First a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> First a
forall a. a -> First a
First


--
matchingElement :: (Monoid e)
                => Namespace -> ElementName
                -> OdtReaderSafe  e e
                -> ElementMatcher e
matchingElement :: Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
ns Anchor
name OdtReaderSafe e e
reader = (Namespace
ns, Anchor
name, OdtReaderSafe e e
-> ArrowState
     (XMLConverterState Namespace ReaderState) e (Fallible e)
forall (a :: * -> * -> *) m.
(ArrowChoice a, Monoid m) =>
a m m -> a m (Fallible m)
asResultAccumulator OdtReaderSafe e e
reader)
  where
   asResultAccumulator :: (ArrowChoice a, Monoid m) => a m m -> a m (Fallible m)
   asResultAccumulator :: a m m -> a m (Fallible m)
asResultAccumulator a m m
a = a m m -> a m (Fallible m)
forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess (a m m -> a m (Fallible m)) -> a m m -> a m (Fallible m)
forall a b. (a -> b) -> a -> b
$ a m m -> a m (m, m)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue a m m
a a m (m, m) -> (m -> m -> m) -> a m m
forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% m -> m -> m
forall a. Monoid a => a -> a -> a
mappend

--
matchChildContent'   :: (Monoid result)
                     => [ElementMatcher result]
                     ->  OdtReaderSafe _x result
matchChildContent' :: [ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent' [ElementMatcher result]
ls = result -> OdtReaderSafe _x result
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV result
forall a. Monoid a => a
mempty OdtReaderSafe _x result
-> ArrowState
     (XMLConverterState Namespace ReaderState) result result
-> OdtReaderSafe _x result
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [ElementMatcher result]
-> ArrowState
     (XMLConverterState Namespace ReaderState) result result
forall nsID extraState a.
NameSpaceID nsID =>
[(nsID, Anchor, FallibleXMLConverter nsID extraState a a)]
-> XMLConverter nsID extraState a a
matchContent' [ElementMatcher result]
ls

--
matchChildContent    :: (Monoid result)
                     => [ElementMatcher result]
                     ->  OdtReaderSafe  (result, XML.Content) result
                     ->  OdtReaderSafe _x result
matchChildContent :: [ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [ElementMatcher result]
ls OdtReaderSafe (result, Content) result
fallback = result -> OdtReaderSafe _x result
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV result
forall a. Monoid a => a
mempty OdtReaderSafe _x result
-> ArrowState
     (XMLConverterState Namespace ReaderState) result result
-> OdtReaderSafe _x result
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> ArrowState
     (XMLConverterState Namespace ReaderState) result result
forall nsID extraState a.
NameSpaceID nsID =>
[(nsID, Anchor, FallibleXMLConverter nsID extraState a a)]
-> XMLConverter nsID extraState (a, Content) a
-> XMLConverter nsID extraState a a
matchContent [ElementMatcher result]
ls OdtReaderSafe (result, Content) result
fallback

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

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

--
-- | Open Document allows several consecutive spaces if they are marked up
read_plain_text :: OdtReaderSafe (Inlines, XML.Content) Inlines
read_plain_text :: OdtReaderSafe (Inlines, Content) Inlines
read_plain_text =  (Inlines, Content) -> Inlines
forall a b. (a, b) -> a
fst ((Inlines, Content) -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Inlines, Content)
     (Fallible Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Inlines, Content)
     (Inlines, Fallible Inlines)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
(b -> c) -> a b c' -> a b (c, c')
^&&& ArrowState
  (XMLConverterState Namespace ReaderState)
  (Inlines, Content)
  (Fallible Inlines)
read_plain_text' ArrowState
  (XMLConverterState Namespace ReaderState)
  (Inlines, Content)
  (Inlines, Fallible Inlines)
-> (Inlines -> Fallible Inlines -> Inlines)
-> OdtReaderSafe (Inlines, Content) Inlines
forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% Inlines -> Fallible Inlines -> Inlines
forall a _f. a -> Either _f a -> a
recover
  where
    -- fallible version
    read_plain_text' :: OdtReader (Inlines, XML.Content) Inlines
    read_plain_text' :: ArrowState
  (XMLConverterState Namespace ReaderState)
  (Inlines, Content)
  (Fallible Inlines)
read_plain_text' =      (     ArrowState
  (XMLConverterState Namespace ReaderState) Content (Fallible Anchor)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Inlines, Content)
     (Inlines, Fallible Anchor)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ( (Content -> Fallible Anchor)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Content (Fallible Anchor)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Content -> Fallible Anchor
extractText )
                              ArrowState
  (XMLConverterState Namespace ReaderState)
  (Inlines, Content)
  (Inlines, Fallible Anchor)
-> ((Inlines, Fallible Anchor) -> Either () (Inlines, Inlines))
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Inlines, Content)
     (Either () (Inlines, Inlines))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (Inlines, Fallible Anchor) -> Either () (Inlines, Anchor)
forall (v :: * -> *) f a.
ChoiceVector v =>
v (Either f a) -> Either f (v a)
spreadChoice ((Inlines, Fallible Anchor) -> Either () (Inlines, Anchor))
-> ((Inlines, Anchor) -> (Inlines, Inlines))
-> (Inlines, Fallible Anchor)
-> Either () (Inlines, Inlines)
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> a success success' -> FallibleArrow a x failure success'
>>?! (Anchor -> Inlines) -> (Inlines, Anchor) -> (Inlines, Inlines)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Anchor -> Inlines
text
                            )
                       ArrowState
  (XMLConverterState Namespace ReaderState)
  (Inlines, Content)
  (Either () (Inlines, Inlines))
-> (Inlines -> Inlines -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Inlines, Content)
     (Fallible Inlines)
forall (a :: * -> * -> *) x f b b' c.
ArrowChoice a =>
FallibleArrow a x f (b, b')
-> (b -> b' -> c) -> FallibleArrow a x f c
>>?% Inlines -> Inlines -> Inlines
forall a. Monoid a => a -> a -> a
mappend
    --
    extractText     :: XML.Content -> Fallible T.Text
    extractText :: Content -> Fallible Anchor
extractText (XML.Text CData
cData) = Anchor -> Fallible Anchor
forall a _x. a -> Either _x a
succeedWith (CData -> Anchor
XML.cdData CData
cData)
    extractText         Content
_        = Fallible Anchor
forall failure _x. Monoid failure => Either failure _x
failEmpty

read_text_seq :: InlineMatcher
read_text_seq :: InlineMatcher
read_text_seq  = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"sequence"
                 (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ [InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [] OdtReaderSafe (Inlines, Content) 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.
read_spaces      :: InlineMatcher
read_spaces :: InlineMatcher
read_spaces       = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"s" (
                          Namespace
-> Anchor
-> ListLevel
-> XMLConverter Namespace ReaderState Inlines ListLevel
forall nsID attrValue extraState x.
(NameSpaceID nsID, Read attrValue) =>
nsID
-> Anchor -> attrValue -> XMLConverter nsID extraState x attrValue
readAttrWithDefault Namespace
NsText Anchor
"c" ListLevel
1 -- how many spaces?
                      XMLConverter Namespace ReaderState Inlines ListLevel
-> (ListLevel -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ [Inline] -> Inlines
forall a. [a] -> Many a
fromList([Inline] -> Inlines)
-> (ListLevel -> [Inline]) -> ListLevel -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListLevel -> Inline -> [Inline]
forall a. ListLevel -> a -> [a]
`replicate` Inline
Space)
                    )
--
read_line_break  :: InlineMatcher
read_line_break :: InlineMatcher
read_line_break   = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"line-break"
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV Inlines
linebreak

--
read_span        :: InlineMatcher
read_span :: InlineMatcher
read_span         = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"span"
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall x. OdtReaderSafe x Inlines -> OdtReaderSafe x Inlines
withNewStyle
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> ArrowState
      (XMLConverterState Namespace ReaderState) Inlines Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall a b. (a -> b) -> a -> b
$ [InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [ InlineMatcher
read_span
                                        , InlineMatcher
read_spaces
                                        , InlineMatcher
read_line_break
                                        , 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
                                        ] OdtReaderSafe (Inlines, Content) Inlines
read_plain_text

--
read_paragraph   :: BlockMatcher
read_paragraph :: BlockMatcher
read_paragraph    = Namespace -> Anchor -> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"p"
                    (OdtReaderSafe Blocks Blocks -> BlockMatcher)
-> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall a b. (a -> b) -> a -> b
$ OdtReaderSafe Blocks Blocks -> OdtReaderSafe Blocks Blocks
constructPara
                    (OdtReaderSafe Blocks Blocks -> OdtReaderSafe Blocks Blocks)
-> OdtReaderSafe Blocks Blocks -> OdtReaderSafe Blocks Blocks
forall a b. (a -> b) -> a -> b
$ (Inlines -> Blocks)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks Inlines
-> OdtReaderSafe Blocks Blocks
forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA Inlines -> Blocks
para
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Blocks Inlines
 -> OdtReaderSafe Blocks Blocks)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks Inlines
-> OdtReaderSafe Blocks Blocks
forall a b. (a -> b) -> a -> b
$ ArrowState (XMLConverterState Namespace ReaderState) Blocks Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks Inlines
forall x. OdtReaderSafe x Inlines -> OdtReaderSafe x Inlines
withNewStyle
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Blocks Inlines
 -> ArrowState
      (XMLConverterState Namespace ReaderState) Blocks Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks Inlines
forall a b. (a -> b) -> a -> b
$ [InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [ InlineMatcher
read_span
                                        , InlineMatcher
read_spaces
                                        , InlineMatcher
read_line_break
                                        , 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
                                        ] OdtReaderSafe (Inlines, Content) Inlines
read_plain_text


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

--
read_header      :: BlockMatcher
read_header :: BlockMatcher
read_header       = Namespace -> Anchor -> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"h"
                    (OdtReaderSafe Blocks Blocks -> BlockMatcher)
-> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall a b. (a -> b) -> a -> b
$  proc Blocks
blocks -> do
  ListLevel
level    <- ( Namespace
-> Anchor
-> ListLevel
-> XMLConverter Namespace ReaderState Blocks ListLevel
forall nsID attrValue extraState x.
(NameSpaceID nsID, Read attrValue) =>
nsID
-> Anchor -> attrValue -> XMLConverter nsID extraState x attrValue
readAttrWithDefault Namespace
NsText Anchor
"outline-level" ListLevel
1
              ) -< Blocks
blocks
  Inlines
children <- ( [InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [ InlineMatcher
read_span
                                  , InlineMatcher
read_spaces
                                  , InlineMatcher
read_line_break
                                  , 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
                                  ] OdtReaderSafe (Inlines, Content) Inlines
read_plain_text
              ) -< Blocks
blocks
  Anchor
anchor   <- OdtReaderSafe Inlines Anchor
getHeaderAnchor -< Inlines
children
  let idAttr :: (Anchor, [a], [a])
idAttr = (Anchor
anchor, [], []) -- no classes, no key-value pairs
  ((Attr, ListLevel, Inlines) -> Blocks)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Attr, ListLevel, Inlines)
     Blocks
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Attr -> ListLevel -> Inlines -> Blocks)
-> (Attr, ListLevel, Inlines) -> Blocks
forall a b c z. (a -> b -> c -> z) -> (a, b, c) -> z
uncurry3 Attr -> ListLevel -> Inlines -> Blocks
headerWith) -< (Attr
forall a a. (Anchor, [a], [a])
idAttr, ListLevel
level, Inlines
children)

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

--
read_list        :: BlockMatcher
read_list :: BlockMatcher
read_list         = Namespace -> Anchor -> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"list"
--                  $ withIncreasedListLevel
                    (OdtReaderSafe Blocks Blocks -> BlockMatcher)
-> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall a b. (a -> b) -> a -> b
$ OdtReaderSafe Blocks [Blocks] -> OdtReaderSafe Blocks Blocks
forall x. OdtReaderSafe x [Blocks] -> OdtReaderSafe x Blocks
constructList
--                  $ liftA bulletList
                    (OdtReaderSafe Blocks [Blocks] -> OdtReaderSafe Blocks Blocks)
-> OdtReaderSafe Blocks [Blocks] -> OdtReaderSafe Blocks Blocks
forall a b. (a -> b) -> a -> b
$ [ElementMatcher [Blocks]] -> OdtReaderSafe Blocks [Blocks]
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent' [ ElementMatcher [Blocks]
read_list_item
                                         ]
--
read_list_item   :: ElementMatcher [Blocks]
read_list_item :: ElementMatcher [Blocks]
read_list_item    = Namespace
-> Anchor
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
-> ElementMatcher [Blocks]
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"list-item"
                    (XMLConverter Namespace ReaderState [Blocks] [Blocks]
 -> ElementMatcher [Blocks])
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
-> ElementMatcher [Blocks]
forall a b. (a -> b) -> a -> b
$ (Blocks -> [Blocks])
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA ([Blocks] -> [Blocks]
compactify([Blocks] -> [Blocks])
-> (Blocks -> [Blocks]) -> Blocks -> [Blocks]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[]))
                      ( [BlockMatcher]
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent' [ BlockMatcher
read_paragraph
                                           , BlockMatcher
read_header
                                           , BlockMatcher
read_list
                                           ]
                      )


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

read_link        :: InlineMatcher
read_link :: InlineMatcher
read_link         = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"a"
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ (Anchor -> Anchor -> Inlines -> Inlines)
-> OdtReaderSafe Inlines Anchor
-> OdtReaderSafe Inlines Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) z y x r b.
Arrow a =>
(z -> y -> x -> r) -> a b z -> a b y -> a b x -> a b r
liftA3 Anchor -> Anchor -> Inlines -> Inlines
link
                      ( Namespace -> Anchor -> Anchor -> OdtReaderSafe Inlines Anchor
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> Anchor -> XMLConverter nsID extraState x Anchor
findAttrTextWithDefault Namespace
NsXLink  Anchor
"href"  Anchor
""          )
                      ( Namespace -> Anchor -> Anchor -> OdtReaderSafe Inlines Anchor
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> Anchor -> XMLConverter nsID extraState x Anchor
findAttrTextWithDefault Namespace
NsOffice Anchor
"title" Anchor
""          )
                      ( [InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [ 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
                                          ] OdtReaderSafe (Inlines, Content) Inlines
read_plain_text                  )


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

read_note        :: InlineMatcher
read_note :: InlineMatcher
read_note         = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"note"
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ (Blocks -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Blocks
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA Blocks -> Inlines
note
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Blocks
 -> ArrowState
      (XMLConverterState Namespace ReaderState) Inlines Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Blocks
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall a b. (a -> b) -> a -> b
$ [BlockMatcher]
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Blocks
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent' [ BlockMatcher
read_note_body ]

read_note_body   :: BlockMatcher
read_note_body :: BlockMatcher
read_note_body    = Namespace -> Anchor -> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"note-body"
                    (OdtReaderSafe Blocks Blocks -> BlockMatcher)
-> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall a b. (a -> b) -> a -> b
$ [BlockMatcher] -> OdtReaderSafe Blocks Blocks
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent' [ BlockMatcher
read_paragraph ]

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

read_citation    :: InlineMatcher
read_citation :: InlineMatcher
read_citation     = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"bibliography-mark"
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ ([Citation] -> Inlines -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines [Citation]
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) x y z b.
Arrow a =>
(x -> y -> z) -> a b x -> a b y -> a b z
liftA2 [Citation] -> Inlines -> Inlines
cite
                      ( (Anchor -> ListLevel -> [Citation])
-> OdtReaderSafe Inlines Anchor
-> XMLConverter Namespace ReaderState Inlines ListLevel
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines [Citation]
forall (a :: * -> * -> *) x y z b.
Arrow a =>
(x -> y -> z) -> a b x -> a b y -> a b z
liftA2 Anchor -> ListLevel -> [Citation]
makeCitation
                        ( Namespace -> Anchor -> Anchor -> OdtReaderSafe Inlines Anchor
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> Anchor -> XMLConverter nsID extraState x Anchor
findAttrTextWithDefault Namespace
NsText Anchor
"identifier" Anchor
"" )
                        ( Namespace
-> Anchor
-> ListLevel
-> XMLConverter Namespace ReaderState Inlines ListLevel
forall nsID attrValue extraState x.
(NameSpaceID nsID, Read attrValue) =>
nsID
-> Anchor -> attrValue -> XMLConverter nsID extraState x attrValue
readAttrWithDefault Namespace
NsText Anchor
"number" ListLevel
0          )
                      )
                      ( [InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [] OdtReaderSafe (Inlines, Content) Inlines
read_plain_text             )
  where
   makeCitation :: T.Text -> Int -> [Citation]
   makeCitation :: Anchor -> ListLevel -> [Citation]
makeCitation Anchor
citeId ListLevel
num = [Anchor
-> [Inline]
-> [Inline]
-> CitationMode
-> ListLevel
-> ListLevel
-> Citation
Citation Anchor
citeId [] [] CitationMode
NormalCitation ListLevel
num ListLevel
0]


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

--
read_table        :: BlockMatcher
read_table :: BlockMatcher
read_table         = Namespace -> Anchor -> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsTable Anchor
"table"
                     (OdtReaderSafe Blocks Blocks -> BlockMatcher)
-> OdtReaderSafe Blocks Blocks -> BlockMatcher
forall a b. (a -> b) -> a -> b
$ ([[Blocks]] -> Blocks)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks [[Blocks]]
-> OdtReaderSafe Blocks Blocks
forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA [[Blocks]] -> Blocks
simpleTable'
                     (ArrowState
   (XMLConverterState Namespace ReaderState) Blocks [[Blocks]]
 -> OdtReaderSafe Blocks Blocks)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks [[Blocks]]
-> OdtReaderSafe Blocks Blocks
forall a b. (a -> b) -> a -> b
$ [ElementMatcher [[Blocks]]]
-> ArrowState
     (XMLConverterState Namespace ReaderState) Blocks [[Blocks]]
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent'  [ ElementMatcher [[Blocks]]
read_table_row
                                           ]

-- | A simple table without a caption or headers
-- | Infers the number of headers from rows
simpleTable' :: [[Blocks]] -> Blocks
simpleTable' :: [[Blocks]] -> Blocks
simpleTable' []         = [Blocks] -> [[Blocks]] -> Blocks
simpleTable [] []
simpleTable' ([Blocks]
x : [[Blocks]]
rest) = [Blocks] -> [[Blocks]] -> Blocks
simpleTable (ParaModifier -> [Blocks] -> [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Blocks -> ParaModifier
forall a b. a -> b -> a
const Blocks
forall a. Many a
defaults) [Blocks]
x) ([Blocks]
x [Blocks] -> [[Blocks]] -> [[Blocks]]
forall a. a -> [a] -> [a]
: [[Blocks]]
rest)
  where defaults :: Many a
defaults = [a] -> Many a
forall a. [a] -> Many a
fromList []

--
read_table_row    :: ElementMatcher [[Blocks]]
read_table_row :: ElementMatcher [[Blocks]]
read_table_row     = Namespace
-> Anchor
-> OdtReaderSafe [[Blocks]] [[Blocks]]
-> ElementMatcher [[Blocks]]
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsTable Anchor
"table-row"
                     (OdtReaderSafe [[Blocks]] [[Blocks]] -> ElementMatcher [[Blocks]])
-> OdtReaderSafe [[Blocks]] [[Blocks]] -> ElementMatcher [[Blocks]]
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> [[Blocks]])
-> ArrowState
     (XMLConverterState Namespace ReaderState) [[Blocks]] [Blocks]
-> OdtReaderSafe [[Blocks]] [[Blocks]]
forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA ([Blocks] -> [[Blocks]] -> [[Blocks]]
forall a. a -> [a] -> [a]
:[])
                     (ArrowState
   (XMLConverterState Namespace ReaderState) [[Blocks]] [Blocks]
 -> OdtReaderSafe [[Blocks]] [[Blocks]])
-> ArrowState
     (XMLConverterState Namespace ReaderState) [[Blocks]] [Blocks]
-> OdtReaderSafe [[Blocks]] [[Blocks]]
forall a b. (a -> b) -> a -> b
$ [ElementMatcher [Blocks]]
-> ArrowState
     (XMLConverterState Namespace ReaderState) [[Blocks]] [Blocks]
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent'  [ ElementMatcher [Blocks]
read_table_cell
                                           ]

--
read_table_cell   :: ElementMatcher [Blocks]
read_table_cell :: ElementMatcher [Blocks]
read_table_cell    = Namespace
-> Anchor
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
-> ElementMatcher [Blocks]
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsTable Anchor
"table-cell"
                     (XMLConverter Namespace ReaderState [Blocks] [Blocks]
 -> ElementMatcher [Blocks])
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
-> ElementMatcher [Blocks]
forall a b. (a -> b) -> a -> b
$ (Blocks -> [Blocks])
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA ([Blocks] -> [Blocks]
compactify([Blocks] -> [Blocks])
-> (Blocks -> [Blocks]) -> Blocks -> [Blocks]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[]))
                     (ArrowState
   (XMLConverterState Namespace ReaderState) [Blocks] Blocks
 -> XMLConverter Namespace ReaderState [Blocks] [Blocks])
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
forall a b. (a -> b) -> a -> b
$ [BlockMatcher]
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent' [ BlockMatcher
read_paragraph
                                          ]

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

--
read_frame :: InlineMatcher
read_frame :: InlineMatcher
read_frame = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsDraw Anchor
"frame"
             (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ Namespace
-> (Anchor -> Bool)
-> XMLConverter Namespace ReaderState Inlines [Element]
forall nsID extraState x.
NameSpaceID nsID =>
nsID
-> (Anchor -> Bool) -> XMLConverter nsID extraState x [Element]
filterChildrenName' Namespace
NsDraw (Anchor -> [Anchor] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Anchor
"image", Anchor
"object", Anchor
"text-box"])
           XMLConverter Namespace ReaderState Inlines [Element]
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Element] Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     [Element]
     (FirstMatch Inlines)
forall (f :: * -> *) m s x.
(Foldable f, Monoid m) =>
ArrowState s x m -> ArrowState s (f x) m
foldS ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_child
           ArrowState
  (XMLConverterState Namespace ReaderState)
  [Element]
  (FirstMatch Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (FirstMatch Inlines)
     Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Element] Inlines
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (FirstMatch Inlines -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (FirstMatch Inlines)
     Inlines
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr FirstMatch Inlines -> Inlines
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

read_frame_child :: OdtReaderSafe XML.Element (FirstMatch Inlines)
read_frame_child :: ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_child =
  proc Element
child -> case Element -> Anchor
elName Element
child of
    Anchor
"image"    -> ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_img      -< Element
child
    Anchor
"object"   -> ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_mathml   -< Element
child
    Anchor
"text-box" -> ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_text_box -< Element
child
    Anchor
_          -> FirstMatch Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) () (FirstMatch Inlines)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV FirstMatch Inlines
forall a. Monoid a => a
mempty      -< ()

read_frame_img :: OdtReaderSafe XML.Element (FirstMatch Inlines)
read_frame_img :: ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_img =
  proc Element
img -> do
    Maybe Anchor
src <- XMLConverter Namespace ReaderState Element (Maybe Anchor)
-> XMLConverter Namespace ReaderState Element (Maybe Anchor)
forall nsID extraState s.
XMLConverter nsID extraState Element s
-> XMLConverter nsID extraState Element s
executeIn (Namespace
-> Anchor
-> XMLConverter Namespace ReaderState Element (Maybe Anchor)
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> XMLConverter nsID extraState x (Maybe Anchor)
findAttr' Namespace
NsXLink Anchor
"href") -< Element
img
    case Maybe Anchor -> Anchor
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Anchor
src of
      Anchor
""   -> FirstMatch Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) () (FirstMatch Inlines)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV FirstMatch Inlines
forall a. Monoid a => a
mempty -< ()
      Anchor
src' -> do
        let exts :: Extensions
exts = [Extension] -> Extensions
extensionsFromList [Extension
Ext_auto_identifiers]
        (String, ByteString)
resource   <- OdtReaderSafe String (String, ByteString)
lookupResource                          -< Anchor -> String
T.unpack Anchor
src'
        (String, ByteString)
_          <- OdtReaderSafe (String, ByteString) (String, ByteString)
updateMediaWithResource                 -< (String, ByteString)
resource
        Maybe Anchor
w          <- Namespace
-> Anchor -> XMLConverter Namespace ReaderState () (Maybe Anchor)
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> XMLConverter nsID extraState x (Maybe Anchor)
findAttrText' Namespace
NsSVG Anchor
"width"             -< ()
        Maybe Anchor
h          <- Namespace
-> Anchor -> XMLConverter Namespace ReaderState () (Maybe Anchor)
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> XMLConverter nsID extraState x (Maybe Anchor)
findAttrText' Namespace
NsSVG Anchor
"height"            -< ()
        Inlines
titleNodes <- [InlineMatcher] -> OdtReaderSafe () Inlines
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent' [ InlineMatcher
read_frame_title ] -< ()
        Inlines
alt        <- [InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> OdtReaderSafe () Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [] OdtReaderSafe (Inlines, Content) Inlines
read_plain_text    -< ()
        ((Attr, Anchor, Anchor, Inlines) -> FirstMatch Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Attr, Anchor, Anchor, Inlines)
     (FirstMatch Inlines)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Inlines -> FirstMatch Inlines
forall a. a -> FirstMatch a
firstMatch (Inlines -> FirstMatch Inlines)
-> ((Attr, Anchor, Anchor, Inlines) -> Inlines)
-> (Attr, Anchor, Anchor, Inlines)
-> FirstMatch Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Anchor -> Anchor -> Inlines -> Inlines)
-> (Attr, Anchor, Anchor, Inlines) -> Inlines
forall a b c d z. (a -> b -> c -> d -> z) -> (a, b, c, d) -> z
uncurry4 Attr -> Anchor -> Anchor -> Inlines -> Inlines
imageWith)                 -<
          (Maybe Anchor -> Maybe Anchor -> Attr
image_attributes Maybe Anchor
w Maybe Anchor
h, Anchor
src', Extensions -> [Inline] -> Anchor
inlineListToIdentifier Extensions
exts (Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
titleNodes), Inlines
alt)

read_frame_title :: InlineMatcher
read_frame_title :: InlineMatcher
read_frame_title = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsSVG Anchor
"title" ([InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [] OdtReaderSafe (Inlines, Content) Inlines
read_plain_text)

image_attributes :: Maybe T.Text -> Maybe T.Text -> Attr
image_attributes :: Maybe Anchor -> Maybe Anchor -> Attr
image_attributes Maybe Anchor
x Maybe Anchor
y =
  ( Anchor
"", [], Anchor -> Maybe Anchor -> [(Anchor, Anchor)]
forall b a. (Eq b, IsString b) => a -> Maybe b -> [(a, b)]
dim Anchor
"width" Maybe Anchor
x [(Anchor, Anchor)] -> [(Anchor, Anchor)] -> [(Anchor, Anchor)]
forall a. [a] -> [a] -> [a]
++ Anchor -> Maybe Anchor -> [(Anchor, Anchor)]
forall b a. (Eq b, IsString b) => a -> Maybe b -> [(a, b)]
dim Anchor
"height" Maybe Anchor
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 :: OdtReaderSafe XML.Element (FirstMatch Inlines)
read_frame_mathml :: ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_mathml =
  proc Element
obj -> do
    Maybe Anchor
src <- XMLConverter Namespace ReaderState Element (Maybe Anchor)
-> XMLConverter Namespace ReaderState Element (Maybe Anchor)
forall nsID extraState s.
XMLConverter nsID extraState Element s
-> XMLConverter nsID extraState Element s
executeIn (Namespace
-> Anchor
-> XMLConverter Namespace ReaderState Element (Maybe Anchor)
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> XMLConverter nsID extraState x (Maybe Anchor)
findAttr' Namespace
NsXLink Anchor
"href") -< Element
obj
    case Maybe Anchor -> Anchor
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Anchor
src of
      Anchor
""   -> FirstMatch Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) () (FirstMatch Inlines)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV FirstMatch Inlines
forall a. Monoid a => a
mempty -< ()
      Anchor
src' -> do
        let path :: String
path = Anchor -> String
T.unpack (Anchor -> String) -> Anchor -> String
forall a b. (a -> b) -> a -> b
$
                    Anchor -> Maybe Anchor -> Anchor
forall a. a -> Maybe a -> a
fromMaybe Anchor
src' (Anchor -> Anchor -> Maybe Anchor
T.stripPrefix Anchor
"./" Anchor
src') Anchor -> Anchor -> Anchor
forall a. Semigroup a => a -> a -> a
<> Anchor
"/content.xml"
        (String
_, ByteString
mathml) <- OdtReaderSafe String (String, ByteString)
lookupResource -< String
path
        case Anchor -> Either Anchor [Exp]
readMathML (ByteString -> Anchor
UTF8.toText (ByteString -> Anchor) -> ByteString -> Anchor
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict ByteString
mathml) of
          Left Anchor
_     -> FirstMatch Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) () (FirstMatch Inlines)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV FirstMatch Inlines
forall a. Monoid a => a
mempty -< ()
          Right [Exp]
exps -> ([Exp] -> FirstMatch Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     [Exp]
     (FirstMatch Inlines)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Inlines -> FirstMatch Inlines
forall a. a -> FirstMatch a
firstMatch (Inlines -> FirstMatch Inlines)
-> ([Exp] -> Inlines) -> [Exp] -> FirstMatch Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anchor -> Inlines
displayMath (Anchor -> Inlines) -> ([Exp] -> Anchor) -> [Exp] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> Anchor
writeTeX) -< [Exp]
exps

read_frame_text_box :: OdtReaderSafe XML.Element (FirstMatch Inlines)
read_frame_text_box :: ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_text_box = proc Element
box -> do
    Blocks
paragraphs <- XMLConverter Namespace ReaderState Element Blocks
-> XMLConverter Namespace ReaderState Element Blocks
forall nsID extraState s.
XMLConverter nsID extraState Element s
-> XMLConverter nsID extraState Element s
executeIn ([BlockMatcher] -> XMLConverter Namespace ReaderState Element Blocks
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent' [ BlockMatcher
read_paragraph ]) -< Element
box
    ([Block] -> FirstMatch Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     [Block]
     (FirstMatch Inlines)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr [Block] -> FirstMatch Inlines
read_img_with_caption -< Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
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 (Anchor
src,Anchor
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] -> (Anchor, Anchor) -> Inline
Image Attr
attr [Inline]
alt (Anchor
src, Anchor
"fig:" Anchor -> Anchor -> Anchor
forall a. Semigroup a => a -> a -> a
<> Anchor
title))   -- no text, default caption
read_img_with_caption (Para (Image Attr
attr [Inline]
_ (Anchor
src,Anchor
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] -> (Anchor, Anchor) -> Inline
Image Attr
attr [Inline]
txt (Anchor
src, Anchor
"fig:" Anchor -> Anchor -> Anchor
forall a. Semigroup a => a -> a -> a
<> Anchor
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_ :: Anchor
_ANCHOR_PREFIX_ = Anchor
"anchor"

--
readAnchorAttr :: OdtReader _x Anchor
readAnchorAttr :: OdtReader _x Anchor
readAnchorAttr = Namespace -> Anchor -> OdtReader _x Anchor
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> FallibleXMLConverter nsID extraState x Anchor
findAttrText Namespace
NsText Anchor
"name"

-- | Beware: may fail
findAnchorName :: OdtReader AnchorPrefix Anchor
findAnchorName :: OdtReader Anchor Anchor
findAnchorName = (      OdtReader Anchor Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Anchor
     (Anchor, Fallible Anchor)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue OdtReader Anchor Anchor
forall _x. OdtReader _x Anchor
readAnchorAttr
                   ArrowState
  (XMLConverterState Namespace ReaderState)
  Anchor
  (Anchor, Fallible Anchor)
-> ((Anchor, Fallible Anchor) -> Either () (Anchor, Anchor))
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Anchor
     (Either () (Anchor, Anchor))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^  (Anchor, Fallible Anchor) -> Either () (Anchor, Anchor)
forall (v :: * -> *) f a.
ChoiceVector v =>
v (Either f a) -> Either f (v a)
spreadChoice
                 ) ArrowState
  (XMLConverterState Namespace ReaderState)
  Anchor
  (Either () (Anchor, Anchor))
-> OdtReaderSafe (Anchor, Anchor) Anchor -> OdtReader Anchor Anchor
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> a success success' -> FallibleArrow a x failure success'
>>?! OdtReaderSafe (Anchor, Anchor) Anchor
getPrettyAnchor


--
maybeAddAnchorFrom :: OdtReader Inlines AnchorPrefix
                   -> OdtReaderSafe Inlines Inlines
maybeAddAnchorFrom :: OdtReader Inlines Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom OdtReader Inlines Anchor
anchorReader =
  ArrowState
  (XMLConverterState Namespace ReaderState)
  Inlines
  (Fallible Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Inlines
     (Inlines, Fallible Inlines)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue (OdtReader Inlines Anchor
anchorReader OdtReader Inlines Anchor
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     Anchor
     ()
     Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Inlines
     (Fallible Inlines)
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> FallibleArrow a success failure success'
-> FallibleArrow a x failure success'
>>? OdtReader Anchor Anchor
findAnchorName OdtReader Anchor Anchor
-> (Anchor -> Inlines)
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     Anchor
     ()
     Inlines
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> (success -> success') -> FallibleArrow a x failure success'
>>?^ Anchor -> Inlines
toAnchorElem)
  ArrowState
  (XMLConverterState Namespace ReaderState)
  Inlines
  (Inlines, Fallible Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Inlines, Fallible Inlines)
     Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  proc (Inlines
inlines, Fallible Inlines
fAnchorElem) -> do
  case Fallible Inlines
fAnchorElem of
    Right Inlines
anchorElem -> ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Inlines
anchorElem
    Left ()
_           -> ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Inlines
inlines
  where
    toAnchorElem :: Anchor -> Inlines
    toAnchorElem :: Anchor -> Inlines
toAnchorElem Anchor
anchorID = Attr -> Inlines -> Inlines
spanWith (Anchor
anchorID, [], []) Inlines
forall a. Monoid a => a
mempty
                            -- no classes, no key-value pairs

--
read_bookmark     :: InlineMatcher
read_bookmark :: InlineMatcher
read_bookmark      = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"bookmark"
                     (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ OdtReader Inlines Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom (OdtReaderSafe Inlines Anchor -> OdtReader Inlines Anchor
forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess (OdtReaderSafe Inlines Anchor -> OdtReader Inlines Anchor)
-> OdtReaderSafe Inlines Anchor -> OdtReader Inlines Anchor
forall a b. (a -> b) -> a -> b
$ Anchor -> OdtReaderSafe Inlines Anchor
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV Anchor
_ANCHOR_PREFIX_)

--
read_bookmark_start :: InlineMatcher
read_bookmark_start :: InlineMatcher
read_bookmark_start = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"bookmark-start"
                     (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ OdtReader Inlines Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom (OdtReaderSafe Inlines Anchor -> OdtReader Inlines Anchor
forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess (OdtReaderSafe Inlines Anchor -> OdtReader Inlines Anchor)
-> OdtReaderSafe Inlines Anchor -> OdtReader Inlines Anchor
forall a b. (a -> b) -> a -> b
$ Anchor -> OdtReaderSafe Inlines Anchor
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV Anchor
_ANCHOR_PREFIX_)

--
read_reference_start :: InlineMatcher
read_reference_start :: InlineMatcher
read_reference_start = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"reference-mark-start"
                     (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ OdtReader Inlines Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom OdtReader Inlines Anchor
forall _x. OdtReader _x Anchor
readAnchorAttr

-- | Beware: may fail
findAnchorRef :: OdtReader _x Anchor
findAnchorRef :: OdtReader _x Anchor
findAnchorRef = (      Namespace -> Anchor -> OdtReader _x Anchor
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Anchor -> FallibleXMLConverter nsID extraState x Anchor
findAttrText Namespace
NsText Anchor
"ref-name"
                  OdtReader _x Anchor
-> (Anchor -> (Anchor, Anchor))
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     _x
     ()
     (Anchor, Anchor)
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> (success -> success') -> FallibleArrow a x failure success'
>>?^ (Anchor
_ANCHOR_PREFIX_,)
                ) FallibleArrow
  (ArrowState (XMLConverterState Namespace ReaderState))
  _x
  ()
  (Anchor, Anchor)
-> OdtReaderSafe (Anchor, Anchor) Anchor -> OdtReader _x Anchor
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> a success success' -> FallibleArrow a x failure success'
>>?! OdtReaderSafe (Anchor, Anchor) Anchor
getPrettyAnchor


--
maybeInAnchorRef :: OdtReaderSafe Inlines Inlines
maybeInAnchorRef :: ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeInAnchorRef = proc Inlines
inlines -> do
  Fallible Anchor
fRef <- FallibleXMLConverter Namespace ReaderState () Anchor
forall _x. OdtReader _x Anchor
findAnchorRef -< ()
  case Fallible Anchor
fRef of
    Right Anchor
anchor ->
      (Inlines -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Anchor -> Inlines -> Inlines
toAnchorRef Anchor
anchor) -<< Inlines
inlines
    Left ()
_ -> ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Inlines
inlines
  where
    toAnchorRef :: Anchor -> Inlines -> Inlines
    toAnchorRef :: Anchor -> Inlines -> Inlines
toAnchorRef Anchor
anchor = Anchor -> Anchor -> Inlines -> Inlines
link (Anchor
"#" Anchor -> Anchor -> Anchor
forall a. Semigroup a => a -> a -> a
<> Anchor
anchor) Anchor
"" -- no title

--
read_bookmark_ref :: InlineMatcher
read_bookmark_ref :: InlineMatcher
read_bookmark_ref = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"bookmark-ref"
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$    ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeInAnchorRef
                     ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< [InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [] OdtReaderSafe (Inlines, Content) Inlines
read_plain_text

--
read_reference_ref :: InlineMatcher
read_reference_ref :: InlineMatcher
read_reference_ref = Namespace
-> Anchor
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Anchor -> OdtReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Anchor
"reference-ref"
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$    ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeInAnchorRef
                     ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< [InlineMatcher]
-> OdtReaderSafe (Inlines, Content) Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> OdtReaderSafe (result, Content) result
-> OdtReaderSafe _x result
matchChildContent [] OdtReaderSafe (Inlines, Content) Inlines
read_plain_text


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

read_text :: OdtReaderSafe _x Pandoc
read_text :: OdtReaderSafe _x Pandoc
read_text = [BlockMatcher] -> OdtReaderSafe _x Blocks
forall result _x.
Monoid result =>
[ElementMatcher result] -> OdtReaderSafe _x result
matchChildContent' [ BlockMatcher
read_header
                               , BlockMatcher
read_paragraph
                               , BlockMatcher
read_list
                               , BlockMatcher
read_table
                               ]
            OdtReaderSafe _x Blocks
-> (Blocks -> Pandoc) -> OdtReaderSafe _x Pandoc
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ Blocks -> Pandoc
doc

post_process :: Pandoc -> Pandoc
post_process :: Pandoc -> Pandoc
post_process (Pandoc Meta
m [Block]
blocks) =
  Meta -> [Block] -> Pandoc
Pandoc Meta
m ([Block] -> [Block]
post_process' [Block]
blocks)

post_process' :: [Block] -> [Block]
post_process' :: [Block] -> [Block]
post_process' (Table Attr
attr Caption
_ [ColSpec]
specs TableHead
th [TableBody]
tb TableFoot
tf : Div (Anchor
"", [Anchor
"caption"], [(Anchor, Anchor)]
_) [Block]
blks : [Block]
xs)
  = 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]
post_process' [Block]
xs
post_process' [Block]
bs = [Block]
bs

read_body :: OdtReader _x (Pandoc, MediaBag)
read_body :: OdtReader _x (Pandoc, MediaBag)
read_body = Namespace
-> Anchor
-> OdtReader _x (Pandoc, MediaBag)
-> OdtReader _x (Pandoc, MediaBag)
forall nsID extraState f s.
NameSpaceID nsID =>
nsID
-> Anchor
-> FallibleXMLConverter nsID extraState f s
-> FallibleXMLConverter nsID extraState f s
executeInSub Namespace
NsOffice Anchor
"body"
          (OdtReader _x (Pandoc, MediaBag)
 -> OdtReader _x (Pandoc, MediaBag))
-> OdtReader _x (Pandoc, MediaBag)
-> OdtReader _x (Pandoc, MediaBag)
forall a b. (a -> b) -> a -> b
$ Namespace
-> Anchor
-> OdtReader _x (Pandoc, MediaBag)
-> OdtReader _x (Pandoc, MediaBag)
forall nsID extraState f s.
NameSpaceID nsID =>
nsID
-> Anchor
-> FallibleXMLConverter nsID extraState f s
-> FallibleXMLConverter nsID extraState f s
executeInSub Namespace
NsOffice Anchor
"text"
          (OdtReader _x (Pandoc, MediaBag)
 -> OdtReader _x (Pandoc, MediaBag))
-> OdtReader _x (Pandoc, MediaBag)
-> OdtReader _x (Pandoc, MediaBag)
forall a b. (a -> b) -> a -> b
$ ArrowState
  (XMLConverterState Namespace ReaderState) _x (Pandoc, MediaBag)
-> OdtReader _x (Pandoc, MediaBag)
forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess
          (ArrowState
   (XMLConverterState Namespace ReaderState) _x (Pandoc, MediaBag)
 -> OdtReader _x (Pandoc, MediaBag))
-> ArrowState
     (XMLConverterState Namespace ReaderState) _x (Pandoc, MediaBag)
-> OdtReader _x (Pandoc, MediaBag)
forall a b. (a -> b) -> a -> b
$ proc _x
inlines -> do
             Pandoc
txt   <- OdtReaderSafe _x Pandoc
forall _x. OdtReaderSafe _x Pandoc
read_text     -< _x
inlines
             ReaderState
state <- XMLConverter Namespace ReaderState () ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState -< ()
             ArrowState
  (XMLConverterState Namespace ReaderState)
  (Pandoc, MediaBag)
  (Pandoc, MediaBag)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA                -< (Pandoc -> Pandoc
post_process Pandoc
txt, ReaderState -> MediaBag
getMediaBag ReaderState
state)