xml-basic (empty) → 0.0.1
raw patch · 18 files changed
+1618/−0 lines, 18 filesdep +basedep +containersdep +data-accessorsetup-changed
Dependencies added: base, containers, data-accessor, explicit-exception, special-functors, utility-ht
Files
- LICENSE +31/−0
- Setup.lhs +3/−0
- src/Text/HTML/Basic/Character.hs +73/−0
- src/Text/HTML/Basic/Entity.hs +326/−0
- src/Text/HTML/Basic/Tag.hs +177/−0
- src/Text/XML/Basic/Attribute.hs +215/−0
- src/Text/XML/Basic/Character.hs +198/−0
- src/Text/XML/Basic/Entity.hs +100/−0
- src/Text/XML/Basic/Format.hs +66/−0
- src/Text/XML/Basic/Name.hs +37/−0
- src/Text/XML/Basic/Name/LowerCase.hs +30/−0
- src/Text/XML/Basic/Name/MixedCase.hs +24/−0
- src/Text/XML/Basic/Name/Qualified.hs +43/−0
- src/Text/XML/Basic/Position.hs +93/−0
- src/Text/XML/Basic/ProcessingInstruction.hs +68/−0
- src/Text/XML/Basic/Tag.hs +40/−0
- src/Text/XML/Basic/Utility.hs +33/−0
- xml-basic.cabal +61/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2009, Henning Thielemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The names of contributors may not be used to endorse or promote+ products derived from this software without specific prior+ written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ src/Text/HTML/Basic/Character.hs view
@@ -0,0 +1,73 @@+module Text.HTML.Basic.Character (+ T(..), toUnicode, toUnicodeOrFormat,+ fromUnicode, fromCharRef, fromEntityRef,+ maybeUnicode, maybeCharRef, maybeEntityRef,+ isUnicode, isCharRef, isEntityRef, isRef,+ unicode, refC, refE,+ asciiFromUnicode,+ asciiFromUnicodeInternetExploder,+ reduceRef,+ validCharRef, switchUnicodeRuns,+ isLower, isUpper, toLower, toUpper,+ ) where++import Text.XML.Basic.Character+ hiding (toUnicode, toUnicodeOrFormat, asciiFromUnicode, reduceRef, )+import qualified Text.HTML.Basic.Entity as Ent+import qualified Data.Char as Char+import qualified Data.Map as Map+import Data.Maybe (fromMaybe, )++import qualified Control.Monad.Exception.Synchronous as Exc+++toUnicode :: T -> Exc.Exceptional String Char+toUnicode = toUnicodeGen Ent.mapNameToChar++toUnicodeOrFormat :: T -> ShowS+toUnicodeOrFormat =+ toUnicodeOrFormatGen Ent.mapNameToChar++{-|+Convert unicode character to XML Char.+If there is a named reference, use this.+If it is ASCII, represent it as Char.+Otherwise use a numeric reference.+-}+asciiFromUnicode :: Char -> T+asciiFromUnicode =+ asciiFromUnicodeGen Ent.mapCharToName++asciiFromUnicodeInternetExploder :: Char -> T+asciiFromUnicodeInternetExploder =+ asciiFromUnicodeGen Ent.mapCharToNameInternetExploder++reduceRef :: T -> T+reduceRef = reduceRefGen Ent.mapNameToChar+++isLower :: T -> Bool+isLower =+ Exc.switch (const False) Char.isLower . toUnicode++isUpper :: T -> Bool+isUpper =+ Exc.switch (const False) Char.isUpper . toUnicode+++toLower :: T -> T+toLower = lift Char.toLower++toUpper :: T -> T+toUpper = lift Char.toUpper++lift :: (Char -> Char) -> T -> T+lift f x =+ case x of+ Unicode c -> Unicode $ f c+ CharRef n -> CharRef $+ if validCharRef n then Char.ord $ f $ Char.chr n else n+ EntityRef n -> EntityRef $+ fromMaybe n $+ flip Map.lookup Ent.mapCharToName . f+ =<< flip Map.lookup Ent.mapNameToChar n
+ src/Text/HTML/Basic/Entity.hs view
@@ -0,0 +1,326 @@+-- this should be in Text.HTML but then we provoke name clashes+module Text.HTML.Basic.Entity (+ Name,+ list, listInternetExploder,+ mapNameToChar,+ mapCharToName, mapCharToNameInternetExploder,+ mapNameToUpper, mapNameToLower,+ XMLEnt.numberToChar,+ ) where++import qualified Text.XML.Basic.Entity as XMLEnt+import Data.Maybe (mapMaybe, )+import Data.Maybe.HT (toMaybe, )+import Data.Tuple.HT (swap, mapSnd, )++import qualified Data.Map as Map+import Data.Char (chr, toLower, )+++type Name = String++mapNameToChar :: Map.Map Name Char+mapNameToChar =+ Map.fromList list++mapCharToName :: Map.Map Char Name+mapCharToName =+ Map.fromList $ map swap list++mapCharToNameInternetExploder :: Map.Map Char Name+mapCharToNameInternetExploder =+ Map.fromList $ map swap listInternetExploder+++mapNameToUpper :: Map.Map String String+mapNameToUpper =+ Map.fromList $ map swap upperLowerPairs++mapNameToLower :: Map.Map String String+mapNameToLower =+ Map.fromList upperLowerPairs++{-+Maybe it would be cleaner to convert a name to a character+and then use 'Char.toLower' or 'Char.toUpper'.+-}+upperLowerPairs :: [(String, String)]+upperLowerPairs =+ mapMaybe+ (\(name,_) ->+ let lname = map toLower name+ in toMaybe+ (lname /= name && Map.member lname mapNameToChar)+ (name,lname))+ listAdditional++++{- |+A table mapping HTML entity names to code points.+Although entity references can in principle represent more than one character,+the standard entities only contain one character.+-}+list :: [(Name, Char)]+list =+ XMLEnt.list ++ listAdditional++listInternetExploder :: [(Name, Char)]+listInternetExploder =+ XMLEnt.listInternetExploder ++ listAdditional++listAdditional :: [(Name, Char)]+listAdditional =+ map (mapSnd chr) $+ ("nbsp", 160) :+ ("iexcl", 161) :+ ("cent", 162) :+ ("pound", 163) :+ ("curren", 164) :+ ("yen", 165) :+ ("brvbar", 166) :+ ("sect", 167) :+ ("uml", 168) :+ ("copy", 169) :+ ("ordf", 170) :+ ("laquo", 171) :+ ("not", 172) :+ ("shy", 173) :+ ("reg", 174) :+ ("macr", 175) :+ ("deg", 176) :+ ("plusmn", 177) :+ ("sup2", 178) :+ ("sup3", 179) :+ ("acute", 180) :+ ("micro", 181) :+ ("para", 182) :+ ("middot", 183) :+ ("cedil", 184) :+ ("sup1", 185) :+ ("ordm", 186) :+ ("raquo", 187) :+ ("frac14", 188) :+ ("frac12", 189) :+ ("frac34", 190) :+ ("iquest", 191) :+ ("Agrave", 192) :+ ("Aacute", 193) :+ ("Acirc", 194) :+ ("Atilde", 195) :+ ("Auml", 196) :+ ("Aring", 197) :+ ("AElig", 198) :+ ("Ccedil", 199) :+ ("Egrave", 200) :+ ("Eacute", 201) :+ ("Ecirc", 202) :+ ("Euml", 203) :+ ("Igrave", 204) :+ ("Iacute", 205) :+ ("Icirc", 206) :+ ("Iuml", 207) :+ ("ETH", 208) :+ ("Ntilde", 209) :+ ("Ograve", 210) :+ ("Oacute", 211) :+ ("Ocirc", 212) :+ ("Otilde", 213) :+ ("Ouml", 214) :+ ("times", 215) :+ ("Oslash", 216) :+ ("Ugrave", 217) :+ ("Uacute", 218) :+ ("Ucirc", 219) :+ ("Uuml", 220) :+ ("Yacute", 221) :+ ("THORN", 222) :+ ("szlig", 223) :+ ("agrave", 224) :+ ("aacute", 225) :+ ("acirc", 226) :+ ("atilde", 227) :+ ("auml", 228) :+ ("aring", 229) :+ ("aelig", 230) :+ ("ccedil", 231) :+ ("egrave", 232) :+ ("eacute", 233) :+ ("ecirc", 234) :+ ("euml", 235) :+ ("igrave", 236) :+ ("iacute", 237) :+ ("icirc", 238) :+ ("iuml", 239) :+ ("eth", 240) :+ ("ntilde", 241) :+ ("ograve", 242) :+ ("oacute", 243) :+ ("ocirc", 244) :+ ("otilde", 245) :+ ("ouml", 246) :+ ("divide", 247) :+ ("oslash", 248) :+ ("ugrave", 249) :+ ("uacute", 250) :+ ("ucirc", 251) :+ ("uuml", 252) :+ ("yacute", 253) :+ ("thorn", 254) :+ ("yuml", 255) :++ ("OElig", 338) :+ ("oelig", 339) :+ ("Scaron", 352) :+ ("scaron", 353) :+ ("Yuml", 376) :+ ("circ", 710) :+ ("tilde", 732) :++ ("ensp", 8194) :+ ("emsp", 8195) :+ ("thinsp", 8201) :+ ("zwnj", 8204) :+ ("zwj", 8205) :+ ("lrm", 8206) :+ ("rlm", 8207) :+ ("ndash", 8211) :+ ("mdash", 8212) :+ ("lsquo", 8216) :+ ("rsquo", 8217) :+ ("sbquo", 8218) :+ ("ldquo", 8220) :+ ("rdquo", 8221) :+ ("bdquo", 8222) :+ ("dagger", 8224) :+ ("Dagger", 8225) :+ ("permil", 8240) :+ ("lsaquo", 8249) :+ ("rsaquo", 8250) :+ ("euro", 8364) :++ ("fnof", 402) :+ ("Alpha", 913) :+ ("Beta", 914) :+ ("Gamma", 915) :+ ("Delta", 916) :+ ("Epsilon", 917) :+ ("Zeta", 918) :+ ("Eta", 919) :+ ("Theta", 920) :+ ("Iota", 921) :+ ("Kappa", 922) :+ ("Lambda", 923) :+ ("Mu", 924) :+ ("Nu", 925) :+ ("Xi", 926) :+ ("Omicron", 927) :+ ("Pi", 928) :+ ("Rho", 929) :+ ("Sigma", 931) :+ ("Tau", 932) :+ ("Upsilon", 933) :+ ("Phi", 934) :+ ("Chi", 935) :+ ("Psi", 936) :+ ("Omega", 937) :+ ("alpha", 945) :+ ("beta", 946) :+ ("gamma", 947) :+ ("delta", 948) :+ ("epsilon", 949) :+ ("zeta", 950) :+ ("eta", 951) :+ ("theta", 952) :+ ("iota", 953) :+ ("kappa", 954) :+ ("lambda", 955) :+ ("mu", 956) :+ ("nu", 957) :+ ("xi", 958) :+ ("omicron", 959) :+ ("pi", 960) :+ ("rho", 961) :+ ("sigmaf", 962) :+ ("sigma", 963) :+ ("tau", 964) :+ ("upsilon", 965) :+ ("phi", 966) :+ ("chi", 967) :+ ("psi", 968) :+ ("omega", 969) :+ ("thetasym", 977) :+ ("upsih", 978) :+ ("piv", 982) :+ ("bull", 8226) :+ ("hellip", 8230) :+ ("prime", 8242) :+ ("Prime", 8243) :+ ("oline", 8254) :+ ("frasl", 8260) :+ ("weierp", 8472) :+ ("image", 8465) :+ ("real", 8476) :+ ("trade", 8482) :+ ("alefsym", 8501) :+ ("larr", 8592) :+ ("uarr", 8593) :+ ("rarr", 8594) :+ ("darr", 8595) :+ ("harr", 8596) :+ ("crarr", 8629) :+ ("lArr", 8656) :+ ("uArr", 8657) :+ ("rArr", 8658) :+ ("dArr", 8659) :+ ("hArr", 8660) :+ ("forall", 8704) :+ ("part", 8706) :+ ("exist", 8707) :+ ("empty", 8709) :+ ("nabla", 8711) :+ ("isin", 8712) :+ ("notin", 8713) :+ ("ni", 8715) :+ ("prod", 8719) :+ ("sum", 8721) :+ ("minus", 8722) :+ ("lowast", 8727) :+ ("radic", 8730) :+ ("prop", 8733) :+ ("infin", 8734) :+ ("ang", 8736) :+ ("and", 8743) :+ ("or", 8744) :+ ("cap", 8745) :+ ("cup", 8746) :+ ("int", 8747) :+ ("there4", 8756) :+ ("sim", 8764) :+ ("cong", 8773) :+ ("asymp", 8776) :+ ("ne", 8800) :+ ("equiv", 8801) :+ ("le", 8804) :+ ("ge", 8805) :+ ("sub", 8834) :+ ("sup", 8835) :+ ("nsub", 8836) :+ ("sube", 8838) :+ ("supe", 8839) :+ ("oplus", 8853) :+ ("otimes", 8855) :+ ("perp", 8869) :+ ("sdot", 8901) :+ ("lceil", 8968) :+ ("rceil", 8969) :+ ("lfloor", 8970) :+ ("rfloor", 8971) :+ ("lang", 9001) :+ ("rang", 9002) :+ ("loz", 9674) :+ ("spades", 9824) :+ ("clubs", 9827) :+ ("hearts", 9829) :+ ("diams", 9830) :+ []
+ src/Text/HTML/Basic/Tag.hs view
@@ -0,0 +1,177 @@+{- |+We do not define a tag data type here,+since this is too much bound to the particular use+(e.g. list or tree structure).+However we define a tag name and several+-}+module Text.HTML.Basic.Tag (+ Tag.Name(..),+ Tag.doctype, Tag.doctypeString,+ Tag.cdata, Tag.cdataString,+ isEmpty, isSloppy, isInnerOf, closes,+ ) where+++import Text.XML.Basic.Tag (Name, )++import qualified Text.XML.Basic.Tag as Tag+import qualified Text.XML.Basic.Name as Name++import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Tuple.HT (mapFst, )+++{- |+Check whether a HTML tag is empty.+-}+isEmpty :: (Name.Tag name, Ord name) =>+ Name name -> Bool+isEmpty = flip Set.member emptySet++{- |+Set of empty HTML tags.+-}+emptySet :: (Name.Tag name, Ord name) =>+ Set.Set (Name name)+emptySet =+ nameSet $+ "area" :+ "base" :+ "br" :+ "col" :+ "frame" :+ "hr" :+ "img" :+ "input" :+ "link" :+ "meta" :+ "param" :+ []+++{- |+Some tags, namely those for text styles like FONT, B, I,+are used quite sloppily.+That is, they are not terminated or not terminated in the right order.+We close them implicitly, if another tag closes+and ignore non-matching closing tags.+-}+isSloppy :: (Name.Tag name, Ord name) =>+ Name name -> Bool+isSloppy = flip Set.member sloppySet++{-+Example page:+http://extremetracking.com/open;unique?login=crsucks+-}++sloppySet :: (Name.Tag name, Ord name) =>+ Set.Set (Name name)+sloppySet =+ nameSet $+ "font" :+ "b" :+ "i" :+ "tt" :+ "u" :+ "strike" :+ "s" :+ "big" :+ "small" :+ []+++isInnerOf :: (Name.Tag name, Ord name) =>+ Name name -> Name name -> Bool+isInnerOf outer inner =+ maybe False (Set.member inner) $+ Map.lookup outer innerMap+++innerMap :: (Name.Tag name, Ord name) =>+ Map.Map (Name name) (Set.Set (Name name))+innerMap =+ nameMap $+ ("body", pSet) :+ ("caption", pSet) :+ ("dd", pSet) :+ ("div", pSet) :+ ("dl", dtdSet) :+ ("dt", pSet) :+ ("li", pSet) :+ ("map", pSet) :+ ("object", pSet) :+ ("ol", liSet) :+ ("table", nameSet ["th","tr","td","thead","tfoot","tbody"]) :+ ("tbody", thdrSet) :+ ("td", pSet) :+ ("tfoot", thdrSet) :+ ("th", pSet) :+ ("thead", thdrSet) :+ ("tr", thdSet) :+ ("ul", liSet) :+ []+++closes :: (Name.Tag name, Ord name) =>+ Name name -> Name name -> Bool+closes closing opening =+ (not (Name.match "option" closing) && Name.match "select" opening) ||+ (Name.matchAny ["option", "script", "style","textarea","title"] opening) ||+ (maybe False (Set.member opening) $+ Map.lookup closing closesMap)+++closesMap :: (Name.Tag name, Ord name) =>+ Map.Map (Name name) (Set.Set (Name name))+closesMap =+ nameMap $+ ("a" , nameSingle "a") :+ ("li" , liSet) :+ ("th" , thdSet) :+ ("td" , thdSet) :+ ("tr" , thdrSet) :+ ("dt" , dtdSet) :+ ("dd" , dtdSet) :+ ("hr" , pSet) :+ ("colgroup" , nameSingle "colgroup") :+ ("form" , nameSingle "form") :+ ("label" , nameSingle "label") :+ ("map" , nameSingle "map") :+ ("object" , nameSingle "object") :+ ("thead" , nameSet ["colgroup"]) :+ ("tfoot" , nameSet ["thead", "colgroup"]) :+ ("tbody" , nameSet ["tbody", "tfoot", "thead", "colgroup"]) :+ ("h1" , headingSet) :+ ("h2" , headingSet) :+ ("h3" , headingSet) :+ ("h4" , headingSet) :+ ("h5" , headingSet) :+ ("h6" , headingSet) :+ ("dl" , headingSet) :+ ("ol" , headingSet) :+ ("ul" , headingSet) :+ ("table" , headingSet) :+ ("div" , headingSet) :+ ("p" , headingSet) :+ []+++nameMap :: (Name.Tag name, Ord name) => [(String,a)] -> Map.Map (Name name) a+nameMap = Map.fromList . map (mapFst Name.fromString)++nameSet :: (Name.Tag name, Ord name) => [String] -> Set.Set (Name name)+nameSet = Set.fromList . map Name.fromString++nameSingle :: (Name.Tag name, Ord name) => String -> Set.Set (Name name)+nameSingle = Set.singleton . Name.fromString++pSet, dtdSet, thdSet, thdrSet, liSet, headingSet ::+ (Name.Tag name, Ord name) => Set.Set (Name name)+pSet = nameSet ["p"]+dtdSet = nameSet ["dt","dd"]+thdSet = nameSet ["th","td"]+thdrSet = nameSet ["th","td","tr"]+liSet = nameSet ["li"]+headingSet = nameSet ["h1","h2","h3","h4","h5","h6","p" {- not "div" -}]
+ src/Text/XML/Basic/Attribute.hs view
@@ -0,0 +1,215 @@+module Text.XML.Basic.Attribute where++import qualified Text.XML.Basic.Name as Name+import qualified Text.XML.Basic.Format as Fmt++import Text.XML.Basic.Utility (updateAppend, )++import qualified Data.Accessor.Basic as Accessor++import Data.Foldable (Foldable(foldMap), )+import Data.Traversable (Traversable, sequenceA, traverse, )+import Control.Applicative (Applicative, pure, liftA, )++import qualified Data.List as List++import Prelude hiding (any, )+++{- | An HTML attribute @id=\"name\"@ generates @(\"id\",\"name\")@ -}+data T name string =+ Cons {+ name_ :: Name name,+ value_ :: string+ } deriving (Eq, Ord)++cons :: (Name.Attribute name) => Name name -> string -> T name string+cons = Cons++new :: (Name.Attribute name) => String -> string -> T name string+new n v = Cons (Name.fromString n) v++lift ::+ (Name name -> string -> (Name name, string)) ->+ T name string -> T name string+lift f (Cons n v) = uncurry Cons $ f n v++toPair :: (Name.Attribute name) => T name string -> (String, string)+toPair (Cons n v) = (Name.toString n, v)++fromPair :: (Name.Attribute name) => (String, string) -> T name string+fromPair (n,v) = Cons (Name.fromString n) v++name :: Accessor.T (T name string) (Name name)+name = Accessor.fromSetGet (\n p -> p{name_ = n}) name_++value :: Accessor.T (T name string) string+value = Accessor.fromSetGet (\n p -> p{value_ = n}) value_+++instance (Name.Attribute name, Show string) => Show (T name string) where+ showsPrec p = showsPrec p . toPair++instance (Name.Attribute name, Fmt.C string) => Fmt.C (T name string) where+ run attr =+ Fmt.name (name_ attr) . Fmt.eq .+ Fmt.stringQuoted (Fmt.run (value_ attr) "")++{- |+Each attribute is preceded by a space,+that is there is a space between adjacent attributes+and one leading space.+-}+formatListBlankHead ::+ (Name.Attribute name, Fmt.C string) =>+ [T name string] -> ShowS+formatListBlankHead =+ Fmt.many (\attr -> Fmt.blank . Fmt.run attr)++instance Functor (T name) where+ fmap f (Cons n v) = Cons n (f v)++instance Foldable (T name) where+ foldMap f (Cons _n v) = f v++instance Traversable (T name) where+ sequenceA (Cons n v) = liftA (Cons n) v++++mapName :: (name0 -> name1) -> T name0 string -> T name1 string+mapName f (Cons (Name n) v) = Cons (Name $ f n) v++++newtype Name ident = Name {unname :: ident}+ deriving (Eq, Ord)++instance Show ident => Show (Name ident) where+ showsPrec p = showsPrec p . unname++instance Name.Attribute ident => Name.C (Name ident) where+ fromString = Name . Name.attributeFromString+ toString = Name.attributeToString . unname+++-- * attribute lists++mapValues ::+ (str0 -> str1) ->+ ([T name str0] -> [T name str1])+mapValues f =+ map (fmap f)++mapValuesA :: Applicative f =>+ (str0 -> f str1) ->+ ([T name str0] -> f [T name str1])+mapValuesA f =+ traverse (traverse f)+++{- |+Process specific attributes of an attribute list.+The function name is inspired by Data.Map.+-}+adjustOn ::+ (Name name -> Bool) ->+ (string -> string) ->+ ([T name string] -> [T name string])+adjustOn p f =+ map (\attr ->+ fmap (if p (name_ attr) then f else id) attr)++adjustOnA :: Applicative f =>+ (Name name -> Bool) ->+ (string -> f string) ->+ ([T name string] -> f [T name string])+adjustOnA p f =+ traverse (\attr ->+ traverse (if p (name_ attr) then f else pure) attr)+++insert ::+ (Name.Attribute name, Eq name) =>+ Name name ->+ string ->+ ([T name string] -> [T name string])+insert = insertWith const++{- |+Insert an attribute into an attribute list.+If an attribute with the same name is already present,+then the value of this attribute is changed to @f newValue oldValue@.+The function name is analogous to Data.Map.+-}+insertWith ::+ (Name.Attribute name, Eq name) =>+ (string -> string -> string) ->+ Name name ->+ string ->+ ([T name string] -> [T name string])+insertWith f n v =+ updateAppend+ ((n ==) . name_)+ (Cons n v)+ (fmap (f v))+++-- * match attributes++match ::+ (Name.Attribute name, Eq name, Eq string) =>+ String -> string -> T name string -> Bool+match n v attr =+ Name.match n (name_ attr) && v == value_ attr++{- |+@matchManyValues name [value0, value1] attrs@+checks whether @(name, value0)@ or @(name, value1)@+is contained in @attrs@.+The values are handled case-sensitive.+-}+matchAnyValue ::+ (Name.Attribute name, Eq name, Eq string) =>+ String -> [string] -> T name string -> Bool+matchAnyValue n vs attr =+ Name.match n (name_ attr) && elem (value_ attr) vs+++lookup ::+ (Name.Attribute name, Eq name) =>+ Name name -> [T name string] -> Maybe string+lookup n =+ fmap value_ .+ List.find ((n==) . name_)++lookupLit ::+ (Name.Attribute name, Eq name) =>+ String -> [T name string] -> Maybe string+lookupLit n =+ fmap value_ .+ List.find (Name.match n . name_)+++any :: (T name string -> Bool) -> [T name string] -> Bool+any = List.any++anyName :: (Name name -> Bool) -> [T name string] -> Bool+anyName p = any (p . name_)++anyValue :: (string -> Bool) -> [T name string] -> Bool+anyValue p = any (p . value_)+++anyLit ::+ (Eq name, Name.Attribute name, Eq string) =>+ String -> string -> [T name string] -> Bool+anyLit n v = any (match n v)++anyNameLit ::+ (Eq name, Name.Attribute name) =>+ String -> [T name string] -> Bool+anyNameLit n = anyName (Name.match n)++anyValueLit :: (Eq string) => string -> [T name string] -> Bool+anyValueLit v = anyValue (v==)
+ src/Text/XML/Basic/Character.hs view
@@ -0,0 +1,198 @@+{-|+All kinds of representations of a character in XML combined in one type.+Note that an entity can in principle represent a large text,+thus an \"XML character\" might actually be a text.+However the standard entities consist of one character.+In contrast to our representation,+HaXml uses Unicode substrings instead of Unicode characters,+which is certainly more efficient for common XML texts+that contain mainly Unicode text and only few references.+However our representation is unique,+whereas HaXmls may represent a text as @"abc","def"@ or @"abcdef"@.+-}+module Text.XML.Basic.Character (+ T(..), toUnicode, toUnicodeGen,+ toUnicodeOrFormat, toUnicodeOrFormatGen,+ fromUnicode, fromCharRef, fromEntityRef,+ maybeUnicode, maybeCharRef, maybeEntityRef,+ isUnicode, isCharRef, isEntityRef, isRef,+ unicode, refC, refE,+ asciiFromUnicode, asciiFromUnicodeGen,+ reduceRef, reduceRefGen,+ validCharRef, switchUnicodeRuns,+ ) where++import qualified Text.XML.Basic.Format as Fmt+import qualified Text.XML.Basic.Entity as Ent+import qualified Data.Map as Map+import qualified Data.Char as Char+import Data.Maybe.HT (toMaybe, )+import Data.Tuple.HT (mapFst, )+import Control.Monad (mplus, )++import qualified Control.Monad.Exception.Synchronous as Exc+++data T =+ Unicode Char+ | CharRef Int+ | EntityRef String+ deriving (Eq)++{- |+If a reference cannot be resolved+then an @Exception@ constructor with an error message is returned.+-}+toUnicode :: T -> Exc.Exceptional String Char+toUnicode =+ toUnicodeGen Ent.mapNameToChar++toUnicodeGen :: Map.Map String Char -> T -> Exc.Exceptional String Char+toUnicodeGen _ (Unicode c) = Exc.Success c+toUnicodeGen _ (CharRef c) =+ if validCharRef c+ then Exc.Success $ Char.chr c+ else Exc.Exception $ "Character number out of bound: " ++ show c+toUnicodeGen dict (EntityRef name) =+ maybe (Exc.Exception $ "Unknown entity &" ++ name ++ ";") Exc.Success $+ Map.lookup name dict+++{- |+If a reference cannot be resolved+then a reference string is returned.+-}+toUnicodeOrFormat :: T -> ShowS+toUnicodeOrFormat =+ toUnicodeOrFormatGen Ent.mapNameToChar++toUnicodeOrFormatGen :: Map.Map String Char -> T -> ShowS+toUnicodeOrFormatGen dict =+ Fmt.run . reduceRefGen dict+++fromUnicode :: Char -> T+fromUnicode = Unicode++fromCharRef :: Int -> T+fromCharRef = CharRef++fromEntityRef :: String -> T+fromEntityRef = EntityRef+++maybeUnicode :: T -> Maybe Char+maybeUnicode (Unicode c) = Just c+maybeUnicode _ = Nothing++maybeCharRef :: T -> Maybe Int+maybeCharRef (CharRef n) = Just n+maybeCharRef _ = Nothing++maybeEntityRef :: T -> Maybe String+maybeEntityRef (EntityRef s) = Just s+maybeEntityRef _ = Nothing+++isUnicode :: T -> Bool+isUnicode (Unicode _) = True+isUnicode _ = False++isCharRef :: T -> Bool+isCharRef (CharRef _) = True+isCharRef _ = False++isEntityRef :: T -> Bool+isEntityRef (EntityRef _) = True+isEntityRef _ = False++isRef :: T -> Bool+isRef x = isCharRef x && isEntityRef x++++{-|+Convert unicode character to XML Char.+If there is a entity reference, use this.+If it is ASCII, represent it as Char.+Otherwise use a character reference.+-}+asciiFromUnicode :: Char -> T+asciiFromUnicode =+ asciiFromUnicodeGen Ent.mapCharToName++asciiFromUnicodeGen :: Map.Map Char String -> Char -> T+asciiFromUnicodeGen dict c =+ maybe+ (if Char.isAscii c+ then fromUnicode c+ else fromCharRef (Char.ord c))+ fromEntityRef $+ Map.lookup c dict+++-- * shortcuts for making the output of the Show instance valid++unicode :: Char -> T+unicode = Unicode++refC :: Int -> T+refC = fromCharRef++refE :: String -> T+refE = fromEntityRef+++switchUnicodeRuns ::+ (String -> a) -> (Int -> a) -> (String -> a) ->+ [T] -> [a]+switchUnicodeRuns uni charRef entRef =+ let prepend (Unicode c) rest =+ mapFst (Left . (c:)) $+ case rest of+ (Left s : ss) -> (s, ss)+ _ -> ([], rest)+ prepend (CharRef n) rest = (Right (charRef n), rest)+ prepend (EntityRef n) rest = (Right (entRef n), rest)+ in map (either uni id) .+ foldr (\c -> uncurry (:) . prepend c) []+++instance Show T where+ showsPrec prec a =+ showParen (prec >= 10) $+ case a of+ Unicode c -> showString "unicode " . shows c+ CharRef n -> showString "refC " . shows n+ EntityRef n -> showString "refE " . shows n+ showList =+ showParen True .+ foldr (.) (showString "[]") .+ switchUnicodeRuns+ (\str -> showString "map unicode " . shows str . showString " ++ ")+ (\n -> showString "refC " . shows n . showString " : ")+ (\n -> showString "refE " . shows n . showString " : ")+++instance Fmt.C T where+ run (Unicode c) = (c:)+ run (CharRef n) = Fmt.amp . Fmt.sharp . shows n . Fmt.semicolon+ run (EntityRef n) = Fmt.amp . (n++) . Fmt.semicolon++++reduceRef :: T -> T+reduceRef = reduceRefGen Ent.mapNameToChar++{- | try to convert a References to equivalent Unicode characters -}+reduceRefGen :: Map.Map String Char -> T -> T+reduceRefGen dict x =+ maybe x Unicode $+ mplus+ (flip Map.lookup dict =<< maybeEntityRef x)+ (do n <- maybeCharRef x+ toMaybe (validCharRef n) (Char.chr n))++validCharRef :: Int -> Bool+validCharRef n =+ 0 <= n && n <= Char.ord maxBound
+ src/Text/XML/Basic/Entity.hs view
@@ -0,0 +1,100 @@+module Text.XML.Basic.Entity (+ Name,+ list, listInternetExploder,+ mapNameToChar, mapCharToName,+ numberToChar,+ ) where++import qualified Data.Map as Map+import qualified Data.Char as Char+import Control.Monad.Exception.Synchronous (Exceptional, assert, throw, )+import Data.Monoid (Monoid(mempty, mappend), mconcat, )+import Data.Tuple.HT (swap, )+++{- |+Lookup a numeric entity, the leading @\'#\'@ must have already been removed.++> numberToChar "65" == Success 'A'+> numberToChar "x41" == Success 'A'+> numberToChar "x4E" === Success 'N'+> numberToChar "x4e" === Success 'N'+> numberToChar "Haskell" == Exception "..."+> numberToChar "" == Exception "..."+> numberToChar "89439085908539082" == Exception "..."++It's safe to use that for arbitrary big number strings,+since we abort parsing as soon as possible.++> numberToChar (repeat '1') == Exception "..."+-}+numberToChar :: String -> Exceptional String Char+numberToChar s =+ fmap Char.chr $+ case s of+ ('x':ds) -> readBounded 16 Char.isHexDigit ds+ ds -> readBounded 10 Char.isDigit ds++{- |+We fail on leading zeros in order to prevent infinite loop on @repeat '0'@.+This function assumes that @16 * ord maxBound@ is always representable as @Int@.+-}+readBounded :: Int -> (Char -> Bool) -> String -> Exceptional String Int+readBounded base validChar str =+ case str of+ "" -> throw "empty number string"+ "0" -> return 0+ _ ->+ let m digit =+ Update $ \mostSig ->+ let n = mostSig*base + Char.digitToInt digit+ in assert ("invalid character "++show digit)+ (validChar digit) >>+ assert "leading zero not allowed for security reasons"+ (not (mostSig==0 && digit=='0')) >>+ assert "number too big"+ (n <= Char.ord maxBound) >>+ return n+ in evalUpdate (mconcat $ map m str) 0+++newtype Update e a = Update {evalUpdate :: a -> Exceptional e a}++instance Monoid (Update e a) where+ mempty = Update return+ mappend (Update x) (Update y) =+ Update (\a -> x a >>= y)+-- Update (x>=>y)++++type Name = String++mapNameToChar :: Map.Map Name Char+mapNameToChar =+ Map.fromList list++mapCharToName :: Map.Map Char Name+mapCharToName =+ Map.fromList $ map swap list++{- |+A table mapping XML entity names to code points.+Although entity references can in principle represent more than one character,+the standard entities only contain one character.+-}+list :: [(Name, Char)]+list =+ ("apos", '\'') :+ listInternetExploder++{- |+This list excludes @apos@ as Internet Explorer does not know about it.+-}+listInternetExploder :: [(Name, Char)]+listInternetExploder =+ ("quot", '"') :+ ("amp", '&') :+ ("lt", '<') :+ ("gt", '>') :+ []
+ src/Text/XML/Basic/Format.hs view
@@ -0,0 +1,66 @@+module Text.XML.Basic.Format where++import qualified Text.XML.Basic.Name as Name++import Prelude hiding (quot)+++class C object where+ run :: object -> ShowS++instance C Char where+ run = showChar++instance C object => C [object] where+ run = many run+++{-+adapted from HXT++import Text.XML.HXT.DOM.ShowXml+ (showBlank, showQuoteString,+ showEq, showLt, showGt, showSlash)+-}++nl, blank,+ eq, lt, gt, slash, amp, sharp, colon, semicolon,+ apos, quot, lpar, rpar, exclam, quest :: ShowS++nl = showChar '\n'+blank = showChar ' '+eq = showChar '='+lt = showChar '<'+gt = showChar '>'+slash = showChar '/'+amp = showChar '&'+sharp = showChar '#'+colon = showChar ':'+semicolon = showChar ';'+apos = showChar '\''+quot = showChar '\"'+lpar = showChar '('+rpar = showChar ')'+exclam = showChar '!'+quest = showChar '?'+++angle :: ShowS -> ShowS+angle s = lt . s . gt++{- |+Internet Explorer does not recognize '+and thus we have to format it literally.+-}+stringQuoted :: String -> ShowS+stringQuoted s =+ if elem '\'' s+ then quot . showString s . quot+ else apos . showString s . apos++name :: Name.C name => name -> ShowS+name n =+ showString (Name.toString n)++many :: (a -> ShowS) -> [a] -> ShowS+many s = foldr (.) id . map s
+ src/Text/XML/Basic/Name.hs view
@@ -0,0 +1,37 @@+{- |+We provide a type class for tag and attribute names.+Instances can be names that preserve case,+names with lowercase letters as canonical representation.+To do: Qualified names.+-}+module Text.XML.Basic.Name where++-- * types and classes++class C name where+ fromString :: String -> name+ toString :: name -> String+++{- |+We need to distinguish between tag names and attribute names,+because DOCTYPE as tag name must be written upper case,+whereas as attribute name it may be written either way.+-}+class Tag ident where+ tagFromString :: String -> ident+ tagToString :: ident -> String++class Attribute ident where+ attributeFromString :: String -> ident+ attributeToString :: ident -> String++++-- * convenience functions++match :: (C name, Eq name) => String -> name -> Bool+match proto = (fromString proto ==)++matchAny :: (C name, Eq name) => [String] -> name -> Bool+matchAny proto = flip elem (map fromString proto)
+ src/Text/XML/Basic/Name/LowerCase.hs view
@@ -0,0 +1,30 @@+{- |+This name uses only lowercase characters as canonical representation,+except for @DOCTYPE@ and @CDATA@.+This is optimal for processing HTML which is case-insensitiv.+-}+module Text.XML.Basic.Name.LowerCase where++import qualified Text.XML.Basic.Name as Name+import qualified Text.XML.Basic.Tag as Tag+import Data.Char (toLower, toUpper, )+++newtype T = Cons String+ deriving (Eq, Ord)+++instance Show T where+ showsPrec p (Cons s) = showsPrec p s++instance Name.Tag T where+ tagFromString x = Cons $+ let xu = map toUpper x+ in if elem xu $ [Tag.doctypeString, Tag.cdataString]+ then xu+ else map toLower x+ tagToString (Cons s) = s++instance Name.Attribute T where+ attributeFromString = Cons . map toLower+ attributeToString (Cons s) = s
+ src/Text/XML/Basic/Name/MixedCase.hs view
@@ -0,0 +1,24 @@+{- |+This name type preserves the characters case of its input.+This is the right choice for case-sensitive names (XML)+or if you like to preserve case of HTML tags.+In the latter case it is however more difficult to match tag names.+-}+module Text.XML.Basic.Name.MixedCase where++import qualified Text.XML.Basic.Name as Name+++newtype T = Cons String+ deriving (Eq, Ord)++instance Show T where+ showsPrec p (Cons s) = showsPrec p s++instance Name.Tag T where+ tagFromString = Cons+ tagToString (Cons s) = s++instance Name.Attribute T where+ attributeFromString = Cons+ attributeToString (Cons s) = s
+ src/Text/XML/Basic/Name/Qualified.hs view
@@ -0,0 +1,43 @@+{- |+This name type preserves the characters case of its input+and divides the names into namespace and local identifier.+-}+module Text.XML.Basic.Name.Qualified where++import qualified Text.XML.Basic.Name as Name+import qualified Data.Accessor.Basic as Accessor+++data T = Cons {namespace_, local_ :: String}+ deriving (Show, Eq, Ord)++namespace :: Accessor.T T String+namespace = Accessor.fromSetGet (\n p -> p{namespace_ = n}) namespace_++local :: Accessor.T T String+local = Accessor.fromSetGet (\n p -> p{local_ = n}) local_+++fromString :: String -> T+fromString =+ uncurry Cons .+ (\(n,pl) ->+ case pl of+ ':':l -> (n,l)+ _ -> ("",n)) .+ break (':'==)++toString :: T -> String+toString (Cons n l) =+ if null n+ then l+ else n ++ ':' : l+++instance Name.Tag T where+ tagFromString = fromString+ tagToString = toString++instance Name.Attribute T where+ attributeFromString = fromString+ attributeToString = toString
+ src/Text/XML/Basic/Position.hs view
@@ -0,0 +1,93 @@+{- |+Module : Text.XML.Basic.Position++Maintainer : tagsoup@henning-thielemann.de+Stability : provisional+Portability : portable++Position in a file.++Cf. to Text.ParserCombinators.Parsec.Pos+-}++module Text.XML.Basic.Position (+ T, FileName, Row, Column,+ new, initialize,+ row, column, fileName,+ updateOnChar, updateOnString,+ toReportText,+ ) where++import qualified Data.Accessor.Basic as Accessor+-- import Data.Accessor.Basic ((^=), )++import Data.List (foldl')+++type FileName = String+type Row = Int+type Column = Int++{- |+Position in a file consisting of file name, row and column coordinates.+Upper left is (0,0), but show routines can display this with different offsets.+-}+data T =+ Cons {+ fileName_ :: FileName,+ row_ :: !Row,+ column_ :: !Column+ } deriving (Eq,Ord)+++new :: FileName -> Row -> Column -> T+new = Cons++initialize :: FileName -> T+initialize fn = new fn 0 0+++-- * access functions++fileName :: Accessor.T T FileName+fileName = Accessor.fromSetGet (\fn p -> p{fileName_ = fn}) fileName_++row :: Accessor.T T Row+row = Accessor.fromSetGet (\n p -> p{row_ = n}) row_++column :: Accessor.T T Column+column = Accessor.fromSetGet (\n p -> p{column_ = n}) column_+++-- * update position according to read characters++updateOnString :: T -> String -> T+updateOnString pos string =+ foldl' (flip updateOnChar) pos string++updateOnChar :: Char -> T -> T+updateOnChar char (Cons name r c) =+ let (newRow, newColumn) =+ case char of+ '\n' -> (succ r, 0)+ '\t' -> (r, c + 8 - mod c 8)+ _ -> (r, succ c)+ in Cons name newRow newColumn+-- in (row ^= newRow) $ (column ^= newColumn) $ pos+++-- * update position according to read characters++{- |+Convert the file position to a format+that development environments can understand.+-}+toReportText :: T -> String+toReportText (Cons name r c) =+ concatMap (++":") [name, show (r+1), show (c+1)]++instance Show T where+ showsPrec p (Cons name r c) =+ showParen (p > 10)+ (showString $ unwords $+ "Position.new" : show name : show r : show c : [])
+ src/Text/XML/Basic/ProcessingInstruction.hs view
@@ -0,0 +1,68 @@+module Text.XML.Basic.ProcessingInstruction (+ T(..),+ mapName,+ mapAttributes, mapAttributesA,+ ) where++import qualified Text.XML.Basic.Attribute as Attr+import qualified Text.XML.Basic.Name as Name+import qualified Text.XML.Basic.Format as Fmt++import Data.Monoid (Monoid, mempty, )++import Data.Foldable (Foldable(foldMap), )+import Data.Traversable (Traversable(sequenceA), traverse, )+import Control.Applicative (Applicative, pure, liftA, )+++data T name string =+ Known [Attr.T name string]+ | Unknown String+ deriving (Show, Eq, Ord)+++instance (Name.Attribute name, Fmt.C string) => Fmt.C (T name string) where+ run p =+ case p of+ Known attrs -> Attr.formatListBlankHead attrs+ Unknown str -> Fmt.blank . showString str+++instance Functor (T name) where+ fmap f proc =+ case proc of+ Known attrs -> Known $ map (fmap f) attrs+ Unknown text -> Unknown text++instance Foldable (T name) where+ foldMap f proc =+ case proc of+ Known attrs -> foldMap (foldMap f) attrs+ Unknown _text -> mempty++instance Traversable (T name) where+ sequenceA proc =+ case proc of+ Known attrs -> liftA Known $ traverse sequenceA attrs+ Unknown text -> pure $ Unknown text++mapName :: (name0 -> name1) -> T name0 string -> T name1 string+mapName f = mapAttributes (map (Attr.mapName f))+++mapAttributes ::+ ([Attr.T name0 string0] -> [Attr.T name1 string1]) ->+ T name0 string0 -> T name1 string1+mapAttributes f proc =+ case proc of+ Known attrs -> Known $ f attrs+ Unknown text -> Unknown text++mapAttributesA ::+ (Applicative f) =>+ ([Attr.T name0 string0] -> f [Attr.T name1 string1]) ->+ T name0 string0 -> f (T name1 string1)+mapAttributesA f proc =+ case proc of+ Known attrs -> liftA Known $ f attrs+ Unknown text -> pure $ Unknown text
+ src/Text/XML/Basic/Tag.hs view
@@ -0,0 +1,40 @@+{- |+We do not define a tag data type here,+since this is too much bound to the particular use+(e.g. list or tree structure).+However we define a tag name and some special names.+-}+module Text.XML.Basic.Tag (+ Name(..),+ doctype, doctypeString,+ cdata, cdataString,+ ) where++import Text.XML.Basic.Name as Name+++newtype Name ident = Name {unname :: ident}+ deriving (Eq, Ord)++instance Show ident => Show (Name ident) where+ showsPrec p = showsPrec p . unname++instance Name.Tag ident => Name.C (Name ident) where+ fromString = Name . Name.tagFromString+ toString = Name.tagToString . unname+++++doctype :: (Name.Tag name) => Name name+doctype = Name.fromString doctypeString++cdata :: (Name.Tag name) => Name name+cdata = Name.fromString cdataString+++doctypeString :: String+doctypeString = "DOCTYPE"++cdataString :: String+cdataString = "[CDATA["
+ src/Text/XML/Basic/Utility.hs view
@@ -0,0 +1,33 @@+module Text.XML.Basic.Utility where++import Data.List.HT (switchL, break, )+import Data.Tuple.HT (mapSnd, )+++import Prelude hiding (break, )+++{- |+Needs 'break' from utility-ht in order to be as lazy as 'updateAppend''.+-}+updateAppend :: (a -> Bool) -> a -> (a -> a) -> [a] -> [a]+updateAppend p deflt f =+ uncurry (++) .+ mapSnd (uncurry (:) . switchL (deflt,[]) ((,) . f)) .+ break p++{- |+Apply @f@ to the first element, where @p@ holds.+If no such element exists, append the default value @deflt@ to the list.+-}+updateAppend' :: (a -> Bool) -> a -> (a -> a) -> [a] -> [a]+updateAppend' p deflt f =+ let recourse xt =+ uncurry (:) $+ case xt of+ [] -> (deflt,[])+ (x:xs) ->+ if p x+ then (f x, xs)+ else (x, recourse xs)+ in recourse
+ xml-basic.cabal view
@@ -0,0 +1,61 @@+Name: xml-basic+Version: 0.0.1+License: BSD3+License-File: LICENSE+Author: Henning Thielemann <haskell@henning-thielemann.de>+Maintainer: Henning Thielemann <haskell@henning-thielemann.de>+Homepage: http://www.haskell.org/haskellwiki/XML-Basic+Category: XML+Synopsis: Basics for XML/HTML representation and processing+Description:+ We provide basic data types for XML representation,+ like names, attributes, entities.+ Yes we try hard to get type safe XML handling out of Haskell 98.+ We also provide information about exceptional HTML tags,+ like self-closing tags.+ This package provides common functionality+ that is both needed in list (tagsoup-ht) and tree (wraxml) representations of XML.+Tested-With: GHC==6.8.2+Cabal-Version: >=1.6+Build-Type: Simple+Source-Repository head+ type: darcs+ location: http://code.haskell.org/~thielema/xml-basic/++Source-Repository this+ type: darcs+ location: http://code.haskell.org/~thielema/xml-basic/+ tag: 0.0.1++Flag splitBase+ description: Choose the new smaller, split-up base package.++Library+ Build-Depends:+ explicit-exception >=0.1.3 && <0.2,+ data-accessor >=0.2 && <0.3,+ utility-ht >=0.0.4 && <0.1+ If flag(splitBase)+ Build-Depends: base >= 2, containers >=0.1 && <0.3+ Else+ Build-Depends: base >= 1.0 && < 2, special-functors >=1.0 && <1.1++ GHC-Options: -Wall+ Hs-Source-Dirs: src+ Exposed-Modules:+ Text.HTML.Basic.Tag+ Text.HTML.Basic.Character+ Text.HTML.Basic.Entity+ Text.XML.Basic.Tag+ Text.XML.Basic.ProcessingInstruction+ Text.XML.Basic.Attribute+ Text.XML.Basic.Name+ Text.XML.Basic.Name.MixedCase+ Text.XML.Basic.Name.LowerCase+ Text.XML.Basic.Name.Qualified+ Text.XML.Basic.Position+ Text.XML.Basic.Character+ Text.XML.Basic.Entity+ Text.XML.Basic.Format+ Exposed-Modules:+ Text.XML.Basic.Utility