diff options
Diffstat (limited to 'src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs')
| -rw-r--r-- | src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs | 65 |
1 files changed, 46 insertions, 19 deletions
diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs index c45916c03..ccbaf6fc4 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -29,8 +29,10 @@ module Text.Pandoc.Readers.Odt.Generic.XMLConverter , modifyExtraState , producingExtraState , findChild' +, filterChildrenName' , isSet' , isSetWithDefault +, elName , searchAttr , lookupAttr , lookupAttr' @@ -43,6 +45,7 @@ module Text.Pandoc.Readers.Odt.Generic.XMLConverter , readAttrWithDefault , getAttr , executeIn +, executeInSub , withEveryL , tryAll , matchContent' @@ -309,34 +312,44 @@ readNSattributes = fromState $ \state -> maybe (state, failEmpty ) -- | Given a namespace id and an element name, creates a 'XML.QName' for -- internal use -elemName :: (NameSpaceID nsID) +qualifyName :: (NameSpaceID nsID) => nsID -> ElementName -> XMLConverter nsID extraState x XML.QName -elemName nsID name = lookupNSiri nsID +qualifyName nsID name = lookupNSiri nsID &&& lookupNSprefix nsID >>% XML.QName name -- | Checks if a given element matches both a specified namespace id +-- and a predicate +elemNameMatches :: (NameSpaceID nsID) + => nsID -> (ElementName -> Bool) + -> XMLConverter nsID extraState XML.Element Bool +elemNameMatches nsID f = keepingTheValue (lookupNSiri nsID) >>% hasMatchingName + where hasMatchingName e iri = let name = XML.elName e + in f (XML.qName name) + && XML.qURI name == iri + +-- | Checks if a given element matches both a specified namespace id -- and a specified element name elemNameIs :: (NameSpaceID nsID) => nsID -> ElementName -> XMLConverter nsID extraState XML.Element Bool -elemNameIs nsID name = keepingTheValue (lookupNSiri nsID) >>% hasThatName - where hasThatName e iri = let elName = XML.elName e - in XML.qName elName == name - && XML.qURI elName == iri +elemNameIs nsID name = elemNameMatches nsID (== name) -------------------------------------------------------------------------------- -- General content -------------------------------------------------------------------------------- +elName :: XML.Element -> ElementName +elName = XML.qName . XML.elName + -- elContent :: XMLConverter nsID extraState x [XML.Content] elContent = getCurrentElement >>^ XML.elContent -------------------------------------------------------------------------------- --- Chilren +-- Children -------------------------------------------------------------------------------- -- @@ -344,7 +357,7 @@ elContent = getCurrentElement findChildren :: (NameSpaceID nsID) => nsID -> ElementName -> XMLConverter nsID extraState x [XML.Element] -findChildren nsID name = elemName nsID name +findChildren nsID name = qualifyName nsID name &&& getCurrentElement >>% XML.findChildren @@ -353,7 +366,7 @@ findChild' :: (NameSpaceID nsID) => nsID -> ElementName -> XMLConverter nsID extraState x (Maybe XML.Element) -findChild' nsID name = elemName nsID name +findChild' nsID name = qualifyName nsID name &&& getCurrentElement >>% XML.findChild @@ -364,6 +377,14 @@ findChild :: (NameSpaceID nsID) findChild nsID name = findChild' nsID name >>> maybeToChoice +filterChildrenName' :: (NameSpaceID nsID) + => nsID + -> (ElementName -> Bool) + -> XMLConverter nsID extraState x [XML.Element] +filterChildrenName' nsID f = getCurrentElement + >>> arr XML.elChildren + >>> iterateS (keepingTheValue (elemNameMatches nsID f)) + >>> arr (catMaybes . fmap (uncurry $ bool Nothing . Just)) -------------------------------------------------------------------------------- -- Attributes @@ -441,7 +462,7 @@ lookupDefaultingAttr nsID attrName findAttr' :: (NameSpaceID nsID) => nsID -> AttributeName -> XMLConverter nsID extraState x (Maybe AttributeValue) -findAttr' nsID attrName = elemName nsID attrName +findAttr' nsID attrName = qualifyName nsID attrName &&& getCurrentElement >>% XML.findAttr @@ -537,15 +558,21 @@ executeThere a = second jumpThere >>> jumpBack -- >>? jumpBack would not ensure the jump. >>^ collapseEither --- | Do something in a sub-element, tnen come back -executeIn :: (NameSpaceID nsID) - => nsID -> ElementName - -> FallibleXMLConverter nsID extraState f s - -> FallibleXMLConverter nsID extraState f s -executeIn nsID name a = keepingTheValue - (findChild nsID name) - >>> ignoringState liftFailure - >>? switchingTheStack a + +-- | Do something in a specific element, then come back +executeIn :: XMLConverter nsID extraState XML.Element s + -> XMLConverter nsID extraState XML.Element s +executeIn a = duplicate >>> switchingTheStack a + +-- | Do something in a sub-element, then come back +executeInSub :: (NameSpaceID nsID) + => nsID -> ElementName + -> FallibleXMLConverter nsID extraState f s + -> FallibleXMLConverter nsID extraState f s +executeInSub nsID name a = keepingTheValue + (findChild nsID name) + >>> ignoringState liftFailure + >>? switchingTheStack a where liftFailure (_, (Left f)) = Left f liftFailure (x, (Right e)) = Right (x, e) |