@@ -1,5 +1,7 @@
11{-# LANGUAGE NoImplicitPrelude #-}
22{-# LANGUAGE Arrows #-}
3+{-# LANGUAGE DeriveFoldable #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
35{-# LANGUAGE PatternGuards #-}
46{-# LANGUAGE RecordWildCards #-}
57{-# LANGUAGE TupleSections #-}
@@ -26,21 +28,26 @@ import Control.Applicative hiding (liftA, liftA2, liftA3)
2628import Control.Arrow
2729
2830import qualified Data.ByteString.Lazy as B
29−import Data.List (find, intercalate)
31+import Data.Foldable (fold)
32+import Data.List (find, intercalate, stripPrefix)
3033import qualified Data.Map as M
3134import Data.Maybe
35+import Data.Semigroup (First(..), Option(..))
3236
37+import Text.TeXMath (readMathML, writeTeX)
3338import qualified Text.XML.Light as XML
3439
3540import Text.Pandoc.Builder
3641import Text.Pandoc.MediaBag (MediaBag, insertMedia)
3742import Text.Pandoc.Shared
3843import Text.Pandoc.Extensions (extensionsFromList, Extension(..))
44+import qualified Text.Pandoc.UTF8 as UTF8
3945
4046import Text.Pandoc.Readers.Odt.Base
4147import Text.Pandoc.Readers.Odt.Namespaces
4248import Text.Pandoc.Readers.Odt.StyleReader
4349
50+import Text.Pandoc.Readers.Odt.Arrows.State (foldS)
4451import Text.Pandoc.Readers.Odt.Arrows.Utils
4552import Text.Pandoc.Readers.Odt.Generic.Fallible
4653import Text.Pandoc.Readers.Odt.Generic.Utils
@@ -498,6 +505,13 @@ type InlineMatcher = ElementMatcher Inlines
498505type BlockMatcher = ElementMatcher Blocks
499506
500507
508+newtype FirstMatch a = FirstMatch (Option (First a))
509+ deriving (Foldable, Monoid, Semigroup)
510+
511+firstMatch :: a -> FirstMatch a
512+firstMatch = FirstMatch . Option . Just . First
513+
514+
501515--
502516matchingElement :: (Monoid e)
503517 => Namespace -> ElementName
@@ -598,7 +612,7 @@ read_paragraph = matchingElement NsText "p"
598612 , read_reference_start
599613 , read_bookmark_ref
600614 , read_reference_ref
601− , read_maybe_nested_img_frame
615+ , read_frame
602616 , read_text_seq
603617 ] read_plain_text
604618
@@ -624,7 +638,7 @@ read_header = matchingElement NsText "h"
624638 , read_reference_start
625639 , read_bookmark_ref
626640 , read_reference_ref
627− , read_maybe_nested_img_frame
641+ , read_frame
628642 ] read_plain_text
629643 ) -< blocks
630644 anchor <- getHeaderAnchor -< children
@@ -737,32 +751,43 @@ read_table_cell = matchingElement NsTable "table-cell"
737751 ]
738752
739753----------------------
740−-- Images
754+-- Frames
741755----------------------
742756
743757--
744−read_maybe_nested_img_frame :: InlineMatcher
745−read_maybe_nested_img_frame = matchingElement NsDraw "frame"
746− $ proc blocks -> do
747− img <- (findChild' NsDraw "image") -< ()
748− case img of
749− Just _ -> read_frame -< blocks
750− Nothing -> matchChildContent' [ read_frame_text_box ] -< blocks
751−
752−read_frame :: OdtReaderSafe Inlines Inlines
753−read_frame =
754− proc blocks -> do
755− let exts = extensionsFromList [Ext_auto_identifiers]
756− w <- ( findAttr' NsSVG "width" ) -< ()
757− h <- ( findAttr' NsSVG "height" ) -< ()
758− titleNodes <- ( matchChildContent' [ read_frame_title ] ) -< blocks
759− src <- matchChildContent' [ read_image_src ] -< blocks
760− resource <- lookupResource -< src
761− _ <- updateMediaWithResource -< resource
762− alt <- (matchChildContent [] read_plain_text) -< blocks
763− arr (uncurry4 imageWith ) -<
764− (image_attributes w h, src,
765− inlineListToIdentifier exts (toList titleNodes), alt)
758+read_frame :: InlineMatcher
759+read_frame = matchingElement NsDraw "frame"
760+ $ filterChildrenName' NsDraw (`elem` ["image", "object", "text-box"])
761+ >>> foldS read_frame_child
762+ >>> arr fold
763+
764+read_frame_child :: OdtReaderSafe XML.Element (FirstMatch Inlines)
765+read_frame_child =
766+ proc child -> case elName child of
767+ "image" -> read_frame_img -< child
768+ "object" -> read_frame_mathml -< child
769+ "text-box" -> read_frame_text_box -< child
770+ _ -> returnV mempty -< ()
771+
772+read_frame_img :: OdtReaderSafe XML.Element (FirstMatch Inlines)
773+read_frame_img =
774+ proc img -> do
775+ src <- executeIn (findAttr' NsXLink "href") -< img
776+ case fold src of
777+ "" -> returnV mempty -< ()
778+ src' -> do
779+ let exts = extensionsFromList [Ext_auto_identifiers]
780+ resource <- lookupResource -< src'
781+ _ <- updateMediaWithResource -< resource
782+ w <- findAttr' NsSVG "width" -< ()
783+ h <- findAttr' NsSVG "height" -< ()
784+ titleNodes <- matchChildContent' [ read_frame_title ] -< ()
785+ alt <- matchChildContent [] read_plain_text -< ()
786+ arr (firstMatch . uncurry4 imageWith) -<
787+ (image_attributes w h, src', inlineListToIdentifier exts (toList titleNodes), alt)
788+
789+read_frame_title :: InlineMatcher
790+read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plain_text)
766791
767792image_attributes :: Maybe String -> Maybe String -> Attr
768793image_attributes x y =
@@ -772,28 +797,29 @@ image_attributes x y =
772797 dim name (Just v) = [(name, v)]
773798 dim _ Nothing = []
774799
775−read_image_src :: (Namespace, ElementName, OdtReader Anchor Anchor)
776−read_image_src = matchingElement NsDraw "image"
777− $ proc _ -> do
778− imgSrc <- findAttr NsXLink "href" -< ()
779− case imgSrc of
780− Right src -> returnV src -<< ()
781− Left _ -> returnV "" -< ()
782−
783−read_frame_title :: InlineMatcher
784−read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plain_text)
785−
786−read_frame_text_box :: InlineMatcher
787−read_frame_text_box = matchingElement NsDraw "text-box"
788− $ proc blocks -> do
789− paragraphs <- (matchChildContent' [ read_paragraph ]) -< blocks
790− arr read_img_with_caption -< toList paragraphs
791−
792−read_img_with_caption :: [Block] -> Inlines
800+read_frame_mathml :: OdtReaderSafe XML.Element (FirstMatch Inlines)
801+read_frame_mathml =
802+ proc obj -> do
803+ src <- executeIn (findAttr' NsXLink "href") -< obj
804+ case fold src of
805+ "" -> returnV mempty -< ()
806+ src' -> do
807+ let path = fromMaybe src' (stripPrefix "./" src') ++ "/content.xml"
808+ (_, mathml) <- lookupResource -< path
809+ case readMathML (UTF8.toString $ B.toStrict mathml) of
810+ Left _ -> returnV mempty -< ()
811+ Right exps -> arr (firstMatch . displayMath . writeTeX) -< exps
812+
813+read_frame_text_box :: OdtReaderSafe XML.Element (FirstMatch Inlines)
814+read_frame_text_box = proc box -> do
815+ paragraphs <- executeIn (matchChildContent' [ read_paragraph ]) -< box
816+ arr read_img_with_caption -< toList paragraphs
817+
818+read_img_with_caption :: [Block] -> FirstMatch Inlines
793819read_img_with_caption (Para [Image attr alt (src,title)] : _) =
794− singleton (Image attr alt (src, 'f':'i':'g':':':title)) -- no text, default caption
820+ firstMatch $ singleton (Image attr alt (src, 'f':'i':'g':':':title)) -- no text, default caption
795821read_img_with_caption (Para (Image attr _ (src,title) : txt) : _) =
796− singleton (Image attr txt (src, 'f':'i':'g':':':title) ) -- override caption with the text that follows
822+ firstMatch $ singleton (Image attr txt (src, 'f':'i':'g':':':title) ) -- override caption with the text that follows
797823read_img_with_caption ( Para (_ : xs) : ys) =
798824 read_img_with_caption (Para xs : ys)
799825read_img_with_caption _ =
@@ -901,8 +927,8 @@ post_process' (Table _ a w h r : Div ("", ["caption"], _) [Para inlines] : xs) =
901927post_process' bs = bs
902928
903929read_body :: OdtReader _x (Pandoc, MediaBag)
904−read_body = executeIn NsOffice "body"
905− $ executeIn NsOffice "text"
930+read_body = executeInSub NsOffice "body"
931+ $ executeInSub NsOffice "text"
906932 $ liftAsSuccess
907933 $ proc inlines -> do
908934 txt <- read_text -< inlines