diff options
Diffstat (limited to 'src/Text/Pandoc/Readers/Odt/ContentReader.hs')
| -rw-r--r-- | src/Text/Pandoc/Readers/Odt/ContentReader.hs | 83 |
1 files changed, 38 insertions, 45 deletions
diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index 2672b01ef..380f16c66 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -1,8 +1,8 @@ {-# LANGUAGE Arrows #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE PatternGuards #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} {- Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com> @@ -39,29 +39,28 @@ module Text.Pandoc.Readers.Odt.ContentReader , read_body ) where -import Control.Arrow -import Control.Applicative hiding ( liftA, liftA2, liftA3 ) +import Control.Applicative hiding (liftA, liftA2, liftA3) +import Control.Arrow -import qualified Data.ByteString.Lazy as B -import qualified Data.Map as M -import Data.List ( find, intercalate ) -import Data.Maybe +import qualified Data.ByteString.Lazy as B +import Data.List (find, intercalate) +import qualified Data.Map as M +import Data.Maybe -import qualified Text.XML.Light as XML +import qualified Text.XML.Light as XML -import Text.Pandoc.Definition -import Text.Pandoc.Builder -import Text.Pandoc.MediaBag (insertMedia, MediaBag) -import Text.Pandoc.Shared +import Text.Pandoc.Builder +import Text.Pandoc.MediaBag (MediaBag, insertMedia) +import Text.Pandoc.Shared -import Text.Pandoc.Readers.Odt.Base -import Text.Pandoc.Readers.Odt.Namespaces -import Text.Pandoc.Readers.Odt.StyleReader +import Text.Pandoc.Readers.Odt.Base +import Text.Pandoc.Readers.Odt.Namespaces +import Text.Pandoc.Readers.Odt.StyleReader -import Text.Pandoc.Readers.Odt.Arrows.Utils -import Text.Pandoc.Readers.Odt.Generic.XMLConverter -import Text.Pandoc.Readers.Odt.Generic.Fallible -import Text.Pandoc.Readers.Odt.Generic.Utils +import Text.Pandoc.Readers.Odt.Arrows.Utils +import Text.Pandoc.Readers.Odt.Generic.Fallible +import Text.Pandoc.Readers.Odt.Generic.Utils +import Text.Pandoc.Readers.Odt.Generic.XMLConverter import qualified Data.Set as Set @@ -94,8 +93,6 @@ data ReaderState , envMedia :: Media -- | Hold binary resources used in the document , odtMediaBag :: MediaBag --- , sequences --- , trackedChangeIDs } deriving ( Show ) @@ -250,7 +247,7 @@ getPrettyAnchor = proc (baseIdent, uglyAnchor) -> do modifyExtraState (putPrettyAnchor uglyAnchor newPretty) -<< newPretty -- | Input: basis for a new header anchor --- Ouput: saved new anchor +-- Output: saved new anchor getHeaderAnchor :: OdtReaderSafe Inlines Anchor getHeaderAnchor = proc title -> do state <- getExtraState -< () @@ -296,7 +293,7 @@ withNewStyle a = proc x -> do modifier <- arr modifierFromStyleDiff -< triple fShouldTrace <- isStyleToTrace -< style case fShouldTrace of - Right shouldTrace -> do + Right shouldTrace -> if shouldTrace then do pushStyle -< style @@ -325,7 +322,7 @@ type InlineModifier = Inlines -> Inlines modifierFromStyleDiff :: PropertyTriple -> InlineModifier modifierFromStyleDiff propertyTriple = composition $ - (getVPosModifier propertyTriple) + getVPosModifier propertyTriple : map (first ($ propertyTriple) >>> ifThen_else ignore) [ (hasEmphChanged , emph ) , (hasChanged isStrong , strong ) @@ -344,9 +341,9 @@ modifierFromStyleDiff propertyTriple = Just oldVPos -> getVPosModifier' (oldVPos, verticalPosition textProps) getVPosModifier' (oldVPos , newVPos ) | oldVPos == newVPos = ignore - getVPosModifier' ( _ , VPosSub ) = subscript - getVPosModifier' ( _ , VPosSuper ) = superscript - getVPosModifier' ( _ , _ ) = ignore + getVPosModifier' ( _ , VPosSub ) = subscript + getVPosModifier' ( _ , VPosSuper ) = superscript + getVPosModifier' ( _ , _ ) = ignore hasEmphChanged :: PropertyTriple -> Bool hasEmphChanged = swing any [ hasChanged isEmphasised @@ -355,17 +352,17 @@ modifierFromStyleDiff propertyTriple = ] hasChanged property triple@(_, property -> newProperty, _) = - maybe True (/=newProperty) (lookupPreviousValue property triple) + (/= Just newProperty) (lookupPreviousValue property triple) hasChangedM property triple@(_, textProps,_) = fromMaybe False $ (/=) <$> property textProps <*> lookupPreviousValueM property triple - lookupPreviousValue f = lookupPreviousStyleValue ((fmap f).textProperties) + lookupPreviousValue f = lookupPreviousStyleValue (fmap f . textProperties) lookupPreviousValueM f = lookupPreviousStyleValue ((f =<<).textProperties) lookupPreviousStyleValue f (ReaderState{..},_,mFamily) - = ( findBy f $ extendedStylePropertyChain styleTrace styleSet ) + = findBy f (extendedStylePropertyChain styleTrace styleSet) <|> ( f =<< fmap (lookupDefaultStyle' styleSet) mFamily ) @@ -569,7 +566,7 @@ read_text_seq = matchingElement NsText "sequence" -- specifically. I honor that, although the current implementation of '(<>)' --- for 'Inlines' in "Text.Pandoc.Builder" will collaps them agein. +-- for 'Inlines' in "Text.Pandoc.Builder" will collapse them again. -- The rational is to be prepared for future modifications. read_spaces :: InlineMatcher read_spaces = matchingElement NsText "s" ( @@ -663,7 +660,7 @@ read_list = matchingElement NsText "list" -- read_list_item :: ElementMatcher [Blocks] read_list_item = matchingElement NsText "list-item" - $ liftA (compactify'.(:[])) + $ liftA (compactify.(:[])) ( matchChildContent' [ read_paragraph , read_header , read_list @@ -749,7 +746,7 @@ read_table_row = matchingElement NsTable "table-row" -- read_table_cell :: ElementMatcher [Blocks] read_table_cell = matchingElement NsTable "table-cell" - $ liftA (compactify'.(:[])) + $ liftA (compactify.(:[])) $ matchChildContent' [ read_paragraph ] @@ -796,8 +793,7 @@ read_image_src = matchingElement NsDraw "image" Left _ -> returnV "" -< () read_frame_title :: InlineMatcher -read_frame_title = matchingElement NsSVG "title" - $ (matchChildContent [] read_plain_text) +read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plain_text) read_frame_text_box :: InlineMatcher read_frame_text_box = matchingElement NsDraw "text-box" @@ -806,12 +802,12 @@ read_frame_text_box = matchingElement NsDraw "text-box" arr read_img_with_caption -< toList paragraphs read_img_with_caption :: [Block] -> Inlines -read_img_with_caption ((Para ((Image attr alt (src,title)) : [])) : _) = +read_img_with_caption (Para [Image attr alt (src,title)] : _) = singleton (Image attr alt (src, 'f':'i':'g':':':title)) -- no text, default caption -read_img_with_caption ((Para ((Image attr _ (src,title)) : txt)) : _) = +read_img_with_caption (Para (Image attr _ (src,title) : txt) : _) = singleton (Image attr txt (src, 'f':'i':'g':':':title) ) -- override caption with the text that follows -read_img_with_caption ( (Para (_ : xs)) : ys) = - read_img_with_caption ((Para xs) : ys) +read_img_with_caption ( Para (_ : xs) : ys) = + read_img_with_caption (Para xs : ys) read_img_with_caption _ = mempty @@ -899,9 +895,6 @@ read_reference_ref = matchingElement NsText "reference-ref" -- Entry point ---------------------- ---read_plain_content :: OdtReaderSafe _x Inlines ---read_plain_content = strContent >>^ text - read_text :: OdtReaderSafe _x Pandoc read_text = matchChildContent' [ read_header , read_paragraph @@ -915,8 +908,8 @@ post_process (Pandoc m blocks) = Pandoc m (post_process' blocks) post_process' :: [Block] -> [Block] -post_process' ((Table _ a w h r) : (Div ("", ["caption"], _) [Para inlines] ) : xs) = - (Table inlines a w h r) : ( post_process' xs ) +post_process' (Table _ a w h r : Div ("", ["caption"], _) [Para inlines] : xs) = + Table inlines a w h r : post_process' xs post_process' bs = bs read_body :: OdtReader _x (Pandoc, MediaBag) |