packages feed

wraxml 0.4.2 → 0.4.3

raw patch · 20 files changed

+454/−170 lines, 20 filesdep ~tagchupnew-component:exe:escape-tidy-html

Dependency ranges changed: tagchup

Files

+ example/Escape.hs view
@@ -0,0 +1,65 @@+{- |+Detects character encoding, decodes,+and convert all special characters to HTML references.+CDATA sections are converted to plain text.+Input is read from standard input,+output is written to standard output.+The encoding can be given as one argument,+which then overrides encoding information within the document.+Since an HTML tree is used as internal representation,+in the output opening and closing tags are correctly nested.+This may be an improvement,+but if the input is written with bugs or strange behaviour+of a particular HTML viewer in mind,+this may be a loss.++> escape-tidy-html utf-8 <input.xhtml >output.xhtml++See also @escape-html@ example from tagchup package.+-}+module Main where++import qualified Text.XML.HXT.DOM.Unicode as Unicode++import qualified Text.HTML.WraXML.Document as HtmlDoc+import qualified Text.XML.WraXML.Document.Tagchup as TagchupDoc+import qualified Text.XML.WraXML.Tree as XmlTree+import qualified Text.XML.WraXML.String as XmlString+import qualified Text.HTML.Tagchup.Parser as Parser+import qualified Text.HTML.Basic.Character as HtmlChar+import qualified Text.XML.Basic.Name.LowerCase as Name++import System.Environment (getArgs, )++++getDecoder :: XmlString.Encoding -> XmlString.Encoded -> String+getDecoder =+   maybe Unicode.latin1ToUnicode (fst.) .+   Unicode.getDecodingFct++escape :: HtmlDoc.T i Name.T String -> String+escape =+   flip HtmlDoc.format "" .+   fmap (map HtmlChar.asciiFromUnicode) .+   HtmlDoc.lift id (map XmlTree.textFromCData)++main :: IO ()+main =+   do argv <- getArgs+      case argv of+         [] ->+            interact+               (escape .+                XmlString.evalDecodeAdaptive .+                HtmlDoc.decodeAdaptive getDecoder .+                TagchupDoc.toXmlDocument .+                Parser.runSoupWithPositions)+         [encoding] ->+            interact+               (escape .+                TagchupDoc.toXmlDocument .+                Parser.runSoupWithPositions .+                getDecoder encoding)+         _ ->+            putStrLn "Error: more than one decoding given"
src/Data/Tree/BranchLeafLabel.hs view
@@ -94,6 +94,16 @@      -> (i -> leaf -> b)      -> (T i branch leaf -> b) foldLabel branchF leafF =+   fold+      (flip ($))+      (\branch subTrees i -> branchF i branch subTrees)+      (\leaf i -> leafF i leaf)++foldLabelAlt ::+        (i -> branch -> [b] -> b)+     -> (i -> leaf -> b)+     -> (T i branch leaf -> b)+foldLabelAlt branchF leafF =    let recourse =           switchLabel (\i x -> branchF i x . List.map recourse) leafF    in  recourse
src/Text/HTML/WraXML/Document.hs view
@@ -1,23 +1,51 @@ module Text.HTML.WraXML.Document (-   XMLDoc.T(..), XMLDoc.lift, format,+   XmlDoc.T(..), XmlDoc.lift,+   decodeAdaptive, format,    ) where -import qualified Text.HTML.WraXML.Tree    as HTMLTree-import qualified Text.XML.WraXML.Document as XMLDoc+import qualified Text.HTML.WraXML.Tree    as HtmlTree+import qualified Text.XML.WraXML.Document as XmlDoc+import qualified Text.XML.WraXML.String  as XmlString+import qualified Text.XML.Basic.Attribute as Attr import qualified Text.XML.Basic.Name as Name import qualified Text.XML.Basic.Format as Format+import qualified Text.HTML.Basic.String as HtmlStringB+import qualified Text.HTML.Basic.Character as HtmlChar +import Control.Monad.Trans.State (State, put, get, ) +import Control.Applicative (liftA2, )+import Data.Traversable (traverse, )++ format ::    (Name.Tag name, Name.Attribute name, Format.C string) =>-   XMLDoc.T i name string -> ShowS-format (XMLDoc.Cons xml dtd trees) =+   XmlDoc.T i name string -> ShowS+format (XmlDoc.Cons xml dtd trees) =    let (formatHTML, formatXMLDecl) =           maybe-             (HTMLTree.formatMany, id)+             (HtmlTree.formatMany, id)              (\xmlDecl ->-                 (HTMLTree.formatManyXHTML,-                  XMLDoc.formatXMLDeclaration xmlDecl)) xml+                 (HtmlTree.formatManyXHTML,+                  XmlDoc.formatXMLDeclaration xmlDecl)) xml    in  formatXMLDecl .-       maybe id XMLDoc.formatDocType dtd .+       maybe id XmlDoc.formatDocType dtd .        formatHTML trees+++decodeAdaptive ::+   (Name.Attribute name, Name.Tag name) =>+   (XmlString.Encoding -> XmlString.Encoded -> String) ->+   XmlDoc.T i name [HtmlChar.T] ->+   State (XmlString.Encoded -> String) (XmlDoc.T i name String)+decodeAdaptive getDecoder (XmlDoc.Cons xml0 dtd trees0) =+   liftA2+      (\xml1 trees1 -> XmlDoc.Cons xml1 dtd trees1)+      (do decoder <- get+          let xml1 = fmap (map (fmap (HtmlStringB.decode decoder))) xml0+          maybe+             (return ())+             (put . getDecoder) $+             Attr.lookup Attr.encodingName =<< xml1+          return xml1)+      (traverse (HtmlTree.decodeAdaptive getDecoder) trees0)
+ src/Text/HTML/WraXML/Element.hs view
@@ -0,0 +1,38 @@+module Text.HTML.WraXML.Element (+   module Text.HTML.WraXML.Element,+   T, name_, attributes_,+   Elem.cons, Elem.name, Elem.attributes,+   Elem.checkName, Elem.format,+   ) where++import Text.XML.WraXML.Element (T, name_, attributes_, )++import qualified Text.XML.WraXML.Element as Elem++import qualified Text.XML.Basic.Name as Name+import qualified Text.XML.WraXML.String as XmlString++import qualified Text.HTML.Basic.Tag as Tag+import qualified Text.HTML.Basic.Character as HtmlChar+import qualified Text.HTML.Basic.String as HtmlString++import Control.Monad.Trans.State (State, put, get, )+++-- * decode++decodeAdaptive ::+   (Name.Attribute name, Name.Tag name) =>+   (XmlString.Encoding -> XmlString.Encoded -> String) ->+   T name [HtmlChar.T] ->+   State (HtmlString.Encoded -> String) (T name String)+decodeAdaptive getDecoder elem0 =+   do decoder <- get+      let elem1 =+             fmap (HtmlString.decode decoder) elem0+      maybe+         (return ())+         (put . getDecoder) $+         (Tag.maybeMetaEncoding+             (name_ elem1) (attributes_ elem1))+      return elem1
src/Text/HTML/WraXML/Entity.hs view
@@ -1,7 +1,7 @@ module Text.HTML.WraXML.Entity-   (Name, HTMLEnt.mapNameToChar, mapCharToName, ) where+   (Name, HtmlEnt.mapNameToChar, mapCharToName, ) where -import qualified Text.HTML.Basic.Entity as HTMLEnt+import qualified Text.HTML.Basic.Entity as HtmlEnt import qualified Data.Map as Map  import Data.Tuple.HT (swap, )@@ -11,4 +11,4 @@  mapCharToName :: Map.Map Char Name mapCharToName =-   Map.fromList $ map swap HTMLEnt.listInternetExploder+   Map.fromList $ map swap HtmlEnt.listInternetExploder
src/Text/HTML/WraXML/String.hs view
@@ -1,7 +1,7 @@ module Text.HTML.WraXML.String where  import qualified Text.XML.WraXML.String as XmlString-import qualified Text.HTML.Basic.Character as HTMLChar+import qualified Text.HTML.Basic.Character as HtmlChar import qualified Data.Char as Char import qualified Text.XML.HXT.DOM.Unicode as Unicode @@ -12,7 +12,7 @@  type T = [Atom] -type Atom = HTMLChar.T+type Atom = HtmlChar.T   {- |@@ -20,27 +20,27 @@ This can only work, if the string does not contain special characters. -} fromString :: String -> T-fromString = map HTMLChar.fromUnicode+fromString = map HtmlChar.fromUnicode  {- | default routine -} fromUnicodeString :: String -> T-fromUnicodeString = map HTMLChar.asciiFromUnicode+fromUnicodeString = map HtmlChar.asciiFromUnicode  fromUnicodeStringInternetExploder :: String -> T fromUnicodeStringInternetExploder =-   map HTMLChar.asciiFromUnicodeInternetExploder+   map HtmlChar.asciiFromUnicodeInternetExploder   toUnicodeStringOrFormat :: T -> String toUnicodeStringOrFormat =    flip compose "" .-   map HTMLChar.toUnicodeOrFormat+   map HtmlChar.toUnicodeOrFormat  toUnicodeString :: T -> String-toUnicodeString = XmlString.toUnicodeString-+toUnicodeString =+   map (Exc.resolve error . HtmlChar.toUnicode)   {- |@@ -52,10 +52,10 @@    Unicode.DecodingFctEmbedErrors -> T -> XmlString.EmbeddedExceptions toUnicodeStringDecodingEmbedError f =    concat .-   HTMLChar.switchUnicodeRuns+   HtmlChar.switchUnicodeRuns       (map Exc.fromEither . f)-      ((:[]) . HTMLChar.toUnicode . HTMLChar.fromCharRef)-      ((:[]) . HTMLChar.toUnicode . HTMLChar.fromEntityRef)+      ((:[]) . HtmlChar.toUnicode . HtmlChar.fromCharRef)+      ((:[]) . HtmlChar.toUnicode . HtmlChar.fromEntityRef)   @@ -64,10 +64,10 @@ This uses ISO latin encoding and may fail for exotic characters. -} toLower :: T -> T-toLower = map HTMLChar.toLower+toLower = map HtmlChar.toLower  toUpper :: T -> T-toUpper = map HTMLChar.toUpper+toUpper = map HtmlChar.toUpper   toCanonicalUnicodeString :: T -> String
src/Text/HTML/WraXML/Table.hs view
@@ -1,7 +1,7 @@ module Text.HTML.WraXML.Table where --- import qualified Text.HTML.WraXML.Tree as HTMLTree-import qualified Text.XML.WraXML.Tree    as XMLTree+-- import qualified Text.HTML.WraXML.Tree as HtmlTree+import qualified Text.XML.WraXML.Tree    as XmlTree import qualified Text.XML.WraXML.Element as Elem  import qualified Text.XML.Basic.Name as Name@@ -9,41 +9,41 @@ import           Data.Maybe(mapMaybe)  -type T i name str = [[[XMLTree.T i name str]]]+type T i name str = [[[XmlTree.T i name str]]]  {- | Ignores all non-table-row-tags and all non-table-cell-tags. -} simpleFromRows ::    (Name.Tag name) =>-   [XMLTree.T i name str] ->  T i name str+   [XmlTree.T i name str] ->  T i name str simpleFromRows =    map (simpleFromRow . snd) .    filter (Elem.checkName (Name.match "tr") . fst) .-   mapMaybe XMLTree.maybeTag+   mapMaybe XmlTree.maybeTag  simpleFromRow ::    (Name.Tag name) =>-   [XMLTree.T i name str] ->  [[XMLTree.T i name str]]+   [XmlTree.T i name str] ->  [[XmlTree.T i name str]] simpleFromRow =    map snd .    filter (Elem.checkName (Name.matchAny ["th","td"]) . fst) .-   mapMaybe XMLTree.maybeTag+   mapMaybe XmlTree.maybeTag   {- data CellType = Heading | Cell -fromRows :: [XMLTree.T i name str] ->  [[(CellType, [XMLTree.T i name str])]]+fromRows :: [XmlTree.T i name str] ->  [[(CellType, [XmlTree.T i name str])]] fromRows =    map fromRow .-   filter (XMLTree.checkTagName ("tr"==) . fst) .-   mapMaybe XMLTree.maybeTag+   filter (XmlTree.checkTagName ("tr"==) . fst) .+   mapMaybe XmlTree.maybeTag -fromRow :: [XMLTree.T i name str] ->  [(CellType, [XMLTree.T i name str])]+fromRow :: [XmlTree.T i name str] ->  [(CellType, [XmlTree.T i name str])] fromRow =    mapMaybe (\tag ->-      if XMLTree.checkTagName ("td"==) tag+      if XmlTree.checkTagName ("td"==) tag         then Just) .-   mapMaybe XMLTree.maybeTag+   mapMaybe XmlTree.maybeTag -}
src/Text/HTML/WraXML/Tree.hs view
@@ -5,14 +5,20 @@ import qualified Text.XML.WraXML.String  as XmlString import qualified Data.Char               as Char +import qualified Text.XML.Basic.Tag as TagX import qualified Text.HTML.Basic.Tag as Tag-import qualified Text.XML.WraXML.Element as Elem+import qualified Text.HTML.Basic.Character as HtmlChar+import qualified Text.HTML.Basic.String as HtmlStringB+import qualified Text.HTML.WraXML.Element as Elem import qualified Text.XML.Basic.Attribute as Attr-import qualified Text.XML.Basic.Name  as Name+import qualified Text.XML.Basic.Name as Name  import Text.XML.WraXML.Tree (formatLeaf, ) import qualified Text.XML.Basic.Format as Format +import Control.Monad.Trans.State (State, put, get, )+import Control.Applicative (liftA, liftA2, )+ import           Data.List.HT (takeWhileRev, ) import           Data.Tuple.HT (mapFst, ) import           Control.Monad (liftM2, )@@ -51,7 +57,50 @@    XmlTree.filterTagsFlatten (Elem.checkName (Name.match "head"))  -{-# DEPRECATED decodeSpecialCharsMetaEncoding "XMLChar.Unicode constructors must contain unicode characters and not encoded ones. Decode characters before parsing!" #-}+{- |+Decode strings in a HTML tree.+Switch decoding on every occurence of a content-type meta-tag.+This must operate on @HtmlString@s, that is before reference resolution,+since after reference resolution+Unicode characters may clash with encoded characters.+-}+decodeAdaptive ::+   (Name.Attribute name, Name.Tag name) =>+   (XmlString.Encoding -> XmlString.Encoded -> String) ->+   XmlTree.T i name [HtmlChar.T] ->+   State (XmlString.Encoded -> String) (XmlTree.T i name String)+decodeAdaptive getDecoder =+   XmlTree.fold+      (liftA . XmlTree.wrap2)+      (\elm subTrees ->+         liftA2 (Tree.Branch . XmlTree.Tag)+            (Elem.decodeAdaptive getDecoder elm)+            (fmap (map XmlTree.unwrap) $ sequence subTrees))+      (liftA Tree.Leaf .+       decodeLeafAdaptive getDecoder)++decodeLeafAdaptive ::+   (Name.Attribute name, Name.Tag name) =>+   (XmlString.Encoding -> XmlString.Encoded -> String) ->+   XmlTree.Leaf name [HtmlChar.T] ->+   State (XmlString.Encoded -> String) (XmlTree.Leaf name String)+decodeLeafAdaptive getDecoder leaf0 =+   do decoder <- get+      let leaf1 =+             maybe+                (fmap (HtmlStringB.decode decoder) leaf0)+                (XmlTree.CData . decoder)+                (XmlTree.maybeCDataLeaf leaf0)+      -- this should not happen in correct XML file+      maybe+         (return ())+         (put . getDecoder) $+         uncurry TagX.maybeXMLEncoding =<<+         XmlTree.maybeProcessingLeaf leaf1+      return leaf1+++{-# DEPRECATED decodeSpecialCharsMetaEncoding "This calls findMetaEncoding which is a potential space leak. Better use decodeAdaptive." #-}  {- | Convert special characters of XmlString into Unicode
src/Text/HTML/WraXML/Tree/HXT.hs view
@@ -10,7 +10,7 @@  import qualified Text.XML.WraXML.Tree.HXT as WraHXT -import qualified Text.HTML.WraXML.Tree   as HTMLTree+import qualified Text.HTML.WraXML.Tree   as HtmlTree import qualified Text.XML.WraXML.Tree    as XmlTree  import qualified Text.XML.Basic.Name.LowerCase as NameLC@@ -115,12 +115,12 @@ findMetaEncoding :: String -> IO (Maybe String) findMetaEncoding str =    do htmlTrees <- xmlTreesFromHTMLString str-      return (msum (map HTMLTree.findMetaEncoding (htmlTrees :: [XmlTree.T () NameLC.T String])))+      return (msum (map HtmlTree.findMetaEncoding (htmlTrees :: [XmlTree.T () NameLC.T String])))  getMetaHTTPHeaders :: String -> IO [(String, String)] getMetaHTTPHeaders str =    do htmlTrees <- xmlTreesFromHTMLString str-      return (concatMap HTMLTree.getMetaHTTPHeaders (htmlTrees :: [XmlTree.T () NameLC.T String]))+      return (concatMap HtmlTree.getMetaHTTPHeaders (htmlTrees :: [XmlTree.T () NameLC.T String]))  xmlTreesFromHTMLString ::    (Name.Tag name, Name.Attribute name) =>
src/Text/XML/WraXML/Document.hs view
@@ -5,13 +5,16 @@ import qualified Text.XML.Basic.Name as Name import qualified Text.XML.Basic.Format as Format +import Control.Applicative (Applicative, liftA2, )+import Data.Traversable (traverse, )  -data T i name str = Cons {-   xmlDeclaration :: Maybe [Attr.T name str],-   docType :: Maybe String,-   content :: [XmlTree.T i name str]}-     deriving Show+data T i name str =+   Cons {+      xmlDeclaration :: Maybe [Attr.T name str],+      docType :: Maybe String,+      content :: [XmlTree.T i name str]+   } deriving Show  instance    (Name.Tag name, Name.Attribute name) =>@@ -25,6 +28,16 @@    T i name str0 -> T i name str1 lift g f (Cons xml dtd trees) =    Cons (fmap (map (fmap g)) xml) dtd $ f trees++liftA ::+   (Name.Tag name, Name.Attribute name, Applicative m) =>+   (str0 -> m str1) ->+   ([XmlTree.T i name str0] -> m [XmlTree.T i name str1]) ->+   T i name str0 -> m (T i name str1)+liftA g f (Cons xml dtd trees) =+   liftA2+      (\xmlDecl cnt -> Cons xmlDecl dtd cnt)+      (traverse (traverse (traverse g)) xml) (f trees)   formatXMLDeclaration ::
src/Text/XML/WraXML/Document/Tagchup.hs view
@@ -9,7 +9,7 @@ import qualified Text.HTML.Tagchup.PositionTag as PosTag import qualified Text.XML.Basic.Position    as Position import qualified Text.HTML.Basic.Tag as TagH-import qualified Text.HTML.Basic.Character    as HTMLChar+import qualified Text.HTML.Basic.Character    as HtmlChar  import qualified Text.XML.Basic.Name.LowerCase as NameLC import qualified Text.XML.Basic.Name           as Name@@ -34,11 +34,11 @@ instance CharSpace Char where    isSpace = Char.isSpace -instance CharSpace HTMLChar.T where+instance CharSpace HtmlChar.T where    isSpace c =       case c of-         HTMLChar.Unicode chr -> Char.isSpace chr-         HTMLChar.EntityRef "nbsp" -> True+         HtmlChar.Unicode chr -> Char.isSpace chr+         HtmlChar.EntityRef "nbsp" -> True          _ -> False  class StringSpace string where
src/Text/XML/WraXML/String.hs view
@@ -2,7 +2,7 @@  import qualified Text.XML.HXT.DOM.Unicode as Unicode -import qualified Text.XML.Basic.Character as XMLChar+import qualified Text.XML.Basic.Character as XmlChar  import Control.Applicative (Applicative, liftA, ) import qualified Numeric@@ -12,35 +12,43 @@  import qualified Control.Monad.Exception.Synchronous as Exc +import Control.Monad.Trans.State (State, evalState, ) + type T = [Atom] type EmbeddedExceptions = [Exc.Exceptional String Char] -type Atom = XMLChar.T+type Atom = XmlChar.T  +-- | should be an abstract type+type Encoding = String+-- | should be [Word8]+type Encoded  = String++ {- | Literal translation from pure strings. This can only work, if the string does not contain special characters. -} fromString :: String -> T-fromString = map XMLChar.fromUnicode+fromString = map XmlChar.fromUnicode  diffFromString :: String -> T -> T diffFromString =-   flip (foldr (\c -> (XMLChar.fromUnicode c :)))+   flip (foldr (\c -> (XmlChar.fromUnicode c :)))  {- | default routine -} fromUnicodeString :: String -> T-fromUnicodeString = map XMLChar.asciiFromUnicode+fromUnicodeString = map XmlChar.asciiFromUnicode   toUnicodeStringOrFormat :: T -> String toUnicodeStringOrFormat =    flip compose "" .-   map XMLChar.toUnicodeOrFormat+   map XmlChar.toUnicodeOrFormat  toUnicodeStringEmbedMessage :: T -> String toUnicodeStringEmbedMessage =@@ -60,10 +68,10 @@  toUnicodeStringEmbedException :: T -> EmbeddedExceptions toUnicodeStringEmbedException =-   map XMLChar.toUnicode+   map XmlChar.toUnicode  -{-# DEPRECATED utf8ToUnicodeString, isoLatin1ToUnicodeString, replaceUTF8ByUnicode, uStringWithErrorsMergePlainChars "XMLChar.Unicode constructors must contain unicode characters and not encoded ones. Decode characters before parsing!" #-}+{-# DEPRECATED utf8ToUnicodeString, isoLatin1ToUnicodeString, replaceUTF8ByUnicode, uStringWithErrorsMergePlainChars "XmlChar.Unicode constructors must contain unicode characters and not encoded ones. Decode characters before parsing!" #-} {- | Interpret the XML string as mixture of ISO-Latin-1 characters and XML entities and convert that to a Unicode string.@@ -90,18 +98,18 @@ -} parse :: String -> T parse ('&':'#':'x':xs) =-   parseAux Char.isHexDigit (XMLChar.fromCharRef . readHex) "&#x" xs+   parseAux Char.isHexDigit (XmlChar.fromCharRef . readHex) "&#x" xs parse ('&':'#':xs) =-   parseAux Char.isDigit (XMLChar.fromCharRef . read) "&#" xs+   parseAux Char.isDigit (XmlChar.fromCharRef . read) "&#" xs parse ('&':xs) =-   parseAux Char.isAlphaNum XMLChar.fromEntityRef "&" xs-parse (x:xs) = XMLChar.fromUnicode x : parse xs+   parseAux Char.isAlphaNum XmlChar.fromEntityRef "&" xs+parse (x:xs) = XmlChar.fromUnicode x : parse xs parse [] = [] -- use unfoldr?  parseAux ::    (Char -> Bool)         ->-   (String -> XMLChar.T)  ->+   (String -> XmlChar.T)  ->    String                 ->    String                 ->    T@@ -109,11 +117,11 @@    let (name,rest0) = span check xs    in  case rest0 of           ';':rest1 -> ref name : parse rest1-          _ -> map XMLChar.fromUnicode (prefix++name) ++ parse rest0+          _ -> map XmlChar.fromUnicode (prefix++name) ++ parse rest0   reduceRefs :: T -> T-reduceRefs = map XMLChar.reduceRef+reduceRefs = map XmlChar.reduceRef  {- | Consider the XmlString as a mixture of XML entities and UTF-8 characters.@@ -126,11 +134,11 @@ mapUnicodeRuns :: (String -> String) -> T -> T mapUnicodeRuns f =    flip compose [] .-   XMLChar.switchUnicodeRuns+   XmlChar.switchUnicodeRuns --      (\s -> fromString (f s) ++)       (diffFromString . f)-      ((:) . XMLChar.fromCharRef)-      ((:) . XMLChar.fromEntityRef)+      ((:) . XmlChar.fromCharRef)+      ((:) . XmlChar.fromEntityRef)   @@ -149,6 +157,11 @@                   _ -> ([], ys))       [] ++evalDecodeAdaptive ::+   State (Encoded -> String) a -> a+evalDecodeAdaptive =+   flip evalState id   liftFromUnicode :: (String -> String) -> (T -> T)
src/Text/XML/WraXML/String/HXT.hs view
@@ -4,7 +4,7 @@ import qualified Data.Tree.NTree.TypeDefs  as HXTTree  import qualified Text.XML.WraXML.String  as XmlString-import qualified Text.XML.Basic.Character as XMLChar+import qualified Text.XML.Basic.Character as XmlChar   toXmlString :: HXT.XmlTrees -> XmlString.T@@ -16,8 +16,8 @@      then         case label of            HXT.XText str -> XmlString.fromString str-           HXT.XCharRef ref -> [XMLChar.fromCharRef ref]-           HXT.XEntityRef ref -> [XMLChar.fromEntityRef ref]+           HXT.XCharRef ref -> [XmlChar.fromCharRef ref]+           HXT.XEntityRef ref -> [XmlChar.fromEntityRef ref]            _ -> error "HXT: illegal part of HXT string"      else error "HXT: parts of a string must not contain sub-strings" @@ -25,7 +25,7 @@ fromXmlString :: XmlString.T -> HXT.XmlTrees fromXmlString =    map (flip HXTTree.NTree []) .-   XMLChar.switchUnicodeRuns+   XmlChar.switchUnicodeRuns       HXT.XText       HXT.XCharRef       HXT.XEntityRef
src/Text/XML/WraXML/String/HaXml.hs view
@@ -4,7 +4,7 @@ import qualified Text.XML.HaXml as HaXml  import qualified Text.XML.WraXML.String  as XmlString-import qualified Text.XML.Basic.Character as XMLChar+import qualified Text.XML.Basic.Character as XmlChar  import Data.Maybe.HT (alternatives, (?->), ) @@ -16,7 +16,7 @@ fromXmlString :: XmlString.T -> AttValue fromXmlString =    AttValue .-   XMLChar.switchUnicodeRuns+   XmlChar.switchUnicodeRuns       Left       (Right . HaXml.RefChar)       (Right . HaXml.RefEntity)@@ -27,21 +27,21 @@ refToXmlAtom :: HaXml.Reference -> XmlString.Atom refToXmlAtom ref =    case ref of-      HaXml.RefChar   num  -> XMLChar.fromCharRef   num-      HaXml.RefEntity name -> XMLChar.fromEntityRef name+      HaXml.RefChar   num  -> XmlChar.fromCharRef   num+      HaXml.RefEntity name -> XmlChar.fromEntityRef name -charFromXmlAtom' :: XMLChar.T -> Either Char Reference+charFromXmlAtom' :: XmlChar.T -> Either Char Reference charFromXmlAtom' c =    case c of-      XMLChar.Unicode   char -> Left char-      XMLChar.EntityRef name -> Right (HaXml.RefEntity name)-      XMLChar.CharRef   num  -> Right (HaXml.RefChar   num)+      XmlChar.Unicode   char -> Left char+      XmlChar.EntityRef name -> Right (HaXml.RefEntity name)+      XmlChar.CharRef   num  -> Right (HaXml.RefChar   num) -charFromXmlAtom :: XMLChar.T -> Either Char Reference+charFromXmlAtom :: XmlChar.T -> Either Char Reference charFromXmlAtom c =    alternatives-      (error "HaXml.charFromXmlAtom: unsupported constructor in XMLChar.T") $-      XMLChar.maybeUnicode   c ?-> Left :-      XMLChar.maybeEntityRef c ?-> Right . HaXml.RefEntity :-      XMLChar.maybeCharRef   c ?-> Right . HaXml.RefChar :+      (error "HaXml.charFromXmlAtom: unsupported constructor in XmlChar.T") $+      XmlChar.maybeUnicode   c ?-> Left :+      XmlChar.maybeEntityRef c ?-> Right . HaXml.RefEntity :+      XmlChar.maybeCharRef   c ?-> Right . HaXml.RefChar :       []
src/Text/XML/WraXML/Tree.hs view
@@ -58,6 +58,7 @@    | Warning String  -- better 'str'?  +{-# DEPRECTATED AttributePlain "use Attribute type from xml-basic package instead" #-} type AttributePlain = (String, String)  @@ -80,27 +81,7 @@          Warning  str -> showString "Warning " . showsPrec 11 str  -{---- * Name data type -A name can only consist of (7-bit) ASCII characters.-It is used both for tag names and for attribute names.-newtype Name = Name String-   deriving (Show, Eq, Ord)--nameFromString :: String -> Name-nameFromString x =-   if all Char.isAscii x-     then Name $ map Char.toLower x-     else error ("XMLTree.nameFromString: '" ++ x ++-                 "' contains non-ASCII characters.")--nameToString :: Name -> String-nameToString (Name x) = x--}--- {- * generators -}  wrap :: Tree.T i (Branch name str) (Leaf name str) -> T i name str@@ -264,8 +245,52 @@       Text _ s -> Just s       _        -> Nothing +maybeCommentLeaf :: Leaf name str -> Maybe String+maybeCommentLeaf t =+   case t of+      Comment s -> Just s+      _         -> Nothing +maybeCDataLeaf :: Leaf name str -> Maybe String+maybeCDataLeaf t =+   case t of+      CData s -> Just s+      _       -> Nothing +maybeProcessingLeaf :: Leaf name str -> Maybe (Tag.Name name, PI.T name str)+maybeProcessingLeaf t =+   case t of+      PI n instr -> Just (n, instr)+      _          -> Nothing++maybeWarningLeaf :: Leaf name str -> Maybe String+maybeWarningLeaf t =+   case t of+      Warning s -> Just s+      _         -> Nothing+++fold ::+   (i -> a -> b) ->+   (Elem.T name str -> [b] -> a) ->+   (Leaf name str -> a) ->+   (T i name str -> b)+fold iF branchF leafF =+   Tree.fold iF (branchF . getElement) leafF . unwrap++switch ::+   (i -> a -> b) ->+   (Elem.T name str -> [T i name str] -> a) ->+   (Leaf name str -> a) ->+   (T i name str -> b)+switch iF branchF leafF =+   Tree.switch iF+      (\b subTrees -> branchF (getElement b) (map wrap subTrees))+      leafF+    . unwrap+++ {- * types of processors -}  type Filter i name str = T i name str -> T i name str@@ -307,6 +332,16 @@    Tree.map (liftElement f) id  {- |+Convert all CData sections to plain text.+-}+textFromCData :: T i name String -> T i name String+textFromCData =+   lift $+   Tree.map id+      (\leaf -> maybe leaf (Text False) $ maybeCDataLeaf leaf)+++{- | You can e.g. filter @text1 <b> text2 </b> text3@ to @text1  text2  text3@ by @filterTag (checkTagName ("b"\/=))@.@@ -347,13 +382,18 @@ Example: @filterTagsFlatten (checkTagName ("meta"==))@ -} filterTagsFlatten ::-   (Elem.T name str -> Bool) -> T i name str -> [(Elem.T name str, [T i name str])]+   (Elem.T name str -> Bool) ->+   T i name str ->+   [(Elem.T name str, [T i name str])] filterTagsFlatten p =    filter (p . fst) .    mapMaybe maybeTag .    allSubTrees -filterElementsFlatten :: (Elem.T name str -> Bool) -> T i name str -> [Elem.T name str]+filterElementsFlatten ::+   (Elem.T name str -> Bool) ->+   T i name str ->+   [Elem.T name str] filterElementsFlatten p =    Tree.fold       (flip const)@@ -397,15 +437,18 @@       (\branch -> Tree.Branch branch . map unwrap . f . map wrap)       Tree.Leaf -processSubTrees :: (Tag.Name name -> Bool) ->-   ([T i name str] -> [T i name str]) -> Filter i name str+processSubTrees ::+   (Tag.Name name -> Bool) ->+   ([T i name str] -> [T i name str]) ->+   Filter i name str processSubTrees p f =    lift $    Tree.mapSubTrees       (\(Tag (Elem.Cons name _)) -> p name)       (mapSnd (map unwrap . f . map wrap)) -processSubTreesAttrs :: (Tag.Name name -> Bool) ->+processSubTreesAttrs ::+   (Tag.Name name -> Bool) ->    (([Attr.T name str], [T i name str]) ->     ([Attr.T name str], [T i name str])) ->    Filter i name str@@ -438,7 +481,7 @@  mapTextA :: Applicative m =>    (String -> m String) ->-   (T i name String -> m (T i name String))+   (FilterA m i name String) mapTextA f =    liftA $    Tree.mapA@@ -480,7 +523,8 @@ escape :: T i name String -> T i name XmlString.T escape = fmap XmlString.fromUnicodeString -{-# DEPRECATED decodeSpecialChars, maybeDecodeSpecialChars, decodeSpecialCharsDecoder, decodeAttrs, decodeAttr, maybeDecodeUTF8Chars "XMLChar.Unicode constructors must contain unicode characters and not encoded ones. Decode characters before parsing!" #-}++{-# DEPRECATED decodeSpecialChars, maybeDecodeSpecialChars, decodeSpecialCharsDecoder, decodeAttrs, decodeAttr, maybeDecodeUTF8Chars "XmlChar.Unicode constructors must contain unicode characters and not encoded ones. Decode characters before parsing!" #-}  {- | Decode characters like those from UTF-8 scheme.
src/Text/XML/WraXML/Tree/HXT.hs view
@@ -20,7 +20,7 @@ import qualified Text.XML.Basic.Name as Name import qualified Text.XML.Basic.ProcessingInstruction as PI -import qualified Text.XML.Basic.Character as XMLChar+import qualified Text.XML.Basic.Character as XmlChar  -- needed for code copies from HXT at the of the file import Text.XML.HXT.DOM.XmlTree (QName, NTree, XNode, )@@ -113,9 +113,9 @@           HXT.XText str ->              leaf (Text True (XmlString.fromString str))           HXT.XCharRef ref ->-             leaf (Text False [XMLChar.fromCharRef ref])+             leaf (Text False [XmlChar.fromCharRef ref])           HXT.XEntityRef ref ->-             leaf (Text False [XMLChar.fromEntityRef ref])+             leaf (Text False [XmlChar.fromEntityRef ref])           HXT.XCmt cmt ->              leaf (Comment cmt)           HXT.XPi target proc ->
src/Text/XML/WraXML/Tree/HaXml.hs view
@@ -14,7 +14,7 @@  import qualified Text.XML.WraXML.String       as XmlString import qualified Text.XML.WraXML.String.HaXml as HaXmlString-import qualified Text.XML.Basic.Character as XMLChar+import qualified Text.XML.Basic.Character as XmlChar  import qualified Text.XML.Basic.Attribute as Attr import qualified Text.XML.Basic.Name as Name@@ -48,7 +48,7 @@       (\x i ->           case x of              Text whitespace str0 ->-                XMLChar.switchUnicodeRuns+                XmlChar.switchUnicodeRuns                    (flip (HaXml.CString whitespace) i)                    (flip HaXml.CRef i . HaXml.RefChar)                    (flip HaXml.CRef i . HaXml.RefEntity)
src/Text/XML/WraXML/Tree/TagSoup.hs view
@@ -65,7 +65,7 @@ -} {- toXmlTrees ::-   [Tag XMLChar] -> [XmlTree name String]+   [Tag XmlChar] -> [XmlTree name String] toXmlTrees =    toXmlTreesAux .    Tag.canonicalizeTags
src/Text/XML/WraXML/Tree/Tagchup.hs view
@@ -103,11 +103,11 @@    XmlTree.Leaf name string -> Tag.T name string fromLeaf leaf =    case leaf of-      XmlTree.Text  _ text -> Tag.Text text-      XmlTree.Comment text -> Tag.Comment text-      XmlTree.CData   text -> Tag.Special TagH.cdata text-      XmlTree.PI      name instr -> Tag.Processing name instr-      XmlTree.Warning text -> Tag.Warning text+      XmlTree.Text  _ text  -> Tag.text text+      XmlTree.Comment text  -> Tag.comment text+      XmlTree.CData   text  -> Tag.cdata text+      XmlTree.PI name instr -> Tag.processing name instr+      XmlTree.Warning text  -> Tag.warning text   liftElementFilter ::
wraxml.cabal view
@@ -1,25 +1,11 @@ Name:           wraxml-Version:        0.4.2+Version:        0.4.3 License:        GPL License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de> Maintainer:     Henning Thielemann <haskell@henning-thielemann.de> Homepage:       http://darcs.haskell.org/wraxml/-Category:       Text-Build-Depends:-  polyparse >=1.2 && <1.4,-  tagsoup >=0.6 && <0.7,-  tagchup >=0.3 && <0.4,-  xml-basic >=0.1 && <0.2,-  HaXml >=1.19.4 && <1.20,-  hxt >=8.1.0 && <9,-  hxt-filter >=8.1.1 && <9,-  transformers >=0.1 && <0.2,-  utility-ht >=0.0.4 && <0.1,-  explicit-exception >=0.1.3 && <0.2,-  data-accessor >=0.2 && <0.3,-  containers >=0.1 && <0.3,-  base >=3 && <4+Category:       XML Synopsis:   Lazy wrapper to HaXML, HXT, TagSoup via custom XML tree structure Description:   This is a wrapper to HaXML and HXT (Haskell XML Toolbox).@@ -55,32 +41,70 @@   leafs for XML strings and special tags,   and the labels for pointers to positions in the source file.   ("Text.XML.WraXML.Tree")-GHC-Options:    -Wall Build-Type:     Simple-Hs-source-dirs: src-Exposed-modules:-  Data.Tree.BranchLeafLabel-  Data.Tree.BranchLeaf-  Text.HTML.WraXML.Document-  Text.HTML.WraXML.Table-  Text.HTML.WraXML.Tree-  Text.HTML.WraXML.Tree.HXT-  Text.HTML.WraXML.String-  Text.HTML.WraXML.Entity-  Text.XML.WraXML.Position.HaXml-  Text.XML.WraXML.String-  Text.XML.WraXML.String.HaXml-  Text.XML.WraXML.String.HXT-  Text.XML.WraXML.Element-  Text.XML.WraXML.Tree-  Text.XML.WraXML.Tree.HaXml-  Text.XML.WraXML.Tree.HXT-  Text.XML.WraXML.Tree.TagSoup-  Text.XML.WraXML.Tree.Tagchup-  Text.XML.WraXML.Tree.Literal-  Text.XML.WraXML.Document-  Text.XML.WraXML.Document.TagSoup-  Text.XML.WraXML.Document.Tagchup-Other-Modules:-  Text.XML.WraXML.Utility-  Text.XML.WraXML.Tree.LazyParser+Cabal-Version:   >= 1.6++Source-Repository head+   Type:     darcs+   Location: http://darcs.haskell.org/wraxml/++Source-Repository this+   Type:     darcs+   Location: http://darcs.haskell.org/wraxml/+   Tag:      0.4.3++Flag buildExamples+   description: Build example executables+   default:     False++Library+  Build-Depends:+    polyparse >=1.2 && <1.4,+    tagsoup >=0.6 && <0.7,+    tagchup >=0.4 && <0.5,+    xml-basic >=0.1 && <0.2,+    HaXml >=1.19.4 && <1.20,+    hxt >=8.1.0 && <9,+    hxt-filter >=8.1.1 && <9,+    transformers >=0.1 && <0.2,+    utility-ht >=0.0.4 && <0.1,+    explicit-exception >=0.1.3 && <0.2,+    data-accessor >=0.2 && <0.3,+    containers >=0.1 && <0.3,+    base >=3 && <4+  GHC-Options:    -Wall+  Hs-source-dirs: src+  Exposed-modules:+    Data.Tree.BranchLeafLabel+    Data.Tree.BranchLeaf+    Text.HTML.WraXML.Document+    Text.HTML.WraXML.Table+    Text.HTML.WraXML.Tree+    Text.HTML.WraXML.Tree.HXT+    Text.HTML.WraXML.Element+    Text.HTML.WraXML.String+    Text.HTML.WraXML.Entity+    Text.XML.WraXML.Position.HaXml+    Text.XML.WraXML.String+    Text.XML.WraXML.String.HaXml+    Text.XML.WraXML.String.HXT+    Text.XML.WraXML.Element+    Text.XML.WraXML.Tree+    Text.XML.WraXML.Tree.HaXml+    Text.XML.WraXML.Tree.HXT+    Text.XML.WraXML.Tree.TagSoup+    Text.XML.WraXML.Tree.Tagchup+    Text.XML.WraXML.Tree.Literal+    Text.XML.WraXML.Document+    Text.XML.WraXML.Document.TagSoup+    Text.XML.WraXML.Document.Tagchup+  Other-Modules:+    Text.XML.WraXML.Utility+    Text.XML.WraXML.Tree.LazyParser++Executable escape-tidy-html+  If !flag(buildExamples)+    Buildable: False+  GHC-Options:    -Wall+  Hs-Source-Dirs: src, example+  Main-Is:        Escape.hs