hxt 9.0.1 → 9.1.0
raw patch · 73 files changed
+9905/−2235 lines, 73 filesdep ~hxt-charpropertiesPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hxt-charproperties
API changes (from Hackage documentation)
- Data.Tree.NTree.TypeDefs: formatNTreeF :: (node -> String) -> (String -> String) -> (String -> String) -> NTree node -> String -> String
- Text.XML.HXT.Arrow.Edit: escapeHtmlDoc :: ArrowList a => a XmlTree XmlTree
- Text.XML.HXT.Arrow.Edit: escapeXmlDoc :: ArrowList a => a XmlTree XmlTree
- Text.XML.HXT.Arrow.ParserInterface: parseXmlAttrValue :: ArrowXml a => String -> a XmlTree XmlTree
- Text.XML.HXT.Arrow.ParserInterface: parseXmlGeneralEntityValue :: ArrowXml a => String -> a XmlTree XmlTree
- Text.XML.HXT.Arrow.ParserInterface: substEntityRefs :: ArrowList a => [(String, Int)] -> a XmlTree XmlTree
- Text.XML.HXT.Arrow.ParserInterface: substHtmlEntityRefs :: ArrowList a => a XmlTree XmlTree
- Text.XML.HXT.Arrow.ParserInterface: substXmlEntityRefs :: ArrowList a => a XmlTree XmlTree
- Text.XML.HXT.DOM.QualifiedName: instance Eq Atom
- Text.XML.HXT.DOM.QualifiedName: instance NFData Atom
- Text.XML.HXT.DOM.QualifiedName: instance Ord Atom
- Text.XML.HXT.DOM.QualifiedName: instance Ord QName
- Text.XML.HXT.DOM.QualifiedName: instance Read Atom
- Text.XML.HXT.DOM.QualifiedName: instance Read QName
- Text.XML.HXT.DOM.QualifiedName: instance Show Atom
- Text.XML.HXT.DOM.QualifiedName: instance Typeable Atom
- Text.XML.HXT.DOM.QualifiedName: type XName = Atom
- Text.XML.HXT.DOM.ShowXml: showElemType :: String -> XmlTrees -> String -> String
- Text.XML.HXT.DOM.TypeDefs: instance Ord XNode
- Text.XML.HXT.DOM.TypeDefs: instance Read XNode
- Text.XML.HXT.DOM.XmlNode: instance XmlNode a => XmlNode (NTree a)
- Text.XML.HXT.Parser.XmlDTDTokenParser: attrValue :: GenParser Char state XmlTree
- Text.XML.HXT.Parser.XmlParsec: parseXmlAttrValue :: String -> XmlTree -> XmlTrees
- Text.XML.HXT.Parser.XmlParsec: parseXmlGeneralEntityValue :: String -> XmlTree -> XmlTrees
+ Control.Arrow.ArrowNF: class (Arrow a, ArrowList a) => ArrowWNF a
+ Control.Arrow.ArrowNF: rwnf2A :: (ArrowWNF a, WNFData c) => a b c -> a b c
+ Control.Arrow.ArrowNF: rwnfA :: (ArrowWNF a, WNFData c) => a b c -> a b c
+ Control.Arrow.ArrowNavigatableTree: addNav :: (ArrowList a, NavigatableTreeToTree nt t) => a (t b) (nt b)
+ Control.Arrow.ArrowNavigatableTree: addToOneSide :: (ArrowList a, NavigatableTreeToTree nt t, NavigatableTreeModify nt t) => (Maybe (nt b) -> [t b] -> Maybe (nt b)) -> a (t b) (t b) -> a (nt b) (nt b)
+ Control.Arrow.ArrowNavigatableTree: addToTheLeft :: (ArrowList a, NavigatableTreeToTree nt t, NavigatableTreeModify nt t) => a (t b) (t b) -> a (nt b) (nt b)
+ Control.Arrow.ArrowNavigatableTree: addToTheRight :: (ArrowList a, NavigatableTreeToTree nt t, NavigatableTreeModify nt t) => a (t b) (t b) -> a (nt b) (nt b)
+ Control.Arrow.ArrowNavigatableTree: ancestorAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: ancestorOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: changeThisTree :: (ArrowList a, ArrowIf a, NavigatableTreeToTree nt t, NavigatableTreeModify nt t) => a (t b) (t b) -> a (nt b) (nt b)
+ Control.Arrow.ArrowNavigatableTree: childAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: class ArrowList a => ArrowNavigatableTree a
+ Control.Arrow.ArrowNavigatableTree: descendantAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: descendantOrFollowingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: descendantOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: dropFromTheLeft :: (ArrowList a, NavigatableTreeModify nt t) => a (nt b) (nt b)
+ Control.Arrow.ArrowNavigatableTree: dropFromTheRight :: (ArrowList a, NavigatableTreeModify nt t) => a (nt b) (nt b)
+ Control.Arrow.ArrowNavigatableTree: filterAxis :: (ArrowIf a, NavigatableTreeToTree nt t) => a (t b) c -> a (nt b) (nt b)
+ Control.Arrow.ArrowNavigatableTree: followingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: followingSiblingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: isAtRoot :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: moveDown :: (ArrowNavigatableTree a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: moveLeft :: (ArrowNavigatableTree a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: moveOn :: (ArrowList a, NavigatableTree t) => a (t b) (t b) -> a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: moveRight :: (ArrowNavigatableTree a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: moveToRoot :: (Arrow a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: moveUp :: (ArrowNavigatableTree a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: parentAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: precedingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: precedingSiblingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: remNav :: (ArrowList a, NavigatableTreeToTree nt t) => a (nt b) (t b)
+ Control.Arrow.ArrowNavigatableTree: revDescendantOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: selfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)
+ Control.Arrow.ArrowNavigatableTree: substThisTree :: (ArrowList a, ArrowIf a, NavigatableTreeToTree nt t, NavigatableTreeModify nt t) => t b -> a (nt b) (nt b)
+ Control.Arrow.ArrowNavigatableTree: withNav :: (ArrowList a, NavigatableTreeToTree nt t) => a (nt b) (nt c) -> a (t b) (t c)
+ Control.Arrow.ArrowNavigatableTree: withoutNav :: (ArrowList a, NavigatableTreeToTree nt t, NavigatableTreeModify nt t) => a (t b) (t b) -> a (nt b) (nt b)
+ Control.Arrow.ArrowTree: hasNode :: (ArrowTree a, Tree t) => (b -> Bool) -> a (t b) (t b)
+ Control.Arrow.IOListArrow: instance ArrowNavigatableTree IOLA
+ Control.Arrow.IOListArrow: instance ArrowWNF IOLA
+ Control.Arrow.IOStateListArrow: instance ArrowNavigatableTree (IOSLA s)
+ Control.Arrow.IOStateListArrow: instance ArrowWNF (IOSLA s)
+ Control.Arrow.ListArrow: instance ArrowNavigatableTree LA
+ Control.Arrow.ListArrow: instance ArrowWNF LA
+ Control.Arrow.NTreeEdit: editNTreeA :: [IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))] -> LA (NTree b) (NTree b)
+ Control.Arrow.NTreeEdit: fmapNTreeA :: (b -> Maybe b) -> LA (NTree b) (NTree b)
+ Control.Arrow.StateListArrow: instance ArrowNavigatableTree (SLA s)
+ Control.Arrow.StateListArrow: instance ArrowWNF (SLA s)
+ Control.FlatSeq: ($!!) :: WNFData a => (a -> b) -> a -> b
+ Control.FlatSeq: class WNFData a
+ Control.FlatSeq: flatseq :: WNFData a => a -> b -> b
+ Control.FlatSeq: instance (WNFData a, WNFData b) => WNFData (a, b)
+ Control.FlatSeq: instance (WNFData a, WNFData b, WNFData c) => WNFData (a, b, c)
+ Control.FlatSeq: instance (WNFData a, WNFData b, WNFData c, WNFData d) => WNFData (a, b, c, d)
+ Control.FlatSeq: instance WNFData ()
+ Control.FlatSeq: instance WNFData Bool
+ Control.FlatSeq: instance WNFData Char
+ Control.FlatSeq: instance WNFData Double
+ Control.FlatSeq: instance WNFData Float
+ Control.FlatSeq: instance WNFData Int
+ Control.FlatSeq: instance WNFData Integer
+ Control.FlatSeq: instance WNFData Word
+ Control.FlatSeq: instance WNFData Word16
+ Control.FlatSeq: instance WNFData Word32
+ Control.FlatSeq: instance WNFData Word64
+ Control.FlatSeq: instance WNFData Word8
+ Control.FlatSeq: instance WNFData a => WNFData [a]
+ Control.FlatSeq: rlnf :: (a -> ()) -> [a] -> ()
+ Control.FlatSeq: rwnf :: WNFData a => a -> ()
+ Control.FlatSeq: rwnf2 :: WNFData a => a -> ()
+ Data.Tree.Class: formatNTree' :: Tree t => (a -> String) -> (String -> String) -> (String -> String) -> t a -> String -> String
+ Data.Tree.NTree.Edit: editNTreeBottomUp :: (NTree a -> Maybe [NTree a]) -> NTree a -> [NTree a]
+ Data.Tree.NTree.Edit: mapNTree' :: (a -> Maybe a) -> NTree a -> NTree a
+ Data.Tree.NTree.TypeDefs: instance WNFData a => WNFData (NTree a)
+ Data.Tree.NTree.Zipper.TypeDefs: NTC :: (NTrees a) -> a -> (NTrees a) -> NTCrumb a
+ Data.Tree.NTree.Zipper.TypeDefs: NTZ :: (NTree a) -> (NTBreadCrumbs a) -> NTZipper a
+ Data.Tree.NTree.Zipper.TypeDefs: addToTheLeft :: NTree a -> NTZipper a -> Maybe (NTZipper a)
+ Data.Tree.NTree.Zipper.TypeDefs: addToTheRight :: NTree a -> NTZipper a -> Maybe (NTZipper a)
+ Data.Tree.NTree.Zipper.TypeDefs: context :: NTZipper a -> (NTBreadCrumbs a)
+ Data.Tree.NTree.Zipper.TypeDefs: data NTCrumb a
+ Data.Tree.NTree.Zipper.TypeDefs: data NTZipper a
+ Data.Tree.NTree.Zipper.TypeDefs: down :: NTZipper a -> Maybe (NTZipper a)
+ Data.Tree.NTree.Zipper.TypeDefs: dropFromTheLeft :: NTZipper a -> Maybe (NTZipper a)
+ Data.Tree.NTree.Zipper.TypeDefs: dropFromTheRight :: NTZipper a -> Maybe (NTZipper a)
+ Data.Tree.NTree.Zipper.TypeDefs: fromNTZipper :: NTZipper a -> NTree a
+ Data.Tree.NTree.Zipper.TypeDefs: instance Functor NTCrumb
+ Data.Tree.NTree.Zipper.TypeDefs: instance Functor NTZipper
+ Data.Tree.NTree.Zipper.TypeDefs: instance NavigatableTree NTZipper
+ Data.Tree.NTree.Zipper.TypeDefs: instance NavigatableTreeModify NTZipper NTree
+ Data.Tree.NTree.Zipper.TypeDefs: instance NavigatableTreeToTree NTZipper NTree
+ Data.Tree.NTree.Zipper.TypeDefs: instance Show a => Show (NTCrumb a)
+ Data.Tree.NTree.Zipper.TypeDefs: instance Show a => Show (NTZipper a)
+ Data.Tree.NTree.Zipper.TypeDefs: instance Tree NTZipper
+ Data.Tree.NTree.Zipper.TypeDefs: isTop :: NTZipper a -> Bool
+ Data.Tree.NTree.Zipper.TypeDefs: ntree :: NTZipper a -> (NTree a)
+ Data.Tree.NTree.Zipper.TypeDefs: toNTZipper :: NTree a -> NTZipper a
+ Data.Tree.NTree.Zipper.TypeDefs: toTheLeft :: NTZipper a -> Maybe (NTZipper a)
+ Data.Tree.NTree.Zipper.TypeDefs: toTheRight :: NTZipper a -> Maybe (NTZipper a)
+ Data.Tree.NTree.Zipper.TypeDefs: type NTBreadCrumbs a = [NTCrumb a]
+ Data.Tree.NTree.Zipper.TypeDefs: up :: NTZipper a -> Maybe (NTZipper a)
+ Data.Tree.NTree.Zipper.TypeDefs: up1 :: NTree a -> NTCrumb a -> NTree a
+ Data.Tree.NavigatableTree.Class: addTreeLeft :: NavigatableTreeModify nt t => t a -> nt a -> Maybe (nt a)
+ Data.Tree.NavigatableTree.Class: addTreeRight :: NavigatableTreeModify nt t => t a -> nt a -> Maybe (nt a)
+ Data.Tree.NavigatableTree.Class: class NavigatableTree t
+ Data.Tree.NavigatableTree.Class: class NavigatableTreeModify nt t | t -> nt, nt -> t
+ Data.Tree.NavigatableTree.Class: class NavigatableTreeToTree nt t | t -> nt, nt -> t
+ Data.Tree.NavigatableTree.Class: dropTreeLeft :: NavigatableTreeModify nt t => nt a -> Maybe (nt a)
+ Data.Tree.NavigatableTree.Class: dropTreeRight :: NavigatableTreeModify nt t => nt a -> Maybe (nt a)
+ Data.Tree.NavigatableTree.Class: fromTree :: NavigatableTreeToTree nt t => t a -> nt a
+ Data.Tree.NavigatableTree.Class: mvDown :: NavigatableTree t => t a -> Maybe (t a)
+ Data.Tree.NavigatableTree.Class: mvLeft :: NavigatableTree t => t a -> Maybe (t a)
+ Data.Tree.NavigatableTree.Class: mvRight :: NavigatableTree t => t a -> Maybe (t a)
+ Data.Tree.NavigatableTree.Class: mvUp :: NavigatableTree t => t a -> Maybe (t a)
+ Data.Tree.NavigatableTree.Class: substThisTree :: NavigatableTreeModify nt t => t a -> nt a -> nt a
+ Data.Tree.NavigatableTree.Class: toTree :: NavigatableTreeToTree nt t => nt a -> t a
+ Data.Tree.NavigatableTree.XPathAxis: ancestorAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: ancestorOrSelfAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: childAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: descendantAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: descendantOrSelfAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: followingAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: followingSiblingAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: isAtRoot :: NavigatableTree t => t a -> Bool
+ Data.Tree.NavigatableTree.XPathAxis: maybePlus :: (a -> Maybe a) -> (a -> [a])
+ Data.Tree.NavigatableTree.XPathAxis: maybeStar :: (a -> Maybe a) -> (a -> [a])
+ Data.Tree.NavigatableTree.XPathAxis: mvToRoot :: NavigatableTree t => t a -> t a
+ Data.Tree.NavigatableTree.XPathAxis: parentAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: precedingAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: precedingSiblingAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: revDescendantOrSelfAxis :: NavigatableTree t => t a -> [t a]
+ Data.Tree.NavigatableTree.XPathAxis: selfAxis :: NavigatableTree t => t a -> [t a]
+ Text.XML.HXT.Arrow.Edit: escapeHtmlRefs :: (Char -> String -> String, Char -> String -> String)
+ Text.XML.HXT.Arrow.Edit: escapeXmlRefs :: (Char -> String -> String, Char -> String -> String)
+ Text.XML.HXT.Arrow.ParserInterface: parseXmlEntityValueAsAttrValue :: ArrowXml a => String -> a XmlTree XmlTree
+ Text.XML.HXT.Arrow.ParserInterface: parseXmlEntityValueAsContent :: ArrowXml a => String -> a XmlTree XmlTree
+ Text.XML.HXT.Arrow.Pickle: xpInt :: PU Int
+ Text.XML.HXT.Arrow.Pickle.Xml: xpInt :: PU Int
+ Text.XML.HXT.Arrow.ProcessDocument: parseXmlDocumentWithExpat :: IOStateArrow s XmlTree XmlTree
+ Text.XML.HXT.Arrow.XmlArrow: blb :: ArrowXml a => Blob -> a n XmlTree
+ Text.XML.HXT.Arrow.XmlArrow: changeBlob :: ArrowXml a => (Blob -> Blob) -> a XmlTree XmlTree
+ Text.XML.HXT.Arrow.XmlArrow: isBlob :: ArrowXml a => a XmlTree XmlTree
+ Text.XML.HXT.Arrow.XmlArrow: mkBlob :: ArrowXml a => a Blob XmlTree
+ Text.XML.HXT.Arrow.XmlArrow: xshowBlob :: ArrowXml a => a n XmlTree -> a n Blob
+ Text.XML.HXT.Arrow.XmlState.RunIOStateArrow: dummyExpatParser :: IOSArrow b b
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: theExpat :: Selector XIOSysState Bool
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: theExpatErrors :: Selector XIOSysState (IOSArrow XmlTree XmlTree)
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: theExpatParser :: Selector XIOSysState (IOSArrow XmlTree XmlTree)
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: xioExpat :: XIOParseConfig -> !Bool
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: xioExpatErrors :: XIOSysWriter -> IOSArrow XmlTree XmlTree
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: xioExpatParser :: XIOParseConfig -> IOSArrow XmlTree XmlTree
+ Text.XML.HXT.DOM.MimeTypes: text_xdtd :: String
+ Text.XML.HXT.DOM.QualifiedName: data XName
+ Text.XML.HXT.DOM.QualifiedName: instance Binary XName
+ Text.XML.HXT.DOM.QualifiedName: instance Eq XName
+ Text.XML.HXT.DOM.QualifiedName: instance NFData XName
+ Text.XML.HXT.DOM.QualifiedName: instance Ord XName
+ Text.XML.HXT.DOM.QualifiedName: instance Typeable XName
+ Text.XML.HXT.DOM.QualifiedName: instance WNFData QName
+ Text.XML.HXT.DOM.QualifiedName: instance WNFData XName
+ Text.XML.HXT.DOM.QualifiedName: newQName :: XName -> XName -> XName -> QName
+ Text.XML.HXT.DOM.QualifiedName: qualifiedName' :: QName -> String -> String
+ Text.XML.HXT.DOM.ShowXml: xshow' :: (Char -> StringFct) -> (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> Blob
+ Text.XML.HXT.DOM.ShowXml: xshow'' :: (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> String
+ Text.XML.HXT.DOM.ShowXml: xshowBlob :: XmlTrees -> Blob
+ Text.XML.HXT.DOM.TypeDefs: XBlob :: Blob -> XNode
+ Text.XML.HXT.DOM.TypeDefs: blobToString :: Blob -> String
+ Text.XML.HXT.DOM.TypeDefs: instance WNFData DTDElem
+ Text.XML.HXT.DOM.TypeDefs: instance WNFData XNode
+ Text.XML.HXT.DOM.TypeDefs: rwnfAttributes :: Attributes -> ()
+ Text.XML.HXT.DOM.TypeDefs: stringToBlob :: String -> Blob
+ Text.XML.HXT.DOM.TypeDefs: type Blob = ByteString
+ Text.XML.HXT.DOM.TypeDefs: type XmlNavTree = NTZipper XNode
+ Text.XML.HXT.DOM.TypeDefs: type XmlNavTrees = [NTZipper XNode]
+ Text.XML.HXT.DOM.XmlNode: changeBlob :: XmlNode a => (Blob -> Blob) -> a -> a
+ Text.XML.HXT.DOM.XmlNode: getBlob :: XmlNode a => a -> Maybe Blob
+ Text.XML.HXT.DOM.XmlNode: instance (XmlNode a, Tree t) => XmlNode (t a)
+ Text.XML.HXT.DOM.XmlNode: isBlob :: XmlNode a => a -> Bool
+ Text.XML.HXT.DOM.XmlNode: mkAttr' :: QName -> XmlTrees -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkBlob :: XmlNode a => Blob -> a
+ Text.XML.HXT.DOM.XmlNode: mkCdata' :: String -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkCharRef' :: Int -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkCmt' :: String -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkDTDElem' :: DTDElem -> Attributes -> XmlTrees -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkElement' :: QName -> XmlTrees -> XmlTrees -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkEntityRef' :: String -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkError' :: Int -> String -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkPi' :: QName -> XmlTrees -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkRoot' :: XmlTrees -> XmlTrees -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: mkText' :: String -> XmlTree
+ Text.XML.HXT.DOM.XmlNode: setBlob :: XmlNode a => Blob -> a -> a
+ Text.XML.HXT.DTDValidation.Validation: generalEntitiesDefined :: XmlArrow
+ Text.XML.HXT.Parser.XmlCharParser: XPState :: !Bool -> s -> XPState s
+ Text.XML.HXT.Parser.XmlCharParser: data XPState s
+ Text.XML.HXT.Parser.XmlCharParser: type SimpleXParser a = XParser () a
+ Text.XML.HXT.Parser.XmlCharParser: type XParser s a = GenParser Char (XPState s) a
+ Text.XML.HXT.Parser.XmlCharParser: withNormNewline :: a -> XPState a
+ Text.XML.HXT.Parser.XmlCharParser: withoutNormNewline :: a -> XPState a
+ Text.XML.HXT.Parser.XmlCharParser: xmlCRLFChar :: XParser s Char
+ Text.XML.HXT.Parser.XmlCharParser: xps_normalizeNewline :: XPState s -> !Bool
+ Text.XML.HXT.Parser.XmlCharParser: xps_userState :: XPState s -> s
+ Text.XML.HXT.Parser.XmlDTDTokenParser: entityValue :: XParser s XmlTree
+ Text.XML.HXT.Parser.XmlParsec: parseXmlEntityValueAsAttrValue :: String -> XmlTree -> XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: parseXmlEntityValueAsContent :: String -> XmlTree -> XmlTrees
+ Text.XML.HXT.Parser.XmlTokenParser: amp :: XParser s ()
+ Text.XML.HXT.Parser.XmlTokenParser: attrChar :: String -> XParser s String
+ Text.XML.HXT.Parser.XmlTokenParser: checkString :: String -> XParser s ()
- Text.XML.HXT.Arrow.DocumentOutput: encodeDocument :: Bool -> String -> IOStateArrow s XmlTree XmlTree
+ Text.XML.HXT.Arrow.DocumentOutput: encodeDocument :: Bool -> Bool -> String -> IOStateArrow s XmlTree XmlTree
- Text.XML.HXT.Arrow.DocumentOutput: encodeDocument' :: ArrowXml a => Bool -> String -> a XmlTree XmlTree
+ Text.XML.HXT.Arrow.DocumentOutput: encodeDocument' :: ArrowXml a => Bool -> Bool -> String -> a XmlTree XmlTree
- Text.XML.HXT.Arrow.WriteDocument: prepareContents :: ArrowXml a => XIOSysState -> (Bool -> String -> a XmlTree XmlTree) -> a XmlTree XmlTree
+ Text.XML.HXT.Arrow.WriteDocument: prepareContents :: ArrowXml a => XIOSysState -> (Bool -> Bool -> String -> a XmlTree XmlTree) -> a XmlTree XmlTree
- Text.XML.HXT.Arrow.XmlState.TypeDefs: XIOPcfg :: MimeTypeTable -> String -> [String] -> String -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> IOSArrow XmlTree XmlTree -> XIOParseConfig
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: XIOPcfg :: MimeTypeTable -> String -> [String] -> String -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> !Bool -> IOSArrow XmlTree XmlTree -> !Bool -> IOSArrow XmlTree XmlTree -> XIOParseConfig
- Text.XML.HXT.Arrow.XmlState.TypeDefs: XIORxc :: !Bool -> String -> !Bool -> !Bool -> !Bool -> !Bool -> !Int -> !Int -> AssocList String XmlTrees -> IOSArrow XmlTree XmlTree -> XIORelaxConfig
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: XIORxc :: !Bool -> String -> !Bool -> !Bool -> !Bool -> !Bool -> IOSArrow XmlTree XmlTree -> XIORelaxConfig
- Text.XML.HXT.Arrow.XmlState.TypeDefs: XIOwrt :: !Int -> !XmlTrees -> XIOSysWriter
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: XIOwrt :: !Int -> !XmlTrees -> IOSArrow XmlTree XmlTree -> !Int -> !Int -> AssocList String XmlTrees -> XIOSysWriter
- Text.XML.HXT.Arrow.XmlState.TypeDefs: xioRelaxAttrList :: XIORelaxConfig -> AssocList String XmlTrees
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: xioRelaxAttrList :: XIOSysWriter -> AssocList String XmlTrees
- Text.XML.HXT.Arrow.XmlState.TypeDefs: xioRelaxDefineId :: XIORelaxConfig -> !Int
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: xioRelaxDefineId :: XIOSysWriter -> !Int
- Text.XML.HXT.Arrow.XmlState.TypeDefs: xioRelaxNoOfErrors :: XIORelaxConfig -> !Int
+ Text.XML.HXT.Arrow.XmlState.TypeDefs: xioRelaxNoOfErrors :: XIOSysWriter -> !Int
- Text.XML.HXT.IO.GetFILE: getCont :: Bool -> String -> IO (Either ([(String, String)], String) String)
+ Text.XML.HXT.IO.GetFILE: getCont :: Bool -> String -> IO (Either ([(String, String)], String) ByteString)
- Text.XML.HXT.IO.GetFILE: getStdinCont :: Bool -> IO (Either ([(String, String)], String) String)
+ Text.XML.HXT.IO.GetFILE: getStdinCont :: Bool -> IO (Either ([(String, String)], String) ByteString)
- Text.XML.HXT.Parser.XmlCharParser: xmlChar :: GenParser Char state Unicode
+ Text.XML.HXT.Parser.XmlCharParser: xmlChar :: XParser s Unicode
- Text.XML.HXT.Parser.XmlCharParser: xmlLetter :: GenParser Char state Unicode
+ Text.XML.HXT.Parser.XmlCharParser: xmlLetter :: XParser s Unicode
- Text.XML.HXT.Parser.XmlCharParser: xmlNCNameChar :: GenParser Char state Unicode
+ Text.XML.HXT.Parser.XmlCharParser: xmlNCNameChar :: XParser s Unicode
- Text.XML.HXT.Parser.XmlCharParser: xmlNCNameStartChar :: GenParser Char state Unicode
+ Text.XML.HXT.Parser.XmlCharParser: xmlNCNameStartChar :: XParser s Unicode
- Text.XML.HXT.Parser.XmlCharParser: xmlNameChar :: GenParser Char state Unicode
+ Text.XML.HXT.Parser.XmlCharParser: xmlNameChar :: XParser s Unicode
- Text.XML.HXT.Parser.XmlCharParser: xmlNameStartChar :: GenParser Char state Unicode
+ Text.XML.HXT.Parser.XmlCharParser: xmlNameStartChar :: XParser s Unicode
- Text.XML.HXT.Parser.XmlCharParser: xmlSpaceChar :: GenParser Char state Char
+ Text.XML.HXT.Parser.XmlCharParser: xmlSpaceChar :: XParser s Char
- Text.XML.HXT.Parser.XmlDTDTokenParser: dtdChars :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlDTDTokenParser: dtdChars :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlDTDTokenParser: dtdDeclEnd :: GenParser Char state ()
+ Text.XML.HXT.Parser.XmlDTDTokenParser: dtdDeclEnd :: XParser s ()
- Text.XML.HXT.Parser.XmlDTDTokenParser: dtdDeclStart :: GenParser Char state (DTDElem, Attributes)
+ Text.XML.HXT.Parser.XmlDTDTokenParser: dtdDeclStart :: XParser s (DTDElem, Attributes)
- Text.XML.HXT.Parser.XmlDTDTokenParser: dtdDeclTokenizer :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlDTDTokenParser: dtdDeclTokenizer :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlDTDTokenParser: dtdToken :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlDTDTokenParser: dtdToken :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlDTDTokenParser: peReference :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlDTDTokenParser: peReference :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlDTDTokenParser: percent :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlDTDTokenParser: percent :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlParsec: cDSect :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlParsec: cDSect :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlParsec: charData :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: charData :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: charData' :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlParsec: charData' :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlParsec: comment :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlParsec: comment :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlParsec: content :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: content :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: contentWithTextDecl :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: contentWithTextDecl :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: doctypedecl :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: doctypedecl :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: document :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlParsec: document :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlParsec: document' :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: document' :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: element :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlParsec: element :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlParsec: encodingDecl :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: encodingDecl :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: markupdecl :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: markupdecl :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: misc :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlParsec: misc :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlParsec: pI :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlParsec: pI :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlParsec: parseXmlEncodingSpec :: Parser XmlTree -> XmlTree -> XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: parseXmlEncodingSpec :: SimpleXParser XmlTree -> XmlTree -> XmlTrees
- Text.XML.HXT.Parser.XmlParsec: parseXmlPart :: Parser XmlTrees -> String -> String -> XmlTree -> XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: parseXmlPart :: SimpleXParser XmlTrees -> String -> String -> XmlTree -> XmlTrees
- Text.XML.HXT.Parser.XmlParsec: parseXmlText :: Parser XmlTrees -> String -> XmlTree -> XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: parseXmlText :: SimpleXParser XmlTrees -> XPState () -> String -> XmlTree -> XmlTrees
- Text.XML.HXT.Parser.XmlParsec: prolog :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: prolog :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: sDDecl :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: sDDecl :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: textDecl :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: textDecl :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: versionInfo :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: versionInfo :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: xMLDecl :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: xMLDecl :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlParsec: xMLDecl' :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlParsec: xMLDecl' :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlTokenParser: allBut :: (GenParser Char state Char -> GenParser Char state String) -> String -> GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: allBut :: (XParser s Char -> XParser s String) -> String -> XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: allBut1 :: (GenParser Char state Char -> GenParser Char state String) -> (Char -> Bool) -> String -> GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: allBut1 :: (XParser s Char -> XParser s String) -> (Char -> Bool) -> String -> XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: asciiLetter :: GenParser Char state Char
+ Text.XML.HXT.Parser.XmlTokenParser: asciiLetter :: XParser s Char
- Text.XML.HXT.Parser.XmlTokenParser: attrValue :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: attrValue :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: attrValueT :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlTokenParser: attrValueT :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlTokenParser: attrValueT' :: String -> GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlTokenParser: attrValueT' :: String -> XParser s XmlTrees
- Text.XML.HXT.Parser.XmlTokenParser: bar :: GenParser Char state ()
+ Text.XML.HXT.Parser.XmlTokenParser: bar :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: charRef :: GenParser Char state Int
+ Text.XML.HXT.Parser.XmlTokenParser: charRef :: XParser s Int
- Text.XML.HXT.Parser.XmlTokenParser: charRefT :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlTokenParser: charRefT :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlTokenParser: comma :: GenParser Char state ()
+ Text.XML.HXT.Parser.XmlTokenParser: comma :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: concRes :: GenParser Char state [[a]] -> GenParser Char state [a]
+ Text.XML.HXT.Parser.XmlTokenParser: concRes :: XParser s [[a]] -> XParser s [a]
- Text.XML.HXT.Parser.XmlTokenParser: dq :: GenParser Char state Char
+ Text.XML.HXT.Parser.XmlTokenParser: dq :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: encName :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: encName :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: entityCharT :: String -> GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlTokenParser: entityCharT :: String -> XParser s XmlTree
- Text.XML.HXT.Parser.XmlTokenParser: entityRef :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: entityRef :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: entityRefT :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlTokenParser: entityRefT :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlTokenParser: entityTokensT :: String -> GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlTokenParser: entityTokensT :: String -> XParser s XmlTrees
- Text.XML.HXT.Parser.XmlTokenParser: entityValue :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: entityValue :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: entityValueT :: GenParser Char state XmlTrees
+ Text.XML.HXT.Parser.XmlTokenParser: entityValueT :: XParser s XmlTrees
- Text.XML.HXT.Parser.XmlTokenParser: eq :: GenParser Char state ()
+ Text.XML.HXT.Parser.XmlTokenParser: eq :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: gt :: GenParser Char state Char
+ Text.XML.HXT.Parser.XmlTokenParser: gt :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: keyword :: String -> GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: keyword :: String -> XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: keywords :: [String] -> GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: keywords :: [String] -> XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: lpar :: GenParser Char state ()
+ Text.XML.HXT.Parser.XmlTokenParser: lpar :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: lt :: GenParser Char state Char
+ Text.XML.HXT.Parser.XmlTokenParser: lt :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: mkList :: GenParser Char state a -> GenParser Char state [a]
+ Text.XML.HXT.Parser.XmlTokenParser: mkList :: XParser s a -> XParser s [a]
- Text.XML.HXT.Parser.XmlTokenParser: name :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: name :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: nameT :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlTokenParser: nameT :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlTokenParser: names :: GenParser Char state [String]
+ Text.XML.HXT.Parser.XmlTokenParser: names :: XParser s [String]
- Text.XML.HXT.Parser.XmlTokenParser: ncName :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: ncName :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: nmtoken :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: nmtoken :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: nmtokenT :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlTokenParser: nmtokenT :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlTokenParser: nmtokens :: GenParser Char state [String]
+ Text.XML.HXT.Parser.XmlTokenParser: nmtokens :: XParser s [String]
- Text.XML.HXT.Parser.XmlTokenParser: peReference :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: peReference :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: peReferenceT :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlTokenParser: peReferenceT :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlTokenParser: pubidLiteral :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: pubidLiteral :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: qName :: GenParser Char state (String, String)
+ Text.XML.HXT.Parser.XmlTokenParser: qName :: XParser s (String, String)
- Text.XML.HXT.Parser.XmlTokenParser: quoted :: GenParser Char state a -> GenParser Char state a
+ Text.XML.HXT.Parser.XmlTokenParser: quoted :: XParser s a -> XParser s a
- Text.XML.HXT.Parser.XmlTokenParser: reference :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: reference :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: referenceT :: GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlTokenParser: referenceT :: XParser s XmlTree
- Text.XML.HXT.Parser.XmlTokenParser: rpar :: GenParser Char state ()
+ Text.XML.HXT.Parser.XmlTokenParser: rpar :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: sPace :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: sPace :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: sPace0 :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: sPace0 :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: semi :: GenParser Char state Char
+ Text.XML.HXT.Parser.XmlTokenParser: semi :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: separator :: Char -> GenParser Char state ()
+ Text.XML.HXT.Parser.XmlTokenParser: separator :: Char -> XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: singleChar :: String -> GenParser Char state Char
+ Text.XML.HXT.Parser.XmlTokenParser: singleChar :: String -> XParser s Char
- Text.XML.HXT.Parser.XmlTokenParser: singleChars :: String -> GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: singleChars :: String -> XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: singleCharsT :: String -> GenParser Char state XmlTree
+ Text.XML.HXT.Parser.XmlTokenParser: singleCharsT :: String -> XParser s XmlTree
- Text.XML.HXT.Parser.XmlTokenParser: skipS :: GenParser Char state ()
+ Text.XML.HXT.Parser.XmlTokenParser: skipS :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: skipS0 :: GenParser Char state ()
+ Text.XML.HXT.Parser.XmlTokenParser: skipS0 :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: sq :: GenParser Char state Char
+ Text.XML.HXT.Parser.XmlTokenParser: sq :: XParser s ()
- Text.XML.HXT.Parser.XmlTokenParser: systemLiteral :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: systemLiteral :: XParser s String
- Text.XML.HXT.Parser.XmlTokenParser: versionNum :: GenParser Char state String
+ Text.XML.HXT.Parser.XmlTokenParser: versionNum :: XParser s String
Files
- examples/arrows/AGentleIntroductionToHXT/PicklerExample/Baseball.hs +209/−201
- examples/arrows/hparser/HXmlParser.hs +1/−2
- examples/arrows/hparser/Makefile +5/−1
- examples/arrows/hparser/example1CRLF.xml +22/−0
- examples/arrows/hparser/lousy.html +4/−3
- examples/arrows/performance/GenDoc.hs +299/−128
- examples/arrows/performance/Makefile +24/−6
- examples/arrows/pickle/PickleTest.hs +55/−26
- examples/xhtml/tmp.xml +4/−0
- examples/xhtml/xhtml-lat1.ent +196/−0
- examples/xhtml/xhtml-special.ent +79/−0
- examples/xhtml/xhtml-symbol.ent +242/−0
- examples/xhtml/xhtml.xml +1484/−0
- examples/xhtml/xhtml1-frameset.dtd +1225/−0
- examples/xhtml/xhtml1-strict.dtd +988/−0
- examples/xhtml/xhtml1-transitional.dtd +1196/−0
- hxt.cabal +21/−4
- src/Control/Arrow/ArrowExc.hs +2/−2
- src/Control/Arrow/ArrowIO.hs +4/−0
- src/Control/Arrow/ArrowIf.hs +11/−0
- src/Control/Arrow/ArrowList.hs +18/−1
- src/Control/Arrow/ArrowNF.hs +26/−3
- src/Control/Arrow/ArrowNavigatableTree.hs +313/−0
- src/Control/Arrow/ArrowState.hs +2/−0
- src/Control/Arrow/ArrowTree.hs +18/−1
- src/Control/Arrow/IOListArrow.hs +18/−11
- src/Control/Arrow/IOStateListArrow.hs +20/−0
- src/Control/Arrow/ListArrow.hs +19/−3
- src/Control/Arrow/ListArrows.hs +6/−0
- src/Control/Arrow/NTreeEdit.hs +46/−0
- src/Control/Arrow/StateListArrow.hs +19/−1
- src/Control/FlatSeq.hs +90/−0
- src/Data/Function/Selector.hs +46/−46
- src/Data/Tree/Class.hs +47/−0
- src/Data/Tree/NTree/Edit.hs +98/−0
- src/Data/Tree/NTree/TypeDefs.hs +26/−45
- src/Data/Tree/NTree/Zipper/TypeDefs.hs +240/−0
- src/Data/Tree/NavigatableTree/Class.hs +77/−0
- src/Data/Tree/NavigatableTree/XPathAxis.hs +128/−0
- src/Text/XML/HXT/Arrow/DTDProcessing.hs +71/−61
- src/Text/XML/HXT/Arrow/DocumentInput.hs +38/−16
- src/Text/XML/HXT/Arrow/DocumentOutput.hs +101/−30
- src/Text/XML/HXT/Arrow/Edit.hs +152/−197
- src/Text/XML/HXT/Arrow/GeneralEntitySubstitution.hs +65/−66
- src/Text/XML/HXT/Arrow/Namespace.hs +23/−22
- src/Text/XML/HXT/Arrow/ParserInterface.hs +4/−56
- src/Text/XML/HXT/Arrow/Pickle.hs +10/−5
- src/Text/XML/HXT/Arrow/Pickle/DTD.hs +2/−0
- src/Text/XML/HXT/Arrow/Pickle/Xml.hs +16/−1
- src/Text/XML/HXT/Arrow/ProcessDocument.hs +65/−30
- src/Text/XML/HXT/Arrow/ReadDocument.hs +41/−42
- src/Text/XML/HXT/Arrow/WriteDocument.hs +10/−16
- src/Text/XML/HXT/Arrow/XmlArrow.hs +103/−2
- src/Text/XML/HXT/Arrow/XmlRegex.hs +2/−2
- src/Text/XML/HXT/Arrow/XmlState/RunIOStateArrow.hs +15/−3
- src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs +49/−25
- src/Text/XML/HXT/DOM/FormatXmlTree.hs +4/−13
- src/Text/XML/HXT/DOM/Interface.hs +1/−0
- src/Text/XML/HXT/DOM/MimeTypes.hs +3/−0
- src/Text/XML/HXT/DOM/QualifiedName.hs +262/−189
- src/Text/XML/HXT/DOM/ShowXml.hs +327/−286
- src/Text/XML/HXT/DOM/TypeDefs.hs +100/−57
- src/Text/XML/HXT/DOM/XmlNode.hs +207/−40
- src/Text/XML/HXT/DTDValidation/DocTransformation.hs +3/−3
- src/Text/XML/HXT/DTDValidation/Validation.hs +5/−0
- src/Text/XML/HXT/IO/GetFILE.hs +12/−23
- src/Text/XML/HXT/Parser/HtmlParsec.hs +299/−168
- src/Text/XML/HXT/Parser/XmlCharParser.hs +71/−21
- src/Text/XML/HXT/Parser/XmlDTDParser.hs +61/−49
- src/Text/XML/HXT/Parser/XmlDTDTokenParser.hs +20/−19
- src/Text/XML/HXT/Parser/XmlParsec.hs +260/−175
- src/Text/XML/HXT/Parser/XmlTokenParser.hs +174/−133
- src/Text/XML/HXT/Version.hs +1/−1
examples/arrows/AGentleIntroductionToHXT/PicklerExample/Baseball.hs view
@@ -23,7 +23,7 @@ { sYear :: Int , sLeagues :: Leagues }- deriving (Show, Eq)+ deriving (Show, Eq) type Leagues = Map String Divisions @@ -34,8 +34,8 @@ , city :: String , players :: [Player] }- deriving (Show, Eq)- + deriving (Show, Eq)+ data Player = Player { firstName :: String , lastName :: String@@ -44,7 +44,7 @@ , hits :: Maybe Int , era :: Maybe Float }- deriving (Show, Eq)+ deriving (Show, Eq) -- ------------------------------------------------------------ -- the pickler instance declarations@@ -64,73 +64,81 @@ -- the XML root element -xpSeason :: PU Season+xpSeason :: PU Season xpSeason = xpElem "SEASON" $ xpWrap ( uncurry Season- , \ s -> (sYear s, sLeagues s)) $+ , \ s -> (sYear s, sLeagues s)) $ xpPair (xpAttr "YEAR" xpickle) xpLeagues -xpLeagues :: PU Leagues+xpLeagues :: PU Leagues xpLeagues = xpWrap ( fromList- , toList ) $+ , toList ) $ xpList $ xpElem "LEAGUE" $ xpPair (xpAttr "NAME" xpText) xpDivisions -xpDivisions :: PU Divisions+xpDivisions :: PU Divisions xpDivisions = xpWrap ( fromList- , toList- ) $+ , toList+ ) $ xpList $ xpElem "DIVISION" $- xpPair (xpAttr "NAME" xpText) xpickle+ xpPair (xpAttr "NAME" xpText)+ xpickle -xpTeam :: PU Team+xpTeam :: PU Team xpTeam = xpElem "TEAM" $ xpWrap ( uncurry3 Team- , \ t -> (teamName t, city t, players t)) $- xpTriple (xpAttr "NAME" xpText) (xpAttr "CITY" xpText) (xpList xpickle)+ , \ t -> (teamName t, city t, players t)+ ) $+ xpTriple (xpAttr "NAME" xpText)+ (xpAttr "CITY" xpText)+ (xpList xpickle) -xpPlayer :: PU Player+xpPlayer :: PU Player xpPlayer = xpElem "PLAYER" $- xpWrap ( \ ((f,l,p),(a,h,e)) -> Player f l p a h e- , \ t -> ((firstName t, lastName t, position t),(atBats t, hits t, era t))) $- xpPair (xpTriple (xpAttr "GIVEN_NAME" xpText)- (xpAttr "SURNAME" xpText)- (xpAttr "POSITION" xpText))- (xpTriple (xpOption (xpAttr "AT_BATS" xpickle))- (xpOption (xpAttr "HITS" xpickle))- (xpOption (xpAttr "ERA" xpPrim )))+ xpWrap ( \ ((f,l,p,a,h,e)) -> Player f l p a h e+ , \ t -> (firstName t, lastName t+ , position t, atBats t+ , hits t, era t+ )+ ) $+ xp6Tuple (xpAttr "GIVEN_NAME" xpText)+ (xpAttr "SURNAME" xpText)+ (xpAttr "POSITION" xpText)+ (xpOption (xpAttr "AT_BATS" xpickle))+ (xpOption (xpAttr "HITS" xpickle))+ (xpOption (xpAttr "ERA" xpPrim )) -- ------------------------------------------------------------ -- a simple pickle/unpickle application -main :: IO ()+main :: IO () main = do runX ( xunpickleDocument xpSeason [ withValidate no- , withTrace 1- , withRemoveWS yes- , withPreserveComment no- ] "simple2.xml"- >>>- processSeason- >>>- xpickleDocument xpSeason [ withIndent yes- ] "new-simple2.xml"- )+ , withTrace 1+ , withRemoveWS yes+ , withPreserveComment no+ ] "simple2.xml"+ >>>+ processSeason+ >>>+ xpickleDocument xpSeason [ withIndent yes+ ] "new-simple2.xml"+ ) return () -- the dummy for processing the unpickled data -processSeason :: IOSArrow Season Season+processSeason :: IOSArrow Season Season processSeason = arrIO ( \ x -> do {print x ; return x}) @@ -138,175 +146,175 @@ -- the internal data of "simple2.xml" -season1998 :: Season+season1998 :: Season season1998 = Season { sYear = 1998 , sLeagues = fromList- [ ( "American League"- , fromList- [ ( "Central"- , [ Team { teamName = "White Sox"- , city = "Chicago"- , players = []}- , Team { teamName = "Royals"- , city = "Kansas City"- , players = []}- , Team { teamName = "Tigers"- , city = "Detroit"- , players = []}- , Team { teamName = "Indians"- , city = "Cleveland"- , players = []}- , Team { teamName = "Twins"- , city = "Minnesota"- , players = []}- ])- , ( "East"- , [ Team { teamName = "Orioles"- , city = "Baltimore"- , players = []}- , Team { teamName = "Red Sox"- , city = "Boston"- , players = []}- , Team { teamName = "Yankees"- , city = "New York"- , players = []}- , Team { teamName = "Devil Rays"- , city = "Tampa Bay"- , players = []}- , Team { teamName = "Blue Jays"- , city = "Toronto"- , players = []}- ])- , ( "West"- , [ Team { teamName = "Angels"- , city = "Anaheim"- , players = []}- , Team { teamName = "Athletics"- , city = "Oakland"- , players = []}- , Team { teamName = "Mariners"- , city = "Seattle"- , players = []}- , Team { teamName = "Rangers"- , city = "Texas"- , players = []}- ])- ])- , ( "National League"- , fromList- [ ( "Central"- , [ Team { teamName = "Cubs"- , city = "Chicago"- , players = []}- , Team { teamName = "Reds"- , city = "Cincinnati"- , players = []}- , Team { teamName = "Astros"- , city = "Houston"- , players = []}- , Team { teamName = "Brewers"- , city = "Milwaukee"- , players = []}- , Team { teamName = "Pirates"- , city = "Pittsburgh"- , players = []}- , Team { teamName = "Cardinals"- , city = "St. Louis"- , players = []}- ])- , ( "East"- , [ Team { teamName = "Braves"- , city = "Atlanta"- , players =- [ Player { firstName = "Marty"- , lastName = "Malloy"- , position = "Second Base"- , atBats = Just 28- , hits = Just 5- , era = Nothing}- , Player { firstName = "Ozzie"- , lastName = "Guillen"- , position = "Shortstop"- , atBats = Just 264- , hits = Just 73- , era = Nothing}- , Player { firstName = "Danny"- , lastName = "Bautista"- , position = "Outfield"- , atBats = Just 144- , hits = Just 36- , era = Nothing}- , Player { firstName = "Gerald"- , lastName = "Williams"- , position = "Outfield"- , atBats = Just 266- , hits = Just 81- , era = Nothing}- , Player { firstName = "Tom"- , lastName = "Glavine"- , position = "Starting Pitcher"- , atBats = Nothing- , hits = Nothing- , era = Just 2.47}- , Player { firstName = "Javier"- , lastName = "Lopez"- , position = "Catcher"- , atBats = Just 489- , hits = Just 139- , era = Nothing}- , Player { firstName = "Ryan"- , lastName = "Klesko"- , position = "Outfield"- , atBats = Just 427- , hits = Just 117- , era = Nothing}- , Player { firstName = "Andres"- , lastName = "Galarraga"- , position = "First Base"- , atBats = Just 555- , hits = Just 169- , era = Nothing}- , Player { firstName = "Wes"- , lastName = "Helms"- , position = "Third Base"- , atBats = Just 13- , hits = Just 4- , era = Nothing}- ]}- , Team { teamName = "Marlins"- , city = "Florida"- , players = []}- , Team { teamName = "Expos"- , city = "Montreal"- , players = []}- , Team { teamName = "Mets"- , city = "New York"- , players = []}- , Team { teamName = "Phillies"- , city = "Philadelphia"- , players = []}- ])- , ( "West"- , [ Team { teamName = "Diamondbacks"- , city = "Arizona"- , players = []}- , Team { teamName = "Rockies"- , city = "Colorado"- , players = []}- , Team { teamName = "Dodgers"- , city = "Los Angeles"- , players = []}- , Team { teamName = "Padres"- , city = "San Diego"- , players = []}- , Team { teamName = "Giants"- , city = "San Francisco"- , players = []}- ])- ])- ]+ [ ( "American League"+ , fromList+ [ ( "Central"+ , [ Team { teamName = "White Sox"+ , city = "Chicago"+ , players = []}+ , Team { teamName = "Royals"+ , city = "Kansas City"+ , players = []}+ , Team { teamName = "Tigers"+ , city = "Detroit"+ , players = []}+ , Team { teamName = "Indians"+ , city = "Cleveland"+ , players = []}+ , Team { teamName = "Twins"+ , city = "Minnesota"+ , players = []}+ ])+ , ( "East"+ , [ Team { teamName = "Orioles"+ , city = "Baltimore"+ , players = []}+ , Team { teamName = "Red Sox"+ , city = "Boston"+ , players = []}+ , Team { teamName = "Yankees"+ , city = "New York"+ , players = []}+ , Team { teamName = "Devil Rays"+ , city = "Tampa Bay"+ , players = []}+ , Team { teamName = "Blue Jays"+ , city = "Toronto"+ , players = []}+ ])+ , ( "West"+ , [ Team { teamName = "Angels"+ , city = "Anaheim"+ , players = []}+ , Team { teamName = "Athletics"+ , city = "Oakland"+ , players = []}+ , Team { teamName = "Mariners"+ , city = "Seattle"+ , players = []}+ , Team { teamName = "Rangers"+ , city = "Texas"+ , players = []}+ ])+ ])+ , ( "National League"+ , fromList+ [ ( "Central"+ , [ Team { teamName = "Cubs"+ , city = "Chicago"+ , players = []}+ , Team { teamName = "Reds"+ , city = "Cincinnati"+ , players = []}+ , Team { teamName = "Astros"+ , city = "Houston"+ , players = []}+ , Team { teamName = "Brewers"+ , city = "Milwaukee"+ , players = []}+ , Team { teamName = "Pirates"+ , city = "Pittsburgh"+ , players = []}+ , Team { teamName = "Cardinals"+ , city = "St. Louis"+ , players = []}+ ])+ , ( "East"+ , [ Team { teamName = "Braves"+ , city = "Atlanta"+ , players =+ [ Player { firstName = "Marty"+ , lastName = "Malloy"+ , position = "Second Base"+ , atBats = Just 28+ , hits = Just 5+ , era = Nothing}+ , Player { firstName = "Ozzie"+ , lastName = "Guillen"+ , position = "Shortstop"+ , atBats = Just 264+ , hits = Just 73+ , era = Nothing}+ , Player { firstName = "Danny"+ , lastName = "Bautista"+ , position = "Outfield"+ , atBats = Just 144+ , hits = Just 36+ , era = Nothing}+ , Player { firstName = "Gerald"+ , lastName = "Williams"+ , position = "Outfield"+ , atBats = Just 266+ , hits = Just 81+ , era = Nothing}+ , Player { firstName = "Tom"+ , lastName = "Glavine"+ , position = "Starting Pitcher"+ , atBats = Nothing+ , hits = Nothing+ , era = Just 2.47}+ , Player { firstName = "Javier"+ , lastName = "Lopez"+ , position = "Catcher"+ , atBats = Just 489+ , hits = Just 139+ , era = Nothing}+ , Player { firstName = "Ryan"+ , lastName = "Klesko"+ , position = "Outfield"+ , atBats = Just 427+ , hits = Just 117+ , era = Nothing}+ , Player { firstName = "Andres"+ , lastName = "Galarraga"+ , position = "First Base"+ , atBats = Just 555+ , hits = Just 169+ , era = Nothing}+ , Player { firstName = "Wes"+ , lastName = "Helms"+ , position = "Third Base"+ , atBats = Just 13+ , hits = Just 4+ , era = Nothing}+ ]}+ , Team { teamName = "Marlins"+ , city = "Florida"+ , players = []}+ , Team { teamName = "Expos"+ , city = "Montreal"+ , players = []}+ , Team { teamName = "Mets"+ , city = "New York"+ , players = []}+ , Team { teamName = "Phillies"+ , city = "Philadelphia"+ , players = []}+ ])+ , ( "West"+ , [ Team { teamName = "Diamondbacks"+ , city = "Arizona"+ , players = []}+ , Team { teamName = "Rockies"+ , city = "Colorado"+ , players = []}+ , Team { teamName = "Dodgers"+ , city = "Los Angeles"+ , players = []}+ , Team { teamName = "Padres"+ , city = "San Diego"+ , players = []}+ , Team { teamName = "Giants"+ , city = "San Francisco"+ , players = []}+ ])+ ])+ ] } -- ------------------------------------------------------------
examples/arrows/hparser/HXmlParser.hs view
@@ -125,8 +125,7 @@ ++ showOptions ++- [ Option "f" ["output-file"] (ReqArg (withSysAttr "output-file") "FILE") "output file for resulting document (default: stdout)"- , Option "q" ["no-output"] (NoArg $ withSysAttr "no-output" "1") "no output of resulting document"+ [ Option "q" ["no-output"] (NoArg $ withSysAttr "no-output" "1") "no output of resulting document" , Option "x" ["action"] (ReqArg (withSysAttr "action") "ACTION") "actions are: only-text, indent, no-op" ] -- the last 2 option values will be stored by withAttr in the system key-value list
examples/arrows/hparser/Makefile view
@@ -32,6 +32,7 @@ $(MAKE) test0 test1 test2 test3 test4 EX1 = ./example1.xml+EX1a = ./example1CRLF.xml EXi = ./invalid.xml EX2 = ../../xhtml/xhtml.xml EX3 = ./namespace0.xml@@ -76,6 +77,9 @@ @sleep 2 ; echo ; echo "===> once again, but without any markup" ; echo ; sleep 2 $(prog) --action=only-text --output-encoding=ISO-8859-1 $(EX1) @echo+ @sleep 2 ; echo ; echo "===> same source, but with CRLF, parser will emit UTF-8" ; echo ; sleep 2+ $(prog) --output-encoding=UTF-8 $(EX1a)+ @echo test2 : @echo "===> the source of a xhtml document" ; echo ; sleep 2@@ -110,7 +114,7 @@ @echo "===> the source of another lousy html document containing empty elements" ; echo ; sleep 2 cat $(EX4a) @sleep 2 ; echo ; echo "===> parser accepts this document and tries to format this as a HTML document without any dangarous empty elements" ; echo ; sleep 2- $(prog) --indent --preserve-comment --parse-html --output-html --no-empty-elements $(EX4a)+ $(prog) --indent --preserve-comment --parse-html --output-xhtml $(EX4a) @echo dist :
+ examples/arrows/hparser/example1CRLF.xml view
@@ -0,0 +1,22 @@+<?xml version="1.0" encoding="ISO-8859-1" ?> + +<!DOCTYPE a [ +<!ATTLIST a att1 NMTOKENS #IMPLIED + att2 ID #REQUIRED> +<!ATTLIST b btt2 ID #REQUIRED + btt3 IDREF #REQUIRED> +<!ELEMENT a (b, cü?)> +<!ELEMENT b EMPTY> +<!ELEMENT cü (#PCDATA)> +]> + +<?pi a processing instruction?> + +<a att1=" test + äöüß + test " + att2="root" +> + <b btt2="b1" btt3="root"/> + <cü>hello world äöüß test</cü> +</a>
examples/arrows/hparser/lousy.html view
@@ -21,6 +21,7 @@ </table> <xxx>xxx</xxx>+ <? abc + xyz ?> <yyy a=b/> <![CDATA[a CDATA section with some unescaped chars@@ -30,8 +31,8 @@ Ä Ö Ü A <address><a href="mailto:uwe@muehle.welt.all">Uwe Schmidt</a></address>-<!-- Created: Tue Apr 29 16:07:57 CEST 2003 -->+<!-- Created: -- Tue Apr 29 16:07:57 CEST 2003 --> <!-- hhmts start -->-Last modified: Tue Aug 17 15:56:59 CEST 2010-<!-- hhmts end -->+Last modified: Thu Feb 3 13:27:19 CET 2011+<!-- hhmts end -> </html>
examples/arrows/performance/GenDoc.hs view
@@ -1,27 +1,41 @@ {-# LANGUAGE BangPatterns#-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- ---------------------------------------- module Main where -import Text.XML.HXT.Core-import Text.XML.HXT.TagSoup+import Text.XML.HXT.Core hiding (trace)+-- import Text.XML.HXT.TagSoup+-- import Text.XML.HXT.Expat +import Data.Char (isDigit)+import Data.List (foldl')+ import Data.String.Unicode ( unicodeToXmlEntity ) import Control.Monad.State.Strict hiding (when) +import Control.DeepSeq+import Control.FlatSeq+ import Data.Maybe -import System.IO -- import the IO and commandline option stuff+import System.IO hiding (utf8) -- import the IO and commandline option stuff import System.Environment --- ----------------------------------------+import qualified Text.XML.HXT.DOM.XmlNode as XN+import qualified Data.Tree.Class as T+import Data.Tree.NTree.TypeDefs -- as T -main :: IO ()+import Debug.Trace++-- ------------------------------------------------------------++main :: IO () main = do p <- getProgName@@ -30,18 +44,19 @@ main' p i where main' p' = fromMaybe main0 . lookup (pn p') $ mpt- mpt = [ ("GenDoc", main1)- , ("ReadDoc", main2)- , ("PruneRight", main3 False)- , ("PruneLeft", main3 True)- , ("MemTest", main4)- ]+ mpt = [ ("GenDoc", main1)+ , ("ReadDoc", main2)+ , ("PruneRight", main3 False)+ , ("PruneLeft", main3 True)+ , ("MemTest", main4 True)+ , ("MemTest1", main4 False)+ ] -- ---------------------------------------- -- generate a document containing a binary tree of 2^i leafs (= 2^(i-1) XML elements) -main1 :: Int -> IO ()+main1 :: Int -> IO () main1 i = runX (genDoc i (fn i)) >> return ()@@ -50,62 +65,101 @@ -- read a document containing a binary tree of 2^i leafs -main2 :: Int -> IO ()+main2 :: Int -> IO () main2 i = do- [x] <- runX (readDoc (fn i)- >>>- traceMsg 1 "start unpickle"- >>>- unpickleTree- >>>- traceMsg 1 "start fold"- >>>- arr (foldT1 max)- )+ [x] <- runX (setTraceLevel 2+ >>>+ readDoc (fn i)+ >>>+{-+ traceMsg 1 "start rnfA"+ >>>+ rnfA this+ >>>+-}+ traceMsg 1 "start unpickle"+ >>>+ unpickleTree+ >>>+ traceMsg 1 "start fold"+ >>>+ arr (foldT1 max)+ ) putStrLn ( "maximum value in tree is " ++ show x ++- ", expected value was " ++ show ((2::Int)^i)- )+ ", expected value was " ++ show ((2::Int)^i)+ ) -- ---------------------------------------- -- test on lazyness, is the whole tree read or only the first child of every child node? -main3 :: Bool -> Int -> IO ()+main3 :: Bool -> Int -> IO () main3 l i = do [t] <- runX ( readDoc (fn i)- >>>- fromLA (xshow ( getChildren- >>>- if l then pruneForkLeft else pruneForkRight- )- )- )+ >>>+ fromLA (xshow ( getChildren+ >>>+ if l then pruneForkLeft else pruneForkRight+ )+ )+ ) putStrLn ("pruned binary tree is : " ++ show t) -- ---------------------------------------- -main4 :: Int -> IO ()-main4 i+main4 :: Bool -> Int -> IO ()+main4 wnf i = do [x] <- runX ( setTraceLevel 1- >>>- traceMsg 1 ("generate tree of depth " ++ show i)- >>>- fromLA (genTree 0 i)- >>>- traceMsg 1 ("compute maximum and minimum")- >>>- fromLA ( foldBTree maximum &&& foldBTree minimum ) -- 2 traversals: complete tree in mem- >>>- arr2 (\ ma mi -> "maximum value = " ++ show ma ++ ", minimum = " ++ show mi )- >>>- traceValue 1 id- )+ >>>+ traceMsg 1 ("generate tree of depth " ++ show i)+ >>>+ ( if wnf+ then fromLA (genTree'' 0 i)+ else fromLA (rnfA $ genTree 0 i)+ )+ >>>+ perform ( traceMsg 1 ("deep hasAttrValue")+ >>>+ deep (hasName "leaf" >>> hasAttrValue "value" (== "1"))+ >>>+ getAttrValue "value"+ >>>+ arrIO putStrLn+ )+ >>>+ perform ( traceMsg 1 ("deep hasAttrValue")+ >>>+ deep (hasName "leaf" >>> hasAttrValue "value" (== "1"))+ >>>+ getAttrValue "value"+ >>>+ arrIO putStrLn+ )+ {-+ perform (traceMsg 1 ("write doc")+ >>>+ putDoc "./tmp.xml"+ )+ >>>+ traceMsg 1 ("compute maximum and minimum")+ >>>+ fromLA ( foldBTree maximum &&& foldBTree minimum ) -- 2 traversals: complete tree in mem+ >>>+ arr2 (\ ma mi -> "maximum value = " ++ show ma ++ ", minimum = " ++ show mi )+ >>>+ traceValue 1 id+ -}+ >>>+ traceMsg 1 "done"+ >>>+ constA "0"+ ) putStrLn x -foldBTree :: ([Int] -> Int) -> LA XmlTree Int+foldBTree :: ([Int] -> Int) -> LA XmlTree Int foldBTree f = choiceA [ hasName "leaf" :-> ( getAttrValue "value" >>^ read )@@ -117,7 +171,7 @@ -- just to check how much memory is used for the tree -main0 :: Int -> IO ()+main0 :: Int -> IO () main0 i = do let t = mkBTree i@@ -127,117 +181,225 @@ -- ---------------------------------------- -pn :: String -> String-pn = reverse . takeWhile (/= '/') . reverse+pn :: String -> String+pn = reverse . takeWhile (/= '/') . reverse -fn :: Int -> String-fn = ("tree-" ++) . (++ ".xml") . reverse . take 4 . reverse . ((replicate 4 '0') ++ ) . show+fn :: Int -> String+fn = ("tree-" ++) . (++ ".xml") . reverse . take 4 . reverse . ((replicate 4 '0') ++ ) . show -- ---------------------------------------- -genTree :: Int -> Int -> LA XmlTree XmlTree+genTree :: Int -> Int -> LA XmlTree XmlTree genTree !n !d- | d == 0 = aelem "leaf" [sattr "value" (show (n + 1))]- | otherwise = selem "fork" [ genTree (2*n) (d-1)- , genTree (2*n+1) (d-1)- ]+ | d == 0 = aelem "leaf" [sattr "value" (show (n + 1))]+ | otherwise = selem "fork" [ genTree (2*n) (d-1)+ , genTree (2*n+1) (d-1)+ ] -- ---------------------------------------- -genDoc :: Int -> String -> IOSArrow b XmlTree-genDoc d out = constA (mkBTree d)- >>>- xpickleVal xpickle- >>>- putDoc out+genTree' :: Int -> Int -> LA XmlTree XmlTree+genTree' !n !d+ | d == 0 = aelem' "leaf" [sattr' "value" (show (n + 1))]+ | otherwise = selem' "fork" [ genTree' (2*n) (d-1)+ , genTree' (2*n+1) (d-1)+ ] -- ---------------------------------------- -readDoc :: String -> IOSArrow b XmlTree+genTree'' :: Int -> Int -> LA XmlTree XmlTree+genTree'' !n !d+ | d == 0 = rwnfA $+ -- trace ("+leaf " ++ show (n+1)) $+ aelem "leaf" $+ -- trace ("++leaf " ++ show (n+1)) $+ [rwnf2A $+ -- trace ("+valu " ++ show (n+1)) $+ sattr "value" $+ show $+ -- trace ("++valu " ++ show (n+1)) $+ (n + 1)+ ]+ | otherwise = rwnfA $+ -- trace ("+fork " ++ show (n+1)) $+ selem "fork" $+ -- trace ("++fork " ++ show (n+1)) $+ [ genTree'' (2*n) (d-1)+ , genTree'' (2*n+1) (d-1)+ ]++-- ----------------------------------------++-- (hopefully) strict constructors++mkText' s = rwnf s `seq`+ T.mkLeaf tn+ where+ tn = XN.mkText s++mkAttr' n al = n `seq`+ rwnf al `seq`+ T.mkTree an al+ where+ an = XN.mkAttrNode n++mkElem' n al cl = n `seq`+ en `seq`+ rwnf al `seq`+ rwnf cl `seq`+ T.mkTree en cl+ where+ en = XN.mkElementNode n al++-- ----------------------------------------+-- strict arrows++mkElement' :: String -> LA n XmlTree -> LA n XmlTree -> LA n XmlTree+mkElement' n af cf = (listA af &&& listA cf)+ >>>+ arr2 (mkElem' (mkName n))++selem' :: String -> [LA n XmlTree] -> LA n XmlTree+selem' n cfs = mkElement' n none (catA cfs)++aelem' :: String -> [LA n XmlTree] -> LA n XmlTree+aelem' n afs = mkElement' n (catA afs) none++sattr' :: String -> String -> LA n XmlTree+sattr' an av = constA (mkAttr' (mkName an) [mkText' av])++-- ----------------------------------------++genDoc :: Int -> String -> IOSArrow b XmlTree+genDoc d out = constA (let t = mkBTree d in rnf t `seq` t)+ >>>+ xpickleVal xpickle+ >>>+{-+ strictA+ >>>+ perform (writeBinaryValue (out ++ ".bin"))+ >>>+ readBinaryValue (out ++ ".bin")+ >>>+ strictA+ >>>+-}+ putDoc out++-- ----------------------------------------++readDoc :: String -> IOSArrow b XmlTree readDoc src- = readDocument [ withTagSoup- , withParseHTML no- , withRemoveWS yes- , withInputEncoding isoLatin1- , withWarnings no- , withTrace 1- , withStrictInput no- ] src+ = readDocument [ withParseHTML no+ , withTrace 2+ , withValidate no+ , withInputEncoding isoLatin1+ , withWarnings yes+ , withStrictInput no+ , withCanonicalize yes+ , withRemoveWS no+ -- , withExpat yes+ -- , withTagSoup+ ] src+{- >>>- processChildren (isElem `guards` this)-+ perform ( writeDocument [ withShowTree yes+ , withOutputHTML+ ] ""+ )+ >>>+ perform ( writeDocument [ withShowTree no+ , withOutputHTML+ ] ""+ )+-} -- ---------------------------------------- -unpickleTree :: ArrowXml a => a XmlTree BTree-unpickleTree = xunpickleVal xpickle+unpickleTree :: ArrowXml a => a XmlTree BTree+unpickleTree = xunpickleVal xpickle -- ---------------------------------------- -pruneForkRight :: LA XmlTree XmlTree+pruneForkRight :: LA XmlTree XmlTree pruneForkRight = ( replaceChildren- ( ( getChildren >>. take 1 )- >>>- pruneForkRight- )+ ( ( getChildren >>. take 1 )+ >>>+ pruneForkRight+ ) ) `when` (hasName "fork") -pruneForkLeft :: LA XmlTree XmlTree+pruneForkLeft :: LA XmlTree XmlTree pruneForkLeft = ( replaceChildren- ( ( getChildren >>. drop 1 )- >>>- pruneForkLeft- )+ ( ( getChildren >>. drop 1 )+ >>>+ pruneForkLeft+ ) ) `when` (hasName "fork") -- ---------------------------------------- -type Counter a = State Int a+type Counter a = State Int a -incr :: Counter Int-incr = do- modify (+1)- get+incr :: Counter Int+incr = do+ modify (+1)+ get -- ---------------------------------------- -data BTree = Leaf Int- | Fork BTree BTree- deriving (Show)+data BTree = Leaf Int+ | Fork BTree BTree+ deriving (Show) +instance NFData BTree where+ rnf (Leaf i) = rnf i+ rnf (Fork t1 t2) = rnf t1 `seq` rnf t2+ instance XmlPickler BTree where xpickle = xpAlt tag ps- where- tag (Leaf _ ) = 0- tag (Fork _ _ ) = 1- ps = [ xpWrap ( Leaf, \ (Leaf i) -> i)- ( xpElem "leaf" $ xpAttr "value" $ xpickle )+ where+ tag (Leaf _ ) = 0+ tag (Fork _ _ ) = 1 - , xpWrap ( uncurry Fork, \ (Fork l r) -> (l, r))- ( xpElem "fork" $ xpPair xpickle xpickle )- ]+ ps = [ xpWrap ( Leaf, \ (Leaf i) -> i)+ ( xpElem "leaf" $ xpAttr "value" $ xpInt ) -- xpWrap (const 0, const ">&\"äöü") $ xpText )+ , xpWrap ( uncurry Fork, \ (Fork l r) -> (l, r))+ ( xpElem "fork" $ xpPair xpickle xpickle )+ ] -- ---------------------------------------- -mkBTree :: Int -> BTree-mkBTree depth = evalState (mkT depth) 0+mkBTree :: Int -> BTree+mkBTree depth = evalState (mkT depth) 0+ where+ mkT :: Int -> Counter BTree+ mkT 0 = do+ i <- incr+ return (Leaf i)+ mkT n = do+ l <- mkT (n-1)+ r <- mkT (n-1)+ return (Fork l r) -mkT :: Int -> Counter BTree-mkT 0 = do- i <- incr- return (Leaf i)-mkT n = do- l <- mkT (n-1)- r <- mkT (n-1)- return (Fork l r)+bTreeToNTree :: BTree -> NTree Int+bTreeToNTree (Leaf i) = NTree i []+bTreeToNTree (Fork l r) = NTree j [l',r']+ where+ l' = bTreeToNTree l+ r' = bTreeToNTree r+ j = T.getNode l' + T.getNode r' +mkNTree = bTreeToNTree . mkBTree+ -- ---------------------------------------- -foldT1 :: (Int -> Int -> Int) -> BTree -> Int-foldT1 _ (Leaf v) = v-foldT1 op (Fork l r) = foldT1 op l `op` foldT1 op r+foldT1 :: (Int -> Int -> Int) -> BTree -> Int+foldT1 _ (Leaf v) = v+foldT1 op (Fork l r) = foldT1 op l `op` foldT1 op r -- ---------------------------------------- @@ -248,8 +410,17 @@ -- docs with latin1 encoding. Here ist done even with ASCCI -- every none ASCII char is represented by a char ref (&nnn;) -putDoc :: String -> IOStateArrow s XmlTree XmlTree+putDoc :: String -> IOStateArrow s XmlTree XmlTree putDoc dst+ = writeDocument [ withOutputEncoding isoLatin1+ , withOutputXML+ ] dst++-- ----------------------------------------+{-++putDoc :: String -> IOStateArrow s XmlTree XmlTree+putDoc dst = addXmlPi >>> addXmlPiEncoding isoLatin1@@ -262,16 +433,16 @@ >>> none where- isStdout = null dst || dst == "-"+ isStdout = null dst || dst == "-" - hPutDocument :: (Handle -> IO()) -> IO()+ hPutDocument :: (Handle -> IO()) -> IO() hPutDocument action- | isStdout- = action stdout- | otherwise- = do- handle <- openBinaryFile dst WriteMode- action handle- hClose handle-+ | isStdout+ = action stdout+ | otherwise+ = do+ handle <- openBinaryFile dst WriteMode+ action handle+ hClose handle+-} -- ----------------------------------------
examples/arrows/performance/Makefile view
@@ -11,16 +11,21 @@ CNT = 3 ropts = +RTS -s -RTS +popts = +RTS -P -hy -RTS prog = ./GenDoc prog2 = ./ReadDoc prog3 = ./PruneRight prog4 = ./PruneLeft prog5 = ./MemTest-progs = $(prog) $(prog2) $(prog3) $(prog4) $(prog5)+prog6 = ./MemTest1+progs = $(prog) $(prog2) $(prog3) $(prog4) $(prog5) $(prog6) all : $(progs) +prof :+ $(MAKE) all PKGFLAGS="-prof -auto-all -caf-all"+ $(prog) : $(prog).hs $(GHC) --make -o $@ $< @@ -39,6 +44,9 @@ $(prog5) : $(prog) ln -f $(prog) $(prog5) +$(prog6) : $(prog)+ ln -f $(prog) $(prog6)+ # generate and read documents containing a binary tree # with 2^i leaf nodes containing the numbers 1 to 2^i # for i up to at least 22 (8M XML elements) output works fine@@ -48,6 +56,7 @@ # these tests have run on a box with 1Gb memory tests = 2 3 10 11 12+ptests = 16 test : $(prog) $(MAKE) genfiles tests="$(tests)"@@ -58,11 +67,20 @@ perftest : $(prog) $(MAKE) test tests="2 3 10 11 12 13 14 15 16 17 18 19 20" +pgenfiles :+ rm -f $(prog).aux $(prog).hp $(prog).ps $(prog).prof+ $(MAKE) genfiles ropts="$(popts)" tests=$(ptests)+ hp2ps -c $(prog).hp++preadfiles :+ $(MAKE) readfiles ropts="$(popts)" tests=$(ptests)+ hp2ps -c $(prog2).hp+ genfiles : @for i in $(tests) ; \ do \ echo time $(prog) $(ropts) $$i ; \- time $(prog) $$i ; \+ time $(prog) $(ropts) $$i ; \ ls -l tree-*$$i.xml ; \ echo ; \ done@@ -71,7 +89,7 @@ @for i in $(tests) ; \ do \ echo time $(prog2) $(ropts) $$i ; \- time $(prog2) $$i ; \+ time $(prog2) $(ropts) $$i ; \ echo ; \ done @@ -79,7 +97,7 @@ @for i in $(tests) ; \ do \ echo time $(prog3) $(ropts) $$i ; \- time $(prog3) $$i ; \+ time $(prog3) $(ropts) $$i ; \ echo ; \ done @@ -87,14 +105,14 @@ @for i in $(tests) ; \ do \ echo time $(prog4) $(ropts) $$i ; \- time $(prog4) $$i ; \+ time $(prog4) $(ropts) $$i ; \ echo ; \ done memtest : @for i in $(tests) ; \ do \- echo time $(prog5) $$i ; \+ echo time $(prog5) $(ropts) $$i ; \ time $(prog5) $(ropts) $$i ; \ echo ; \ done
examples/arrows/pickle/PickleTest.hs view
@@ -71,29 +71,45 @@ tag (UnExpr _ _ ) = 3 tag (BinExpr _ _ _ ) = 4 ps = [ xpWrap ( IntConst- , \ (IntConst i ) -> i ) ( xpElem "int" $- xpAttr "value" $- xpickle )+ , \ (IntConst i ) -> i+ ) $+ ( xpElem "int" $+ xpAttr "value" $+ xpickle+ ) , xpWrap ( BoolConst- , \ (BoolConst b) -> b) ( xpElem "bool" $- xpAttr "value" $- xpWrap (toEnum, fromEnum) xpickle )+ , \ (BoolConst b) -> b+ ) $+ ( xpElem "bool" $+ xpAttr "value" $+ xpWrap (toEnum, fromEnum) xpickle+ ) , xpWrap ( Var- , \ (Var n) -> n) ( xpElem "var" $- xpAttr "name" $- xpText )+ , \ (Var n) -> n+ ) $+ ( xpElem "var" $+ xpAttr "name" $+ xpText+ ) , xpWrap ( uncurry UnExpr- , \ (UnExpr op e) -> (op, e))- ( xpElem "unex" $- xpPair (xpAttr "op" xpickle) xpickle )+ , \ (UnExpr op e) -> (op, e)+ ) $+ ( xpElem "unex" $+ xpPair (xpAttr "op" xpickle)+ xpickle+ ) , xpWrap ( uncurry3 $ BinExpr- , \ (BinExpr op e1 e2) -> (op, e1, e2))- ( xpElem "binex" $- xpTriple (xpAttr "op" xpickle) xpickle xpickle )+ , \ (BinExpr op e1 e2) -> (op, e1, e2)+ ) $+ ( xpElem "binex" $+ xpTriple (xpAttr "op" xpickle)+ xpickle+ xpickle+ ) ] instance XmlPickler Stmt where@@ -104,20 +120,33 @@ tag ( If _ _ _ ) = 2 tag ( While _ _ ) = 3 ps = [ xpWrap ( uncurry Assign- , \ (Assign n v) -> (n, v))- ( xpElem "assign" $- xpPair (xpAttr "name" xpText) xpickle )+ , \ (Assign n v) -> (n, v)+ ) $+ ( xpElem "assign" $+ xpPair (xpAttr "name" xpText)+ xpickle+ ) , xpWrap ( Stmts- , \ (Stmts sl) -> sl) ( xpElem "block" $- xpList xpickle )+ , \ (Stmts sl) -> sl+ ) $+ ( xpElem "block" $+ xpList xpickle+ ) , xpWrap ( uncurry3 If- , \ (If c t e) -> (c, t, e))- ( xpElem "if" $- xpTriple xpickle xpickle xpickle )+ , \ (If c t e) -> (c, t, e)+ ) $+ ( xpElem "if" $+ xpTriple xpickle+ xpickle+ xpickle+ ) , xpWrap ( uncurry While- , \ (While c b) -> (c, b))- ( xpElem "while" $- xpPair xpickle xpickle )+ , \ (While c b) -> (c, b)+ ) $+ ( xpElem "while" $+ xpPair xpickle+ xpickle+ ) ] -- ------------------------------------------------------------
+ examples/xhtml/tmp.xml view
@@ -0,0 +1,4 @@+<!DOCTYPE html SYSTEM "xhtml1-strict.dtd">+<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">+<head><title/></head><body/>+</html>
+ examples/xhtml/xhtml-lat1.ent view
@@ -0,0 +1,196 @@+<!-- Portions (C) International Organization for Standardization 1986+ Permission to copy in any form is granted for use with+ conforming SGML systems and applications as defined in+ ISO 8879, provided this notice is included in all copies.+-->+<!-- Character entity set. Typical invocation:+ <!ENTITY % HTMLlat1 PUBLIC+ "-//W3C//ENTITIES Latin 1 for XHTML//EN"+ "http://www.w3.org/TR/xhtml1/DTD/xhtml-lat1.ent">+ %HTMLlat1;+-->++<!ENTITY nbsp " "> <!-- no-break space = non-breaking space,+ U+00A0 ISOnum -->+<!ENTITY iexcl "¡"> <!-- inverted exclamation mark, U+00A1 ISOnum -->+<!ENTITY cent "¢"> <!-- cent sign, U+00A2 ISOnum -->+<!ENTITY pound "£"> <!-- pound sign, U+00A3 ISOnum -->+<!ENTITY curren "¤"> <!-- currency sign, U+00A4 ISOnum -->+<!ENTITY yen "¥"> <!-- yen sign = yuan sign, U+00A5 ISOnum -->+<!ENTITY brvbar "¦"> <!-- broken bar = broken vertical bar,+ U+00A6 ISOnum -->+<!ENTITY sect "§"> <!-- section sign, U+00A7 ISOnum -->+<!ENTITY uml "¨"> <!-- diaeresis = spacing diaeresis,+ U+00A8 ISOdia -->+<!ENTITY copy "©"> <!-- copyright sign, U+00A9 ISOnum -->+<!ENTITY ordf "ª"> <!-- feminine ordinal indicator, U+00AA ISOnum -->+<!ENTITY laquo "«"> <!-- left-pointing double angle quotation mark+ = left pointing guillemet, U+00AB ISOnum -->+<!ENTITY not "¬"> <!-- not sign = discretionary hyphen,+ U+00AC ISOnum -->+<!ENTITY shy "­"> <!-- soft hyphen = discretionary hyphen,+ U+00AD ISOnum -->+<!ENTITY reg "®"> <!-- registered sign = registered trade mark sign,+ U+00AE ISOnum -->+<!ENTITY macr "¯"> <!-- macron = spacing macron = overline+ = APL overbar, U+00AF ISOdia -->+<!ENTITY deg "°"> <!-- degree sign, U+00B0 ISOnum -->+<!ENTITY plusmn "±"> <!-- plus-minus sign = plus-or-minus sign,+ U+00B1 ISOnum -->+<!ENTITY sup2 "²"> <!-- superscript two = superscript digit two+ = squared, U+00B2 ISOnum -->+<!ENTITY sup3 "³"> <!-- superscript three = superscript digit three+ = cubed, U+00B3 ISOnum -->+<!ENTITY acute "´"> <!-- acute accent = spacing acute,+ U+00B4 ISOdia -->+<!ENTITY micro "µ"> <!-- micro sign, U+00B5 ISOnum -->+<!ENTITY para "¶"> <!-- pilcrow sign = paragraph sign,+ U+00B6 ISOnum -->+<!ENTITY middot "·"> <!-- middle dot = Georgian comma+ = Greek middle dot, U+00B7 ISOnum -->+<!ENTITY cedil "¸"> <!-- cedilla = spacing cedilla, U+00B8 ISOdia -->+<!ENTITY sup1 "¹"> <!-- superscript one = superscript digit one,+ U+00B9 ISOnum -->+<!ENTITY ordm "º"> <!-- masculine ordinal indicator,+ U+00BA ISOnum -->+<!ENTITY raquo "»"> <!-- right-pointing double angle quotation mark+ = right pointing guillemet, U+00BB ISOnum -->+<!ENTITY frac14 "¼"> <!-- vulgar fraction one quarter+ = fraction one quarter, U+00BC ISOnum -->+<!ENTITY frac12 "½"> <!-- vulgar fraction one half+ = fraction one half, U+00BD ISOnum -->+<!ENTITY frac34 "¾"> <!-- vulgar fraction three quarters+ = fraction three quarters, U+00BE ISOnum -->+<!ENTITY iquest "¿"> <!-- inverted question mark+ = turned question mark, U+00BF ISOnum -->+<!ENTITY Agrave "À"> <!-- latin capital letter A with grave+ = latin capital letter A grave,+ U+00C0 ISOlat1 -->+<!ENTITY Aacute "Á"> <!-- latin capital letter A with acute,+ U+00C1 ISOlat1 -->+<!ENTITY Acirc "Â"> <!-- latin capital letter A with circumflex,+ U+00C2 ISOlat1 -->+<!ENTITY Atilde "Ã"> <!-- latin capital letter A with tilde,+ U+00C3 ISOlat1 -->+<!ENTITY Auml "Ä"> <!-- latin capital letter A with diaeresis,+ U+00C4 ISOlat1 -->+<!ENTITY Aring "Å"> <!-- latin capital letter A with ring above+ = latin capital letter A ring,+ U+00C5 ISOlat1 -->+<!ENTITY AElig "Æ"> <!-- latin capital letter AE+ = latin capital ligature AE,+ U+00C6 ISOlat1 -->+<!ENTITY Ccedil "Ç"> <!-- latin capital letter C with cedilla,+ U+00C7 ISOlat1 -->+<!ENTITY Egrave "È"> <!-- latin capital letter E with grave,+ U+00C8 ISOlat1 -->+<!ENTITY Eacute "É"> <!-- latin capital letter E with acute,+ U+00C9 ISOlat1 -->+<!ENTITY Ecirc "Ê"> <!-- latin capital letter E with circumflex,+ U+00CA ISOlat1 -->+<!ENTITY Euml "Ë"> <!-- latin capital letter E with diaeresis,+ U+00CB ISOlat1 -->+<!ENTITY Igrave "Ì"> <!-- latin capital letter I with grave,+ U+00CC ISOlat1 -->+<!ENTITY Iacute "Í"> <!-- latin capital letter I with acute,+ U+00CD ISOlat1 -->+<!ENTITY Icirc "Î"> <!-- latin capital letter I with circumflex,+ U+00CE ISOlat1 -->+<!ENTITY Iuml "Ï"> <!-- latin capital letter I with diaeresis,+ U+00CF ISOlat1 -->+<!ENTITY ETH "Ð"> <!-- latin capital letter ETH, U+00D0 ISOlat1 -->+<!ENTITY Ntilde "Ñ"> <!-- latin capital letter N with tilde,+ U+00D1 ISOlat1 -->+<!ENTITY Ograve "Ò"> <!-- latin capital letter O with grave,+ U+00D2 ISOlat1 -->+<!ENTITY Oacute "Ó"> <!-- latin capital letter O with acute,+ U+00D3 ISOlat1 -->+<!ENTITY Ocirc "Ô"> <!-- latin capital letter O with circumflex,+ U+00D4 ISOlat1 -->+<!ENTITY Otilde "Õ"> <!-- latin capital letter O with tilde,+ U+00D5 ISOlat1 -->+<!ENTITY Ouml "Ö"> <!-- latin capital letter O with diaeresis,+ U+00D6 ISOlat1 -->+<!ENTITY times "×"> <!-- multiplication sign, U+00D7 ISOnum -->+<!ENTITY Oslash "Ø"> <!-- latin capital letter O with stroke+ = latin capital letter O slash,+ U+00D8 ISOlat1 -->+<!ENTITY Ugrave "Ù"> <!-- latin capital letter U with grave,+ U+00D9 ISOlat1 -->+<!ENTITY Uacute "Ú"> <!-- latin capital letter U with acute,+ U+00DA ISOlat1 -->+<!ENTITY Ucirc "Û"> <!-- latin capital letter U with circumflex,+ U+00DB ISOlat1 -->+<!ENTITY Uuml "Ü"> <!-- latin capital letter U with diaeresis,+ U+00DC ISOlat1 -->+<!ENTITY Yacute "Ý"> <!-- latin capital letter Y with acute,+ U+00DD ISOlat1 -->+<!ENTITY THORN "Þ"> <!-- latin capital letter THORN,+ U+00DE ISOlat1 -->+<!ENTITY szlig "ß"> <!-- latin small letter sharp s = ess-zed,+ U+00DF ISOlat1 -->+<!ENTITY agrave "à"> <!-- latin small letter a with grave+ = latin small letter a grave,+ U+00E0 ISOlat1 -->+<!ENTITY aacute "á"> <!-- latin small letter a with acute,+ U+00E1 ISOlat1 -->+<!ENTITY acirc "â"> <!-- latin small letter a with circumflex,+ U+00E2 ISOlat1 -->+<!ENTITY atilde "ã"> <!-- latin small letter a with tilde,+ U+00E3 ISOlat1 -->+<!ENTITY auml "ä"> <!-- latin small letter a with diaeresis,+ U+00E4 ISOlat1 -->+<!ENTITY aring "å"> <!-- latin small letter a with ring above+ = latin small letter a ring,+ U+00E5 ISOlat1 -->+<!ENTITY aelig "æ"> <!-- latin small letter ae+ = latin small ligature ae, U+00E6 ISOlat1 -->+<!ENTITY ccedil "ç"> <!-- latin small letter c with cedilla,+ U+00E7 ISOlat1 -->+<!ENTITY egrave "è"> <!-- latin small letter e with grave,+ U+00E8 ISOlat1 -->+<!ENTITY eacute "é"> <!-- latin small letter e with acute,+ U+00E9 ISOlat1 -->+<!ENTITY ecirc "ê"> <!-- latin small letter e with circumflex,+ U+00EA ISOlat1 -->+<!ENTITY euml "ë"> <!-- latin small letter e with diaeresis,+ U+00EB ISOlat1 -->+<!ENTITY igrave "ì"> <!-- latin small letter i with grave,+ U+00EC ISOlat1 -->+<!ENTITY iacute "í"> <!-- latin small letter i with acute,+ U+00ED ISOlat1 -->+<!ENTITY icirc "î"> <!-- latin small letter i with circumflex,+ U+00EE ISOlat1 -->+<!ENTITY iuml "ï"> <!-- latin small letter i with diaeresis,+ U+00EF ISOlat1 -->+<!ENTITY eth "ð"> <!-- latin small letter eth, U+00F0 ISOlat1 -->+<!ENTITY ntilde "ñ"> <!-- latin small letter n with tilde,+ U+00F1 ISOlat1 -->+<!ENTITY ograve "ò"> <!-- latin small letter o with grave,+ U+00F2 ISOlat1 -->+<!ENTITY oacute "ó"> <!-- latin small letter o with acute,+ U+00F3 ISOlat1 -->+<!ENTITY ocirc "ô"> <!-- latin small letter o with circumflex,+ U+00F4 ISOlat1 -->+<!ENTITY otilde "õ"> <!-- latin small letter o with tilde,+ U+00F5 ISOlat1 -->+<!ENTITY ouml "ö"> <!-- latin small letter o with diaeresis,+ U+00F6 ISOlat1 -->+<!ENTITY divide "÷"> <!-- division sign, U+00F7 ISOnum -->+<!ENTITY oslash "ø"> <!-- latin small letter o with stroke,+ = latin small letter o slash,+ U+00F8 ISOlat1 -->+<!ENTITY ugrave "ù"> <!-- latin small letter u with grave,+ U+00F9 ISOlat1 -->+<!ENTITY uacute "ú"> <!-- latin small letter u with acute,+ U+00FA ISOlat1 -->+<!ENTITY ucirc "û"> <!-- latin small letter u with circumflex,+ U+00FB ISOlat1 -->+<!ENTITY uuml "ü"> <!-- latin small letter u with diaeresis,+ U+00FC ISOlat1 -->+<!ENTITY yacute "ý"> <!-- latin small letter y with acute,+ U+00FD ISOlat1 -->+<!ENTITY thorn "þ"> <!-- latin small letter thorn with,+ U+00FE ISOlat1 -->+<!ENTITY yuml "ÿ"> <!-- latin small letter y with diaeresis,+ U+00FF ISOlat1 -->
+ examples/xhtml/xhtml-special.ent view
@@ -0,0 +1,79 @@+<!-- Special characters for HTML -->++<!-- Character entity set. Typical invocation:+ <!ENTITY % HTMLspecial PUBLIC+ "-//W3C//ENTITIES Special for XHTML//EN"+ "http://www.w3.org/TR/xhtml1/DTD/xhtml-special.ent">+ %HTMLspecial;+-->++<!-- Portions (C) International Organization for Standardization 1986:+ Permission to copy in any form is granted for use with+ conforming SGML systems and applications as defined in+ ISO 8879, provided this notice is included in all copies.+-->++<!-- Relevant ISO entity set is given unless names are newly introduced.+ New names (i.e., not in ISO 8879 list) do not clash with any+ existing ISO 8879 entity names. ISO 10646 character numbers+ are given for each character, in hex. values are decimal+ conversions of the ISO 10646 values and refer to the document+ character set. Names are Unicode names. +-->++<!-- C0 Controls and Basic Latin -->+<!ENTITY quot """> <!-- quotation mark = APL quote,+ U+0022 ISOnum -->+<!ENTITY amp "&#38;"> <!-- ampersand, U+0026 ISOnum -->+<!ENTITY lt "&#60;"> <!-- less-than sign, U+003C ISOnum -->+<!ENTITY gt ">"> <!-- greater-than sign, U+003E ISOnum -->+<!ENTITY apos "'"> <!-- apostrophe mark, U+0027 ISOnum -->++<!-- Latin Extended-A -->+<!ENTITY OElig "Œ"> <!-- latin capital ligature OE,+ U+0152 ISOlat2 -->+<!ENTITY oelig "œ"> <!-- latin small ligature oe, U+0153 ISOlat2 -->+<!-- ligature is a misnomer, this is a separate character in some languages -->+<!ENTITY Scaron "Š"> <!-- latin capital letter S with caron,+ U+0160 ISOlat2 -->+<!ENTITY scaron "š"> <!-- latin small letter s with caron,+ U+0161 ISOlat2 -->+<!ENTITY Yuml "Ÿ"> <!-- latin capital letter Y with diaeresis,+ U+0178 ISOlat2 -->++<!-- Spacing Modifier Letters -->+<!ENTITY circ "ˆ"> <!-- modifier letter circumflex accent,+ U+02C6 ISOpub -->+<!ENTITY tilde "˜"> <!-- small tilde, U+02DC ISOdia -->++<!-- General Punctuation -->+<!ENTITY ensp " "> <!-- en space, U+2002 ISOpub -->+<!ENTITY emsp " "> <!-- em space, U+2003 ISOpub -->+<!ENTITY thinsp " "> <!-- thin space, U+2009 ISOpub -->+<!ENTITY zwnj "‌"> <!-- zero width non-joiner,+ U+200C NEW RFC 2070 -->+<!ENTITY zwj "‍"> <!-- zero width joiner, U+200D NEW RFC 2070 -->+<!ENTITY lrm "‎"> <!-- left-to-right mark, U+200E NEW RFC 2070 -->+<!ENTITY rlm "‏"> <!-- right-to-left mark, U+200F NEW RFC 2070 -->+<!ENTITY ndash "–"> <!-- en dash, U+2013 ISOpub -->+<!ENTITY mdash "—"> <!-- em dash, U+2014 ISOpub -->+<!ENTITY lsquo "‘"> <!-- left single quotation mark,+ U+2018 ISOnum -->+<!ENTITY rsquo "’"> <!-- right single quotation mark,+ U+2019 ISOnum -->+<!ENTITY sbquo "‚"> <!-- single low-9 quotation mark, U+201A NEW -->+<!ENTITY ldquo "“"> <!-- left double quotation mark,+ U+201C ISOnum -->+<!ENTITY rdquo "”"> <!-- right double quotation mark,+ U+201D ISOnum -->+<!ENTITY bdquo "„"> <!-- double low-9 quotation mark, U+201E NEW -->+<!ENTITY dagger "†"> <!-- dagger, U+2020 ISOpub -->+<!ENTITY Dagger "‡"> <!-- double dagger, U+2021 ISOpub -->+<!ENTITY permil "‰"> <!-- per mille sign, U+2030 ISOtech -->+<!ENTITY lsaquo "‹"> <!-- single left-pointing angle quotation mark,+ U+2039 ISO proposed -->+<!-- lsaquo is proposed but not yet ISO standardized -->+<!ENTITY rsaquo "›"> <!-- single right-pointing angle quotation mark,+ U+203A ISO proposed -->+<!-- rsaquo is proposed but not yet ISO standardized -->+<!ENTITY euro "€"> <!-- euro sign, U+20AC NEW -->
+ examples/xhtml/xhtml-symbol.ent view
@@ -0,0 +1,242 @@+<!-- Mathematical, Greek and Symbolic characters for HTML -->++<!-- Character entity set. Typical invocation:+ <!ENTITY % HTMLsymbol PUBLIC+ "-//W3C//ENTITIES Symbols for XHTML//EN"+ "http://www.w3.org/TR/xhtml1/DTD/xhtml-symbol.ent">+ %HTMLsymbol;+-->++<!-- Portions (C) International Organization for Standardization 1986:+ Permission to copy in any form is granted for use with+ conforming SGML systems and applications as defined in+ ISO 8879, provided this notice is included in all copies.+-->++<!-- Relevant ISO entity set is given unless names are newly introduced.+ New names (i.e., not in ISO 8879 list) do not clash with any+ existing ISO 8879 entity names. ISO 10646 character numbers+ are given for each character, in hex. values are decimal+ conversions of the ISO 10646 values and refer to the document+ character set. Names are Unicode names. +-->++<!-- Latin Extended-B -->+<!ENTITY fnof "ƒ"> <!-- latin small f with hook = function+ = florin, U+0192 ISOtech -->++<!-- Greek -->+<!ENTITY Alpha "Α"> <!-- greek capital letter alpha, U+0391 -->+<!ENTITY Beta "Β"> <!-- greek capital letter beta, U+0392 -->+<!ENTITY Gamma "Γ"> <!-- greek capital letter gamma,+ U+0393 ISOgrk3 -->+<!ENTITY Delta "Δ"> <!-- greek capital letter delta,+ U+0394 ISOgrk3 -->+<!ENTITY Epsilon "Ε"> <!-- greek capital letter epsilon, U+0395 -->+<!ENTITY Zeta "Ζ"> <!-- greek capital letter zeta, U+0396 -->+<!ENTITY Eta "Η"> <!-- greek capital letter eta, U+0397 -->+<!ENTITY Theta "Θ"> <!-- greek capital letter theta,+ U+0398 ISOgrk3 -->+<!ENTITY Iota "Ι"> <!-- greek capital letter iota, U+0399 -->+<!ENTITY Kappa "Κ"> <!-- greek capital letter kappa, U+039A -->+<!ENTITY Lambda "Λ"> <!-- greek capital letter lambda,+ U+039B ISOgrk3 -->+<!ENTITY Mu "Μ"> <!-- greek capital letter mu, U+039C -->+<!ENTITY Nu "Ν"> <!-- greek capital letter nu, U+039D -->+<!ENTITY Xi "Ξ"> <!-- greek capital letter xi, U+039E ISOgrk3 -->+<!ENTITY Omicron "Ο"> <!-- greek capital letter omicron, U+039F -->+<!ENTITY Pi "Π"> <!-- greek capital letter pi, U+03A0 ISOgrk3 -->+<!ENTITY Rho "Ρ"> <!-- greek capital letter rho, U+03A1 -->+<!-- there is no Sigmaf, and no U+03A2 character either -->+<!ENTITY Sigma "Σ"> <!-- greek capital letter sigma,+ U+03A3 ISOgrk3 -->+<!ENTITY Tau "Τ"> <!-- greek capital letter tau, U+03A4 -->+<!ENTITY Upsilon "Υ"> <!-- greek capital letter upsilon,+ U+03A5 ISOgrk3 -->+<!ENTITY Phi "Φ"> <!-- greek capital letter phi,+ U+03A6 ISOgrk3 -->+<!ENTITY Chi "Χ"> <!-- greek capital letter chi, U+03A7 -->+<!ENTITY Psi "Ψ"> <!-- greek capital letter psi,+ U+03A8 ISOgrk3 -->+<!ENTITY Omega "Ω"> <!-- greek capital letter omega,+ U+03A9 ISOgrk3 -->++<!ENTITY alpha "α"> <!-- greek small letter alpha,+ U+03B1 ISOgrk3 -->+<!ENTITY beta "β"> <!-- greek small letter beta, U+03B2 ISOgrk3 -->+<!ENTITY gamma "γ"> <!-- greek small letter gamma,+ U+03B3 ISOgrk3 -->+<!ENTITY delta "δ"> <!-- greek small letter delta,+ U+03B4 ISOgrk3 -->+<!ENTITY epsilon "ε"> <!-- greek small letter epsilon,+ U+03B5 ISOgrk3 -->+<!ENTITY zeta "ζ"> <!-- greek small letter zeta, U+03B6 ISOgrk3 -->+<!ENTITY eta "η"> <!-- greek small letter eta, U+03B7 ISOgrk3 -->+<!ENTITY theta "θ"> <!-- greek small letter theta,+ U+03B8 ISOgrk3 -->+<!ENTITY iota "ι"> <!-- greek small letter iota, U+03B9 ISOgrk3 -->+<!ENTITY kappa "κ"> <!-- greek small letter kappa,+ U+03BA ISOgrk3 -->+<!ENTITY lambda "λ"> <!-- greek small letter lambda,+ U+03BB ISOgrk3 -->+<!ENTITY mu "μ"> <!-- greek small letter mu, U+03BC ISOgrk3 -->+<!ENTITY nu "ν"> <!-- greek small letter nu, U+03BD ISOgrk3 -->+<!ENTITY xi "ξ"> <!-- greek small letter xi, U+03BE ISOgrk3 -->+<!ENTITY omicron "ο"> <!-- greek small letter omicron, U+03BF NEW -->+<!ENTITY pi "π"> <!-- greek small letter pi, U+03C0 ISOgrk3 -->+<!ENTITY rho "ρ"> <!-- greek small letter rho, U+03C1 ISOgrk3 -->+<!ENTITY sigmaf "ς"> <!-- greek small letter final sigma,+ U+03C2 ISOgrk3 -->+<!ENTITY sigma "σ"> <!-- greek small letter sigma,+ U+03C3 ISOgrk3 -->+<!ENTITY tau "τ"> <!-- greek small letter tau, U+03C4 ISOgrk3 -->+<!ENTITY upsilon "υ"> <!-- greek small letter upsilon,+ U+03C5 ISOgrk3 -->+<!ENTITY phi "φ"> <!-- greek small letter phi, U+03C6 ISOgrk3 -->+<!ENTITY chi "χ"> <!-- greek small letter chi, U+03C7 ISOgrk3 -->+<!ENTITY psi "ψ"> <!-- greek small letter psi, U+03C8 ISOgrk3 -->+<!ENTITY omega "ω"> <!-- greek small letter omega,+ U+03C9 ISOgrk3 -->+<!ENTITY thetasym "ϑ"> <!-- greek small letter theta symbol,+ U+03D1 NEW -->+<!ENTITY upsih "ϒ"> <!-- greek upsilon with hook symbol,+ U+03D2 NEW -->+<!ENTITY piv "ϖ"> <!-- greek pi symbol, U+03D6 ISOgrk3 -->++<!-- General Punctuation -->+<!ENTITY bull "•"> <!-- bullet = black small circle,+ U+2022 ISOpub -->+<!-- bullet is NOT the same as bullet operator, U+2219 -->+<!ENTITY hellip "…"> <!-- horizontal ellipsis = three dot leader,+ U+2026 ISOpub -->+<!ENTITY prime "′"> <!-- prime = minutes = feet, U+2032 ISOtech -->+<!ENTITY Prime "″"> <!-- double prime = seconds = inches,+ U+2033 ISOtech -->+<!ENTITY oline "‾"> <!-- overline = spacing overscore,+ U+203E NEW -->+<!ENTITY frasl "⁄"> <!-- fraction slash, U+2044 NEW -->++<!-- Letterlike Symbols -->+<!ENTITY weierp "℘"> <!-- script capital P = power set+ = Weierstrass p, U+2118 ISOamso -->+<!ENTITY image "ℑ"> <!-- blackletter capital I = imaginary part,+ U+2111 ISOamso -->+<!ENTITY real "ℜ"> <!-- blackletter capital R = real part symbol,+ U+211C ISOamso -->+<!ENTITY trade "™"> <!-- trade mark sign, U+2122 ISOnum -->+<!ENTITY alefsym "ℵ"> <!-- alef symbol = first transfinite cardinal,+ U+2135 NEW -->+<!-- alef symbol is NOT the same as hebrew letter alef,+ U+05D0 although the same glyph could be used to depict both characters -->++<!-- Arrows -->+<!ENTITY larr "←"> <!-- leftwards arrow, U+2190 ISOnum -->+<!ENTITY uarr "↑"> <!-- upwards arrow, U+2191 ISOnum-->+<!ENTITY rarr "→"> <!-- rightwards arrow, U+2192 ISOnum -->+<!ENTITY darr "↓"> <!-- downwards arrow, U+2193 ISOnum -->+<!ENTITY harr "↔"> <!-- left right arrow, U+2194 ISOamsa -->+<!ENTITY crarr "↵"> <!-- downwards arrow with corner leftwards+ = carriage return, U+21B5 NEW -->+<!ENTITY lArr "⇐"> <!-- leftwards double arrow, U+21D0 ISOtech -->+<!-- Unicode does not say that lArr is the same as the 'is implied by' arrow+ but also does not have any other character for that function. So ? lArr can+ be used for 'is implied by' as ISOtech suggests -->+<!ENTITY uArr "⇑"> <!-- upwards double arrow, U+21D1 ISOamsa -->+<!ENTITY rArr "⇒"> <!-- rightwards double arrow,+ U+21D2 ISOtech -->+<!-- Unicode does not say this is the 'implies' character but does not have + another character with this function so ?+ rArr can be used for 'implies' as ISOtech suggests -->+<!ENTITY dArr "⇓"> <!-- downwards double arrow, U+21D3 ISOamsa -->+<!ENTITY hArr "⇔"> <!-- left right double arrow,+ U+21D4 ISOamsa -->++<!-- Mathematical Operators -->+<!ENTITY forall "∀"> <!-- for all, U+2200 ISOtech -->+<!ENTITY part "∂"> <!-- partial differential, U+2202 ISOtech -->+<!ENTITY exist "∃"> <!-- there exists, U+2203 ISOtech -->+<!ENTITY empty "∅"> <!-- empty set = null set = diameter,+ U+2205 ISOamso -->+<!ENTITY nabla "∇"> <!-- nabla = backward difference,+ U+2207 ISOtech -->+<!ENTITY isin "∈"> <!-- element of, U+2208 ISOtech -->+<!ENTITY notin "∉"> <!-- not an element of, U+2209 ISOtech -->+<!ENTITY ni "∋"> <!-- contains as member, U+220B ISOtech -->+<!-- should there be a more memorable name than 'ni'? -->+<!ENTITY prod "∏"> <!-- n-ary product = product sign,+ U+220F ISOamsb -->+<!-- prod is NOT the same character as U+03A0 'greek capital letter pi' though+ the same glyph might be used for both -->+<!ENTITY sum "∑"> <!-- n-ary sumation, U+2211 ISOamsb -->+<!-- sum is NOT the same character as U+03A3 'greek capital letter sigma'+ though the same glyph might be used for both -->+<!ENTITY minus "−"> <!-- minus sign, U+2212 ISOtech -->+<!ENTITY lowast "∗"> <!-- asterisk operator, U+2217 ISOtech -->+<!ENTITY radic "√"> <!-- square root = radical sign,+ U+221A ISOtech -->+<!ENTITY prop "∝"> <!-- proportional to, U+221D ISOtech -->+<!ENTITY infin "∞"> <!-- infinity, U+221E ISOtech -->+<!ENTITY ang "∠"> <!-- angle, U+2220 ISOamso -->+<!ENTITY and "∧"> <!-- logical and = wedge, U+2227 ISOtech -->+<!ENTITY or "∨"> <!-- logical or = vee, U+2228 ISOtech -->+<!ENTITY cap "∩"> <!-- intersection = cap, U+2229 ISOtech -->+<!ENTITY cup "∪"> <!-- union = cup, U+222A ISOtech -->+<!ENTITY int "∫"> <!-- integral, U+222B ISOtech -->+<!ENTITY there4 "∴"> <!-- therefore, U+2234 ISOtech -->+<!ENTITY sim "∼"> <!-- tilde operator = varies with = similar to,+ U+223C ISOtech -->+<!-- tilde operator is NOT the same character as the tilde, U+007E,+ although the same glyph might be used to represent both -->+<!ENTITY cong "≅"> <!-- approximately equal to, U+2245 ISOtech -->+<!ENTITY asymp "≈"> <!-- almost equal to = asymptotic to,+ U+2248 ISOamsr -->+<!ENTITY ne "≠"> <!-- not equal to, U+2260 ISOtech -->+<!ENTITY equiv "≡"> <!-- identical to, U+2261 ISOtech -->+<!ENTITY le "≤"> <!-- less-than or equal to, U+2264 ISOtech -->+<!ENTITY ge "≥"> <!-- greater-than or equal to,+ U+2265 ISOtech -->+<!ENTITY sub "⊂"> <!-- subset of, U+2282 ISOtech -->+<!ENTITY sup "⊃"> <!-- superset of, U+2283 ISOtech -->+<!-- note that nsup, 'not a superset of, U+2283' is not covered by the Symbol + font encoding and is not included. Should it be, for symmetry?+ It is in ISOamsn --> +<!ENTITY nsub "⊄"> <!-- not a subset of, U+2284 ISOamsn -->+<!ENTITY sube "⊆"> <!-- subset of or equal to, U+2286 ISOtech -->+<!ENTITY supe "⊇"> <!-- superset of or equal to,+ U+2287 ISOtech -->+<!ENTITY oplus "⊕"> <!-- circled plus = direct sum,+ U+2295 ISOamsb -->+<!ENTITY otimes "⊗"> <!-- circled times = vector product,+ U+2297 ISOamsb -->+<!ENTITY perp "⊥"> <!-- up tack = orthogonal to = perpendicular,+ U+22A5 ISOtech -->+<!ENTITY sdot "⋅"> <!-- dot operator, U+22C5 ISOamsb -->+<!-- dot operator is NOT the same character as U+00B7 middle dot -->++<!-- Miscellaneous Technical -->+<!ENTITY lceil "⌈"> <!-- left ceiling = apl upstile,+ U+2308 ISOamsc -->+<!ENTITY rceil "⌉"> <!-- right ceiling, U+2309 ISOamsc -->+<!ENTITY lfloor "⌊"> <!-- left floor = apl downstile,+ U+230A ISOamsc -->+<!ENTITY rfloor "⌋"> <!-- right floor, U+230B ISOamsc -->+<!ENTITY lang "〈"> <!-- left-pointing angle bracket = bra,+ U+2329 ISOtech -->+<!-- lang is NOT the same character as U+003C 'less than' + or U+2039 'single left-pointing angle quotation mark' -->+<!ENTITY rang "〉"> <!-- right-pointing angle bracket = ket,+ U+232A ISOtech -->+<!-- rang is NOT the same character as U+003E 'greater than' + or U+203A 'single right-pointing angle quotation mark' -->++<!-- Geometric Shapes -->+<!ENTITY loz "◊"> <!-- lozenge, U+25CA ISOpub -->++<!-- Miscellaneous Symbols -->+<!ENTITY spades "♠"> <!-- black spade suit, U+2660 ISOpub -->+<!-- black here seems to mean filled as opposed to hollow -->+<!ENTITY clubs "♣"> <!-- black club suit = shamrock,+ U+2663 ISOpub -->+<!ENTITY hearts "♥"> <!-- black heart suit = valentine,+ U+2665 ISOpub -->+<!ENTITY diams "♦"> <!-- black diamond suit, U+2666 ISOpub -->
+ examples/xhtml/xhtml.xml view
@@ -0,0 +1,1484 @@+<!DOCTYPE html SYSTEM "xhtml1-strict.dtd">+<?xml-stylesheet href="http://www.w3.org/StyleSheets/TR/W3C-REC.css" type="text/css"?>+<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">+<head>+<title>XHTML 1.0: The Extensible HyperText Markup+Language</title>+<link rel="stylesheet"+href="http://www.w3.org/StyleSheets/TR/W3C-REC.css" type="text/css" />+<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />+<style type="text/css">+span.term { font-style: italic; color: rgb(0, 0, 192) }+code {+ color: green;+ font-family: monospace;+ font-weight: bold;+}++code.greenmono {+ color: green;+ font-family: monospace;+ font-weight: bold;+}+.good {+ border: solid green;+ border-width: 2px;+ color: green;+ font-weight: bold;+ margin-right: 5%;+ margin-left: 0;+}+.bad {+ border: solid red;+ border-width: 2px;+ margin-left: 0;+ margin-right: 5%;+ color: rgb(192, 101, 101);+}++img {+ color: white;+ border: none;+}++div.navbar { text-align: center; }+div.contents {+ background-color: rgb(204,204,255);+ padding: 0.5em;+ border: none;+ margin-right: 5%;+}+.tocline { list-style: none; }+table.exceptions { background-color: rgb(255,255,153); }+</style>+</head>+<body>+<div class="navbar">+ <a href="#toc">table of contents</a>+ <hr />+</div>+<div class="head"><p><a href="http://www.w3.org/"><img class="head"+src="http://www.w3.org/Icons/WWW/w3c_home.gif" alt="W3C" /></a></p>++<h1 class="head"><a name="title" id="title">XHTML</a><sup>™</sup> 1.0:+The Extensible HyperText Markup Language</h1>++<h2>A Reformulation of HTML 4 in XML 1.0</h2>++<h3>W3C Recommendation 26 January 2000</h3>++<dl>+<dt>This version:</dt>++<dd><a href=+"http://www.w3.org/TR/2000/REC-xhtml1-20000126">+http://www.w3.org/TR/2000/REC-xhtml1-20000126</a> <br />+(<a href="xhtml1.ps">Postscript version</a>,+<a href="xhtml1.pdf">PDF version</a>,+<a href="xhtml1.zip">ZIP archive</a>, or+<a href="xhtml1.tgz">Gzip'd TAR archive</a>)+</dd>++<dt>Latest version:</dt>++<dd><a href="http://www.w3.org/TR/xhtml1">+http://www.w3.org/TR/xhtml1</a></dd>++<dt>Previous version:</dt>++<dd><a href=+"http://www.w3.org/TR/1999/PR-xhtml1-19991210">+http://www.w3.org/TR/1999/PR-xhtml1-19991210</a></dd>++<dt>Authors:</dt>++<dd>See <a href="#acks">acknowledgements</a>.</dd>+</dl>++<p class="copyright"><a+href="http://www.w3.org/Consortium/Legal/ipr-notice#Copyright"> Copyright</a>+©2000 <a href="http://www.w3.org/"><abbr title="World Wide Web+Consortium">W3C</abbr></a><sup>®</sup> (<a+href="http://www.lcs.mit.edu/"><abbr+title="Massachusetts Institute of Technology">MIT</abbr></a>, <a+href="http://www.inria.fr/"><abbr+lang="fr" title="Institut National de Recherche en Informatique et+Automatique">INRIA</abbr></a>, <a+href="http://www.keio.ac.jp/">Keio</a>), All Rights Reserved. W3C <a+href="http://www.w3.org/Consortium/Legal/ipr-notice#Legal_Disclaimer">liability</a>,+<a+href="http://www.w3.org/Consortium/Legal/ipr-notice#W3C_Trademarks">trademark</a>,+<a+href="http://www.w3.org/Consortium/Legal/copyright-documents-19990405">document+use</a> and <a+href="http://www.w3.org/Consortium/Legal/copyright-software-19980720">software+licensing</a> rules+apply.</p>+<hr />+</div>++<h2 class="notoc">Abstract</h2>++<p>This specification defines <abbr title="Extensible Hypertext Markup+Language">XHTML</abbr> 1.0, a reformulation of HTML 4+as an XML 1.0 application, and three <abbr title="Document Type+Definition">DTDs</abbr> corresponding to+the ones defined by HTML 4. The semantics of the elements and+their attributes are defined in the W3C Recommendation for HTML 4.+These semantics provide the foundation for future+extensibility of XHTML. Compatibility with existing HTML user+agents is possible by following a small set of guidelines.</p>++<h2>Status of this document</h2>++<p><em>This section describes the status of this document at the time+of its publication. Other documents may supersede this document. The+latest status of this document series is maintained at the W3C.</em></p>++<p>+This document has been reviewed by W3C Members and other+interested parties and has been endorsed by the Director+as a W3C Recommendation. It is a stable document and may be+used as reference material or cited as a normative+reference from another document. W3C's role in making the+Recommendation is to draw attention to the specification and+to promote its widespread deployment. This enhances the+functionality and interoperability of the Web.+</p>+<p>This document has been produced as part of the <a href=+"http://www.w3.org/MarkUp/">W3C HTML Activity</a>. The goals of+the <a href="http://www.w3.org/MarkUp/Group/">HTML Working+Group</a> <i>(<a href="http://cgi.w3.org/MemberAccess/">members+only</a>)</i> are discussed in the <a href=+"http://www.w3.org/MarkUp/Group/HTMLcharter">HTML Working Group+charter</a> <i>(<a href="http://cgi.w3.org/MemberAccess/">members+only</a>)</i>.</p>++<p>A list of current W3C Recommendations and other technical documents+can be found at <a+href="http://www.w3.org/TR">http://www.w3.org/TR</a>.</p>++<p>Public discussion on <abbr title="HyperText Markup+Language">HTML</abbr> features takes place on the mailing list <a+href="mailto:www-html@w3.org"> www-html@w3.org</a> (<a href=+"http://lists.w3.org/Archives/Public/www-html/">archive</a>).</p>++<p>Please report errors in this document to <a+href="mailto:www-html-editor@w3.org">www-html-editor@w3.org</a>.</p>++<p>The list of known errors in this specification is available at <a+href="http://www.w3.org/2000/01/REC-xhtml1-20000126-errata">http://www.w3.org/2000/01/REC-xhtml1-20000126-errata</a>.</p>++<h2 class="notoc"><a id="toc" name="toc">Contents</a></h2>++<div class="contents">+<ul class="toc">+<li class="tocline">1. <a href="#xhtml">What is XHTML?</a>++<ul class="toc">+<li class="tocline">1.1 <a href="#html4">What is HTML 4?</a></li>++<li class="tocline">1.2 <a href="#xml">What is XML?</a></li>++<li class="tocline">1.3 <a href="#why">Why the need for XHTML?</a></li>+</ul>+</li>++<li class="tocline">2. <a href="#defs">Definitions</a>++<ul class="toc">+<li class="tocline">2.1 <a href="#terms">Terminology</a></li>++<li class="tocline">2.2 <a href="#general">General Terms</a></li>+</ul>+</li>++<li class="tocline">3. <a href="#normative">Normative Definition of XHTML 1.0</a>+++<ul class="toc">+<li class="tocline">3.1 <a href="#docconf">Document Conformance</a></li>++<li class="tocline">3.2 <a href="#uaconf">User Agent Conformance</a></li>+</ul>+</li>++<li class="tocline">4. <a href="#diffs">Differences with HTML 4</a>++</li>++<li class="tocline">5. <a href="#issues">Compatibility Issues</a>++<ul class="toc">+<li class="tocline">5.1 <a href="#media">Internet Media Types</a></li>+</ul>+</li>++<li class="tocline">6. <a href="#future">Future Directions</a>++<ul class="toc">+<li class="tocline">6.1 <a href="#mods">Modularizing HTML</a></li>++<li class="tocline">6.2 <a href="#extensions">Subsets and Extensibility</a></li>++<li class="tocline">6.3 <a href="#profiles">Document Profiles</a></li>+</ul>+</li>++<li class="tocline"><a href="#dtds">Appendix A. DTDs</a></li>++<li class="tocline"><a href="#prohibitions">Appendix B. Element+Prohibitions</a></li>++<li class="tocline"><a href="#guidelines">Appendix C. HTML Compatibility Guidelines</a></li>++<li class="tocline"><a href="#acks">Appendix D. Acknowledgements</a></li>++<li class="tocline"><a href="#refs">Appendix E. References</a></li>+</ul>+</div>++<!--OddPage-->+<h1><a name="xhtml" id="xhtml">1. What is XHTML?</a></h1>++<p>XHTML is a family of current and future document types and modules that+reproduce, subset, and extend HTML 4 <a href="#ref-html4">[HTML]</a>. XHTML family document types are <abbr title="Extensible Markup Language">XML</abbr> based,+and ultimately are designed to work in conjunction with XML-based user agents.+The details of this family and its evolution are+discussed in more detail in the section on <a href="#future">Future+Directions</a>. </p>++<p>XHTML 1.0 (this specification) is the first document type in the XHTML+family. It is a reformulation of the three HTML 4 document types as+applications of XML 1.0 <a href="#ref-xml"> [XML]</a>. It is intended+to be used as a language for content that is both XML-conforming and, if some+simple <a href="#guidelines">guidelines</a> are followed,+operates in HTML 4 conforming user agents. Developers who migrate+their content to XHTML 1.0 will realize the following benefits:</p>++<ul>+<li>XHTML documents are XML conforming. As such, they are readily viewed,+edited, and validated with standard XML tools.</li>+<li>XHTML documents can be written to+to operate as well or better than they did before in existing+HTML 4-conforming user agents as well as in new, XHTML 1.0 conforming user+agents.</li>+<li>XHTML documents can utilize applications (e.g. scripts and applets) that rely+upon either the HTML Document Object Model or the XML Document Object Model <a+href="#ref-dom">[DOM]</a>.</li>+<li>As the XHTML family evolves, documents conforming to XHTML 1.0 will be more+likely to interoperate within and among various XHTML environments.</li>+</ul>++<p>The XHTML family is the next step in the evolution of the Internet. By+migrating to XHTML today, content developers can enter the XML world with all+of its attendant benefits, while still remaining confident in their+content's backward and future compatibility.</p>++<h2><a name="html4" id="html4">1.1 What is HTML 4?</a></h2>++<p>HTML 4 <a href="#ref-html4">[HTML]</a> is an <abbr title="Standard+Generalized Markup Language">SGML</abbr> (Standard+Generalized Markup Language) application conforming to+International Standard <abbr title="Organization for International+Standardization">ISO</abbr> 8879, and is widely regarded as the+standard publishing language of the World Wide Web.</p>++<p>SGML is a language for describing markup languages,+particularly those used in electronic document exchange, document+management, and document publishing. HTML is an example of a+language defined in SGML.</p>++<p>SGML has been around since the middle 1980's and has remained+quite stable. Much of this stability stems from the fact that the+language is both feature-rich and flexible. This flexibility,+however, comes at a price, and that price is a level of+complexity that has inhibited its adoption in a diversity of+environments, including the World Wide Web.</p>++<p>HTML, as originally conceived, was to be a language for the+exchange of scientific and other technical documents, suitable+for use by non-document specialists. HTML addressed the problem+of SGML complexity by specifying a small set of structural and+semantic tags suitable for authoring relatively simple documents.+In addition to simplifying the document structure, HTML added+support for hypertext. Multimedia capabilities were added+later.</p>++<p>In a remarkably short space of time, HTML became wildly+popular and rapidly outgrew its original purpose. Since HTML's+inception, there has been rapid invention of new elements for use+within HTML (as a standard) and for adapting HTML to vertical,+highly specialized, markets. This plethora of new elements has+led to compatibility problems for documents across different+platforms.</p>++<p>As the heterogeneity of both software and platforms rapidly+proliferate, it is clear that the suitability of 'classic' HTML 4+for use on these platforms is somewhat limited.</p>++<h2><a name="xml" id="xml">1.2 What is XML?</a></h2>++<p>XML<sup>™</sup> is the shorthand for Extensible Markup+Language, and is an acronym of Extensible Markup Language <a+href="#ref-xml">[XML]</a>.</p>++<p>XML was conceived as a means of regaining the power and+flexibility of SGML without most of its complexity. Although a+restricted form of SGML, XML nonetheless preserves most of SGML's+power and richness, and yet still retains all of SGML's commonly+used features.</p>++<p>While retaining these beneficial features, XML removes many of+the more complex features of SGML that make the authoring and+design of suitable software both difficult and costly.</p>++<h2><a name="why" id="why">1.3 Why the need for XHTML?</a></h2>++<p>The benefits of migrating to XHTML 1.0 are described above. Some of the+benefits of migrating to XHTML in general are:</p>++<ul>+<li>Document developers and user agent designers are constantly+discovering new ways to express their ideas through new markup. In XML, it is+relatively easy to introduce new elements or additional element+attributes. The XHTML family is designed to accommodate these extensions+through XHTML modules and techniques for developing new XHTML-conforming+modules (described in the forthcoming XHTML Modularization specification).+These modules will permit the combination of existing and+new feature sets when developing content and when designing new user+agents.</li>++<li>Alternate ways of accessing the Internet are constantly being+introduced. Some estimates indicate that by the year 2002, 75% of+Internet document viewing will be carried out on these alternate+platforms. The XHTML family is designed with general user agent+interoperability in mind. Through a new user agent and document profiling+mechanism, servers, proxies, and user agents will be able to perform+best effort content transformation. Ultimately, it will be possible to+develop XHTML-conforming content that is usable by any XHTML-conforming+user agent.</li>++</ul>+<!--OddPage-->+<h1><a name="defs" id="defs">2. Definitions</a></h1>++<h2><a name="terms" id="terms">2.1 Terminology</a></h2>++<p>The following terms are used in this specification. These+terms extend the definitions in <a href="#ref-rfc2119">+[RFC2119]</a> in ways based upon similar definitions in ISO/<abbr+title="International Electro-technical Commission">IEC</abbr>+9945-1:1990 <a href="#ref-posix">[POSIX.1]</a>:</p>++<dl>+<dt>Implementation-defined</dt>++<dd>A value or behavior is implementation-defined when it is left+to the implementation to define [and document] the corresponding+requirements for correct document construction.</dd>++<dt>May</dt>++<dd>With respect to implementations, the word "may" is to be+interpreted as an optional feature that is not required in this+specification but can be provided. With respect to <a href=+"#docconf">Document Conformance</a>, the word "may" means that+the optional feature must not be used. The term "optional" has+the same definition as "may".</dd>++<dt>Must</dt>++<dd>In this specification, the word "must" is to be interpreted+as a mandatory requirement on the implementation or on Strictly+Conforming XHTML Documents, depending upon the context. The term+"shall" has the same definition as "must".</dd>++<dt>Reserved</dt>++<dd>A value or behavior is unspecified, but it is not allowed to+be used by Conforming Documents nor to be supported by a+Conforming User Agents.</dd>++<dt>Should</dt>++<dd>With respect to implementations, the word "should" is to be+interpreted as an implementation recommendation, but not a+requirement. With respect to documents, the word "should" is to+be interpreted as recommended programming practice for documents+and a requirement for Strictly Conforming XHTML Documents.</dd>++<dt>Supported</dt>++<dd>Certain facilities in this specification are optional. If a+facility is supported, it behaves as specified by this+specification.</dd>++<dt>Unspecified</dt>++<dd>When a value or behavior is unspecified, the specification+defines no portability requirements for a facility on an+implementation even when faced with a document that uses the+facility. A document that requires specific behavior in such an+instance, rather than tolerating any behavior when using that+facility, is not a Strictly Conforming XHTML Document.</dd>+</dl>++<h2><a name="general" id="general">2.2 General Terms</a></h2>++<dl>+<dt>Attribute</dt>++<dd>An attribute is a parameter to an element declared in the+DTD. An attribute's type and value range, including a possible+default value, are defined in the DTD.</dd>++<dt>DTD</dt>++<dd>A DTD, or document type definition, is a collection of XML+declarations that, as a collection, defines the legal structure,+<span class="term">elements</span>, and <span class="term">+attributes</span> that are available for use in a document that+complies to the DTD.</dd>++<dt>Document</dt>++<dd>A document is a stream of data that, after being combined+with any other streams it references, is structured such that it+holds information contained within <span class="term">+elements</span> that are organized as defined in the associated+<span class="term">DTD</span>. See <a href="#docconf">Document+Conformance</a> for more information.</dd>++<dt>Element</dt>++<dd>An element is a document structuring unit declared in the+<span class="term">DTD</span>. The element's content model is+defined in the <span class="term">DTD</span>, and additional+semantics may be defined in the prose description of the+element.</dd>++<dt><a name="facilities" id="facilities">Facilities</a></dt>++<dd>Functionality includes <span class="term">elements</span>,+<span class="term">attributes</span>, and the semantics+associated with those <span class="term">elements</span> and+<span class="term">attributes</span>. An implementation+supporting that functionality is said to provide the necessary+facilities.</dd>++<dt>Implementation</dt>++<dd>An implementation is a system that provides collection of+<span class="term">facilities</span> and services that supports+this specification. See <a href="#uaconf">User Agent+Conformance</a> for more information.</dd>++<dt>Parsing</dt>++<dd>Parsing is the act whereby a <span class="term">+document</span> is scanned, and the information contained within+the <span class="term">document</span> is filtered into the+context of the <span class="term">elements</span> in which the+information is structured.</dd>++<dt>Rendering</dt>++<dd>Rendering is the act whereby the information in a <span+class="term">document</span> is presented. This presentation is+done in the form most appropriate to the environment (e.g.+aurally, visually, in print).</dd>++<dt>User Agent</dt>++<dd>A user agent is an <span class="term">implementation</span>+that retrieves and processes XHTML documents. See <a href=+"#uaconf">User Agent Conformance</a> for more information.</dd>++<dt>Validation</dt>++<dd>Validation is a process whereby <span class="term">+documents</span> are verified against the associated <span class=+"term">DTD</span>, ensuring that the structure, use of <span+class="term">elements</span>, and use of <span class="term">+attributes</span> are consistent with the definitions in the+<span class="term">DTD</span>.</dd>++<dt><a name="wellformed" id="wellformed">Well-formed</a></dt>++<dd>A <span class="term">document</span> is well-formed when it+is structured according to the rules defined in <a href=+"http://www.w3.org/TR/REC-xml#sec-well-formed">Section 2.1</a> of+the XML 1.0 Recommendation <a href="#ref-xml">[XML]</a>.+Basically, this definition states that elements, delimited by+their start and end tags, are nested properly within one+another.</dd>+</dl>++<!--OddPage-->+<h1><a name="normative" id="normative">3. Normative Definition of+XHTML 1.0</a></h1>++<h2><a name="docconf" id="docconf">3.1 Document+Conformance</a></h2>++<p>This version of XHTML provides a definition of strictly+conforming XHTML documents, which are restricted to tags and+attributes from the XHTML namespace. See <a href=+"#well-formed">Section 3.1.2</a> for information on using XHTML+with other namespaces, for instance, to include metadata+expressed in <abbr title="Resource Description Format">RDF</abbr> within XHTML documents.</p>++<h3><a name="strict" id="strict">3.1.1 Strictly Conforming+Documents</a></h3>++<p>A Strictly Conforming XHTML Document is a document that+requires only the facilities described as mandatory in this+specification. Such a document must meet all of the following+criteria:</p>++<ol>+<li>+<p>It must validate against one of the three DTDs found in <a+href="#dtds">Appendix A</a>.</p>+</li>++<li>+<p>The root element of the document must be <code>+<html></code>.</p>+</li>++<li>+<p>The root element of the document must designate the XHTML+namespace using the <code>xmlns</code> attribute <a href=+"#ref-xmlns">[XMLNAMES]</a>. The namespace for XHTML is+defined to be+<code>http://www.w3.org/1999/xhtml</code>.</p>+</li>++<li>+<p>There must be a DOCTYPE declaration in the document prior to+the root element. The public identifier included in+the DOCTYPE declaration must reference one of the three DTDs+found in <a href="#dtds">Appendix A</a> using the respective+Formal Public Identifier. The system identifier may be changed to reflect+local system conventions.</p>++<pre>+<!DOCTYPE html+ PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"+ "DTD/xhtml1-strict.dtd">++<!DOCTYPE html+ PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"+ "DTD/xhtml1-transitional.dtd">++<!DOCTYPE html+ PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"+ "DTD/xhtml1-frameset.dtd">+</pre>+</li>+</ol>++<p>Here is an example of a minimal XHTML document.</p>++<div class="good">+<pre>+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE html+ PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"+ "DTD/xhtml1-strict.dtd">+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">+ <head>+ <title>Virtual Library</title>+ </head>+ <body>+ <p>Moved to <a href="http://vlib.org/">vlib.org</a>.</p>+ </body>+</html></pre>+</div>++<p>Note that in this example, the XML declaration is included. An XML+declaration like the one above is+not required in all XML documents. XHTML document authors are strongly encouraged to use XML declarations in all their documents. Such a declaration is required+when the character encoding of the document is other than the default UTF-8 or+UTF-16.</p>++<h3><a name="well-formed" id="well-formed">3.1.2 Using XHTML with+other namespaces</a></h3>++<p>The XHTML namespace may be used with other XML namespaces+as per <a href="#ref-xmlns">[XMLNAMES]</a>, although such+documents are not strictly conforming XHTML 1.0 documents as+defined above. Future work by W3C will address ways to specify+conformance for documents involving multiple namespaces.</p>++<p>The following example shows the way in which XHTML 1.0 could+be used in conjunction with the MathML Recommendation:</p>++<div class="good">+<pre>+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">+ <head>+ <title>A Math Example</title>+ </head>+ <body>+ <p>The following is MathML markup:</p>+ <math xmlns="http://www.w3.org/1998/Math/MathML">+ <apply> <log/>+ <logbase>+ <cn> 3 </cn>+ </logbase>+ <ci> x </ci>+ </apply>+ </math>+ </body>+</html>+</pre>+</div>++<p>The following example shows the way in which XHTML 1.0 markup+could be incorporated into another XML namespace:</p>++<div class="good">+<pre>+<?xml version="1.0" encoding="UTF-8"?>+<!-- initially, the default namespace is "books" -->+<book xmlns='urn:loc.gov:books'+ xmlns:isbn='urn:ISBN:0-395-36341-6' xml:lang="en" lang="en">+ <title>Cheaper by the Dozen</title>+ <isbn:number>1568491379</isbn:number>+ <notes>+ <!-- make HTML the default namespace for a hypertext commentary -->+ <p xmlns='http://www.w3.org/1999/xhtml'>+ This is also available <a href="http://www.w3.org/">online</a>.+ </p>+ </notes>+</book>+</pre>+</div>++<h2><a name="uaconf" id="uaconf">3.2 User Agent+Conformance</a></h2>++<p>A conforming user agent must meet all of the following+criteria:</p>++<ol>+<li>In order to be consistent with the XML 1.0 Recommendation <a+href="#ref-xml">[XML]</a>, the user agent must parse and evaluate+an XHTML document for well-formedness. If the user agent claims+to be a validating user agent, it must also validate documents+against their referenced DTDs according to <a href="#ref-xml">+[XML]</a>.</li>++<li>When the user agent claims to support <a href="#facilities">+facilities</a> defined within this specification or required by+this specification through normative reference, it must do so in+ways consistent with the facilities' definition.</li>++<li>When a user agent processes an XHTML document as generic XML,+it shall only recognize attributes of type+<code>ID</code> (e.g. the <code>id</code> attribute on most XHTML elements)+as fragment identifiers.</li>++<li>If a user agent encounters an element it does not recognize,+it must render the element's content.</li>++<li>If a user agent encounters an attribute it does not+recognize, it must ignore the entire attribute specification+(i.e., the attribute and its value).</li>++<li>If a user agent encounters an attribute value it doesn't+recognize, it must use the default attribute value.</li>++<li>If it encounters an entity reference (other than one+of the predefined entities) for which the User Agent has+processed no declaration (which could happen if the declaration+is in the external subset which the User Agent hasn't read), the entity+reference should be rendered as the characters (starting+with the ampersand and ending with the semi-colon) that+make up the entity reference.</li>++<li>When rendering content, User Agents that encounter+characters or character entity references that are recognized but not renderable should display the document in such a way that it is obvious to the user that normal rendering has not taken place.</li>++<li>+The following characters are defined in [XML] as whitespace characters:++<ul>+<li>Space (&#x0020;)</li>+<li>Tab (&#x0009;)</li>+<li>Carriage return (&#x000D;)</li>+<li>Line feed (&#x000A;)</li>+</ul>++<p>+The XML processor normalizes different system's line end codes into one+single line-feed character, that is passed up to the application. The XHTML+user agent in addition, must treat the following characters as whitespace:+</p>++<ul>+<li>Form feed (&#x000C;)</li>+<li>Zero-width space (&#x200B;)</li>+</ul>++<p>+In elements where the 'xml:space' attribute is set to 'preserve', the user+agent must leave all whitespace characters intact (with the exception of+leading and trailing whitespace characters, which should be removed).+Otherwise, whitespace+is handled according to the following rules:+</p>++<ul>+<li>+All whitespace surrounding block elements should be removed.+</li>+<li>+Comments are removed entirely and do not affect whitespace handling. One+whitespace character on either side of a comment is treated as two white+space characters.+</li>+<li>+Leading and trailing whitespace inside a block element must be removed.+</li>+<li>Line feed characters within a block element must be converted into a+space (except when the 'xml:space' attribute is set to 'preserve').+</li>+<li>+A sequence of white space characters must be reduced to a single space+character (except when the 'xml:space' attribute is set to 'preserve').+</li>+<li>+With regard to rendition,+the User Agent should render the content in a+manner appropriate to the language in which the content is written.+In languages whose primary script is Latinate, the ASCII space+character is typically used to encode both grammatical word boundaries and+typographic whitespace; in languages whose script is related to Nagari+(e.g., Sanskrit, Thai, etc.), grammatical boundaries may be encoded using+the ZW 'space' character, but will not typically be represented by+typographic whitespace in rendered output; languages using Arabiform scripts+may encode typographic whitespace using a space character, but may also use+the ZW space character to delimit 'internal' grammatical boundaries (what+look like words in Arabic to an English eye frequently encode several words,+e.g. 'kitAbuhum' = 'kitAbu-hum' = 'book them' == their book); and languages+in the Chinese script tradition typically neither encode such delimiters nor+use typographic whitespace in this way.+</li>+</ul>++<p>Whitespace in attribute values is processed according to <a+href="#ref-xml">[XML]</a>.</p>+</li>+</ol>++<!--OddPage-->+<h1><a name="diffs" id="diffs">4. Differences with HTML 4</a></h1>++<p>Due to the fact that XHTML is an XML application, certain+practices that were perfectly legal in SGML-based HTML 4 <a+href="#ref-html4">[HTML]</a> must be changed.</p>++<h2><a name="h-4.1" id="h-4.1">4.1 Documents must be+well-formed</a></h2>++<p><a href="#wellformed">Well-formedness</a> is a new concept+introduced by <a href="#ref-xml">[XML]</a>. Essentially this+means that all elements must either have closing tags or be+written in a special form (as described below), and that all the+elements must nest.</p>++<p>Although overlapping is illegal in SGML, it was widely+tolerated in existing browsers.</p>++<div class="good">+<p><strong><em>CORRECT: nested elements.</em></strong></p>++<p><p>here is an emphasized+<em>paragraph</em>.</p></p>+</div>++<div class="bad">+<p><strong><em>INCORRECT: overlapping elements</em></strong></p>++<p><p>here is an emphasized+<em>paragraph.</p></em></p>+</div>++<h2><a name="h-4.2" id="h-4.2">4.2 Element and attribute+names must be in lower case</a></h2>++<p>XHTML documents must use lower case for all HTML element and+attribute names. This difference is necessary because XML is+case-sensitive e.g. <li> and <LI> are different+tags.</p>++<h2><a name="h-4.3" id="h-4.3">4.3 For non-empty elements,+end tags are required</a></h2>++<p>In SGML-based HTML 4 certain elements were permitted to omit+the end tag; with the elements that followed implying closure.+This omission is not permitted in XML-based XHTML. All elements+other than those declared in the DTD as <code>EMPTY</code> must+have an end tag.</p>++<div class="good">+<p><strong><em>CORRECT: terminated elements</em></strong></p>++<p><p>here is a paragraph.</p><p>here is+another paragraph.</p></p>+</div>++<div class="bad">+<p><strong><em>INCORRECT: unterminated elements</em></strong></p>++<p><p>here is a paragraph.<p>here is another+paragraph.</p>+</div>++<h2><a name="h-4.4" id="h-4.4">4.4 Attribute values must+always be quoted</a></h2>++<p>All attribute values must be quoted, even those which appear+to be numeric.</p>++<div class="good">+<p><strong><em>CORRECT: quoted attribute values</em></strong></p>++<p><table rows="3"></p>+</div>++<div class="bad">+<p><strong><em>INCORRECT: unquoted attribute values</em></strong></p>++<p><table rows=3></p>+</div>++<h2><a name="h-4.5" id="h-4.5">4.5 Attribute+Minimization</a></h2>++<p>XML does not support attribute minimization. Attribute-value+pairs must be written in full. Attribute names such as <code>+compact</code> and <code>checked</code> cannot occur in elements+without their value being specified.</p>++<div class="good">+<p><strong><em>CORRECT: unminimized attributes</em></strong></p>++<p><dl compact="compact"></p>+</div>++<div class="bad">+<p><strong><em>INCORRECT: minimized attributes</em></strong></p>++<p><dl compact></p>+</div>++<h2><a name="h-4.6" id="h-4.6">4.6 Empty Elements</a></h2>++<p>Empty elements must either have an end tag or the start tag must end with <code>/></code>. For instance,+<code><br/></code> or <code><hr></hr></code>. See <a+href="#guidelines">HTML Compatibility Guidelines</a> for information on ways to+ensure this is backward compatible with HTML 4 user agents.</p>++<div class="good">+<p><strong><em>CORRECT: terminated empty tags</em></strong></p>++<p><br/><hr/></p>+</div>++<div class="bad">+<p><strong><em>INCORRECT: unterminated empty tags</em></strong></p>++<p><br><hr></p>+</div>++<h2><a name="h-4.7" id="h-4.7">4.7 Whitespace handling in+attribute values</a></h2>++<p>In attribute values, user agents will strip leading and+trailing whitespace from attribute values and map sequences+of one or more whitespace characters (including line breaks) to+a single inter-word space (an ASCII space character for western+scripts). See <a href="http://www.w3.org/TR/REC-xml#AVNormalize">+Section 3.3.3</a> of <a href="#ref-xml">[XML]</a>.</p>++<h2><a name="h-4.8" id="h-4.8">4.8 Script and Style+elements</a></h2>++<p>In XHTML, the script and style elements are declared as having+<code>#PCDATA</code> content. As a result, <code><</code> and+<code>&</code> will be treated as the start of markup, and+entities such as <code>&lt;</code> and <code>&amp;</code>+will be recognized as entity references by the XML processor to+<code><</code> and <code>&</code> respectively. Wrapping+the content of the script or style element within a <code>+CDATA</code> marked section avoids the expansion of these+entities.</p>++<div class="good">+<pre>+<script>+ <![CDATA[+ ... unescaped script content ...+ ]]>+ </script>+</pre>+</div>++<p><code>CDATA</code> sections are recognized by the XML+processor and appear as nodes in the Document Object Model, see+<a href=+"http://www.w3.org/TR/REC-DOM-Level-1/level-one-core.html#ID-E067D597">+Section 1.3</a> of the DOM Level 1 Recommendation <a href=+"#ref-dom">[DOM]</a>.</p>++<p>An alternative is to use external script and style+documents.</p>++<h2><a name="h-4.9" id="h-4.9">4.9 SGML exclusions</a></h2>++<p>SGML gives the writer of a DTD the ability to exclude specific+elements from being contained within an element. Such+prohibitions (called "exclusions") are not possible in XML.</p>++<p>For example, the HTML 4 Strict DTD forbids the nesting of an+'<code>a</code>' element within another '<code>a</code>' element+to any descendant depth. It is not possible to spell out such+prohibitions in XML. Even though these prohibitions cannot be+defined in the DTD, certain elements should not be nested. A+summary of such elements and the elements that should not be+nested in them is found in the normative <a href="#prohibitions">+Appendix B</a>.</p>++<h2><a name="h-4.10" id="h-4.10">4.10 The elements with 'id' and 'name'+attributes</a></h2>++<p>HTML 4 defined the <code>name</code> attribute for the elements+<code>a</code>,+<code>applet</code>, <code>form</code>, <code>frame</code>,+<code>iframe</code>, <code>img</code>, and <code>map</code>.+HTML 4 also introduced+the <code>id</code> attribute. Both of these attributes are designed to be+used as fragment identifiers.</p>+<p>In XML, fragment identifiers are of type <code>ID</code>, and+there can only be a single attribute of type <code>ID</code> per element.+Therefore, in XHTML 1.0 the <code>id</code>+attribute is defined to be of type <code>ID</code>. In order to+ensure that XHTML 1.0 documents are well-structured XML documents, XHTML 1.0+documents MUST use the <code>id</code> attribute when defining fragment+identifiers, even on elements that historically have also had a+<code>name</code> attribute.+See the <a href="#guidelines">HTML Compatibility+Guidelines</a> for information on ensuring such anchors are backwards+compatible when serving XHTML documents as media type <code>text/html</code>.+</p>+<p>Note that in XHTML 1.0, the <code>name</code> attribute of these+elements is formally deprecated, and will be removed in a+subsequent version of XHTML.</p>++<!--OddPage-->+<h1><a name="issues" id="issues">5. Compatibility Issues</a></h1>++<p>Although there is no requirement for XHTML 1.0 documents to be+compatible with existing user agents, in practice this is easy to+accomplish. Guidelines for creating compatible documents can be+found in <a href="#guidelines">Appendix C</a>.</p>++<h2><a name="media" id="media">5.1 Internet Media Type</a></h2>+<p>As of the publication of this recommendation, the general+recommended MIME labeling for XML-based applications+has yet to be resolved.</p>++<p>However, XHTML Documents which follow the guidelines set forth+in <a href="#guidelines">Appendix C</a>, "HTML Compatibility Guidelines" may be+labeled with the Internet Media Type "text/html", as they+are compatible with most HTML browsers. This document+makes no recommendation about MIME labeling of other+XHTML documents.</p>++<!--OddPage-->+<h1><a name="future" id="future">6. Future Directions</a></h1>++<p>XHTML 1.0 provides the basis for a family of document types+that will extend and subset XHTML, in order to support a wide+range of new devices and applications, by defining modules and+specifying a mechanism for combining these modules. This+mechanism will enable the extension and sub-setting of XHTML 1.0+in a uniform way through the definition of new modules.</p>++<h2><a name="mods" id="mods">6.1 Modularizing HTML</a></h2>++<p>As the use of XHTML moves from the traditional desktop user+agents to other platforms, it is clear that not all of the XHTML+elements will be required on all platforms. For example a hand+held device or a cell-phone may only support a subset of XHTML+elements.</p>++<p>The process of modularization breaks XHTML up into a series of+smaller element sets. These elements can then be recombined to+meet the needs of different communities.</p>++<p>These modules will be defined in a later W3C document.</p>++<h2><a name="extensions" id="extensions">6.2 Subsets and+Extensibility</a></h2>++<p>Modularization brings with it several advantages:</p>++<ul>+<li>+<p>It provides a formal mechanism for sub-setting XHTML.</p>+</li>++<li>+<p>It provides a formal mechanism for extending XHTML.</p>+</li>++<li>+<p>It simplifies the transformation between document types.</p>+</li>++<li>+<p>It promotes the reuse of modules in new document types.</p>+</li>+</ul>++<h2><a name="profiles" id="profiles">6.3 Document+Profiles</a></h2>++<p>A document profile specifies the syntax and semantics of a set+of documents. Conformance to a document profile provides a basis+for interoperability guarantees. The document profile specifies+the facilities required to process documents of that type, e.g.+which image formats can be used, levels of scripting, style sheet+support, and so on.</p>++<p>For product designers this enables various groups to define+their own standard profile.</p>++<p>For authors this will obviate the need to write several+different versions of documents for different clients.</p>++<p>For special groups such as chemists, medical doctors, or+mathematicians this allows a special profile to be built using+standard HTML elements plus a group of elements geared to the+specialist's needs.</p>++<!--OddPage-->+<h1><a name="appendices" id="appendices"></a>+<a name="dtds" id="dtds">Appendix A. DTDs</a></h1>++<p><b>This appendix is normative.</b></p>++<p>These DTDs and entity sets form a normative part of this+specification. The complete set of DTD files together with an XML+declaration and SGML Open Catalog is included in the <a href=+"xhtml1.zip">zip file</a> for this specification.</p>++<h2><a name="h-A1" id="h-A1">A.1 Document Type+Definitions</a></h2>++<p>These DTDs approximate the HTML 4 DTDs. It is likely that+when the DTDs are modularized, a method of DTD construction will+be employed that corresponds more closely to HTML 4.</p>++<ul>+<li>+<p><a href="DTD/xhtml1-strict.dtd" type="text/plain">+XHTML-1.0-Strict</a></p>+</li>++<li>+<p><a href="DTD/xhtml1-transitional.dtd" type="text/plain">+XHTML-1.0-Transitional</a></p>+</li>++<li>+<p><a href="DTD/xhtml1-frameset.dtd" type="text/plain">+XHTML-1.0-Frameset</a></p>+</li>+</ul>++<h2><a name="h-A2" id="h-A2">A.2 Entity Sets</a></h2>++<p>The XHTML entity sets are the same as for HTML 4, but have+been modified to be valid XML 1.0 entity declarations. Note the+entity for the Euro currency sign (<code>&euro;</code> or+<code>&#8364;</code> or <code>&#x20AC;</code>) is defined+as part of the special characters.</p>++<ul>+<li>+<p><a href="DTD/xhtml-lat1.ent">Latin-1 characters</a></p>+</li>++<li>+<p><a href="DTD/xhtml-special.ent">Special characters</a></p>+</li>++<li>+<p><a href="DTD/xhtml-symbol.ent">Symbols</a></p>+</li>+</ul>++<!--OddPage-->+<h1><a name="prohibitions" id="prohibitions">Appendix B. Element+Prohibitions</a></h1>++<p><b>This appendix is normative.</b></p>++<p>The following elements have prohibitions on which elements+they can contain (see <a href="#h-4.9">Section 4.9</a>). This+prohibition applies to all depths of nesting, i.e. it contains+all the descendant elements.</p>++<dl><dt><code class="tag">a</code></dt>+<dd>+cannot contain other <code>a</code> elements.</dd>+<dt><code class="tag">pre</code></dt>+<dd>cannot contain the <code>img</code>, <code>object</code>,+<code>big</code>, <code>small</code>, <code>sub</code>, or <code>+sup</code> elements.</dd>++<dt><code class="tag">button</code></dt>+<dd>cannot contain the <code>input</code>, <code>select</code>,+<code>textarea</code>, <code>label</code>, <code>button</code>,+<code>form</code>, <code>fieldset</code>, <code>iframe</code> or+<code>isindex</code> elements.</dd>+<dt><code class="tag">label</code></dt>+<dd>cannot contain other <code class="tag">label</code> elements.</dd>+<dt><code class="tag">form</code></dt>+<dd>cannot contain other <code>form</code> elements.</dd>+</dl>++<!--OddPage-->+<h1><a name="guidelines" id="guidelines">Appendix C.+HTML Compatibility Guidelines</a></h1>++<p><b>This appendix is informative.</b></p>++<p>This appendix summarizes design guidelines for authors who+wish their XHTML documents to render on existing HTML user+agents.</p>++<h2>C.1 Processing Instructions</h2>+<p>Be aware that processing instructions are rendered on some+user agents. However, also note that when the XML declaration is not included+in a document, the document can only use the default character encodings UTF-8+or UTF-16.</p>++<h2>C.2 Empty Elements</h2>+<p>Include a space before the trailing <code>/</code> and <code>+></code> of empty elements, e.g. <code class="greenmono">+<br /></code>, <code class="greenmono">+<hr /></code> and <code class="greenmono"><img+src="karen.jpg" alt="Karen" /></code>. Also, use the+minimized tag syntax for empty elements, e.g. <code class=+"greenmono"><br /></code>, as the alternative syntax <code+class="greenmono"><br></br></code> allowed by XML+gives uncertain results in many existing user agents.</p>++<h2>C.3 Element Minimization and Empty Element Content</h2>+<p>Given an empty instance of an element whose content model is+not <code>EMPTY</code> (for example, an empty title or paragraph)+do not use the minimized form (e.g. use <code class="greenmono">+<p> </p></code> and not <code class="greenmono">+<p /></code>).</p>++<h2>C.4 Embedded Style Sheets and Scripts</h2>+<p>Use external style sheets if your style sheet uses <code>+<</code> or <code>&</code> or <code>]]></code> or <code>--</code>. Use+external scripts if your script uses <code><</code> or <code>+&</code> or <code>]]></code> or <code>--</code>. Note that XML parsers+are permitted to silently remove the contents of comments. Therefore, the historical+practice of "hiding" scripts and style sheets within comments to make the+documents backward compatible is likely to not work as expected in XML-based+implementations.</p>++<h2>C.5 Line Breaks within Attribute Values</h2>+<p>Avoid line breaks and multiple whitespace characters within+attribute values. These are handled inconsistently by user+agents.</p>++<h2>C.6 Isindex</h2>+<p>Don't include more than one <code>isindex</code> element in+the document <code>head</code>. The <code>isindex</code> element+is deprecated in favor of the <code>input</code> element.</p>++<h2>C.7 The <code>lang</code> and <code>xml:lang</code> Attributes</h2>+<p>Use both the <code>lang</code> and <code>xml:lang</code>+attributes when specifying the language of an element. The value+of the <code>xml:lang</code> attribute takes precedence.</p>++<h2>C.8 Fragment Identifiers</h2>+<p>In XML, <abbr title="Uniform Resource Identifiers">URIs</abbr> [<a href="#ref-rfc2396">RFC2396</a>] that end with fragment identifiers of the form+<code>"#foo"</code> do not refer to elements with an attribute+<code>name="foo"</code>; rather, they refer to elements with an+attribute defined to be of type <code>ID</code>, e.g., the <code>+id</code> attribute in HTML 4. Many existing HTML clients don't+support the use of <code>ID</code>-type attributes in this way,+so identical values may be supplied for both of these attributes to ensure+maximum forward and backward compatibility (e.g., <code class=+"greenmono"><a id="foo" name="foo">...</a></code>).</p>++<p>Further, since the set of+legal values for attributes of type <code>ID</code> is much smaller than+for those of type <code>CDATA</code>, the type of the <code>name</code>+attribute has been changed to <code>NMTOKEN</code>. This attribute is+constrained such that it can only have the same values as type+<code>ID</code>, or as the <code>Name</code> production in XML 1.0 Section+2.5, production 5. Unfortunately, this constraint cannot be expressed in the+XHTML 1.0 DTDs. Because of this change, care must be taken when+converting existing HTML documents. The values of these attributes+must be unique within the document, valid, and any references to these+fragment identifiers (both+internal and external) must be updated should the values be changed during+conversion.</p>+<p>Finally, note that XHTML 1.0 has deprecated the+<code>name</code> attribute of the <code>a</code>, <code>applet</code>, <code>form</code>, <code>frame</code>, <code>iframe</code>, <code>img</code>, and <code>map</code>+elements, and it will be+removed from XHTML in subsequent versions.</p>++<h2>C.9 Character Encoding</h2>+<p>To specify a character encoding in the document, use both the+encoding attribute specification on the xml declaration (e.g.+<code class="greenmono"><?xml version="1.0"+encoding="EUC-JP"?></code>) and a meta http-equiv statement+(e.g. <code class="greenmono"><meta http-equiv="Content-type"+content='text/html; charset="EUC-JP"' /></code>). The+value of the encoding attribute of the xml processing instruction+takes precedence.</p>++<h2>C.10 Boolean Attributes</h2>+<p>Some HTML user agents are unable to interpret boolean+attributes when these appear in their full (non-minimized) form,+as required by XML 1.0. Note this problem doesn't affect user+agents compliant with HTML 4. The following attributes are+involved: <code>compact</code>, <code>nowrap</code>, <code>+ismap</code>, <code>declare</code>, <code>noshade</code>, <code>+checked</code>, <code>disabled</code>, <code>readonly</code>,+<code>multiple</code>, <code>selected</code>, <code>+noresize</code>, <code>defer</code>.</p>++<h2>C.11 Document Object Model and XHTML</h2>+<p>+The Document Object Model level 1 Recommendation [<a href="#ref-dom">DOM</a>]+defines document object model interfaces for XML and HTML 4. The HTML 4+document object model specifies that HTML element and attribute names are+returned in upper-case. The XML document object model specifies that+element and attribute names are returned in the case they are specified. In+XHTML 1.0, elements and attributes are specified in lower-case. This apparent difference can be+addressed in two ways:+</p>+<ol>+<li>Applications that access XHTML documents served as Internet media type+<code>text/html</code>+via the <abbr title="Document Object Model">DOM</abbr> can use the HTML DOM,+and can rely upon element and attribute names being returned in+upper-case from those interfaces.</li>+<li>Applications that access XHTML documents served as Internet media types+<code>text/xml</code> or <code>application/xml</code>+can also use the XML DOM. Elements and attributes will be returned in lower-case.+Also, some XHTML elements may or may+not appear+in the object tree because they are optional in the content model+(e.g. the <code>tbody</code> element within+<code>table</code>). This occurs because in HTML 4 some elements were+permitted to be minimized such that their start and end tags are both omitted+(an SGML feature).+This is not possible in XML. Rather than require document authors to insert+extraneous elements, XHTML has made the elements optional.+Applications need to adapt to this+accordingly.</li>+</ol>++<h2>C.12 Using Ampersands in Attribute Values</h2>+<p>+When an attribute value contains an ampersand, it must be expressed as a character+entity reference+(e.g. "<code>&amp;</code>"). For example, when the+<code>href</code> attribute+of the <code>a</code> element refers to a+CGI script that takes parameters, it must be expressed as+<code>http://my.site.dom/cgi-bin/myscript.pl?class=guest&amp;name=user</code>+rather than as+<code>http://my.site.dom/cgi-bin/myscript.pl?class=guest&name=user</code>.+</p>++<h2>C.13 Cascading Style Sheets (CSS) and XHTML</h2>++<p>The Cascading Style Sheets level 2 Recommendation [<a href="#ref-css2">CSS2</a>] defines style+properties which are applied to the parse tree of the HTML or XML+document. Differences in parsing will produce different visual or+aural results, depending on the selectors used. The following hints+will reduce this effect for documents which are served without+modification as both media types:</p>++<ol>+<li>+CSS style sheets for XHTML should use lower case element and+attribute names.</li>+++<li>In tables, the tbody element will be inferred by the parser of an+HTML user agent, but not by the parser of an XML user agent. Therefore+you should always explicitly add a tbody element if it is referred to+in a CSS selector.</li>++<li>Within the XHTML name space, user agents are expected to+recognize the "id" attribute as an attribute of type ID.+Therefore, style sheets should be able to continue using the+shorthand "#" selector syntax even if the user agent does not read+the DTD.</li>++<li>Within the XHTML name space, user agents are expected to+recognize the "class" attribute. Therefore, style sheets should be+able to continue using the shorthand "." selector syntax.</li>++<li>+CSS defines different conformance rules for HTML and XML documents;+be aware that the HTML rules apply to XHTML documents delivered as+HTML and the XML rules apply to XHTML documents delivered as XML.</li>+</ol>+<!--OddPage-->+<h1><a name="acks" id="acks">Appendix D.+Acknowledgements</a></h1>++<p><b>This appendix is informative.</b></p>++<p>This specification was written with the participation of the+members of the W3C HTML working group:</p>++<dl>+<dd>Steven Pemberton, CWI (HTML Working Group Chair)<br />+Murray Altheim, Sun Microsystems<br />+Daniel Austin, AskJeeves (CNET: The Computer Network through July 1999)<br />+Frank Boumphrey, HTML Writers Guild<br />+John Burger, Mitre<br />+Andrew W. Donoho, IBM<br />+Sam Dooley, IBM<br />+Klaus Hofrichter, GMD<br />+Philipp Hoschka, W3C<br />+Masayasu Ishikawa, W3C<br />+Warner ten Kate, Philips Electronics<br />+Peter King, Phone.com<br />+Paula Klante, JetForm<br />+Shin'ichi Matsui, Panasonic (W3C visiting engineer through September 1999)<br />+Shane McCarron, Applied Testing and Technology (The Open Group through August+1999)<br />+Ann Navarro, HTML Writers Guild<br />+Zach Nies, Quark<br />+Dave Raggett, W3C/HP (W3C lead for HTML)<br />+Patrick Schmitz, Microsoft<br />+Sebastian Schnitzenbaumer, Stack Overflow<br />+Peter Stark, Phone.com<br />+Chris Wilson, Microsoft<br />+Ted Wugofski, Gateway 2000<br />+Dan Zigmond, WebTV Networks</dd>+</dl>++<!--OddPage-->+<h1><a name="refs" id="refs">Appendix E. References</a></h1>++<p><b>This appendix is informative.</b></p>++<dl>++<dt><a name="ref-css2" id="ref-css2"><b>[CSS2]</b></a></dt>++<dd><a href="http://www.w3.org/TR/1998/REC-CSS2-19980512">"Cascading Style Sheets, level 2 (CSS2) Specification"</a>, B.+Bos, H. W. Lie, C. Lilley, I. Jacobs, 12 May 1998.<br />+Latest version available at: <a href="http://www.w3.org/TR/REC-CSS2">+http://www.w3.org/TR/REC-CSS2</a></dd>++<dt><a name="ref-dom" id="ref-dom"><b>[DOM]</b></a></dt>++<dd><a href="http://www.w3.org/TR/1998/REC-DOM-Level-1-19981001">"Document Object Model (DOM) Level 1 Specification"</a>, Lauren+Wood <i>et al.</i>, 1 October 1998.<br />+Latest version available at: <a href="http://www.w3.org/TR/REC-DOM-Level-1">+http://www.w3.org/TR/REC-DOM-Level-1</a></dd>++<dt><a name="ref-html4" id="ref-html4"><b>[HTML]</b></a></dt>++<dd><a href="http://www.w3.org/TR/1999/REC-html401-19991224">"HTML 4.01 Specification"</a>, D. Raggett, A. Le Hors, I.+Jacobs, 24 December 1999.<br />+Latest version available at: <a href="http://www.w3.org/TR/html401">+http://www.w3.org/TR/html401</a></dd>++<dt><a name="ref-posix" id="ref-posix"><b>[POSIX.1]</b></a></dt>++<dd>"ISO/IEC 9945-1:1990 Information Technology - Portable+Operating System Interface (POSIX) - Part 1: System Application+Program Interface (API) [C Language]", Institute of Electrical+and Electronics Engineers, Inc, 1990.</dd>++<dt><a name="ref-rfc2046" id="ref-rfc2046"><b>+[RFC2046]</b></a></dt>++<dd><a href="http://www.ietf.org/rfc/rfc2046.txt">"RFC2046: Multipurpose Internet Mail Extensions (MIME) Part+Two: Media Types"</a>, N. Freed and N. Borenstein, November+1996.<br />+Available at <a href="http://www.ietf.org/rfc/rfc2046.txt">+http://www.ietf.org/rfc/rfc2046.txt</a>. Note that this RFC+obsoletes RFC1521, RFC1522, and RFC1590.</dd>++<dt><a name="ref-rfc2119" id="ref-rfc2119"><b>+[RFC2119]</b></a></dt>++<dd><a href="http://www.ietf.org/rfc/rfc2119.txt">"RFC2119: Key words for use in RFCs to Indicate Requirement+Levels"</a>, S. Bradner, March 1997.<br />+Available at: <a href="http://www.ietf.org/rfc/rfc2119.txt">+http://www.ietf.org/rfc/rfc2119.txt</a></dd>++<dt><a name="ref-rfc2376" id="ref-rfc2376"><b>+[RFC2376]</b></a></dt>++<dd><a href="http://www.ietf.org/rfc/rfc2376.txt">"RFC2376: XML Media Types"</a>, E. Whitehead, M. Murata, July+1998.<br />+Available at: <a href="http://www.ietf.org/rfc/rfc2376.txt">+http://www.ietf.org/rfc/rfc2376.txt</a></dd>++<dt><a name="ref-rfc2396" id="ref-rfc2396"><b>+[RFC2396]</b></a></dt>++<dd><a href="http://www.ietf.org/rfc/rfc2396.txt">"RFC2396: Uniform Resource Identifiers (URI): Generic+Syntax"</a>, T. Berners-Lee, R. Fielding, L. Masinter, August+1998.<br />+This document updates RFC1738 and RFC1808.<br />+Available at: <a href="http://www.ietf.org/rfc/rfc2396.txt">+http://www.ietf.org/rfc/rfc2396.txt</a></dd>++<dt><a name="ref-xml" id="ref-xml"><b>[XML]</b></a></dt>++<dd><a href="http://www.w3.org/TR/1998/REC-xml-19980210">"Extensible Markup Language (XML) 1.0 Specification"</a>, T.+Bray, J. Paoli, C. M. Sperberg-McQueen, 10 February 1998.<br />+Latest version available at: <a href="http://www.w3.org/TR/REC-xml">+http://www.w3.org/TR/REC-xml</a></dd>++<dt><a name="ref-xmlns" id="ref-xmlns"><b>[XMLNAMES]</b></a></dt>++<dd><a href="http://www.w3.org/TR/1999/REC-xml-names-19990114">"Namespaces in XML"</a>, T. Bray, D. Hollander, A. Layman, 14+January 1999.<br />+XML namespaces provide a simple method for qualifying names used+in XML documents by associating them with namespaces identified+by URI.<br />+Latest version available at: <a href="http://www.w3.org/TR/REC-xml-names">+http://www.w3.org/TR/REC-xml-names</a></dd>++</dl>+<p><a href="http://www.w3.org/WAI/WCAG1AAA-Conformance"+title="Explanation of Level Triple-A Conformance">+<img height="32" width="88"+src="http://www.w3.org/WAI/wcag1AAA.gif"+alt="Level Triple-A conformance icon, W3C-WAI Web Content Accessibility Guidelines 1.0" /></a></p>+<div class="navbar">+ <hr />+ <a href="#toc">table of contents</a>+</div>+</body>+</html>+
+ examples/xhtml/xhtml1-frameset.dtd view
@@ -0,0 +1,1225 @@+<!--+ Extensible HTML version 1.0 Frameset DTD++ This is the same as HTML 4.0 Frameset except for+ changes due to the differences between XML and SGML.++ Namespace = http://www.w3.org/1999/xhtml++ For further information, see: http://www.w3.org/TR/xhtml1++ Copyright (c) 1998-2000 W3C (MIT, INRIA, Keio),+ All Rights Reserved. ++ This DTD module is identified by the PUBLIC and SYSTEM identifiers:++ PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"+ SYSTEM "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"++ $Revision: 1.1 $+ $Date: 2002/10/01 13:47:08 $++-->++<!--================ Character mnemonic entities =========================-->++<!ENTITY % HTMLlat1 PUBLIC+ "-//W3C//ENTITIES Latin 1 for XHTML//EN"+ "xhtml-lat1.ent">+%HTMLlat1;++<!ENTITY % HTMLsymbol PUBLIC+ "-//W3C//ENTITIES Symbols for XHTML//EN"+ "xhtml-symbol.ent">+%HTMLsymbol;++<!ENTITY % HTMLspecial PUBLIC+ "-//W3C//ENTITIES Special for XHTML//EN"+ "xhtml-special.ent">+%HTMLspecial;++<!--================== Imported Names ====================================-->++<!ENTITY % ContentType "CDATA">+ <!-- media type, as per [RFC2045] -->++<!ENTITY % ContentTypes "CDATA">+ <!-- comma-separated list of media types, as per [RFC2045] -->++<!ENTITY % Charset "CDATA">+ <!-- a character encoding, as per [RFC2045] -->++<!ENTITY % Charsets "CDATA">+ <!-- a space separated list of character encodings, as per [RFC2045] -->++<!ENTITY % LanguageCode "NMTOKEN">+ <!-- a language code, as per [RFC1766] -->++<!ENTITY % Character "CDATA">+ <!-- a single character from [ISO10646] -->++<!ENTITY % Number "CDATA">+ <!-- one or more digits -->++<!ENTITY % LinkTypes "CDATA">+ <!-- space-separated list of link types -->++<!ENTITY % MediaDesc "CDATA">+ <!-- single or comma-separated list of media descriptors -->++<!ENTITY % URI "CDATA">+ <!-- a Uniform Resource Identifier, see [RFC2396] -->++<!ENTITY % UriList "CDATA">+ <!-- a space separated list of Uniform Resource Identifiers -->++<!ENTITY % Datetime "CDATA">+ <!-- date and time information. ISO date format -->++<!ENTITY % Script "CDATA">+ <!-- script expression -->++<!ENTITY % StyleSheet "CDATA">+ <!-- style sheet data -->++<!ENTITY % Text "CDATA">+ <!-- used for titles etc. -->++<!ENTITY % FrameTarget "NMTOKEN">+ <!-- render in this frame -->++<!ENTITY % Length "CDATA">+ <!-- nn for pixels or nn% for percentage length -->++<!ENTITY % MultiLength "CDATA">+ <!-- pixel, percentage, or relative -->++<!ENTITY % MultiLengths "CDATA">+ <!-- comma-separated list of MultiLength -->++<!ENTITY % Pixels "CDATA">+ <!-- integer representing length in pixels -->++<!-- these are used for image maps -->++<!ENTITY % Shape "(rect|circle|poly|default)">++<!ENTITY % Coords "CDATA">+ <!-- comma separated list of lengths -->++<!-- used for object, applet, img, input and iframe -->+<!ENTITY % ImgAlign "(top|middle|bottom|left|right)">++<!-- a color using sRGB: #RRGGBB as Hex values -->+<!ENTITY % Color "CDATA">++<!-- There are also 16 widely known color names with their sRGB values:++ Black = #000000 Green = #008000+ Silver = #C0C0C0 Lime = #00FF00+ Gray = #808080 Olive = #808000+ White = #FFFFFF Yellow = #FFFF00+ Maroon = #800000 Navy = #000080+ Red = #FF0000 Blue = #0000FF+ Purple = #800080 Teal = #008080+ Fuchsia= #FF00FF Aqua = #00FFFF+-->++<!--=================== Generic Attributes ===============================-->++<!-- core attributes common to most elements+ id document-wide unique id+ class space separated list of classes+ style associated style info+ title advisory title/amplification+-->+<!ENTITY % coreattrs+ "id ID #IMPLIED+ class CDATA #IMPLIED+ style %StyleSheet; #IMPLIED+ title %Text; #IMPLIED"+ >++<!-- internationalization attributes+ lang language code (backwards compatible)+ xml:lang language code (as per XML 1.0 spec)+ dir direction for weak/neutral text+-->+<!ENTITY % i18n+ "lang %LanguageCode; #IMPLIED+ xml:lang %LanguageCode; #IMPLIED+ dir (ltr|rtl) #IMPLIED"+ >++<!-- attributes for common UI events+ onclick a pointer button was clicked+ ondblclick a pointer button was double clicked+ onmousedown a pointer button was pressed down+ onmouseup a pointer button was released+ onmousemove a pointer was moved onto the element+ onmouseout a pointer was moved away from the element+ onkeypress a key was pressed and released+ onkeydown a key was pressed down+ onkeyup a key was released+-->+<!ENTITY % events+ "onclick %Script; #IMPLIED+ ondblclick %Script; #IMPLIED+ onmousedown %Script; #IMPLIED+ onmouseup %Script; #IMPLIED+ onmouseover %Script; #IMPLIED+ onmousemove %Script; #IMPLIED+ onmouseout %Script; #IMPLIED+ onkeypress %Script; #IMPLIED+ onkeydown %Script; #IMPLIED+ onkeyup %Script; #IMPLIED"+ >++<!-- attributes for elements that can get the focus+ accesskey accessibility key character+ tabindex position in tabbing order+ onfocus the element got the focus+ onblur the element lost the focus+-->+<!ENTITY % focus+ "accesskey %Character; #IMPLIED+ tabindex %Number; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED"+ >++<!ENTITY % attrs "%coreattrs; %i18n; %events;">++<!-- text alignment for p, div, h1-h6. The default is+ align="left" for ltr headings, "right" for rtl -->++<!ENTITY % TextAlign "align (left|center|right) #IMPLIED">++<!--=================== Text Elements ====================================-->++<!ENTITY % special+ "br | span | bdo |object | applet | img | map | iframe">++<!ENTITY % fontstyle "tt | i | b | big | small | u+ | s | strike |font | basefont">++<!ENTITY % phrase "em | strong | dfn | code | q | sub | sup |+ samp | kbd | var | cite | abbr | acronym">++<!ENTITY % inline.forms "input | select | textarea | label | button">++<!-- these can occur at block or inline level -->+<!ENTITY % misc "ins | del | script | noscript">++<!ENTITY % inline "a | %special; | %fontstyle; | %phrase; | %inline.forms;">++<!-- %Inline; covers inline or "text-level" elements -->+<!ENTITY % Inline "(#PCDATA | %inline; | %misc;)*">++<!--================== Block level elements ==============================-->++<!ENTITY % heading "h1|h2|h3|h4|h5|h6">+<!ENTITY % lists "ul | ol | dl | menu | dir">+<!ENTITY % blocktext "pre | hr | blockquote | address | center">++<!ENTITY % block+ "p | %heading; | div | %lists; | %blocktext; | isindex | fieldset | table">++<!ENTITY % Block "(%block; | form | %misc;)*">++<!-- %Flow; mixes Block and Inline and is used for list items etc. -->+<!ENTITY % Flow "(#PCDATA | %block; | form | %inline; | %misc;)*">++<!--================== Content models for exclusions =====================-->++<!-- a elements use %Inline; excluding a -->++<!ENTITY % a.content+ "(#PCDATA | %special; | %fontstyle; | %phrase; | %inline.forms; | %misc;)*">++<!-- pre uses %Inline excluding img, object, applet, big, small,+ sub, sup, font, or basefont -->++<!ENTITY % pre.content+ "(#PCDATA | a | br | span | bdo | map | tt | i | b | u | s |+ %phrase; | %inline.forms;)*">++<!-- form uses %Flow; excluding form -->++<!ENTITY % form.content "(#PCDATA | %block; | %inline; | %misc;)*">++<!-- button uses %Flow; but excludes a, form, form controls, iframe -->++<!ENTITY % button.content+ "(#PCDATA | p | %heading; | div | %lists; | %blocktext; |+ table | br | span | bdo | object | applet | img | map |+ %fontstyle; | %phrase; | %misc;)*">++<!--================ Document Structure ==================================-->++<!-- the namespace URI designates the document profile -->++<!ELEMENT html (head, frameset)>+<!ATTLIST html+ %i18n;+ xmlns %URI; #FIXED 'http://www.w3.org/1999/xhtml'+ >++<!--================ Document Head =======================================-->++<!ENTITY % head.misc "(script|style|meta|link|object|isindex)*">++<!-- content model is %head.misc; combined with a single+ title and an optional base element in any order -->++<!ELEMENT head (%head.misc;,+ ((title, %head.misc;, (base, %head.misc;)?) |+ (base, %head.misc;, (title, %head.misc;))))>++<!ATTLIST head+ %i18n;+ profile %URI; #IMPLIED+ >++<!-- The title element is not considered part of the flow of text.+ It should be displayed, for example as the page header or+ window title. Exactly one title is required per document.+ -->+<!ELEMENT title (#PCDATA)>+<!ATTLIST title %i18n;>++<!-- document base URI -->++<!ELEMENT base EMPTY>+<!ATTLIST base+ href %URI; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!-- generic metainformation -->+<!ELEMENT meta EMPTY>+<!ATTLIST meta+ %i18n;+ http-equiv CDATA #IMPLIED+ name CDATA #IMPLIED+ content CDATA #REQUIRED+ scheme CDATA #IMPLIED+ >++<!--+ Relationship values can be used in principle:++ a) for document specific toolbars/menus when used+ with the link element in document head e.g.+ start, contents, previous, next, index, end, help+ b) to link to a separate style sheet (rel="stylesheet")+ c) to make a link to a script (rel="script")+ d) by stylesheets to control how collections of+ html nodes are rendered into printed documents+ e) to make a link to a printable version of this document+ e.g. a PostScript or PDF version (rel="alternate" media="print")+-->++<!ELEMENT link EMPTY>+<!ATTLIST link+ %attrs;+ charset %Charset; #IMPLIED+ href %URI; #IMPLIED+ hreflang %LanguageCode; #IMPLIED+ type %ContentType; #IMPLIED+ rel %LinkTypes; #IMPLIED+ rev %LinkTypes; #IMPLIED+ media %MediaDesc; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!-- style info, which may include CDATA sections -->+<!ELEMENT style (#PCDATA)>+<!ATTLIST style+ %i18n;+ type %ContentType; #REQUIRED+ media %MediaDesc; #IMPLIED+ title %Text; #IMPLIED+ xml:space (preserve) #FIXED 'preserve'+ >++<!-- script statements, which may include CDATA sections -->+<!ELEMENT script (#PCDATA)>+<!ATTLIST script+ charset %Charset; #IMPLIED+ type %ContentType; #REQUIRED+ language CDATA #IMPLIED+ src %URI; #IMPLIED+ defer (defer) #IMPLIED+ xml:space (preserve) #FIXED 'preserve'+ >++<!-- alternate content container for non script-based rendering -->++<!ELEMENT noscript %Flow;>+<!ATTLIST noscript+ %attrs;+ >++<!--======================= Frames =======================================-->++<!-- only one noframes element permitted per document -->++<!ELEMENT frameset (frameset|frame|noframes)*>+<!ATTLIST frameset+ %coreattrs;+ rows %MultiLengths; #IMPLIED+ cols %MultiLengths; #IMPLIED+ onload %Script; #IMPLIED+ onunload %Script; #IMPLIED+ >++<!-- reserved frame names start with "_" otherwise starts with letter -->++<!-- tiled window within frameset -->++<!ELEMENT frame EMPTY>+<!ATTLIST frame+ %coreattrs;+ longdesc %URI; #IMPLIED+ name NMTOKEN #IMPLIED+ src %URI; #IMPLIED+ frameborder (1|0) "1"+ marginwidth %Pixels; #IMPLIED+ marginheight %Pixels; #IMPLIED+ noresize (noresize) #IMPLIED+ scrolling (yes|no|auto) "auto"+ >++<!-- inline subwindow -->++<!ELEMENT iframe %Flow;>+<!ATTLIST iframe+ %coreattrs;+ longdesc %URI; #IMPLIED+ name NMTOKEN #IMPLIED+ src %URI; #IMPLIED+ frameborder (1|0) "1"+ marginwidth %Pixels; #IMPLIED+ marginheight %Pixels; #IMPLIED+ scrolling (yes|no|auto) "auto"+ align %ImgAlign; #IMPLIED+ height %Length; #IMPLIED+ width %Length; #IMPLIED+ >++<!-- alternate content container for non frame-based rendering -->++<!ELEMENT noframes (body)>+<!ATTLIST noframes+ %attrs;+ >++<!--=================== Document Body ====================================-->++<!ELEMENT body %Flow;>+<!ATTLIST body+ %attrs;+ onload %Script; #IMPLIED+ onunload %Script; #IMPLIED+ background %URI; #IMPLIED+ bgcolor %Color; #IMPLIED+ text %Color; #IMPLIED+ link %Color; #IMPLIED+ vlink %Color; #IMPLIED+ alink %Color; #IMPLIED+ >++<!ELEMENT div %Flow;> <!-- generic language/style container -->+<!ATTLIST div+ %attrs;+ %TextAlign;+ >++<!--=================== Paragraphs =======================================-->++<!ELEMENT p %Inline;>+<!ATTLIST p+ %attrs;+ %TextAlign;+ >++<!--=================== Headings =========================================-->++<!--+ There are six levels of headings from h1 (the most important)+ to h6 (the least important).+-->++<!ELEMENT h1 %Inline;>+<!ATTLIST h1+ %attrs;+ %TextAlign;+ >++<!ELEMENT h2 %Inline;>+<!ATTLIST h2+ %attrs;+ %TextAlign;+ >++<!ELEMENT h3 %Inline;>+<!ATTLIST h3+ %attrs;+ %TextAlign;+ >++<!ELEMENT h4 %Inline;>+<!ATTLIST h4+ %attrs;+ %TextAlign;+ >++<!ELEMENT h5 %Inline;>+<!ATTLIST h5+ %attrs;+ %TextAlign;+ >++<!ELEMENT h6 %Inline;>+<!ATTLIST h6+ %attrs;+ %TextAlign;+ >++<!--=================== Lists ============================================-->++<!-- Unordered list bullet styles -->++<!ENTITY % ULStyle "(disc|square|circle)">++<!-- Unordered list -->++<!ELEMENT ul (li)+>+<!ATTLIST ul+ %attrs;+ type %ULStyle; #IMPLIED+ compact (compact) #IMPLIED+ >++<!-- Ordered list numbering style++ 1 arabic numbers 1, 2, 3, ...+ a lower alpha a, b, c, ...+ A upper alpha A, B, C, ...+ i lower roman i, ii, iii, ...+ I upper roman I, II, III, ...++ The style is applied to the sequence number which by default+ is reset to 1 for the first list item in an ordered list.+-->+<!ENTITY % OLStyle "CDATA">++<!-- Ordered (numbered) list -->++<!ELEMENT ol (li)+>+<!ATTLIST ol+ %attrs;+ type %OLStyle; #IMPLIED+ compact (compact) #IMPLIED+ start %Number; #IMPLIED+ >++<!-- single column list (DEPRECATED) --> +<!ELEMENT menu (li)+>+<!ATTLIST menu+ %attrs;+ compact (compact) #IMPLIED+ >++<!-- multiple column list (DEPRECATED) --> +<!ELEMENT dir (li)+>+<!ATTLIST dir+ %attrs;+ compact (compact) #IMPLIED+ >++<!-- LIStyle is constrained to: "(%ULStyle;|%OLStyle;)" -->+<!ENTITY % LIStyle "CDATA">++<!-- list item -->++<!ELEMENT li %Flow;>+<!ATTLIST li+ %attrs;+ type %LIStyle; #IMPLIED+ value %Number; #IMPLIED+ >++<!-- definition lists - dt for term, dd for its definition -->++<!ELEMENT dl (dt|dd)+>+<!ATTLIST dl+ %attrs;+ compact (compact) #IMPLIED+ >++<!ELEMENT dt %Inline;>+<!ATTLIST dt+ %attrs;+ >++<!ELEMENT dd %Flow;>+<!ATTLIST dd+ %attrs;+ >++<!--=================== Address ==========================================-->++<!-- information on author -->++<!ELEMENT address %Inline;>+<!ATTLIST address+ %attrs;+ >++<!--=================== Horizontal Rule ==================================-->++<!ELEMENT hr EMPTY>+<!ATTLIST hr+ %attrs;+ align (left|center|right) #IMPLIED+ noshade (noshade) #IMPLIED+ size %Pixels; #IMPLIED+ width %Length; #IMPLIED+ >++<!--=================== Preformatted Text ================================-->++<!-- content is %Inline; excluding + "img|object|applet|big|small|sub|sup|font|basefont" -->++<!ELEMENT pre %pre.content;>+<!ATTLIST pre+ %attrs;+ width %Number; #IMPLIED+ xml:space (preserve) #FIXED 'preserve'+ >++<!--=================== Block-like Quotes ================================-->++<!ELEMENT blockquote %Flow;>+<!ATTLIST blockquote+ %attrs;+ cite %URI; #IMPLIED+ >++<!--=================== Text alignment ===================================-->++<!-- center content -->+<!ELEMENT center %Flow;>+<!ATTLIST center+ %attrs;+ >++<!--=================== Inserted/Deleted Text ============================-->+++<!--+ ins/del are allowed in block and inline content, but its+ inappropriate to include block content within an ins element+ occurring in inline content.+-->+<!ELEMENT ins %Flow;>+<!ATTLIST ins+ %attrs;+ cite %URI; #IMPLIED+ datetime %Datetime; #IMPLIED+ >++<!ELEMENT del %Flow;>+<!ATTLIST del+ %attrs;+ cite %URI; #IMPLIED+ datetime %Datetime; #IMPLIED+ >++<!--================== The Anchor Element ================================-->++<!-- content is %Inline; except that anchors shouldn't be nested -->++<!ELEMENT a %a.content;>+<!ATTLIST a+ %attrs;+ charset %Charset; #IMPLIED+ type %ContentType; #IMPLIED+ name NMTOKEN #IMPLIED+ href %URI; #IMPLIED+ hreflang %LanguageCode; #IMPLIED+ rel %LinkTypes; #IMPLIED+ rev %LinkTypes; #IMPLIED+ accesskey %Character; #IMPLIED+ shape %Shape; "rect"+ coords %Coords; #IMPLIED+ tabindex %Number; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!--===================== Inline Elements ================================-->++<!ELEMENT span %Inline;> <!-- generic language/style container -->+<!ATTLIST span+ %attrs;+ >++<!ELEMENT bdo %Inline;> <!-- I18N BiDi over-ride -->+<!ATTLIST bdo+ %coreattrs;+ %events;+ lang %LanguageCode; #IMPLIED+ xml:lang %LanguageCode; #IMPLIED+ dir (ltr|rtl) #REQUIRED+ >++<!ELEMENT br EMPTY> <!-- forced line break -->+<!ATTLIST br+ %coreattrs;+ clear (left|all|right|none) "none"+ >++<!ELEMENT em %Inline;> <!-- emphasis -->+<!ATTLIST em %attrs;>++<!ELEMENT strong %Inline;> <!-- strong emphasis -->+<!ATTLIST strong %attrs;>++<!ELEMENT dfn %Inline;> <!-- definitional -->+<!ATTLIST dfn %attrs;>++<!ELEMENT code %Inline;> <!-- program code -->+<!ATTLIST code %attrs;>++<!ELEMENT samp %Inline;> <!-- sample -->+<!ATTLIST samp %attrs;>++<!ELEMENT kbd %Inline;> <!-- something user would type -->+<!ATTLIST kbd %attrs;>++<!ELEMENT var %Inline;> <!-- variable -->+<!ATTLIST var %attrs;>++<!ELEMENT cite %Inline;> <!-- citation -->+<!ATTLIST cite %attrs;>++<!ELEMENT abbr %Inline;> <!-- abbreviation -->+<!ATTLIST abbr %attrs;>++<!ELEMENT acronym %Inline;> <!-- acronym -->+<!ATTLIST acronym %attrs;>++<!ELEMENT q %Inline;> <!-- inlined quote -->+<!ATTLIST q+ %attrs;+ cite %URI; #IMPLIED+ >++<!ELEMENT sub %Inline;> <!-- subscript -->+<!ATTLIST sub %attrs;>++<!ELEMENT sup %Inline;> <!-- superscript -->+<!ATTLIST sup %attrs;>++<!ELEMENT tt %Inline;> <!-- fixed pitch font -->+<!ATTLIST tt %attrs;>++<!ELEMENT i %Inline;> <!-- italic font -->+<!ATTLIST i %attrs;>++<!ELEMENT b %Inline;> <!-- bold font -->+<!ATTLIST b %attrs;>++<!ELEMENT big %Inline;> <!-- bigger font -->+<!ATTLIST big %attrs;>++<!ELEMENT small %Inline;> <!-- smaller font -->+<!ATTLIST small %attrs;>++<!ELEMENT u %Inline;> <!-- underline -->+<!ATTLIST u %attrs;>++<!ELEMENT s %Inline;> <!-- strike-through -->+<!ATTLIST s %attrs;>++<!ELEMENT strike %Inline;> <!-- strike-through -->+<!ATTLIST strike %attrs;>++<!ELEMENT basefont EMPTY> <!-- base font size -->+<!ATTLIST basefont+ id ID #IMPLIED+ size CDATA #REQUIRED+ color %Color; #IMPLIED+ face CDATA #IMPLIED+ >++<!ELEMENT font %Inline;> <!-- local change to font -->+<!ATTLIST font+ %coreattrs;+ %i18n;+ size CDATA #IMPLIED+ color %Color; #IMPLIED+ face CDATA #IMPLIED+ >++<!--==================== Object ======================================-->+<!--+ object is used to embed objects as part of HTML pages.+ param elements should precede other content. Parameters+ can also be expressed as attribute/value pairs on the+ object element itself when brevity is desired.+-->++<!ELEMENT object (#PCDATA | param | %block; | form |%inline; | %misc;)*>+<!ATTLIST object+ %attrs;+ declare (declare) #IMPLIED+ classid %URI; #IMPLIED+ codebase %URI; #IMPLIED+ data %URI; #IMPLIED+ type %ContentType; #IMPLIED+ codetype %ContentType; #IMPLIED+ archive %UriList; #IMPLIED+ standby %Text; #IMPLIED+ height %Length; #IMPLIED+ width %Length; #IMPLIED+ usemap %URI; #IMPLIED+ name NMTOKEN #IMPLIED+ tabindex %Number; #IMPLIED+ align %ImgAlign; #IMPLIED+ border %Pixels; #IMPLIED+ hspace %Pixels; #IMPLIED+ vspace %Pixels; #IMPLIED+ >++<!--+ param is used to supply a named property value.+ In XML it would seem natural to follow RDF and support an+ abbreviated syntax where the param elements are replaced+ by attribute value pairs on the object start tag.+-->+<!ELEMENT param EMPTY>+<!ATTLIST param+ id ID #IMPLIED+ name CDATA #REQUIRED+ value CDATA #IMPLIED+ valuetype (data|ref|object) "data"+ type %ContentType; #IMPLIED+ >++<!--=================== Java applet ==================================-->+<!--+ One of code or object attributes must be present.+ Place param elements before other content.+-->+<!ELEMENT applet (#PCDATA | param | %block; | form | %inline; | %misc;)*>+<!ATTLIST applet+ %coreattrs;+ codebase %URI; #IMPLIED+ archive CDATA #IMPLIED+ code CDATA #IMPLIED+ object CDATA #IMPLIED+ alt %Text; #IMPLIED+ name NMTOKEN #IMPLIED+ width %Length; #REQUIRED+ height %Length; #REQUIRED+ align %ImgAlign; #IMPLIED+ hspace %Pixels; #IMPLIED+ vspace %Pixels; #IMPLIED+ >++<!--=================== Images ===========================================-->++<!--+ To avoid accessibility problems for people who aren't+ able to see the image, you should provide a text+ description using the alt and longdesc attributes.+ In addition, avoid the use of server-side image maps.+-->++<!ELEMENT img EMPTY>+<!ATTLIST img+ %attrs;+ src %URI; #REQUIRED+ alt %Text; #REQUIRED+ name NMTOKEN #IMPLIED+ longdesc %URI; #IMPLIED+ height %Length; #IMPLIED+ width %Length; #IMPLIED+ usemap %URI; #IMPLIED+ ismap (ismap) #IMPLIED+ align %ImgAlign; #IMPLIED+ border %Pixels; #IMPLIED+ hspace %Pixels; #IMPLIED+ vspace %Pixels; #IMPLIED+ >++<!-- usemap points to a map element which may be in this document+ or an external document, although the latter is not widely supported -->++<!--================== Client-side image maps ============================-->++<!-- These can be placed in the same document or grouped in a+ separate document although this isn't yet widely supported -->++<!ELEMENT map ((%block; | form | %misc;)+ | area+)>+<!ATTLIST map+ %i18n;+ %events;+ id ID #REQUIRED+ class CDATA #IMPLIED+ style %StyleSheet; #IMPLIED+ title %Text; #IMPLIED+ name NMTOKEN #IMPLIED+ >++<!ELEMENT area EMPTY>+<!ATTLIST area+ %attrs;+ shape %Shape; "rect"+ coords %Coords; #IMPLIED+ href %URI; #IMPLIED+ nohref (nohref) #IMPLIED+ alt %Text; #REQUIRED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!--================ Forms ===============================================-->++<!ELEMENT form %form.content;> <!-- forms shouldn't be nested -->++<!ATTLIST form+ %attrs;+ action %URI; #REQUIRED+ method (get|post) "get"+ name NMTOKEN #IMPLIED+ enctype %ContentType; "application/x-www-form-urlencoded"+ onsubmit %Script; #IMPLIED+ onreset %Script; #IMPLIED+ accept %ContentTypes; #IMPLIED+ accept-charset %Charsets; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!--+ Each label must not contain more than ONE field+ Label elements shouldn't be nested.+-->+<!ELEMENT label %Inline;>+<!ATTLIST label+ %attrs;+ for IDREF #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ >++<!ENTITY % InputType+ "(text | password | checkbox |+ radio | submit | reset |+ file | hidden | image | button)"+ >++<!-- the name attribute is required for all but submit & reset -->++<!ELEMENT input EMPTY> <!-- form control -->+<!ATTLIST input+ %attrs;+ type %InputType; "text"+ name CDATA #IMPLIED+ value CDATA #IMPLIED+ checked (checked) #IMPLIED+ disabled (disabled) #IMPLIED+ readonly (readonly) #IMPLIED+ size CDATA #IMPLIED+ maxlength %Number; #IMPLIED+ src %URI; #IMPLIED+ alt CDATA #IMPLIED+ usemap %URI; #IMPLIED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ onselect %Script; #IMPLIED+ onchange %Script; #IMPLIED+ accept %ContentTypes; #IMPLIED+ align %ImgAlign; #IMPLIED+ >++<!ELEMENT select (optgroup|option)+> <!-- option selector -->+<!ATTLIST select+ %attrs;+ name CDATA #IMPLIED+ size %Number; #IMPLIED+ multiple (multiple) #IMPLIED+ disabled (disabled) #IMPLIED+ tabindex %Number; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ onchange %Script; #IMPLIED+ >++<!ELEMENT optgroup (option)+> <!-- option group -->+<!ATTLIST optgroup+ %attrs;+ disabled (disabled) #IMPLIED+ label %Text; #REQUIRED+ >++<!ELEMENT option (#PCDATA)> <!-- selectable choice -->+<!ATTLIST option+ %attrs;+ selected (selected) #IMPLIED+ disabled (disabled) #IMPLIED+ label %Text; #IMPLIED+ value CDATA #IMPLIED+ >++<!ELEMENT textarea (#PCDATA)> <!-- multi-line text field -->+<!ATTLIST textarea+ %attrs;+ name CDATA #IMPLIED+ rows %Number; #REQUIRED+ cols %Number; #REQUIRED+ disabled (disabled) #IMPLIED+ readonly (readonly) #IMPLIED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ onselect %Script; #IMPLIED+ onchange %Script; #IMPLIED+ >++<!--+ The fieldset element is used to group form fields.+ Only one legend element should occur in the content+ and if present should only be preceded by whitespace.+-->+<!ELEMENT fieldset (#PCDATA | legend | %block; | form | %inline; | %misc;)*>+<!ATTLIST fieldset+ %attrs;+ >++<!ENTITY % LAlign "(top|bottom|left|right)">++<!ELEMENT legend %Inline;> <!-- fieldset label -->+<!ATTLIST legend+ %attrs;+ accesskey %Character; #IMPLIED+ align %LAlign; #IMPLIED+ >++<!--+ Content is %Flow; excluding a, form, form controls, iframe+--> +<!ELEMENT button %button.content;> <!-- push button -->+<!ATTLIST button+ %attrs;+ name CDATA #IMPLIED+ value CDATA #IMPLIED+ type (button|submit|reset) "submit"+ disabled (disabled) #IMPLIED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ >++<!-- single-line text input control (DEPRECATED) -->+<!ELEMENT isindex EMPTY>+<!ATTLIST isindex+ %coreattrs;+ %i18n;+ prompt %Text; #IMPLIED+ >++<!--======================= Tables =======================================-->++<!-- Derived from IETF HTML table standard, see [RFC1942] -->++<!--+ The border attribute sets the thickness of the frame around the+ table. The default units are screen pixels.++ The frame attribute specifies which parts of the frame around+ the table should be rendered. The values are not the same as+ CALS to avoid a name clash with the valign attribute.+-->+<!ENTITY % TFrame "(void|above|below|hsides|lhs|rhs|vsides|box|border)">++<!--+ The rules attribute defines which rules to draw between cells:++ If rules is absent then assume:+ "none" if border is absent or border="0" otherwise "all"+-->++<!ENTITY % TRules "(none | groups | rows | cols | all)">+ +<!-- horizontal placement of table relative to document -->+<!ENTITY % TAlign "(left|center|right)">++<!-- horizontal alignment attributes for cell contents++ char alignment char, e.g. char=":"+ charoff offset for alignment char+-->+<!ENTITY % cellhalign+ "align (left|center|right|justify|char) #IMPLIED+ char %Character; #IMPLIED+ charoff %Length; #IMPLIED"+ >++<!-- vertical alignment attributes for cell contents -->+<!ENTITY % cellvalign+ "valign (top|middle|bottom|baseline) #IMPLIED"+ >++<!ELEMENT table+ (caption?, (col*|colgroup*), thead?, tfoot?, (tbody+|tr+))>+<!ELEMENT caption %Inline;>+<!ELEMENT thead (tr)+>+<!ELEMENT tfoot (tr)+>+<!ELEMENT tbody (tr)+>+<!ELEMENT colgroup (col)*>+<!ELEMENT col EMPTY>+<!ELEMENT tr (th|td)+>+<!ELEMENT th %Flow;>+<!ELEMENT td %Flow;>++<!ATTLIST table+ %attrs;+ summary %Text; #IMPLIED+ width %Length; #IMPLIED+ border %Pixels; #IMPLIED+ frame %TFrame; #IMPLIED+ rules %TRules; #IMPLIED+ cellspacing %Length; #IMPLIED+ cellpadding %Length; #IMPLIED+ align %TAlign; #IMPLIED+ bgcolor %Color; #IMPLIED+ >++<!ENTITY % CAlign "(top|bottom|left|right)">++<!ATTLIST caption+ %attrs;+ align %CAlign; #IMPLIED+ >++<!--+colgroup groups a set of col elements. It allows you to group+several semantically related columns together.+-->+<!ATTLIST colgroup+ %attrs;+ span %Number; "1"+ width %MultiLength; #IMPLIED+ %cellhalign;+ %cellvalign;+ >++<!--+ col elements define the alignment properties for cells in+ one or more columns.++ The width attribute specifies the width of the columns, e.g.++ width=64 width in screen pixels+ width=0.5* relative width of 0.5++ The span attribute causes the attributes of one+ col element to apply to more than one column.+-->+<!ATTLIST col+ %attrs;+ span %Number; "1"+ width %MultiLength; #IMPLIED+ %cellhalign;+ %cellvalign;+ >++<!--+ Use thead to duplicate headers when breaking table+ across page boundaries, or for static headers when+ tbody sections are rendered in scrolling panel.++ Use tfoot to duplicate footers when breaking table+ across page boundaries, or for static footers when+ tbody sections are rendered in scrolling panel.++ Use multiple tbody sections when rules are needed+ between groups of table rows.+-->+<!ATTLIST thead+ %attrs;+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST tfoot+ %attrs;+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST tbody+ %attrs;+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST tr+ %attrs;+ %cellhalign;+ %cellvalign;+ bgcolor %Color; #IMPLIED+ >++<!-- Scope is simpler than headers attribute for common tables -->+<!ENTITY % Scope "(row|col|rowgroup|colgroup)">++<!-- th is for headers, td for data and for cells acting as both -->++<!ATTLIST th+ %attrs;+ abbr %Text; #IMPLIED+ axis CDATA #IMPLIED+ headers IDREFS #IMPLIED+ scope %Scope; #IMPLIED+ rowspan %Number; "1"+ colspan %Number; "1"+ %cellhalign;+ %cellvalign;+ nowrap (nowrap) #IMPLIED+ bgcolor %Color; #IMPLIED+ width %Pixels; #IMPLIED+ height %Pixels; #IMPLIED+ >++<!ATTLIST td+ %attrs;+ abbr %Text; #IMPLIED+ axis CDATA #IMPLIED+ headers IDREFS #IMPLIED+ scope %Scope; #IMPLIED+ rowspan %Number; "1"+ colspan %Number; "1"+ %cellhalign;+ %cellvalign;+ nowrap (nowrap) #IMPLIED+ bgcolor %Color; #IMPLIED+ width %Pixels; #IMPLIED+ height %Pixels; #IMPLIED+ >+
+ examples/xhtml/xhtml1-strict.dtd view
@@ -0,0 +1,988 @@+<!--+ Extensible HTML version 1.0 Strict DTD++ This is the same as HTML 4.0 Strict except for+ changes due to the differences between XML and SGML.++ Namespace = http://www.w3.org/1999/xhtml++ For further information, see: http://www.w3.org/TR/xhtml1++ Copyright (c) 1998-2000 W3C (MIT, INRIA, Keio),+ All Rights Reserved. ++ This DTD module is identified by the PUBLIC and SYSTEM identifiers:++ PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"+ SYSTEM "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"++ $Revision: 1.1 $+ $Date: 2002/10/01 13:47:08 $++-->++<!--================ Character mnemonic entities =========================-->++<!ENTITY % HTMLlat1 PUBLIC+ "-//W3C//ENTITIES Latin 1 for XHTML//EN"+ "xhtml-lat1.ent">+%HTMLlat1;++<!ENTITY % HTMLsymbol PUBLIC+ "-//W3C//ENTITIES Symbols for XHTML//EN"+ "xhtml-symbol.ent">+%HTMLsymbol;++<!ENTITY % HTMLspecial PUBLIC+ "-//W3C//ENTITIES Special for XHTML//EN"+ "xhtml-special.ent">+%HTMLspecial;++<!--================== Imported Names ====================================-->++<!ENTITY % ContentType "CDATA">+ <!-- media type, as per [RFC2045] -->++<!ENTITY % ContentTypes "CDATA">+ <!-- comma-separated list of media types, as per [RFC2045] -->++<!ENTITY % Charset "CDATA">+ <!-- a character encoding, as per [RFC2045] -->++<!ENTITY % Charsets "CDATA">+ <!-- a space separated list of character encodings, as per [RFC2045] -->++<!ENTITY % LanguageCode "NMTOKEN">+ <!-- a language code, as per [RFC1766] -->++<!ENTITY % Character "CDATA">+ <!-- a single character from [ISO10646] -->++<!ENTITY % Number "CDATA">+ <!-- one or more digits -->++<!ENTITY % LinkTypes "CDATA">+ <!-- space-separated list of link types -->++<!ENTITY % MediaDesc "CDATA">+ <!-- single or comma-separated list of media descriptors -->++<!ENTITY % URI "CDATA">+ <!-- a Uniform Resource Identifier, see [RFC2396] -->++<!ENTITY % UriList "CDATA">+ <!-- a space separated list of Uniform Resource Identifiers -->++<!ENTITY % Datetime "CDATA">+ <!-- date and time information. ISO date format -->++<!ENTITY % Script "CDATA">+ <!-- script expression -->++<!ENTITY % StyleSheet "CDATA">+ <!-- style sheet data -->++<!ENTITY % Text "CDATA">+ <!-- used for titles etc. -->++<!ENTITY % FrameTarget "NMTOKEN">+ <!-- render in this frame -->++<!ENTITY % Length "CDATA">+ <!-- nn for pixels or nn% for percentage length -->++<!ENTITY % MultiLength "CDATA">+ <!-- pixel, percentage, or relative -->++<!ENTITY % MultiLengths "CDATA">+ <!-- comma-separated list of MultiLength -->++<!ENTITY % Pixels "CDATA">+ <!-- integer representing length in pixels -->++<!-- these are used for image maps -->++<!ENTITY % Shape "(rect|circle|poly|default)">++<!ENTITY % Coords "CDATA">+ <!-- comma separated list of lengths -->++<!--=================== Generic Attributes ===============================-->++<!-- core attributes common to most elements+ id document-wide unique id+ class space separated list of classes+ style associated style info+ title advisory title/amplification+-->+<!ENTITY % coreattrs+ "id ID #IMPLIED+ class CDATA #IMPLIED+ style %StyleSheet; #IMPLIED+ title %Text; #IMPLIED"+ >++<!-- internationalization attributes+ lang language code (backwards compatible)+ xml:lang language code (as per XML 1.0 spec)+ dir direction for weak/neutral text+-->+<!ENTITY % i18n+ "lang %LanguageCode; #IMPLIED+ xml:lang %LanguageCode; #IMPLIED+ dir (ltr|rtl) #IMPLIED"+ >++<!-- attributes for common UI events+ onclick a pointer button was clicked+ ondblclick a pointer button was double clicked+ onmousedown a pointer button was pressed down+ onmouseup a pointer button was released+ onmousemove a pointer was moved onto the element+ onmouseout a pointer was moved away from the element+ onkeypress a key was pressed and released+ onkeydown a key was pressed down+ onkeyup a key was released+-->+<!ENTITY % events+ "onclick %Script; #IMPLIED+ ondblclick %Script; #IMPLIED+ onmousedown %Script; #IMPLIED+ onmouseup %Script; #IMPLIED+ onmouseover %Script; #IMPLIED+ onmousemove %Script; #IMPLIED+ onmouseout %Script; #IMPLIED+ onkeypress %Script; #IMPLIED+ onkeydown %Script; #IMPLIED+ onkeyup %Script; #IMPLIED"+ >++<!-- attributes for elements that can get the focus+ accesskey accessibility key character+ tabindex position in tabbing order+ onfocus the element got the focus+ onblur the element lost the focus+-->+<!ENTITY % focus+ "accesskey %Character; #IMPLIED+ tabindex %Number; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED"+ >++<!ENTITY % attrs "%coreattrs; %i18n; %events;">++<!--=================== Text Elements ====================================-->++<!ENTITY % special+ "br | span | bdo | object | img | map">++<!ENTITY % fontstyle "tt | i | b | big | small">++<!ENTITY % phrase "em | strong | dfn | code | q | sub | sup |+ samp | kbd | var | cite | abbr | acronym">++<!ENTITY % inline.forms "input | select | textarea | label | button">++<!-- these can occur at block or inline level -->+<!ENTITY % misc "ins | del | script | noscript">++<!ENTITY % inline "a | %special; | %fontstyle; | %phrase; | %inline.forms;">++<!-- %Inline; covers inline or "text-level" elements -->+<!ENTITY % Inline "(#PCDATA | %inline; | %misc;)*">++<!--================== Block level elements ==============================-->++<!ENTITY % heading "h1|h2|h3|h4|h5|h6">+<!ENTITY % lists "ul | ol | dl">+<!ENTITY % blocktext "pre | hr | blockquote | address">++<!ENTITY % block+ "p | %heading; | div | %lists; | %blocktext; | fieldset | table">++<!ENTITY % Block "(%block; | form | %misc;)*">++<!-- %Flow; mixes Block and Inline and is used for list items etc. -->+<!ENTITY % Flow "(#PCDATA | %block; | form | %inline; | %misc;)*">++<!--================== Content models for exclusions =====================-->++<!-- a elements use %Inline; excluding a -->++<!ENTITY % a.content+ "(#PCDATA | %special; | %fontstyle; | %phrase; | %inline.forms; | %misc;)*">++<!-- pre uses %Inline excluding img, object, big, small, sup or sup -->++<!ENTITY % pre.content+ "(#PCDATA | a | br | span | bdo | map | tt | i | b |+ %phrase; | %inline.forms;)*">++<!-- form uses %Block; excluding form -->++<!ENTITY % form.content "(%block; | %misc;)*">++<!-- button uses %Flow; but excludes a, form and form controls -->++<!ENTITY % button.content+ "(#PCDATA | p | %heading; | div | %lists; | %blocktext; |+ table | %special; | %fontstyle; | %phrase; | %misc;)*">++<!--================ Document Structure ==================================-->++<!-- the namespace URI designates the document profile -->++<!ELEMENT html (head, body)>+<!ATTLIST html+ %i18n;+ xmlns %URI; #FIXED 'http://www.w3.org/1999/xhtml'+ >++<!--================ Document Head =======================================-->++<!ENTITY % head.misc "(script|style|meta|link|object)*">++<!-- content model is %head.misc; combined with a single+ title and an optional base element in any order -->++<!ELEMENT head (%head.misc;,+ ((title, %head.misc;, (base, %head.misc;)?) |+ (base, %head.misc;, (title, %head.misc;))))>++<!ATTLIST head+ %i18n;+ profile %URI; #IMPLIED+ >++<!-- The title element is not considered part of the flow of text.+ It should be displayed, for example as the page header or+ window title. Exactly one title is required per document.+ -->+<!ELEMENT title (#PCDATA)>+<!ATTLIST title %i18n;>++<!-- document base URI -->++<!ELEMENT base EMPTY>+<!ATTLIST base+ href %URI; #IMPLIED+ >++<!-- generic metainformation -->+<!ELEMENT meta EMPTY>+<!ATTLIST meta+ %i18n;+ http-equiv CDATA #IMPLIED+ name CDATA #IMPLIED+ content CDATA #REQUIRED+ scheme CDATA #IMPLIED+ >++<!--+ Relationship values can be used in principle:++ a) for document specific toolbars/menus when used+ with the link element in document head e.g.+ start, contents, previous, next, index, end, help+ b) to link to a separate style sheet (rel="stylesheet")+ c) to make a link to a script (rel="script")+ d) by stylesheets to control how collections of+ html nodes are rendered into printed documents+ e) to make a link to a printable version of this document+ e.g. a PostScript or PDF version (rel="alternate" media="print")+-->++<!ELEMENT link EMPTY>+<!ATTLIST link+ %attrs;+ charset %Charset; #IMPLIED+ href %URI; #IMPLIED+ hreflang %LanguageCode; #IMPLIED+ type %ContentType; #IMPLIED+ rel %LinkTypes; #IMPLIED+ rev %LinkTypes; #IMPLIED+ media %MediaDesc; #IMPLIED+ >++<!-- style info, which may include CDATA sections -->+<!ELEMENT style (#PCDATA)>+<!ATTLIST style+ %i18n;+ type %ContentType; #REQUIRED+ media %MediaDesc; #IMPLIED+ title %Text; #IMPLIED+ xml:space (preserve) #FIXED 'preserve'+ >++<!-- script statements, which may include CDATA sections -->+<!ELEMENT script (#PCDATA)>+<!ATTLIST script+ charset %Charset; #IMPLIED+ type %ContentType; #REQUIRED+ src %URI; #IMPLIED+ defer (defer) #IMPLIED+ xml:space (preserve) #FIXED 'preserve'+ >++<!-- alternate content container for non script-based rendering -->++<!ELEMENT noscript %Block;>+<!ATTLIST noscript+ %attrs;+ >++<!--=================== Document Body ====================================-->++<!ELEMENT body %Block;>+<!ATTLIST body+ %attrs;+ onload %Script; #IMPLIED+ onunload %Script; #IMPLIED+ >++<!ELEMENT div %Flow;> <!-- generic language/style container -->+<!ATTLIST div+ %attrs;+ >++<!--=================== Paragraphs =======================================-->++<!ELEMENT p %Inline;>+<!ATTLIST p+ %attrs;+ >++<!--=================== Headings =========================================-->++<!--+ There are six levels of headings from h1 (the most important)+ to h6 (the least important).+-->++<!ELEMENT h1 %Inline;>+<!ATTLIST h1+ %attrs;+ >++<!ELEMENT h2 %Inline;>+<!ATTLIST h2+ %attrs;+ >++<!ELEMENT h3 %Inline;>+<!ATTLIST h3+ %attrs;+ >++<!ELEMENT h4 %Inline;>+<!ATTLIST h4+ %attrs;+ >++<!ELEMENT h5 %Inline;>+<!ATTLIST h5+ %attrs;+ >++<!ELEMENT h6 %Inline;>+<!ATTLIST h6+ %attrs;+ >++<!--=================== Lists ============================================-->++<!-- Unordered list -->++<!ELEMENT ul (li)+>+<!ATTLIST ul+ %attrs;+ >++<!-- Ordered (numbered) list -->++<!ELEMENT ol (li)+>+<!ATTLIST ol+ %attrs;+ >++<!-- list item -->++<!ELEMENT li %Flow;>+<!ATTLIST li+ %attrs;+ >++<!-- definition lists - dt for term, dd for its definition -->++<!ELEMENT dl (dt|dd)+>+<!ATTLIST dl+ %attrs;+ >++<!ELEMENT dt %Inline;>+<!ATTLIST dt+ %attrs;+ >++<!ELEMENT dd %Flow;>+<!ATTLIST dd+ %attrs;+ >++<!--=================== Address ==========================================-->++<!-- information on author -->++<!ELEMENT address %Inline;>+<!ATTLIST address+ %attrs;+ >++<!--=================== Horizontal Rule ==================================-->++<!ELEMENT hr EMPTY>+<!ATTLIST hr+ %attrs;+ >++<!--=================== Preformatted Text ================================-->++<!-- content is %Inline; excluding "img|object|big|small|sub|sup" -->++<!ELEMENT pre %pre.content;>+<!ATTLIST pre+ %attrs;+ xml:space (preserve) #FIXED 'preserve'+ >++<!--=================== Block-like Quotes ================================-->++<!ELEMENT blockquote %Block;>+<!ATTLIST blockquote+ %attrs;+ cite %URI; #IMPLIED+ >++<!--=================== Inserted/Deleted Text ============================-->++<!--+ ins/del are allowed in block and inline content, but its+ inappropriate to include block content within an ins element+ occurring in inline content.+-->+<!ELEMENT ins %Flow;>+<!ATTLIST ins+ %attrs;+ cite %URI; #IMPLIED+ datetime %Datetime; #IMPLIED+ >++<!ELEMENT del %Flow;>+<!ATTLIST del+ %attrs;+ cite %URI; #IMPLIED+ datetime %Datetime; #IMPLIED+ >++<!--================== The Anchor Element ================================-->++<!-- content is %Inline; except that anchors shouldn't be nested -->++<!ELEMENT a %a.content;>+<!ATTLIST a+ %attrs;+ charset %Charset; #IMPLIED+ type %ContentType; #IMPLIED+ name NMTOKEN #IMPLIED+ href %URI; #IMPLIED+ hreflang %LanguageCode; #IMPLIED+ rel %LinkTypes; #IMPLIED+ rev %LinkTypes; #IMPLIED+ accesskey %Character; #IMPLIED+ shape %Shape; "rect"+ coords %Coords; #IMPLIED+ tabindex %Number; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ >++<!--===================== Inline Elements ================================-->++<!ELEMENT span %Inline;> <!-- generic language/style container -->+<!ATTLIST span+ %attrs;+ >++<!ELEMENT bdo %Inline;> <!-- I18N BiDi over-ride -->+<!ATTLIST bdo+ %coreattrs;+ %events;+ lang %LanguageCode; #IMPLIED+ xml:lang %LanguageCode; #IMPLIED+ dir (ltr|rtl) #REQUIRED+ >++<!ELEMENT br EMPTY> <!-- forced line break -->+<!ATTLIST br+ %coreattrs;+ >++<!ELEMENT em %Inline;> <!-- emphasis -->+<!ATTLIST em %attrs;>++<!ELEMENT strong %Inline;> <!-- strong emphasis -->+<!ATTLIST strong %attrs;>++<!ELEMENT dfn %Inline;> <!-- definitional -->+<!ATTLIST dfn %attrs;>++<!ELEMENT code %Inline;> <!-- program code -->+<!ATTLIST code %attrs;>++<!ELEMENT samp %Inline;> <!-- sample -->+<!ATTLIST samp %attrs;>++<!ELEMENT kbd %Inline;> <!-- something user would type -->+<!ATTLIST kbd %attrs;>++<!ELEMENT var %Inline;> <!-- variable -->+<!ATTLIST var %attrs;>++<!ELEMENT cite %Inline;> <!-- citation -->+<!ATTLIST cite %attrs;>++<!ELEMENT abbr %Inline;> <!-- abbreviation -->+<!ATTLIST abbr %attrs;>++<!ELEMENT acronym %Inline;> <!-- acronym -->+<!ATTLIST acronym %attrs;>++<!ELEMENT q %Inline;> <!-- inlined quote -->+<!ATTLIST q+ %attrs;+ cite %URI; #IMPLIED+ >++<!ELEMENT sub %Inline;> <!-- subscript -->+<!ATTLIST sub %attrs;>++<!ELEMENT sup %Inline;> <!-- superscript -->+<!ATTLIST sup %attrs;>++<!ELEMENT tt %Inline;> <!-- fixed pitch font -->+<!ATTLIST tt %attrs;>++<!ELEMENT i %Inline;> <!-- italic font -->+<!ATTLIST i %attrs;>++<!ELEMENT b %Inline;> <!-- bold font -->+<!ATTLIST b %attrs;>++<!ELEMENT big %Inline;> <!-- bigger font -->+<!ATTLIST big %attrs;>++<!ELEMENT small %Inline;> <!-- smaller font -->+<!ATTLIST small %attrs;>++<!--==================== Object ======================================-->+<!--+ object is used to embed objects as part of HTML pages.+ param elements should precede other content. Parameters+ can also be expressed as attribute/value pairs on the+ object element itself when brevity is desired.+-->++<!ELEMENT object (#PCDATA | param | %block; | form | %inline; | %misc;)*>+<!ATTLIST object+ %attrs;+ declare (declare) #IMPLIED+ classid %URI; #IMPLIED+ codebase %URI; #IMPLIED+ data %URI; #IMPLIED+ type %ContentType; #IMPLIED+ codetype %ContentType; #IMPLIED+ archive %UriList; #IMPLIED+ standby %Text; #IMPLIED+ height %Length; #IMPLIED+ width %Length; #IMPLIED+ usemap %URI; #IMPLIED+ name NMTOKEN #IMPLIED+ tabindex %Number; #IMPLIED+ >++<!--+ param is used to supply a named property value.+ In XML it would seem natural to follow RDF and support an+ abbreviated syntax where the param elements are replaced+ by attribute value pairs on the object start tag.+-->+<!ELEMENT param EMPTY>+<!ATTLIST param+ id ID #IMPLIED+ name CDATA #IMPLIED+ value CDATA #IMPLIED+ valuetype (data|ref|object) "data"+ type %ContentType; #IMPLIED+ >++<!--=================== Images ===========================================-->++<!--+ To avoid accessibility problems for people who aren't+ able to see the image, you should provide a text+ description using the alt and longdesc attributes.+ In addition, avoid the use of server-side image maps.+ Note that in this DTD there is no name attribute. That+ is only available in the transitional and frameset DTD.+-->++<!ELEMENT img EMPTY>+<!ATTLIST img+ %attrs;+ src %URI; #REQUIRED+ alt %Text; #REQUIRED+ longdesc %URI; #IMPLIED+ height %Length; #IMPLIED+ width %Length; #IMPLIED+ usemap %URI; #IMPLIED+ ismap (ismap) #IMPLIED+ >++<!-- usemap points to a map element which may be in this document+ or an external document, although the latter is not widely supported -->++<!--================== Client-side image maps ============================-->++<!-- These can be placed in the same document or grouped in a+ separate document although this isn't yet widely supported -->++<!ELEMENT map ((%block; | form | %misc;)+ | area+)>+<!ATTLIST map+ %i18n;+ %events;+ id ID #REQUIRED+ class CDATA #IMPLIED+ style %StyleSheet; #IMPLIED+ title %Text; #IMPLIED+ name NMTOKEN #IMPLIED+ >++<!ELEMENT area EMPTY>+<!ATTLIST area+ %attrs;+ shape %Shape; "rect"+ coords %Coords; #IMPLIED+ href %URI; #IMPLIED+ nohref (nohref) #IMPLIED+ alt %Text; #REQUIRED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ >++<!--================ Forms ===============================================-->+<!ELEMENT form %form.content;> <!-- forms shouldn't be nested -->++<!ATTLIST form+ %attrs;+ action %URI; #REQUIRED+ method (get|post) "get"+ enctype %ContentType; "application/x-www-form-urlencoded"+ onsubmit %Script; #IMPLIED+ onreset %Script; #IMPLIED+ accept %ContentTypes; #IMPLIED+ accept-charset %Charsets; #IMPLIED+ >++<!--+ Each label must not contain more than ONE field+ Label elements shouldn't be nested.+-->+<!ELEMENT label %Inline;>+<!ATTLIST label+ %attrs;+ for IDREF #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ >++<!ENTITY % InputType+ "(text | password | checkbox |+ radio | submit | reset |+ file | hidden | image | button)"+ >++<!-- the name attribute is required for all but submit & reset -->++<!ELEMENT input EMPTY> <!-- form control -->+<!ATTLIST input+ %attrs;+ type %InputType; "text"+ name CDATA #IMPLIED+ value CDATA #IMPLIED+ checked (checked) #IMPLIED+ disabled (disabled) #IMPLIED+ readonly (readonly) #IMPLIED+ size CDATA #IMPLIED+ maxlength %Number; #IMPLIED+ src %URI; #IMPLIED+ alt CDATA #IMPLIED+ usemap %URI; #IMPLIED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ onselect %Script; #IMPLIED+ onchange %Script; #IMPLIED+ accept %ContentTypes; #IMPLIED+ >++<!ELEMENT select (optgroup|option)+> <!-- option selector -->+<!ATTLIST select+ %attrs;+ name CDATA #IMPLIED+ size %Number; #IMPLIED+ multiple (multiple) #IMPLIED+ disabled (disabled) #IMPLIED+ tabindex %Number; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ onchange %Script; #IMPLIED+ >++<!ELEMENT optgroup (option)+> <!-- option group -->+<!ATTLIST optgroup+ %attrs;+ disabled (disabled) #IMPLIED+ label %Text; #REQUIRED+ >++<!ELEMENT option (#PCDATA)> <!-- selectable choice -->+<!ATTLIST option+ %attrs;+ selected (selected) #IMPLIED+ disabled (disabled) #IMPLIED+ label %Text; #IMPLIED+ value CDATA #IMPLIED+ >++<!ELEMENT textarea (#PCDATA)> <!-- multi-line text field -->+<!ATTLIST textarea+ %attrs;+ name CDATA #IMPLIED+ rows %Number; #REQUIRED+ cols %Number; #REQUIRED+ disabled (disabled) #IMPLIED+ readonly (readonly) #IMPLIED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ onselect %Script; #IMPLIED+ onchange %Script; #IMPLIED+ >++<!--+ The fieldset element is used to group form fields.+ Only one legend element should occur in the content+ and if present should only be preceded by whitespace.+-->+<!ELEMENT fieldset (#PCDATA | legend | %block; | form | %inline; | %misc;)*>+<!ATTLIST fieldset+ %attrs;+ >++<!ELEMENT legend %Inline;> <!-- fieldset label -->+<!ATTLIST legend+ %attrs;+ accesskey %Character; #IMPLIED+ >++<!--+ Content is %Flow; excluding a, form and form controls+--> +<!ELEMENT button %button.content;> <!-- push button -->+<!ATTLIST button+ %attrs;+ name CDATA #IMPLIED+ value CDATA #IMPLIED+ type (button|submit|reset) "submit"+ disabled (disabled) #IMPLIED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ >++<!--======================= Tables =======================================-->++<!-- Derived from IETF HTML table standard, see [RFC1942] -->++<!--+ The border attribute sets the thickness of the frame around the+ table. The default units are screen pixels.++ The frame attribute specifies which parts of the frame around+ the table should be rendered. The values are not the same as+ CALS to avoid a name clash with the valign attribute.+-->+<!ENTITY % TFrame "(void|above|below|hsides|lhs|rhs|vsides|box|border)">++<!--+ The rules attribute defines which rules to draw between cells:++ If rules is absent then assume:+ "none" if border is absent or border="0" otherwise "all"+-->++<!ENTITY % TRules "(none | groups | rows | cols | all)">+ +<!-- horizontal placement of table relative to document -->+<!ENTITY % TAlign "(left|center|right)">++<!-- horizontal alignment attributes for cell contents++ char alignment char, e.g. char=':'+ charoff offset for alignment char+-->+<!ENTITY % cellhalign+ "align (left|center|right|justify|char) #IMPLIED+ char %Character; #IMPLIED+ charoff %Length; #IMPLIED"+ >++<!-- vertical alignment attributes for cell contents -->+<!ENTITY % cellvalign+ "valign (top|middle|bottom|baseline) #IMPLIED"+ >++<!ELEMENT table+ (caption?, (col*|colgroup*), thead?, tfoot?, (tbody+|tr+))>+<!ELEMENT caption %Inline;>+<!ELEMENT thead (tr)+>+<!ELEMENT tfoot (tr)+>+<!ELEMENT tbody (tr)+>+<!ELEMENT colgroup (col)*>+<!ELEMENT col EMPTY>+<!ELEMENT tr (th|td)+>+<!ELEMENT th %Flow;>+<!ELEMENT td %Flow;>++<!ATTLIST table+ %attrs;+ summary %Text; #IMPLIED+ width %Length; #IMPLIED+ border %Pixels; #IMPLIED+ frame %TFrame; #IMPLIED+ rules %TRules; #IMPLIED+ cellspacing %Length; #IMPLIED+ cellpadding %Length; #IMPLIED+ >++<!ENTITY % CAlign "(top|bottom|left|right)">++<!ATTLIST caption+ %attrs;+ >++<!--+colgroup groups a set of col elements. It allows you to group+several semantically related columns together.+-->+<!ATTLIST colgroup+ %attrs;+ span %Number; "1"+ width %MultiLength; #IMPLIED+ %cellhalign;+ %cellvalign;+ >++<!--+ col elements define the alignment properties for cells in+ one or more columns.++ The width attribute specifies the width of the columns, e.g.++ width=64 width in screen pixels+ width=0.5* relative width of 0.5++ The span attribute causes the attributes of one+ col element to apply to more than one column.+-->+<!ATTLIST col+ %attrs;+ span %Number; "1"+ width %MultiLength; #IMPLIED+ %cellhalign;+ %cellvalign;+ >++<!--+ Use thead to duplicate headers when breaking table+ across page boundaries, or for static headers when+ tbody sections are rendered in scrolling panel.++ Use tfoot to duplicate footers when breaking table+ across page boundaries, or for static footers when+ tbody sections are rendered in scrolling panel.++ Use multiple tbody sections when rules are needed+ between groups of table rows.+-->+<!ATTLIST thead+ %attrs;+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST tfoot+ %attrs;+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST tbody+ %attrs;+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST tr+ %attrs;+ %cellhalign;+ %cellvalign;+ >+++<!-- Scope is simpler than headers attribute for common tables -->+<!ENTITY % Scope "(row|col|rowgroup|colgroup)">++<!-- th is for headers, td for data and for cells acting as both -->++<!ATTLIST th+ %attrs;+ abbr %Text; #IMPLIED+ axis CDATA #IMPLIED+ headers IDREFS #IMPLIED+ scope %Scope; #IMPLIED+ rowspan %Number; "1"+ colspan %Number; "1"+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST td+ %attrs;+ abbr %Text; #IMPLIED+ axis CDATA #IMPLIED+ headers IDREFS #IMPLIED+ scope %Scope; #IMPLIED+ rowspan %Number; "1"+ colspan %Number; "1"+ %cellhalign;+ %cellvalign;+ >+
+ examples/xhtml/xhtml1-transitional.dtd view
@@ -0,0 +1,1196 @@+<!--+ Extensible HTML version 1.0 Transitional DTD++ This is the same as HTML 4.0 Transitional except for+ changes due to the differences between XML and SGML.++ Namespace = http://www.w3.org/1999/xhtml++ For further information, see: http://www.w3.org/TR/xhtml1++ Copyright (c) 1998-2000 W3C (MIT, INRIA, Keio),+ All Rights Reserved. ++ This DTD module is identified by the PUBLIC and SYSTEM identifiers:++ PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"+ SYSTEM "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"++ $Revision: 1.1 $+ $Date: 2002/10/01 13:47:08 $++-->++<!--================ Character mnemonic entities =========================-->++<!ENTITY % HTMLlat1 PUBLIC+ "-//W3C//ENTITIES Latin 1 for XHTML//EN"+ "xhtml-lat1.ent">+%HTMLlat1;++<!ENTITY % HTMLsymbol PUBLIC+ "-//W3C//ENTITIES Symbols for XHTML//EN"+ "xhtml-symbol.ent">+%HTMLsymbol;++<!ENTITY % HTMLspecial PUBLIC+ "-//W3C//ENTITIES Special for XHTML//EN"+ "xhtml-special.ent">+%HTMLspecial;++<!--================== Imported Names ====================================-->++<!ENTITY % ContentType "CDATA">+ <!-- media type, as per [RFC2045] -->++<!ENTITY % ContentTypes "CDATA">+ <!-- comma-separated list of media types, as per [RFC2045] -->++<!ENTITY % Charset "CDATA">+ <!-- a character encoding, as per [RFC2045] -->++<!ENTITY % Charsets "CDATA">+ <!-- a space separated list of character encodings, as per [RFC2045] -->++<!ENTITY % LanguageCode "NMTOKEN">+ <!-- a language code, as per [RFC1766] -->++<!ENTITY % Character "CDATA">+ <!-- a single character from [ISO10646] -->++<!ENTITY % Number "CDATA">+ <!-- one or more digits -->++<!ENTITY % LinkTypes "CDATA">+ <!-- space-separated list of link types -->++<!ENTITY % MediaDesc "CDATA">+ <!-- single or comma-separated list of media descriptors -->++<!ENTITY % URI "CDATA">+ <!-- a Uniform Resource Identifier, see [RFC2396] -->++<!ENTITY % UriList "CDATA">+ <!-- a space separated list of Uniform Resource Identifiers -->++<!ENTITY % Datetime "CDATA">+ <!-- date and time information. ISO date format -->++<!ENTITY % Script "CDATA">+ <!-- script expression -->++<!ENTITY % StyleSheet "CDATA">+ <!-- style sheet data -->++<!ENTITY % Text "CDATA">+ <!-- used for titles etc. -->++<!ENTITY % FrameTarget "NMTOKEN">+ <!-- render in this frame -->++<!ENTITY % Length "CDATA">+ <!-- nn for pixels or nn% for percentage length -->++<!ENTITY % MultiLength "CDATA">+ <!-- pixel, percentage, or relative -->++<!ENTITY % MultiLengths "CDATA">+ <!-- comma-separated list of MultiLength -->++<!ENTITY % Pixels "CDATA">+ <!-- integer representing length in pixels -->++<!-- these are used for image maps -->++<!ENTITY % Shape "(rect|circle|poly|default)">++<!ENTITY % Coords "CDATA">+ <!-- comma separated list of lengths -->++<!-- used for object, applet, img, input and iframe -->+<!ENTITY % ImgAlign "(top|middle|bottom|left|right)">++<!-- a color using sRGB: #RRGGBB as Hex values -->+<!ENTITY % Color "CDATA">++<!-- There are also 16 widely known color names with their sRGB values:++ Black = #000000 Green = #008000+ Silver = #C0C0C0 Lime = #00FF00+ Gray = #808080 Olive = #808000+ White = #FFFFFF Yellow = #FFFF00+ Maroon = #800000 Navy = #000080+ Red = #FF0000 Blue = #0000FF+ Purple = #800080 Teal = #008080+ Fuchsia= #FF00FF Aqua = #00FFFF+-->++<!--=================== Generic Attributes ===============================-->++<!-- core attributes common to most elements+ id document-wide unique id+ class space separated list of classes+ style associated style info+ title advisory title/amplification+-->+<!ENTITY % coreattrs+ "id ID #IMPLIED+ class CDATA #IMPLIED+ style %StyleSheet; #IMPLIED+ title %Text; #IMPLIED"+ >++<!-- internationalization attributes+ lang language code (backwards compatible)+ xml:lang language code (as per XML 1.0 spec)+ dir direction for weak/neutral text+-->+<!ENTITY % i18n+ "lang %LanguageCode; #IMPLIED+ xml:lang %LanguageCode; #IMPLIED+ dir (ltr|rtl) #IMPLIED"+ >++<!-- attributes for common UI events+ onclick a pointer button was clicked+ ondblclick a pointer button was double clicked+ onmousedown a pointer button was pressed down+ onmouseup a pointer button was released+ onmousemove a pointer was moved onto the element+ onmouseout a pointer was moved away from the element+ onkeypress a key was pressed and released+ onkeydown a key was pressed down+ onkeyup a key was released+-->+<!ENTITY % events+ "onclick %Script; #IMPLIED+ ondblclick %Script; #IMPLIED+ onmousedown %Script; #IMPLIED+ onmouseup %Script; #IMPLIED+ onmouseover %Script; #IMPLIED+ onmousemove %Script; #IMPLIED+ onmouseout %Script; #IMPLIED+ onkeypress %Script; #IMPLIED+ onkeydown %Script; #IMPLIED+ onkeyup %Script; #IMPLIED"+ >++<!-- attributes for elements that can get the focus+ accesskey accessibility key character+ tabindex position in tabbing order+ onfocus the element got the focus+ onblur the element lost the focus+-->+<!ENTITY % focus+ "accesskey %Character; #IMPLIED+ tabindex %Number; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED"+ >++<!ENTITY % attrs "%coreattrs; %i18n; %events;">++<!-- text alignment for p, div, h1-h6. The default is+ align="left" for ltr headings, "right" for rtl -->++<!ENTITY % TextAlign "align (left|center|right) #IMPLIED">++<!--=================== Text Elements ====================================-->++<!ENTITY % special+ "br | span | bdo | object | applet | img | map | iframe">++<!ENTITY % fontstyle "tt | i | b | big | small | u+ | s | strike |font | basefont">++<!ENTITY % phrase "em | strong | dfn | code | q | sub | sup |+ samp | kbd | var | cite | abbr | acronym">++<!ENTITY % inline.forms "input | select | textarea | label | button">++<!-- these can occur at block or inline level -->+<!ENTITY % misc "ins | del | script | noscript">++<!ENTITY % inline "a | %special; | %fontstyle; | %phrase; | %inline.forms;">++<!-- %Inline; covers inline or "text-level" elements -->+<!ENTITY % Inline "(#PCDATA | %inline; | %misc;)*">++<!--================== Block level elements ==============================-->++<!ENTITY % heading "h1|h2|h3|h4|h5|h6">+<!ENTITY % lists "ul | ol | dl | menu | dir">+<!ENTITY % blocktext "pre | hr | blockquote | address | center | noframes">++<!ENTITY % block+ "p | %heading; | div | %lists; | %blocktext; | isindex |fieldset | table">++<!ENTITY % Block "(%block; | form | %misc;)*">++<!-- %Flow; mixes Block and Inline and is used for list items etc. -->+<!ENTITY % Flow "(#PCDATA | %block; | form | %inline; | %misc;)*">++<!--================== Content models for exclusions =====================-->++<!-- a elements use %Inline; excluding a -->++<!ENTITY % a.content+ "(#PCDATA | %special; | %fontstyle; | %phrase; | %inline.forms; | %misc;)*">++<!-- pre uses %Inline excluding img, object, applet, big, small,+ sub, sup, font, or basefont -->++<!ENTITY % pre.content+ "(#PCDATA | a | br | span | bdo | map | tt | i | b | u | s |+ %phrase; | %inline.forms;)*">++<!-- form uses %Flow; excluding form -->++<!ENTITY % form.content "(#PCDATA | %block; | %inline; | %misc;)*">++<!-- button uses %Flow; but excludes a, form, form controls, iframe -->++<!ENTITY % button.content+ "(#PCDATA | p | %heading; | div | %lists; | %blocktext; |+ table | br | span | bdo | object | applet | img | map |+ %fontstyle; | %phrase; | %misc;)*">++<!--================ Document Structure ==================================-->++<!-- the namespace URI designates the document profile -->++<!ELEMENT html (head, body)>+<!ATTLIST html+ %i18n;+ xmlns %URI; #FIXED 'http://www.w3.org/1999/xhtml'+ >++<!--================ Document Head =======================================-->++<!ENTITY % head.misc "(script|style|meta|link|object|isindex)*">++<!-- content model is %head.misc; combined with a single+ title and an optional base element in any order -->++<!ELEMENT head (%head.misc;,+ ((title, %head.misc;, (base, %head.misc;)?) |+ (base, %head.misc;, (title, %head.misc;))))>++<!ATTLIST head+ %i18n;+ profile %URI; #IMPLIED+ >++<!-- The title element is not considered part of the flow of text.+ It should be displayed, for example as the page header or+ window title. Exactly one title is required per document.+ -->+<!ELEMENT title (#PCDATA)>+<!ATTLIST title %i18n;>++<!-- document base URI -->++<!ELEMENT base EMPTY>+<!ATTLIST base+ href %URI; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!-- generic metainformation -->+<!ELEMENT meta EMPTY>+<!ATTLIST meta+ %i18n;+ http-equiv CDATA #IMPLIED+ name CDATA #IMPLIED+ content CDATA #REQUIRED+ scheme CDATA #IMPLIED+ >++<!--+ Relationship values can be used in principle:++ a) for document specific toolbars/menus when used+ with the link element in document head e.g.+ start, contents, previous, next, index, end, help+ b) to link to a separate style sheet (rel="stylesheet")+ c) to make a link to a script (rel="script")+ d) by stylesheets to control how collections of+ html nodes are rendered into printed documents+ e) to make a link to a printable version of this document+ e.g. a PostScript or PDF version (rel="alternate" media="print")+-->++<!ELEMENT link EMPTY>+<!ATTLIST link+ %attrs;+ charset %Charset; #IMPLIED+ href %URI; #IMPLIED+ hreflang %LanguageCode; #IMPLIED+ type %ContentType; #IMPLIED+ rel %LinkTypes; #IMPLIED+ rev %LinkTypes; #IMPLIED+ media %MediaDesc; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!-- style info, which may include CDATA sections -->+<!ELEMENT style (#PCDATA)>+<!ATTLIST style+ %i18n;+ type %ContentType; #REQUIRED+ media %MediaDesc; #IMPLIED+ title %Text; #IMPLIED+ xml:space (preserve) #FIXED 'preserve'+ >++<!-- script statements, which may include CDATA sections -->+<!ELEMENT script (#PCDATA)>+<!ATTLIST script+ charset %Charset; #IMPLIED+ type %ContentType; #REQUIRED+ language CDATA #IMPLIED+ src %URI; #IMPLIED+ defer (defer) #IMPLIED+ xml:space (preserve) #FIXED 'preserve'+ >++<!-- alternate content container for non script-based rendering -->++<!ELEMENT noscript %Flow;>+<!ATTLIST noscript+ %attrs;+ >++<!--======================= Frames =======================================-->++<!-- inline subwindow -->++<!ELEMENT iframe %Flow;>+<!ATTLIST iframe+ %coreattrs;+ longdesc %URI; #IMPLIED+ name NMTOKEN #IMPLIED+ src %URI; #IMPLIED+ frameborder (1|0) "1"+ marginwidth %Pixels; #IMPLIED+ marginheight %Pixels; #IMPLIED+ scrolling (yes|no|auto) "auto"+ align %ImgAlign; #IMPLIED+ height %Length; #IMPLIED+ width %Length; #IMPLIED+ >++<!-- alternate content container for non frame-based rendering -->++<!ELEMENT noframes %Flow;>+<!ATTLIST noframes+ %attrs;+ >++<!--=================== Document Body ====================================-->++<!ELEMENT body %Flow;>+<!ATTLIST body+ %attrs;+ onload %Script; #IMPLIED+ onunload %Script; #IMPLIED+ background %URI; #IMPLIED+ bgcolor %Color; #IMPLIED+ text %Color; #IMPLIED+ link %Color; #IMPLIED+ vlink %Color; #IMPLIED+ alink %Color; #IMPLIED+ >++<!ELEMENT div %Flow;> <!-- generic language/style container -->+<!ATTLIST div+ %attrs;+ %TextAlign;+ >++<!--=================== Paragraphs =======================================-->++<!ELEMENT p %Inline;>+<!ATTLIST p+ %attrs;+ %TextAlign;+ >++<!--=================== Headings =========================================-->++<!--+ There are six levels of headings from h1 (the most important)+ to h6 (the least important).+-->++<!ELEMENT h1 %Inline;>+<!ATTLIST h1+ %attrs;+ %TextAlign;+ >++<!ELEMENT h2 %Inline;>+<!ATTLIST h2+ %attrs;+ %TextAlign;+ >++<!ELEMENT h3 %Inline;>+<!ATTLIST h3+ %attrs;+ %TextAlign;+ >++<!ELEMENT h4 %Inline;>+<!ATTLIST h4+ %attrs;+ %TextAlign;+ >++<!ELEMENT h5 %Inline;>+<!ATTLIST h5+ %attrs;+ %TextAlign;+ >++<!ELEMENT h6 %Inline;>+<!ATTLIST h6+ %attrs;+ %TextAlign;+ >++<!--=================== Lists ============================================-->++<!-- Unordered list bullet styles -->++<!ENTITY % ULStyle "(disc|square|circle)">++<!-- Unordered list -->++<!ELEMENT ul (li)+>+<!ATTLIST ul+ %attrs;+ type %ULStyle; #IMPLIED+ compact (compact) #IMPLIED+ >++<!-- Ordered list numbering style++ 1 arabic numbers 1, 2, 3, ...+ a lower alpha a, b, c, ...+ A upper alpha A, B, C, ...+ i lower roman i, ii, iii, ...+ I upper roman I, II, III, ...++ The style is applied to the sequence number which by default+ is reset to 1 for the first list item in an ordered list.+-->+<!ENTITY % OLStyle "CDATA">++<!-- Ordered (numbered) list -->++<!ELEMENT ol (li)+>+<!ATTLIST ol+ %attrs;+ type %OLStyle; #IMPLIED+ compact (compact) #IMPLIED+ start %Number; #IMPLIED+ >++<!-- single column list (DEPRECATED) --> +<!ELEMENT menu (li)+>+<!ATTLIST menu+ %attrs;+ compact (compact) #IMPLIED+ >++<!-- multiple column list (DEPRECATED) --> +<!ELEMENT dir (li)+>+<!ATTLIST dir+ %attrs;+ compact (compact) #IMPLIED+ >++<!-- LIStyle is constrained to: "(%ULStyle;|%OLStyle;)" -->+<!ENTITY % LIStyle "CDATA">++<!-- list item -->++<!ELEMENT li %Flow;>+<!ATTLIST li+ %attrs;+ type %LIStyle; #IMPLIED+ value %Number; #IMPLIED+ >++<!-- definition lists - dt for term, dd for its definition -->++<!ELEMENT dl (dt|dd)+>+<!ATTLIST dl+ %attrs;+ compact (compact) #IMPLIED+ >++<!ELEMENT dt %Inline;>+<!ATTLIST dt+ %attrs;+ >++<!ELEMENT dd %Flow;>+<!ATTLIST dd+ %attrs;+ >++<!--=================== Address ==========================================-->++<!-- information on author -->++<!ELEMENT address %Inline;>+<!ATTLIST address+ %attrs;+ >++<!--=================== Horizontal Rule ==================================-->++<!ELEMENT hr EMPTY>+<!ATTLIST hr+ %attrs;+ align (left|center|right) #IMPLIED+ noshade (noshade) #IMPLIED+ size %Pixels; #IMPLIED+ width %Length; #IMPLIED+ >++<!--=================== Preformatted Text ================================-->++<!-- content is %Inline; excluding + "img|object|applet|big|small|sub|sup|font|basefont" -->++<!ELEMENT pre %pre.content;>+<!ATTLIST pre+ %attrs;+ width %Number; #IMPLIED+ xml:space (preserve) #FIXED 'preserve'+ >++<!--=================== Block-like Quotes ================================-->++<!ELEMENT blockquote %Flow;>+<!ATTLIST blockquote+ %attrs;+ cite %URI; #IMPLIED+ >++<!--=================== Text alignment ===================================-->++<!-- center content -->+<!ELEMENT center %Flow;>+<!ATTLIST center+ %attrs;+ >++<!--=================== Inserted/Deleted Text ============================-->++<!--+ ins/del are allowed in block and inline content, but its+ inappropriate to include block content within an ins element+ occurring in inline content.+-->+<!ELEMENT ins %Flow;>+<!ATTLIST ins+ %attrs;+ cite %URI; #IMPLIED+ datetime %Datetime; #IMPLIED+ >++<!ELEMENT del %Flow;>+<!ATTLIST del+ %attrs;+ cite %URI; #IMPLIED+ datetime %Datetime; #IMPLIED+ >++<!--================== The Anchor Element ================================-->++<!-- content is %Inline; except that anchors shouldn't be nested -->++<!ELEMENT a %a.content;>+<!ATTLIST a+ %attrs;+ charset %Charset; #IMPLIED+ type %ContentType; #IMPLIED+ name NMTOKEN #IMPLIED+ href %URI; #IMPLIED+ hreflang %LanguageCode; #IMPLIED+ rel %LinkTypes; #IMPLIED+ rev %LinkTypes; #IMPLIED+ accesskey %Character; #IMPLIED+ shape %Shape; "rect"+ coords %Coords; #IMPLIED+ tabindex %Number; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!--===================== Inline Elements ================================-->++<!ELEMENT span %Inline;> <!-- generic language/style container -->+<!ATTLIST span+ %attrs;+ >++<!ELEMENT bdo %Inline;> <!-- I18N BiDi over-ride -->+<!ATTLIST bdo+ %coreattrs;+ %events;+ lang %LanguageCode; #IMPLIED+ xml:lang %LanguageCode; #IMPLIED+ dir (ltr|rtl) #REQUIRED+ >++<!ELEMENT br EMPTY> <!-- forced line break -->+<!ATTLIST br+ %coreattrs;+ clear (left|all|right|none) "none"+ >++<!ELEMENT em %Inline;> <!-- emphasis -->+<!ATTLIST em %attrs;>++<!ELEMENT strong %Inline;> <!-- strong emphasis -->+<!ATTLIST strong %attrs;>++<!ELEMENT dfn %Inline;> <!-- definitional -->+<!ATTLIST dfn %attrs;>++<!ELEMENT code %Inline;> <!-- program code -->+<!ATTLIST code %attrs;>++<!ELEMENT samp %Inline;> <!-- sample -->+<!ATTLIST samp %attrs;>++<!ELEMENT kbd %Inline;> <!-- something user would type -->+<!ATTLIST kbd %attrs;>++<!ELEMENT var %Inline;> <!-- variable -->+<!ATTLIST var %attrs;>++<!ELEMENT cite %Inline;> <!-- citation -->+<!ATTLIST cite %attrs;>++<!ELEMENT abbr %Inline;> <!-- abbreviation -->+<!ATTLIST abbr %attrs;>++<!ELEMENT acronym %Inline;> <!-- acronym -->+<!ATTLIST acronym %attrs;>++<!ELEMENT q %Inline;> <!-- inlined quote -->+<!ATTLIST q+ %attrs;+ cite %URI; #IMPLIED+ >++<!ELEMENT sub %Inline;> <!-- subscript -->+<!ATTLIST sub %attrs;>++<!ELEMENT sup %Inline;> <!-- superscript -->+<!ATTLIST sup %attrs;>++<!ELEMENT tt %Inline;> <!-- fixed pitch font -->+<!ATTLIST tt %attrs;>++<!ELEMENT i %Inline;> <!-- italic font -->+<!ATTLIST i %attrs;>++<!ELEMENT b %Inline;> <!-- bold font -->+<!ATTLIST b %attrs;>++<!ELEMENT big %Inline;> <!-- bigger font -->+<!ATTLIST big %attrs;>++<!ELEMENT small %Inline;> <!-- smaller font -->+<!ATTLIST small %attrs;>++<!ELEMENT u %Inline;> <!-- underline -->+<!ATTLIST u %attrs;>++<!ELEMENT s %Inline;> <!-- strike-through -->+<!ATTLIST s %attrs;>++<!ELEMENT strike %Inline;> <!-- strike-through -->+<!ATTLIST strike %attrs;>++<!ELEMENT basefont EMPTY> <!-- base font size -->+<!ATTLIST basefont+ id ID #IMPLIED+ size CDATA #REQUIRED+ color %Color; #IMPLIED+ face CDATA #IMPLIED+ >++<!ELEMENT font %Inline;> <!-- local change to font -->+<!ATTLIST font+ %coreattrs;+ %i18n;+ size CDATA #IMPLIED+ color %Color; #IMPLIED+ face CDATA #IMPLIED+ >++<!--==================== Object ======================================-->+<!--+ object is used to embed objects as part of HTML pages.+ param elements should precede other content. Parameters+ can also be expressed as attribute/value pairs on the+ object element itself when brevity is desired.+-->++<!ELEMENT object (#PCDATA | param | %block; | form | %inline; | %misc;)*>+<!ATTLIST object+ %attrs;+ declare (declare) #IMPLIED+ classid %URI; #IMPLIED+ codebase %URI; #IMPLIED+ data %URI; #IMPLIED+ type %ContentType; #IMPLIED+ codetype %ContentType; #IMPLIED+ archive %UriList; #IMPLIED+ standby %Text; #IMPLIED+ height %Length; #IMPLIED+ width %Length; #IMPLIED+ usemap %URI; #IMPLIED+ name NMTOKEN #IMPLIED+ tabindex %Number; #IMPLIED+ align %ImgAlign; #IMPLIED+ border %Pixels; #IMPLIED+ hspace %Pixels; #IMPLIED+ vspace %Pixels; #IMPLIED+ >++<!--+ param is used to supply a named property value.+ In XML it would seem natural to follow RDF and support an+ abbreviated syntax where the param elements are replaced+ by attribute value pairs on the object start tag.+-->+<!ELEMENT param EMPTY>+<!ATTLIST param+ id ID #IMPLIED+ name CDATA #REQUIRED+ value CDATA #IMPLIED+ valuetype (data|ref|object) "data"+ type %ContentType; #IMPLIED+ >++<!--=================== Java applet ==================================-->+<!--+ One of code or object attributes must be present.+ Place param elements before other content.+-->+<!ELEMENT applet (#PCDATA | param | %block; | form | %inline; | %misc;)*>+<!ATTLIST applet+ %coreattrs;+ codebase %URI; #IMPLIED+ archive CDATA #IMPLIED+ code CDATA #IMPLIED+ object CDATA #IMPLIED+ alt %Text; #IMPLIED+ name NMTOKEN #IMPLIED+ width %Length; #REQUIRED+ height %Length; #REQUIRED+ align %ImgAlign; #IMPLIED+ hspace %Pixels; #IMPLIED+ vspace %Pixels; #IMPLIED+ >++<!--=================== Images ===========================================-->++<!--+ To avoid accessibility problems for people who aren't+ able to see the image, you should provide a text+ description using the alt and longdesc attributes.+ In addition, avoid the use of server-side image maps.+-->++<!ELEMENT img EMPTY>+<!ATTLIST img+ %attrs;+ src %URI; #REQUIRED+ alt %Text; #REQUIRED+ name NMTOKEN #IMPLIED+ longdesc %URI; #IMPLIED+ height %Length; #IMPLIED+ width %Length; #IMPLIED+ usemap %URI; #IMPLIED+ ismap (ismap) #IMPLIED+ align %ImgAlign; #IMPLIED+ border %Length; #IMPLIED+ hspace %Pixels; #IMPLIED+ vspace %Pixels; #IMPLIED+ >++<!-- usemap points to a map element which may be in this document+ or an external document, although the latter is not widely supported -->++<!--================== Client-side image maps ============================-->++<!-- These can be placed in the same document or grouped in a+ separate document although this isn't yet widely supported -->++<!ELEMENT map ((%block; | form | %misc;)+ | area+)>+<!ATTLIST map+ %i18n;+ %events;+ id ID #REQUIRED+ class CDATA #IMPLIED+ style %StyleSheet; #IMPLIED+ title %Text; #IMPLIED+ name CDATA #IMPLIED+ >++<!ELEMENT area EMPTY>+<!ATTLIST area+ %attrs;+ shape %Shape; "rect"+ coords %Coords; #IMPLIED+ href %URI; #IMPLIED+ nohref (nohref) #IMPLIED+ alt %Text; #REQUIRED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!--================ Forms ===============================================-->++<!ELEMENT form %form.content;> <!-- forms shouldn't be nested -->++<!ATTLIST form+ %attrs;+ action %URI; #REQUIRED+ method (get|post) "get"+ name NMTOKEN #IMPLIED+ enctype %ContentType; "application/x-www-form-urlencoded"+ onsubmit %Script; #IMPLIED+ onreset %Script; #IMPLIED+ accept %ContentTypes; #IMPLIED+ accept-charset %Charsets; #IMPLIED+ target %FrameTarget; #IMPLIED+ >++<!--+ Each label must not contain more than ONE field+ Label elements shouldn't be nested.+-->+<!ELEMENT label %Inline;>+<!ATTLIST label+ %attrs;+ for IDREF #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ >++<!ENTITY % InputType+ "(text | password | checkbox |+ radio | submit | reset |+ file | hidden | image | button)"+ >++<!-- the name attribute is required for all but submit & reset -->++<!ELEMENT input EMPTY> <!-- form control -->+<!ATTLIST input+ %attrs;+ type %InputType; "text"+ name CDATA #IMPLIED+ value CDATA #IMPLIED+ checked (checked) #IMPLIED+ disabled (disabled) #IMPLIED+ readonly (readonly) #IMPLIED+ size CDATA #IMPLIED+ maxlength %Number; #IMPLIED+ src %URI; #IMPLIED+ alt CDATA #IMPLIED+ usemap %URI; #IMPLIED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ onselect %Script; #IMPLIED+ onchange %Script; #IMPLIED+ accept %ContentTypes; #IMPLIED+ align %ImgAlign; #IMPLIED+ >++<!ELEMENT select (optgroup|option)+> <!-- option selector -->+<!ATTLIST select+ %attrs;+ name CDATA #IMPLIED+ size %Number; #IMPLIED+ multiple (multiple) #IMPLIED+ disabled (disabled) #IMPLIED+ tabindex %Number; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ onchange %Script; #IMPLIED+ >++<!ELEMENT optgroup (option)+> <!-- option group -->+<!ATTLIST optgroup+ %attrs;+ disabled (disabled) #IMPLIED+ label %Text; #REQUIRED+ >++<!ELEMENT option (#PCDATA)> <!-- selectable choice -->+<!ATTLIST option+ %attrs;+ selected (selected) #IMPLIED+ disabled (disabled) #IMPLIED+ label %Text; #IMPLIED+ value CDATA #IMPLIED+ >++<!ELEMENT textarea (#PCDATA)> <!-- multi-line text field -->+<!ATTLIST textarea+ %attrs;+ name CDATA #IMPLIED+ rows %Number; #REQUIRED+ cols %Number; #REQUIRED+ disabled (disabled) #IMPLIED+ readonly (readonly) #IMPLIED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ onselect %Script; #IMPLIED+ onchange %Script; #IMPLIED+ >++<!--+ The fieldset element is used to group form fields.+ Only one legend element should occur in the content+ and if present should only be preceded by whitespace.+-->+<!ELEMENT fieldset (#PCDATA | legend | %block; | form | %inline; | %misc;)*>+<!ATTLIST fieldset+ %attrs;+ >++<!ENTITY % LAlign "(top|bottom|left|right)">++<!ELEMENT legend %Inline;> <!-- fieldset label -->+<!ATTLIST legend+ %attrs;+ accesskey %Character; #IMPLIED+ align %LAlign; #IMPLIED+ >++<!--+ Content is %Flow; excluding a, form, form controls, iframe+--> +<!ELEMENT button %button.content;> <!-- push button -->+<!ATTLIST button+ %attrs;+ name CDATA #IMPLIED+ value CDATA #IMPLIED+ type (button|submit|reset) "submit"+ disabled (disabled) #IMPLIED+ tabindex %Number; #IMPLIED+ accesskey %Character; #IMPLIED+ onfocus %Script; #IMPLIED+ onblur %Script; #IMPLIED+ >++<!-- single-line text input control (DEPRECATED) -->+<!ELEMENT isindex EMPTY>+<!ATTLIST isindex+ %coreattrs;+ %i18n;+ prompt %Text; #IMPLIED+ >++<!--======================= Tables =======================================-->++<!-- Derived from IETF HTML table standard, see [RFC1942] -->++<!--+ The border attribute sets the thickness of the frame around the+ table. The default units are screen pixels.++ The frame attribute specifies which parts of the frame around+ the table should be rendered. The values are not the same as+ CALS to avoid a name clash with the valign attribute.+-->+<!ENTITY % TFrame "(void|above|below|hsides|lhs|rhs|vsides|box|border)">++<!--+ The rules attribute defines which rules to draw between cells:++ If rules is absent then assume:+ "none" if border is absent or border="0" otherwise "all"+-->++<!ENTITY % TRules "(none | groups | rows | cols | all)">+ +<!-- horizontal placement of table relative to document -->+<!ENTITY % TAlign "(left|center|right)">++<!-- horizontal alignment attributes for cell contents++ char alignment char, e.g. char=':'+ charoff offset for alignment char+-->+<!ENTITY % cellhalign+ "align (left|center|right|justify|char) #IMPLIED+ char %Character; #IMPLIED+ charoff %Length; #IMPLIED"+ >++<!-- vertical alignment attributes for cell contents -->+<!ENTITY % cellvalign+ "valign (top|middle|bottom|baseline) #IMPLIED"+ >++<!ELEMENT table+ (caption?, (col*|colgroup*), thead?, tfoot?, (tbody+|tr+))>+<!ELEMENT caption %Inline;>+<!ELEMENT thead (tr)+>+<!ELEMENT tfoot (tr)+>+<!ELEMENT tbody (tr)+>+<!ELEMENT colgroup (col)*>+<!ELEMENT col EMPTY>+<!ELEMENT tr (th|td)+>+<!ELEMENT th %Flow;>+<!ELEMENT td %Flow;>++<!ATTLIST table+ %attrs;+ summary %Text; #IMPLIED+ width %Length; #IMPLIED+ border %Pixels; #IMPLIED+ frame %TFrame; #IMPLIED+ rules %TRules; #IMPLIED+ cellspacing %Length; #IMPLIED+ cellpadding %Length; #IMPLIED+ align %TAlign; #IMPLIED+ bgcolor %Color; #IMPLIED+ >++<!ENTITY % CAlign "(top|bottom|left|right)">++<!ATTLIST caption+ %attrs;+ align %CAlign; #IMPLIED+ >++<!--+colgroup groups a set of col elements. It allows you to group+several semantically related columns together.+-->+<!ATTLIST colgroup+ %attrs;+ span %Number; "1"+ width %MultiLength; #IMPLIED+ %cellhalign;+ %cellvalign;+ >++<!--+ col elements define the alignment properties for cells in+ one or more columns.++ The width attribute specifies the width of the columns, e.g.++ width=64 width in screen pixels+ width=0.5* relative width of 0.5++ The span attribute causes the attributes of one+ col element to apply to more than one column.+-->+<!ATTLIST col+ %attrs;+ span %Number; "1"+ width %MultiLength; #IMPLIED+ %cellhalign;+ %cellvalign;+ >++<!--+ Use thead to duplicate headers when breaking table+ across page boundaries, or for static headers when+ tbody sections are rendered in scrolling panel.++ Use tfoot to duplicate footers when breaking table+ across page boundaries, or for static footers when+ tbody sections are rendered in scrolling panel.++ Use multiple tbody sections when rules are needed+ between groups of table rows.+-->+<!ATTLIST thead+ %attrs;+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST tfoot+ %attrs;+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST tbody+ %attrs;+ %cellhalign;+ %cellvalign;+ >++<!ATTLIST tr+ %attrs;+ %cellhalign;+ %cellvalign;+ bgcolor %Color; #IMPLIED+ >++<!-- Scope is simpler than headers attribute for common tables -->+<!ENTITY % Scope "(row|col|rowgroup|colgroup)">++<!-- th is for headers, td for data and for cells acting as both -->++<!ATTLIST th+ %attrs;+ abbr %Text; #IMPLIED+ axis CDATA #IMPLIED+ headers IDREFS #IMPLIED+ scope %Scope; #IMPLIED+ rowspan %Number; "1"+ colspan %Number; "1"+ %cellhalign;+ %cellvalign;+ nowrap (nowrap) #IMPLIED+ bgcolor %Color; #IMPLIED+ width %Pixels; #IMPLIED+ height %Pixels; #IMPLIED+ >++<!ATTLIST td+ %attrs;+ abbr %Text; #IMPLIED+ axis CDATA #IMPLIED+ headers IDREFS #IMPLIED+ scope %Scope; #IMPLIED+ rowspan %Number; "1"+ colspan %Number; "1"+ %cellhalign;+ %cellvalign;+ nowrap (nowrap) #IMPLIED+ bgcolor %Color; #IMPLIED+ width %Pixels; #IMPLIED+ height %Pixels; #IMPLIED+ >+
hxt.cabal view
@@ -1,6 +1,6 @@ -- arch-tag: Haskell XML Toolbox main description file Name: hxt-Version: 9.0.1+Version: 9.1.0 Synopsis: A collection of tools for processing XML with Haskell. Description: The Haskell XML Toolbox bases on the ideas of HaXml and HXML, but introduces a more general approach for processing XML with Haskell.@@ -48,6 +48,7 @@ examples/arrows/HelloWorld/Mini.hs examples/arrows/hparser/emptyElements.html examples/arrows/hparser/example1.xml+ examples/arrows/hparser/example1CRLF.xml examples/arrows/hparser/HXmlParser.hs examples/arrows/hparser/invalid1.xml examples/arrows/hparser/invalid2.rng@@ -63,6 +64,14 @@ examples/arrows/performance/Makefile examples/arrows/pickle/Makefile examples/arrows/pickle/PickleTest.hs+ examples/xhtml/tmp.xml+ examples/xhtml/xhtml1-frameset.dtd+ examples/xhtml/xhtml1-strict.dtd+ examples/xhtml/xhtml1-transitional.dtd+ examples/xhtml/xhtml-lat1.ent+ examples/xhtml/xhtml-special.ent+ examples/xhtml/xhtml-symbol.ent+ examples/xhtml/xhtml.xml library exposed-modules:@@ -71,18 +80,25 @@ Control.Arrow.ArrowIf, Control.Arrow.ArrowList, Control.Arrow.ArrowNF,+ Control.Arrow.ArrowNavigatableTree, Control.Arrow.ArrowState, Control.Arrow.ArrowTree, Control.Arrow.IOListArrow, Control.Arrow.IOStateListArrow, Control.Arrow.ListArrow, Control.Arrow.ListArrows,+ Control.Arrow.NTreeEdit, Control.Arrow.StateListArrow,+ Control.FlatSeq, Data.AssocList, Data.Atom, Data.Function.Selector, Data.Tree.Class, Data.Tree.NTree.TypeDefs,+ Data.Tree.NTree.Edit,+ Data.Tree.NTree.Zipper.TypeDefs,+ Data.Tree.NavigatableTree.Class,+ Data.Tree.NavigatableTree.XPathAxis, Text.XML.HXT.Arrow.Binary, Text.XML.HXT.Arrow.DTDProcessing, Text.XML.HXT.Arrow.DocumentInput,@@ -145,6 +161,7 @@ hs-source-dirs: src ghc-options: -Wall+ ghc-prof-options: -auto-all -caf-all extensions: MultiParamTypeClasses DeriveDataTypeable FunctionalDependencies FlexibleInstances @@ -159,6 +176,6 @@ deepseq >= 1.1 && < 2, bytestring >= 0.9 && < 1, binary >= 0.5 && < 1,- hxt-charproperties >= 9 && < 10,- hxt-unicode >= 9 && < 10,- hxt-regex-xmlschema >= 9 && < 10+ hxt-charproperties >= 9.1 && < 10,+ hxt-unicode >= 9 && < 10,+ hxt-regex-xmlschema >= 9 && < 10
src/Control/Arrow/ArrowExc.hs view
@@ -31,8 +31,8 @@ catchA :: a b c -> a SomeException c -> a b c catchA f h = tryA f- >>>- ( h ||| returnA )+ >>>+ ( h ||| returnA ) -- ------------------------------------------------------------
src/Control/Arrow/ArrowIO.hs view
@@ -33,6 +33,7 @@ -- | construct an arrow from an IO action without any parameter arrIO0 :: IO c -> a b c arrIO0 f = arrIO (const f)+ {-# INLINE arrIO0 #-} -- | construction of a 2 argument arrow from a binary IO action -- |@@ -40,6 +41,7 @@ arrIO2 :: (b1 -> b2 -> IO c) -> a (b1, b2) c arrIO2 f = arrIO (\ ~(x1, x2) -> f x1 x2)+ {-# INLINE arrIO2 #-} -- | construction of a 3 argument arrow from a 3-ary IO action -- |@@ -47,6 +49,7 @@ arrIO3 :: (b1 -> b2 -> b3 -> IO c) -> a (b1, (b2, b3)) c arrIO3 f = arrIO (\ ~(x1, ~(x2, x3)) -> f x1 x2 x3)+ {-# INLINE arrIO3 #-} -- | construction of a 4 argument arrow from a 4-ary IO action -- |@@ -54,6 +57,7 @@ arrIO4 :: (b1 -> b2 -> b3 -> b4 -> IO c) -> a (b1, (b2, (b3, b4))) c arrIO4 f = arrIO (\ ~(x1, ~(x2, ~(x3, x4))) -> f x1 x2 x3 x4)+ {-# INLINE arrIO4 #-} -- | the interface for converting an IO predicate into a list arrow
src/Control/Arrow/ArrowIf.hs view
@@ -47,46 +47,55 @@ ifP :: (b -> Bool) -> a b d -> a b d -> a b d ifP p = ifA (isA p)+ {-# INLINE ifP #-} -- | negation: @ neg f = ifA f none this @ neg :: a b c -> a b b neg f = ifA f none this+ {-# INLINE neg #-} -- | @ f \`when\` g @ : when the predicate g holds, f is applied, else the identity filter this when :: a b b -> a b c -> a b b f `when` g = ifA g f this+ {-# INLINE when #-} -- | shortcut: @ f \`whenP\` p = f \`when\` (isA p) @ whenP :: a b b -> (b -> Bool) -> a b b f `whenP` g = ifP g f this+ {-# INLINE whenP #-} -- | @ f \`whenNot\` g @ : when the predicate g does not hold, f is applied, else the identity filter this whenNot :: a b b -> a b c -> a b b f `whenNot` g = ifA g this f+ {-# INLINE whenNot #-} -- | like 'whenP' whenNotP :: a b b -> (b -> Bool) -> a b b f `whenNotP` g = ifP g this f+ {-# INLINE whenNotP #-} -- | @ g \`guards\` f @ : when the predicate g holds, f is applied, else none guards :: a b c -> a b d -> a b d f `guards` g = ifA f g none+ {-# INLINE guards #-} -- | like 'whenP' guardsP :: (b -> Bool) -> a b d -> a b d f `guardsP` g = ifP f g none+ {-# INLINE guardsP #-} -- | shortcut for @ f `guards` this @ filterA :: a b c -> a b b filterA f = ifA f this none+ {-# INLINE filterA #-} -- | @ f \`containing\` g @ : keep only those results from f for which g holds --@@ -94,6 +103,7 @@ containing :: a b c -> a c d -> a b c f `containing` g = f >>> g `guards` this+ {-# INLINE containing #-} -- | @ f \`notContaining\` g @ : keep only those results from f for which g does not hold --@@ -101,6 +111,7 @@ notContaining :: a b c -> a c d -> a b c f `notContaining` g = f >>> ifA g none this+ {-# INLINE notContaining #-} -- | @ f \`orElse\` g @ : directional choice: if f succeeds, the result of f is the result, else g is applied orElse :: a b c -> a b c -> a b c
src/Control/Arrow/ArrowList.hs view
@@ -39,7 +39,7 @@ -- | The interface for list arrows ----- Only 'mkA', 'arr2A', 'isA' '(>>.)' don't have default implementations+-- Only 'mkA', 'isA' '(>>.)' don't have default implementations class (Arrow a, ArrowPlus a, ArrowZero a, ArrowApply a) => ArrowList a where @@ -49,6 +49,7 @@ arr2 :: (b1 -> b2 -> c) -> a (b1, b2) c arr2 = arr . uncurry+ {-# INLINE arr2 #-} -- | construction of a 3 argument arrow from a 3-ary function -- |@@ -56,6 +57,7 @@ arr3 :: (b1 -> b2 -> b3 -> c) -> a (b1, (b2, b3)) c arr3 f = arr (\ ~(x1, ~(x2, x3)) -> f x1 x2 x3)+ {-# INLINE arr3 #-} -- | construction of a 4 argument arrow from a 4-ary function -- |@@ -63,10 +65,13 @@ arr4 :: (b1 -> b2 -> b3 -> b4 -> c) -> a (b1, (b2, (b3, b4))) c arr4 f = arr (\ ~(x1, ~(x2, ~(x3, x4))) -> f x1 x2 x3 x4)+ {-# INLINE arr4 #-} -- | construction of a 2 argument arrow from a singe argument arrow arr2A :: (b -> a c d) -> a (b, c) d+ arr2A f = first (arr f) >>> app+ {-# INLINE arr2A #-} -- | constructor for a list arrow from a function with a list as result @@ -76,16 +81,19 @@ arr2L :: (b -> c -> [d]) -> a (b, c) d arr2L = arrL . uncurry+ {-# INLINE arr2L #-} -- | constructor for a const arrow: @ constA = arr . const @ constA :: c -> a b c constA = arr . const+ {-# INLINE constA #-} -- | constructor for a const arrow: @ constL = arrL . const @ constL :: [c] -> a b c constL = arrL . const+ {-# INLINE constL #-} -- | builds an arrow from a predicate. -- If the predicate holds, the single list containing the input is returned, else the empty list@@ -104,6 +112,7 @@ (>.) :: a b c -> ([c] -> d ) -> a b d af >. f = af >>. ((:[]) . f)+ {-# INLINE (>.) #-} -- | combinator for converting an arrow into a determinstic version with all results collected in a single element list --@@ -119,6 +128,7 @@ listA :: a b c -> a b [c] listA af = af >>. (:[])+ {-# INLINE listA #-} -- | the inverse of 'listA' --@@ -128,16 +138,19 @@ unlistA :: a [b] b unlistA = arrL id+ {-# INLINE unlistA #-} -- | the identity arrow, alias for returnA this :: a b b this = returnA+ {-# INLINE this #-} -- | the zero arrow, alias for zeroArrow none :: a b c none = zeroArrow+ {-# INLINE none #-} -- | converts an arrow, that may fail, into an arrow that always succeeds --@@ -145,6 +158,7 @@ withDefault :: a b c -> c -> a b c withDefault a d = a >>. \ x -> if null x then [d] else x+ {-# INLINE withDefault #-} -- | makes a list arrow deterministic, the number of results is at most 1 --@@ -327,6 +341,7 @@ perform :: a b c -> a b b perform f = listA f &&& this >>> arr snd+ {-# INLINE perform #-} -- | generalization of arrow combinator '<+>' --@@ -334,6 +349,7 @@ catA :: [a b c] -> a b c catA = foldl (<+>) none+ {-# INLINE catA #-} -- | generalization of arrow combinator '>>>' --@@ -341,5 +357,6 @@ seqA :: [a b b] -> a b b seqA = foldl (>>>) this+ {-# INLINE seqA #-} -- ------------------------------------------------------------
src/Control/Arrow/ArrowNF.hs view
@@ -2,7 +2,7 @@ {- | Module : Control.Arrow.ArrowNF- Copyright : Copyright (C) 2005-8 Uwe Schmidt+ Copyright : Copyright (C) 2011 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)@@ -19,7 +19,10 @@ where import Control.Arrow+import Control.Arrow.ArrowList+ import Control.DeepSeq+import Control.FlatSeq -- | -- complete evaluation of an arrow result using 'Control.DeepSeq'@@ -32,7 +35,27 @@ strictA = arr $ \ x -> deepseq x x class (Arrow a) => ArrowNF a where- rnfA :: (NFData c) => a b c -> a b c- rnfA f = f >>> strictA+ rnfA :: (NFData c) => a b c -> a b c+ rnfA f = f >>^ (\ x -> deepseq x x)+ {-# INLINE rnfA #-}++-- |+-- partial evaluation of an arrow result using 'Control.FlatSeq'+--+-- There are tow arrows with force the partial evaluation. By convention+-- the 2. should be less lazy than the 1.+--+-- These arrows are sometimes useful for preventing space leaks, especially when parsing+-- complex data structures. In many cases the evaluated AST is more space efficient+-- than the unevaluaded with a lot of closures.++class (Arrow a, ArrowList a) => ArrowWNF a where+ rwnfA :: (WNFData c) => a b c -> a b c+ rwnfA f = f >>. \ x -> rlnf rwnf x `seq` x+ {-# INLINE rwnfA #-}++ rwnf2A :: (WNFData c) => a b c -> a b c+ rwnf2A f = f >>. \ x -> rlnf rwnf2 x `seq` x+ {-# INLINE rwnf2A #-} -- ------------------------------------------------------------
@@ -0,0 +1,313 @@+-- ------------------------------------------------------------++{- |+ Module : Control.Arrow.ArrowNavigatableTree+ Copyright : Copyright (C) 2010 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)+ Stability : experimental+ Portability: portable++ List arrows for navigatable trees++ Trees that implement the "Data.Tree.NavigatableTree.Class" interface, can be processed+ with these arrows.+-}++-- ------------------------------------------------------------++module Control.Arrow.ArrowNavigatableTree+where++import Control.Arrow+import Control.Arrow.ArrowList+import Control.Arrow.ArrowIf++import Data.Maybe++import Data.Tree.NavigatableTree.Class ( NavigatableTree+ , NavigatableTreeToTree+ , NavigatableTreeModify+ )+import qualified Data.Tree.NavigatableTree.Class as T+import qualified Data.Tree.NavigatableTree.XPathAxis as T++-- ------------------------------------------------------------++-- | The interface for navigatable tree arrows+--+-- all functions have default implementations++class (ArrowList a) => ArrowNavigatableTree a where++ -- move one step towards the root+ moveUp :: NavigatableTree t => a (t b) (t b)+ moveUp = arrL $ maybeToList . T.mvUp++ -- descend one step to the leftmost child+ moveDown :: NavigatableTree t => a (t b) (t b)+ moveDown = arrL $ maybeToList . T.mvDown++ -- move to the left neighbour+ moveLeft :: NavigatableTree t => a (t b) (t b)+ moveLeft = arrL $ maybeToList . T.mvLeft++ -- move to the right neighbour+ moveRight :: NavigatableTree t => a (t b) (t b)+ moveRight = arrL $ maybeToList . T.mvRight++-- derived functions++parentAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+parentAxis = arrL T.parentAxis++-- | XPath axis: ancestor++ancestorAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+ancestorAxis = arrL T.ancestorAxis++-- | XPath axis: ancestor or self++ancestorOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+ancestorOrSelfAxis = arrL T.ancestorOrSelfAxis++-- | XPath axis: child++childAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+childAxis = arrL T.childAxis++-- | XPath axis: descendant++descendantAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+descendantAxis = arrL T.descendantAxis++-- | XPath axis: descendant or self++descendantOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+descendantOrSelfAxis = arrL T.descendantOrSelfAxis++-- | not an XPath axis but useful: descendant or following++descendantOrFollowingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+descendantOrFollowingAxis = descendantAxis <+> followingAxis++-- | not an official XPath axis but useful: reverse descendant or self, used in preceding axis++revDescendantOrSelfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+revDescendantOrSelfAxis = arrL T.revDescendantOrSelfAxis++-- | XPath axis: following sibling++followingSiblingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+followingSiblingAxis = arrL T.followingSiblingAxis++-- | XPath axis: preceeding sibling++precedingSiblingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+precedingSiblingAxis = arrL T.precedingSiblingAxis++-- | XPath axis: self++selfAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+selfAxis = arrL T.selfAxis++-- | XPath axis: following++followingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+followingAxis = arrL T.followingAxis++-- | XPath axis: preceding++precedingAxis :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+precedingAxis = arrL T.precedingAxis++-- ------------------------------------------------------------++-- | move to the root++moveToRoot :: (Arrow a, NavigatableTree t) => a (t b) (t b)+moveToRoot = arr T.mvToRoot++isAtRoot :: (ArrowList a, NavigatableTree t) => a (t b) (t b)+isAtRoot = isA (null . T.ancestorAxis)++-- ------------------------------------------------------------++-- | Conversion from a tree into a navigatable tree++addNav :: ( ArrowList a+ , NavigatableTreeToTree nt t+ ) =>+ a (t b) (nt b)+addNav = arr T.fromTree+++-- | Conversion from a navigatable tree into an ordinary tree++remNav :: ( ArrowList a+ , NavigatableTreeToTree nt t+ ) =>+ a (nt b) (t b)+remNav = arr T.toTree++-- | apply an operation using navigation to an ordinary tree+--+-- This root and all children may be visited in arbitrary order++withNav :: ( ArrowList a+ , NavigatableTreeToTree nt t+ ) =>+ a (nt b) (nt c) -> a (t b) (t c)+withNav f = addNav >>> f >>> remNav+++-- | apply a simple operation without use of navigation to a navigatable tree+--+-- This enables to apply arbitrary tree operations to navigatable trees++withoutNav :: ( ArrowList a+ , NavigatableTreeToTree nt t+ , NavigatableTreeModify nt t+ ) =>+ a (t b) (t b) -> a (nt b) (nt b)+withoutNav f = ( (remNav >>> f) -- apply the simple arrow to the tree+ &&&+ this -- remember the navigation context+ )+ >>> arr (uncurry T.substThisTree) -- resore the context+ +-- ------------------------------------------------------------++-- | Filter an axis with an ordinary tree predicate+--+-- Example: In a tree of Ints find all nodes in the subtrees (in preorder) that have label 42+--+-- > descendantAxis >>> filterAxis (hasNode (== 42))+--+-- Example: In an XML Tree find the following nodes of a node with attribute id and value 42+--+-- > descendantAxis >>> filterAxis (hasAttrValue "id" (=="42")) >>> followingAxis++filterAxis :: ( ArrowIf a+ , NavigatableTreeToTree nt t+ ) =>+ a (t b) c -> a (nt b) (nt b)++filterAxis p = (remNav >>> p) `guards` this+{-# INLINE filterAxis #-}+++-- | Move to the next tree on a given axis. Deterministic arrow+--+-- Example: Move to the next node in a preorder visit: next child or else next following+--+-- > moveOn descendantOrFollowingAxis++moveOn :: ( ArrowList a+ , NavigatableTree t+ ) =>+ a (t b) (t b) -> a (t b) (t b)+moveOn axis = single $ axis+{-# INLINE moveOn #-}++-- ------------------------------------------------------------++-- | Change the current subtree of a navigatable tree.+--+-- The arrow for computing the changes should be deterministic. If it fails+-- nothing is changed.++changeThisTree :: ( ArrowList a+ , ArrowIf a+ , NavigatableTreeToTree nt t+ , NavigatableTreeModify nt t+ ) =>+ a (t b) (t b) -> a (nt b) (nt b)+changeThisTree cf = withoutNav $ single cf `orElse` this++-- | Substitute the current subtree of a navigatable tree by a given tree++substThisTree :: ( ArrowList a+ , ArrowIf a+ , NavigatableTreeToTree nt t+ , NavigatableTreeModify nt t+ ) =>+ t b -> a (nt b) (nt b)+substThisTree t = changeThisTree (constA t)++-- ------------------------------------------------------------++-- | apply an ordinary arrow to the current subtree of a navigatabe tree and add the result trees in front of the current tree.+--+-- If this arrow is applied to the root, it will fail, because we want a tree as result, not a forest.++addToTheLeft :: ( ArrowList a+ , NavigatableTreeToTree nt t+ , NavigatableTreeModify nt t+ ) =>+ a (t b) (t b) -> a (nt b) (nt b)+addToTheLeft = addToOneSide $+ foldl (\ acc t -> acc >>= T.addTreeLeft t)+{-# INLINE addToTheLeft #-}++-- | apply an ordinary arrow to the current subtree of a navigatabe tree and add the result trees behind the current tree.+--+-- If this arrow is applied to the root, it will fail, because we want a tree as result, not a forest.++addToTheRight :: ( ArrowList a+ , NavigatableTreeToTree nt t+ , NavigatableTreeModify nt t+ ) =>+ a (t b) (t b) -> a (nt b) (nt b)+addToTheRight = addToOneSide $+ foldr (\ t acc -> acc >>= T.addTreeRight t)+{-# INLINE addToTheRight #-}+++-- | addToOneSide does the real work for 'addToTheLeft' and 'addToTheRight'++addToOneSide :: ( ArrowList a+ , NavigatableTreeToTree nt t+ , NavigatableTreeModify nt t+ ) =>+ ( Maybe (nt b) -> [t b] -> Maybe (nt b) ) ->+ a (t b) (t b) ->+ a (nt b) (nt b)+addToOneSide side f = ( ( remNav >>> listA f )+ &&&+ this+ )+ >>>+ arrL ( uncurry (\ ts nt -> side (Just nt) ts)+ >>>+ maybeToList+ )++-- ------------------------------------------------------------++-- | drop the direct left sibling tree of the given navigatable tree+--+-- If this arrow is applied to the root or a leftmost tree, it will fail, because there is nothing to remove++dropFromTheLeft :: ( ArrowList a+ -- , NavigatableTreeToTree nt t+ , NavigatableTreeModify nt t+ ) =>+ a (nt b) (nt b)+dropFromTheLeft = arrL $ T.dropTreeLeft >>> maybeToList+{-# INLINE dropFromTheLeft #-}++-- | drop the direct left sibling tree of the given navigatable tree+--+-- If this arrow is applied to the root or a rightmost tree, it will fail, because there is nothing to remove++dropFromTheRight :: ( ArrowList a+ , NavigatableTreeModify nt t+ ) =>+ a (nt b) (nt b)+dropFromTheRight = arrL $ T.dropTreeRight >>> maybeToList+{-# INLINE dropFromTheRight #-}++-- ------------------------------------------------------------+
src/Control/Arrow/ArrowState.hs view
@@ -50,12 +50,14 @@ getState :: a b s getState = accessState (\ s _x -> s)+ {-# INLINE getState #-} -- | overwrite the old state -- -- definition: @ setState = changeState (\\ s x -> x) @ setState :: a s s setState = changeState (\ _s x -> x) -- changeState (const id)+ {-# INLINE setState #-} -- | change state (and ignore input) and return new state --
src/Control/Arrow/ArrowTree.hs view
@@ -44,41 +44,55 @@ mkLeaf :: Tree t => b -> a c (t b) mkLeaf = constA . T.mkLeaf+ {-# INLINE mkLeaf #-} -- | construct an inner node mkTree :: Tree t => b -> [t b] -> a c (t b) mkTree n = constA . T.mkTree n+ {-# INLINE mkTree #-} -- | select the children of the root of a tree getChildren :: Tree t => a (t b) (t b) getChildren = arrL T.getChildren+ {-# INLINE getChildren #-} - -- | select the attribute of the root of a tree+ -- | select the node info of the root of a tree getNode :: Tree t => a (t b) b getNode = arr T.getNode+ {-# INLINE getNode #-} + -- | select the attribute of the root of a tree++ hasNode :: Tree t => (b -> Bool) -> a (t b) (t b)+ hasNode p = (getNode >>> isA p) `guards` this+ {-# INLINE hasNode #-}+ -- | substitute the children of the root of a tree setChildren :: Tree t => [t b] -> a (t b) (t b) setChildren cs = arr (T.setChildren cs)+ {-# INLINE setChildren #-} -- | substitute the attribute of the root of a tree setNode :: Tree t => b -> a (t b) (t b) setNode n = arr (T.setNode n)+ {-# INLINE setNode #-} -- | edit the children of the root of a tree changeChildren :: Tree t => ([t b] -> [t b]) -> a (t b) (t b) changeChildren csf = arr (T.changeChildren csf)+ {-# INLINE changeChildren #-} -- | edit the attribute of the root of a tree changeNode :: Tree t => (b -> b) -> a (t b) (t b) changeNode nf = arr (T.changeNode nf)+ {-# INLINE changeNode #-} -- compound arrows @@ -122,6 +136,7 @@ (/>) :: Tree t => a b (t c) -> a (t c) d -> a b d f /> g = f >>> getChildren >>> g+ {-# INLINE (/>) #-} -- | -- pronounced \"double slash\", meaning g arbitrarily deep inside f@@ -138,6 +153,7 @@ (//>) :: Tree t => a b (t c) -> a (t c) d -> a b d f //> g = f >>> getChildren >>> deep g+ {-# INLINE (//>) #-} -- |@@ -147,6 +163,7 @@ (</) :: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b) f </ g = f `containing` (getChildren >>> g)+ {-# INLINE (</) #-} -- | recursively searches a whole tree for subtrees, for which a predicate holds.
src/Control/Arrow/IOListArrow.hs view
@@ -30,11 +30,12 @@ import Control.Arrow.ArrowList import Control.Arrow.ArrowNF import Control.Arrow.ArrowTree+import Control.Arrow.ArrowNavigatableTree import Control.DeepSeq-import Control.Exception ( SomeException- , try- )+import Control.Exception ( SomeException+ , try+ ) -- ------------------------------------------------------------ @@ -122,14 +123,15 @@ return [res] instance ArrowExc IOLA where- tryA f = IOLA $ \ x -> do- res <- try' $ runIOLA f x- return $ case res of- Left er -> [Left er]- Right ys -> [Right x' | x' <- ys]- where- try' :: IO a -> IO (Either SomeException a)- try' = try+ tryA f = IOLA $ \ x -> do+ res <- try' $ runIOLA f x+ return $+ case res of+ Left er -> [Left er]+ Right ys -> [Right x' | x' <- ys]+ where+ try' :: IO a -> IO (Either SomeException a)+ try' = try instance ArrowIOIf IOLA where isIOA p = IOLA $ \x -> do@@ -138,9 +140,14 @@ instance ArrowTree IOLA +instance ArrowNavigatableTree IOLA+ instance ArrowNF IOLA where rnfA (IOLA f) = IOLA $ \ x -> do res <- f x deepseq res $ return res+++instance ArrowWNF IOLA -- ------------------------------------------------------------
src/Control/Arrow/IOStateListArrow.hs view
@@ -35,6 +35,7 @@ import Control.Arrow.ArrowList import Control.Arrow.ArrowNF import Control.Arrow.ArrowTree+import Control.Arrow.ArrowNavigatableTree import Control.Arrow.ArrowState import Control.DeepSeq@@ -50,6 +51,7 @@ instance Category (IOSLA s) where id = IOSLA $ \ s x -> return (s, [x]) -- don't defined id = arr id, this gives loops during optimization+ {-# INLINE id #-} IOSLA g . IOSLA f = IOSLA $ \ s x -> do (s1, ys) <- f s x@@ -63,6 +65,7 @@ instance Arrow (IOSLA s) where arr f = IOSLA $ \ s x -> return (s, [f x])+ {-# INLINE arr #-} first (IOSLA f) = IOSLA $ \ s (x1, x2) -> do (s', ys1) <- f s x1@@ -89,6 +92,7 @@ instance ArrowZero (IOSLA s) where zeroArrow = IOSLA $ \ s -> const (return (s, []))+ {-# INLINE zeroArrow #-} instance ArrowPlus (IOSLA s) where@@ -114,19 +118,27 @@ instance ArrowApply (IOSLA s) where app = IOSLA $ \ s (IOSLA f, x) -> f s x+ {-# INLINE app #-} instance ArrowList (IOSLA s) where arrL f = IOSLA $ \ s x -> return (s, (f x))+ {-# INLINE arrL #-} arr2A f = IOSLA $ \ s (x, y) -> runIOSLA (f x) s y+ {-# INLINE arr2A #-} constA c = IOSLA $ \ s -> const (return (s, [c]))+ {-# INLINE constA #-} isA p = IOSLA $ \ s x -> return (s, if p x then [x] else [])+ {-# INLINE isA #-} IOSLA f >>. g = IOSLA $ \ s x -> do (s1, ys) <- f s x return (s1, g ys)+ {-# INLINE (>>.) #-}+ -- just for efficency perform (IOSLA f) = IOSLA $ \ s x -> do (s1, _ys) <- f s x return (s1, [x])+ {-# INLINE perform #-} instance ArrowIf (IOSLA s) where ifA (IOSLA p) ta ea = IOSLA $ \ s x -> do@@ -148,6 +160,7 @@ arrIO cmd = IOSLA $ \ s x -> do res <- cmd x return (s, [res])+ {-# INLINE arrIO #-} instance ArrowExc (IOSLA s) where tryA f = IOSLA $ \ s x -> do@@ -163,10 +176,13 @@ isIOA p = IOSLA $ \ s x -> do res <- p x return (s, if res then [x] else [])+ {-# INLINE isIOA #-} instance ArrowState s (IOSLA s) where changeState cf = IOSLA $ \ s x -> let s' = cf s x in return (seq s' s', [x])+ {-# INLINE changeState #-} accessState af = IOSLA $ \ s x -> return (s, [af s x])+ {-# INLINE accessState #-} -- ------------------------------------------------------------ @@ -200,9 +216,13 @@ instance ArrowTree (IOSLA s) +instance ArrowNavigatableTree (IOSLA s)+ instance (NFData s) => ArrowNF (IOSLA s) where rnfA (IOSLA f) = IOSLA $ \ s x -> do res <- f s x deepseq res $ return res++instance ArrowWNF (IOSLA s) -- ------------------------------------------------------------
src/Control/Arrow/ListArrow.hs view
@@ -30,6 +30,7 @@ import Control.Arrow.ArrowList import Control.Arrow.ArrowNF import Control.Arrow.ArrowTree+import Control.Arrow.ArrowNavigatableTree import Control.DeepSeq @@ -43,10 +44,13 @@ instance Category LA where id = LA $ (:[])+ {-# INLINE id #-} LA g . LA f = LA $ concatMap g . f+ {-# INLINE (.) #-} instance Arrow LA where arr f = LA $ \ x -> [f x]+ {-# INLINE arr #-} first (LA f) = LA $ \ ~(x1, x2) -> [ (y1, x2) | y1 <- f x1 ] -- just for efficiency@@ -57,11 +61,12 @@ instance ArrowZero LA where zeroArrow = LA $ const []+ {-# INLINE zeroArrow #-} instance ArrowPlus LA where LA f <+> LA g = LA $ \ x -> f x ++ g x-+ {-# INLINE (<+>) #-} instance ArrowChoice LA where left (LA f) = LA $ either (map Left . f) ((:[]) . Right)@@ -72,20 +77,25 @@ instance ArrowApply LA where app = LA $ \ (LA f, x) -> f x+ {-# INLINE app #-} instance ArrowList LA where- arrL = LA+ arrL = LA+ {-# INLINE arrL #-} arr2A f = LA $ \ ~(x, y) -> runLA (f x) y+ {-# INLINE arr2A #-} isA p = LA $ \ x -> if p x then [x] else []+ {-# INLINE isA #-} LA f >>. g = LA $ g . f+ {-# INLINE (>>.) #-} withDefault a d = a >>. \ x -> if null x then [d] else x - instance ArrowIf LA where ifA (LA p) t e = LA $ \ x -> runLA ( if null (p x) then e else t ) x+ {-# INLINE ifA #-} (LA f) `orElse` (LA g) = LA $ \ x -> ( let@@ -95,6 +105,7 @@ then g x else res )+ {-# INLINE orElse #-} spanA p = LA $ (:[]) . span (not . null . runLA p) @@ -102,11 +113,15 @@ instance ArrowTree LA +instance ArrowNavigatableTree LA+ instance ArrowNF LA where rnfA (LA f) = LA $ \ x -> let res = f x in deepseq res res +instance ArrowWNF LA+ -- ------------------------------------------------------------ -- | conversion of pure list arrows into other possibly more complex@@ -114,6 +129,7 @@ fromLA :: ArrowList a => LA b c -> a b c fromLA f = arrL (runLA f)+{-# INLINE fromLA #-} -- ------------------------------------------------------------
src/Control/Arrow/ListArrows.hs view
@@ -21,6 +21,7 @@ , module Control.Arrow.ArrowIf , module Control.Arrow.ArrowIO , module Control.Arrow.ArrowList+ , module Control.Arrow.ArrowNavigatableTree , module Control.Arrow.ArrowNF , module Control.Arrow.ArrowState , module Control.Arrow.ArrowTree@@ -29,6 +30,8 @@ , module Control.Arrow.StateListArrow , module Control.Arrow.IOListArrow , module Control.Arrow.IOStateListArrow++ , module Control.Arrow.NTreeEdit -- extra arrows ) where @@ -36,6 +39,7 @@ import Control.Arrow.ArrowExc import Control.Arrow.ArrowList import Control.Arrow.ArrowIf+import Control.Arrow.ArrowNavigatableTree import Control.Arrow.ArrowNF import Control.Arrow.ArrowState import Control.Arrow.ArrowTree@@ -45,5 +49,7 @@ import Control.Arrow.StateListArrow import Control.Arrow.IOListArrow import Control.Arrow.IOStateListArrow++import Control.Arrow.NTreeEdit -- extra arrows -- ------------------------------------------------------------
+ src/Control/Arrow/NTreeEdit.hs view
@@ -0,0 +1,46 @@+-- ------------------------------------------------------------++{- |+ Module : Control.Arrow.NTreeEdit+ Copyright : Copyright (C) 2011 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)+ Stability : experimental+ Portability: portable++ arrows for efficient editing of rose trees++-}++-- ------------------------------------------------------------++module Control.Arrow.NTreeEdit+where++import Control.Arrow+import Control.Arrow.ArrowIf+import Control.Arrow.ArrowList+import Control.Arrow.ListArrow++import Data.Maybe+import Data.Tree.NTree.TypeDefs+import Data.Tree.NTree.Edit++-- ------------------------------------------------------------++-- | Edit parts of a rose tree+--+-- The subtrees to be modified are selected by the first part of the IfThen pairs+-- The modification by the second part++editNTreeA :: [IfThen (LA (NTree b) c) (LA (NTree b) (NTree b))] ->+ LA (NTree b) (NTree b)+editNTreeA cs = arrL $ editNTreeBottomUp ef+ where+ ef = listToMaybe . (runLA . foldr (\ (g :-> h) -> ifA g (listA h)) none $ cs)++fmapNTreeA :: (b -> Maybe b) -> LA (NTree b) (NTree b)+fmapNTreeA f = arr $ mapNTree' f++-- eof ------------------------------------------------------------
src/Control/Arrow/StateListArrow.hs view
@@ -4,7 +4,7 @@ {- | Module : Control.Arrow.StateListArrow- Copyright : Copyright (C) 2005-8 Uwe Schmidt+ Copyright : Copyright (C) 2010 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)@@ -33,6 +33,7 @@ import Control.Arrow.ArrowNF import Control.Arrow.ArrowState import Control.Arrow.ArrowTree+import Control.Arrow.ArrowNavigatableTree import Control.DeepSeq @@ -44,6 +45,7 @@ instance Category (SLA s) where id = SLA $ \ s x -> (s, [x])+ {-# INLINE id #-} SLA g . SLA f = SLA $ \ s x -> let ~(s1, ys) = f s x@@ -60,6 +62,7 @@ instance Arrow (SLA s) where arr f = SLA $ \ s x -> (s, [f x])+ {-# INLINE arr #-} first (SLA f) = SLA $ \ s ~(x1, x2) -> let ~(s', ys1) = f s x1@@ -89,6 +92,7 @@ instance ArrowZero (SLA s) where zeroArrow = SLA $ \ s -> const (s, [])+ {-# INLINE zeroArrow #-} instance ArrowPlus (SLA s) where@@ -118,22 +122,29 @@ instance ArrowApply (SLA s) where app = SLA $ \ s (SLA f, x) -> f s x+ {-# INLINE app #-} instance ArrowList (SLA s) where arrL f = SLA $ \ s x -> (s, (f x))+ {-# INLINE arrL #-} arr2A f = SLA $ \ s ~(x, y) -> runSLA (f x) s y+ {-# INLINE arr2A #-} constA c = SLA $ \ s -> const (s, [c])+ {-# INLINE constA #-} isA p = SLA $ \ s x -> (s, if p x then [x] else [])+ {-# INLINE isA #-} SLA f >>. g = SLA $ \ s x -> let ~(s1, ys) = f s x in (s1, g ys)+ {-# INLINE (>>.) #-} -- just for efficency perform (SLA f) = SLA $ \ s x -> let ~(s1, _ys) = f s x in (s1, [x])+ {-# INLINE perform #-} instance ArrowIf (SLA s) where ifA (SLA p) ta ea = SLA $ \ s x -> let@@ -155,15 +166,21 @@ instance ArrowState s (SLA s) where changeState cf = SLA $ \ s x -> (cf s x, [x])+ {-# INLINE changeState #-} accessState af = SLA $ \ s x -> (s, [af s x])+ {-# INLINE accessState #-} instance ArrowTree (SLA s) +instance ArrowNavigatableTree (SLA s)+ instance (NFData s) => ArrowNF (SLA s) where rnfA (SLA f) = SLA $ \ s x -> let res = f s x in deepseq res res +instance ArrowWNF (SLA s)+ -- ------------------------------------------------------------ -- | conversion of state list arrows into arbitray other@@ -180,6 +197,7 @@ fromSLA :: ArrowList a => s -> SLA s b c -> a b c fromSLA s f = arrL (snd . (runSLA f s))+{-# INLINE fromSLA #-} -- ------------------------------------------------------------
+ src/Control/FlatSeq.hs view
@@ -0,0 +1,90 @@+-- ------------------------------------------------------------++{- |+ Module : Control.FlatSeq+ Copyright : Copyright (C) 2011 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)+ Stability : experimental+ Portability: portable++ Force evaluation like deepseq in Control.DeepSeq,+ but control the depth of evaluation.+ flatseq may evaluate more than seq but less than deepseq++-}++-- ------------------------------------------------------------++module Control.FlatSeq+where++import Data.Word++-- ------------------------------------------------------------++infixr 0 $!!++($!!) :: WNFData a => (a -> b) -> a -> b+f $!! x = rwnf x `seq` f x+{-# INLINE ($!!) #-}++flatseq :: WNFData a => a -> b -> b+flatseq a b = rwnf a `seq` b+{-# INLINE flatseq #-}++rlnf :: (a -> ()) -> [a] -> ()+rlnf _ [] = ()+rlnf r (x:xs) = r x `seq` rlnf r xs+{-# INLINE rlnf #-}++-- | A class of types that can be partially evaluated, but evaluation can be propagated deeper than WHNF++class WNFData a where+ -- | Default for rwnf is reduction to WHNF+ rwnf :: a -> ()+ rwnf a = a `seq` ()+ {-# INLINE rwnf #-}++ -- | Default for rwnf2 is rwnf+ rwnf2 :: a -> ()+ rwnf2 = rwnf+ {-# INLINE rwnf2 #-}++instance WNFData Int +instance WNFData Integer+instance WNFData Float+instance WNFData Double++instance WNFData Char+instance WNFData Bool+instance WNFData ()++instance WNFData Word+instance WNFData Word8+instance WNFData Word16+instance WNFData Word32+instance WNFData Word64++instance WNFData a => WNFData [a] where+ rwnf [] = ()+ rwnf (x:xs) = x `seq` rwnf xs+ {-# INLINE rwnf #-}++instance (WNFData a, WNFData b) => WNFData (a,b) where+ rwnf (x,y) = rwnf x `seq` rwnf y+ {-# INLINE rwnf #-}++instance (WNFData a, WNFData b, WNFData c) => WNFData (a,b,c) where+ rwnf (x,y,z) = rwnf x `seq` rwnf y `seq` rwnf z + {-# INLINE rwnf #-}++instance (WNFData a, WNFData b, WNFData c, WNFData d) => WNFData (a,b,c,d) where+ rwnf (x1,x2,x3,x4) = rwnf x1 `seq` + rwnf x2 `seq` + rwnf x3 `seq` + rwnf x4 + {-# INLINE rwnf #-}++-- ------------------------------------------------------------
src/Data/Function/Selector.hs view
@@ -3,7 +3,7 @@ module Data.Function.Selector where -import Prelude hiding (id,(.))+import Prelude hiding (id,(.)) import Control.Arrow import Control.Category@@ -16,44 +16,44 @@ -- for reading and updating parts of a composite type data Selector s a = S { getS :: s -> a- , setS :: a -> s -> s- }+ , setS :: a -> s -> s+ } -chgS :: Selector s a -> (a -> a) -> (s -> s)-chgS sel f s = setS sel x s- where- x = f . getS sel $ s+chgS :: Selector s a -> (a -> a) -> (s -> s)+chgS sel f s = setS sel x s+ where+ x = f . getS sel $ s -chgM :: (Monad m) => Selector s a -> (a -> m a) -> (s -> m s)-chgM sel f s = do- y <- f x- return $ setS sel y s- where- x = getS sel $ s+chgM :: (Monad m) => Selector s a -> (a -> m a) -> (s -> m s)+chgM sel f s = do+ y <- f x+ return $ setS sel y s+ where+ x = getS sel $ s -- | Alias for constructor S -mkSelector :: (s -> a) -> (a -> s -> s) -> Selector s a-mkSelector = S+mkSelector :: (s -> a) -> (a -> s -> s) -> Selector s a+mkSelector = S -- (.), (>>>), (<<<) instance Category Selector where- id = S { getS = id- , setS = const- }- (S g2 s2) . (S g1 s1) = S { getS = g2 . g1- , setS = \ x s ->- let x1 = g1 s in- let x1' = s2 x x1 in- s1 x1' s- }+ id = S { getS = id+ , setS = const+ }+ (S g2 s2) . (S g1 s1) = S { getS = g2 . g1+ , setS = \ x s ->+ let x1 = g1 s in+ let x1' = s2 x x1 in+ s1 x1' s+ } -idS :: Selector s s-idS = id+idS :: Selector s s+idS = id -(.&&&.) :: Selector s a -> Selector s b -> Selector s (a, b)-(.&&&.) (S g1 s1) (S g2 s2) = S { getS = g1 &&& g2+(.&&&.) :: Selector s a -> Selector s b -> Selector s (a, b)+(.&&&.) (S g1 s1) (S g2 s2) = S { getS = g1 &&& g2 , setS = \ (x, y) -> s2 y . s1 x } @@ -110,30 +110,30 @@ -- | Selectors for pairs and 3-tuples: comp1, comp2, comp3, -- this can be extended to n-tuples -class Comp1 s a | s -> a where comp1 :: Selector s a-class Comp2 s a | s -> a where comp2 :: Selector s a-class Comp3 s a | s -> a where comp3 :: Selector s a+class Comp1 s a | s -> a where comp1 :: Selector s a+class Comp2 s a | s -> a where comp2 :: Selector s a+class Comp3 s a | s -> a where comp3 :: Selector s a -instance Comp1 (a, b) a where comp1 = S { getS = fst- , setS = \ x1 (_, x2) -> (x1, x2)- }+instance Comp1 (a, b) a where comp1 = S { getS = fst+ , setS = \ x1 (_, x2) -> (x1, x2)+ } -instance Comp2 (a, b) b where comp2 = S { getS = snd- , setS = \ x2 (x1, _) -> (x1, x2)- }+instance Comp2 (a, b) b where comp2 = S { getS = snd+ , setS = \ x2 (x1, _) -> (x1, x2)+ } -instance Comp1 (a, b, c) a where comp1 = S { getS = \ (x1, _, _) -> x1- , setS = \ x1 (_, x2, x3) -> (x1, x2, x3)- }+instance Comp1 (a, b, c) a where comp1 = S { getS = \ (x1, _, _) -> x1+ , setS = \ x1 (_, x2, x3) -> (x1, x2, x3)+ } -instance Comp2 (a, b, c) b where comp2 = S { getS = \ (_, x2, _) -> x2- , setS = \ x2 (x1, _, x3) -> (x1, x2, x3)- }+instance Comp2 (a, b, c) b where comp2 = S { getS = \ (_, x2, _) -> x2+ , setS = \ x2 (x1, _, x3) -> (x1, x2, x3)+ } -instance Comp3 (a, b, c) c where comp3 = S { getS = \ (_, _, x3) -> x3- , setS = \ x3 (x1, x2, _) -> (x1, x2, x3)- }+instance Comp3 (a, b, c) c where comp3 = S { getS = \ (_, _, x3) -> x3+ , setS = \ x3 (x1, x2, _) -> (x1, x2, x3)+ } -- ------------------------------------------------------------
src/Data/Tree/Class.hs view
@@ -30,16 +30,19 @@ mkLeaf :: a -> t a mkLeaf n = mkTree n []+ {-# INLINE mkLeaf #-} -- | leaf test: list of children empty? isLeaf :: t a -> Bool isLeaf = null . getChildren+ {-# INLINE isLeaf #-} -- | innner node test: @ not . isLeaf @ isInner :: t a -> Bool isInner = not . isLeaf+ {-# INLINE isInner #-} -- | select node attribute @@ -61,11 +64,13 @@ setNode :: a -> t a -> t a setNode n = changeNode (const n)+ {-# INLINE setNode #-} -- | substitute children: @ setChildren cl = changeChildren (const cl) @ setChildren :: [t a] -> t a -> t a setChildren cl = changeChildren (const cl)+ {-# INLINE setChildren #-} -- | fold for trees @@ -74,19 +79,61 @@ -- | all nodes of a tree nodesTree :: t a -> [a]+ nodesTree = foldTree (\ n rs -> n : concat rs)+ {-# INLINE nodesTree #-} -- | depth of a tree depthTree :: t a -> Int+ depthTree = foldTree (\ _ rs -> 1 + maximum (0 : rs)) -- | number of nodes in a tree cardTree :: t a -> Int+ cardTree = foldTree (\ _ rs -> 1 + sum rs) -- | format tree for readable trace output -- -- a /graphical/ representation of the tree in text format formatTree :: (a -> String) -> t a -> String+ formatTree nf n = formatNTree' nf (showString "---") (showString " ") n "" -- ------------------------------------------------------------+-- |+-- convert a tree into a pseudo graphical string representation++formatNTree' :: Tree t => (a -> String) -> (String -> String) -> (String -> String) -> t a -> String -> String++formatNTree' node2String pf1 pf2 tree+ = formatNode+ . formatChildren pf2 l+ where+ n = getNode tree+ l = getChildren tree+ formatNode = pf1 . foldr (.) id (map trNL (node2String n)) . showNL+ trNL '\n' = showNL . pf2+ trNL c = showChar c+ showNL = showChar '\n'+ formatChildren _ []+ = id+ formatChildren pf (t:ts)+ | null ts+ = pfl'+ . formatTr pf2' t+ | otherwise+ = pfl'+ . formatTr pf1' t+ . formatChildren pf ts+ where+ pf0' = pf . showString indent1+ pf1' = pf . showString indent2+ pf2' = pf . showString indent3+ pfl' = pf . showString indent4+ formatTr = formatNTree' node2String pf0'+ indent1 = "+---"+ indent2 = "| "+ indent3 = " "+ indent4 = "|\n"++-- eof ------------------------------------------------------------
+ src/Data/Tree/NTree/Edit.hs view
@@ -0,0 +1,98 @@+-- ------------------------------------------------------------++{- |+ Module : + Copyright : Copyright (C) 2011 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)+ Stability : experimental+ Portability: portable++ Space and time efficient editing of rose trees+-}++-- ------------------------------------------------------------++module Data.Tree.NTree.Edit+where++import Data.Maybe++import Data.Tree.NTree.TypeDefs++-- import Debug.Trace+++-- | editNTreeBottomUp is a space optimized tree edit function+--+-- The nodes in a tree are visited bottom up. An edit function is applied to+-- all nodes. A Nothing result of the editing function indicates no changes.+-- This is used to share the input tree within the resulting tree.+--+-- The following law holds:+--+-- > editNTreeBottomUp (const Nothing) t == [t]+--+-- In this case the resulting tree does not only represent the same value+-- but it is the same machine value (relative to some evaluations of closures+-- during the tree walk+--+-- With a simple fold like editing function the whole tree would be reconstructed+-- in memory++editNTreeBottomUp :: (NTree a -> Maybe [NTree a]) -> NTree a -> [NTree a]+editNTreeBottomUp f t0 = maybe [t0] id . editNTreeBU $ t0+ where++ -- editNTreeBU :: NTree a -> Maybe [NTree a]+ editNTreeBU t@(NTree n cs)+ | isNothing r'+ &&+ isJust cl' = Just [t'] -- children have been change but not the node itself+ | otherwise = r' -- nothing has been changes or node has been changed + where+ cl' = editNTreesBU cs -- the edited children+ t' = case cl' of -- the node to be processed with f+ Nothing -> t -- possibly with the new children (bottom up)+ Just cs' -> NTree n cs'+ r' = f t' -- the edited result++ -- editNTreesBU :: [NTree a] -> Maybe [NTree a]+ editNTreesBU [] = Nothing+ editNTreesBU (t : ts) = mergeRes+ (editNTreeBU t )+ (editNTreesBU ts)+ where+ mergeRes r' = case r' of+ Nothing -> maybe Nothing (Just . (t :))+ Just ts' -> Just . (ts' ++) . fromMaybe ts+++-- | A space optimized map for NTrees+--+-- Subtrees, that are not changed are reused in the resulting tree+-- See also: editNTreeBottomUp++mapNTree' :: (a -> Maybe a) -> NTree a -> NTree a+mapNTree' f t0 = maybe t0 id . map' $ t0+ where++ -- map' :: NTree a -> Maybe (NTree a)+ map' (NTree n cs) = mergeRes (f n) (maps' cs)+ where+ mergeRes Nothing Nothing = Nothing+ mergeRes Nothing (Just cs') = Just (NTree n cs')+ mergeRes (Just n') cl = Just (NTree n' (fromMaybe cs cl))++ -- maps' :: [NTree a] -> Maybe [NTree a]+ maps' [] = Nothing+ maps' (t : ts) = mergeRes+ (map' t )+ (maps' ts)+ where+ mergeRes r' = case r' of+ Nothing -> maybe Nothing (Just . (t :))+ Just t' -> Just . (t' :) . fromMaybe ts++-- eof ------------------------------------------------------------
src/Data/Tree/NTree/TypeDefs.hs view
@@ -4,11 +4,11 @@ {- | Module : Data.Tree.NTree.TypeDefs- Copyright : Copyright (C) 2005-2008 Uwe Schmidt+ Copyright : Copyright (C) 2005-2010 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)- Stability : experimental+ Stability : stable Portability: portable Interface definition for trees@@ -20,17 +20,17 @@ -- ------------------------------------------------------------ module Data.Tree.NTree.TypeDefs- ( module Data.Tree.Class- , module Data.Tree.NTree.TypeDefs- ) where import Control.DeepSeq+import Control.FlatSeq import Data.Binary import Data.Tree.Class import Data.Typeable +-- ------------------------------------------------------------+ -- | n-ary ordered tree (rose trees) -- -- a tree consists of a node and a possible empty list of children.@@ -51,7 +51,18 @@ instance (NFData a) => NFData (NTree a) where rnf (NTree n cl) = rnf n `seq` rnf cl+ {-# INLINE rnf #-} +instance (WNFData a) => WNFData (NTree a) where+ rwnf (NTree n cl) = rwnf n `seq` rwnf cl+ {-# INLINE rwnf #-}++ -- | Evaluate a tree 2 steps deep, the top node and all children are evaluated with rwnf+ rwnf2 (NTree n cl) = rwnf n `seq` rlnf rwnf cl+ {-# INLINE rwnf2 #-}++-- ------------------------------------------------------------+ instance (Binary a) => Binary (NTree a) where put (NTree n cs) = put n >> put cs get = do@@ -59,63 +70,33 @@ cs <- get return (NTree n cs) +-- ------------------------------------------------------------+ -- | NTree implements class Functor instance Functor NTree where fmap f ~(NTree n cl) = NTree (f n) (map (fmap f) cl)+ {-# INLINE fmap #-} +-- ------------------------------------------------------------ -- | Implementation of "Data.Tree.Class" interface for rose trees instance Tree NTree where mkTree n cl = NTree n cl+ {-# INLINE mkTree #-} getNode ~(NTree n _ ) = n+ {-# INLINE getNode #-} getChildren ~(NTree _ cl) = cl+ {-# INLINE getChildren #-} changeNode cf ~(NTree n cl) = NTree (cf n) cl+ {-# INLINE changeNode #-} changeChildren cf ~(NTree n cl) = NTree n (cf cl)+ {-# INLINE changeChildren #-} foldTree f ~(NTree n cs) = f n (map (foldTree f) cs)-- nodesTree = foldTree (\ n rs -> n : concat rs)- depthTree = foldTree (\ _ rs -> 1 + maximum (0 : rs))- cardTree = foldTree (\ _ rs -> 1 + sum rs)- formatTree nf n = formatNTreeF nf (showString "---") (showString " ") n ""---- --------------------------------------------------------------- |--- convert a tree into a pseudo graphical string reprsentation--formatNTreeF :: (node -> String) -> (String -> String) -> (String -> String) -> NTree node -> String -> String--formatNTreeF node2String pf1 pf2 (NTree n l)- = formatNode- . formatChildren pf2 l- where- formatNode = pf1 . foldr (.) id (map trNL (node2String n)) . showNL- trNL '\n' = showNL . pf2- trNL c = showChar c- showNL = showChar '\n'- formatChildren _ []- = id- formatChildren pf (t:ts)- | null ts- = pfl'- . formatTr pf2' t- | otherwise- = pfl'- . formatTr pf1' t- . formatChildren pf ts- where- pf0' = pf . showString indent1- pf1' = pf . showString indent2- pf2' = pf . showString indent3- pfl' = pf . showString indent4- formatTr = formatNTreeF node2String pf0'- indent1 = "+---"- indent2 = "| "- indent3 = " "- indent4 = "|\n"+ {-# INLINE foldTree #-} -- eof ------------------------------------------------------------
+ src/Data/Tree/NTree/Zipper/TypeDefs.hs view
@@ -0,0 +1,240 @@+{-# OPTIONS -fno-warn-orphans #-}++-- ------------------------------------------------------------++{- |+ Module : Data.Tree.NTree.Zipper.TypeDefs+ Copyright : Copyright (C) 2010 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)+ Stability : stable+ Portability: portable++ Implementation of navigateble trees for+ rose trees. The implementation is done with zippers.+ A description and introductory tutorial about zippers+ can be found in <http://learnyouahaskell.com/zippers>+-}++-- ------------------------------------------------------------++module Data.Tree.NTree.Zipper.TypeDefs+{-+ ( NTZipper+ , NTree+ , toNTZipper+ , fromNTZipper+ )+-}+where++import Data.Tree.Class++import Data.Tree.NavigatableTree.Class+import Data.Tree.NavigatableTree.XPathAxis ( childAxis )++import Data.Tree.NTree.TypeDefs++-- ------------------------------------------------------------++-- | Zipper for rose trees+--+-- A zipper consist of the current tree and the branches on the way back to the root++data NTZipper a = NTZ+ { ntree :: (NTree a)+ , context :: (NTBreadCrumbs a)+ }+ deriving (Show)++-- | The list of unzipped nodes from a current tree back to the root++type NTBreadCrumbs a = [NTCrumb a]++-- | One unzipped step consists of the left siblings, the node info and the right siblings++data NTCrumb a = NTC+ (NTrees a) -- left side+ a -- node+ (NTrees a) -- right side+ deriving (Show)++-- ------------------------------------------------------------++-- | Conversion of a rose tree into a navigatable rose tree++toNTZipper :: NTree a -> NTZipper a+toNTZipper t = NTZ t []++{-# INLINE toNTZipper #-}++-- | Conversion of a navigatable rose tree into an ordinary rose tree.+--+-- The context, the parts for moving up to the root are just removed from the tree.+-- So when transforming a navigatable tree by moving around and by changing some nodes,+-- one has to navigate back+-- to the root, else that parts are removed from the result++fromNTZipper :: NTZipper a -> NTree a+fromNTZipper = ntree++{-# INLINE fromNTZipper #-}++-- ------------------------------------------------------------++up :: NTZipper a -> Maybe (NTZipper a)+up z+ | isTop z = Nothing+ | otherwise = Just $ NTZ (up1 t bc) bcs+ where+ NTZ t (bc : bcs) = z++{-# INLINE up #-}++down :: NTZipper a -> Maybe (NTZipper a)+down (NTZ (NTree n cs) bcs)+ | null cs = Nothing+ | otherwise = Just $ NTZ (head cs) (NTC [] n (tail cs) : bcs)++{-# INLINE down #-}++toTheRight :: NTZipper a -> Maybe (NTZipper a)+toTheRight z+ | isTop z+ ||+ null rs = Nothing+ | otherwise = Just $ NTZ t' (bc' : bcs)+ where+ (NTZ t (bc : bcs)) = z+ (NTC ls n rs) = bc+ t' = head rs+ bc' = NTC (t : ls) n (tail rs)++{-# INLINE toTheRight #-}++toTheLeft :: NTZipper a -> Maybe (NTZipper a)+toTheLeft z+ | isTop z+ ||+ null ls = Nothing+ | otherwise = Just $ NTZ t' (bc' : bcs)+ where+ (NTZ t (bc : bcs)) = z+ (NTC ls n rs) = bc+ t' = head ls+ bc' = NTC (tail ls) n (t : rs)++{-# INLINE toTheLeft #-}++addToTheLeft :: NTree a -> NTZipper a -> Maybe (NTZipper a)+addToTheLeft t z+ | isTop z = Nothing+ | otherwise = Just $ NTZ t' (NTC (t:ls) n rs : bcs)+ where+ (NTZ t' (bc : bcs)) = z+ (NTC ls n rs) = bc+{-# INLINE addToTheLeft #-}++addToTheRight :: NTree a -> NTZipper a -> Maybe (NTZipper a)+addToTheRight t z+ | isTop z = Nothing+ | otherwise = Just $ NTZ t' (NTC ls n (t:rs) : bcs)+ where+ (NTZ t' (bc : bcs)) = z+ (NTC ls n rs) = bc+{-# INLINE addToTheRight #-}++dropFromTheLeft :: NTZipper a -> Maybe (NTZipper a)+dropFromTheLeft z+ | isTop z = Nothing+ | null ls = Nothing+ | otherwise = Just $ NTZ t' (NTC (tail ls) n rs : bcs)+ where+ (NTZ t' (bc : bcs)) = z+ (NTC ls n rs) = bc+{-# INLINE dropFromTheLeft #-}++dropFromTheRight :: NTZipper a -> Maybe (NTZipper a)+dropFromTheRight z+ | isTop z = Nothing+ | null rs = Nothing+ | otherwise = Just $ NTZ t' (NTC ls n (tail rs) : bcs)+ where+ (NTZ t' (bc : bcs)) = z+ (NTC ls n rs) = bc+{-# INLINE dropFromTheRight #-}++-- ------------------------------------------------------------++isTop :: NTZipper a -> Bool+isTop = null . context++{-# INLINE isTop #-}++up1 :: NTree a -> NTCrumb a -> NTree a+up1 t (NTC ls n rs) = NTree n (foldl (flip (:)) (t : rs) ls)++{-# INLINE up1 #-}++-- ------------------------------------------------------------++instance Functor NTZipper where+ fmap f (NTZ t xs) = NTZ (fmap f t) (map (fmap f) xs)+ {-# INLINE fmap #-}++instance Functor NTCrumb where+ fmap f (NTC xs x ys)= NTC (map (fmap f) xs) (f x) (map (fmap f) ys)+ {-# INLINE fmap #-}++instance Tree NTZipper where+ mkTree n cl = toNTZipper . mkTree n $ map ntree cl++ getNode = getNode . ntree+ {-# INLINE getNode #-}+ getChildren = childAxis+ {-# INLINE getChildren #-}++ changeNode cf t = t { ntree = changeNode cf (ntree t) }+ changeChildren cf t = t { ntree = setChildren (map ntree . cf . childAxis $ t) (ntree t) }++ foldTree f = foldTree f . ntree+ {-# INLINE foldTree #-}++instance NavigatableTree NTZipper where+ mvDown = down+ {-# INLINE mvDown #-}++ mvUp = up+ {-# INLINE mvUp #-}++ mvLeft = toTheLeft+ {-# INLINE mvLeft #-}++ mvRight = toTheRight+ {-# INLINE mvRight #-}++instance NavigatableTreeToTree NTZipper NTree where+ fromTree = toNTZipper+ {-# INLINE fromTree #-}++ toTree = fromNTZipper+ {-# INLINE toTree #-}++instance NavigatableTreeModify NTZipper NTree where+ addTreeLeft = addToTheLeft+ {-# INLINE addTreeLeft #-}++ addTreeRight = addToTheRight+ {-# INLINE addTreeRight #-}++ dropTreeLeft = dropFromTheLeft+ {-# INLINE dropTreeLeft #-}++ dropTreeRight = dropFromTheRight+ {-# INLINE dropTreeRight #-}++ substThisTree t nt = nt { ntree = t }+ {-# INLINE substThisTree #-}++-- ------------------------------------------------------------
@@ -0,0 +1,77 @@+-- ------------------------------------------------------------++{- |+ Module : Data.Tree.NavigatableTree.Class+ Copyright : Copyright (C) 2010 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)+ Stability : experimental+ Portability: portable++ Interface definition for navigatable trees.+ Navigatable trees need to have operations to move up, down, left and right.+ With these elementary operations, most of the XPath axises can be defined.+-}++-- ------------------------------------------------------------++module Data.Tree.NavigatableTree.Class+where++-- ------------------------------------------------------------++-- | The interface for navigatable trees++class NavigatableTree t where+ -- | move one step towards the root+ mvUp :: t a -> Maybe (t a)++ -- | descend one step to the leftmost child+ mvDown :: t a -> Maybe (t a)++ -- | move to the left neighbour+ mvLeft :: t a -> Maybe (t a)++ -- | move to the right neighbour+ mvRight :: t a -> Maybe (t a)++-- ------------------------------------------------------------++-- | Conversion between trees and navigatable trees,+--+-- There is only a single navigatable tree implementation for a given tree allowed+-- (see the functional dependencies)++class NavigatableTreeToTree nt t | t -> nt, nt -> t where+ -- | construct a navigatable tree+ fromTree :: t a -> nt a++ -- | remove navigation+ toTree :: nt a -> t a++-- ------------------------------------------------------------++-- | Edit operation on navigatable trees+--+-- There is only a single navigatable tree implementation for a given tree allowed+-- (see the functional dependencies)++class NavigatableTreeModify nt t | t -> nt, nt -> t where++ -- | add an ordinary tree in front of the given navigatable tree+ addTreeLeft :: t a -> nt a -> Maybe (nt a)++ -- | add an ordinary tree behind of the given navigatable tree+ addTreeRight :: t a -> nt a -> Maybe (nt a)++ -- | drop the direct left sibling tree of the given navigatable tree+ dropTreeLeft :: nt a -> Maybe (nt a)++ -- | drop the direct right sibling tree of the given navigatable tree+ dropTreeRight :: nt a -> Maybe (nt a)++ -- | change the tree but remain the navigation+ substThisTree :: t a -> nt a -> nt a++-- ------------------------------------------------------------
@@ -0,0 +1,128 @@+-- ------------------------------------------------------------++{- |+ Module : Data.Tree.NavigatableTree.XPathAxis+ Copyright : Copyright (C) 2010 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)+ Stability : experimental+ Portability: portable++ Navigatable trees need to have operations to move up, down, left and right.+ With these elementary operations, the XPath axises can be defined.+-}++-- ------------------------------------------------------------++module Data.Tree.NavigatableTree.XPathAxis+where++import Data.Maybe ( maybeToList )+import Data.Tree.NavigatableTree.Class++import Control.Arrow ( (>>>) )+import Control.Monad ( (>=>) )++-- ------------------------------------------------------------+--+-- mothers little helpers++-- | collect all trees by moving into one direction, starting tree is included++maybeStar :: (a -> Maybe a) -> (a -> [a])+maybeStar f x = x : maybe [] (maybeStar f) (f x)++-- | collect all trees by moving into one direction, starting tree is not included++maybePlus :: (a -> Maybe a) -> (a -> [a])+maybePlus f x = maybe [] (maybeStar f) (f x)++{-# INLINE maybePlus #-}++-- ------------------------------------------------------------+-- XPath axis++-- | XPath axis: parent++parentAxis :: NavigatableTree t => t a -> [t a]+parentAxis = maybeToList . mvUp+{-# INLINE parentAxis #-}++-- | XPath axis: ancestor++ancestorAxis :: NavigatableTree t => t a -> [t a]+ancestorAxis = maybePlus mvUp+{-# INLINE ancestorAxis #-}++-- | XPath axis: ancestor or self++ancestorOrSelfAxis :: NavigatableTree t => t a -> [t a]+ancestorOrSelfAxis = maybeStar mvUp+{-# INLINE ancestorOrSelfAxis #-}++-- | XPath axis: child++childAxis :: NavigatableTree t => t a -> [t a]+childAxis = (mvDown >>> maybeToList) >=> maybeStar mvRight+{-# INLINE childAxis #-}++-- | XPath axis: descendant++descendantAxis :: NavigatableTree t => t a -> [t a]+descendantAxis = descendantOrSelfAxis >>> tail+{-# INLINE descendantAxis #-}++-- | XPath axis: descendant or self++descendantOrSelfAxis :: NavigatableTree t => t a -> [t a]+descendantOrSelfAxis = visit []+ where+ visit k t = t : maybe k (visit' k) (mvDown t)+ visit' k t = visit (maybe k (visit' k) (mvRight t)) t++-- | not an official XPath axis but useful: reverse descendant or self, used in preceding axis++revDescendantOrSelfAxis :: NavigatableTree t => t a -> [t a]+revDescendantOrSelfAxis t+ = t : concatMap revDescendantOrSelfAxis (reverse $ childAxis t)++-- | XPath axis: following sibling++followingSiblingAxis :: NavigatableTree t => t a -> [t a]+followingSiblingAxis = maybePlus mvRight+{-# INLINE followingSiblingAxis #-}++-- | XPath axis: preceeding sibling++precedingSiblingAxis :: NavigatableTree t => t a -> [t a]+precedingSiblingAxis = maybePlus mvLeft+{-# INLINE precedingSiblingAxis #-}++-- | XPath axis: self++selfAxis :: NavigatableTree t => t a -> [t a]+selfAxis = (:[])+{-# INLINE selfAxis #-}++-- | XPath axis: following++followingAxis :: NavigatableTree t => t a -> [t a]+followingAxis = ancestorOrSelfAxis >=> followingSiblingAxis >=> descendantOrSelfAxis++-- | XPath axis: preceding++precedingAxis :: NavigatableTree t => t a -> [t a]+precedingAxis = ancestorOrSelfAxis >=> precedingSiblingAxis >=> revDescendantOrSelfAxis++-- | move to the root++mvToRoot :: NavigatableTree t => t a -> t a+mvToRoot = ancestorOrSelfAxis >>> last+{-# INLINE mvToRoot #-}++isAtRoot :: NavigatableTree t => t a -> Bool+isAtRoot = null . ancestorAxis+{-# INLINE isAtRoot #-}++-- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/DTDProcessing.hs view
@@ -128,25 +128,14 @@ >>> setSysAttrString a_standalone "" >>>- ( addDocType- `whenNot`- ( getChildren >>> isDTDDoctype )- )- >>> processChildren substParamEntities >>> setDocumentStatusFromSystemState "in XML DTD processing"+ >>>+ traceMsg 1 ("processDTD: parameter entities processed") ) `when` documentStatusOk- where- addDocType- = replaceChildren ( (getChildren >>> isXmlPi)- <+>- mkDTDDoctype [] none- <+>- (getChildren >>> neg isXmlPi)- ) substParamEntities :: IOStateArrow s XmlTree XmlTree substParamEntities@@ -214,8 +203,10 @@ >>> parseXmlDTDdecl >>>- substRefsInEntityValue+ substPeRefsInEntityValue >>>+ traceDTD "ENTITY declaration after PE substitution"+ >>> processEntityDecl >>> traceDTD "ENTITY declaration after DTD declaration parsing"@@ -259,17 +250,24 @@ processExternalEntity -- only the current base uri must be remembered = setDTDAttrValue a_url $< ( getDTDAttrValue k_system >>> mkAbsURI ) - processInternalEntity :: DTDStateArrow XmlTree XmlTree -- just combine all parts of the entity value- processInternalEntity -- into one string- = replaceChildren (xshow getChildren >>> mkText)+ processInternalEntity :: DTDStateArrow XmlTree XmlTree+ processInternalEntity+ = this -- everything is already done in substPeRefsInEntityValue processParamEntity :: String -> DTDStateArrow XmlTree XmlTree processParamEntity peName = ifA (constA peName >>> getPeValue)- ( issueWarn ("parameter entity " ++ show peName ++ " already defined") )+ ( issueWarn ("parameter entity " ++ show peName ++ " already defined")+ >>>+ none -- second def must be ignored+ ) ( ( ifA ( hasDTDAttr k_system ) -- is external param entity ?- ( runInLocalURIContext getExternalParamEntityValue )- ( replaceChildren (xshow getChildren >>> mkText) ) -- just combine all parts of the entity value into one string+ ( setDTDAttrValue a_url $< -- store absolut url+ ( getDTDAttrValue k_system >>> mkAbsURI )+ )+ -- this is too early, pe may be not referenced and file may be not there+ -- ( runInLocalURIContext getExternalParamEntityValue )+ ( this ) -- everything is already done in substPeRefsInEntityValue ) >>> addPe peName@@ -278,32 +276,50 @@ substPERef :: String -> DTDStateArrow XmlTree XmlTree substPERef pn = choiceA- [ isInternalRef :-> issueErr ("a parameter entity reference of " ++ show pn ++ " occurs in the internal subset of the DTD")- , isUndefinedRef :-> issueErr ("parameter entity " ++ show pn ++ " not found (forward reference?)")+ [ isUndefinedRef :-> issueErr ("parameter entity " ++ show pn ++ " not found (forward reference?)")+ , isInternalRef :-> issueErr ("a parameter entity reference of " ++ show pn ++ " occurs in the internal subset of the DTD")+ , isUnreadExternalRef :-> ( perform+ ( peVal -- load the external pe value+ >>> -- update the pe env+ getExternalParamEntityValue pn -- and try again+ >>>+ addPe pn+ )+ >>>+ substPERef pn+ ) , this :-> substPE ] `when` isDTDPERef where- isInternalRef = isA (const (loc == Internal))- peVal = constA pn >>> getPeValue+ peVal = constA pn >>> getPeValue++ isUnreadExternalRef = ( peVal+ >>>+ getDTDAttrValue a_url+ >>>+ isA (not . null)+ )+ `guards`+ this++ isInternalRef = none -- isA (const (loc == Internal)) -- TODO: check this restriction, it seams rather meaningless isUndefinedRef = neg peVal- substPE- = replaceChildren (peVal >>> getChildren) -- store PE value in children component- >>>- ( ( setBase $< (peVal >>> getDTDAttrValue a_url) ) -- store base uri for external refs- `orElse`- this- )- where- setBase uri = setDTDAttrValue a_url uri+ substPE = replaceChildren (peVal >>> getChildren) -- store PE value in children component - substRefsInEntityValue :: DTDStateArrow XmlTree XmlTree- substRefsInEntityValue- = ( ( processChildren ( transfCharRef- >>>- substPeRefsInValue []- )+ substPeRefsInEntityValue :: DTDStateArrow XmlTree XmlTree+ substPeRefsInEntityValue+ = ( ( replaceChildren+ ( xshow ( getChildren -- substitute char entites+ >>> -- and parameter references+ transfCharRef -- combine all pieces to a single string+ >>> -- as the new entity value+ substPeRefsInValue []+ )+ >>>+ mkText+ ) ) `whenNot` hasDTDAttr k_system -- only apply for internal entities@@ -365,8 +381,8 @@ >>> parseXmlDTDEntityValue >>>- transfCharRef- >>>+ -- transfCharRef this must be done somewhere else+ -- >>> substPeRefsInValue (pn : recl) substPeRefsInCondSect :: RecList -> DTDStateArrow XmlTree XmlTree@@ -473,36 +489,30 @@ >>> getChildren -getExternalParamEntityValue :: DTDStateArrow XmlTree XmlTree-getExternalParamEntityValue+getExternalParamEntityValue :: String -> DTDStateArrow XmlTree XmlTree+getExternalParamEntityValue pn = isDTDPEntity `guards`- ( setEntityValue $<<< ( getDTDAttrl- &&&- listA ( getEntityValue $< getDTDAttrl )- &&&- getBaseURI- )- )+ ( setEntityValue $< ( listA ( getEntityValue $< getDTDAttrValue a_url ) ) ) where- getEntityValue :: Attributes -> DTDStateArrow XmlTree XmlTree- getEntityValue al- = root [sattr a_source (lookup1 k_system al){- <+> catA (map (uncurry sattr) al)-}] []+ getEntityValue :: String -> DTDStateArrow XmlTree XmlTree+ getEntityValue url+ = root [sattr a_source url] [] >>>- getXmlEntityContents+ runInLocalURIContext getXmlEntityContents >>>- traceMsg 2 "getExternalParamEntityValue: contents read"+ traceMsg 2 ("getExternalParamEntityValue: contents read for " ++ show pn ++ " from " ++ show url) >>> getChildren - setEntityValue :: Attributes -> XmlTrees -> String -> DTDStateArrow XmlTree XmlTree- setEntityValue al res base+ setEntityValue :: XmlTrees -> DTDStateArrow XmlTree XmlTree+ setEntityValue res | null res- = issueErr ("illegal external parameter entity value for entity %" ++ peName ++";")+ = issueErr ("illegal external parameter entity value for entity %" ++ pn ++";") | otherwise- = mkDTDElem PENTITY ((a_url, base) : al) (arrL $ const res)- where- peName = lookup1 a_name al+ = replaceChildren (constL res)+ >>>+ setDTDAttrValue a_url "" -- mark entity as read traceDTD :: String -> DTDStateArrow XmlTree XmlTree traceDTD msg = traceMsg 3 msg >>> traceTree
src/Text/XML/HXT/Arrow/DocumentInput.hs view
@@ -129,7 +129,7 @@ >>> ( arr (uncurry addInputError) -- io error occured |||- arr addTxtContent -- content read+ arr addTxtContent -- content read ) ) @@ -159,9 +159,9 @@ uriToMime mtt = arr $ ( \ uri -> extensionToMimeType (drop 1 . takeExtension $ uri) mtt ) -addTxtContent :: String -> IOStateArrow s XmlTree XmlTree-addTxtContent c- = replaceChildren (txt c)+addTxtContent :: Blob -> IOStateArrow s XmlTree XmlTree+addTxtContent bc+ = replaceChildren (blb bc) >>> addAttr transferMessage "OK" >>>@@ -260,11 +260,23 @@ getXmlEntityContents :: IOStateArrow s XmlTree XmlTree getXmlEntityContents- = getXmlContents' parseXmlEntityEncodingSpec+ = traceMsg 2 "getXmlEntityContents" >>>- processChildren removeEncodingSpec+ addAttr transferMimeType text_xml_external_parsed_entity -- the default transfer mimetype >>>+ getXmlContents' parseXmlEntityEncodingSpec+ >>>+ addAttr transferMimeType text_xml_external_parsed_entity+ >>>+ processChildren+ ( removeEncodingSpec+ >>>+ changeText normalizeNL -- newline normalization must be done here+ ) -- the following calls of the parsers don't do this+ >>> setBaseURIFromDoc+ >>>+ traceMsg 2 "getXmlEntityContents done" getXmlContents' :: IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree getXmlContents' parseEncodingSpec@@ -286,9 +298,7 @@ traceValue 1 (("getXmlContents: content read and decoded for " ++) . show) ) >>>- traceTree- >>>- traceSource+ traceDoc "getXmlContents'" ) `when` isRoot@@ -334,13 +344,21 @@ decodeDocument :: IOStateArrow s XmlTree XmlTree decodeDocument = choiceA- [ ( isRoot >>> isXmlHtmlDoc ) :-> ( decodeArr normalizeNL $< getEncoding )- , ( isRoot >>> isTextDoc ) :-> ( decodeArr id $< getTextEncoding )+ [ ( isRoot >>> isXmlHtmlDoc ) :-> ( decodeX $< getSysVar theExpat)+ , ( isRoot >>> isTextDoc ) :-> ( decodeArr $< getTextEncoding ) , this :-> this ] where- decodeArr :: (String -> String) -> String -> IOStateArrow s XmlTree XmlTree- decodeArr normalizeNewline enc+ decodeX :: Bool -> IOStateArrow s XmlTree XmlTree+ decodeX False = decodeArr $< getEncoding+ decodeX True = noDecode $< getEncoding -- parse with expat++ noDecode enc = traceMsg 2 ("no decoding (done by expat): encoding is " ++ show enc)+ >>>+ addAttr transferEncoding enc++ decodeArr :: String -> IOStateArrow s XmlTree XmlTree+ decodeArr enc = maybe notFound found . getDecodingFct $ enc where found df@@ -355,13 +373,17 @@ >>> setDocumentStatusFromSystemState "decoding document" +{- just for performance test+ decodeText _ _ = this+-} decodeText df withEncErrors = processChildren ( getText -- get the document content+ -- the following 3 lines+ -- don't seem to raise the space problem in decodeText+ -- space is allocated in blobToString and in parsec >>> arr df -- decode the text, result is (string, [errMsg])- >>> ( ( (fst >>> normalizeNewline) -- take decoded string, normalize newline and build text node- ^>> mkText- )+ >>> ( ( fst ^>> mkText ) -- take decoded string and build text node <+> ( if withEncErrors then
src/Text/XML/HXT/Arrow/DocumentOutput.hs view
@@ -31,9 +31,14 @@ import Control.Arrow.ArrowIO import Control.Arrow.ListArrow -import Data.String.Unicode ( getOutputEncodingFct )+import qualified+ Data.ByteString.Lazy as BS+import Data.Maybe+import Data.String.Unicode ( getOutputEncodingFct' ) import Text.XML.HXT.DOM.Interface+import qualified+ Text.XML.HXT.DOM.ShowXml as XS import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.Edit ( addHeadlineToXmlDoc@@ -42,6 +47,8 @@ , indentDoc , numberLinesInXmlDoc , treeRepOfXmlDoc+ , escapeHtmlRefs+ , escapeXmlRefs ) import Text.XML.HXT.Arrow.XmlState import Text.XML.HXT.Arrow.XmlState.TypeDefs@@ -59,16 +66,31 @@ -- ------------------------------------------------------------ ----- output arrows+-- | Write the contents of a document tree into an output stream (file or stdout).+--+-- If textMode is set, writing is done with Haskell string output, else (default)+-- writing is done with lazy ByteString output putXmlDocument :: Bool -> String -> IOStateArrow s XmlTree XmlTree putXmlDocument textMode dst = perform putDoc where putDoc- = xshow getChildren- >>>- arrIO (\ s -> try ( hPutDocument (\h -> hPutStrLn h s)))+ = ( if textMode+ then ( xshow getChildren+ >>>+ arrIO (\ s -> try ( hPutDocument (\h -> hPutStrLn h s)))+ )+ else ( xshowBlob getChildren+ >>>+ arrIO (\ s -> try ( hPutDocument (\h -> do+ BS.hPutStr h s+ BS.hPutStr h (stringToBlob "\n")+ )+ )+ )+ )+ ) >>> ( ( traceMsg 1 ("io error, document not written to " ++ outFile) >>>@@ -77,7 +99,7 @@ filterErrorMsg ) |||- ( traceMsg 2 ("document written to " ++ outFile)+ ( traceMsg 2 ("document written to " ++ outFile ++ ", textMode = " ++ show textMode) >>> none )@@ -149,14 +171,14 @@ where getEC enc' = fromLA $ getOutputEncoding' defaultEnc enc' -encodeDocument :: Bool -> String -> IOStateArrow s XmlTree XmlTree-encodeDocument supressXmlPi defaultEnc+encodeDocument :: Bool -> Bool -> String -> IOStateArrow s XmlTree XmlTree+encodeDocument quoteXml supressXmlPi defaultEnc = encode $< getOutputEncoding defaultEnc where encode enc = traceMsg 2 ("encodeDocument: encoding is " ++ show enc) >>>- ( encodeDocument' supressXmlPi enc+ ( encodeDocument' quoteXml supressXmlPi enc `orElse` ( issueFatal ("encoding scheme not supported: " ++ show enc) >>>@@ -166,9 +188,21 @@ -- ------------------------------------------------------------ +isBinaryDoc :: LA XmlTree XmlTree+isBinaryDoc = ( ( getAttrValue transferMimeType >>^ stringToLower )+ >>>+ isA (\ t -> not (null t || isTextMimeType t || isXmlMimeType t))+ )+ `guards` this+ getOutputEncoding' :: String -> String -> LA XmlTree String getOutputEncoding' defaultEnc defaultEnc2- = catA [ getChildren -- 1. guess: evaluate <?xml ... encoding="..."?>+ = catA [ isBinaryDoc+ >>> -- 0. guess: binary data found: no encoding at all+ constA isoLatin1 -- the content should usually be a blob+ -- this handling is like the decoding in DocumentInput,+ -- there nothing is decoded for non text or non xml contents+ , getChildren -- 1. guess: evaluate <?xml ... encoding="..."?> >>> ( ( isPi >>> hasName t_xml ) `guards`@@ -180,29 +214,66 @@ ] >. (head . filter (not . null)) -- make the filter deterministic: take 1. entry from list of guesses -encodeDocument' :: ArrowXml a => Bool -> String -> a XmlTree XmlTree-encodeDocument' supressXmlPi defaultEnc+encodeDocument' :: ArrowXml a => Bool -> Bool -> String -> a XmlTree XmlTree+encodeDocument' quoteXml supressXmlPi defaultEnc = fromLA (encode $< getOutputEncoding' defaultEnc utf8) where encode :: String -> LA XmlTree XmlTree encode encodingScheme- = case getOutputEncodingFct encodingScheme of- Nothing -> none- Just ef -> ( if supressXmlPi- then processChildren (none `when` isXmlPi)- else ( addXmlPi- >>>- addXmlPiEncoding encodingScheme- )- )- >>>- replaceChildren ( xshow getChildren- >>>- arr ef- >>>- mkText- )- >>>- addAttr a_output_encoding encodingScheme+ | encodingScheme == unicodeString+ = replaceChildren+ ( (getChildren >. XS.xshow'' cQuot aQuot)+ >>>+ mkText+ )+ | isNothing encodeFct+ = none+ | otherwise+ = ( if supressXmlPi+ then processChildren (none `when` isXmlPi)+ else ( addXmlPi+ >>>+ addXmlPiEncoding encodingScheme+ )+ )+ >>>+ ( isLatin1Blob+ `orElse`+ encodeDoc (fromJust encodeFct)+ )+ >>>+ addAttr a_output_encoding encodingScheme+ where+ (cQuot, aQuot)+ | quoteXml = escapeXmlRefs+ | otherwise = escapeHtmlRefs++ encodeFct = getOutputEncodingFct' encodingScheme++ encodeDoc ef = replaceChildren+ ( xshowBlobWithEnc cQuot aQuot ef getChildren+ >>>+ mkBlob+ )+ xshowBlobWithEnc cenc aenc enc f+ = f >. XS.xshow' cenc aenc enc ++ -- if encoding scheme is isolatin1 and the contents is a single blob (bytestring)+ -- the encoding is the identity.+ -- This optimization enables processing (copying) of none XML contents+ -- without any conversions from and to strings+ isLatin1Blob+ | encodingScheme /= isoLatin1+ = none+ | otherwise = childIsSingleBlob `guards` this+ where+ childIsSingleBlob+ = listA getChildren+ >>>+ isA (length >>> (== 1))+ >>>+ unlistA+ >>>+ isBlob -- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/Edit.hs view
@@ -2,7 +2,7 @@ {- | Module : Text.XML.HXT.Arrow.Edit- Copyright : Copyright (C) 2006-9 Uwe Schmidt+ Copyright : Copyright (C) 2011 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de)@@ -24,8 +24,8 @@ , xshowEscapeXml - , escapeXmlDoc- , escapeHtmlDoc+ , escapeXmlRefs+ , escapeHtmlRefs , haskellRepOfXmlDoc , treeRepOfXmlDoc@@ -65,19 +65,21 @@ import Control.Arrow.ArrowIf import Control.Arrow.ArrowTree import Control.Arrow.ListArrow+import Control.Arrow.NTreeEdit import Data.Char.Properties.XMLCharProps ( isXmlSpaceChar ) import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.DOM.Interface-import qualified Text.XML.HXT.DOM.XmlNode as XN+import qualified Text.XML.HXT.DOM.XmlNode as XN+import qualified Text.XML.HXT.DOM.ShowXml as XS import Text.XML.HXT.DOM.FormatXmlTree ( formatXmlTree ) import Text.XML.HXT.Parser.HtmlParsec ( emptyHtmlTags ) import Text.XML.HXT.Parser.XmlEntities ( xmlEntities ) import Text.XML.HXT.Parser.XhtmlEntities ( xhtmlEntities ) import Data.List ( isPrefixOf )-import qualified Data.Map as M+import qualified Data.Map as M import Data.Maybe -- ------------------------------------------------------------@@ -103,29 +105,69 @@ canonicalizeTree' :: LA XmlTree XmlTree -> LA XmlTree XmlTree canonicalizeTree' toBeRemoved- = processChildren (none `when` isText)+ = processChildren+ ( (none `when` (isText <+> isXmlPi)) -- remove XML PI and all text around XML root element+ >>>+ (deep isPi `when` isDTD) -- remove DTD parts, except PIs whithin DTD+ ) >>>- processBottomUp canonicalize1Node- where- canonicalize1Node :: LA XmlTree XmlTree- canonicalize1Node- = (deep isPi `when` isDTD) -- remove DTD parts, except PIs- >>>- (none `when` toBeRemoved) -- remove uninteresting nodes- >>>- ( processAttrl ( processChildren transfCharRef- >>>- collapseXText- )- `when` isElem- )- >>>- transfCdata -- CDATA -> text- >>>- transfCharRef -- Char refs -> text- >>>- collapseXText -- combine text+ canonicalizeNodes toBeRemoved+{-+canonicalize1Node :: LA XmlTree XmlTree -> LA XmlTree XmlTree+canonicalize1Node toBeRemoved+ = choiceA+ [ toBeRemoved :-> none+ , isElem :-> ( processAttrl+ ( processChildren transfCharRef+ >>>+ collapseXText' -- combine text in attribute values+ )+ >>>+ collapseXText' -- combine text in content+ )+ , isCharRef :-> ( getCharRef+ >>>+ arr (\ i -> [toEnum i])+ >>>+ mkText+ )+ , isCdata :-> ( getCdata+ >>>+ mkText+ )+ , this :-> this+ ]+-}+canonicalizeNodes :: LA XmlTree XmlTree -> LA XmlTree XmlTree+canonicalizeNodes toBeRemoved+ = editNTreeA $+ [ toBeRemoved :-> none+ , ( isElem >>> getAttrl >>> getChildren >>> isCharRef ) -- canonicalize attribute list+ :-> ( processAttrl+ ( processChildren transfCharRef+ >>>+ collapseXText' -- combine text in attribute values+ )+ >>>+ ( collapseXText' -- and combine text in content+ `when`+ (getChildren >>. has2XText)+ )+ )+ , ( isElem >>> (getChildren >>. has2XText) )+ :-> collapseXText' -- combine text in content + , isCharRef :-> ( getCharRef+ >>>+ arr (\ i -> [toEnum i])+ >>>+ mkText+ )+ , isCdata :-> ( getCdata+ >>>+ mkText+ )+ ] -- | -- Applies some "Canonical XML" rules to a document tree.@@ -147,12 +189,9 @@ -- - Special characters in attribute values and character content are replaced by character references canonicalizeAllNodes :: ArrowList a => a XmlTree XmlTree-canonicalizeAllNodes- = fromLA $- canonicalizeTree' ( isCmt -- remove comment- <+>- isXmlPi -- remove xml declaration- )+canonicalizeAllNodes = fromLA $+ canonicalizeTree' isCmt -- remove comment+{-# INLINE canonicalizeAllNodes #-} -- | -- Canonicalize a tree for XPath@@ -161,9 +200,8 @@ -- see 'canonicalizeAllNodes' canonicalizeForXPath :: ArrowList a => a XmlTree XmlTree-canonicalizeForXPath- = fromLA $- canonicalizeTree' isXmlPi+canonicalizeForXPath = fromLA $ canonicalizeTree' none -- comment remains there+{-# INLINE canonicalizeForXPath #-} -- | -- Canonicalize the contents of a document@@ -175,27 +213,20 @@ -- see 'canonicalizeAllNodes' canonicalizeContents :: ArrowList a => a XmlTree XmlTree-canonicalizeContents- = fromLA $- processBottomUp canonicalize1Node- where- canonicalize1Node :: LA XmlTree XmlTree- canonicalize1Node- = ( processAttrl ( processChildren transfCharRef- >>>- collapseXText- )- `when` isElem- )- >>>- transfCdata -- CDATA -> text- >>>- transfCharRef -- Char refs -> text- >>>- collapseXText -- combine text+canonicalizeContents = fromLA $+ canonicalizeNodes none+{-# INLINE canonicalizeContents #-} -- ------------------------------------------------------------ +has2XText :: XmlTrees -> XmlTrees+has2XText ts0@(t1 : ts1@(t2 : ts2))+ | XN.isText t1 = if XN.isText t2+ then ts0+ else has2XText ts2+ | otherwise = has2XText ts1+has2XText _ = []+ collapseXText' :: LA XmlTree XmlTree collapseXText' = replaceChildren ( listA getChildren >>> arrL (foldr mergeText' []) )@@ -217,9 +248,7 @@ -- This is useful, e.g. after char and entity reference substitution collapseXText :: ArrowList a => a XmlTree XmlTree-collapseXText- = fromLA $- collapseXText'+collapseXText = fromLA collapseXText' -- | -- Applies collapseXText recursively.@@ -228,9 +257,7 @@ -- see also : 'collapseXText' collapseAllXText :: ArrowList a => a XmlTree XmlTree-collapseAllXText- = fromLA $- processBottomUp collapseXText'+collapseAllXText = fromLA $ processBottomUp collapseXText' -- ------------------------------------------------------------ @@ -242,10 +269,10 @@ -- -- So the following law holds ----- > xshowEscape f >>> xread == f+-- > xshowEscapeXml f >>> xread == f xshowEscapeXml :: ArrowXml a => a n XmlTree -> a n String-xshowEscapeXml f = xshow (f >>> escapeXmlDoc)+xshowEscapeXml f = f >. (uncurry XS.xshow'' escapeXmlRefs) -- ------------------------------------------------------------ @@ -258,131 +285,72 @@ xmlEntityRefTable , xhtmlEntityRefTable :: EntityRefTable -xmlEntityRefTable = buildEntityRefTable $ xmlEntities-xhtmlEntityRefTable = buildEntityRefTable $ xhtmlEntities+xmlEntityRefTable = buildEntityRefTable $ xmlEntities+xhtmlEntityRefTable = buildEntityRefTable $ xhtmlEntities buildEntityRefTable :: [(String, Int)] -> EntityRefTable buildEntityRefTable = M.fromList . map (\ (x,y) -> (y,x) ) -escapeText'' :: (Char -> XmlTree) -> (Char -> Bool) -> XmlTree -> XmlTrees-escapeText'' escChar isEsc t- = maybe [t] escape' . XN.getText $ t- where- escape' "" = [t] -- empty text nodes remain empty text nodes- escape' s = escape s -- they do not disapear-- escape ""- = []- escape (c:s1)- | isEsc c- = escChar c : escape s1- escape s- = XN.mkText s1 : escape s2- where- (s1, s2) = break isEsc s--{--escapeCharRef :: Char -> XmlTree-escapeCharRef = XN.mkCharRef . fromEnum--}--escapeEntityRef :: EntityRefTable -> Char -> XmlTree-escapeEntityRef entityTable c- = maybe (XN.mkCharRef c') XN.mkEntityRef . M.lookup c' $ entityTable- where- c' = fromEnum c--escapeXmlEntityRef :: Char -> XmlTree-escapeXmlEntityRef = escapeEntityRef xmlEntityRefTable--escapeHtmlEntityRef :: Char -> XmlTree-escapeHtmlEntityRef = escapeEntityRef xhtmlEntityRefTable- -- ------------------------------------------------------------ --- |--- escape all special XML chars into XML entity references or char references------ convert the special XML chars \< and & in text nodes into prefefiened XML entity references,--- in attribute values also \', \", \>, \\n, \\r and \\t are converted into entity or char references,--- in comments nothing is converted (see XML standard 2.4, useful e.g. for JavaScript).--escapeXmlDoc :: ArrowList a => a XmlTree XmlTree-escapeXmlDoc- = fromLA $ escapeDoc escXmlText escXmlAttrValue+escapeXmlRefs :: (Char -> String -> String, Char -> String -> String)+escapeXmlRefs = (cquote, aquote) where- escXmlText- = arrL $ escapeText'' escapeXmlEntityRef (`elem` "<&") -- no escape for ", ' and > required: XML standard 2.4- escXmlAttrValue- = arrL $ escapeText'' escapeXmlEntityRef (`elem` "<>\"\'&\n\r\t")----- |--- escape all special HTML chars into XHTML entity references or char references------ convert the special XML chars \< and & and all none ASCII chars in text nodes into prefefiened XML or XHTML entity references,--- in attribute values also \', \", \>, \\n, \\r and \\t are converted into entity or char references,--- in comments nothing is converted---- ------------------------------------------------------------+ cquote c+ | c `elem` "<&" = ('&' :)+ . ((lookupRef c xmlEntityRefTable) ++)+ . (';' :)+ | otherwise = (c :)+ aquote c+ | c `elem` "<>\"\'&\n\r\t"+ = ('&' :)+ . ((lookupRef c xmlEntityRefTable) ++)+ . (';' :)+ | otherwise = (c :) -escapeHtmlDoc :: ArrowList a => a XmlTree XmlTree-escapeHtmlDoc- = fromLA $ escapeDoc escHtmlText escHtmlAttrValue+escapeHtmlRefs :: (Char -> String -> String, Char -> String -> String)+escapeHtmlRefs = (cquote, aquote) where- escHtmlText- = arrL $ escapeText'' escapeHtmlEntityRef isHtmlTextEsc- escHtmlAttrValue- = arrL $ escapeText'' escapeHtmlEntityRef isHtmlAttrEsc-- isHtmlTextEsc c- = c >= toEnum(128) || ( c `elem` "<&" )- isHtmlAttrEsc c- = c >= toEnum(128) || ( c `elem` "<>\"\'&\n\r\t" )+ cquote c+ | isHtmlTextEsc c+ = ('&' :)+ . ((lookupRef c xhtmlEntityRefTable) ++)+ . (';' :)+ | otherwise = (c :)+ aquote c+ | isHtmlAttrEsc c+ = ('&' :)+ . ((lookupRef c xhtmlEntityRefTable) ++)+ . (';' :)+ | otherwise = (c :) --- ------------------------------------------------------------+ isHtmlTextEsc c = c >= toEnum(128) || ( c `elem` "<&" )+ isHtmlAttrEsc c = c >= toEnum(128) || ( c `elem` "<>\"\'&\n\r\t" ) -escapeDoc :: LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree-escapeDoc escText escAttr- = escape- where- escape- = choiceA- [ isElem :-> ( processChildren escape- >>>- processAttrl escVal- )- , isText :-> escText- -- , isCmt :-> escCmt- , isDTD :-> processTopDown escDTD- , this :-> this- ]- escVal = processChildren escAttr- escDTD = escVal `when` ( isDTDEntity <+> isDTDPEntity )+lookupRef :: Char -> EntityRefTable -> String+lookupRef c = fromMaybe ('#' : show (fromEnum c))+ . M.lookup (fromEnum c)+{-# INLINE lookupRef #-} -- ------------------------------------------------------------ preventEmptyElements :: ArrowList a => [String] -> Bool -> a XmlTree XmlTree preventEmptyElements ns isHtml- = fromLA $ insertDummyElem+ = fromLA $+ editNTreeA [ ( isElem+ >>>+ isNoneEmpty+ >>>+ neg getChildren+ )+ :-> replaceChildren (txt "")+ ] where isNoneEmpty | not (null ns) = hasNameWith (localPart >>> (`elem` ns)) | isHtml = hasNameWith (localPart >>> (`notElem` emptyHtmlTags)) | otherwise = this - insertDummyElem- = processBottomUp- ( replaceChildren (txt "")- `when`- ( isElem- >>>- isNoneEmpty- >>>- neg getChildren- )- )- -- ------------------------------------------------------------ -- |@@ -441,25 +409,19 @@ -- ------------------------------------------------------------ -removeComment' :: LA XmlTree XmlTree-removeComment' = none `when` isCmt- -- |--- remove Comments: @none `when` isCmt@+-- remove a Comment node removeComment :: ArrowXml a => a XmlTree XmlTree-removeComment = fromLA $ removeComment'+removeComment = none `when` isCmt -- |--- remove all comments recursively+-- remove all comments in a tree recursively removeAllComment :: ArrowXml a => a XmlTree XmlTree-removeAllComment = fromLA $ processBottomUp removeComment'---- ----------+removeAllComment = fromLA $ editNTreeA [isCmt :-> none] -removeWhiteSpace' :: LA XmlTree XmlTree-removeWhiteSpace' = none `when` isWhiteSpace+-- ------------------------------------------------------------ -- | -- simple filter for removing whitespace.@@ -470,7 +432,7 @@ -- see also : 'removeAllWhiteSpace', 'removeDocWhiteSpace' removeWhiteSpace :: ArrowXml a => a XmlTree XmlTree-removeWhiteSpace = fromLA $ removeWhiteSpace'+removeWhiteSpace = fromLA $ none `when` isWhiteSpace -- | -- simple recursive filter for removing all whitespace.@@ -481,8 +443,11 @@ -- see also : 'removeWhiteSpace', 'removeDocWhiteSpace' removeAllWhiteSpace :: ArrowXml a => a XmlTree XmlTree-removeAllWhiteSpace = fromLA $ processBottomUp removeWhiteSpace'+removeAllWhiteSpace = fromLA $ editNTreeA [isWhiteSpace :-> none]+ -- fromLA $ processBottomUp removeWhiteSpace' -- less efficient +-- ------------------------------------------------------------+ -- | -- filter for removing all not significant whitespace. --@@ -673,43 +638,33 @@ -- ------------------------------------------------------------ -transfCdata' :: LA XmlTree XmlTree-transfCdata' = (getCdata >>> mkText) `when` isCdata- -- |--- converts a CDATA section node into a normal text node+-- converts a CDATA section into normal text nodes transfCdata :: ArrowXml a => a XmlTree XmlTree transfCdata = fromLA $- transfCdata'+ (getCdata >>> mkText) `when` isCdata -- | -- converts CDATA sections in whole document tree into normal text nodes transfAllCdata :: ArrowXml a => a XmlTree XmlTree-transfAllCdata = fromLA $- processBottomUp transfCdata'------transfCharRef' :: LA XmlTree XmlTree-transfCharRef' = ( getCharRef >>> arr (\ i -> [toEnum i]) >>> mkText )- `when`- isCharRef+transfAllCdata = fromLA $ editNTreeA [isCdata :-> (getCdata >>> mkText)] -- |--- converts character references to normal text+-- converts a character reference to normal text transfCharRef :: ArrowXml a => a XmlTree XmlTree transfCharRef = fromLA $- transfCharRef'+ ( getCharRef >>> arr (\ i -> [toEnum i]) >>> mkText )+ `when`+ isCharRef -- | -- recursively converts all character references to normal text transfAllCharRef :: ArrowXml a => a XmlTree XmlTree-transfAllCharRef = fromLA $- processBottomUp transfCharRef'+transfAllCharRef = fromLA $ editNTreeA [isCharRef :-> (getCharRef >>> arr (\ i -> [toEnum i]) >>> mkText)] -- ------------------------------------------------------------ @@ -741,7 +696,7 @@ <+> txt "\n" <+>- ( getChildren >>> (none `when` isDTDDoctype) ) -- remove old DTD stuff+ ( getChildren >>> (none `when` isDTDDoctype) ) -- remove old DTD decl ) -- ------------------------------------------------------------@@ -762,7 +717,7 @@ addXmlPi :: ArrowXml a => a XmlTree XmlTree addXmlPi = fromLA- ( insertChildrenAt 0 ( ( mkPi (mkSNsName t_xml) none+ ( insertChildrenAt 0 ( ( mkPi (mkName t_xml) none >>> addAttr a_version "1.0" )
src/Text/XML/HXT/Arrow/GeneralEntitySubstitution.hs view
@@ -30,8 +30,8 @@ import Text.XML.HXT.Arrow.XmlState import Text.XML.HXT.Arrow.ParserInterface- ( parseXmlAttrValue- , parseXmlGeneralEntityValue+ ( parseXmlEntityValueAsAttrValue+ , parseXmlEntityValueAsContent ) import Text.XML.HXT.Arrow.Edit@@ -71,7 +71,7 @@ emptyGeEnv :: GEEnv emptyGeEnv = GEEnv M.empty -lookupGeEnv :: String -> GEEnv -> Maybe GESubstArrow+lookupGeEnv :: String -> GEEnv -> Maybe GESubstArrow lookupGeEnv k (GEEnv env) = M.lookup k env @@ -108,10 +108,10 @@ >>> processChildren (processGeneralEntity context recl) )+ , isEntityRef :-> substEntityRef , isDTDDoctype :-> processChildren (processGeneralEntity context recl) , isDTDEntity :-> addEntityDecl , isDTDAttlist :-> substEntitiesInAttrDefaultValue- , isEntityRef :-> substEntityRef , this :-> this ] where@@ -129,45 +129,35 @@ addInternalEntity :: GEArrow XmlTree b addInternalEntity- = ( ( getDTDAttrValue a_name+ = insertInternal $<<+ ( ( getDTDAttrValue a_name >>> traceValue 2 (("processGeneralEntity: general entity definition for " ++) . show) ) &&& xshow (getChildren >>> isText) )- >>>- applyA ( arr2 $ \ entity str ->- listA ( ( ( txt str- >>>- parseXmlGeneralEntityValue ("general internal entity" ++ show entity)- >>>- filterErrorMsg- )- `orElse` txt ""- )- >>>- processGeneralEntity ReferenceInEntityValue (entity : recl)- )- >>>- applyA (arr $ \ ts -> insertEntity (substInternal ts) entity)- )- >>>- none+ where+ insertInternal entity contents+ = insertEntity (substInternal contents) entity+ >>>+ none addExternalEntity :: GEArrow XmlTree b addExternalEntity- = ( ( getDTDAttrValue a_name+ = insertExternal $<<+ ( ( getDTDAttrValue a_name >>> traceValue 2 (("processGeneralEntity: external entity definition for " ++) . show) ) &&& getDTDAttrValue a_url -- the absolute URL, not the relative in attr: k_system )- >>>- applyA (arr2 $ \ entity uri -> insertEntity (substExternalParsed1Time uri) entity)- >>>- none+ where+ insertExternal entity uri+ = insertEntity (substExternalParsed1Time uri) entity+ >>>+ none addUnparsedEntity :: GEArrow XmlTree b addUnparsedEntity@@ -194,6 +184,8 @@ ok = this alreadyDefined _ = issueWarn ("entity " ++ show entity ++ " already defined, repeated definition ignored")+ >>>+ none addEntity :: (String -> GESubstArrow) -> String -> GEArrow b b addEntity fct entity@@ -207,8 +199,8 @@ >>> -- substitute entities mkText -- and convert value into a string >>>- parseXmlAttrValue "default value of attribute"- >>>+ parseXmlEntityValueAsAttrValue "default value of attribute"+ >>> filterErrorMsg >>> substEntitiesInAttrValue@@ -244,7 +236,6 @@ ) >>> arr2 substA )- `orElse` this where substA :: String -> GEEnv -> GEArrow XmlTree XmlTree substA entity geEnv@@ -268,45 +259,43 @@ >>> runInLocalURIContext ( root [sattr a_source uri] [] -- uri must be an absolute uri >>> -- abs uri is computed during parameter entity handling- listA ( getXmlEntityContents- >>>- processExternalEntityContents- )+ getXmlEntityContents+ >>>+ processExternalEntityContents ) >>>- applyA ( arr $ \ ts -> addEntity (substExternalParsed ts) entity )+ applyA ( arr $ \ s -> addEntity (substExternalParsed s) entity ) ) >>> processGeneralEntity cx rl where- processExternalEntityContents :: IOStateArrow s XmlTree XmlTree+ processExternalEntityContents :: IOStateArrow s XmlTree String processExternalEntityContents- = ( ( documentStatusOk -- reading entity succeeded- >>> -- with content stored in a text node- (getChildren >>> isText)- )- `guards`- ( getChildren- >>>- parseXmlGeneralEntityValue ("external parsed entity " ++ show entity)- >>>- filterErrorMsg+ = ( ( ( documentStatusOk -- reading entity succeeded+ >>> -- with content stored in a text node+ (getChildren >>> isText)+ )+ `guards`+ this )+ `orElse`+ issueErr ("illegal value for external parsed entity " ++ show entity) )- `orElse`- issueErr ("illegal value for external parsed entity " ++ show entity)+ >>>+ xshow (getChildren >>> isText) - substExternalParsed :: XmlTrees -> String -> GESubstArrow- substExternalParsed ts entity ReferenceInContent rl = includedIfValidating ts rl entity- substExternalParsed _ entity ReferenceInAttributeValue _++ substExternalParsed :: String -> String -> GESubstArrow+ substExternalParsed s entity ReferenceInContent rl = includedIfValidating s rl entity+ substExternalParsed _ entity ReferenceInAttributeValue _ = forbidden entity "external parsed general" "in attribute value"- substExternalParsed _ _ ReferenceInEntityValue _+ substExternalParsed _ _ ReferenceInEntityValue _ = bypassed - substInternal :: XmlTrees -> String -> GESubstArrow- substInternal ts entity ReferenceInContent rl = included ts rl entity- substInternal ts entity ReferenceInAttributeValue rl= includedInLiteral ts rl entity- substInternal _ _ ReferenceInEntityValue _ = bypassed+ substInternal :: String -> String -> GESubstArrow+ substInternal s entity ReferenceInContent rl = included s rl entity+ substInternal s entity ReferenceInAttributeValue rl = includedInLiteral s rl entity+ substInternal _ _ ReferenceInEntityValue _ = bypassed substUnparsed :: String -> GESubstArrow substUnparsed entity ReferenceInContent _ = forbidden entity "unparsed" "content"@@ -314,27 +303,37 @@ substUnparsed entity ReferenceInEntityValue _ = forbidden entity "unparsed" "entity value" -- XML 1.0 chapter 4.4.2- included :: XmlTrees -> RecList -> String -> GEArrow XmlTree XmlTree- included ts rl entity- = arrL (const ts)+ included :: String -> RecList -> String -> GEArrow XmlTree XmlTree+ included s rl entity+ = traceMsg 3 ("substituting general entity " ++ show entity ++ " with value " ++ show s) >>>+ txt s+ >>>+ parseXmlEntityValueAsContent ("substituting general entity " ++ show entity ++ " in contents")+ >>>+ filterErrorMsg+ >>> processGeneralEntity context (entity : rl) -- XML 1.0 chapter 4.4.3- includedIfValidating :: XmlTrees -> RecList -> String -> GEArrow XmlTree XmlTree+ includedIfValidating :: String -> RecList -> String -> GEArrow XmlTree XmlTree includedIfValidating = included- -- XML 1.0 chapter 4.4.4 forbidden :: String -> String -> String -> GEArrow XmlTree XmlTree forbidden entity msg cx = issueErr ("reference of " ++ msg ++ show entity ++ " forbidden in " ++ cx) -- XML 1.0 chapter 4.4.5- includedInLiteral :: XmlTrees -> RecList -> String -> GEArrow XmlTree XmlTree- includedInLiteral- = included-+ includedInLiteral :: String -> RecList -> String -> GEArrow XmlTree XmlTree+ includedInLiteral s rl entity+ = txt s+ >>>+ parseXmlEntityValueAsAttrValue ("substituting general entity " ++ show entity ++ " in attribute value")+ >>>+ filterErrorMsg+ >>>+ processGeneralEntity context (entity : rl) -- XML 1.0 chapter 4.4.7 bypassed :: GEArrow XmlTree XmlTree bypassed
src/Text/XML/HXT/Arrow/Namespace.hs view
@@ -53,6 +53,7 @@ isNamespaceDeclAttr = fromLA $ (getAttrName >>> isA isNameSpaceName) `guards` this+{-# INLINE isNamespaceDeclAttr #-} -- | get the namespace prefix and the namespace URI out of -- an attribute tree with a namespace declaration (see 'isNamespaceDeclAttr')@@ -114,9 +115,9 @@ -- -- Calls 'cleanupNamespaces' with 'collectNamespaceDecl' -uniqueNamespaces :: ArrowXml a => a XmlTree XmlTree-uniqueNamespaces = fromLA $- cleanupNamespaces' collectNamespaceDecl+uniqueNamespaces :: ArrowXml a => a XmlTree XmlTree+uniqueNamespaces = fromLA $+ cleanupNamespaces' collectNamespaceDecl -- | generate unique namespaces and add all namespace declarations for all prefix-uri pairs in all qualified names --@@ -125,20 +126,20 @@ uniqueNamespacesFromDeclAndQNames :: ArrowXml a => a XmlTree XmlTree uniqueNamespacesFromDeclAndQNames = fromLA $- cleanupNamespaces' ( collectNamespaceDecl- <+>- collectPrefixUriPairs- )+ cleanupNamespaces' ( collectNamespaceDecl+ <+>+ collectPrefixUriPairs+ ) -cleanupNamespaces' :: LA XmlTree (String, String) -> LA XmlTree XmlTree-cleanupNamespaces' collectNamespaces = processTopDownUntil- ( hasNamespaceDecl `guards` cleanupNamespaces collectNamespaces )+cleanupNamespaces' :: LA XmlTree (String, String) -> LA XmlTree XmlTree+cleanupNamespaces' collectNamespaces = processTopDownUntil+ ( hasNamespaceDecl `guards` cleanupNamespaces collectNamespaces ) where- hasNamespaceDecl = isElem- >>>- getAttrl- >>>- isNamespaceDeclAttr+ hasNamespaceDecl = isElem+ >>>+ getAttrl+ >>>+ isNamespaceDeclAttr -- | does the real work for namespace cleanup. --@@ -273,11 +274,11 @@ nsDeclToAttr :: (XName, XName) -> LA XmlTree XmlTree nsDeclToAttr (n, uri)- = mkAttr qn (txt (show uri))+ = mkAttr qn (txt (unXN uri)) where qn :: QName- qn | isNullXName n = mkQName' nullXName xmlnsXName xmlnsNamespaceXName- | otherwise = mkQName' xmlnsXName n xmlnsNamespaceXName+ qn | isNullXName n = newQName xmlnsXName nullXName xmlnsNamespaceXName+ | otherwise = newQName n xmlnsXName xmlnsNamespaceXName -- ----------------------------------------------------------------------------- @@ -374,7 +375,7 @@ , ( getQName >>> isA (not . isWellformedNSDecl ) )- `guards` nsError (\ n -> "illegal namespace declaration for name " ++ n ++ " starting with reserved prefix " ++ show "xml" )+ `guards` nsError (\ n -> "illegal namespace declaration for name " ++ show n ++ " starting with reserved prefix " ++ show "xml" ) ] , isDTD :-> catA [ isDTDDoctype <+> isDTDAttlist <+> isDTDElement <+> isDTDName@@ -413,11 +414,11 @@ ] ] where- nsError :: (String -> String) -> LA XmlTree XmlTree+ nsError :: (QName -> String) -> LA XmlTree XmlTree nsError msg- = (getQName >>> arr show) >>> nsErr msg+ = getQName >>> nsErr msg - nsErr :: (String -> String) -> LA String XmlTree+ nsErr :: (a -> String) -> LA a XmlTree nsErr msg = arr msg >>> mkError c_err doubleOcc :: String -> LA XmlTree XmlTree
src/Text/XML/HXT/Arrow/ParserInterface.hs view
@@ -18,15 +18,8 @@ ( module Text.XML.HXT.Arrow.ParserInterface ) where -import Control.Arrow import Control.Arrow.ArrowList-import Control.Arrow.ArrowIf-import Control.Arrow.ArrowTree-import Control.Arrow.ListArrow -import Text.XML.HXT.Parser.XmlEntities ( xmlEntities )-import Text.XML.HXT.Parser.XhtmlEntities( xhtmlEntities )- import Text.XML.HXT.DOM.Interface import Text.XML.HXT.Arrow.XmlArrow @@ -63,12 +56,11 @@ parseXmlDTDEntityValue :: ArrowXml a => a XmlTree XmlTree parseXmlDTDEntityValue = arrL DP.parseXmlDTDEntityValue -parseXmlAttrValue :: ArrowXml a => String -> a XmlTree XmlTree-parseXmlAttrValue context = arrL (XP.parseXmlAttrValue context)+parseXmlEntityValueAsContent :: ArrowXml a => String -> a XmlTree XmlTree+parseXmlEntityValueAsContent = arrL . XP.parseXmlEntityValueAsContent -parseXmlGeneralEntityValue :: ArrowXml a => String -> a XmlTree XmlTree-parseXmlGeneralEntityValue context- = arrL (XP.parseXmlGeneralEntityValue context)+parseXmlEntityValueAsAttrValue :: ArrowXml a => String -> a XmlTree XmlTree+parseXmlEntityValueAsAttrValue = arrL . XP.parseXmlEntityValueAsAttrValue -- ------------------------------------------------------------ @@ -77,49 +69,5 @@ parseHtmlContent :: ArrowList a => a String XmlTree parseHtmlContent = arrL HP.parseHtmlContent---- ---------------------------------------------------------------- | substitution of all predefined XHTMT entities for none ASCII chars------ This arrow recurses through a whole XML tree and substitutes all--- entity refs within text nodes and attribute values by a text node--- containing of a single char corresponding to this entity.------ Unknown entity refs remain unchanged--substHtmlEntityRefs :: ArrowList a => a XmlTree XmlTree-substHtmlEntityRefs = substEntityRefs xhtmlEntities----- | substitution of the five predefined XMT entities, works like 'substHtmlEntityRefs'--substXmlEntityRefs :: ArrowList a => a XmlTree XmlTree-substXmlEntityRefs = substEntityRefs xmlEntities---- | the entity substitution arrow called from 'substXmlEntityRefs' and 'substHtmlEntityRefs'--substEntityRefs :: ArrowList a => [(String, Int)] -> a XmlTree XmlTree-substEntityRefs entities- = fromLA substEntities- where- substEntities :: LA XmlTree XmlTree- substEntities- = choiceA- [ isEntityRef :-> ( substEntity $< getEntityRef )- , isElem :-> ( processAttrl (processChildren substEntities)- >>>- processChildren substEntities- )- , this :-> this- ]- where- substEntity en- = case (lookup en entities) of- Just i- -> txt [toEnum i] -- constA i >>> mkCharRef- Nothing- -> this- -- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/Pickle.hs view
@@ -96,6 +96,7 @@ , xpOption , xpPair , xpPrim+ , xpInt , xpSeq , xpText , xpText0@@ -157,10 +158,10 @@ >>> ifA ( getSysAttr a_addDTD >>> isA (== v_1) ) ( replaceChildren ( (constA undefined >>> xpickleDTD xp >>> getChildren)- <+>- getChildren+ <+>+ getChildren )- )+ ) this >>> writeDocument [] dest@@ -257,8 +258,12 @@ -- | The arrow version of the unpickler function xunpickleVal :: ArrowXml a => PU b -> a XmlTree b-xunpickleVal xp = arrL (maybeToList . unpickleDoc xp)-+xunpickleVal xp = ( processChildren (none `whenNot` isElem) -- remove all stuff surrounding the root element+ `when`+ isRoot+ )+ >>>+ arrL (maybeToList . unpickleDoc xp) -- | Compute the associated DTD of a pickler
src/Text/XML/HXT/Arrow/Pickle/DTD.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+ -- ------------------------------------------------------------ {- |
src/Text/XML/HXT/Arrow/Pickle/Xml.hs view
@@ -42,6 +42,8 @@ import Control.Arrow.ListArrows +import Data.Char (isDigit)+import Data.List (foldl') import Data.Maybe import Data.Map (Map) import qualified Data.Map as M@@ -475,6 +477,7 @@ xpText :: PU String xpText = xpTextDT scString1+{-# INLINE xpText #-} -- | Pickle a string into an XML text node --@@ -506,6 +509,7 @@ xpText0 :: PU String xpText0 = xpText0DT scString1+{-# INLINE xpText0 #-} -- | Pickle a possibly empty string with a datatype description into an XML node. --@@ -536,6 +540,17 @@ val [(x,"")] = Just x val _ = Nothing +-- | Pickle an unsigned +xpInt :: PU Int+xpInt+ = xpWrapMaybe (readMaybe, show) xpText+ where+ readMaybe xs+ | all isDigit xs = Just . foldl' (\ r c -> 10 * r + (fromEnum c - fromEnum '0')) 0 $ xs+ readMaybe ('-' : xs) = fmap (0 -) . readMaybe $ xs+ readMaybe ('+' : xs) = readMaybe $ xs+ readMaybe _ = Nothing+ -- ------------------------------------------------------------ -- | Pickle an XmlTree by just adding it@@ -641,7 +656,7 @@ xpList1 :: PU a -> PU [a] xpList1 pa = ( xpWrap (\ (x, xs) -> x : xs- ,\ (x : xs) -> (x, xs)+ ,\ x -> (head x, tail x) ) $ xpPair pa (xpList pa) ) { theSchema = scList1 (theSchema pa) }
src/Text/XML/HXT/Arrow/ProcessDocument.hs view
@@ -2,7 +2,7 @@ {- | Module : Text.XML.HXT.Arrow.ProcessDocument- Copyright : Copyright (C) 2005 Uwe Schmidt+ Copyright : Copyright (C) 2011 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de)@@ -18,6 +18,7 @@ module Text.XML.HXT.Arrow.ProcessDocument ( parseXmlDocument+ , parseXmlDocumentWithExpat , parseHtmlDocument , validateDocument , propagateAndValidateNamespaces@@ -31,6 +32,7 @@ import Control.Arrow.ArrowIf import Control.Arrow.ArrowTree import Control.Arrow.ListArrow ( fromLA )+import Control.Arrow.NTreeEdit import Text.XML.HXT.DOM.Interface @@ -40,7 +42,6 @@ import Text.XML.HXT.Arrow.ParserInterface ( parseXmlDoc , parseHtmlDoc- , substHtmlEntityRefs ) import Text.XML.HXT.Arrow.Edit ( transfAllCharRef@@ -61,6 +62,7 @@ ) import Text.XML.HXT.DTDValidation.Validation ( validate , getDTDSubset+ , generalEntitiesDefined , transform ) @@ -99,21 +101,59 @@ >>> setDocumentStatusFromSystemState "parse XML document" >>>- processDTD- >>>- processGeneralEntities- >>>- transfAllCharRef- >>>- ( if validate'- then validateDocument- else this+ ( ifA (fromLA getDTDSubset)+ ( processDTD+ >>>+ ( processGeneralEntities -- DTD contains general entity definitions+ `when`+ fromLA generalEntitiesDefined+ )+ >>>+ transfAllCharRef+ >>>+ ( if validate' -- validation only possible if DTD there+ then validateDocument+ else this+ )+ )+ ( if validate' -- validation only consists of checking for undefined entity refs+ -- predefined XML entity refs are substituted in the XML parser into char refs+ -- so there is no need for an entity substitution+ then traceMsg 2 "checkUndefinedEntityRefs: looking for undefined entity refs"+ >>>+ perform checkUndefinedEntityRefs+ >>>+ traceMsg 2 "checkUndefinedEntityRefs: looking for undefined entity refs done"+ >>>+ setDocumentStatusFromSystemState "decoding document"+ else this+ ) ) ) `when` documentStatusOk +checkUndefinedEntityRefs :: IOStateArrow s XmlTree XmlTree+checkUndefinedEntityRefs+ = deep isEntityRef+ >>>+ getEntityRef+ >>>+ arr (\ en -> "general entity reference \"&" ++ en ++ ";\" is undefined")+ >>>+ mkError c_err+ >>>+ filterErrorMsg+ -- ------------------------------------------------------------ +parseXmlDocumentWithExpat :: IOStateArrow s XmlTree XmlTree+parseXmlDocumentWithExpat+ = ( withoutUserState $< getSysVar theExpatParser+ )+ `when` documentStatusOk++-- ------------------------------------------------------------+ {- | HTML parser @@ -132,10 +172,9 @@ parseHtmlDocument = ( perform ( getAttrValue a_source >>> traceValue 1 (("parseHtmlDoc: parse HTML document " ++) . show) ) >>>- ( parseHtml $< getSysVar theTagSoup )+ ( parseHtml $< getSysVar (theTagSoup .&&&. theExpat) ) >>>- ( removeWarnings $< getSysVar (theWarnings .&&&. theTagSoup )- )+ ( removeWarnings $< getSysVar (theWarnings .&&&. theTagSoup) ) >>> setDocumentStatusFromSystemState "parse HTML document" >>>@@ -150,9 +189,11 @@ ) `when` documentStatusOk where- parseHtml withTagSoup'- | withTagSoup' = withoutUserState $< getSysVar theTagSoupParser -- withoutUserState parseHtmlTagSoup+ parseHtml (withTagSoup', withExpat')+ | withExpat' = withoutUserState $< getSysVar theExpatParser + | withTagSoup' = withoutUserState $< getSysVar theTagSoupParser+ | otherwise = traceMsg 1 ("parse document with parsec HTML parser") >>> replaceChildren@@ -161,23 +202,17 @@ xshow getChildren ) -- get string to be parsed >>>- parseHtmlDoc -- run parser+ parseHtmlDoc -- run parser, entity substituion is done in parser )- >>>- substHtmlEntityRefs -- substitute entity refs removeWarnings (warnings, withTagSoup')- | withTagSoup'- &&- not warnings = this- | otherwise = processTopDownWithAttrl- ( if warnings -- remove warnings inserted by parser and entity subst- then filterErrorMsg- else ( none- `when`- isError- )- )+ | warnings = processTopDownWithAttrl -- remove warnings inserted by parser and entity subst+ filterErrorMsg+ | withTagSoup' = this -- warnings are not generated in tagsoup++ | otherwise = fromLA $+ editNTreeA [isError :-> none] -- remove all warnings from document+ -- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/ReadDocument.hs view
@@ -39,6 +39,7 @@ import Text.XML.HXT.Arrow.ParserInterface import Text.XML.HXT.Arrow.ProcessDocument ( getDocumentContents , parseXmlDocument+ , parseXmlDocumentWithExpat , parseHtmlDocument , propagateAndValidateNamespaces , andValidateNamespaces@@ -168,10 +169,10 @@ >>> readD $< getSysVar theWithCache where- readD True = constA undefined -- just for generalizing the signature to: IOStateArrow s b XmlTree+ readD True = constA undefined -- just for generalizing the signature to: IOStateArrow s b XmlTree >>> -- instead of IOStateArrow s XmlTree XmlTree (withoutUserState $< (getSysVar theCacheRead >>^ ($ src)))- readD False = readDocument'' src+ readD False = readDocument'' src readDocument'' :: String -> IOStateArrow s b XmlTree readDocument'' src@@ -207,7 +208,8 @@ ( replaceChildren none ) -- empty response, e.g. in if-modified-since request ( ( parse $< getSysVar (theValidate .&&&. theIgnoreNoneXmlContents .&&&.- theTagSoup+ theTagSoup .&&&.+ theExpat ) ) >>>@@ -270,28 +272,31 @@ (mi == mis || mis == "*") ) || r- parse (validate, (removeNoneXml, withTagSoup'))- | not isXmlOrHtml = if removeNoneXml- then replaceChildren none -- don't parse, if mime type is not XML nor HTML- else this -- but remove contents when option is set+ parse (validate, (removeNoneXml, (withTagSoup', withExpat')))+ | not isXmlOrHtml = if removeNoneXml+ then replaceChildren none -- don't parse, if mime type is not XML nor HTML+ else this -- but remove contents when option is set | isHtml- ||+ || withTagSoup' = configSysVar (setS theLowerCaseNames isHtml) >>> parseHtmlDocument -- parse as HTML or with tagsoup XML - | isXml = parseXmlDocument (not validateWithRelax && validate) -- parse as XML+ | isXml = if withExpat'+ then parseXmlDocumentWithExpat+ else parseXmlDocument (not validateWithRelax && validate)+ -- parse as XML | otherwise = this -- suppress warning checknamespaces (withNamespaces, withTagSoup') | withNamespaces- &&- withTagSoup' = andValidateNamespaces -- propagation is done in tagsoup+ &&+ withTagSoup' = andValidateNamespaces -- propagation is done in tagsoup | withNamespaces ||- validateWithRelax = propagateAndValidateNamespaces -- RelaxNG requires correct namespaces+ validateWithRelax = propagateAndValidateNamespaces -- RelaxNG requires correct namespaces | otherwise = this @@ -315,18 +320,18 @@ | otherwise = this isHtml = ( not parseByMimeType && parseHtml ) -- force HTML- ||- ( parseByMimeType && isHtmlMimeType mimeType )+ ||+ ( parseByMimeType && isHtmlMimeType mimeType ) isXml = ( not parseByMimeType && not parseHtml )- ||- ( parseByMimeType- &&- ( isXmlMimeType mimeType- ||- null mimeType- ) -- mime type is XML or not known- )+ ||+ ( parseByMimeType+ &&+ ( isXmlMimeType mimeType+ ||+ null mimeType+ ) -- mime type is XML or not known+ ) isXmlOrHtml = isHtml || isXml @@ -336,7 +341,7 @@ -- the arrow version of 'readDocument', the arrow input is the source URI readFromDocument :: SysConfigList -> IOStateArrow s String XmlTree-readFromDocument config = applyA ( arr $ readDocument config )+readFromDocument config = applyA ( arr $ readDocument config ) -- ------------------------------------------------------------ @@ -348,9 +353,9 @@ -- -- Default encoding: No encoding is done, the String argument is taken as Unicode string -readString :: SysConfigList -> String -> IOStateArrow s b XmlTree+readString :: SysConfigList -> String -> IOStateArrow s b XmlTree readString config content- = readDocument (withInputEncoding unicodeString : config)+ = readDocument (withInputEncoding unicodeString : config) (stringProtocol ++ content) -- ------------------------------------------------------------@@ -358,9 +363,8 @@ -- | -- the arrow version of 'readString', the arrow input is the source URI -readFromString :: SysConfigList -> IOStateArrow s String XmlTree-readFromString config- = applyA ( arr $ readString config )+readFromString :: SysConfigList -> IOStateArrow s String XmlTree+readFromString config = applyA ( arr $ readString config ) -- ------------------------------------------------------------ @@ -372,26 +376,21 @@ -- Does not run in the IO monad hread :: ArrowXml a => a String XmlTree-hread- = parseHtmlContent- >>>- substHtmlEntityRefs- >>>- processTopDown ( none `when` isError )- >>>- canonicalizeContents+hread = fromLA $+ parseHtmlContent -- substHtmlEntityRefs is done in parser+ >>>+ editNTreeA [isError :-> none] -- ignore all errors+ >>>+ canonicalizeContents -- | -- parse a string as XML content, substitute all predefined XML entity refs and canonicalize tree -- (substitute char refs, ...) xread :: ArrowXml a => a String XmlTree-xread- = parseXmlContent- >>>- substXmlEntityRefs- >>>- canonicalizeContents+xread = parseXmlContent -- substXmlEntityRefs is done in parser+ >>>+ canonicalizeContents -- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/WriteDocument.hs view
@@ -36,9 +36,7 @@ import Text.XML.HXT.Arrow.XmlState.RunIOStateArrow ( initialSysState )-import Text.XML.HXT.Arrow.Edit ( escapeHtmlDoc- , escapeXmlDoc- , haskellRepOfXmlDoc+import Text.XML.HXT.Arrow.Edit ( haskellRepOfXmlDoc , indentDoc , addDefaultDTDecl , preventEmptyElements@@ -153,7 +151,7 @@ > ) -} -writeDocument :: SysConfigList -> String -> IOStateArrow s XmlTree XmlTree+writeDocument :: SysConfigList -> String -> IOStateArrow s XmlTree XmlTree writeDocument config dst = localSysEnv $@@ -161,12 +159,14 @@ >>> perform ( (flip writeDocument') dst $< getSysVar theTextMode ) -writeDocument' :: Bool -> String -> IOStateArrow s XmlTree XmlTree+writeDocument' :: Bool -> String -> IOStateArrow s XmlTree XmlTree writeDocument' textMode dst = ( traceMsg 1 ("writeDocument: destination is " ++ show dst) >>> ( (flip prepareContents) encodeDocument $< getSysVar idS ) >>>+ traceDoc "document after encoding"+ >>> putXmlDocument textMode dst >>> traceMsg 1 "writeDocument: finished"@@ -204,7 +204,7 @@ -- | -- indent and format output -prepareContents :: ArrowXml a => XIOSysState -> (Bool -> String -> a XmlTree XmlTree) -> a XmlTree XmlTree+prepareContents :: ArrowXml a => XIOSysState -> (Bool -> Bool -> String -> a XmlTree XmlTree) -> a XmlTree XmlTree prepareContents config encodeDoc = indent >>>@@ -212,7 +212,7 @@ >>> format where- indent' = getS theIndent config+ indent' = getS theIndent config removeWS' = getS theRemoveWS config showTree' = getS theShowTree config showHaskell' = getS theShowHaskell config@@ -237,26 +237,20 @@ | showHaskell' = haskellRepOfXmlDoc | outHtml' = preventEmptyElements noEEsFor' True >>>- escapeHtmlDoc -- escape al XML and HTML chars >= 128- >>> encodeDoc -- convert doc into text with respect to output encoding with ASCII as default- noPi' ( if null outEnc' then usAscii else outEnc' )+ False noPi' ( if null outEnc' then usAscii else outEnc' ) | outXhtml' = preventEmptyElements noEEsFor' True >>>- escapeXmlDoc -- escape lt, gt, amp, quot,- >>> encodeDoc -- convert doc into text with respect to output encoding- noPi' outEnc'+ True noPi' outEnc' | outXml' = ( if null noEEsFor' then this else preventEmptyElements noEEsFor' False ) >>>- escapeXmlDoc -- escape lt, gt, amp, quot,- >>> encodeDoc -- convert doc into text with respect to output encoding- noPi' outEnc'+ True noPi' outEnc' | otherwise = this -- ------------------------------------------------------------
src/Text/XML/HXT/Arrow/XmlArrow.hs view
@@ -2,7 +2,7 @@ {- | Module : Text.XML.HXT.Arrow.XmlArrow- Copyright : Copyright (C) 2005-9 Uwe Schmidt+ Copyright : Copyright (C) 2011 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de)@@ -63,26 +63,36 @@ -- | test for text nodes isText :: a XmlTree XmlTree isText = isA XN.isText+ {-# INLINE isText #-} + isBlob :: a XmlTree XmlTree+ isBlob = isA XN.isBlob+ {-# INLINE isBlob #-}+ -- | test for char reference, used during parsing isCharRef :: a XmlTree XmlTree isCharRef = isA XN.isCharRef+ {-# INLINE isCharRef #-} -- | test for entity reference, used during parsing isEntityRef :: a XmlTree XmlTree isEntityRef = isA XN.isEntityRef+ {-# INLINE isEntityRef #-} -- | test for comment isCmt :: a XmlTree XmlTree isCmt = isA XN.isCmt+ {-# INLINE isCmt #-} -- | test for CDATA section, used during parsing isCdata :: a XmlTree XmlTree isCdata = isA XN.isCdata+ {-# INLINE isCdata #-} -- | test for processing instruction isPi :: a XmlTree XmlTree isPi = isA XN.isPi+ {-# INLINE isPi #-} -- | test for processing instruction \<?xml ...\> isXmlPi :: a XmlTree XmlTree@@ -91,22 +101,27 @@ -- | test for element isElem :: a XmlTree XmlTree isElem = isA XN.isElem+ {-# INLINE isElem #-} -- | test for DTD part, used during parsing isDTD :: a XmlTree XmlTree isDTD = isA XN.isDTD+ {-# INLINE isDTD #-} -- | test for attribute tree isAttr :: a XmlTree XmlTree isAttr = isA XN.isAttr+ {-# INLINE isAttr #-} -- | test for error message isError :: a XmlTree XmlTree isError = isA XN.isError+ {-# INLINE isError #-} -- | test for root node (element with name \"\/\") isRoot :: a XmlTree XmlTree isRoot = isA XN.isRoot+ {-# INLINE isRoot #-} -- | test for text nodes with text, for which a predicate holds --@@ -121,52 +136,61 @@ isWhiteSpace :: a XmlTree XmlTree isWhiteSpace = hasText (all isXmlSpaceChar)+ {-# INLINE isWhiteSpace #-} -- | -- test whether a node (element, attribute, pi) has a name with a special property hasNameWith :: (QName -> Bool) -> a XmlTree XmlTree hasNameWith p = (getQName >>> isA p) `guards` this+ {-# INLINE hasNameWith #-} -- | -- test whether a node (element, attribute, pi) has a specific qualified name -- useful only after namespace propagation hasQName :: QName -> a XmlTree XmlTree hasQName n = (getQName >>> isA (== n)) `guards` this+ {-# INLINE hasQName #-} -- | -- test whether a node has a specific name (prefix:localPart ore localPart), -- generally useful, even without namespace handling hasName :: String -> a XmlTree XmlTree hasName n = (getName >>> isA (== n)) `guards` this+ {-# INLINE hasName #-} -- | -- test whether a node has a specific name as local part, -- useful only after namespace propagation hasLocalPart :: String -> a XmlTree XmlTree hasLocalPart n = (getLocalPart >>> isA (== n)) `guards` this+ {-# INLINE hasLocalPart #-} -- | -- test whether a node has a specific name prefix, -- useful only after namespace propagation hasNamePrefix :: String -> a XmlTree XmlTree hasNamePrefix n = (getNamePrefix >>> isA (== n)) `guards` this+ {-# INLINE hasNamePrefix #-} -- | -- test whether a node has a specific namespace URI -- useful only after namespace propagation hasNamespaceUri :: String -> a XmlTree XmlTree hasNamespaceUri n = (getNamespaceUri >>> isA (== n)) `guards` this+ {-# INLINE hasNamespaceUri #-} -- | -- test whether an element node has an attribute node with a specific name hasAttr :: String -> a XmlTree XmlTree hasAttr n = (getAttrl >>> hasName n) `guards` this+ {-# INLINE hasAttr #-} -- | -- test whether an element node has an attribute node with a specific qualified name hasQAttr :: QName -> a XmlTree XmlTree hasQAttr n = (getAttrl >>> hasQName n) `guards` this+ {-# INLINE hasQAttr #-} -- | -- test whether an element node has an attribute with a specific value@@ -183,22 +207,32 @@ -- | text node construction arrow mkText :: a String XmlTree mkText = arr XN.mkText+ {-# INLINE mkText #-} + -- | blob node construction arrow+ mkBlob :: a Blob XmlTree+ mkBlob = arr XN.mkBlob+ {-# INLINE mkBlob #-}+ -- | char reference construction arrow, useful for document output mkCharRef :: a Int XmlTree mkCharRef = arr XN.mkCharRef+ {-# INLINE mkCharRef #-} -- | entity reference construction arrow, useful for document output mkEntityRef :: a String XmlTree mkEntityRef = arr XN.mkEntityRef+ {-# INLINE mkEntityRef #-} -- | comment node construction, useful for document output mkCmt :: a String XmlTree mkCmt = arr XN.mkCmt+ {-# INLINE mkCmt #-} -- | CDATA construction, useful for document output mkCdata :: a String XmlTree mkCdata = arr XN.mkCdata+ {-# INLINE mkCdata #-} -- | error node construction, useful only internally mkError :: Int -> a String XmlTree@@ -211,6 +245,7 @@ mkElement n af cf = (listA af &&& listA cf) >>> arr2 (\ al cl -> XN.mkElement n al cl)+ -- | attribute node construction: -- | the attribute value is computed by applying an arrow to the input mkAttr :: QName -> a n XmlTree -> a n XmlTree@@ -235,164 +270,208 @@ mkqelem :: QName -> [a n XmlTree] -> [a n XmlTree] -> a n XmlTree mkqelem n afs cfs = mkElement n (catA afs) (catA cfs)+ {-# INLINE mkqelem #-} -- | convenient arrow for element construction with strings instead of qualified names as element names, see also 'mkElement' and 'mkelem' mkelem :: String -> [a n XmlTree] -> [a n XmlTree] -> a n XmlTree mkelem n afs cfs = mkElement (mkName n) (catA afs) (catA cfs)+ {-# INLINE mkelem #-} -- | convenient arrow for element constrution with attributes but without content, simple variant of 'mkelem' and 'mkElement' aelem :: String -> [a n XmlTree] -> a n XmlTree aelem n afs = catA afs >. \ al -> XN.mkElement (mkName n) al []+ {-# INLINE aelem #-} -- | convenient arrow for simple element constrution without attributes, simple variant of 'mkelem' and 'mkElement' selem :: String -> [a n XmlTree] -> a n XmlTree selem n cfs = catA cfs >. XN.mkElement (mkName n) []+ {-# INLINE selem #-} -- | convenient arrow for constrution of empty elements without attributes, simple variant of 'mkelem' and 'mkElement' eelem :: String -> a n XmlTree eelem n = constA (XN.mkElement (mkName n) [] [])+ {-# INLINE eelem #-} -- | construction of an element node with name \"\/\" for document roots root :: [a n XmlTree] -> [a n XmlTree] -> a n XmlTree root = mkelem t_root+ {-# INLINE root #-} -- | alias for 'mkAttr' qattr :: QName -> a n XmlTree -> a n XmlTree qattr = mkAttr+ {-# INLINE qattr #-} -- | convenient arrow for attribute constrution, simple variant of 'mkAttr' attr :: String -> a n XmlTree -> a n XmlTree attr = mkAttr . mkName+ {-# INLINE attr #-} -- constant arrows (ignoring the input) for tree construction ------------------------------ -- | constant arrow for text nodes txt :: String -> a n XmlTree txt = constA . XN.mkText+ {-# INLINE txt #-} + -- | constant arrow for blob nodes+ blb :: Blob -> a n XmlTree+ blb = constA . XN.mkBlob+ {-# INLINE blb #-}+ -- | constant arrow for char reference nodes charRef :: Int -> a n XmlTree charRef = constA . XN.mkCharRef+ {-# INLINE charRef #-} -- | constant arrow for entity reference nodes entityRef :: String -> a n XmlTree entityRef = constA . XN.mkEntityRef+ {-# INLINE entityRef #-} -- | constant arrow for comment cmt :: String -> a n XmlTree cmt = constA . XN.mkCmt+ {-# INLINE cmt #-} -- | constant arrow for warning warn :: String -> a n XmlTree warn = constA . (XN.mkError c_warn)+ {-# INLINE warn #-} -- | constant arrow for errors err :: String -> a n XmlTree err = constA . (XN.mkError c_err)+ {-# INLINE err #-} -- | constant arrow for fatal errors fatal :: String -> a n XmlTree fatal = constA . (XN.mkError c_fatal)+ {-# INLINE fatal #-} -- | constant arrow for simple processing instructions, see 'mkPi' spi :: String -> String -> a n XmlTree- spi piName piCont = constA (XN.mkPi (mkName piName) [XN.mkText piCont])+ spi piName piCont = constA (XN.mkPi (mkName piName) [XN.mkAttr (mkName a_value) [XN.mkText piCont]])+ {-# INLINE spi #-} -- | constant arrow for attribute nodes, attribute name is a qualified name and value is a text, -- | see also 'mkAttr', 'qattr', 'attr' sqattr :: QName -> String -> a n XmlTree sqattr an av = constA (XN.mkAttr an [XN.mkText av])+ {-# INLINE sqattr #-} -- | constant arrow for attribute nodes, attribute name and value are -- | given by parameters, see 'mkAttr' sattr :: String -> String -> a n XmlTree sattr an av = constA (XN.mkAttr (mkName an) [XN.mkText av])+ {-# INLINE sattr #-} -- selector arrows -------------------------------------------------- -- | select the text of a text node getText :: a XmlTree String getText = arrL (maybeToList . XN.getText)+ {-# INLINE getText #-} -- | select the value of a char reference getCharRef :: a XmlTree Int getCharRef = arrL (maybeToList . XN.getCharRef)+ {-# INLINE getCharRef #-} -- | select the name of a entity reference node getEntityRef :: a XmlTree String getEntityRef = arrL (maybeToList . XN.getEntityRef)+ {-# INLINE getEntityRef #-} -- | select the comment of a comment node getCmt :: a XmlTree String getCmt = arrL (maybeToList . XN.getCmt)+ {-# INLINE getCmt #-} -- | select the content of a CDATA node getCdata :: a XmlTree String getCdata = arrL (maybeToList . XN.getCdata)+ {-# INLINE getCdata #-} -- | select the name of a processing instruction getPiName :: a XmlTree QName getPiName = arrL (maybeToList . XN.getPiName)+ {-# INLINE getPiName #-} -- | select the content of a processing instruction getPiContent :: a XmlTree XmlTree getPiContent = arrL (fromMaybe [] . XN.getPiContent)+ {-# INLINE getPiContent #-} -- | select the name of an element node getElemName :: a XmlTree QName getElemName = arrL (maybeToList . XN.getElemName)+ {-# INLINE getElemName #-} -- | select the attribute list of an element node getAttrl :: a XmlTree XmlTree getAttrl = arrL (fromMaybe [] . XN.getAttrl)+ {-# INLINE getAttrl #-} -- | select the DTD type of a DTD node getDTDPart :: a XmlTree DTDElem getDTDPart = arrL (maybeToList . XN.getDTDPart)+ {-# INLINE getDTDPart #-} -- | select the DTD attributes of a DTD node getDTDAttrl :: a XmlTree Attributes getDTDAttrl = arrL (maybeToList . XN.getDTDAttrl)+ {-# INLINE getDTDAttrl #-} -- | select the name of an attribute getAttrName :: a XmlTree QName getAttrName = arrL (maybeToList . XN.getAttrName)+ {-# INLINE getAttrName #-} -- | select the error level (c_warn, c_err, c_fatal) from an error node getErrorLevel :: a XmlTree Int getErrorLevel = arrL (maybeToList . XN.getErrorLevel)+ {-# INLINE getErrorLevel #-} -- | select the error message from an error node getErrorMsg :: a XmlTree String getErrorMsg = arrL (maybeToList . XN.getErrorMsg)+ {-# INLINE getErrorMsg #-} -- | select the qualified name from an element, attribute or pi getQName :: a XmlTree QName getQName = arrL (maybeToList . XN.getName)+ {-# INLINE getQName #-} -- | select the prefix:localPart or localPart from an element, attribute or pi getName :: a XmlTree String getName = arrL (maybeToList . XN.getQualifiedName)+ {-# INLINE getName #-} -- | select the univeral name ({namespace URI} ++ localPart) getUniversalName :: a XmlTree String getUniversalName = arrL (maybeToList . XN.getUniversalName)+ {-# INLINE getUniversalName #-} -- | select the univeral name (namespace URI ++ localPart) getUniversalUri :: a XmlTree String getUniversalUri = arrL (maybeToList . XN.getUniversalUri)+ {-# INLINE getUniversalUri #-} -- | select the local part getLocalPart :: a XmlTree String getLocalPart = arrL (maybeToList . XN.getLocalPart)+ {-# INLINE getLocalPart #-} -- | select the name prefix getNamePrefix :: a XmlTree String getNamePrefix = arrL (maybeToList . XN.getNamePrefix)+ {-# INLINE getNamePrefix #-} -- | select the namespace URI getNamespaceUri :: a XmlTree String getNamespaceUri = arrL (maybeToList . XN.getNamespaceUri)+ {-# INLINE getNamespaceUri #-} -- | select the value of an attribute of an element node, -- always succeeds with empty string as default value \"\"@@ -418,6 +497,10 @@ changeText :: (String -> String) -> a XmlTree XmlTree changeText cf = arr (XN.changeText cf) `when` isText + -- | edit the blob of a blob node+ changeBlob :: (Blob -> Blob) -> a XmlTree XmlTree+ changeBlob cf = arr (XN.changeBlob cf) `when` isBlob+ -- | edit the comment string of a comment node changeCmt :: (String -> String) -> a XmlTree XmlTree changeCmt cf = arr (XN.changeCmt cf) `when` isCmt@@ -461,30 +544,37 @@ -- | replace an element, attribute or pi name setQName :: QName -> a XmlTree XmlTree setQName n = changeQName (const n)+ {-# INLINE setQName #-} -- | replace an element name setElemName :: QName -> a XmlTree XmlTree setElemName n = changeElemName (const n)+ {-# INLINE setElemName #-} -- | replace an attribute name setAttrName :: QName -> a XmlTree XmlTree setAttrName n = changeAttrName (const n)+ {-# INLINE setAttrName #-} -- | replace an element name setPiName :: QName -> a XmlTree XmlTree setPiName n = changePiName (const n)+ {-# INLINE setPiName #-} -- | replace an atribute list of an element node setAttrl :: a XmlTree XmlTree -> a XmlTree XmlTree setAttrl = changeAttrl (const id) -- (\ x y -> y)+ {-# INLINE setAttrl #-} -- | add a list of attributes to an element addAttrl :: a XmlTree XmlTree -> a XmlTree XmlTree addAttrl = changeAttrl (XN.mergeAttrl)+ {-# INLINE addAttrl #-} -- | add (or replace) an attribute addAttr :: String -> String -> a XmlTree XmlTree addAttr an av = addAttrl (sattr an av)+ {-# INLINE addAttr #-} -- | remove an attribute removeAttr :: String -> a XmlTree XmlTree@@ -551,9 +641,20 @@ | otherwise = XN.changeChildren (++ [c]) t + -- | apply an arrow to the input and convert the resulting XML trees into a string representation+ xshow :: a n XmlTree -> a n String xshow f = f >. XS.xshow+ {-# INLINE xshow #-}+++ -- | apply an arrow to the input and convert the resulting XML trees into a string representation++ xshowBlob :: a n XmlTree -> a n Blob+ xshowBlob f = f >. XS.xshowBlob+ {-# INLINE xshowBlob #-}+ {- | Document Type Definition arrows
src/Text/XML/HXT/Arrow/XmlRegex.hs view
@@ -133,8 +133,8 @@ mkPrimA :: LA XmlTree XmlTree -> XmlRegex mkPrimA a = mkPrim (not . null . runLA a) -mkDot :: XmlRegex-mkDot = Dot+mkDot :: XmlRegex+mkDot = Dot mkStar :: XmlRegex -> XmlRegex mkStar (Zero _) = mkUnit -- {}* == ()
src/Text/XML/HXT/Arrow/XmlState/RunIOStateArrow.hs view
@@ -18,6 +18,7 @@ where import Control.Arrow -- arrow classes+import Control.Arrow.ArrowList import Control.Arrow.IOStateListArrow import Text.XML.HXT.DOM.Interface@@ -74,6 +75,10 @@ initialSysWriter = XIOwrt { xioErrorStatus = c_ok , xioErrorMsgList = []+ , xioExpatErrors = none+ , xioRelaxNoOfErrors = 0+ , xioRelaxDefineId = 0+ , xioRelaxAttrList = [] } initialSysEnv :: XIOSysEnv@@ -121,6 +126,8 @@ , xioCanonicalize = True , xioIgnoreNoneXmlContents = False , xioTagSoupParser = dummyTagSoupParser+ , xioExpat = False+ , xioExpatParser = dummyExpatParser } initialOutputConfig :: XIOOutputConfig@@ -144,9 +151,6 @@ , xioRelaxValidateExtRef = True , xioRelaxValidateInclude = True , xioRelaxCollectErrors = True- , xioRelaxNoOfErrors = 0- , xioRelaxDefineId = 0- , xioRelaxAttrList = [] , xioRelaxValidator = dummyRelaxValidator } @@ -183,6 +187,14 @@ [ "TagSoup parser not configured," , "please install package hxt-tagsoup" , " and use 'withTagSoup' parser config option from this package"+ ]++dummyExpatParser :: IOSArrow b b+dummyExpatParser = issueFatal $+ unlines $+ [ "Expat parser not configured,"+ , "please install package hxt-expat"+ , " and use 'withExpat' parser config option from this package" ] dummyRelaxValidator :: IOSArrow b b
src/Text/XML/HXT/Arrow/XmlState/TypeDefs.hs view
@@ -162,6 +162,10 @@ data XIOSysWriter = XIOwrt { xioErrorStatus :: ! Int , xioErrorMsgList :: ! XmlTrees+ , xioExpatErrors :: IOSArrow XmlTree XmlTree+ , xioRelaxNoOfErrors :: ! Int+ , xioRelaxDefineId :: ! Int+ , xioRelaxAttrList :: AssocList String XmlTrees } data XIOSysEnv = XIOEnv { xioTraceLevel :: ! Int@@ -203,6 +207,8 @@ , xioIgnoreNoneXmlContents :: ! Bool , xioTagSoup :: ! Bool , xioTagSoupParser :: IOSArrow XmlTree XmlTree+ , xioExpat :: ! Bool+ , xioExpatParser :: IOSArrow XmlTree XmlTree } data XIOOutputConfig = XIOOcfg { xioIndent :: ! Bool@@ -224,10 +230,7 @@ , xioRelaxValidateExtRef :: ! Bool , xioRelaxValidateInclude :: ! Bool , xioRelaxCollectErrors :: ! Bool- , xioRelaxNoOfErrors :: ! Int- , xioRelaxDefineId :: ! Int- , xioRelaxAttrList :: AssocList String XmlTrees- , xioRelaxValidator :: IOSArrow XmlTree XmlTree+ , xioRelaxValidator :: IOSArrow XmlTree XmlTree } data XIOCacheConfig = XIOCch { xioBinaryCompression :: CompressionFct@@ -278,6 +281,27 @@ , setS = \ x s -> s { xioErrorMsgList = x } } +theRelaxNoOfErrors :: Selector XIOSysState Int+theRelaxNoOfErrors = theSysWriter+ >>>+ S { getS = xioRelaxNoOfErrors+ , setS = \ x s -> s { xioRelaxNoOfErrors = x}+ }++theRelaxDefineId :: Selector XIOSysState Int+theRelaxDefineId = theSysWriter+ >>>+ S { getS = xioRelaxDefineId+ , setS = \ x s -> s { xioRelaxDefineId = x}+ }++theRelaxAttrList :: Selector XIOSysState (AssocList String XmlTrees)+theRelaxAttrList = theSysWriter+ >>>+ S { getS = xioRelaxAttrList+ , setS = \ x s -> s { xioRelaxAttrList = x}+ }+ -- ---------------------------------------- theSysEnv :: Selector XIOSysState XIOSysEnv@@ -464,27 +488,6 @@ , setS = \ x s -> s { xioRelaxCollectErrors = x} } -theRelaxNoOfErrors :: Selector XIOSysState Int-theRelaxNoOfErrors = theRelaxConfig- >>>- S { getS = xioRelaxNoOfErrors- , setS = \ x s -> s { xioRelaxNoOfErrors = x}- }--theRelaxDefineId :: Selector XIOSysState Int-theRelaxDefineId = theRelaxConfig- >>>- S { getS = xioRelaxDefineId- , setS = \ x s -> s { xioRelaxDefineId = x}- }--theRelaxAttrList :: Selector XIOSysState (AssocList String XmlTrees)-theRelaxAttrList = theRelaxConfig- >>>- S { getS = xioRelaxAttrList- , setS = \ x s -> s { xioRelaxAttrList = x}- }- theRelaxValidator :: Selector XIOSysState (IOSArrow XmlTree XmlTree) theRelaxValidator = theRelaxConfig >>>@@ -663,6 +666,27 @@ >>> S { getS = xioTagSoupParser , setS = \ x s -> s { xioTagSoupParser = x }+ }++theExpat :: Selector XIOSysState Bool+theExpat = theParseConfig+ >>>+ S { getS = xioExpat+ , setS = \ x s -> s { xioExpat = x }+ }++theExpatParser :: Selector XIOSysState (IOSArrow XmlTree XmlTree)+theExpatParser = theParseConfig+ >>>+ S { getS = xioExpatParser+ , setS = \ x s -> s { xioExpatParser = x }+ }++theExpatErrors :: Selector XIOSysState (IOSArrow XmlTree XmlTree)+theExpatErrors = theSysWriter+ >>>+ S { getS = xioExpatErrors+ , setS = \ x s -> s { xioExpatErrors = x } } -- ----------------------------------------
src/Text/XML/HXT/DOM/FormatXmlTree.hs view
@@ -21,12 +21,12 @@ ) where +import Data.Maybe+ import Text.XML.HXT.DOM.Interface import Text.XML.HXT.DOM.ShowXml import Text.XML.HXT.DOM.XmlNode -import Data.Maybe- -- ------------------------------------------------------------ @@ -49,7 +49,7 @@ where showName :: XNode -> String-showName = maybe "" showQn . getName+showName = maybe "" show . getName showAtts :: XNode -> String showAtts = concatMap showAl . fromMaybe [] . getAttrl@@ -57,18 +57,9 @@ showAl :: XmlTree -> String showAl t -- (NTree (XAttr an) av) | isAttr t- = "\n| " ++ (maybe "" showQn . getName $ t) ++ "=" ++ show (xshow . getChildren $ t)+ = "\n| " ++ (maybe "" show . getName $ t) ++ "=" ++ show (xshow . getChildren $ t) | otherwise = show t--showQn :: QName -> String-showQn n- | null ns- = show $ qualifiedName n- | otherwise- = show $ "{" ++ ns ++ "}" ++ qualifiedName n- where- ns = namespaceUri n -- ------------------------------------------------------------
src/Text/XML/HXT/DOM/Interface.hs view
@@ -30,6 +30,7 @@ import Text.XML.HXT.DOM.TypeDefs -- XML Tree types import Text.XML.HXT.DOM.Util import Text.XML.HXT.DOM.MimeTypes -- mime types related stuff+ import Data.String.EncodingNames -- char encoding names for readDocument -- ------------------------------------------------------------
src/Text/XML/HXT/DOM/MimeTypes.hs view
@@ -47,6 +47,7 @@ text_html, text_pdf, text_plain,+ text_xdtd, text_xml, text_xml_external_parsed_entity :: String @@ -58,6 +59,7 @@ text_html = "text/html" text_pdf = "text/pdf" text_plain = "text/plain"+text_xdtd = "text/x-dtd" text_xml = "text/xml" text_xml_external_parsed_entity = "text/xml-external-parsed-entity" @@ -74,6 +76,7 @@ , application_xml_dtd , text_xml , text_xml_external_parsed_entity+ , text_xdtd ] || "+xml" `isSuffixOf` t -- application/mathml+xml
src/Text/XML/HXT/DOM/QualifiedName.hs view
@@ -4,14 +4,14 @@ {- | Module : Text.XML.HXT.DOM.QualifiedName- Copyright : Copyright (C) 2008 Uwe Schmidt+ Copyright : Copyright (C) 2011 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : stable Portability: portable - The core data types of the HXT DOM.+ The types and functions for qualified names -} @@ -19,7 +19,7 @@ module Text.XML.HXT.DOM.QualifiedName ( QName- , XName+ , XName(unXN) , NsEnv , mkQName@@ -39,6 +39,7 @@ , newXName , nullXName , isNullXName+ , newQName , mkQName' , namePrefix'@@ -50,6 +51,7 @@ , setNamespaceUri' , qualifiedName+ , qualifiedName' , universalName , universalUri , buildUniversalName@@ -84,6 +86,7 @@ import Control.Concurrent.MVar import Control.DeepSeq+import Control.FlatSeq import Data.AssocList import Data.Binary@@ -110,9 +113,46 @@ -- Names are always reduced to normal form, and they are stored internally in a name cache -- for sharing equal names by the same data structure -type XName = Atom+data XName = XN { _idXN :: ! Int -- for optimization of equality test, see Eq instance+ , unXN :: String+ }+ deriving (Typeable) +instance Eq XName where+ (XN id1 _) == (XN id2 _) = id1 == id2++instance Ord XName where+ compare (XN _ n1) (XN _ n2) = compare n1 n2+{-+instance Read XName where+ readsPrec p str = [ (newXName x, y) | (x, y) <- readsPrec p str ]++instance Show XName where+ show (XN _ s) = show s+-}+instance NFData XName where+ rnf (XN _ s) = rnf s++instance WNFData XName where+ rwnf (XN _ s) = rnf s++instance Binary XName where+ put (XN _ s) = put s+ get = do+ s <- get+ return $! newXName s++-----------------------------------------------------------------------------+ -- |+-- Type for the namespace association list, used when propagating namespaces by+-- modifying the 'QName' values in a tree++type NsEnv = AssocList XName XName++-----------------------------------------------------------------------------++-- | -- Namespace support for element and attribute names. -- -- A qualified name consists of a name prefix, a local name@@ -121,120 +161,81 @@ -- When dealing with namespaces, the document tree must be processed by 'Text.XML.HXT.Arrow.Namespace.propagateNamespaces' -- to split names of structure \"prefix:localPart\" and label the name with the apropriate namespace uri -data QName = LP ! XName- | PX ! XName ! QName- | NS ! XName ! QName- deriving (Ord, Show, Read, Typeable)---- |--- Type for the namespace association list, used when propagating namespaces by--- modifying the 'QName' values in a tree--type NsEnv = AssocList XName XName+data QName = QN { localPart' :: ! XName+ , namePrefix' :: ! XName+ , namespaceUri' :: ! XName+ }+ deriving (Typeable) -- ----------------------------------------------------------------------------- -- | Two QNames are equal if (1. case) namespaces are both empty and the qualified names -- (prefix:localpart) are the same or (2. case) namespaces are set and namespaces and--- local parts both are equal+-- local parts are equal instance Eq QName where- (LP lp1) == (LP lp2) = lp1 == lp2- (PX px1 qn1) == (PX px2 qn2) = px1 == px2 && qn1== qn2- (NS ns1 qn1) == (NS ns2 qn2) = ns1 == ns2 && localPart' qn1 == localPart' qn2- n1@(PX _ _) == n2@(LP _) = qualifiedName n1 == qualifiedName n2- n1@(LP _) == n2@(PX _ _) = qualifiedName n1 == qualifiedName n2- _ == _ = False+ (QN lp1 px1 ns1) == (QN lp2 px2 ns2)+ | ns1 /= ns2 = False -- namespaces are set and differ+ | not (isNullXName ns1) = lp1 == lp2 -- namespaces are set and are equal: local parts must be equal+ | otherwise = lp1 == lp2 -- no namespaces are set: local parts must be equal+ && -- and prefixes are not set or they are equal+ px1 == px2 --- the 4. and 5. rule are only neccessary when someone--- uses XML names not in a systematical way--- and does things like "mkName("x:y") == mkPrefixLocalPart("x","y")+instance NFData QName+instance WNFData QName -instance NFData QName where+instance Show QName where+ show = showQN +-- -----------------------------------------------------------------------------+ instance Binary QName where- put qn = let- px = namePrefix qn- lp = localPart qn- ns = namespaceUri qn- in- put px >> put lp >> put ns+ put (QN lp px ns) = put (unXN px) >>+ put (unXN lp) >>+ put (unXN ns) get = do px <- get lp <- get ns <- get- return $ mkQName px lp ns+ return $! newNsName lp px ns+ -- ^^+ -- strict apply !!!+ -- build the QNames strict, else the name sharing optimization will not be in effect -- ----------------------------------------------------------------------------- -newXName :: String -> XName-newXName = newAtom- isNullXName :: XName -> Bool isNullXName = (== nullXName)--nullXName :: XName-nullXName = newXName ""---- | access name prefix--namePrefix' :: QName -> XName-namePrefix' (LP _) = nullXName-namePrefix' (PX px _) = px-namePrefix' (NS _ n) = namePrefix' n---- | access local part--localPart' :: QName -> XName-localPart' (LP lp) = lp-localPart' (PX _ n) = localPart' n-localPart' (NS _ n) = localPart' n---- | access namespace uri--namespaceUri' :: QName -> XName-namespaceUri' (NS ns _) = ns-namespaceUri' _ = nullXName+{-# INLINE isNullXName #-} namePrefix :: QName -> String-namePrefix = show . namePrefix'+namePrefix = unXN . namePrefix'+{-# INLINE namePrefix #-} localPart :: QName -> String-localPart = show . localPart'+localPart = unXN . localPart'+{-# INLINE localPart #-} namespaceUri :: QName -> String-namespaceUri = show . namespaceUri'+namespaceUri = unXN . namespaceUri'+{-# INLINE namespaceUri #-} -- ------------------------------------------------------------ -- | set name prefix -setNamespaceUri' :: XName -> QName -> QName-setNamespaceUri' ns (NS _ n) = if isNullXName ns- then n- else NS ns n-setNamespaceUri' ns n = if isNullXName ns- then n- else NS ns n+setNamespaceUri' :: XName -> QName -> QName+setNamespaceUri' ns (QN lp px _ns) = newQName lp px ns -- | set local part -setLocalPart' :: XName -> QName -> QName-setLocalPart' lp (LP _) = LP lp-setLocalPart' lp (PX px n) = PX px (setLocalPart' lp n)-setLocalPart' lp (NS ns n) = NS ns (setLocalPart' lp n)+setLocalPart' :: XName -> QName -> QName+setLocalPart' lp (QN _lp px ns) = newQName lp px ns -- | set name prefix -setNamePrefix' :: XName -> QName -> QName-setNamePrefix' px (PX _ n) = if px == nullXName- then n- else PX px n-setNamePrefix' px n@(LP _) = if px == nullXName- then n- else PX px n-setNamePrefix' px (NS ns n) = NS ns (setNamePrefix' px n)-+setNamePrefix' :: XName -> QName -> QName+setNamePrefix' px (QN lp _px ns) = newQName lp px ns -- ------------------------------------------------------------ @@ -242,10 +243,17 @@ -- builds the full name \"prefix:localPart\", if prefix is not null, else the local part is the result qualifiedName :: QName -> String-qualifiedName (LP lp) = show lp-qualifiedName (PX px n) = show px ++ (':' : qualifiedName n)-qualifiedName (NS _ n) = qualifiedName n+qualifiedName (QN lp px _ns)+ | isNullXName px = unXN lp+ | otherwise = unXN px ++ (':' : unXN lp) +-- | functional list version of qualifiedName used in xshow++qualifiedName' :: QName -> String -> String+qualifiedName' (QN lp px _ns)+ | isNullXName px = (unXN lp ++)+ | otherwise = (unXN px ++) . (':' :) . (unXN lp ++)+ -- | -- builds the \"universal\" name, that is the namespace uri surrounded with \"{\" and \"}\" followed by the local part -- (specialisation of 'buildUniversalName')@@ -266,21 +274,24 @@ -- namespace uri and local part are combined with the combining function given by the first parameter buildUniversalName :: (String -> String -> String) -> QName -> String-buildUniversalName bf (NS ns n) = show ns `bf` localPart n-buildUniversalName _ n = localPart n+buildUniversalName bf n@(QN _lp _px ns)+ | isNullXName ns = localPart n+ | otherwise = unXN ns `bf` localPart n +showQN :: QName -> String+showQN n+ | null ns = show $ qualifiedName n+ | otherwise = show $ "{" ++ ns ++ "}" ++ qualifiedName n+ where+ ns = namespaceUri n+ -- ------------------------------------------------------------ -- -- internal XName functions mkQName' :: XName -> XName -> XName -> QName-mkQName' px lp ns- | isNullXName ns = px_lp- | otherwise = NS ns px_lp- where- px_lp- | isNullXName px = LP lp- | otherwise = PX px (LP lp)+mkQName' px lp ns = newQName lp px ns+{-# DEPRECATED mkQName' "use newQName instead with lp px ns param seq " #-} -- ------------------------------------------------------------ @@ -291,10 +302,8 @@ mkPrefixLocalPart :: String -> String -> QName mkPrefixLocalPart px lp- | null px = n1- | otherwise = PX (newXName px) n1- where- n1 = LP (newXName lp)+ | null px = newLpName lp+ | otherwise = newPxName lp px -- | -- constructs a simple, namespace unaware name.@@ -307,10 +316,10 @@ | (':' `elem` n) && not (null px) -- more restrictive: isWellformedQualifiedName n- = mkPrefixLocalPart px lp- | otherwise = mkPrefixLocalPart "" n+ = newPxName lp px+ | otherwise = newLpName n where- (px, (_:lp)) = span (/= ':') n+ (px, (_ : lp)) = span (/= ':') n -- | -- constructs a complete qualified name with 'namePrefix', 'localPart' and 'namespaceUri'.@@ -320,10 +329,8 @@ mkQName :: String -> String -> String -> QName mkQName px lp ns- | null ns = n1- | otherwise = NS (newXName ns) n1- where- n1 = mkPrefixLocalPart px lp+ | null ns = mkPrefixLocalPart px lp+ | otherwise = newNsName lp px ns -- ------------------------------------------------------------ @@ -332,6 +339,7 @@ mkSNsName :: String -> QName mkSNsName = mkName+{-# DEPRECATED mkSNsName "use mkName instead" #-} -- | -- constructs a simple, namespace aware name, with prefix:localPart as first parameter,@@ -339,10 +347,18 @@ -- -- see also 'mkName', 'mkPrefixLocalPart' -mkNsName :: String -> String -> QName+{-+mkNsName :: String -> String -> QName+mkNsName n ns = trace ("mkNsName: " ++ show n ++ " " ++ show ns) (mkNsName' n ns)+-}++mkNsName :: String -> String -> QName mkNsName n ns- | null ns = mkName n- | otherwise = NS (newXName ns) (mkName n)+ | null ns = qn+ | otherwise = setNamespaceUri' ns' qn+ where+ qn = mkName n+ ns' = newXName ns -- ------------------------------------------------------------ @@ -388,27 +404,8 @@ -- see 'isWellformedQName' and 'isWellformedQualifiedName' for error checking. setNamespace :: NsEnv -> QName -> QName-setNamespace env n@(PX px _) = attachNS env px n -- none empty prefix found-setNamespace env n@(LP _) = attachNS env nullXName n -- use default namespace uri-setNamespace env (NS _ n) = setNamespace env n--attachNS :: NsEnv -> XName -> QName -> QName-attachNS env px n1 = maybe n1 (\ ns -> NS ns n1) . lookup px $ env--xmlnsNamespaceXName :: XName-xmlnsNamespaceXName = newXName xmlnsNamespace--xmlnsXName :: XName-xmlnsXName = newXName a_xmlns--xmlnsQN :: QName-xmlnsQN = NS xmlnsNamespaceXName (LP xmlnsXName)--xmlNamespaceXName :: XName-xmlNamespaceXName = newXName xmlNamespace--xmlXName :: XName-xmlXName = newXName a_xml+setNamespace env n@(QN lp px _ns)+ = maybe n (\ ns -> newQName lp px ns) . lookup px $ env -- ----------------------------------------------------------------------------- --@@ -440,11 +437,13 @@ -- predicate is used in filter 'valdateNamespaces'. isWellformedQName :: QName -> Bool-isWellformedQName (LP lp) = isNCName . show $ lp -- rule [8] XML Namespaces-isWellformedQName (PX px n) = (isNCName . show) px -- rule [7] XML Namespaces+isWellformedQName (QN lp px _ns)+ = (isNCName . unXN) lp -- rule [8] XML Namespaces &&- isWellformedQName n-isWellformedQName (NS _ n) = isWellformedQName n+ ( isNullXName px+ ||+ (isNCName . unXN) px -- rule [7] XML Namespaces+ ) -- | -- test whether an attribute name is a namesapce declaration name.@@ -454,47 +453,44 @@ -- predicate is used in filter 'valdateNamespaces'. isWellformedNSDecl :: QName -> Bool-isWellformedNSDecl n = not (isNameSpaceName n)+isWellformedNSDecl n+ = not (isNameSpaceName n) || isWellformedNameSpaceName n -- | -- test for a namespace name to be well formed -isWellformedNameSpaceName :: QName -> Bool-isWellformedNameSpaceName (LP lp) = lp == xmlnsXName-isWellformedNameSpaceName (PX px n) = px == xmlnsXName- &&- not (null lp')- &&- not (a_xml `isPrefixOf` lp')- where- lp' = localPart n-isWellformedNameSpaceName (NS _ n) = isWellformedNSDecl n+isWellformedNameSpaceName :: QName -> Bool+isWellformedNameSpaceName n@(QN lp px _ns)+ | isNullXName px = lp == xmlnsXName+ | otherwise = px == xmlnsXName+ &&+ not (null lp')+ &&+ not (a_xml `isPrefixOf` lp')+ where+ lp' = localPart n + -- | -- test whether a name is a namespace declaration attribute name -isNameSpaceName :: QName -> Bool-isNameSpaceName (LP lp) = lp == xmlnsXName-isNameSpaceName (PX px _) = px == xmlnsXName-isNameSpaceName (NS _ n) = isNameSpaceName n+isNameSpaceName :: QName -> Bool+isNameSpaceName (QN lp px _ns)+ | isNullXName px = lp == xmlnsXName+ | otherwise = px == xmlnsXName -- | -- -- predicate is used in filter 'valdateNamespaces'. -isDeclaredNamespace :: QName -> Bool-isDeclaredNamespace (NS ns n) = isNS ns n-isDeclaredNamespace n = isNS nullXName n--isNS :: XName -> QName -> Bool-isNS _ (LP _) = True -- no namespace used-isNS ns (PX px _)- | px == xmlnsXName = ns == xmlnsNamespaceXName -- "xmlns" has a predefined namespace uri- | px == xmlXName = ns == xmlNamespaceXName -- "xml" has a predefiend namespace"- | otherwise = ns /= nullXName -- namespace values are not empty-isNS ns (NS _ n) = isNS ns n -- this does not occur, but warning is prevented+isDeclaredNamespace :: QName -> Bool+isDeclaredNamespace (QN _lp px ns)+ | isNullXName px = True -- no namespace used+ | px == xmlnsXName = ns == xmlnsNamespaceXName -- "xmlns" has a predefined namespace uri+ | px == xmlXName = ns == xmlNamespaceXName -- "xml" has a predefiend namespace"+ | otherwise = not (isNullXName ns) -- namespace values are not empty -- ----------------------------------------------------------------------------- @@ -503,50 +499,127 @@ -- ----------------------------------------------------------------------------- --- the name cache, same implementation strategy as in Data.Atom,--- but conversion to and from ByteString prevented+-- the name and string cache -type Atoms = M.Map String String+data NameCache = NC { _newXN :: ! Int -- next free name id+ , _xnCache :: ! (M.Map String XName)+ , _qnCache :: ! (M.Map (XName, XName, XName) QName) -- we need another type than QName+ } -- for the key because of the unusable+ -- Eq instance of QName+type ChangeNameCache r = NameCache -> (NameCache, r) -newtype Atom = A String- deriving (Eq, Ord, Typeable)+-- ------------------------------------------------------------ +-- | the internal cache for QNames (and name strings)++theNameCache :: MVar NameCache+theNameCache = unsafePerformIO (newMVar $ initialCache)+{-# NOINLINE theNameCache #-}++initialXNames :: [XName]++nullXName+ , xmlnsNamespaceXName+ , xmlnsXName+ , xmlNamespaceXName+ , xmlXName :: XName++initialXNames@+ [ nullXName+ , xmlnsNamespaceXName+ , xmlnsXName+ , xmlNamespaceXName+ , xmlXName+ ] = zipWith XN [0..] $+ [ ""+ , xmlnsNamespace+ , a_xmlns+ , xmlNamespace+ , a_xml+ ]++initialQNames :: [QName]++xmlnsQN :: QName++initialQNames@+ [xmlnsQN] = [QN xmlnsXName nullXName xmlnsNamespaceXName]++initialCache :: NameCache+initialCache = NC+ (length initialXNames)+ (M.fromList $ map (\ xn -> (unXN xn, xn)) initialXNames)+ (M.fromList $ map (\ qn@(QN lp px ns) -> ((lp, px, ns), qn)) initialQNames)+ -- ------------------------------------------------------------ --- | the internal cache for the strings+changeNameCache :: NFData r => ChangeNameCache r -> r+changeNameCache action = unsafePerformIO changeNameCache'+ where+ changeNameCache' = do+ -- putStrLn "takeMVar"+ c <- takeMVar theNameCache+ let (c', res) = action c+ c' `seq` -- rnf res `seq`+ putMVar theNameCache c'+ -- putStrLn "putMVar"+ return res -theAtoms :: MVar Atoms-theAtoms = unsafePerformIO (newMVar M.empty)-{-# NOINLINE theAtoms #-}+{-# NOINLINE changeNameCache #-} --- | insert a bytestring into the atom cache+newXName' :: String -> ChangeNameCache XName+newXName' n c@(NC nxn xm qm)+ = case M.lookup n xm of+ Just xn -> (c, xn)+ Nothing -> let nxn' = nxn + 1 in+ let xn = (XN nxn n) in+ let xm' = M.insert n xn xm in+ -- trace ("newXName: XN " ++ show nxn ++ " " ++ show n) $+ rnf xn `seq` (NC nxn' xm' qm, xn) -insertAtom :: String -> Atoms -> (Atoms, Atom)-insertAtom s m = maybe (M.insert {- (trace (show s) s) -} s s m, deepseq s (A s))- (\ s' -> (m, A s'))- .- M.lookup s $ m+newQName' :: XName -> XName -> XName -> ChangeNameCache QName+newQName' lp px ns c@(NC nxn xm qm)+ = case M.lookup q' qm of+ Just qn -> -- trace ("oldQName: " ++ show qn) $ -- log evaluation sequence+ (c, qn)+ Nothing -> let qm' = M.insert q' q qm in+ -- trace ("newQName: " ++ show q) $ -- log insertion of a new QName+ q `seq` (NC nxn xm qm', q)+ where+ q' = (lp, px, ns)+ q = QN lp px ns --- | creation of an @Atom@ from a @String@+andThen :: ChangeNameCache r1 ->+ (r1 -> ChangeNameCache r2) -> ChangeNameCache r2+andThen a1 a2 c0 = let (c1, r1) = a1 c0 in+ (a2 r1) c1 -newAtom :: String -> Atom-newAtom = unsafePerformIO . newAtom'-{-# NOINLINE newAtom #-}+newXName :: String -> XName+newXName n = changeNameCache $+ newXName' n --- | The internal operation running in the IO monad-newAtom' :: String -> IO Atom-newAtom' s = do- m <- takeMVar theAtoms- let (m', a) = insertAtom s m- putMVar theAtoms m'- return a+newQName :: XName -> XName -> XName -> QName+newQName lp px ns = lp `seq` px `seq` ns `seq` -- XNames must be evaluated, else MVar blocks+ ( changeNameCache $+ newQName' lp px ns+ ) -instance Read Atom where- readsPrec p str = [ (newAtom x, y) | (x, y) <- readsPrec p str ]+newLpName :: String -> QName+newLpName lp = changeNameCache $+ newXName' lp `andThen` \ lp' ->+ newQName' lp' nullXName nullXName -instance Show Atom where- show (A s) = s+newPxName :: String -> String -> QName+newPxName lp px = changeNameCache $+ newXName' lp `andThen` \ lp' ->+ newXName' px `andThen` \ px' ->+ newQName' lp' px' nullXName -instance NFData Atom where+newNsName :: String -> String -> String -> QName+newNsName lp px ns = changeNameCache $+ newXName' lp `andThen` \ lp' ->+ newXName' px `andThen` \ px' ->+ newXName' ns `andThen` \ ns' ->+ newQName' lp' px' ns' -----------------------------------------------------------------------------
src/Text/XML/HXT/DOM/ShowXml.hs view
@@ -17,11 +17,16 @@ module Text.XML.HXT.DOM.ShowXml ( xshow- , showElemType+ , xshowBlob+ , xshow'+ , xshow'' ) where +import Prelude hiding (showChar, showString)+ import Data.Maybe+import Data.Tree.Class import Data.Tree.NTree.TypeDefs import Text.XML.HXT.DOM.TypeDefs -- XML Tree types@@ -35,371 +40,407 @@ -- the toString conversion functions -- |--- convert the result of a filter into a string+-- convert a list of trees into a string -- -- see also : 'xmlTreesToText' for filter version, 'Text.XML.HXT.Parser.XmlParsec.xread' for the inverse operation -xshow :: XmlTrees -> String+xshow :: XmlTrees -> String xshow [(NTree (XText s) _)] = s -- special case optimisation-xshow ts = showXmlTrees ts ""+xshow [(NTree (XBlob b) _)] = blobToString b -- special case optimisation+xshow ts = showXmlTrees showString showString ts "" --- ------------------------------------------------------------+-- | convert an XML tree into a binary large object (a bytestring) -showXmlTree :: XmlTree -> String -> String+xshowBlob :: XmlTrees -> Blob+xshowBlob [(NTree (XBlob b) _)] = b -- special case optimisation+xshowBlob [(NTree (XText s) _)] = stringToBlob s -- special case optimisation+xshowBlob ts = stringToBlob $ xshow ts -showXmlTree (NTree (XText s) _)- = showString s+-- |+-- convert a list of trees into a blob.+--+-- Apply a quoting function for XML quoting of content,+-- a 2. quoting funtion for attribute values+-- and an encoding function after tree conversion -showXmlTree (NTree (XCharRef i) _)- = showString "&#" . showString (show i) . showChar ';'+xshow' :: (Char -> StringFct) -> (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> Blob+xshow' cquot aquot enc ts = stringToBlob $ (concatMap' enc (showTrees ts "")) ""+ where+ showTrees = showXmlTrees (concatMap' cquot) (concatMap' aquot) -showXmlTree (NTree (XEntityRef r) _)- = showString "&" . showString r . showChar ';'+xshow'' :: (Char -> StringFct) -> (Char -> StringFct) -> XmlTrees -> String+xshow'' cquot aquot ts = showTrees ts ""+ where+ showTrees = showXmlTrees (concatMap' cquot) (concatMap' aquot) -showXmlTree (NTree (XCmt c) _)- = showString "<!--" . showString c . showString "-->"+-- ------------------------------------------------------------ -showXmlTree (NTree (XCdata d) _)- = showString "<![CDATA[" . showString d . showString "]]>"+type StringFct = String -> String -showXmlTree (NTree (XPi n al) _)- = showString "<?"- .- showQName n- .- (foldr (.) id . map showPiAttr) al- .- showString "?>"+-- ------------------------------------------------------------++showXmlTrees :: (String -> StringFct) -> (String -> StringFct) -> XmlTrees -> StringFct+showXmlTrees cf af+ = showTrees where- showPiAttr :: XmlTree -> String -> String- showPiAttr a@(NTree (XAttr an) cs)- | qualifiedName an == a_value- = showBlank . showXmlTrees cs- | otherwise- = showXmlTree a- showPiAttr _- = id -showXmlTree (NTree (XTag t al) [])- = showLt . showQName t . showXmlTrees al . showSlash . showGt+ -- ------------------------------------------------------------ -showXmlTree (NTree (XTag t al) cs)- = showLt . showQName t . showXmlTrees al . showGt- . showXmlTrees cs- . showLt . showSlash . showQName t . showGt+ showTrees :: XmlTrees -> StringFct+ showTrees = foldr (.) id . map showXmlTree+ {-# INLINE showTrees #-} -showXmlTree (NTree (XDTD de al) cs)- = showXmlDTD de al cs+ showTrees' :: XmlTrees -> StringFct+ showTrees' = foldr (\ x y -> x . showNL . y) id . map showXmlTree+ {-# INLINE showTrees' #-} -showXmlTree (NTree (XAttr an) cs)- = showBlank . showQName an . showEq . showQuoteString (xshow cs)+ -- ------------------------------------------------------------ -showXmlTree (NTree (XError l e) _)- = showString "<!-- ERROR (" . shows l . showString "):\n" . showString e . showString "\n-->"+ showXmlTree :: XmlTree -> StringFct+ showXmlTree (NTree (XText s) _) -- common cases first+ = cf s --- ------------------------------------------------------------+ showXmlTree (NTree (XTag t al) [])+ = showLt . showQName t . showTrees al . showSlash . showGt -showXmlTrees :: XmlTrees -> String -> String-showXmlTrees = foldr (.) id . map showXmlTree+ showXmlTree (NTree (XTag t al) cs)+ = showLt . showQName t . showTrees al . showGt+ . showTrees cs+ . showLt . showSlash . showQName t . showGt -showXmlTrees' :: XmlTrees -> String -> String-showXmlTrees' = foldr (\ x y -> x . showNL . y) id . map showXmlTree+ showXmlTree (NTree (XAttr an) cs)+ = showBlank+ . showQName an+ . showEq+ . showQuot+ . af (xshow cs)+ . showQuot --- ------------------------------------------------------------+ showXmlTree (NTree (XBlob b) _)+ = cf . blobToString $ b -showQName :: QName -> String -> String-showQName- = showString . qualifiedName+ showXmlTree (NTree (XCharRef i) _)+ = showString "&#" . showString (show i) . showChar ';' --- ------------------------------------------------------------+ showXmlTree (NTree (XEntityRef r) _)+ = showString "&" . showString r . showChar ';' -showQuoteString :: String -> String -> String-showQuoteString s- | '\"' `elem` s- = showApos . showString s . showApos- | otherwise- = showQuot . showString s . showQuot+ showXmlTree (NTree (XCmt c) _)+ = showString "<!--" . showString c . showString "-->" + showXmlTree (NTree (XCdata d) _)+ = showString "<![CDATA[" . showString d . showString "]]>" --- ------------------------------------------------------------+ showXmlTree (NTree (XPi n al) _)+ = showString "<?"+ . showQName n+ . (foldr (.) id . map showPiAttr) al+ . showString "?>"+ where+ showPiAttr :: XmlTree -> StringFct+ showPiAttr a@(NTree (XAttr an) cs)+ | qualifiedName an == a_value+ = showBlank . showTrees cs+ | otherwise+ = showXmlTree a+ showPiAttr a+ = showXmlTree a -- id -showAttr :: String -> Attributes -> String -> String-showAttr k al- = showString (fromMaybe "" . lookup k $ al)+ showXmlTree (NTree (XDTD de al) cs)+ = showXmlDTD de al cs --- ------------------------------------------------------------+ showXmlTree (NTree (XError l e) _)+ = showString "<!-- ERROR ("+ . shows l+ . showString "):\n"+ . showString e+ . showString "\n-->" -showPEAttr :: Attributes -> String -> String-showPEAttr al- = showPE (lookup a_peref al)- where- showPE (Just pe) = showChar '%' . showString pe . showChar ';'- showPE Nothing = id+ -- ------------------------------------------------------------ --- ------------------------------------------------------------+ showXmlDTD :: DTDElem -> Attributes -> XmlTrees -> StringFct -showExternalId :: Attributes -> String -> String-showExternalId al- = id2Str (lookup k_system al) (lookup k_public al)- where- id2Str Nothing Nothing = id- id2Str (Just s) Nothing = showBlank . showString k_system . showBlank . showQuoteString s- id2Str Nothing (Just p) = showBlank . showString k_public . showBlank . showQuoteString p- id2Str (Just s) (Just p) = showBlank . showString k_public . showBlank . showQuoteString p . showBlank . showQuoteString s+ showXmlDTD DOCTYPE al cs = showString "<!DOCTYPE "+ . showAttr a_name al+ . showExternalId al+ . showInternalDTD cs+ . showString ">"+ where+ showInternalDTD [] = id+ showInternalDTD ds = showString " [\n"+ . showTrees' ds+ . showChar ']' --- ------------------------------------------------------------+ showXmlDTD ELEMENT al cs = showString "<!ELEMENT "+ . showAttr a_name al+ . showBlank+ . showElemType (lookup1 a_type al) cs+ . showString " >" -showNData :: Attributes -> String -> String-showNData al- = nd2Str (lookup k_ndata al)- where- nd2Str Nothing = id- nd2Str (Just v) = showBlank . showString k_ndata . showBlank . showString v+ showXmlDTD ATTLIST al cs = showString "<!ATTLIST "+ . ( if isNothing . lookup a_name $ al+ then+ showTrees cs+ else+ showAttr a_name al+ . showBlank+ . ( case lookup a_value al of+ Nothing -> ( showPEAttr+ . fromMaybe [] . getDTDAttrl+ . head+ ) cs+ Just a -> ( showString a+ . showAttrType (lookup1 a_type al)+ . showAttrKind (lookup1 a_kind al)+ )+ )+ )+ . showString " >"+ where+ showAttrType t+ | t == k_peref+ = showBlank . showPEAttr al+ | t == k_enumeration+ = showAttrEnum+ | t == k_notation+ = showBlank . showString k_notation . showAttrEnum+ | otherwise+ = showBlank . showString t --- ------------------------------------------------------------+ showAttrEnum+ = showString " ("+ . foldr1+ (\ s1 s2 -> s1 . showString " | " . s2)+ (map (getEnum . fromMaybe [] . getDTDAttrl) cs)+ . showString ")"+ where+ getEnum :: Attributes -> StringFct+ getEnum l = showAttr a_name l . showPEAttr l -showXmlDTD :: DTDElem -> Attributes -> XmlTrees -> String -> String+ showAttrKind k+ | k == k_default+ = showBlank+ . showQuoteString (lookup1 a_default al)+ | k == k_fixed+ = showBlank+ . showString k_fixed+ . showBlank+ . showQuoteString (lookup1 a_default al)+ | k == ""+ = id+ | otherwise+ = showBlank+ . showString k -showXmlDTD DOCTYPE al cs- = showString "<!DOCTYPE "- .- showAttr a_name al- .- showExternalId al- .- showInternalDTD cs- .- showString ">"- where- showInternalDTD [] = id- showInternalDTD ds = showString " [\n" . showXmlTrees' ds . showChar ']'+ showXmlDTD NOTATION al _cs+ = showString "<!NOTATION "+ . showAttr a_name al+ . showExternalId al+ . showString " >" -showXmlDTD ELEMENT al cs- = showString "<!ELEMENT "- .- showAttr a_name al- .- showBlank- .- showElemType (lookup1 a_type al) cs- .- showString " >"+ showXmlDTD PENTITY al cs = showEntity "% " al cs -showXmlDTD ATTLIST al cs- = showString "<!ATTLIST "- .- ( if isNothing . lookup a_name $ al- then- showXmlTrees cs- else- showAttr a_name al- .- showBlank- .- ( case lookup a_value al of- Nothing -> ( showPEAttr- . fromMaybe [] . getDTDAttrl- . head- ) cs- Just a -> ( showString a- .- showAttrType (lookup1 a_type al)- .- showAttrKind (lookup1 a_kind al)- )- )- )- .- showString " >"- where- showAttrType t- | t == k_peref- = showBlank . showPEAttr al- | t == k_enumeration- = showAttrEnum- | t == k_notation- = showBlank . showString k_notation . showAttrEnum- | otherwise- = showBlank . showString t+ showXmlDTD ENTITY al cs = showEntity "" al cs - showAttrEnum- = showString " ("- .- foldr1 (\ s1 s2 -> s1 . showString " | " . s2) (map (getEnum . fromMaybe [] . getDTDAttrl) cs)- .- showString ")"- where- getEnum :: Attributes -> String -> String- getEnum l = showAttr a_name l . showPEAttr l+ showXmlDTD PEREF al _cs = showPEAttr al - showAttrKind k- | k == k_default- = showBlank . showQuoteString (lookup1 a_default al)- | k == k_fixed- = showBlank . showString k_fixed- .- showBlank . showQuoteString (lookup1 a_default al)- | k == ""- = id- | otherwise- = showBlank . showString k+ showXmlDTD CONDSECT _ (c1 : cs)+ = showString "<![ "+ . showXmlTree c1+ . showString " [\n"+ . showTrees cs+ . showString "]]>" -showXmlDTD NOTATION al _cs- = showString "<!NOTATION "- .- showAttr a_name al- .- showExternalId al- .- showString " >"+ showXmlDTD CONTENT al cs = showContent (mkDTDElem CONTENT al cs) -showXmlDTD PENTITY al cs- = showEntity "% " al cs+ showXmlDTD NAME al _cs = showAttr a_name al -showXmlDTD ENTITY al cs- = showEntity "" al cs+ showXmlDTD de al _cs = showString "NOT YET IMPLEMETED: "+ . showString (show de)+ . showBlank+ . showString (show al)+ . showString " [...]\n" -showXmlDTD PEREF al _cs- = showPEAttr al+ -- ------------------------------------------------------------ -showXmlDTD CONDSECT _ (c1 : cs)- = showString "<![ "- .- showXmlTree c1- .- showString " [\n"- .- showXmlTrees cs- .- showString "]]>"+ showEntity :: String -> Attributes -> XmlTrees -> StringFct+ showEntity kind al cs = showString "<!ENTITY "+ . showString kind+ . showAttr a_name al+ . showExternalId al+ . showNData al+ . showEntityValue cs+ . showString " >" -showXmlDTD CONTENT al cs- = showContent (mkDTDElem CONTENT al cs) -showXmlDTD NAME al _cs- = showAttr a_name al+ showEntityValue :: XmlTrees -> StringFct+ showEntityValue [] = id+ showEntityValue cs = showBlank+ . showQuot+ . af (xshow cs)+ . showQuot -showXmlDTD de al _cs- = showString "NOT YET IMPLEMETED: " . showString (show de) . showBlank . showString (show al) . showString " [...]\n"+ -- ------------------------------------------------------------ --- ------------------------------------------------------------+ showContent :: XmlTree -> StringFct+ showContent (NTree (XDTD de al) cs)+ = cont2String de+ where+ cont2String :: DTDElem -> StringFct+ cont2String NAME = showAttr a_name al+ cont2String PEREF = showPEAttr al+ cont2String CONTENT = showLpar+ . foldr1+ (combine (lookup1 a_kind al))+ (map showContent cs)+ . showRpar+ . showAttr a_modifier al+ cont2String n = error ("cont2string " ++ show n ++ " is undefined")+ combine k s1 s2 = s1+ . showString ( if k == v_seq+ then ", "+ else " | "+ )+ . s2 -showElemType :: String -> XmlTrees -> String -> String-showElemType t cs- | t == v_pcdata- = showLpar . showString v_pcdata . showRpar+ showContent n = showXmlTree n - | t == v_mixed && (not . null) cs- = showLpar- .- showString v_pcdata- .- ( foldr (.) id . map (mixedContent . selAttrl . getNode) ) cs1- .- showRpar- .- showAttr a_modifier al1- | t == v_mixed -- incorrect tree, e.g. after erronius pe substitution- = showLpar- .- showRpar- | t == v_children && (not . null) cs- = showContent (head cs)- | t == v_children- = showLpar- . showRpar- | t == k_peref- = foldr (.) id . map showContent $ cs- | otherwise- = showString t- where- [(NTree (XDTD CONTENT al1) cs1)] = cs+ -- ------------------------------------------------------------ - mixedContent :: Attributes -> String -> String- mixedContent l- = showString " | " . showAttr a_name l . showPEAttr l+ showElemType :: String -> XmlTrees -> StringFct+ showElemType t cs+ | t == v_pcdata = showLpar . showString v_pcdata . showRpar+ | t == v_mixed+ &&+ (not . null) cs = showLpar+ . showString v_pcdata+ . ( foldr (.) id+ . map (mixedContent . selAttrl . getNode)+ ) cs1+ . showRpar+ . showAttr a_modifier al1+ | t == v_mixed -- incorrect tree, e.g. after erronius pe substitution+ = showLpar+ . showRpar+ | t == v_children+ &&+ (not . null) cs = showContent (head cs)+ | t == v_children = showLpar+ . showRpar+ | t == k_peref = foldr (.) id+ . map showContent $ cs+ | otherwise = showString t+ where+ [(NTree (XDTD CONTENT al1) cs1)] = cs - selAttrl (XDTD _ as) = as- selAttrl (XText tex) = [(a_name, tex)]- selAttrl _ = []+ mixedContent :: Attributes -> StringFct+ mixedContent l = showString " | " . showAttr a_name l . showPEAttr l + selAttrl (XDTD _ as) = as+ selAttrl (XText tex) = [(a_name, tex)]+ selAttrl _ = []+ -- ------------------------------------------------------------ -showContent :: XmlTree -> String -> String-showContent (NTree (XDTD de al) cs)- = cont2String de- where- cont2String :: DTDElem -> String -> String- cont2String NAME- = showAttr a_name al- cont2String PEREF- = showPEAttr al- cont2String CONTENT- = showLpar- .- foldr1 (combine (lookup1 a_kind al)) (map showContent cs)- .- showRpar- .- showAttr a_modifier al- cont2String n- = error ("cont2string " ++ show n ++ " is undefined")- combine k s1 s2- = s1- .- showString ( if k == v_seq- then ", "- else " | "- )- .- s2+showQName :: QName -> StringFct+showQName = qualifiedName'+{-# INLINE showQName #-} -showContent n- = showXmlTree n+-- ------------------------------------------------------------ +showQuoteString :: String -> StringFct+showQuoteString s = showQuot . showString s . showQuot+ -- ------------------------------------------------------------ -showEntity :: String -> Attributes -> XmlTrees -> String -> String+showAttr :: String -> Attributes -> StringFct+showAttr k al = showString (fromMaybe "" . lookup k $ al) -showEntity kind al cs- = showString "<!ENTITY "- .- showString kind- .- showAttr a_name al- .- showExternalId al- .- showNData al- .- showEntityValue cs- .- showString " >"+-- ------------------------------------------------------------ +showPEAttr :: Attributes -> StringFct+showPEAttr al = showPE (lookup a_peref al)+ where+ showPE (Just pe) = showChar '%'+ . showString pe+ . showChar ';'+ showPE Nothing = id+ -- ------------------------------------------------------------ -showEntityValue :: XmlTrees -> String -> String+showExternalId :: Attributes -> StringFct+showExternalId al = id2Str (lookup k_system al) (lookup k_public al)+ where+ id2Str Nothing Nothing = id+ id2Str (Just s) Nothing = showBlank+ . showString k_system+ . showBlank+ . showQuoteString s+ id2Str Nothing (Just p) = showBlank+ . showString k_public+ . showBlank+ . showQuoteString p+ id2Str (Just s) (Just p) = showBlank+ . showString k_public+ . showBlank+ . showQuoteString p+ . showBlank+ . showQuoteString s -showEntityValue []- = id+-- ------------------------------------------------------------ -showEntityValue cs- = showBlank . showQuoteString (xshow cs)+showNData :: Attributes -> StringFct+showNData al = nd2Str (lookup k_ndata al)+ where+ nd2Str Nothing = id+ nd2Str (Just v) = showBlank+ . showString k_ndata+ . showBlank+ . showString v -- ------------------------------------------------------------ showBlank,- showEq, showLt, showGt, showSlash, showApos, showQuot, showLpar, showRpar, showNL :: String -> String+ showEq, showLt, showGt, showSlash, showQuot, showLpar, showRpar, showNL :: StringFct showBlank = showChar ' '+{-# INLINE showBlank #-}+ showEq = showChar '='+{-# INLINE showEq #-}+ showLt = showChar '<'+{-# INLINE showLt #-}+ showGt = showChar '>'+{-# INLINE showGt #-}+ showSlash = showChar '/'-showApos = showChar '\''+{-# INLINE showSlash #-}+ showQuot = showChar '\"'+{-# INLINE showQuot #-}+ showLpar = showChar '('+{-# INLINE showLpar #-}+ showRpar = showChar ')'+{-# INLINE showRpar #-}+ showNL = showChar '\n'+{-# INLINE showNL #-} +showChar :: Char -> StringFct+showChar = (:)+{-# INLINE showChar #-}++showString :: String -> StringFct+showString = (++)+{-# INLINE showString #-}++concatMap' :: (Char -> StringFct) -> String -> StringFct+concatMap' f = foldr (\ x r -> f x . r) id+{-# INLINE concatMap' #-}+ -- -----------------------------------------------------------------------------+
src/Text/XML/HXT/DOM/TypeDefs.hs view
@@ -4,7 +4,7 @@ {- | Module : Text.XML.HXT.DOM.TypeDefs- Copyright : Copyright (C) 2008 Uwe Schmidt+ Copyright : Copyright (C) 2008-2010 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de)@@ -25,39 +25,55 @@ where -import Control.DeepSeq+import Control.DeepSeq+import Control.FlatSeq -import Data.AssocList-import Data.Binary-import Data.Tree.NTree.TypeDefs-import Data.Typeable+import Data.AssocList -import Text.XML.HXT.DOM.QualifiedName+import Data.Binary+import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString.Lazy.Char8 as CS +import Data.Tree.NTree.TypeDefs+import Data.Tree.NTree.Zipper.TypeDefs++import Data.Typeable++import Text.XML.HXT.DOM.QualifiedName+ -- ----------------------------------------------------------------------------- -- -- Basic types for xml tree and filters --- | Node of xml tree representation+-- | Rose tree with XML nodes (XNode) type XmlTree = NTree XNode --- | List of nodes of xml tree representation+-- | List of rose trees with XML nodes type XmlTrees = NTrees XNode +-- | Navigatable rose tree with XML nodes++type XmlNavTree = NTZipper XNode++-- | List of navigatable rose trees with XML nodes++type XmlNavTrees = [NTZipper XNode]+ -- ----------------------------------------------------------------------------- -- -- XNode -- | Represents elements -data XNode = XText String -- ^ ordinary text (leaf)- | XCharRef Int -- ^ character reference (leaf)- | XEntityRef String -- ^ entity reference (leaf)- | XCmt String -- ^ comment (leaf)- | XCdata String -- ^ CDATA section (leaf)- | XPi QName XmlTrees -- ^ Processing Instr with qualified name (leaf)+data XNode = XText String -- ^ ordinary text (leaf)+ | XBlob Blob -- ^ text represented more space efficient as bytestring (leaf)+ | XCharRef Int -- ^ character reference (leaf)+ | XEntityRef String -- ^ entity reference (leaf)+ | XCmt String -- ^ comment (leaf)+ | XCdata String -- ^ CDATA section (leaf)+ | XPi QName XmlTrees -- ^ Processing Instr with qualified name (leaf) -- with list of attributes. -- If tag name is xml, attributs are \"version\", \"encoding\", \"standalone\", -- else attribute list is empty, content is a text child node@@ -65,54 +81,76 @@ | XDTD DTDElem Attributes -- ^ DTD element with assoc list for dtd element features | XAttr QName -- ^ attribute with qualified name, the attribute value is stored in children | XError Int String -- ^ error message with level and text- deriving (Eq, Ord, Show, Read, Typeable)+ deriving (Eq, Show, Typeable) instance NFData XNode where rnf (XText s) = rnf s+ rnf (XTag qn cs) = rnf qn `seq` rnf cs+ rnf (XAttr qn) = rnf qn rnf (XCharRef i) = rnf i rnf (XEntityRef n) = rnf n rnf (XCmt c) = rnf c rnf (XCdata s) = rnf s rnf (XPi qn ts) = rnf qn `seq` rnf ts- rnf (XTag qn cs) = rnf qn `seq` rnf cs rnf (XDTD de al) = rnf de `seq` rnf al- rnf (XAttr qn) = rnf qn+ rnf (XBlob b) = BS.length b `seq` () rnf (XError n e) = rnf n `seq` rnf e +instance WNFData XNode where+ rwnf (XText s) = rwnf s+ rwnf (XTag qn cs) = rwnf qn `seq` rwnf cs+ rwnf (XAttr qn) = rwnf qn+ rwnf (XCharRef i) = i `seq` ()+ rwnf (XEntityRef n) = rwnf n+ rwnf (XCmt c) = rwnf c+ rwnf (XCdata s) = rwnf s+ rwnf (XPi qn ts) = rwnf qn `seq` rwnf ts+ rwnf (XDTD de al) = rwnf de `seq` rwnfAttributes al+ rwnf (XBlob _b) = () -- BS.length b `seq` () -- lazy bytestrings are not evaluated+ rwnf (XError n e) = n `seq` rwnf e++-- | Evaluate an assoc list of strings+rwnfAttributes :: Attributes -> ()+rwnfAttributes [] = ()+rwnfAttributes ((k, v) : as) = rwnf k `seq` rwnf v `seq` rwnfAttributes as++ instance Binary XNode where- put (XText s) = put (0::Word8) >> put s- put (XCharRef i) = put (1::Word8) >> put i- put (XEntityRef n) = put (2::Word8) >> put n- put (XCmt c) = put (3::Word8) >> put c- put (XCdata s) = put (4::Word8) >> put s- put (XPi qn ts) = put (5::Word8) >> put qn >> put ts- put (XTag qn cs) = put (6::Word8) >> put qn >> put cs- put (XDTD de al) = put (7::Word8) >> put de >> put al- put (XAttr qn) = put (8::Word8) >> put qn- put (XError n e) = put (9::Word8) >> put n >> put e+ put (XText s) = put ( 0::Word8) >> put s+ put (XTag qn cs) = put ( 6::Word8) >> put qn >> put cs+ put (XAttr qn) = put ( 8::Word8) >> put qn+ put (XCharRef i) = put ( 1::Word8) >> put i+ put (XEntityRef n) = put ( 2::Word8) >> put n+ put (XCmt c) = put ( 3::Word8) >> put c+ put (XCdata s) = put ( 4::Word8) >> put s+ put (XPi qn ts) = put ( 5::Word8) >> put qn >> put ts+ put (XDTD de al) = put ( 7::Word8) >> put de >> put al+ put (XError n e) = put ( 9::Word8) >> put n >> put e+ put (XBlob b) = put (10::Word8) >> put b get = do tag <- getWord8 case tag of- 0 -> get >>= return . XText- 1 -> get >>= return . XCharRef- 2 -> get >>= return . XEntityRef- 3 -> get >>= return . XCmt- 4 -> get >>= return . XCdata- 5 -> do- qn <- get- get >>= return . XPi qn- 6 -> do- qn <- get- get >>= return . XTag qn- 7 -> do- de <- get- get >>= return . XDTD de- 8 -> get >>= return . XAttr- 9 -> do- n <- get- get >>= return . XError n- _ -> error "XNode.get: error while decoding XNode"+ 0 -> get >>= return . XText+ 1 -> get >>= return . XCharRef+ 2 -> get >>= return . XEntityRef+ 3 -> get >>= return . XCmt+ 4 -> get >>= return . XCdata+ 5 -> do+ qn <- get+ get >>= return . XPi qn+ 6 -> do+ qn <- get+ get >>= return . XTag qn+ 7 -> do+ de <- get+ get >>= return . XDTD de+ 8 -> get >>= return . XAttr+ 9 -> do+ n <- get+ get >>= return . XError n+ 10 -> get >>= return . XBlob+ _ -> error "XNode.get: error while decoding XNode" -- ----------------------------------------------------------------------------- --@@ -156,22 +194,27 @@ deriving (Eq, Ord, Enum, Show, Read, Typeable) instance NFData DTDElem+instance WNFData DTDElem instance Binary DTDElem where put de = put ((toEnum . fromEnum $ de)::Word8) -- DTDElem is not yet instance of Enum get = do tag <- getWord8- return . toEnum . fromEnum $ tag-{-- put de = let- i = fromJust . elemIndex de $ dtdElems- in- put ((toEnum i)::Word8)+ return $! (toEnum . fromEnum $ tag) - get = do- tag <- getWord8- return $ dtdElems !! (fromEnum tag)--}+-- -----------------------------------------------------------------------------++-- | Binary large object implemented as a lazy bytestring++type Blob = BS.ByteString++blobToString :: Blob -> String+blobToString = CS.unpack+{-# INLINE blobToString #-}++stringToBlob :: String -> Blob+stringToBlob = CS.pack+{-# INLINE stringToBlob #-} -- -----------------------------------------------------------------------------
src/Text/XML/HXT/DOM/XmlNode.hs view
@@ -25,15 +25,18 @@ module Text.XML.HXT.DOM.XmlNode ( module Text.XML.HXT.DOM.XmlNode+ , module Data.Tree.Class , module Data.Tree.NTree.TypeDefs ) where import Control.Monad+import Control.FlatSeq +import Data.Maybe+import Data.Tree.Class import Data.Tree.NTree.TypeDefs -import Data.Maybe import Text.XML.HXT.DOM.Interface @@ -41,6 +44,7 @@ -- discriminating predicates isText :: a -> Bool+ isBlob :: a -> Bool isCharRef :: a -> Bool isEntityRef :: a -> Bool isCmt :: a -> Bool@@ -55,6 +59,7 @@ -- constructor functions for leave nodes mkText :: String -> a+ mkBlob :: Blob -> a mkCharRef :: Int -> a mkEntityRef :: String -> a mkCmt :: String -> a@@ -65,6 +70,7 @@ -- selectors getText :: a -> Maybe String+ getBlob :: a -> Maybe Blob getCharRef :: a -> Maybe Int getEntityRef :: a -> Maybe String getCmt :: a -> Maybe String@@ -92,6 +98,7 @@ -- "modifier" functions changeText :: (String -> String) -> a -> a+ changeBlob :: (Blob -> Blob) -> a -> a changeCmt :: (String -> String) -> a -> a changeName :: (QName -> QName) -> a -> a changeElemName :: (QName -> QName) -> a -> a@@ -101,6 +108,7 @@ changeDTDAttrl :: (Attributes -> Attributes) -> a -> a setText :: String -> a -> a+ setBlob :: Blob -> a -> a setCmt :: String -> a -> a setName :: QName -> a -> a setElemName :: QName -> a -> a@@ -112,45 +120,58 @@ -- default implementations getName n = getElemName n `mplus` getAttrName n `mplus` getPiName n- getQualifiedName n = getName n >>= \ n' -> return (qualifiedName n')- getUniversalName n = getName n >>= \ n' -> return (universalName n')- getUniversalUri n = getName n >>= \ n' -> return (universalUri n')- getLocalPart n = getName n >>= \ n' -> return (localPart n')- getNamePrefix n = getName n >>= \ n' -> return (namePrefix n')- getNamespaceUri n = getName n >>= \ n' -> return (namespaceUri n')+ getQualifiedName n = getName n >>= return . qualifiedName+ getUniversalName n = getName n >>= return . universalName+ getUniversalUri n = getName n >>= return . universalUri+ getLocalPart n = getName n >>= return . localPart+ getNamePrefix n = getName n >>= return . namePrefix+ getNamespaceUri n = getName n >>= return . namespaceUri - setText t = changeText (const t)- setCmt c = changeCmt (const c)- setName n = changeName (const n)- setElemName n = changeElemName (const n)- setElemAttrl al = changeAttrl (const al)- setAttrName n = changeAttrName (const n)- setPiName n = changePiName (const n)- setDTDAttrl al = changeDTDAttrl (const al)+ setText = changeText . const+ setBlob = changeBlob . const+ setCmt = changeCmt . const+ setName = changeName . const+ setElemName = changeElemName . const+ setElemAttrl = changeAttrl . const+ setAttrName = changeAttrName . const+ setPiName = changePiName . const+ setDTDAttrl = changeDTDAttrl . const -- XNode and XmlTree are instances of XmlNode instance XmlNode XNode where isText (XText _) = True+ isText (XBlob _) = True isText _ = False+ {-# INLINE isText #-} + isBlob (XBlob _) = True+ isBlob _ = False+ {-# INLINE isBlob #-}+ isCharRef (XCharRef _) = True isCharRef _ = False+ {-# INLINE isCharRef #-} isEntityRef (XEntityRef _) = True isEntityRef _ = False+ {-# INLINE isEntityRef #-} isCmt (XCmt _) = True isCmt _ = False+ {-# INLINE isCmt #-} isCdata (XCdata _) = True isCdata _ = False+ {-# INLINE isCdata #-} isPi (XPi _ _) = True isPi _ = False+ {-# INLINE isPi #-} isElem (XTag _ _) = True isElem _ = False+ {-# INLINE isElem #-} isRoot t = isElem t &&@@ -158,155 +179,253 @@ isDTD (XDTD _ _) = True isDTD _ = False+ {-# INLINE isDTD #-} isAttr (XAttr _) = True isAttr _ = False+ {-# INLINE isAttr #-} isError (XError _ _) = True isError _ = False+ {-# INLINE isError #-} - mkText t = XText t- mkCharRef c = XCharRef c- mkEntityRef e = XEntityRef e- mkCmt c = XCmt c- mkCdata d = XCdata d- mkPi n c = XPi n (if null c then [] else [mkAttr (mkName a_value) c])- mkError l msg = XError l msg+ mkText = XText+ {-# INLINE mkText #-}+ mkBlob = XBlob+ {-# INLINE mkBlob #-}+ mkCharRef = XCharRef+ {-# INLINE mkCharRef #-}+ mkEntityRef = XEntityRef+ {-# INLINE mkEntityRef #-}+ mkCmt = XCmt+ {-# INLINE mkCmt #-}+ mkCdata = XCdata+ {-# INLINE mkCdata #-}+ mkPi = XPi+ {-# INLINE mkPi #-} + mkError = XError+ {-# INLINE mkError #-} - getText (XText t) = Just t++ getText (XText t) = Just t+ getText (XBlob b) = Just . blobToString $ b getText _ = Nothing+ {-# INLINE getText #-} + getBlob (XBlob b) = Just b+ getBlob _ = Nothing+ {-# INLINE getBlob #-}+ getCharRef (XCharRef c) = Just c getCharRef _ = Nothing+ {-# INLINE getCharRef #-} getEntityRef (XEntityRef e) = Just e getEntityRef _ = Nothing+ {-# INLINE getEntityRef #-} getCmt (XCmt c) = Just c getCmt _ = Nothing+ {-# INLINE getCmt #-} getCdata (XCdata d) = Just d getCdata _ = Nothing+ {-# INLINE getCdata #-} getPiName (XPi n _) = Just n getPiName _ = Nothing+ {-# INLINE getPiName #-} getPiContent (XPi _ c) = Just c getPiContent _ = Nothing+ {-# INLINE getPiContent #-} getElemName (XTag n _) = Just n getElemName _ = Nothing+ {-# INLINE getElemName #-} getAttrl (XTag _ al) = Just al getAttrl (XPi _ al) = Just al getAttrl _ = Nothing+ {-# INLINE getAttrl #-} getDTDPart (XDTD p _) = Just p getDTDPart _ = Nothing+ {-# INLINE getDTDPart #-} getDTDAttrl (XDTD _ al) = Just al getDTDAttrl _ = Nothing+ {-# INLINE getDTDAttrl #-} getAttrName (XAttr n) = Just n getAttrName _ = Nothing+ {-# INLINE getAttrName #-} getErrorLevel (XError l _) = Just l getErrorLevel _ = Nothing+ {-# INLINE getErrorLevel #-} getErrorMsg (XError _ m) = Just m getErrorMsg _ = Nothing+ {-# INLINE getErrorMsg #-} - changeText cf (XText t) = XText (cf t)+ changeText cf (XText t) = XText . cf $ t+ changeText cf (XBlob b) = XText . cf . blobToString $ b changeText _ _ = error "changeText undefined"+ {-# INLINE changeText #-} - changeCmt cf (XCmt c) = XCmt (cf c)+ changeBlob cf (XBlob b) = XBlob . cf $ b+ changeBlob _ _ = error "changeBlob undefined"+ {-# INLINE changeBlob #-}++ changeCmt cf (XCmt c) = XCmt . cf $ c changeCmt _ _ = error "changeCmt undefined"+ {-# INLINE changeCmt #-} - changeName cf (XTag n al) = XTag (cf n) al- changeName cf (XAttr n) = XAttr (cf n)- changeName cf (XPi n al) = XPi (cf n) al+ changeName cf (XTag n al) = XTag (cf n) al+ changeName cf (XAttr n) = XAttr . cf $ n+ changeName cf (XPi n al) = XPi (cf n) al changeName _ _ = error "changeName undefined"+ {-# INLINE changeName #-} - changeElemName cf (XTag n al) = XTag (cf n) al+ changeElemName cf (XTag n al) = XTag (cf n) al changeElemName _ _ = error "changeElemName undefined"+ {-# INLINE changeElemName #-} changeAttrl cf (XTag n al) = XTag n (cf al) changeAttrl cf (XPi n al) = XPi n (cf al) changeAttrl _ _ = error "changeAttrl undefined"+ {-# INLINE changeAttrl #-} - changeAttrName cf (XAttr n) = XAttr (cf n)+ changeAttrName cf (XAttr n) = XAttr . cf $ n changeAttrName _ _ = error "changeAttrName undefined"+ {-# INLINE changeAttrName #-} - changePiName cf (XPi n al) = XPi (cf n) al+ changePiName cf (XPi n al) = XPi (cf n) al changePiName _ _ = error "changeAttrName undefined"+ {-# INLINE changePiName #-} changeDTDAttrl cf (XDTD p al) = XDTD p (cf al) changeDTDAttrl _ _ = error "changeDTDAttrl undefined"+ {-# INLINE changeDTDAttrl #-} mkElementNode :: QName -> XmlTrees -> XNode mkElementNode = XTag+{-# INLINE mkElementNode #-} mkAttrNode :: QName -> XNode mkAttrNode = XAttr+{-# INLINE mkAttrNode #-} mkDTDNode :: DTDElem -> Attributes -> XNode mkDTDNode = XDTD+{-# INLINE mkDTDNode #-} -instance XmlNode a => XmlNode (NTree a) where+instance (XmlNode a, Tree t) => XmlNode (t a) where isText = isText . getNode+ {-# INLINE isText #-}+ isBlob = isBlob . getNode+ {-# INLINE isBlob #-} isCharRef = isCharRef . getNode+ {-# INLINE isCharRef #-} isEntityRef = isEntityRef . getNode+ {-# INLINE isEntityRef #-} isCmt = isCmt . getNode+ {-# INLINE isCmt #-} isCdata = isCdata . getNode+ {-# INLINE isCdata #-} isPi = isPi . getNode+ {-# INLINE isPi #-} isElem = isElem . getNode+ {-# INLINE isElem #-} isRoot = isRoot . getNode+ {-# INLINE isRoot #-} isDTD = isDTD . getNode+ {-# INLINE isDTD #-} isAttr = isAttr . getNode+ {-# INLINE isAttr #-} isError = isError . getNode+ {-# INLINE isError #-} mkText = mkLeaf . mkText+ {-# INLINE mkText #-}+ mkBlob = mkLeaf . mkBlob+ {-# INLINE mkBlob #-} mkCharRef = mkLeaf . mkCharRef+ {-# INLINE mkCharRef #-} mkEntityRef = mkLeaf . mkEntityRef+ {-# INLINE mkEntityRef #-} mkCmt = mkLeaf . mkCmt+ {-# INLINE mkCmt #-} mkCdata = mkLeaf . mkCdata+ {-# INLINE mkCdata #-} mkPi n = mkLeaf . mkPi n+ {-# INLINE mkPi #-} mkError l = mkLeaf . mkError l+ {-# INLINE mkError #-} getText = getText . getNode+ {-# INLINE getText #-}+ getBlob = getBlob . getNode+ {-# INLINE getBlob #-} getCharRef = getCharRef . getNode+ {-# INLINE getCharRef #-} getEntityRef = getEntityRef . getNode+ {-# INLINE getEntityRef #-} getCmt = getCmt . getNode+ {-# INLINE getCmt #-} getCdata = getCdata . getNode+ {-# INLINE getCdata #-} getPiName = getPiName . getNode+ {-# INLINE getPiName #-} getPiContent = getPiContent . getNode+ {-# INLINE getPiContent #-} getElemName = getElemName . getNode+ {-# INLINE getElemName #-} getAttrl = getAttrl . getNode+ {-# INLINE getAttrl #-} getDTDPart = getDTDPart . getNode+ {-# INLINE getDTDPart #-} getDTDAttrl = getDTDAttrl . getNode+ {-# INLINE getDTDAttrl #-} getAttrName = getAttrName . getNode+ {-# INLINE getAttrName #-} getErrorLevel = getErrorLevel . getNode+ {-# INLINE getErrorLevel #-} getErrorMsg = getErrorMsg . getNode+ {-# INLINE getErrorMsg #-} - changeText cf = changeNode (changeText cf)- changeCmt cf = changeNode (changeCmt cf)- changeName cf = changeNode (changeName cf)- changeElemName cf = changeNode (changeElemName cf)- changeAttrl cf = changeNode (changeAttrl cf)- changeAttrName cf = changeNode (changeAttrName cf)- changePiName cf = changeNode (changePiName cf)- changeDTDAttrl cf = changeNode (changeDTDAttrl cf)+ changeText = changeNode . changeText+ {-# INLINE changeText #-}+ changeBlob = changeNode . changeBlob+ {-# INLINE changeBlob #-}+ changeCmt = changeNode . changeCmt+ {-# INLINE changeCmt #-}+ changeName = changeNode . changeName+ {-# INLINE changeName #-}+ changeElemName = changeNode . changeElemName+ {-# INLINE changeElemName #-}+ changeAttrl = changeNode . changeAttrl+ {-# INLINE changeAttrl #-}+ changeAttrName = changeNode . changeAttrName+ {-# INLINE changeAttrName #-}+ changePiName = changeNode . changePiName+ {-# INLINE changePiName #-}+ changeDTDAttrl = changeNode . changeDTDAttrl+ {-# INLINE changeDTDAttrl #-} mkElement :: QName -> XmlTrees -> XmlTrees -> XmlTree mkElement n al = mkTree (mkElementNode n al)+{-# INLINE mkElement #-} mkRoot :: XmlTrees -> XmlTrees -> XmlTree mkRoot al = mkTree (mkElementNode (mkName t_root) al) mkAttr :: QName -> XmlTrees -> XmlTree mkAttr n = mkTree (mkAttrNode n)+{-# INLINE mkAttr #-} mkDTDElem :: DTDElem -> Attributes -> XmlTrees -> XmlTree mkDTDElem e al = mkTree (mkDTDNode e al)@@ -329,5 +448,53 @@ mergeAttrl :: XmlTrees -> XmlTrees -> XmlTrees mergeAttrl = foldr addAttr++-- ------------------------------------------------------------++-- | weak normalform versions of constructors++mkElement' :: QName -> XmlTrees -> XmlTrees -> XmlTree+mkElement' n al cl = id $!! mkElement n al cl+{-# INLINE mkElement' #-}++mkRoot' :: XmlTrees -> XmlTrees -> XmlTree+mkRoot' al cl = id $!! mkRoot al cl+{-# INLINE mkRoot' #-}++mkAttr' :: QName -> XmlTrees -> XmlTree+mkAttr' n av = id $!! mkAttr n av+{-# INLINE mkAttr' #-}++mkText' :: String -> XmlTree+mkText' t = id $!! mkText t+{-# INLINE mkText' #-}++mkCharRef' :: Int -> XmlTree+mkCharRef' i = id $!! mkCharRef i+{-# INLINE mkCharRef' #-}++mkEntityRef' :: String -> XmlTree+mkEntityRef' n = id $!! mkEntityRef n+{-# INLINE mkEntityRef' #-}++mkCmt' :: String -> XmlTree+mkCmt' c = id $!! mkCmt c+{-# INLINE mkCmt' #-}++mkCdata' :: String -> XmlTree+mkCdata' d = id $!! mkCdata d+{-# INLINE mkCdata' #-}++mkPi' :: QName -> XmlTrees -> XmlTree+mkPi' n v = id $!! mkPi n v+{-# INLINE mkPi' #-}++mkError' :: Int -> String -> XmlTree+mkError' l m = id $!! mkError l m+{-# INLINE mkError' #-}++mkDTDElem' :: DTDElem -> Attributes -> XmlTrees -> XmlTree+mkDTDElem' e al cl = id $!! mkDTDElem e al cl+{-# INLINE mkDTDElem' #-} -- ------------------------------------------------------------
src/Text/XML/HXT/DTDValidation/DocTransformation.hs view
@@ -82,9 +82,9 @@ traverseTree :: TransEnvTable -> XmlArrow traverseTree transEnv = processTopDown ( (transFct $< getName)- `when`- isElem- )+ `when`+ isElem+ ) where transFct :: String -> XmlArrow transFct name = fromMaybe this . M.lookup name $ transEnv
src/Text/XML/HXT/DTDValidation/Validation.hs view
@@ -26,6 +26,7 @@ module Text.XML.HXT.DTDValidation.Validation ( getDTDSubset+ , generalEntitiesDefined , validate , validateDTD , validateDoc@@ -126,5 +127,9 @@ >>> ( filterA $ isDTDDoctype >>> getDTDAttrl >>> isA (hasEntry a_name) ) +generalEntitiesDefined :: XmlArrow+generalEntitiesDefined = getDTDSubset+ >>>+ deep isDTDEntity -- ------------------------------------------------------------
src/Text/XML/HXT/IO/GetFILE.hs view
@@ -22,18 +22,11 @@ where -import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy as B import Network.URI ( unEscapeString ) -import System.IO ( IOMode(..)- , openBinaryFile- -- , getContents is defined in the prelude- , hGetContents- )- import System.IO.Error ( ioeGetErrorString , try )@@ -46,15 +39,14 @@ -- ------------------------------------------------------------ -getStdinCont :: Bool -> IO (Either ([(String, String)], String)- String)+getStdinCont :: Bool -> IO (Either ([(String, String)], String) B.ByteString) getStdinCont strictInput = do- c <- try ( if strictInput- then do- cb <- B.getContents- return (C.unpack cb)- else getContents+ c <- try ( do+ cb <- B.getContents+ if strictInput+ then B.length cb `seq` return cb+ else return cb ) return (either readErr Right c) where@@ -68,8 +60,7 @@ msg = "stdin read error: " ++ es es = ioeGetErrorString e -getCont :: Bool -> String -> IO (Either ([(String, String)], String)- String)+getCont :: Bool -> String -> IO (Either ([(String, String)], String) B.ByteString) getCont strictInput source = do -- preliminary source'' <- checkFile source'@@ -81,13 +72,11 @@ then return $ fileErr "file not readable" else do c <- try $+ do+ cb <- B.readFile fn if strictInput- then do- cb <- B.readFile fn- return (C.unpack cb)- else do- h <- openBinaryFile fn ReadMode- hGetContents h+ then B.length `seq` return cb+ else return cb return (either readErr Right c) where source' = drivePath $ source
src/Text/XML/HXT/Parser/HtmlParsec.hs view
@@ -33,84 +33,84 @@ where -import Text.XML.HXT.DOM.Interface--import Text.XML.HXT.DOM.XmlNode- ( mkText- , mkError- , mkCmt- , mkElement- , mkAttr- , mkDTDElem- )--import Text.ParserCombinators.Parsec- ( Parser- , SourcePos- , anyChar- , between- , char- , eof- , getPosition- , many- , noneOf- , option- , parse- , satisfy- , string- , try- , (<|>)- )--import Text.XML.HXT.Parser.XmlTokenParser- ( allBut- , dq- , eq- , gt- , name- , pubidLiteral- , skipS- , skipS0- , sq- , systemLiteral-- , singleCharsT- , referenceT- )--import Text.XML.HXT.Parser.XmlParsec- ( cDSect- , charData'- , misc- , parseXmlText- , pI- , xMLDecl'- )--import Text.XML.HXT.Parser.XmlCharParser- ( xmlChar- )+import Data.Char ( toLower+ , toUpper+ )+import Data.Char.Properties.XMLCharProps ( isXmlChar+ )+import Data.Maybe ( fromMaybe+ , fromJust+ )+import qualified Data.Map as M -import Data.Maybe- ( fromMaybe- )+import Text.ParserCombinators.Parsec ( SourcePos+ , anyChar+ , between+ -- , char+ , eof+ , getPosition+ , many+ , many1+ , noneOf+ , option+ , runParser+ , satisfy+ , string+ , try+ , (<|>)+ ) -import Data.Char- ( toLower- , toUpper- )+import Text.XML.HXT.DOM.Interface+import Text.XML.HXT.DOM.XmlNode ( mkText'+ , mkError'+ , mkCdata'+ , mkCmt'+ , mkCharRef'+ , mkElement'+ , mkAttr'+ , mkDTDElem'+ , mkPi'+ , isEntityRef+ , getEntityRef+ )+import Text.XML.HXT.Parser.XmlTokenParser ( allBut+ , amp+ , dq+ , eq+ , gt+ , lt+ , name+ , pubidLiteral+ , skipS+ , skipS0+ , sPace+ , sq+ , systemLiteral+ , checkString+ , singleCharsT+ , referenceT+ )+import Text.XML.HXT.Parser.XmlParsec ( misc+ , parseXmlText+ , xMLDecl'+ )+import Text.XML.HXT.Parser.XmlCharParser ( xmlChar+ , SimpleXParser+ , withNormNewline+ )+import Text.XML.HXT.Parser.XhtmlEntities ( xhtmlEntities+ ) -- ------------------------------------------------------------ -parseHtmlText :: String -> XmlTree -> XmlTrees-parseHtmlText loc t- = parseXmlText htmlDocument loc $ t+parseHtmlText :: String -> XmlTree -> XmlTrees+parseHtmlText loc t = parseXmlText htmlDocument (withNormNewline ()) loc $ t -- ------------------------------------------------------------ -parseHtmlFromString :: Parser XmlTrees -> String -> String -> XmlTrees+parseHtmlFromString :: SimpleXParser XmlTrees -> String -> String -> XmlTrees parseHtmlFromString parser loc- = either ((:[]) . mkError c_err . (++ "\n") . show) id . parse parser loc+ = either ((:[]) . mkError' c_err . (++ "\n") . show) id . runParser parser (withNormNewline ()) loc parseHtmlDocument :: String -> String -> XmlTrees parseHtmlDocument = parseHtmlFromString htmlDocument@@ -120,7 +120,15 @@ -- ------------------------------------------------------------ -htmlDocument :: Parser XmlTrees+type Context = (XmlTreeFl, OpenTags)++type XmlTreeFl = XmlTrees -> XmlTrees++type OpenTags = [(String, XmlTrees, XmlTreeFl)]++-- ------------------------------------------------------------++htmlDocument :: SimpleXParser XmlTrees htmlDocument = do pl <- htmlProlog@@ -128,7 +136,7 @@ eof return (pl ++ el) -htmlProlog :: Parser XmlTrees+htmlProlog :: SimpleXParser XmlTrees htmlProlog = do xml <- option []@@ -136,8 +144,8 @@ <|> ( do pos <- getPosition- _ <- try (string "<?")- return $ [mkError c_warn (show pos ++ " wrong XML declaration")]+ checkString "<?"+ return $ [mkError' c_warn (show pos ++ " wrong XML declaration")] ) ) misc1 <- many misc@@ -146,15 +154,15 @@ <|> ( do pos <- getPosition- _ <- try (upperCaseString "<!DOCTYPE")- return $ [mkError c_warn (show pos ++ " HTML DOCTYPE declaration ignored")]+ upperCaseString "<!DOCTYPE"+ return $ [mkError' c_warn (show pos ++ " HTML DOCTYPE declaration ignored")] ) ) return (xml ++ misc1 ++ dtdPart) -doctypedecl :: Parser XmlTrees+doctypedecl :: SimpleXParser XmlTrees doctypedecl- = between (try $ upperCaseString "<!DOCTYPE") (char '>')+ = between (upperCaseString "<!DOCTYPE") gt ( do skipS n <- name@@ -163,13 +171,13 @@ option [] externalID ) skipS0- return [mkDTDElem DOCTYPE ((a_name, n) : exId) []]+ return [mkDTDElem' DOCTYPE ((a_name, n) : exId) []] ) -externalID :: Parser Attributes+externalID :: SimpleXParser Attributes externalID = do- _ <- try (upperCaseString k_public)+ upperCaseString k_public skipS pl <- pubidLiteral sl <- option "" $ try ( do@@ -178,45 +186,45 @@ ) return $ (k_public, pl) : if null sl then [] else [(k_system, sl)] -htmlContent :: Parser XmlTrees+htmlContent :: SimpleXParser XmlTrees htmlContent = option [] ( do- context <- hContent ([], [])+ context <- hContent (id, []) pos <- getPosition return $ closeTags pos context ) where- closeTags _ (body, [])- = reverse body+ closeTags _pos (body, [])+ = body [] closeTags pos' (body, ((tn, al, body1) : restOpen))- = closeTags pos' (addHtmlWarn (show pos' ++ ": no closing tag found for \"<" ++ tn ++ " ...>\"")- .- addHtmlTag tn al body- $- (body1, restOpen)- )+ = closeTags pos'+ ( addHtmlWarn (show pos' ++ ": no closing tag found for \"<" ++ tn ++ " ...>\"")+ .+ addHtmlTag tn al body+ $+ (body1, restOpen)+ ) -type OpenTags = [(String, XmlTrees, XmlTrees)]-type Context = (XmlTrees, OpenTags)+-- ------------------------------------------------------------ -hElement :: Context -> Parser Context+hElement :: Context -> SimpleXParser Context hElement context = ( do t <- hSimpleData- return (addHtmlElems [t] context)+ return (addHtmlElem t context) ) <|>- hOpenTag context- <|> hCloseTag context <|>+ hOpenTag context+ <|> ( do -- wrong tag, take it as text pos <- getPosition c <- xmlChar return ( addHtmlWarn (show pos ++ " markup char " ++ show c ++ " not allowed in this context") .- addHtmlElems [mkText [c]]+ addHtmlElem (mkText' [c]) $ context )@@ -235,54 +243,57 @@ ) -hSimpleData :: Parser XmlTree+hSimpleData :: SimpleXParser XmlTree hSimpleData- = charData'+ = charData'' <|>- try referenceT+ hReference' <|>- try hComment+ hComment <|>- try pI+ hpI <|>- try cDSect+ hcDSect+ where+ charData''+ = do+ t <- many1 (satisfy (\ x -> isXmlChar x && not (x == '<' || x == '&')))+ return (mkText' t) -hCloseTag :: Context -> Parser Context+hCloseTag :: Context -> SimpleXParser Context hCloseTag context = do- n <- try ( do- _ <- string "</"- lowerCaseName- )+ checkString "</"+ n <- lowerCaseName skipS0 pos <- getPosition checkSymbol gt ("closing > in tag \"</" ++ n ++ "\" expected") (closeTag pos n context) -hOpenTag :: Context -> Parser Context+hOpenTag :: Context -> SimpleXParser Context hOpenTag context = ( do- pos <- getPosition e <- hOpenTagStart- hOpenTagRest pos e context+ hOpenTagRest e context ) -hOpenTagStart :: Parser (String, XmlTrees)+hOpenTagStart :: SimpleXParser ((SourcePos, String), XmlTrees) hOpenTagStart = do- n <- try ( do- _ <- char '<'- n <- lowerCaseName- return n- )+ np <- try ( do+ lt+ pos <- getPosition+ n <- lowerCaseName+ return (pos, n)+ ) skipS0 as <- hAttrList- return (n, as)+ return (np, as) -hOpenTagRest :: SourcePos -> (String, XmlTrees) -> Context -> Parser Context-hOpenTagRest pos (tn, al) context+hOpenTagRest :: ((SourcePos, String), XmlTrees) -> Context -> SimpleXParser Context+hOpenTagRest ((pos, tn), al) context = ( do- _ <- try $ string "/>"- return (addHtmlTag tn al [] context)+ checkString "/>"+ return (addHtmlTag tn al id context) ) <|> ( do@@ -290,13 +301,13 @@ return ( let context2 = closePrevTag pos tn context1 in ( if isEmptyHtmlTag tn- then addHtmlTag tn al []+ then addHtmlTag tn al id else openTag tn al ) context2 ) ) -hAttrList :: Parser XmlTrees+hAttrList :: SimpleXParser XmlTrees hAttrList = many (try hAttribute) where@@ -305,18 +316,14 @@ n <- lowerCaseName v <- hAttrValue skipS0- return $ mkAttr (mkName n) v+ return $ mkAttr' (mkName n) v -hAttrValue :: Parser XmlTrees+hAttrValue :: SimpleXParser XmlTrees hAttrValue = option []- ( try ( do- eq- hAttrValue'- )- )+ ( eq >> hAttrValue' ) -hAttrValue' :: Parser XmlTrees+hAttrValue' :: SimpleXParser XmlTrees hAttrValue' = try ( between dq dq (hAttrValue'' "&\"") ) <|>@@ -324,76 +331,157 @@ <|> ( do -- HTML allows unquoted attribute values cs <- many (noneOf " \r\t\n>\"\'")- return [mkText cs]+ return [mkText' cs] ) -hAttrValue'' :: String -> Parser XmlTrees+hAttrValue'' :: String -> SimpleXParser XmlTrees hAttrValue'' notAllowed = many ( hReference' <|> singleCharsT notAllowed) -hReference' :: Parser XmlTree+hReference' :: SimpleXParser XmlTree hReference'- = try referenceT+ = try hReferenceT <|> ( do- _ <- char '&'- return (mkText "&")+ amp+ return (mkText' "&") ) -hContent :: Context -> Parser Context+hReferenceT :: SimpleXParser XmlTree+hReferenceT+ = do+ r <- referenceT+ return ( if isEntityRef r+ then substRef r+ else r+ )+ where+ -- optimization: HTML entity refs are substituted by char refs, so a later entity ref substituion isn't required+ substRef r+ = case (lookup en xhtmlEntities) of+ Just i -> mkCharRef' i+ Nothing -> r -- not found: the entity ref remains as it is+ -- this is also done in the XML parser+{- alternative def+ Nothing -> mkText' ("&" ++ en ++ ";") -- not found: the entity ref is taken as text+-}+ where+ en = fromJust . getEntityRef $ r++hContent :: Context -> SimpleXParser Context hContent context = option context- ( do- context1 <- hElement context- hContent context1+ ( hElement context+ >>=+ hContent ) +-- ------------------------------------------------------------+ -- hComment allows "--" in comments -- comment from XML spec does not -hComment :: Parser XmlTree+hComment :: SimpleXParser XmlTree hComment = do- c <- between (try $ string "<!--") (string "-->") (allBut many "-->")- return (mkCmt c)+ checkString "<!--"+ pos <- getPosition+ c <- allBut many "-->"+ closeCmt pos c+ where+ closeCmt pos c+ = ( do+ checkString "-->"+ return (mkCmt' c)+ )+ <|>+ ( return $+ mkError' c_warn (show pos ++ " no closing comment sequence \"-->\" found")+ ) -checkSymbol :: Parser a -> String -> Context -> Parser Context-checkSymbol p msg context+-- ------------------------------------------------------------++hpI :: SimpleXParser XmlTree+hpI = checkString "<?"+ >>+ ( try ( do+ n <- name+ p <- sPace >> allBut many "?>"+ string "?>" >>+ return (mkPi' (mkName n) [mkAttr' (mkName a_value) [mkText' p]])+ )+ <|>+ ( do+ pos <- getPosition+ return $+ mkError' c_warn (show pos ++ " illegal PI found")+ )+ )++-- ------------------------------------------------------------++hcDSect :: SimpleXParser XmlTree+hcDSect = do+ checkString "<![CDATA[" pos <- getPosition- option (addHtmlWarn (show pos ++ " " ++ msg) context)- ( do- _ <- try p- return context- )+ t <- allBut many "]]>"+ closeCD pos t+ where+ closeCD pos t+ = ( do+ checkString "]]>"+ return (mkCdata' t)+ )+ <|>+ ( return $+ mkError' c_warn (show pos ++ " no closing CDATA sequence \"]]>\" found")+ ) -lowerCaseName :: Parser String+-- ------------------------------------------------------------++checkSymbol :: SimpleXParser () -> String -> Context -> SimpleXParser Context+checkSymbol p msg context+ = ( p+ >>+ return context+ )+ <|>+ ( do+ pos <- getPosition+ return $ addHtmlWarn (show pos ++ " " ++ msg) context+ )++lowerCaseName :: SimpleXParser String lowerCaseName = do n <- name return (map toLower n) -upperCaseString :: String -> Parser String-upperCaseString- = sequence . map (\ c -> satisfy (( == c) . toUpper))+upperCaseString :: String -> SimpleXParser ()+upperCaseString s+ = try (sequence (map (\ c -> satisfy (( == c) . toUpper)) s)) >> return () -- ------------------------------------------------------------ -addHtmlTag :: String -> XmlTrees -> XmlTrees -> Context -> Context-addHtmlTag tn al body (body1, openTags)- = ([mkElement (mkName tn) al (reverse body)] ++ body1, openTags)+addHtmlTag :: String -> XmlTrees -> XmlTreeFl -> Context -> Context+addHtmlTag tn al body context+ = e `seq`+ addHtmlElem e context+ where+ e = mkElement' (mkName tn) al (body []) addHtmlWarn :: String -> Context -> Context addHtmlWarn msg- = addHtmlElems [mkError c_warn msg]+ = addHtmlElem (mkError' c_warn msg) -addHtmlElems :: XmlTrees -> Context -> Context-addHtmlElems elems (body, openTags)- = (reverse elems ++ body, openTags)+addHtmlElem :: XmlTree -> Context -> Context+addHtmlElem elem' (body, openTags)+ = (body . (elem' :), openTags) openTag :: String -> XmlTrees -> Context -> Context openTag tn al (body, openTags)- = ([], (tn, al, body) : openTags)+ = (id, (tn, al, body) : openTags) closeTag :: SourcePos -> String -> Context -> Context closeTag pos n context@@ -402,7 +490,7 @@ | otherwise = addHtmlWarn (show pos ++ " no opening tag found for </" ++ n ++ ">") .- addHtmlTag n [] []+ addHtmlTag n [] id $ context where@@ -427,7 +515,7 @@ closePrevTag _pos _n context@(_body, []) = context closePrevTag pos n context@(body, (n1, al1, body1) : restOpen)- | n `closes` n1+ | n `closesHtmlTag` n1 = closePrevTag pos n ( addHtmlWarn (show pos ++ " tag \"<" ++ n1 ++ " ...>\" implicitly closed by opening tag \"<" ++ n ++ " ...>\"") .@@ -461,6 +549,7 @@ , "meta" , "param" ]+{-# INLINE emptyHtmlTags #-} isInnerHtmlTagOf :: String -> String -> Bool n `isInnerHtmlTagOf` tn@@ -487,11 +576,52 @@ ] ) -closesHtmlTag- , closes :: String -> String -> Bool+-- a bit more efficient implementation of closes +closesHtmlTag :: String -> String -> Bool+closesHtmlTag t t2+ = fromMaybe False . fmap ($ t) . M.lookup t2 $ closedByTable+{-# INLINE closesHtmlTag #-}++closedByTable :: M.Map String (String -> Bool)+closedByTable+ = M.fromList $+ [ ("a", (== "a"))+ , ("li", (== "li" ))+ , ("th", (`elem` ["th", "td", "tr"] ))+ , ("td", (`elem` ["th", "td", "tr"] ))+ , ("tr", (== "tr"))+ , ("dt", (`elem` ["dt", "dd"] ))+ , ("dd", (`elem` ["dt", "dd"] ))+ , ("p", (`elem` ["hr"+ , "h1", "h2", "h3", "h4", "h5", "h6", "dl", "ol", "ul", "table", "div", "p"] ))+ , ("colgroup", (`elem` ["colgroup", "thead", "tfoot", "tbody"] ))+ , ("form", (`elem` ["form"] ))+ , ("label", (`elem` ["label"] ))+ , ("map", (`elem` ["map"] ))+ , ("option", const True)+ , ("script", const True)+ , ("style", const True)+ , ("textarea", const True)+ , ("title", const True)+ , ("select", ( /= "option"))+ , ("thead", (`elem` ["tfoot","tbody"] ))+ , ("tbody", (== "tbody" ))+ , ("tfoot", (== "tbody" ))+ , ("h1", (`elem` ["h1", "h2", "h3", "h4", "h5", "h6", "dl", "ol", "ul", "table", "div", "p"] ))+ , ("h2", (`elem` ["h1", "h2", "h3", "h4", "h5", "h6", "dl", "ol", "ul", "table", "div", "p"] ))+ , ("h3", (`elem` ["h1", "h2", "h3", "h4", "h5", "h6", "dl", "ol", "ul", "table", "div", "p"] ))+ , ("h4", (`elem` ["h1", "h2", "h3", "h4", "h5", "h6", "dl", "ol", "ul", "table", "div", "p"] ))+ , ("h5", (`elem` ["h1", "h2", "h3", "h4", "h5", "h6", "dl", "ol", "ul", "table", "div", "p"] ))+ , ("h6", (`elem` ["h1", "h2", "h3", "h4", "h5", "h6", "dl", "ol", "ul", "table", "div", "p"] ))+ ]++{-+closesHtmlTag :: String -> String -> Bool closesHtmlTag = closes +closes :: String -> String -> Bool+ "a" `closes` "a" = True "li" `closes` "li" = True "th" `closes` t | t `elem` ["th","td"] = True@@ -533,5 +663,6 @@ ,"p" -- not "div" ] = True _ `closes` _ = False+-} -- ------------------------------------------------------------
src/Text/XML/HXT/Parser/XmlCharParser.hs view
@@ -15,30 +15,53 @@ -- ------------------------------------------------------------ module Text.XML.HXT.Parser.XmlCharParser- ( xmlChar -- xml char parsers+ ( XParser+ , SimpleXParser+ , XPState(..)+ , withNormNewline+ , withoutNormNewline++ , xmlChar -- xml char parsers , xmlNameChar , xmlNameStartChar , xmlNCNameChar , xmlNCNameStartChar , xmlLetter , xmlSpaceChar+ , xmlCRLFChar ) where -import Data.Char.Properties.XMLCharProps( isXmlChar- , isXmlNameChar- , isXmlNameStartChar- , isXmlNCNameChar- , isXmlNCNameStartChar- , isXmlLetter- , isXmlSpaceChar- )+import Data.Char.Properties.XMLCharProps ( isXmlCharCR+ , isXmlNameChar+ , isXmlNameStartChar+ , isXmlNCNameChar+ , isXmlNCNameStartChar+ , isXmlLetter+ , isXmlSpaceCharCR+ ) import Data.String.Unicode import Text.ParserCombinators.Parsec -- ------------------------------------------------------------++type XParser s a = GenParser Char (XPState s) a+type SimpleXParser a = XParser () a++data XPState s = XPState+ { xps_normalizeNewline :: ! Bool+ , xps_userState :: s+ }++withNormNewline :: a -> XPState a+withNormNewline x = XPState True x++withoutNormNewline :: a -> XPState a+withoutNormNewline x = XPState False x++-- ------------------------------------------------------------ -- -- Char (2.2) --@@ -46,50 +69,77 @@ -- | -- parse a single Unicode character -xmlChar :: GenParser Char state Unicode-xmlChar = satisfy isXmlChar <?> "legal XML character"+xmlChar :: XParser s Unicode+xmlChar = ( satisfy isXmlCharCR+ <|>+ xmlCRLFChar+ )+ <?> "legal XML character"+{-# INLINE xmlChar #-} -- | -- parse a XML name character -xmlNameChar :: GenParser Char state Unicode+xmlNameChar :: XParser s Unicode xmlNameChar = satisfy isXmlNameChar <?> "legal XML name character"+{-# INLINE xmlNameChar #-} -- | -- parse a XML name start character -xmlNameStartChar :: GenParser Char state Unicode+xmlNameStartChar :: XParser s Unicode xmlNameStartChar = satisfy isXmlNameStartChar <?> "legal XML name start character"+{-# INLINE xmlNameStartChar #-} -- | -- parse a XML NCName character -xmlNCNameChar :: GenParser Char state Unicode+xmlNCNameChar :: XParser s Unicode xmlNCNameChar = satisfy isXmlNCNameChar <?> "legal XML NCName character"+{-# INLINE xmlNCNameChar #-} -- | -- parse a XML NCName start character -xmlNCNameStartChar :: GenParser Char state Unicode+xmlNCNameStartChar :: XParser s Unicode xmlNCNameStartChar = satisfy isXmlNCNameStartChar <?> "legal XML NCName start character"+{-# INLINE xmlNCNameStartChar #-} -- | -- parse a XML letter character -xmlLetter :: GenParser Char state Unicode+xmlLetter :: XParser s Unicode xmlLetter = satisfy isXmlLetter <?> "legal XML letter"+{-# INLINE xmlLetter #-} -- | -- White Space (2.3) --+-- end of line handling (2.11) will be done before or with 'xmlCRLFChar' parser++xmlSpaceChar :: XParser s Char+xmlSpaceChar = ( satisfy isXmlSpaceCharCR+ <|>+ xmlCRLFChar+ )+ <?> "white space"+{-# INLINE xmlSpaceChar #-}++-- |+-- White Space Normalization+-- -- end of line handling (2.11) -- \#x0D and \#x0D\#x0A are mapped to \#x0A--- is done in XmlInput before parsing--- otherwise \#x0D in internal parsing, e.g. for entities would normalize,--- would be transformed -xmlSpaceChar :: GenParser Char state Char-xmlSpaceChar = satisfy isXmlSpaceChar <?> "white space"+xmlCRLFChar :: XParser s Char+xmlCRLFChar = ( do+ _ <- char '\r'+ s <- getState+ if xps_normalizeNewline s+ then option '\n' (char '\n')+ else return '\r'+ )+ <?> "newline" -- ------------------------------------------------------------
src/Text/XML/HXT/Parser/XmlDTDParser.hs view
@@ -33,27 +33,33 @@ import Text.XML.HXT.DOM.Interface -- import Text.XML.HXT.DOM.ShowXml ( xshow )-import Text.XML.HXT.DOM.XmlNode- ( mkDTDElem- , mkText- , mkError- , isText- , isDTD- , getText- , getDTDPart- , getDTDAttrl- , getChildren- , setChildren- )+import Text.XML.HXT.DOM.XmlNode ( mkDTDElem'+ , mkText'+ , mkError'+ , isText+ , isDTD+ , getText+ , getDTDPart+ , getDTDAttrl+ , getChildren+ , setChildren+ ) import qualified Text.XML.HXT.Parser.XmlTokenParser as XT-import qualified Text.XML.HXT.Parser.XmlCharParser as XC ( xmlSpaceChar )-import qualified Text.XML.HXT.Parser.XmlDTDTokenParser as XD ( dtdToken ) +import Text.XML.HXT.Parser.XmlCharParser ( XParser+ , XPState(..)+ , withoutNormNewline+ )++import qualified Text.XML.HXT.Parser.XmlCharParser as XC+ ( xmlSpaceChar )++import qualified Text.XML.HXT.Parser.XmlDTDTokenParser as XD+ ( dtdToken )+ ----------------------------------------------------------- -- -- all parsers dealing with whitespace will be redefined@@ -61,21 +67,25 @@ type LocalState = (Int, [(Int, String, SourcePos)]) -type SParser a = GenParser Char LocalState a+type SParser a = XParser LocalState a -initialLocalState :: SourcePos -> LocalState-initialLocalState p = (0, [(0, sourceName p, p)])+initialState :: SourcePos -> XPState LocalState+initialState p = withoutNormNewline (0, [(0, sourceName p, p)]) +updateLocalState :: (LocalState -> LocalState) -> SParser ()+updateLocalState upd+ = updateState $ \ xps -> xps { xps_userState = upd $ xps_userState xps }+ pushPar :: String -> SParser () pushPar n = do p <- getPosition- updateState (\ (i, s) -> (i+1, (i+1, n, p) : s))+ updateLocalState (\ (i, s) -> (i+1, (i+1, n, p) : s)) setPosition ( newPos (sourceName p ++ " (line " ++ show (sourceLine p) ++ ", column " ++ show (sourceColumn p) ++ ") in content of parameter entity ref %" ++ n ++ ";") 1 1) popPar :: SParser () popPar = do oldPos <- getPos- updateState pop+ updateLocalState pop setPosition oldPos where pop (i, [(_, s, p)]) = (i+1, [(i+1, s, p)]) -- if param entity substitution is correctly implemented, this case does not occur@@ -84,12 +94,14 @@ getParNo :: SParser Int getParNo = do- (_i, (top, _n, _p) : _s) <- getState+ s <- getState+ let (_i, (top, _n, _p) : _s) = xps_userState s return top getPos :: SParser SourcePos getPos = do- (_i, (_top, _n, p) : _s) <- getState+ s <- getState+ let (_i, (_top, _n, p) : _s) = xps_userState s return p delPE :: SParser ()@@ -129,8 +141,8 @@ -- ------------------------------------------------------------ xmlSpaceChar :: SParser ()-xmlSpaceChar = ( do- _ <- XC.xmlSpaceChar+xmlSpaceChar = ( XC.xmlSpaceChar+ >> return () ) <|>@@ -141,27 +153,27 @@ skipS :: SParser () skipS- = do- skipMany1 xmlSpaceChar+ = skipMany1 xmlSpaceChar+ >> return () skipS0 :: SParser () skipS0- = do- skipMany xmlSpaceChar+ = skipMany xmlSpaceChar+ >> return () name :: SParser XmlTree name = do n <- XT.name- return (mkDTDElem NAME [(a_name, n)] [])+ return (mkDTDElem' NAME [(a_name, n)] []) nmtoken :: SParser XmlTree nmtoken = do n <- XT.nmtoken- return (mkDTDElem NAME [(a_name, n)] [])+ return (mkDTDElem' NAME [(a_name, n)] []) -- ------------------------------------------------------------ --@@ -179,7 +191,7 @@ skipS (al, cl) <- contentspec skipS0- return [mkDTDElem ELEMENT ((a_name, n) : al) cl]+ return [mkDTDElem' ELEMENT ((a_name, n) : al) cl] contentspec :: SParser (Attributes, XmlTrees) contentspec@@ -206,7 +218,7 @@ = ( do (al, cl) <- choiceOrSeq modifier <- optOrRep- return ([(a_type, v_children)], [mkDTDElem CONTENT (modifier ++ al) cl])+ return ([(a_type, v_children)], [mkDTDElem' CONTENT (modifier ++ al) cl]) ) <?> "element content" @@ -261,14 +273,14 @@ m <- optOrRep return ( case m of [(_, "")] -> n- _ -> mkDTDElem CONTENT (m ++ [(a_kind, v_seq)]) [n]+ _ -> mkDTDElem' CONTENT (m ++ [(a_kind, v_seq)]) [n] ) ) <|> ( do (al, cl) <- choiceOrSeq m <- optOrRep- return (mkDTDElem CONTENT (m ++ al) cl)+ return (mkDTDElem' CONTENT (m ++ al) cl) ) -- ------------------------------------------------------------@@ -296,7 +308,7 @@ else do _ <- char '*' <?> "closing parent for mixed content (\")*\")" return ( [ (a_type, v_mixed) ]- , [ mkDTDElem CONTENT [ (a_modifier, "*")+ , [ mkDTDElem' CONTENT [ (a_modifier, "*") , (a_kind, v_choice) ] nl ]@@ -322,7 +334,7 @@ return (map (mkDTree n) al) where mkDTree n' (al, cl)- = mkDTDElem ATTLIST ((a_name, n') : al) cl+ = mkDTDElem' ATTLIST ((a_name, n') : al) cl attDef :: SParser (Attributes, XmlTrees) attDef@@ -426,7 +438,7 @@ skipS (al, cl) <- entityDef skipS0- return [mkDTDElem ENTITY ((a_name, n) : al) cl]+ return [mkDTDElem' ENTITY ((a_name, n) : al) cl] entityDef :: SParser (Attributes, XmlTrees) entityDef@@ -450,7 +462,7 @@ skipS (al, cs) <- peDef skipS0- return [mkDTDElem PENTITY ((a_name, n) : al) cs]+ return [mkDTDElem' PENTITY ((a_name, n) : al) cs] peDef :: SParser (Attributes, XmlTrees) peDef@@ -460,7 +472,7 @@ al <- externalID return (al, []) -entityValue :: GenParser Char state (Attributes, XmlTrees)+entityValue :: XParser s (Attributes, XmlTrees) entityValue = do v <- XT.entityValueT@@ -520,7 +532,7 @@ publicID ) skipS0- return [mkDTDElem NOTATION ((a_name, n) : eid) []]+ return [mkDTDElem' NOTATION ((a_name, n) : eid) []] publicID :: SParser Attributes publicID@@ -540,7 +552,7 @@ skipS0 let n' = stringToUpper n if n' `elem` [k_include, k_ignore]- then return [mkText n']+ then return [mkText' n'] else fail $ "INCLUDE or IGNORE expected in conditional section" -- ------------------------------------------------------------@@ -579,13 +591,13 @@ parseXmlDTDEntityValue t -- (NTree (XDTD PEREF al) cl) | isDTDPEref t = ( either- ( (:[]) . mkError c_err . (++ "\n") . show )+ ( (:[]) . mkError' c_err . (++ "\n") . show ) ( \cl' -> if null cl'- then [mkText ""]+ then [mkText' ""] else cl' ) .- parse parser source+ runParser parser (withoutNormNewline ()) source ) input | otherwise = []@@ -608,10 +620,10 @@ = ( (:[]) . either- ( mkError c_err . (++ "\n") . show )+ ( mkError' c_err . (++ "\n") . show ) ( flip setChildren $ t ) -- \ cl' -> setChildren cl' t) .- parse parser source+ runParser parser (withoutNormNewline ()) source ) input | otherwise = []@@ -640,9 +652,9 @@ parseXmlDTDdecl :: XmlTree -> XmlTrees parseXmlDTDdecl t -- (NTree (XDTD dtdElem al) cl) | isDTD t- = ( either ((:[]) . mkError c_err . (++ "\n") . show) id+ = ( either ((:[]) . mkError' c_err . (++ "\n") . show) id .- runParser parser (initialLocalState pos) source+ runParser parser (initialState pos) source ) input | otherwise = []
src/Text/XML/HXT/Parser/XmlDTDTokenParser.hs view
@@ -20,24 +20,25 @@ import Text.ParserCombinators.Parsec import Text.XML.HXT.DOM.Interface-import Text.XML.HXT.DOM.XmlNode ( mkDTDElem- , mkText+import Text.XML.HXT.DOM.XmlNode ( mkDTDElem'+ , mkText' ) import qualified Text.XML.HXT.Parser.XmlTokenParser as XT+import Text.XML.HXT.Parser.XmlCharParser ( XParser ) -- ------------------------------------------------------------ -- -- DTD declaration tokenizer -dtdDeclTokenizer :: GenParser Char state XmlTree+dtdDeclTokenizer :: XParser s XmlTree dtdDeclTokenizer = do (dcl, al) <- dtdDeclStart content <- many1 dtdToken dtdDeclEnd- return $! mkDTDElem dcl al content+ return $ mkDTDElem' dcl al content -dtdDeclStart :: GenParser Char state (DTDElem, Attributes)+dtdDeclStart :: XParser s (DTDElem, Attributes) dtdDeclStart = foldr1 (<|>) $ map (uncurry dtdStart) $@@ -47,7 +48,7 @@ , ("NOTATION", NOTATION) ] where- dtdStart :: String -> DTDElem -> GenParser Char state (DTDElem, Attributes)+ dtdStart :: String -> DTDElem -> XParser s (DTDElem, Attributes) dtdStart dcl element = try ( do _ <- string "<!"@@ -60,45 +61,45 @@ ) ) -dtdDeclEnd :: GenParser Char state ()+dtdDeclEnd :: XParser s () dtdDeclEnd = do _ <- XT.gt return () -dtdToken :: GenParser Char state XmlTree+dtdToken :: XParser s XmlTree dtdToken = dtdChars <|>- attrValue+ entityValue <|> try peReference -- first try parameter entity ref %xxx; <|> percent -- else % may be indicator for parameter entity declaration <?> "DTD token" -peReference :: GenParser Char state XmlTree+peReference :: XParser s XmlTree peReference = do r <- XT.peReference- return $! (mkDTDElem PEREF [(a_peref, r)] [])+ return $! (mkDTDElem' PEREF [(a_peref, r)] []) -attrValue :: GenParser Char state XmlTree-attrValue+entityValue :: XParser s XmlTree+entityValue = do- v <- XT.attrValue- return $! mkText v+ v <- XT.entityValue+ return $ mkText' v -dtdChars :: GenParser Char state XmlTree+dtdChars :: XParser s XmlTree dtdChars = do v <- many1 (XT.singleChar "%\"'<>[]") -- everything except string constants, < and >, [ and ] (for cond sections)- return $! mkText v -- all illegal chars will be detected later during declaration parsing+ return $ mkText' v -- all illegal chars will be detected later during declaration parsing -percent :: GenParser Char state XmlTree+percent :: XParser s XmlTree percent = do c <- char '%'- return $! mkText [c]+ return $ mkText' [c] -- ------------------------------------------------------------
src/Text/XML/HXT/Parser/XmlParsec.hs view
@@ -38,14 +38,15 @@ , encodingDecl , xread - , parseXmlAttrValue , parseXmlContent , parseXmlDocEncodingSpec , parseXmlDocument , parseXmlDTDPart , parseXmlEncodingSpec , parseXmlEntityEncodingSpec- , parseXmlGeneralEntityValue+ , parseXmlEntityValueAsAttrValue+ , parseXmlEntityValueAsContent+ , parseXmlPart , parseXmlText @@ -56,103 +57,121 @@ ) where -import Text.ParserCombinators.Parsec- ( GenParser- , Parser- , parse- , (<?>), (<|>)- , char- , string- , eof- , between- , many, many1- , option- , try- , unexpected- , getPosition- , getInput- , sourceName- )--import Text.XML.HXT.DOM.ShowXml- ( xshow- )+import Text.ParserCombinators.Parsec ( runParser+ , (<?>), (<|>)+ , char+ , string+ , eof+ , between+ , many+ , many1+ , notFollowedBy+ , option+ , try+ , unexpected+ , getPosition+ , getInput+ , sourceName+ ) +import Text.XML.HXT.DOM.ShowXml ( xshow+ ) import Text.XML.HXT.DOM.Interface--import Text.XML.HXT.DOM.XmlNode- ( mkElement- , mkAttr- , mkRoot- , mkDTDElem- , mkText- , mkCmt- , mkCdata- , mkError- , mkPi- , isText- , isRoot- , getText- , getChildren- , getAttrl- , getAttrName- , changeAttrl- , mergeAttrl- )--import Text.XML.HXT.Parser.XmlCharParser- ( xmlChar- )+import Text.XML.HXT.DOM.XmlNode ( mkElement'+ , mkAttr'+ , mkRoot'+ , mkDTDElem'+ , mkText'+ , mkCmt'+ , mkCdata'+ , mkError'+ , mkPi'+ , isText+ , isRoot+ , getText+ , getChildren+ , getAttrl+ , getAttrName+ , changeAttrl+ , mergeAttrl+ )+import Text.XML.HXT.Parser.XmlCharParser ( xmlChar+ , XParser+ , SimpleXParser+ , XPState+ , withNormNewline+ , withoutNormNewline+ ) import qualified Text.XML.HXT.Parser.XmlTokenParser as XT import qualified Text.XML.HXT.Parser.XmlDTDTokenParser as XD -import Data.Char (toLower)+import Control.FlatSeq++import Data.Char (toLower) import Data.Maybe +-- import Debug.Trace+ -- ------------------------------------------------------------ -- -- Character Data (2.4) -charData :: GenParser Char state XmlTrees+charData :: XParser s XmlTrees charData = many (charData' <|> XT.referenceT) -charData' :: GenParser Char state XmlTree+charData' :: XParser s XmlTree charData'- = try ( do- t <- XT.allBut1 many1 (\ c -> not (c `elem` "<&")) "]]>"- return (mkText $! t)- )+ = do+ t <- XT.allBut1 many1 (\ c -> not (c `elem` "<&")) "]]>"+ return (mkText' t) -- ------------------------------------------------------------ -- -- Comments (2.5) -comment :: GenParser Char state XmlTree-+comment :: XParser s XmlTree comment+ = comment'' $ XT.checkString "<!--"++-- the leading <! is already parsed++comment' :: XParser s XmlTree+comment'+ = comment'' (string "--" >> return ())++comment'' :: XParser s () -> XParser s XmlTree+comment'' op = ( do- c <- between (try $ string "<!--") (string "-->") (XT.allBut many "--")- return (mkCmt $! c)+ c <- between op (string ("-->")) (XT.allBut many "--")+ return (mkCmt' c) ) <?> "comment" -- ------------------------------------------------------------ -- -- Processing Instructions -pI :: GenParser Char state XmlTree-pI- = between (try $ string "<?") (string "?>")+pI :: XParser s XmlTree+pI = pI'' $ XT.checkString "<?"++-- the leading < is already parsed++pI' :: XParser s XmlTree+pI' = pI'' (char '?' >> return ())++pI'' :: XParser s () -> XParser s XmlTree+pI'' op+ = between op (string "?>") ( do n <- pITarget- p <- option "" (do- _ <- XT.sPace+ p <- option "" (XT.sPace+ >> XT.allBut many "?>" )- return $ mkPi (mkName n) [mkAttr (mkName a_value) [mkText p]]+ return (mkPi' (mkName n) [mkAttr' (mkName a_value) [mkText' p]]) ) <?> "processing instruction" where- pITarget :: GenParser Char state String+ pITarget :: XParser s String pITarget = ( do n <- XT.name if map toLower n == t_xml@@ -164,28 +183,38 @@ -- -- CDATA Sections (2.7) -cDSect :: GenParser Char state XmlTree-+cDSect :: XParser s XmlTree cDSect+ = cDSect'' $ XT.checkString "<![CDATA["++-- the leading <! is already parsed, no try neccessary++cDSect' :: XParser s XmlTree+cDSect' + = cDSect'' (string "[CDATA[" >> return ())++cDSect'' :: XParser s () -> XParser s XmlTree+cDSect'' op = do- t <- between ( try $ string "<![CDATA[") (string "]]>") (XT.allBut many "]]>")- return (mkCdata $! t)+ t <- between op (string "]]>") (XT.allBut many "]]>")+ return (mkCdata' t) <?> "CDATA section" -- ------------------------------------------------------------ -- -- Document (2.1) and Prolog (2.8) -document :: GenParser Char state XmlTree+document :: XParser s XmlTree document = do pos <- getPosition dl <- document'- return $ mkRoot [ mkAttr (mkName a_source) [mkText (sourceName pos)]- , mkAttr (mkName a_status) [mkText (show c_ok)]+ return (mkRoot' [ mkAttr' (mkName a_source) [mkText' (sourceName pos)]+ , mkAttr' (mkName a_status) [mkText' (show c_ok)] ] dl+ ) -document' :: GenParser Char state XmlTrees+document' :: XParser s XmlTrees document' = do pl <- prolog@@ -194,7 +223,7 @@ eof return (pl ++ [el] ++ ml) -prolog :: GenParser Char state XmlTrees+prolog :: XParser s XmlTrees prolog = do xml <- option [] xMLDecl'@@ -203,7 +232,7 @@ misc2 <- many misc return (xml ++ misc1 ++ dtdPart ++ misc2) -xMLDecl :: GenParser Char state XmlTrees+xMLDecl :: XParser s XmlTrees xMLDecl = between (try $ string "<?xml") (string "?>") ( do@@ -215,32 +244,34 @@ ) <?> "xml declaration" -xMLDecl' :: GenParser Char state XmlTrees+xMLDecl' :: XParser s XmlTrees xMLDecl' = do al <- xMLDecl- return [mkPi (mkName t_xml) al]+ return [mkPi' (mkName t_xml) al] -xMLDecl'' :: GenParser Char state XmlTree+xMLDecl'' :: XParser s XmlTree xMLDecl'' = do al <- option [] (try xMLDecl)- return (mkRoot al [])+ return (mkRoot' al []) -versionInfo :: GenParser Char state XmlTrees+versionInfo :: XParser s XmlTrees versionInfo = ( do- _ <- try ( do- XT.skipS- XT.keyword a_version- )+ try ( XT.skipS+ >>+ XT.keyword a_version+ >>+ return ()+ ) XT.eq vi <- XT.quoted XT.versionNum- return [mkAttr (mkName a_version) [mkText vi]]+ return [mkAttr' (mkName a_version) [mkText' vi]] ) <?> "version info (with quoted version number)" -misc :: GenParser Char state XmlTree+misc :: XParser s XmlTree misc = comment <|>@@ -248,7 +279,7 @@ <|> ( ( do ws <- XT.sPace- return (mkText ws)+ return (mkText' ws) ) <?> "" ) @@ -256,7 +287,7 @@ -- -- Document Type definition (2.8) -doctypedecl :: GenParser Char state XmlTrees+doctypedecl :: XParser s XmlTrees doctypedecl = between (try $ string "<!DOCTYPE") (char '>') ( do@@ -274,10 +305,10 @@ XT.skipS0 return m )- return [mkDTDElem DOCTYPE ((a_name, n) : exId) markup]+ return [mkDTDElem' DOCTYPE ((a_name, n) : exId) markup] ) -markupOrDeclSep :: GenParser Char state XmlTrees+markupOrDeclSep :: XParser s XmlTrees markupOrDeclSep = ( do ll <- many ( markupdecl@@ -289,7 +320,7 @@ return (concat ll) ) -declSep :: GenParser Char state XmlTrees+declSep :: XParser s XmlTrees declSep = XT.mkList XT.peReferenceT <|>@@ -298,7 +329,7 @@ return [] ) -markupdecl :: GenParser Char state XmlTrees+markupdecl :: XParser s XmlTrees markupdecl = XT.mkList ( pI@@ -312,41 +343,44 @@ -- -- Standalone Document Declaration (2.9) -sDDecl :: GenParser Char state XmlTrees+sDDecl :: XParser s XmlTrees sDDecl = do- _ <- try (do- XT.skipS- XT.keyword a_standalone- )+ try ( XT.skipS+ >>+ XT.keyword a_standalone+ >>+ return ()+ ) XT.eq sd <- XT.quoted (XT.keywords [v_yes, v_no])- return [mkAttr (mkName a_standalone) [mkText sd]]+ return [mkAttr' (mkName a_standalone) [mkText' sd]] -- ------------------------------------------------------------ -- -- element, tags and content (3, 3.1) -element :: GenParser Char state XmlTree+element :: XParser s XmlTree element+ = char '<'+ >>+ element'++element' :: XParser s XmlTree+element' = ( do e <- elementStart- elementRest e+ rwnf e `seq` elementRest e -- evaluate name and attribute list before parsing contents ) <?> "element" -elementStart :: GenParser Char state (String, [(String, XmlTrees)])++elementStart :: XParser s (QName, XmlTrees) elementStart = do- n <- ( try ( do- _ <- char '<'- n <- XT.name- return n- )- <?> "start tag"- )- ass <- attrList+ n <- XT.name+ al <- attrList XT.skipS0- return (n, ass)+ return (mkName n, al) where attrList = option [] ( do@@ -357,49 +391,53 @@ = option [] ( do a1 <- attribute al <- attrList- let (n, _v) = a1- if isJust . lookup n $ al- then unexpected ("attribute name " ++ show n ++ " occurs twice in attribute list")+ let n = fromJust . getAttrName $ a1+ if n `elem` map (fromJust . getAttrName) al+ then unexpected+ ( "attribute name " +++ show (qualifiedName n) +++ " occurs twice in attribute list"+ ) else return (a1 : al) ) -elementRest :: (String, [(String, XmlTrees)]) -> GenParser Char state XmlTree+elementRest :: (QName, XmlTrees) -> XParser s XmlTree elementRest (n, al) = ( do- _ <- try $ string "/>"- return $! (mkElement (mkName n) (map (mkA $!) al) [])+ XT.checkString "/>"+ return $ mkElement' n al [] ) <|> ( do- _ <- XT.gt+ XT.gt c <- content eTag n- return $! (mkElement (mkName n) (map (mkA $!) al) $! c)+ return $ mkElement' n al c ) <?> "proper attribute list followed by \"/>\" or \">\""- where- mkA (n', ts') = mkAttr (mkName n') ts' -eTag :: String -> GenParser Char state ()+eTag :: QName -> XParser s () eTag n' = do- _ <- try ( string "</" ) <?> ""+ XT.checkString "</" <?> "" n <- XT.name XT.skipS0- _ <- XT.gt- if n == n'+ XT.gt+ if n == qualifiedName n' then return ()- else unexpected ("illegal end tag </" ++ n ++ "> found, </" ++ n' ++ "> expected")+ else unexpected ("illegal end tag </" ++ n ++ "> found, </" ++ qualifiedName n' ++ "> expected") -attribute :: GenParser Char state (String, XmlTrees)+attribute :: XParser s XmlTree attribute = do n <- XT.name XT.eq v <- XT.attrValueT- return (n, v)+ return $ mkAttr' (mkName n) v -content :: GenParser Char state XmlTrees+{- this parser corresponds to the XML spec but it's inefficent because of more than 1 char lookahead++content :: XParser s XmlTrees content = do c1 <- charData@@ -417,11 +455,45 @@ return (l : c) ) return (c1 ++ concat cl)+-} -contentWithTextDecl :: GenParser Char state XmlTrees+-- this simpler content parser does not need more than a single lookahead+-- so no try parsers (inefficient) are neccessary++content :: XParser s XmlTrees+content+ = many $+ ( do -- parse markup but no closing tags+ try ( XT.lt+ >>+ notFollowedBy (char '/')+ >>+ return ()+ )+ markup+ )+ <|>+ charData'+ <|>+ XT.referenceT+ where+ markup+ = element'+ <|>+ pI'+ <|>+ ( char '!'+ >>+ ( comment'+ <|>+ cDSect'+ )+ )++contentWithTextDecl :: XParser s XmlTrees contentWithTextDecl- = do- _ <- option [] textDecl+ = option [] textDecl+ >> content -- ------------------------------------------------------------@@ -432,25 +504,25 @@ -- first the whole content is detected, -- and then, after PE substitution include sections are parsed again -conditionalSect :: GenParser Char state XmlTree+conditionalSect :: XParser s XmlTree conditionalSect = do- _ <- try $ string "<!["+ XT.checkString "<![" cs <- many XD.dtdToken _ <- char '[' sect <- condSectCont- return (mkDTDElem CONDSECT [(a_value, sect)] cs)+ return (mkDTDElem' CONDSECT [(a_value, sect)] cs) where - condSectCont :: GenParser Char state String+ condSectCont :: XParser s String condSectCont- = ( do- _ <- try $ string "]]>"+ = ( XT.checkString "]]>"+ >> return "" ) <|> ( do- _ <- try $ string "<!["+ XT.checkString "<![" cs1 <- condSectCont cs2 <- condSectCont return ("<![" ++ cs1 ++ "]]>" ++ cs2)@@ -466,7 +538,7 @@ -- -- External Entities (4.2.2) -externalID :: GenParser Char state Attributes+externalID :: XParser s Attributes externalID = ( do _ <- XT.keyword k_system@@ -490,7 +562,7 @@ -- -- Text Declaration (4.3.1) -textDecl :: GenParser Char state XmlTrees+textDecl :: XParser s XmlTrees textDecl = between (try $ string "<?xml") (string "?>") ( do@@ -502,26 +574,28 @@ <?> "text declaration" -textDecl'' :: GenParser Char state XmlTree+textDecl'' :: XParser s XmlTree textDecl'' = do al <- option [] (try textDecl)- return (mkRoot al [])+ return (mkRoot' al []) -- ------------------------------------------------------------ -- -- Encoding Declaration (4.3.3) -encodingDecl :: GenParser Char state XmlTrees+encodingDecl :: XParser s XmlTrees encodingDecl = do- _ <- try ( do- XT.skipS- XT.keyword a_encoding- )+ try ( XT.skipS+ >>+ XT.keyword a_encoding+ >>+ return ()+ ) XT.eq ed <- XT.quoted XT.encName- return [mkAttr (mkName a_encoding) [mkText ed]]+ return [mkAttr' (mkName a_encoding) [mkText' ed]] -- ------------------------------------------------------------ --@@ -540,7 +614,7 @@ xread :: String -> XmlTrees xread str- = parseXmlFromString parser loc str+ = parseXmlFromString parser (withNormNewline ()) loc str where loc = "string: " ++ show (if length str > 40 then take 40 str ++ "..." else str) parser = do@@ -559,16 +633,16 @@ -- a more general version of 'parseXmlContent'. -- The parser to be used and the context are extra parameter -parseXmlText :: Parser XmlTrees -> String -> XmlTree -> XmlTrees-parseXmlText p loc = parseXmlFromString p loc . xshow . (:[])+parseXmlText :: SimpleXParser XmlTrees -> XPState () -> String -> XmlTree -> XmlTrees+parseXmlText p s0 loc = parseXmlFromString p s0 loc . xshow . (:[]) parseXmlDocument :: String -> String -> XmlTrees-parseXmlDocument = parseXmlFromString document'-+parseXmlDocument = parseXmlFromString document' (withNormNewline ()) -parseXmlFromString :: Parser XmlTrees -> String -> String -> XmlTrees-parseXmlFromString parser loc- = either ((:[]) . mkError c_err . (++ "\n") . show) id . parse parser loc+parseXmlFromString :: SimpleXParser XmlTrees -> XPState () -> String -> String -> XmlTrees+parseXmlFromString parser s0 loc+ = either ((:[]) . mkError' c_err . (++ "\n") . show) id+ . runParser parser s0 loc -- ------------------------------------------------------------ --@@ -576,17 +650,17 @@ removeEncodingSpec :: XmlTree -> XmlTrees removeEncodingSpec t | isText t- = ( either ((:[]) . mkError c_err . (++ "\n") . show) ((:[]) . mkText)- . parse parser "remove encoding spec"+ = ( either ((:[]) . mkError' c_err . (++ "\n") . show) ((:[]) . mkText')+ . runParser parser (withNormNewline ()) "remove encoding spec" . fromMaybe "" . getText ) t | otherwise = [t] where- parser :: Parser String- parser = do- _ <- option [] textDecl+ parser :: XParser s String+ parser = option [] textDecl+ >> getInput -- ------------------------------------------------------------@@ -594,13 +668,14 @@ -- | -- general parser for parsing arbitray parts of a XML document -parseXmlPart :: Parser XmlTrees -> String -> String -> XmlTree -> XmlTrees+parseXmlPart :: SimpleXParser XmlTrees -> String -> String -> XmlTree -> XmlTrees parseXmlPart parser expected context t- = parseXmlText ( do- res <- parser- eof <?> expected- return res- ) context+ = parseXmlText+ ( do+ res <- parser+ eof <?> expected+ return res+ ) (withoutNormNewline ()) context $ t -- ------------------------------------------------------------@@ -617,17 +692,17 @@ -- | -- Parser for general entites -parseXmlGeneralEntityValue :: String -> XmlTree -> XmlTrees-parseXmlGeneralEntityValue+parseXmlEntityValueAsContent :: String -> XmlTree -> XmlTrees+parseXmlEntityValueAsContent = parseXmlPart content "general entity value" -- ------------------------------------------------------------ -- |--- Parser for attribute values+-- Parser for entity substitution within attribute values -parseXmlAttrValue :: String -> XmlTree -> XmlTrees-parseXmlAttrValue+parseXmlEntityValueAsAttrValue :: String -> XmlTree -> XmlTrees+parseXmlEntityValueAsAttrValue = parseXmlPart (XT.attrValueT' "<&") "attribute value" -- ------------------------------------------------------------@@ -663,7 +738,7 @@ -- in case of a valid encoding spec -- else the unchanged tree -parseXmlEncodingSpec :: Parser XmlTree -> XmlTree -> XmlTrees+parseXmlEncodingSpec :: SimpleXParser XmlTree -> XmlTree -> XmlTrees parseXmlEncodingSpec encDecl x = (:[]) . ( if isRoot x@@ -672,14 +747,24 @@ ) $ x where parseEncSpec r- = case ( parse encDecl source . xshow . getChildren $ r ) of+ = case ( runParser encDecl (withNormNewline ()) source+ . xshow+ . getChildren+ $ r+ ) of Right t -> changeAttrl (mergeAttrl . fromMaybe [] . getAttrl $ t) r Left _ -> r where -- arrow \"getAttrValue a_source\" programmed on the tree level (oops!)- source = xshow . concat . map getChildren . filter ((== a_source) . maybe "" qualifiedName . getAttrName) . fromMaybe [] . getAttrl $ r+ source = xshow+ . concat+ . map getChildren+ . filter ((== a_source)+ . maybe "" qualifiedName . getAttrName)+ . fromMaybe []+ . getAttrl $ r parseXmlEntityEncodingSpec :: XmlTree -> XmlTrees parseXmlEntityEncodingSpec = parseXmlEncodingSpec textDecl''
src/Text/XML/HXT/Parser/XmlTokenParser.hs view
@@ -18,10 +18,13 @@ module Text.XML.HXT.Parser.XmlTokenParser ( allBut , allBut1+ , amp , asciiLetter+ , attrChar , attrValue , bar , charRef+ , checkString , comma , dq , encName@@ -78,30 +81,28 @@ ) where -import Data.Char.Properties.XMLCharProps- ( isXmlChar- )-import Data.String.Unicode- ( intToCharRef- , intToCharRefHex- )-+import Data.Char.Properties.XMLCharProps ( isXmlChar+ , isXmlCharCR+ )+import Data.String.Unicode ( intToCharRef+ , intToCharRefHex+ ) import Text.ParserCombinators.Parsec import Text.XML.HXT.DOM.Interface-import Text.XML.HXT.DOM.XmlNode- ( mkDTDElem- , mkText- , mkCharRef- , mkEntityRef- )-import Text.XML.HXT.Parser.XmlCharParser- ( xmlNameChar- , xmlNameStartChar- , xmlNCNameChar- , xmlNCNameStartChar- , xmlSpaceChar- )+import Text.XML.HXT.DOM.XmlNode ( mkDTDElem'+ , mkText'+ , mkCharRef'+ , mkEntityRef'+ )+import Text.XML.HXT.Parser.XmlCharParser ( xmlNameChar+ , xmlNameStartChar+ , xmlNCNameChar+ , xmlNCNameStartChar+ , xmlSpaceChar+ , xmlCRLFChar+ , XParser+ ) -- ------------------------------------------------------------ --@@ -111,19 +112,19 @@ -- ------------------------------------------------------------ -sPace :: GenParser Char state String+sPace :: XParser s String sPace = many1 xmlSpaceChar -sPace0 :: GenParser Char state String+sPace0 :: XParser s String sPace0 = many xmlSpaceChar -skipS :: GenParser Char state ()+skipS :: XParser s () skipS = skipMany1 xmlSpaceChar -skipS0 :: GenParser Char state ()+skipS0 :: XParser s () skipS0 = skipMany xmlSpaceChar @@ -131,55 +132,53 @@ -- -- Names and Tokens (2.3) -asciiLetter :: GenParser Char state Char+asciiLetter :: XParser s Char asciiLetter = satisfy (\ c -> ( c >= 'A' && c <= 'Z' || c >= 'a' && c <= 'z' ) ) <?> "ASCII letter" -name :: GenParser Char state String+name :: XParser s String name- = try ( do- s1 <- xmlNameStartChar- sl <- many xmlNameChar- return (s1 : sl)- )+ = do+ s1 <- xmlNameStartChar+ sl <- many xmlNameChar+ return (s1 : sl) <?> "Name" -- Namespaces in XML: Rules [4-5] NCName: -ncName :: GenParser Char state String+ncName :: XParser s String ncName- = try ( do- s1 <- xmlNCNameStartChar- sl <- many xmlNCNameChar- return (s1 : sl)- )+ = do+ s1 <- xmlNCNameStartChar+ sl <- many xmlNCNameChar+ return (s1 : sl) <?> "NCName" -- Namespaces in XML: Rules [6-8] QName: -qName :: GenParser Char state (String, String)+qName :: XParser s (String, String) qName = do s1 <- ncName- s2 <- option "" ( do- _ <- char ':'- ncName- )- return ( if null s2 then (s2, s1) else (s1, s2) )+ s2 <- option "" (char ':' >> ncName)+ return ( if null s2+ then (s2, s1)+ else (s1, s2)+ ) -nmtoken :: GenParser Char state String+nmtoken :: XParser s String nmtoken = try (many1 xmlNameChar) <?> "Nmtoken" -names :: GenParser Char state [String]+names :: XParser s [String] names = sepBy1 name sPace -nmtokens :: GenParser Char state [String]+nmtokens :: XParser s [String] nmtokens = sepBy1 nmtoken sPace @@ -187,27 +186,38 @@ -- -- Literals (2.3) -singleChar :: String -> GenParser Char state Char+singleChar :: String -> XParser s Char singleChar notAllowed- = satisfy (\ c -> isXmlChar c && not (c `elem` notAllowed))+ = satisfy (\ c -> isXmlCharCR c && c `notElem` notAllowed)+ <|>+ xmlCRLFChar -singleChars :: String -> GenParser Char state String+singleChars :: String -> XParser s String singleChars notAllowed = many1 (singleChar notAllowed) -entityValue :: GenParser Char state String+entityValue :: XParser s String entityValue- = attrValue+ = ( do+ v <- entityValueDQ+ return ("\"" ++ v ++ "\"")+ )+ <|>+ ( do+ v <- entityValueSQ+ return ("'" ++ v ++ "'")+ )+ <?> "entity value (in quotes)" -attrValueDQ :: GenParser Char state String-attrValueDQ- = between dq dq (concRes $ many $ attrChar "<&\"")+entityValueDQ :: XParser s String+entityValueDQ+ = between dq dq (concRes $ many $ attrChar "&\"") -attrValueSQ :: GenParser Char state String-attrValueSQ- = between sq sq (concRes $ many $ attrChar "<&\'")+entityValueSQ :: XParser s String+entityValueSQ+ = between sq sq (concRes $ many $ attrChar "&\'") -attrValue :: GenParser Char state String+attrValue :: XParser s String attrValue = ( do v <- attrValueDQ@@ -220,29 +230,36 @@ ) <?> "attribute value (in quotes)" -attrChar :: String -> GenParser Char state String+attrValueDQ :: XParser s String+attrValueDQ+ = between dq dq (concRes $ many $ attrChar "<&\"")++attrValueSQ :: XParser s String+attrValueSQ+ = between sq sq (concRes $ many $ attrChar "<&\'")++attrChar :: String -> XParser s String attrChar notAllowed = reference <|> mkList (singleChar notAllowed)- <?> "legal attribute character or reference"-+ <?> ("legal attribute or entity character or reference (not allowed: " ++ show notAllowed ++ " )") -systemLiteral :: GenParser Char state String+systemLiteral :: XParser s String systemLiteral = between dq dq (many $ noneOf "\"") <|> between sq sq (many $ noneOf "\'") <?> "system literal (in quotes)" -pubidLiteral :: GenParser Char state String+pubidLiteral :: XParser s String pubidLiteral = between dq dq (many $ pubidChar "\'") <|> between sq sq (many $ pubidChar "") <?> "pubid literal (in quotes)" where- pubidChar :: String -> GenParser Char state Char+ pubidChar :: String -> XParser s Char pubidChar quoteChars = asciiLetter <|>@@ -258,7 +275,7 @@ -- -- Character and Entity References (4.1) -reference :: GenParser Char state String+reference :: XParser s String reference = ( do i <- charRef@@ -270,8 +287,7 @@ return ("&" ++ n ++ ";") ) --checkCharRef :: Int -> GenParser Char state Int+checkCharRef :: Int -> XParser s Int checkCharRef i = if ( i <= fromEnum (maxBound::Char) && isXmlChar (toEnum i)@@ -279,37 +295,36 @@ then return i else unexpected ("illegal value in character reference: " ++ intToCharRef i ++ " , in hex: " ++ intToCharRefHex i) -charRef :: GenParser Char state Int+charRef :: XParser s Int charRef = do- _ <- try (string "&#x")+ checkString "&#x" d <- many1 hexDigit- _ <- semi+ semi checkCharRef (hexStringToInt d) <|> do- _ <- try (string "&#")+ checkString "&#" d <- many1 digit- _ <- semi+ semi checkCharRef (decimalStringToInt d) <?> "character reference" --entityRef :: GenParser Char state String+entityRef :: XParser s String entityRef = do- _ <- char '&'+ amp n <- name- _ <- semi+ semi return n <?> "entity reference" -peReference :: GenParser Char state String+peReference :: XParser s String peReference = try ( do _ <- char '%' n <- name- _ <- semi+ semi return n ) <?> "parameter-entity reference"@@ -318,14 +333,14 @@ -- -- 4.3 -encName :: GenParser Char state String+encName :: XParser s String encName = do c <- asciiLetter r <- many (asciiLetter <|> digit <|> oneOf "._-") return (c:r) -versionNum :: GenParser Char state String+versionNum :: XParser s String versionNum = many1 xmlNameChar @@ -334,7 +349,7 @@ -- -- keywords -keyword :: String -> GenParser Char state String+keyword :: String -> XParser s String keyword kw = try ( do n <- name@@ -344,7 +359,7 @@ ) <?> kw -keywords :: [String] -> GenParser Char state String+keywords :: [String] -> XParser s String keywords = foldr1 (<|>) . map keyword @@ -352,7 +367,7 @@ -- -- parser for quoted attribute values -quoted :: GenParser Char state a -> GenParser Char state a+quoted :: XParser s a -> XParser s a quoted p = between dq dq p <|>@@ -362,15 +377,23 @@ -- -- simple char parsers -dq, sq, lt, gt, semi :: GenParser Char state Char+dq, sq, lt, gt, semi, amp :: XParser s () -dq = char '\"'-sq = char '\''-lt = char '<'-gt = char '>'-semi = char ';'+dq = char '\"' >> return ()+sq = char '\'' >> return ()+lt = char '<' >> return ()+gt = char '>' >> return ()+semi = char ';' >> return ()+amp = char '&' >> return () -separator :: Char -> GenParser Char state ()+{-# INLINE dq #-}+{-# INLINE sq #-}+{-# INLINE lt #-}+{-# INLINE gt #-}+{-# INLINE semi #-}+{-# INLINE amp #-}++separator :: Char -> XParser s () separator c = do _ <- try ( do@@ -380,42 +403,45 @@ skipS0 <?> [c] -bar, comma, eq, lpar, rpar :: GenParser Char state ()+bar, comma, eq, lpar, rpar :: XParser s () bar = separator '|' comma = separator ',' eq = separator '=' -lpar- = do- _ <- char '('- skipS0+{-# INLINE bar #-}+{-# INLINE comma #-}+{-# INLINE eq #-} -rpar- = do- skipS0- _ <- char ')'- return ()+lpar = char '(' >> skipS0+{-# INLINE lpar #-} +rpar = skipS0 >> char ')' >> return ()+{-# INLINE rpar #-} +checkString :: String -> XParser s ()+checkString s+ = try $ string s >> return ()+{-# INLINE checkString #-}+ -- ------------------------------------------------------------ -- -- all chars but not a special substring -allBut :: (GenParser Char state Char -> GenParser Char state String) -> String -> GenParser Char state String+allBut :: (XParser s Char -> XParser s String) -> String -> XParser s String allBut p str = allBut1 p (const True) str -allBut1 :: (GenParser Char state Char -> GenParser Char state String) -> (Char -> Bool) -> String -> GenParser Char state String+allBut1 :: (XParser s Char -> XParser s String) -> (Char -> Bool) -> String -> XParser s String allBut1 p prd (c:rest)- = p ( satisfy (\ x -> isXmlChar x && prd x && not (x == c) )+ = p ( satisfy (\ x -> isXmlCharCR x && prd x && not (x == c) ) <|>- try ( do- _ <- char c- notFollowedBy ( do- _ <- try (string rest)- return c- )+ xmlCRLFChar+ <|>+ try ( char c+ >>+ notFollowedBy (try (string rest) >> return c)+ >> return c ) )@@ -427,13 +453,13 @@ -- -- concatenate parse results -concRes :: GenParser Char state [[a]] -> GenParser Char state [a]+concRes :: XParser s [[a]] -> XParser s [a] concRes p = do sl <- p return (concat sl) -mkList :: GenParser Char state a -> GenParser Char state [a]+mkList :: XParser s a -> XParser s [a] mkList p = do r <- p@@ -447,20 +473,20 @@ -- -- Literals (2.3) -nameT :: GenParser Char state XmlTree+nameT :: XParser s XmlTree nameT = do n <- name- return (mkDTDElem NAME [(a_name, n)] [])+ return (mkDTDElem' NAME [(a_name, n)] []) -nmtokenT :: GenParser Char state XmlTree+nmtokenT :: XParser s XmlTree nmtokenT = do n <- nmtoken- return (mkDTDElem NAME [(a_name, n)] [])+ return (mkDTDElem' NAME [(a_name, n)] []) -entityValueT :: GenParser Char state XmlTrees+entityValueT :: XParser s XmlTrees entityValueT = do sl <- between dq dq (entityTokensT "%&\"")@@ -471,11 +497,11 @@ return sl <?> "entity value (in quotes)" -entityTokensT :: String -> GenParser Char state XmlTrees+entityTokensT :: String -> XParser s XmlTrees entityTokensT notAllowed = many (entityCharT notAllowed) -entityCharT :: String -> GenParser Char state XmlTree+entityCharT :: String -> XParser s XmlTree entityCharT notAllowed = peReferenceT <|>@@ -485,59 +511,74 @@ <|> ( do cs <- many1 (singleChar notAllowed)- return (mkText cs)+ return (mkText' cs) ) -attrValueT :: GenParser Char state XmlTrees+attrValueT :: XParser s XmlTrees attrValueT = between dq dq (attrValueT' "<&\"") <|> between sq sq (attrValueT' "<&\'") <?> "attribute value (in quotes)" -attrValueT' :: String -> GenParser Char state XmlTrees+attrValueT' :: String -> XParser s XmlTrees attrValueT' notAllowed = many ( referenceT <|> singleCharsT notAllowed) -singleCharsT :: String -> GenParser Char state XmlTree+singleCharsT :: String -> XParser s XmlTree singleCharsT notAllowed = do cs <- singleChars notAllowed- return (mkText cs)+ return (mkText' cs) -- ------------------------------------------------------------ -- -- Character and Entity References (4.1) -referenceT :: GenParser Char state XmlTree+referenceT :: XParser s XmlTree referenceT = charRefT <|> entityRefT -charRefT :: GenParser Char state XmlTree+charRefT :: XParser s XmlTree charRefT = do i <- charRef- return $! (mkCharRef $! i)+ return (mkCharRef' i) -entityRefT :: GenParser Char state XmlTree+entityRefT :: XParser s XmlTree entityRefT = do n <- entityRef- return $! (mkEntityRef $! n)+ return $! (maybe (mkEntityRef' n) mkCharRef' . lookup n $ predefinedXmlEntities) -bypassedEntityRefT :: GenParser Char state XmlTree+-- optimization: predefined XML entity refs are converted into equivalent char refs+-- so there is no need for an entitiy substitution phase, if there is no DTD+-- Attention: entityRefT must only be called from within XML/HTML content+-- in DTD parsing this optimization is not allowed because of different semantics+-- of charRefs and entityRefs during substitution of entites in ENTITY definitions++predefinedXmlEntities :: [(String, Int)]+predefinedXmlEntities+ = [ ("lt", 60)+ , ("gt", 62)+ , ("amp", 38)+ , ("apos", 39)+ , ("quot", 34)+ ]++bypassedEntityRefT :: XParser s XmlTree bypassedEntityRefT = do n <- entityRef- return $! (mkText ("&" ++ n ++ ";"))+ return $! (mkText' ("&" ++ n ++ ";")) -peReferenceT :: GenParser Char state XmlTree+peReferenceT :: XParser s XmlTree peReferenceT = do r <- peReference- return $! (mkDTDElem PEREF [(a_peref, r)] [])+ return $! (mkDTDElem' PEREF [(a_peref, r)] []) -- ------------------------------------------------------------
src/Text/XML/HXT/Version.hs view
@@ -1,4 +1,4 @@ module Text.XML.HXT.Version where hxt_version :: String-hxt_version = "8.5.1"+hxt_version = "9.1.0"