{-# LANGUAGE Arrows            #-}
{-# LANGUAGE CPP               #-}
{-# 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 Prelude hiding (Applicative(..))
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.Monoid (Alt (..))

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 Network.URI (parseRelativeReference, URI(uriPath))
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 -> Int
currentListLevel :: ListLevel
                   -- | Keeps track of the previous list start counters,
                   -- so whenever a new list continues numbering,
                   -- we know what number to start from.
                   -- If  list does not continue numbering, the counter
                   -- is being reset.
                 , ReaderState -> Map Int Int
listContinuationStartCounters :: M.Map ListLevel Int
                   -- | Lists may provide their own style, but they don't have
                   -- to. If they do not, the style of a parent list may be used
                   -- or even a default list style from the paragraph style.
                   -- This value keeps track of the closest list style there
                   -- currently is.
                 , ReaderState -> Maybe ListStyle
currentListStyle :: Maybe ListStyle
                   -- | A map from internal anchor names to "pretty" ones.
                   -- The mapping is a purely cosmetic one.
                 , ReaderState -> Map Text Text
bookmarkAnchors  :: M.Map Anchor Anchor
                   -- | A map of files / binary data from the archive
                 , ReaderState -> Media
envMedia         :: Media
                   -- | Hold binary resources used in the document
                 , ReaderState -> MediaBag
odtMediaBag      :: MediaBag
                 }
  deriving ( Int -> ReaderState -> ShowS
[ReaderState] -> ShowS
ReaderState -> FilePath
(Int -> ReaderState -> ShowS)
-> (ReaderState -> FilePath)
-> ([ReaderState] -> ShowS)
-> Show ReaderState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReaderState -> ShowS
showsPrec :: Int -> ReaderState -> ShowS
$cshow :: ReaderState -> FilePath
show :: ReaderState -> FilePath
$cshowList :: [ReaderState] -> ShowS
showList :: [ReaderState] -> ShowS
Show )

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

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

--
modifyListContinuationStartCounter :: ListLevel -> Int -> (ReaderState -> ReaderState)
modifyListContinuationStartCounter :: Int -> Int -> ReaderState -> ReaderState
modifyListContinuationStartCounter Int
listLevel Int
count ReaderState
state =
    ReaderState
state { listContinuationStartCounters = M.insert listLevel count (listContinuationStartCounters state) }

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

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

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

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

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

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

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

insertMedia' :: (FilePath, B.ByteString) -> ReaderState ->  ReaderState
insertMedia' :: (FilePath, ByteString) -> ReaderState -> ReaderState
insertMedia' (FilePath
fp, ByteString
bs) state :: ReaderState
state@ReaderState{Int
Media
[Style]
Maybe ListStyle
Map Int Int
Map Text Text
MediaBag
Styles
styleSet :: ReaderState -> Styles
styleTrace :: ReaderState -> [Style]
currentListLevel :: ReaderState -> Int
listContinuationStartCounters :: ReaderState -> Map Int Int
currentListStyle :: ReaderState -> Maybe ListStyle
bookmarkAnchors :: ReaderState -> Map Text Text
envMedia :: ReaderState -> Media
odtMediaBag :: ReaderState -> MediaBag
styleSet :: Styles
styleTrace :: [Style]
currentListLevel :: Int
listContinuationStartCounters :: Map Int Int
currentListStyle :: Maybe ListStyle
bookmarkAnchors :: Map Text Text
envMedia :: Media
odtMediaBag :: MediaBag
..}
  = ReaderState
state { odtMediaBag = insertMedia fp Nothing bs 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 :: forall a b. (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)
-> ArrowState (XMLConverterState Namespace ReaderState) 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 Text Style
getStyleByName = (Text -> Styles -> Maybe Style) -> ODTReaderSafe Text (Maybe Style)
forall a b. (a -> Styles -> b) -> ODTReaderSafe a b
fromStyles Text -> Styles -> Maybe Style
lookupStyle ODTReaderSafe Text (Maybe Style)
-> (Maybe Style -> Fallible Style) -> ODTReader Text 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 Text ListStyle
lookupListStyle = (Text -> Styles -> Maybe ListStyle)
-> ODTReaderSafe Text (Maybe ListStyle)
forall a b. (a -> Styles -> b) -> ODTReaderSafe a b
fromStyles Text -> Styles -> Maybe ListStyle
lookupListStyleByName ODTReaderSafe Text (Maybe ListStyle)
-> (Maybe ListStyle -> Fallible ListStyle)
-> ODTReader Text 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 b c d.
ArrowState (XMLConverterState Namespace ReaderState) b c
-> ArrowState
     (XMLConverterState Namespace ReaderState) (b, d) (c, d)
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 :: forall x. 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 b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
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)
-> ArrowState (XMLConverterState Namespace ReaderState) 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 :: forall _x. ODTReaderSafe _x Int
getCurrentListLevel = XMLConverter Namespace ReaderState _x ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState XMLConverter Namespace ReaderState _x ReaderState
-> (ReaderState -> Int)
-> ArrowState (XMLConverterState Namespace ReaderState) _x Int
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ReaderState -> Int
currentListLevel

--
getListContinuationStartCounters :: ODTReaderSafe _x (M.Map ListLevel Int)
getListContinuationStartCounters :: forall _x. ODTReaderSafe _x (Map Int Int)
getListContinuationStartCounters = XMLConverter Namespace ReaderState _x ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState XMLConverter Namespace ReaderState _x ReaderState
-> (ReaderState -> Map Int Int)
-> ArrowState
     (XMLConverterState Namespace ReaderState) _x (Map Int Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ReaderState -> Map Int Int
listContinuationStartCounters


--
getPreviousListStartCounter :: ODTReaderSafe ListLevel Int
getPreviousListStartCounter :: ODTReaderSafe Int Int
getPreviousListStartCounter = proc Int
listLevel -> do
    Map Int Int
counts <- ODTReaderSafe Failure (Map Int Int)
forall _x. ODTReaderSafe _x (Map Int Int)
getListContinuationStartCounters -< ()
    ODTReaderSafe Int Int
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Int -> Int -> Map Int Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Int
0 Int
listLevel Map Int Int
counts

--
updateMediaWithResource :: ODTReaderSafe (FilePath, B.ByteString) (FilePath, B.ByteString)
updateMediaWithResource :: ODTReaderSafe (FilePath, ByteString) (FilePath, ByteString)
updateMediaWithResource = ArrowState
  (XMLConverterState Namespace ReaderState)
  (FilePath, ByteString)
  ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (FilePath, ByteString)
     ((FilePath, ByteString), ReaderState)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue (
                 (ArrowState
  (XMLConverterState Namespace ReaderState)
  (FilePath, ByteString)
  ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (FilePath, ByteString)
     ((FilePath, ByteString), ReaderState)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue ArrowState
  (XMLConverterState Namespace ReaderState)
  (FilePath, ByteString)
  ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState
                  ArrowState
  (XMLConverterState Namespace ReaderState)
  (FilePath, ByteString)
  ((FilePath, ByteString), ReaderState)
-> ((FilePath, ByteString) -> ReaderState -> ReaderState)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (FilePath, ByteString)
     ReaderState
forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% (FilePath, ByteString) -> ReaderState -> ReaderState
insertMedia'
                  )
                 ArrowState
  (XMLConverterState Namespace ReaderState)
  (FilePath, ByteString)
  ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState) ReaderState ReaderState
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (FilePath, 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)
  (FilePath, ByteString)
  ((FilePath, ByteString), ReaderState)
-> (((FilePath, ByteString), ReaderState)
    -> (FilePath, ByteString))
-> ODTReaderSafe (FilePath, ByteString) (FilePath, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ((FilePath, ByteString), ReaderState) -> (FilePath, ByteString)
forall a b. (a, b) -> a
fst

lookupResource :: ODTReaderSafe FilePath (FilePath, B.ByteString)
lookupResource :: ODTReaderSafe FilePath (FilePath, ByteString)
lookupResource = proc FilePath
target -> do
    ReaderState
state <- XMLConverter Namespace ReaderState Failure ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState -< ()
    case FilePath -> Media -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
target (ReaderState -> Media
getMediaEnv ReaderState
state) of
      Just ByteString
bs -> (FilePath, ByteString)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Failure
     (FilePath, ByteString)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV (FilePath
target, ByteString
bs) -<< ()
      Maybe ByteString
Nothing -> (FilePath, ByteString)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Failure
     (FilePath, ByteString)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV (FilePath
"", 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 :: Text -> [Text] -> Text
uniqueIdentFrom Text
baseIdent [Text]
usedIdents =
  let  numIdent :: a -> Text
numIdent a
n = Text
baseIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (a -> FilePath
forall a. Show a => a -> FilePath
show a
n)
  in  if Text
baseIdent Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
usedIdents
        then Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
baseIdent Int -> Text
forall {a}. Show a => a -> Text
numIdent
             (Maybe Int -> Text) -> Maybe Int -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> Maybe Int
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Int
x -> Int -> Text
forall {a}. Show a => a -> Text
numIdent Int
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
usedIdents) ([Int
1..Int
60000] :: [Int])
               -- if we have more than 60,000, allow repeats
        else Text
baseIdent

-- | First argument: basis for a new "pretty" anchor if none exists yet
-- Second argument: a key ("ugly" anchor)
-- Returns: saved "pretty" anchor or created new one
getPrettyAnchor :: ODTReaderSafe (AnchorPrefix, Anchor) Anchor
getPrettyAnchor :: ODTReaderSafe (Text, Text) Text
getPrettyAnchor = proc (Text
baseIdent, Text
uglyAnchor) -> do
  ReaderState
state <- XMLConverter Namespace ReaderState Failure ReaderState
forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState -< ()
  case Text -> ReaderState -> Maybe Text
lookupPrettyAnchor Text
uglyAnchor ReaderState
state of
    Just Text
prettyAnchor -> ArrowState (XMLConverterState Namespace ReaderState) Text Text
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Text
prettyAnchor
    Maybe Text
Nothing           -> do
      let newPretty :: Text
newPretty = Text -> [Text] -> Text
uniqueIdentFrom Text
baseIdent (ReaderState -> [Text]
usedAnchors ReaderState
state)
      (ReaderState -> ReaderState)
-> ArrowState (XMLConverterState Namespace ReaderState) Text Text
forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (Text -> Text -> ReaderState -> ReaderState
putPrettyAnchor Text
uglyAnchor Text
newPretty) -<< Text
newPretty

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


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

--
readStyleByName :: ODTReader _x (StyleName, Style)
readStyleByName :: forall _x. ODTReader _x (Text, Style)
readStyleByName =
  Namespace
-> Text -> FallibleXMLConverter Namespace ReaderState _x Text
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> FallibleXMLConverter nsID extraState x Text
findAttr Namespace
NsText Text
"style-name" FallibleXMLConverter Namespace ReaderState _x Text
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     Text
     Failure
     (Text, Style)
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     _x
     Failure
     (Text, 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 Text Style
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Text
     (Text, Fallible Style)
forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue ODTReader Text Style
getStyleByName ArrowState
  (XMLConverterState Namespace ReaderState)
  Text
  (Text, Fallible Style)
-> ((Text, Fallible Style) -> Either Failure (Text, Style))
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     Text
     Failure
     (Text, Style)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (Text, Fallible Style) -> Either Failure (Text, Style)
liftE
  where
    liftE :: (StyleName, Fallible Style) -> Fallible (StyleName, Style)
    liftE :: (Text, Fallible Style) -> Either Failure (Text, Style)
liftE (Text
name, Right Style
v) = (Text, Style) -> Either Failure (Text, Style)
forall a b. b -> Either a b
Right (Text
name, Style
v)
    liftE (Text
_, Left Failure
v)     = Failure -> Either Failure (Text, Style)
forall a b. a -> Either a b
Left Failure
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 :: forall x. ODTReaderSafe x Inlines -> ODTReaderSafe x Inlines
withNewStyle ODTReaderSafe x Inlines
a = proc x
x -> do
  Either Failure (Text, Style)
fStyle <- ODTReader Failure (Text, Style)
forall _x. ODTReader _x (Text, Style)
readStyleByName -< ()
  case Either Failure (Text, Style)
fStyle of
    Right (Text
styleName, Style
_) | Text -> Bool
isCodeStyle Text
styleName -> do
      Inlines
inlines <- ODTReaderSafe x Inlines
a -< x
x
      (Inlines -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Inlines -> Inlines
inlineCode -<< Inlines
inlines
    Right (Text
_, Style
style) -> do
      Maybe StyleFamily
mFamily    <- (Style -> Maybe StyleFamily)
-> ODTReaderSafe Style (Maybe StyleFamily)
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Style -> Maybe StyleFamily
styleFamily -< Style
style
      Either Failure TextProperties
fTextProps <- (Style -> Either Failure TextProperties)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Style
     (Either Failure TextProperties)
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ( Maybe TextProperties -> Either Failure TextProperties
forall (a :: * -> * -> *) b.
ArrowChoice a =>
a (Maybe b) (Fallible b)
maybeToChoice
                        (Maybe TextProperties -> Either Failure TextProperties)
-> (Style -> Maybe TextProperties)
-> Style
-> Either Failure 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 Failure TextProperties
fTextProps of
        Right TextProperties
textProps -> do
          ReaderState
state        <- XMLConverter Namespace ReaderState Failure 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 b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
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 Failure Failure
forall x. ODTReaderSafe x x
popStyle       -< ()
                  (Inlines -> Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
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 Failure
_ -> ODTReaderSafe x Inlines
a -< x
x
        Left Failure
_     -> ODTReaderSafe x Inlines
a -< x
x
    Left Failure
_         -> ODTReaderSafe x Inlines
a -< x
x
  where
    isCodeStyle :: StyleName -> Bool
    isCodeStyle :: Text -> Bool
isCodeStyle Text
"Source_Text" = Bool
True
    isCodeStyle Text
_             = Bool
False

    inlineCode :: Inlines -> Inlines
    inlineCode :: Inlines -> Inlines
inlineCode = Text -> Inlines
code (Text -> Inlines) -> (Inlines -> Text) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> (Inlines -> [Text]) -> Inlines -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Text) -> [Inline] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> [Text]) -> (Inlines -> [Inline]) -> Inlines -> [Text]
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 b c d. (b -> c) -> (b, d) -> (c, d)
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 {b}. b -> (Bool, b) -> b
ifThen_else Inlines -> Inlines
ignore)
        [ ((ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasEmphChanged           , Inlines -> Inlines
emph      )
        , ((TextProperties -> Bool)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall {a}.
Eq a =>
(TextProperties -> a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged TextProperties -> Bool
isStrong      , Inlines -> Inlines
strong    )
        , ((TextProperties -> Maybe UnderlineMode)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall {a}.
Eq a =>
(TextProperties -> a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged TextProperties -> Maybe UnderlineMode
strikethrough , Inlines -> Inlines
strikeout )
        ]
  where
    ifThen_else :: b -> (Bool, b) -> b
ifThen_else b
else' (Bool
if',b
then') = if Bool
if' then b
then' else b
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 {a} {b}.
(TextProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
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 {a}.
Eq a =>
(TextProperties -> a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged  TextProperties -> Bool
isEmphasised
                               , (TextProperties -> Maybe FontPitch)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall {a}.
Eq a =>
(TextProperties -> Maybe a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChangedM TextProperties -> Maybe FontPitch
pitch
                               , (TextProperties -> Maybe UnderlineMode)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
forall {a}.
Eq a =>
(TextProperties -> a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged  TextProperties -> Maybe UnderlineMode
underline
                               ]

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

    hasChangedM :: (TextProperties -> Maybe a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChangedM TextProperties -> Maybe a
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
$ a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (a -> a -> Bool) -> Maybe a -> Maybe (a -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextProperties -> Maybe a
property TextProperties
textProps Maybe (a -> Bool) -> Maybe a -> Maybe Bool
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TextProperties -> Maybe a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Maybe a
forall {a} {b}.
(TextProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousValueM TextProperties -> Maybe a
property (ReaderState, TextProperties, Maybe StyleFamily)
triple

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

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

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


type ParaModifier = Blocks -> Blocks

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

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

    | PercentValue  Int
indent <- LengthOrPercent
mIndent
    ,  Int
indent          Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_
     = Bool
True
    | PercentValue  Int
margin <- LengthOrPercent
mMargin
    ,           Int
margin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_
     = Bool
True
    | PercentValue  Int
indent <- LengthOrPercent
mIndent
    , PercentValue  Int
margin <- LengthOrPercent
mMargin
     = Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
margin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
_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
  Either Failure (Text, Style)
fStyle <- ODTReader Blocks (Text, Style)
forall _x. ODTReader _x (Text, Style)
readStyleByName -< Blocks
blocks
  case Either Failure (Text, Style)
fStyle of
    Left   Failure
_    -> ODTReaderSafe Blocks Blocks
reader -< Blocks
blocks
    Right (Text
styleName, Style
_) | Text -> Bool
isTableCaptionStyle Text
styleName -> do
      Blocks
blocks' <- ODTReaderSafe Blocks Blocks
reader   -< Blocks
blocks
      ParaModifier -> ODTReaderSafe Blocks Blocks
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ParaModifier
tableCaptionP  -< Blocks
blocks'
    Right (Text
_, Style
style) -> do
      [StyleProperties]
props <- ([Style] -> Styles -> [StyleProperties])
-> ODTReaderSafe [Style] [StyleProperties]
forall a b. (a -> Styles -> b) -> ODTReaderSafe a b
fromStyles [Style] -> Styles -> [StyleProperties]
extendedStylePropertyChain -< [Style
style]
      let modifier :: ParaModifier
modifier = [StyleProperties] -> ParaModifier
getParaModifier [StyleProperties]
props
      Blocks
blocks' <- ODTReaderSafe Blocks Blocks
reader   -<  Blocks
blocks
      ParaModifier -> ODTReaderSafe Blocks Blocks
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ParaModifier
modifier        -<< Blocks
blocks'
  where
    isTableCaptionStyle :: StyleName -> Bool
    isTableCaptionStyle :: Text -> Bool
isTableCaptionStyle Text
"Table" = Bool
True
    isTableCaptionStyle Text
_       = Bool
False
    tableCaptionP :: ParaModifier
tableCaptionP Blocks
b = Attr -> ParaModifier
divWith (Text
"", [Text
"caption"], []) Blocks
b

type ListConstructor = [Blocks] -> Blocks

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

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

-- | Determines which style to use for a list, which level to use of that
-- style, and which type of list to create as a result of this information.
-- Then prepares the state for eventual child lists and constructs the list from
-- the results.
-- Two main cases are handled: The list may provide its own style or it may
-- rely on a parent list's style. 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 :: forall x. ODTReaderSafe x [Blocks] -> ODTReaderSafe x Blocks
constructList ODTReaderSafe x [Blocks]
reader = proc x
x -> do
  (ReaderState -> ReaderState) -> ODTReaderSafe Failure Failure
forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (Int -> ReaderState -> ReaderState
shiftListLevel Int
1)                                  -< ()
  Int
listLevel                    <- ODTReaderSafe Failure Int
forall _x. ODTReaderSafe _x Int
getCurrentListLevel                  -< ()
  Int
listContinuationStartCounter <- ODTReaderSafe Int Int
getPreviousListStartCounter          -< Int
listLevel
  Fallible Text
fStyleName                   <- Namespace
-> Text -> FallibleXMLConverter Namespace ReaderState Failure Text
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> FallibleXMLConverter nsID extraState x Text
findAttr Namespace
NsText Text
"style-name"         -< ()
  Fallible Text
fContNumbering               <- Namespace
-> Text -> FallibleXMLConverter Namespace ReaderState Failure Text
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> FallibleXMLConverter nsID extraState x Text
findAttr Namespace
NsText Text
"continue-numbering" -< ()
  Int
listItemCount                <- ODTReaderSafe x [Blocks]
reader ODTReaderSafe x [Blocks]
-> ([Blocks] -> Int)
-> ArrowState (XMLConverterState Namespace ReaderState) x Int
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ [Blocks] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length                    -< x
x

  let continueNumbering :: Bool
continueNumbering = case Fallible Text
fContNumbering of
                            Right Text
"true" -> Bool
True
                            Fallible Text
_            -> Bool
False

  let startNumForListLevelStyle :: Maybe ListLevelStyle -> Int
startNumForListLevelStyle = Bool -> Int -> Maybe ListLevelStyle -> Int
listStartingNumber Bool
continueNumbering Int
listContinuationStartCounter
  let defaultOrderedListConstructor :: ArrowState (XMLConverterState Namespace ReaderState) x Blocks
defaultOrderedListConstructor = Int
-> Int
-> Int
-> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructOrderedList (Maybe ListLevelStyle -> Int
startNumForListLevelStyle Maybe ListLevelStyle
forall a. Maybe a
Nothing) Int
listLevel Int
listItemCount

  case Fallible Text
fStyleName of
    Right Text
styleName -> do
      Fallible ListStyle
fListStyle <- ODTReader Text ListStyle
lookupListStyle -< Text
styleName
      case Fallible ListStyle
fListStyle of
        Right ListStyle
listStyle -> do
          Maybe ListLevelStyle
fListLevelStyle <- ((Int, ListStyle) -> Maybe ListLevelStyle)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Int, ListStyle)
     (Maybe ListLevelStyle)
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Int -> ListStyle -> Maybe ListLevelStyle)
-> (Int, ListStyle) -> Maybe ListLevelStyle
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> ListStyle -> Maybe ListLevelStyle
getListLevelStyle) -< (Int
listLevel, ListStyle
listStyle)
          case Maybe ListLevelStyle
fListLevelStyle of
            Just ListLevelStyle
listLevelStyle -> do
              let startNum :: Int
startNum = Maybe ListLevelStyle -> Int
startNumForListLevelStyle (Maybe ListLevelStyle -> Int) -> Maybe ListLevelStyle -> Int
forall a b. (a -> b) -> a -> b
$ ListLevelStyle -> Maybe ListLevelStyle
forall a. a -> Maybe a
Just ListLevelStyle
listLevelStyle
              Maybe ListStyle
oldListStyle <- ODTReaderSafe (Maybe ListStyle) (Maybe ListStyle)
switchCurrentListStyle                    -<  ListStyle -> Maybe ListStyle
forall a. a -> Maybe a
Just ListStyle
listStyle
              Blocks
blocks       <- ListLevelStyle
-> Int
-> Int
-> Int
-> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructListWith ListLevelStyle
listLevelStyle Int
startNum Int
listLevel Int
listItemCount -<< 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             -> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
defaultOrderedListConstructor -<< x
x
        Left Failure
_                  -> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
defaultOrderedListConstructor -<< x
x
    Left Failure
_ -> do
      ReaderState
state      <- XMLConverter Namespace ReaderState Failure 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 b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
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
fListLevelStyle <- ((Int, ListStyle) -> Maybe ListLevelStyle)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Int, ListStyle)
     (Maybe ListLevelStyle)
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Int -> ListStyle -> Maybe ListLevelStyle)
-> (Int, ListStyle) -> Maybe ListLevelStyle
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> ListStyle -> Maybe ListLevelStyle
getListLevelStyle) -< (Int
listLevel, ListStyle
listStyle)
          case Maybe ListLevelStyle
fListLevelStyle of
            Just ListLevelStyle
listLevelStyle -> do
              let startNum :: Int
startNum = Maybe ListLevelStyle -> Int
startNumForListLevelStyle (Maybe ListLevelStyle -> Int) -> Maybe ListLevelStyle -> Int
forall a b. (a -> b) -> a -> b
$ ListLevelStyle -> Maybe ListLevelStyle
forall a. a -> Maybe a
Just ListLevelStyle
listLevelStyle
              ListLevelStyle
-> Int
-> Int
-> Int
-> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructListWith ListLevelStyle
listLevelStyle Int
startNum Int
listLevel Int
listItemCount -<< x
x
            Maybe ListLevelStyle
Nothing             -> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
defaultOrderedListConstructor -<< x
x
        Maybe ListStyle
Nothing                 -> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
defaultOrderedListConstructor -<< x
x
  where
    listStartingNumber :: Bool -> Int -> Maybe ListLevelStyle -> Int
listStartingNumber Bool
continueNumbering Int
listContinuationStartCounter Maybe ListLevelStyle
mListLevelStyle
      | Bool
continueNumbering                = Int
listContinuationStartCounter
      | Maybe ListLevelStyle -> Bool
forall a. Maybe a -> Bool
isJust Maybe ListLevelStyle
mListLevelStyle           = ListLevelStyle -> Int
listItemStart (Maybe ListLevelStyle -> ListLevelStyle
forall a. HasCallStack => Maybe a -> a
fromJust Maybe ListLevelStyle
mListLevelStyle)
      | Bool
otherwise                        = Int
1
    constructOrderedList :: Int
-> Int
-> Int
-> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructOrderedList Int
startNum Int
listLevel Int
listItemCount =
          ODTReaderSafe x [Blocks]
reader
      ODTReaderSafe x [Blocks]
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
-> ArrowState (XMLConverterState Namespace ReaderState) 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 (Int -> ReaderState -> ReaderState
shiftListLevel (-Int
1))
      XMLConverter Namespace ReaderState [Blocks] [Blocks]
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] 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 (Int -> Int -> ReaderState -> ReaderState
modifyListContinuationStartCounter Int
listLevel (Int
startNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
listItemCount))
      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
>>^ ListAttributes -> ListConstructor
orderedListWith (Int
startNum, ListNumberStyle
DefaultStyle, ListNumberDelim
DefaultDelim)
    constructListWith :: ListLevelStyle
-> Int
-> Int
-> Int
-> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructListWith ListLevelStyle
listLevelStyle Int
startNum Int
listLevel Int
listItemCount =
          ODTReaderSafe x [Blocks]
reader
      ODTReaderSafe x [Blocks]
-> ArrowState
     (XMLConverterState Namespace ReaderState) [Blocks] Blocks
-> ArrowState (XMLConverterState Namespace ReaderState) 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 -> Int -> ListConstructor
getListConstructor ListLevelStyle
listLevelStyle Int
startNum
      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 (Int -> ReaderState -> ReaderState
shiftListLevel (-Int
1))
      ODTReaderSafe Blocks Blocks
-> ODTReaderSafe Blocks Blocks -> ODTReaderSafe Blocks 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) -> ODTReaderSafe Blocks Blocks
forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (Int -> Int -> ReaderState -> ReaderState
modifyListContinuationStartCounter Int
listLevel (Int
startNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
listItemCount))

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

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

type InlineMatcher = ElementMatcher Inlines

type BlockMatcher  = ElementMatcher Blocks

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

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

--
matchingElement :: (Monoid e)
                => Namespace -> ElementName
                -> ODTReaderSafe  e e
                -> ElementMatcher e
matchingElement :: forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
ns Text
name ODTReaderSafe e e
reader = (Namespace
ns, Text
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 :: forall (a :: * -> * -> *) m.
(ArrowChoice a, Monoid m) =>
a m m -> a m (Fallible m)
asResultAccumulator a m m
a = a m m -> FallibleArrow a m Failure m
forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess (a m m -> FallibleArrow a m Failure m)
-> a m m -> FallibleArrow a m Failure 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' :: forall result _x.
Monoid result =>
[ElementMatcher result] -> ODTReaderSafe _x result
matchChildContent' [ElementMatcher result]
ls = result
-> ArrowState (XMLConverterState Namespace ReaderState) _x result
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV result
forall a. Monoid a => a
mempty ArrowState (XMLConverterState Namespace ReaderState) _x result
-> ArrowState
     (XMLConverterState Namespace ReaderState) result result
-> ArrowState (XMLConverterState Namespace ReaderState) _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, Text, 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 :: forall result _x.
Monoid result =>
[ElementMatcher result]
-> ODTReaderSafe (result, Content) result
-> ODTReaderSafe _x result
matchChildContent [ElementMatcher result]
ls ODTReaderSafe (result, Content) result
fallback = result
-> ArrowState (XMLConverterState Namespace ReaderState) _x result
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV result
forall a. Monoid a => a
mempty ArrowState (XMLConverterState Namespace ReaderState) _x result
-> ArrowState
     (XMLConverterState Namespace ReaderState) result result
-> ArrowState (XMLConverterState Namespace ReaderState) _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, Text, 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 Text)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Inlines, Content)
     (Inlines, Fallible Text)
forall b c d.
ArrowState (XMLConverterState Namespace ReaderState) b c
-> ArrowState
     (XMLConverterState Namespace ReaderState) (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ( (Content -> Fallible Text)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Content (Fallible Text)
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Content -> Fallible Text
extractText )
                              ArrowState
  (XMLConverterState Namespace ReaderState)
  (Inlines, Content)
  (Inlines, Fallible Text)
-> ((Inlines, Fallible Text) -> Either Failure (Inlines, Inlines))
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Inlines, Content)
     (Either Failure (Inlines, Inlines))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ (Inlines, Fallible Text) -> Either Failure (Inlines, Text)
forall f a. (Inlines, Either f a) -> Either f (Inlines, a)
forall (v :: * -> *) f a.
ChoiceVector v =>
v (Either f a) -> Either f (v a)
spreadChoice ((Inlines, Fallible Text) -> Either Failure (Inlines, Text))
-> ((Inlines, Text) -> (Inlines, Inlines))
-> (Inlines, Fallible Text)
-> Either Failure (Inlines, Inlines)
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> a success success' -> FallibleArrow a x failure success'
>>?! (Text -> Inlines) -> (Inlines, Text) -> (Inlines, Inlines)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Inlines
text
                            )
                       ArrowState
  (XMLConverterState Namespace ReaderState)
  (Inlines, Content)
  (Either Failure (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 Text
extractText (XML.Text CData
cData) = Text -> Fallible Text
forall a _x. a -> Either _x a
succeedWith (CData -> Text
XML.cdData CData
cData)
    extractText         Content
_        = Fallible Text
forall failure _x. Monoid failure => Either failure _x
failEmpty

read_text_seq :: InlineMatcher
read_text_seq :: InlineMatcher
read_text_seq  = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"s" (
                          Namespace
-> Text -> Int -> XMLConverter Namespace ReaderState Inlines Int
forall nsID attrValue extraState x.
(NameSpaceID nsID, Read attrValue) =>
nsID
-> Text -> attrValue -> XMLConverter nsID extraState x attrValue
readAttrWithDefault Namespace
NsText Text
"c" Int
1 -- how many spaces?
                      XMLConverter Namespace ReaderState Inlines Int
-> (Int -> 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) -> (Int -> [Inline]) -> Int -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Inline -> [Inline]
forall a. Int -> a -> [a]
`replicate` Inline
Space)
                    )
--
read_line_break  :: InlineMatcher
read_line_break :: InlineMatcher
read_line_break   = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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_tab         :: InlineMatcher
read_tab :: InlineMatcher
read_tab          = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"tab"
                    (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
space
--
read_span        :: InlineMatcher
read_span :: InlineMatcher
read_span         = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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_tab
                                        , InlineMatcher
read_link
                                        , InlineMatcher
read_frame
                                        , 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 -> Text -> ODTReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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_tab
                                        , InlineMatcher
read_link
                                        , InlineMatcher
read_note
                                        , InlineMatcher
read_citation
                                        , InlineMatcher
read_bookmark
                                        , InlineMatcher
read_bookmark_start
                                        , InlineMatcher
read_reference_start
                                        , InlineMatcher
read_bookmark_ref
                                        , InlineMatcher
read_reference_ref
                                        , InlineMatcher
read_frame
                                        , InlineMatcher
read_text_seq
                                        ] ODTReaderSafe (Inlines, Content) Inlines
read_plain_text


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

--
read_header      :: BlockMatcher
read_header :: BlockMatcher
read_header       = Namespace -> Text -> ODTReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"h"
                    (ODTReaderSafe Blocks Blocks -> BlockMatcher)
-> ODTReaderSafe Blocks Blocks -> BlockMatcher
forall a b. (a -> b) -> a -> b
$  proc Blocks
blocks -> do
  Int
level    <- ( Namespace
-> Text -> Int -> XMLConverter Namespace ReaderState Blocks Int
forall nsID attrValue extraState x.
(NameSpaceID nsID, Read attrValue) =>
nsID
-> Text -> attrValue -> XMLConverter nsID extraState x attrValue
readAttrWithDefault Namespace
NsText Text
"outline-level" Int
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_tab
                                  , InlineMatcher
read_link
                                  , InlineMatcher
read_note
                                  , InlineMatcher
read_citation
                                  , InlineMatcher
read_bookmark
                                  , InlineMatcher
read_bookmark_start
                                  , InlineMatcher
read_reference_start
                                  , InlineMatcher
read_bookmark_ref
                                  , InlineMatcher
read_reference_ref
                                  , InlineMatcher
read_frame
                                  ] ODTReaderSafe (Inlines, Content) Inlines
read_plain_text
              ) -< Blocks
blocks
  Text
anchor   <- ODTReaderSafe Inlines Text
getHeaderAnchor -< Inlines
children
  let idAttr :: (Text, [a], [a])
idAttr = (Text
anchor, [], []) -- no classes, no key-value pairs
  ((Attr, Int, Inlines) -> Blocks)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Attr, Int, Inlines)
     Blocks
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Attr -> Int -> Inlines -> Blocks)
-> (Attr, Int, Inlines) -> Blocks
forall a b c z. (a -> b -> c -> z) -> (a, b, c) -> z
uncurry3 Attr -> Int -> Inlines -> Blocks
headerWith) -< (Attr
forall {a} {a}. (Text, [a], [a])
idAttr, Int
level, Inlines
children)

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

--
read_list        :: BlockMatcher
read_list :: BlockMatcher
read_list         = Namespace -> Text -> ODTReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"list"
                    (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
                    (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
                                         , ElementMatcher [Blocks]
read_list_header
                                         ]
--
read_list_item   :: ElementMatcher [Blocks]
read_list_item :: ElementMatcher [Blocks]
read_list_item    = Text -> ElementMatcher [Blocks]
read_list_element Text
"list-item"

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

read_list_element               :: ElementName -> ElementMatcher [Blocks]
read_list_element :: Text -> ElementMatcher [Blocks]
read_list_element Text
listElement   = Namespace
-> Text
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
-> ElementMatcher [Blocks]
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
listElement
                                  (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
                                                         , BlockMatcher
read_section
                                                         ]
                                    )

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

read_section :: ElementMatcher Blocks
read_section :: BlockMatcher
read_section = Namespace -> Text -> ODTReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"section"
                 (ODTReaderSafe Blocks Blocks -> BlockMatcher)
-> ODTReaderSafe Blocks Blocks -> BlockMatcher
forall a b. (a -> b) -> a -> b
$ ParaModifier
-> ODTReaderSafe Blocks Blocks -> ODTReaderSafe Blocks Blocks
forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA (Attr -> ParaModifier
divWith Attr
nullAttr)
                 (ODTReaderSafe Blocks Blocks -> ODTReaderSafe Blocks Blocks)
-> ODTReaderSafe Blocks Blocks -> ODTReaderSafe Blocks Blocks
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
                                      , BlockMatcher
read_header
                                      , BlockMatcher
read_list
                                      , BlockMatcher
read_table
                                      , BlockMatcher
read_section
                                      ]


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

read_link        :: InlineMatcher
read_link :: InlineMatcher
read_link         = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"a"
                    (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Inlines -> Inlines)
-> ODTReaderSafe Inlines Text
-> ODTReaderSafe Inlines Text
-> 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 Text -> Text -> Inlines -> Inlines
link
                      ( Namespace -> Text -> Text -> ODTReaderSafe Inlines Text
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState x Text
findAttrTextWithDefault Namespace
NsXLink  Text
"href"  Text
""
                        ODTReaderSafe Inlines Text
-> ArrowState (XMLConverterState Namespace ReaderState) Text Text
-> ODTReaderSafe Inlines Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text -> Text)
-> ArrowState (XMLConverterState Namespace ReaderState) Text Text
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Text -> Text
fixRelativeLink                              )
                      ( Namespace -> Text -> Text -> ODTReaderSafe Inlines Text
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState x Text
findAttrTextWithDefault Namespace
NsOffice Text
"title" Text
""          )
                      ( [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                  )

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

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

read_note        :: InlineMatcher
read_note :: InlineMatcher
read_note         = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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 -> Text -> ODTReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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
                      ( (Text -> Int -> [Citation])
-> ODTReaderSafe Inlines Text
-> XMLConverter Namespace ReaderState Inlines Int
-> 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 Text -> Int -> [Citation]
makeCitation
                        ( Namespace -> Text -> Text -> ODTReaderSafe Inlines Text
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState x Text
findAttrTextWithDefault Namespace
NsText Text
"identifier" Text
"" )
                        ( Namespace
-> Text -> Int -> XMLConverter Namespace ReaderState Inlines Int
forall nsID attrValue extraState x.
(NameSpaceID nsID, Read attrValue) =>
nsID
-> Text -> attrValue -> XMLConverter nsID extraState x attrValue
readAttrWithDefault Namespace
NsText Text
"number" Int
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 :: Text -> Int -> [Citation]
makeCitation Text
citeId Int
num = [Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Citation Text
citeId [] [] CitationMode
NormalCitation Int
num Int
0]


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

--
read_table        :: BlockMatcher
read_table :: BlockMatcher
read_table         = Namespace -> Text -> ODTReaderSafe Blocks Blocks -> BlockMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsTable Text
"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 a b. (a -> b) -> [a] -> [b]
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
-> Text
-> ODTReaderSafe [[Blocks]] [[Blocks]]
-> ElementMatcher [[Blocks]]
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsTable Text
"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
-> Text
-> XMLConverter Namespace ReaderState [Blocks] [Blocks]
-> ElementMatcher [Blocks]
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsTable Text
"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
                                          , BlockMatcher
read_list
                                          ]

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

--
read_frame :: InlineMatcher
read_frame :: InlineMatcher
read_frame = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsDraw Text
"frame"
             (ArrowState
   (XMLConverterState Namespace ReaderState) Inlines Inlines
 -> InlineMatcher)
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall a b. (a -> b) -> a -> b
$ Namespace
-> (Text -> Bool)
-> XMLConverter Namespace ReaderState Inlines [Element]
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> (Text -> Bool) -> XMLConverter nsID extraState x [Element]
filterChildrenName' Namespace
NsDraw (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"image", Text
"object", Text
"text-box"])
           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 b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr FirstMatch Inlines -> Inlines
forall m. Monoid m => FirstMatch m -> m
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 -> Text
elName Element
child of
    Text
"image"    -> ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_img      -< Element
child
    Text
"object"   -> ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_mathml   -< Element
child
    Text
"text-box" -> ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_text_box -< Element
child
    Text
_          -> FirstMatch Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Failure
     (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 Text
src <- XMLConverter Namespace ReaderState Element (Maybe Text)
-> XMLConverter Namespace ReaderState Element (Maybe Text)
forall nsID extraState s.
XMLConverter nsID extraState Element s
-> XMLConverter nsID extraState Element s
executeIn (Namespace
-> Text -> XMLConverter Namespace ReaderState Element (Maybe Text)
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState x (Maybe Text)
findAttr' Namespace
NsXLink Text
"href") -< Element
img
    case Maybe Text -> Text
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
src of
      Text
""   -> FirstMatch Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Failure
     (FirstMatch Inlines)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV FirstMatch Inlines
forall a. Monoid a => a
mempty -< ()
      Text
src' -> do
        let exts :: Extensions
exts = [Extension] -> Extensions
extensionsFromList [Extension
Ext_auto_identifiers]
        (FilePath, ByteString)
resource   <- ODTReaderSafe FilePath (FilePath, ByteString)
lookupResource                          -< Text -> FilePath
T.unpack Text
src'
        (FilePath, ByteString)
_          <- ODTReaderSafe (FilePath, ByteString) (FilePath, ByteString)
updateMediaWithResource                 -< (FilePath, ByteString)
resource
        Maybe Text
w          <- Namespace
-> Text -> XMLConverter Namespace ReaderState Failure (Maybe Text)
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState x (Maybe Text)
findAttrText' Namespace
NsSVG Text
"width"             -< ()
        Maybe Text
h          <- Namespace
-> Text -> XMLConverter Namespace ReaderState Failure (Maybe Text)
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState x (Maybe Text)
findAttrText' Namespace
NsSVG Text
"height"            -< ()
        Inlines
titleNodes <- [InlineMatcher] -> ODTReaderSafe Failure Inlines
forall result _x.
Monoid result =>
[ElementMatcher result] -> ODTReaderSafe _x result
matchChildContent' [ InlineMatcher
read_frame_title ] -< ()
        Inlines
alt        <- [InlineMatcher]
-> ODTReaderSafe (Inlines, Content) Inlines
-> ODTReaderSafe Failure Inlines
forall result _x.
Monoid result =>
[ElementMatcher result]
-> ODTReaderSafe (result, Content) result
-> ODTReaderSafe _x result
matchChildContent [] ODTReaderSafe (Inlines, Content) Inlines
read_plain_text    -< ()
        ((Attr, Text, Text, Inlines) -> FirstMatch Inlines)
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     (Attr, Text, Text, Inlines)
     (FirstMatch Inlines)
forall b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
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, Text, Text, Inlines) -> Inlines)
-> (Attr, Text, Text, Inlines)
-> FirstMatch Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> Text -> Text -> Inlines -> Inlines)
-> (Attr, Text, Text, Inlines) -> Inlines
forall a b c d z. (a -> b -> c -> d -> z) -> (a, b, c, d) -> z
uncurry4 Attr -> Text -> Text -> Inlines -> Inlines
imageWith)                 -<
          (Maybe Text -> Maybe Text -> Attr
image_attributes Maybe Text
w Maybe Text
h, Text
src', Extensions -> [Inline] -> Text
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
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsSVG Text
"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 Text -> Maybe Text -> Attr
image_attributes Maybe Text
x Maybe Text
y =
  ( Text
"", [], Text -> Maybe Text -> [(Text, Text)]
forall {b} {a}. (Eq b, IsString b) => a -> Maybe b -> [(a, b)]
dim Text
"width" Maybe Text
x [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text -> Maybe Text -> [(Text, Text)]
forall {b} {a}. (Eq b, IsString b) => a -> Maybe b -> [(a, b)]
dim Text
"height" Maybe Text
y)
  where
    dim :: a -> Maybe b -> [(a, b)]
dim a
_ (Just b
"")   = []
    dim a
name (Just b
v) = [(a
name, b
v)]
    dim a
_ Maybe b
Nothing     = []

read_frame_mathml :: ODTReaderSafe XML.Element (FirstMatch Inlines)
read_frame_mathml :: ArrowState
  (XMLConverterState Namespace ReaderState)
  Element
  (FirstMatch Inlines)
read_frame_mathml =
  proc Element
obj -> do
    Maybe Text
src <- XMLConverter Namespace ReaderState Element (Maybe Text)
-> XMLConverter Namespace ReaderState Element (Maybe Text)
forall nsID extraState s.
XMLConverter nsID extraState Element s
-> XMLConverter nsID extraState Element s
executeIn (Namespace
-> Text -> XMLConverter Namespace ReaderState Element (Maybe Text)
forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState x (Maybe Text)
findAttr' Namespace
NsXLink Text
"href") -< Element
obj
    case Maybe Text -> Text
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
src of
      Text
""   -> FirstMatch Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Failure
     (FirstMatch Inlines)
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV FirstMatch Inlines
forall a. Monoid a => a
mempty -< ()
      Text
src' -> do
        let path :: FilePath
path = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$
                    Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
src' (Text -> Text -> Maybe Text
T.stripPrefix Text
"./" Text
src') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/content.xml"
        (FilePath
_, ByteString
mathml) <- ODTReaderSafe FilePath (FilePath, ByteString)
lookupResource -< FilePath
path
        case Text -> Either Text [Exp]
readMathML (ByteString -> Text
UTF8.toText (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict ByteString
mathml) of
          Left Text
_     -> FirstMatch Inlines
-> ArrowState
     (XMLConverterState Namespace ReaderState)
     Failure
     (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 b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
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
. Text -> Inlines
displayMath (Text -> Inlines) -> ([Exp] -> Text) -> [Exp] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> Text
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 b c.
(b -> c)
-> ArrowState (XMLConverterState Namespace ReaderState) b c
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 (Text
src,Text
title)] : [Block]
_) =
  Inlines -> FirstMatch Inlines
forall a. a -> FirstMatch a
firstMatch (Inlines -> FirstMatch Inlines) -> Inlines -> FirstMatch Inlines
forall a b. (a -> b) -> a -> b
$ Inline -> Inlines
forall a. a -> Many a
singleton (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
alt (Text
src, Text
"fig:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
title))   -- no text, default caption
read_img_with_caption (Para (Image Attr
attr [Inline]
_ (Text
src,Text
title) : [Inline]
txt) : [Block]
_) =
  Inlines -> FirstMatch Inlines
forall a. a -> FirstMatch a
firstMatch (Inlines -> FirstMatch Inlines) -> Inlines -> FirstMatch Inlines
forall a b. (a -> b) -> a -> b
$ Inline -> Inlines
forall a. a -> Many a
singleton (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
txt (Text
src, Text
"fig:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
title) )  -- override caption with the text that follows
read_img_with_caption  ( Para (Inline
_ : [Inline]
xs) : [Block]
ys) =
  [Block] -> FirstMatch Inlines
read_img_with_caption ([Inline] -> Block
Para [Inline]
xs Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
ys)
read_img_with_caption [Block]
_ =
  FirstMatch Inlines
forall a. Monoid a => a
mempty

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

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

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

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


--
maybeAddAnchorFrom :: ODTReader Inlines AnchorPrefix
                   -> ODTReaderSafe Inlines Inlines
maybeAddAnchorFrom :: ODTReader Inlines Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom ODTReader Inlines Text
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 Text
anchorReader ODTReader Inlines Text
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     Text
     Failure
     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 Text Text
findAnchorName ODTReader Text Text
-> (Text -> Inlines)
-> FallibleArrow
     (ArrowState (XMLConverterState Namespace ReaderState))
     Text
     Failure
     Inlines
forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> (success -> success') -> FallibleArrow a x failure success'
>>?^ Text -> 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 Failure
_           -> ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Inlines
inlines
  where
    toAnchorElem :: Anchor -> Inlines
    toAnchorElem :: Text -> Inlines
toAnchorElem Text
anchorID = Attr -> Inlines -> Inlines
spanWith (Text
anchorID, [], []) Inlines
forall a. Monoid a => a
mempty
                            -- no classes, no key-value pairs

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

--
read_bookmark_start :: InlineMatcher
read_bookmark_start :: InlineMatcher
read_bookmark_start = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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 Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom (ODTReaderSafe Inlines Text -> ODTReader Inlines Text
forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess (ODTReaderSafe Inlines Text -> ODTReader Inlines Text)
-> ODTReaderSafe Inlines Text -> ODTReader Inlines Text
forall a b. (a -> b) -> a -> b
$ Text -> ODTReaderSafe Inlines Text
forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV Text
_ANCHOR_PREFIX_)

--
read_reference_start :: InlineMatcher
read_reference_start :: InlineMatcher
read_reference_start = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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 Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom ODTReader Inlines Text
forall _x. ODTReader _x Text
readAnchorAttr

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


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

--
read_bookmark_ref :: InlineMatcher
read_bookmark_ref :: InlineMatcher
read_bookmark_ref = Namespace
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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
-> Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
-> InlineMatcher
forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"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 :: forall _x. 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_section
                               , BlockMatcher
read_table
                               ]
            ODTReaderSafe _x Blocks
-> (Blocks -> Pandoc)
-> ArrowState (XMLConverterState Namespace ReaderState) _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 (Text
"", [Text
"caption"], [(Text, Text)]
_) [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 :: forall _x. ODTReader _x (Pandoc, MediaBag)
read_body = Namespace
-> Text
-> FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
-> FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
forall nsID extraState f s.
NameSpaceID nsID =>
nsID
-> Text
-> FallibleXMLConverter nsID extraState f s
-> FallibleXMLConverter nsID extraState f s
executeInSub Namespace
NsOffice Text
"body"
          (FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
 -> FallibleXMLConverter
      Namespace ReaderState _x (Pandoc, MediaBag))
-> FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
-> FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
forall a b. (a -> b) -> a -> b
$ Namespace
-> Text
-> FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
-> FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
forall nsID extraState f s.
NameSpaceID nsID =>
nsID
-> Text
-> FallibleXMLConverter nsID extraState f s
-> FallibleXMLConverter nsID extraState f s
executeInSub Namespace
NsOffice Text
"text"
          (FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
 -> FallibleXMLConverter
      Namespace ReaderState _x (Pandoc, MediaBag))
-> FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
-> FallibleXMLConverter Namespace ReaderState _x (Pandoc, MediaBag)
forall a b. (a -> b) -> a -> b
$ ArrowState
  (XMLConverterState Namespace ReaderState) _x (Pandoc, MediaBag)
-> FallibleXMLConverter Namespace ReaderState _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)
 -> FallibleXMLConverter
      Namespace ReaderState _x (Pandoc, MediaBag))
-> ArrowState
     (XMLConverterState Namespace ReaderState) _x (Pandoc, MediaBag)
-> FallibleXMLConverter Namespace ReaderState _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 Failure 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)