{-# 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
                   -- | 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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ReaderState] -> ShowS
$cshowList :: [ReaderState] -> ShowS
show :: ReaderState -> FilePath
$cshow :: ReaderState -> FilePath
showsPrec :: Int -> ReaderState -> ShowS
$cshowsPrec :: Int -> ReaderState -> ShowS
Show )

readerState :: Styles -> Media -> ReaderState
readerState :: Styles -> Media -> ReaderState
readerState Styles
styles Media
media = Styles
-> [Style]
-> Int
-> Maybe ListStyle
-> Map Text Text
-> Media
-> MediaBag
-> ReaderState
ReaderState Styles
styles [] Int
0 forall a. Maybe a
Nothing forall k a. Map k a
M.empty Media
media forall a. Monoid a => a
mempty

--
pushStyle'  :: Style -> ReaderState -> ReaderState
pushStyle' :: Style -> ReaderState -> ReaderState
pushStyle' Style
style ReaderState
state = ReaderState
state { styleTrace :: [Style]
styleTrace = Style
style forall a. a -> [a] -> [a]
: ReaderState -> [Style]
styleTrace ReaderState
state }

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

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

--
shiftListLevel :: ListLevel -> (ReaderState -> ReaderState)
shiftListLevel :: Int -> ReaderState -> ReaderState
shiftListLevel Int
diff = (Int -> Int) -> ReaderState -> ReaderState
modifyListLevel (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 :: Maybe ListStyle
currentListStyle = Maybe ListStyle
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 Text Text
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Text Text
currentListStyle :: Maybe ListStyle
currentListLevel :: Int
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Text Text
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> Int
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..} = 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 Text Text
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Text Text
currentListStyle :: Maybe ListStyle
currentListLevel :: Int
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Text Text
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> Int
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..}
  = ReaderState
state { bookmarkAnchors :: Map Text Text
bookmarkAnchors = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ugly Text
pretty Map Text Text
bookmarkAnchors }

--
usedAnchors :: ReaderState -> [Anchor]
usedAnchors :: ReaderState -> [Text]
usedAnchors ReaderState{Int
Media
[Style]
Maybe ListStyle
Map Text Text
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Text Text
currentListStyle :: Maybe ListStyle
currentListLevel :: Int
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Text Text
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> Int
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..} = 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 Text Text
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Text Text
currentListStyle :: Maybe ListStyle
currentListLevel :: Int
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Text Text
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> Int
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..} = MediaBag
odtMediaBag

getMediaEnv :: ReaderState -> Media
getMediaEnv :: ReaderState -> Media
getMediaEnv ReaderState{Int
Media
[Style]
Maybe ListStyle
Map Text Text
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Text Text
currentListStyle :: Maybe ListStyle
currentListLevel :: Int
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Text Text
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> Int
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..} = 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 Text Text
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Text Text
currentListStyle :: Maybe ListStyle
currentListLevel :: Int
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Text Text
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> Int
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..}
  = ReaderState
state { odtMediaBag :: MediaBag
odtMediaBag = FilePath -> Maybe Text -> ByteString -> MediaBag -> MediaBag
insertMedia FilePath
fp forall a. Maybe a
Nothing ByteString
bs MediaBag
odtMediaBag }

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

type ODTReader      a b = XMLReader     ReaderState a b

type ODTReaderSafe  a b = XMLReaderSafe ReaderState a b

-- | Extract something from the styles
fromStyles :: (a -> Styles -> b) -> ODTReaderSafe a b
fromStyles :: forall a b. (a -> Styles -> b) -> ODTReaderSafe a b
fromStyles a -> Styles -> b
f =     forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue
                     (forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ReaderState -> Styles
styleSet)
               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 = forall a b. (a -> Styles -> b) -> ODTReaderSafe a b
fromStyles Text -> Styles -> Maybe Style
lookupStyle forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall (a :: * -> * -> *) b.
ArrowChoice a =>
a (Maybe b) (Fallible b)
maybeToChoice

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

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

--
switchCurrentListStyle :: ODTReaderSafe (Maybe ListStyle) (Maybe ListStyle)
switchCurrentListStyle :: ODTReaderSafe (Maybe ListStyle) (Maybe ListStyle)
switchCurrentListStyle =     forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState
                         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
                         forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall nsID extraState.
XMLConverter nsID extraState extraState extraState
setExtraState
                         forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a b. (a, b) -> b
snd

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

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

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

--
updateMediaWithResource :: ODTReaderSafe (FilePath, B.ByteString) (FilePath, B.ByteString)
updateMediaWithResource :: ODTReaderSafe (FilePath, ByteString) (FilePath, ByteString)
updateMediaWithResource = forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue (
                 (forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState
                  forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% (FilePath, ByteString) -> ReaderState -> ReaderState
insertMedia'
                  )
                 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall nsID extraState.
XMLConverter nsID extraState extraState extraState
setExtraState
               )
           forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ 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 <- forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState -< ()
    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
target (ReaderState -> Media
getMediaEnv ReaderState
state) of
      Just ByteString
bs -> forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV (FilePath
target, ByteString
bs) -<< ()
      Maybe ByteString
Nothing -> 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 forall a. Semigroup a => a -> a -> a
<> Text
"-" forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (forall a. Show a => a -> FilePath
show a
n)
  in  if Text
baseIdent forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
usedIdents
        then forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
baseIdent forall {a}. Show a => a -> Text
numIdent
             forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Int
x -> forall {a}. Show a => a -> Text
numIdent Int
x 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 <- forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState -< ()
  case Text -> ReaderState -> Maybe Text
lookupPrettyAnchor Text
uglyAnchor ReaderState
state of
    Just Text
prettyAnchor -> 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)
      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 <- 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 (forall a. Many a -> [a]
toList Inlines
title)
                (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ ReaderState -> [Text]
usedAnchors ReaderState
state)
  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 =
  forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> FallibleXMLConverter nsID extraState x Text
findAttr Namespace
NsText Text
"style-name" forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> FallibleArrow a success failure success'
-> FallibleArrow a x failure success'
>>? forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue ODTReader Text Style
getStyleByName 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) = forall a b. b -> Either a b
Right (Text
name, Style
v)
    liftE (Text
_, Left Failure
v)     = forall a b. a -> Either a b
Left Failure
v

--
isStyleToTrace :: ODTReader Style Bool
isStyleToTrace :: ODTReader Style Bool
isStyleToTrace = ODTReader Style StyleFamily
findStyleFamily forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> (success -> success') -> FallibleArrow a x failure success'
>>?^ (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 <- 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
      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    <- forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Style -> Maybe StyleFamily
styleFamily -< Style
style
      Either Failure TextProperties
fTextProps <- forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ( forall (a :: * -> * -> *) b.
ArrowChoice a =>
a (Maybe b) (Fallible b)
maybeToChoice
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleProperties -> Maybe TextProperties
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        <- 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     <- 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
                  forall x. ODTReaderSafe x x
popStyle       -< ()
                  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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Walkable Inline a => a -> Text
stringify forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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  =
  forall (cat :: * -> * -> *) (f :: * -> *) a.
(Category cat, Foldable f) =>
f (cat a a) -> cat a a
composition forall a b. (a -> b) -> a -> b
$
  (ReaderState, TextProperties, Maybe StyleFamily)
-> Inlines -> Inlines
getVPosModifier (ReaderState, TextProperties, Maybe StyleFamily)
propertyTriple
  forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a b. (a -> b) -> a -> b
$ (ReaderState, TextProperties, Maybe StyleFamily)
propertyTriple) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {b}. b -> (Bool, b) -> b
ifThen_else Inlines -> Inlines
ignore)
        [ ((ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasEmphChanged           , Inlines -> Inlines
emph      )
        , (forall {a}.
Eq a =>
(TextProperties -> a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged TextProperties -> Bool
isStrong      , Inlines -> Inlines
strong    )
        , (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 = 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 = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextProperties -> VerticalTextPosition
verticalPosition
        in  case 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 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 = forall a b c d. (((a -> b) -> b) -> c -> d) -> c -> a -> d
swing forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [ forall {a}.
Eq a =>
(TextProperties -> a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChanged  TextProperties -> Bool
isEmphasised
                               , forall {a}.
Eq a =>
(TextProperties -> Maybe a)
-> (ReaderState, TextProperties, Maybe StyleFamily) -> Bool
hasChangedM TextProperties -> Maybe FontPitch
pitch
                               , 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
_) =
        (forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just a
newProperty) (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
_) =
      forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> a -> Bool
(/=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextProperties -> Maybe a
property TextProperties
textProps forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall {a} {b}.
(StyleProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousStyleValue (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextProperties -> a
f 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 = forall {a} {b}.
(StyleProperties -> Maybe a)
-> (ReaderState, b, Maybe StyleFamily) -> Maybe a
lookupPreviousStyleValue (TextProperties -> Maybe a
f 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 Text Text
MediaBag
Styles
odtMediaBag :: MediaBag
envMedia :: Media
bookmarkAnchors :: Map Text Text
currentListStyle :: Maybe ListStyle
currentListLevel :: Int
styleTrace :: [Style]
styleSet :: Styles
odtMediaBag :: ReaderState -> MediaBag
envMedia :: ReaderState -> Media
bookmarkAnchors :: ReaderState -> Map Text Text
currentListStyle :: ReaderState -> Maybe ListStyle
currentListLevel :: ReaderState -> Int
styleTrace :: ReaderState -> [Style]
styleSet :: ReaderState -> Styles
..},b
_,Maybe StyleFamily
mFamily)
      =     forall a b. (a -> Maybe b) -> [a] -> Maybe b
findBy StyleProperties -> Maybe a
f ([Style] -> Styles -> [StyleProperties]
extendedStylePropertyChain [Style]
styleTrace Styles
styleSet)
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StyleProperties -> Maybe a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Styles -> StyleFamily -> StyleProperties
lookupDefaultStyle' Styles
styleSet 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 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StyleProperties -> Bool
isBlockQuote [StyleProperties]
props
                       = ParaModifier
blockQuote
                       | Bool
otherwise
                       = forall a. a -> a
id
  where
  isBlockQuote :: StyleProperties -> Bool
isBlockQuote SProps {Maybe ParaProperties
Maybe TextProperties
paraProperties :: StyleProperties -> Maybe ParaProperties
paraProperties :: Maybe ParaProperties
textProperties :: Maybe TextProperties
textProperties :: StyleProperties -> Maybe TextProperties
..} | 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          forall a. Ord a => a -> a -> Bool
> Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_
     = Bool
True
    | LengthValueMM Int
margin <- LengthOrPercent
mMargin
    ,           Int
margin 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 forall a. Num a => a -> a -> a
+ Int
margin forall a. Ord a => a -> a -> Bool
> Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_MM_

    | PercentValue  Int
indent <- LengthOrPercent
mIndent
    ,  Int
indent          forall a. Ord a => a -> a -> Bool
> Int
_MINIMUM_INDENTATION_FOR_BLOCKQUOTES_IN_PERCENT_
     = Bool
True
    | PercentValue  Int
margin <- LengthOrPercent
mMargin
    ,           Int
margin 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 forall a. Num a => a -> a -> a
+ Int
margin 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 <- 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
      forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ParaModifier
tableCaptionP  -< Blocks
blocks'
    Right (Text
_, Style
style) -> do
      [StyleProperties]
props <- 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
      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 -> ListConstructor
getListConstructor :: ListLevelStyle -> ListConstructor
getListConstructor ListLevelStyle{Int
Maybe Text
ListItemNumberFormat
ListLevelType
listItemStart :: ListLevelStyle -> Int
listItemFormat :: ListLevelStyle -> ListItemNumberFormat
listItemSuffix :: ListLevelStyle -> Maybe Text
listItemPrefix :: ListLevelStyle -> Maybe Text
listLevelType :: ListLevelStyle -> ListLevelType
listItemStart :: Int
listItemFormat :: ListItemNumberFormat
listItemSuffix :: Maybe Text
listItemPrefix :: Maybe Text
listLevelType :: ListLevelType
..} =
  case ListLevelType
listLevelType of
    ListLevelType
LltBullet   -> ListConstructor
bulletList
    ListLevelType
LltImage    -> ListConstructor
bulletList
    ListLevelType
LltNumbered -> let listNumberStyle :: ListNumberStyle
listNumberStyle = ListItemNumberFormat -> ListNumberStyle
toListNumberStyle ListItemNumberFormat
listItemFormat
                       listNumberDelim :: ListNumberDelim
listNumberDelim = 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
listItemStart, ListNumberStyle
listNumberStyle, ListNumberDelim
listNumberDelim)
  where
    toListNumberStyle :: ListItemNumberFormat -> ListNumberStyle
toListNumberStyle  ListItemNumberFormat
LinfNone      = ListNumberStyle
DefaultStyle
    toListNumberStyle  ListItemNumberFormat
LinfNumber    = ListNumberStyle
Decimal
    toListNumberStyle  ListItemNumberFormat
LinfRomanLC   = ListNumberStyle
LowerRoman
    toListNumberStyle  ListItemNumberFormat
LinfRomanUC   = ListNumberStyle
UpperRoman
    toListNumberStyle  ListItemNumberFormat
LinfAlphaLC   = ListNumberStyle
LowerAlpha
    toListNumberStyle  ListItemNumberFormat
LinfAlphaUC   = ListNumberStyle
UpperAlpha
    toListNumberStyle (LinfString 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
  forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (Int -> ReaderState -> ReaderState
shiftListLevel Int
1)        -< ()
  Int
listLevel  <- forall _x. ODTReaderSafe _x Int
getCurrentListLevel          -< ()
  Fallible Text
fStyleName <- forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> FallibleXMLConverter nsID extraState x Text
findAttr Namespace
NsText Text
"style-name" -< ()
  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
fLLS <- forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> ListStyle -> Maybe ListLevelStyle
getListLevelStyle) -< (Int
listLevel,ListStyle
listStyle)
          case Maybe ListLevelStyle
fLLS of
            Just ListLevelStyle
listLevelStyle -> do
              Maybe ListStyle
oldListStyle <- ODTReaderSafe (Maybe ListStyle) (Maybe ListStyle)
switchCurrentListStyle           -<  forall a. a -> Maybe a
Just ListStyle
listStyle
              Blocks
blocks       <- ListLevelStyle
-> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructListWith ListLevelStyle
listLevelStyle -<< x
x
              ODTReaderSafe (Maybe ListStyle) (Maybe ListStyle)
switchCurrentListStyle                           -<  Maybe ListStyle
oldListStyle
              forall (a :: * -> * -> *) b. Arrow a => a b b
returnA                                          -<  Blocks
blocks
            Maybe ListLevelStyle
Nothing             -> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructOrderedList        -< x
x
        Left Failure
_                  -> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructOrderedList        -< x
x
    Left Failure
_ -> do
      ReaderState
state      <- forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState        -< ()
      Maybe ListStyle
mListStyle <- forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ReaderState -> Maybe ListStyle
currentListStyle -< ReaderState
state
      case Maybe ListStyle
mListStyle of
        Just ListStyle
listStyle -> do
          Maybe ListLevelStyle
fLLS <- forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> ListStyle -> Maybe ListLevelStyle
getListLevelStyle) -< (Int
listLevel,ListStyle
listStyle)
          case Maybe ListLevelStyle
fLLS of
            Just ListLevelStyle
listLevelStyle -> ListLevelStyle
-> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructListWith ListLevelStyle
listLevelStyle -<< x
x
            Maybe ListLevelStyle
Nothing             -> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructOrderedList             -<  x
x
        Maybe ListStyle
Nothing                 -> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructOrderedList             -<  x
x
  where
    constructOrderedList :: ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructOrderedList =
          ODTReaderSafe x [Blocks]
reader
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (Int -> ReaderState -> ReaderState
shiftListLevel (-Int
1))
      forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ ListConstructor
orderedList
    constructListWith :: ListLevelStyle
-> ArrowState (XMLConverterState Namespace ReaderState) x Blocks
constructListWith ListLevelStyle
listLevelStyle =
          ODTReaderSafe x [Blocks]
reader
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ListLevelStyle -> ListConstructor
getListConstructor ListLevelStyle
listLevelStyle
      forall (a :: * -> * -> *) b c d.
Arrow a =>
(b -> c) -> a c d -> a b d
^>> forall extraState nsID x.
(extraState -> extraState) -> XMLConverter nsID extraState x x
modifyExtraState (Int -> ReaderState -> ReaderState
shiftListLevel (-Int
1))

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

firstMatch :: a -> FirstMatch a
firstMatch :: forall a. a -> FirstMatch a
firstMatch = forall a. Alt Maybe a -> FirstMatch a
FirstMatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, 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 = forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue a m m
a forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% 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 = forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV forall a. Monoid a => a
mempty forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> 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 = forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV forall a. Monoid a => a
mempty forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> 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 =  forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c c'.
Arrow a =>
(b -> c) -> a b c' -> a b (c, c')
^&&& ODTReader (Inlines, Content) Inlines
read_plain_text' forall (a :: * -> * -> *) x b c d.
Arrow a =>
a x (b, c) -> (b -> c -> d) -> a x d
>>% forall a _f. a -> Either _f a -> a
recover
  where
    -- fallible version
    read_plain_text' :: ODTReader (Inlines, XML.Content) Inlines
    read_plain_text' :: ODTReader (Inlines, Content) Inlines
read_plain_text' =      (     forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ( forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Content -> Fallible Text
extractText )
                              forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall (v :: * -> *) f a.
ChoiceVector v =>
v (Either f a) -> Either f (v a)
spreadChoice forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> a success success' -> FallibleArrow a x failure success'
>>?! forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Inlines
text
                            )
                       forall (a :: * -> * -> *) x f b b' c.
ArrowChoice a =>
FallibleArrow a x f (b, b')
-> (b -> b' -> c) -> FallibleArrow a x f c
>>?% forall a. Monoid a => a -> a -> a
mappend
    --
    extractText     :: XML.Content -> Fallible T.Text
    extractText :: Content -> Fallible Text
extractText (XML.Text CData
cData) = forall a _x. a -> Either _x a
succeedWith (CData -> Text
XML.cdData CData
cData)
    extractText         Content
_        = forall failure _x. Monoid failure => Either failure _x
failEmpty

read_text_seq :: InlineMatcher
read_text_seq :: InlineMatcher
read_text_seq  = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"sequence"
                 forall a b. (a -> b) -> a -> b
$ 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       = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"s" (
                          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?
                      forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ forall a. [a] -> Many a
fromListforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. Int -> a -> [a]
`replicate` Inline
Space)
                    )
--
read_line_break  :: InlineMatcher
read_line_break :: InlineMatcher
read_line_break   = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"line-break"
                    forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV Inlines
linebreak
--
read_tab         :: InlineMatcher
read_tab :: InlineMatcher
read_tab          = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"tab"
                    forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV Inlines
space
--
read_span        :: InlineMatcher
read_span :: InlineMatcher
read_span         = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"span"
                    forall a b. (a -> b) -> a -> b
$ forall x. ODTReaderSafe x Inlines -> ODTReaderSafe x Inlines
withNewStyle
                    forall a b. (a -> b) -> a -> b
$ 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    = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"p"
                    forall a b. (a -> b) -> a -> b
$ ODTReaderSafe Blocks Blocks -> ODTReaderSafe Blocks Blocks
constructPara
                    forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA Inlines -> Blocks
para
                    forall a b. (a -> b) -> a -> b
$ forall x. ODTReaderSafe x Inlines -> ODTReaderSafe x Inlines
withNewStyle
                    forall a b. (a -> b) -> a -> b
$ 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       = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"h"
                    forall a b. (a -> b) -> a -> b
$  proc Blocks
blocks -> do
  Int
level    <- ( 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 <- ( 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
  forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b c z. (a -> b -> c -> z) -> (a, b, c) -> z
uncurry3 Attr -> Int -> Inlines -> Blocks
headerWith) -< (forall {a} {a}. (Text, [a], [a])
idAttr, Int
level, Inlines
children)

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

--
read_list        :: BlockMatcher
read_list :: BlockMatcher
read_list         = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"list"
--                  $ withIncreasedListLevel
                    forall a b. (a -> b) -> a -> b
$ forall x. ODTReaderSafe x [Blocks] -> ODTReaderSafe x Blocks
constructList
--                  $ liftA bulletList
                    forall a b. (a -> b) -> a -> b
$ 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   = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
listElement
                                  forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA ([Blocks] -> [Blocks]
compactifyforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. a -> [a] -> [a]
:[]))
                                    ( 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 = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"section"
                 forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA (Attr -> ParaModifier
divWith Attr
nullAttr)
                 forall a b. (a -> b) -> a -> b
$ 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         = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"a"
                    forall a b. (a -> b) -> a -> b
$ 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
                      ( forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState x Text
findAttrTextWithDefault Namespace
NsXLink  Text
"href"  Text
""
                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Text -> Text
fixRelativeLink                              )
                      ( forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState x Text
findAttrTextWithDefault Namespace
NsOffice Text
"title" Text
""          )
                      ( 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 -> forall {a}. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ URI
u{ uriPath :: FilePath
uriPath = FilePath
xs }
          FilePath
_ -> Text
uri

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

read_note        :: InlineMatcher
read_note :: InlineMatcher
read_note         = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"note"
                    forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA Blocks -> Inlines
note
                    forall a b. (a -> b) -> a -> b
$ 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    = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"note-body"
                    forall a b. (a -> b) -> a -> b
$ forall result _x.
Monoid result =>
[ElementMatcher result] -> ODTReaderSafe _x result
matchChildContent' [ BlockMatcher
read_paragraph ]

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

read_citation    :: InlineMatcher
read_citation :: InlineMatcher
read_citation     = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"bibliography-mark"
                    forall a b. (a -> b) -> a -> b
$ 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
                      ( 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
                        ( forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> Text -> XMLConverter nsID extraState x Text
findAttrTextWithDefault Namespace
NsText Text
"identifier" Text
"" )
                        ( forall nsID attrValue extraState x.
(NameSpaceID nsID, Read attrValue) =>
nsID
-> Text -> attrValue -> XMLConverter nsID extraState x attrValue
readAttrWithDefault Namespace
NsText Text
"number" Int
0          )
                      )
                      ( 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         = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsTable Text
"table"
                     forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA [[Blocks]] -> Blocks
simpleTable'
                     forall a b. (a -> b) -> a -> b
$ 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const forall {a}. Many a
defaults) [Blocks]
x) ([Blocks]
x forall a. a -> [a] -> [a]
: [[Blocks]]
rest)
  where defaults :: Many a
defaults = forall a. [a] -> Many a
fromList []

--
read_table_row    :: ElementMatcher [[Blocks]]
read_table_row :: ElementMatcher [[Blocks]]
read_table_row     = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsTable Text
"table-row"
                     forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA (forall a. a -> [a] -> [a]
:[])
                     forall a b. (a -> b) -> a -> b
$ 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    = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsTable Text
"table-cell"
                     forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) y z b.
Arrow a =>
(y -> z) -> a b y -> a b z
liftA ([Blocks] -> [Blocks]
compactifyforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. a -> [a] -> [a]
:[]))
                     forall a b. (a -> b) -> a -> b
$ 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 = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsDraw Text
"frame"
             forall a b. (a -> b) -> a -> b
$ forall nsID extraState x.
NameSpaceID nsID =>
nsID -> (Text -> Bool) -> XMLConverter nsID extraState x [Element]
filterChildrenName' Namespace
NsDraw (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"image", Text
"object", Text
"text-box"])
           forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) m s x.
(Foldable f, Monoid m) =>
ArrowState s x m -> ArrowState s (f x) m
foldS ODTReaderSafe Element (FirstMatch Inlines)
read_frame_child
           forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

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

read_frame_img :: ODTReaderSafe XML.Element (FirstMatch Inlines)
read_frame_img :: ODTReaderSafe Element (FirstMatch Inlines)
read_frame_img =
  proc Element
img -> do
    Maybe Text
src <- forall nsID extraState s.
XMLConverter nsID extraState Element s
-> XMLConverter nsID extraState Element s
executeIn (forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState x (Maybe Text)
findAttr' Namespace
NsXLink Text
"href") -< Element
img
    case forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
src of
      Text
""   -> forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV 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          <- forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState x (Maybe Text)
findAttrText' Namespace
NsSVG Text
"width"             -< ()
        Maybe Text
h          <- forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState x (Maybe Text)
findAttrText' Namespace
NsSVG Text
"height"            -< ()
        Inlines
titleNodes <- forall result _x.
Monoid result =>
[ElementMatcher result] -> ODTReaderSafe _x result
matchChildContent' [ InlineMatcher
read_frame_title ] -< ()
        Inlines
alt        <- forall result _x.
Monoid result =>
[ElementMatcher result]
-> ODTReaderSafe (result, Content) result
-> ODTReaderSafe _x result
matchChildContent [] ODTReaderSafe (Inlines, Content) Inlines
read_plain_text    -< ()
        forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. a -> FirstMatch a
firstMatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a. Many a -> [a]
toList Inlines
titleNodes), Inlines
alt)

read_frame_title :: InlineMatcher
read_frame_title :: InlineMatcher
read_frame_title = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsSVG Text
"title" (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
"", [], forall {b} {a}. (Eq b, IsString b) => a -> Maybe b -> [(a, b)]
dim Text
"width" Maybe Text
x forall a. [a] -> [a] -> [a]
++ 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 :: ODTReaderSafe Element (FirstMatch Inlines)
read_frame_mathml =
  proc Element
obj -> do
    Maybe Text
src <- forall nsID extraState s.
XMLConverter nsID extraState Element s
-> XMLConverter nsID extraState Element s
executeIn (forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> XMLConverter nsID extraState x (Maybe Text)
findAttr' Namespace
NsXLink Text
"href") -< Element
obj
    case forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
src of
      Text
""   -> forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV forall a. Monoid a => a
mempty -< ()
      Text
src' -> do
        let path :: FilePath
path = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$
                    forall a. a -> Maybe a -> a
fromMaybe Text
src' (Text -> Text -> Maybe Text
T.stripPrefix Text
"./" Text
src') 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 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict ByteString
mathml) of
          Left Text
_     -> forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
returnV forall a. Monoid a => a
mempty -< ()
          Right [Exp]
exps -> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. a -> FirstMatch a
firstMatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
displayMath 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 :: ODTReaderSafe Element (FirstMatch Inlines)
read_frame_text_box = proc Element
box -> do
    Blocks
paragraphs <- forall nsID extraState s.
XMLConverter nsID extraState Element s
-> XMLConverter nsID extraState Element s
executeIn (forall result _x.
Monoid result =>
[ElementMatcher result] -> ODTReaderSafe _x result
matchChildContent' [ BlockMatcher
read_paragraph ]) -< Element
box
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr [Block] -> FirstMatch Inlines
read_img_with_caption -< 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]
_) =
  forall a. a -> FirstMatch a
firstMatch forall a b. (a -> b) -> a -> b
$ forall a. a -> Many a
singleton (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
alt (Text
src, Text
"fig:" 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]
_) =
  forall a. a -> FirstMatch a
firstMatch forall a b. (a -> b) -> a -> b
$ forall a. a -> Many a
singleton (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
txt (Text
src, Text
"fig:" 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 forall a. a -> [a] -> [a]
: [Block]
ys)
read_img_with_caption [Block]
_ =
  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 = 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 = (      forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue forall _x. ODTReader _x Text
readAnchorAttr
                   forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^  forall (v :: * -> *) f a.
ChoiceVector v =>
v (Either f a) -> Either f (v a)
spreadChoice
                 ) 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 =
  forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
keepingTheValue (ODTReader Inlines Text
anchorReader 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 forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> (success -> success') -> FallibleArrow a x failure success'
>>?^ Text -> Inlines
toAnchorElem)
  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 -> forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Inlines
anchorElem
    Left Failure
_           -> 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, [], []) forall a. Monoid a => a
mempty
                            -- no classes, no key-value pairs

--
read_bookmark     :: InlineMatcher
read_bookmark :: InlineMatcher
read_bookmark      = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"bookmark"
                     forall a b. (a -> b) -> a -> b
$ ODTReader Inlines Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom (forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess forall a b. (a -> b) -> a -> b
$ 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 = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"bookmark-start"
                     forall a b. (a -> b) -> a -> b
$ ODTReader Inlines Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom (forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess forall a b. (a -> b) -> a -> b
$ 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 = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"reference-mark-start"
                     forall a b. (a -> b) -> a -> b
$ ODTReader Inlines Text
-> ArrowState
     (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeAddAnchorFrom forall _x. ODTReader _x Text
readAnchorAttr

-- | Beware: may fail
findAnchorRef :: ODTReader _x Anchor
findAnchorRef :: forall _x. ODTReader _x Text
findAnchorRef = (      forall nsID extraState x.
NameSpaceID nsID =>
nsID -> Text -> FallibleXMLConverter nsID extraState x Text
findAttrText Namespace
NsText Text
"ref-name"
                  forall (a :: * -> * -> *) x failure success success'.
ArrowChoice a =>
FallibleArrow a x failure success
-> (success -> success') -> FallibleArrow a x failure success'
>>?^ (Text
_ANCHOR_PREFIX_,)
                ) 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 <- forall _x. ODTReader _x Text
findAnchorRef -< ()
  case Fallible Text
fRef of
    Right Text
anchor ->
      forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Text -> Inlines -> Inlines
toAnchorRef Text
anchor) -<< Inlines
inlines
    Left Failure
_ -> 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
"#" forall a. Semigroup a => a -> a -> a
<> Text
anchor) Text
"" -- no title

--
read_bookmark_ref :: InlineMatcher
read_bookmark_ref :: InlineMatcher
read_bookmark_ref = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"bookmark-ref"
                    forall a b. (a -> b) -> a -> b
$    ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeInAnchorRef
                     forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< 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 = forall e.
Monoid e =>
Namespace -> Text -> ODTReaderSafe e e -> ElementMatcher e
matchingElement Namespace
NsText Text
"reference-ref"
                    forall a b. (a -> b) -> a -> b
$    ArrowState
  (XMLConverterState Namespace ReaderState) Inlines Inlines
maybeInAnchorRef
                     forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< 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 = 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
                               ]
            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 forall a. Maybe a
Nothing [Block]
blks) [ColSpec]
specs TableHead
th [TableBody]
tb TableFoot
tf 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 = forall nsID extraState f s.
NameSpaceID nsID =>
nsID
-> Text
-> FallibleXMLConverter nsID extraState f s
-> FallibleXMLConverter nsID extraState f s
executeInSub Namespace
NsOffice Text
"body"
          forall a b. (a -> b) -> a -> b
$ forall nsID extraState f s.
NameSpaceID nsID =>
nsID
-> Text
-> FallibleXMLConverter nsID extraState f s
-> FallibleXMLConverter nsID extraState f s
executeInSub Namespace
NsOffice Text
"text"
          forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) x success failure.
ArrowChoice a =>
a x success -> FallibleArrow a x failure success
liftAsSuccess
          forall a b. (a -> b) -> a -> b
$ proc _x
inlines -> do
             Pandoc
txt   <- forall _x. ODTReaderSafe _x Pandoc
read_text     -< _x
inlines
             ReaderState
state <- forall nsID extraState x. XMLConverter nsID extraState x extraState
getExtraState -< ()
             forall (a :: * -> * -> *) b. Arrow a => a b b
returnA                -< (Pandoc -> Pandoc
post_process Pandoc
txt, ReaderState -> MediaBag
getMediaBag ReaderState
state)