hxt-xpath-9.1.2.2/0000755000000000000000000000000012465156121012001 5ustar0000000000000000hxt-xpath-9.1.2.2/Setup.lhs0000644000000000000000000000015712465156121013614 0ustar0000000000000000#!/usr/bin/runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hxt-xpath-9.1.2.2/LICENSE0000644000000000000000000000212012465156121013001 0ustar0000000000000000The MIT License Copyright (c) 2005 Uwe Schmidt, Martin Schmidt, Torben Kuseler Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hxt-xpath-9.1.2.2/hxt-xpath.cabal0000644000000000000000000000371712465156121014722 0ustar0000000000000000-- arch-tag: Haskell XML Toolbox XPath Package Name: hxt-xpath Version: 9.1.2.2 Synopsis: The XPath modules for HXT. Description: The Haskell XML Toolbox XPath library. . Changes from 9.1.2: Bug in indexing result sets removed License: OtherLicense License-file: LICENSE Author: Torben Kuseler Maintainer: Uwe Schmidt Stability: Stable Category: XML Homepage: https://github.com/UweSchmidt/hxt Copyright: Copyright (c) 2005-2010 Torben Kuseler, Uwe Schmidt Build-type: Simple Cabal-version: >=1.6 extra-source-files: examples/hunit/HUnitExample.hs examples/hunit/Makefile examples/hunit/mini1.xml examples/hunit/mini2.xml examples/hxpath/example1.xml examples/hxpath/HXPath.hs examples/hxpath/Makefile examples/hxpath/W3CTestData.hs examples/hxpath/xhtml/xhtml1-frameset.dtd examples/hxpath/xhtml/xhtml1-strict.dtd examples/hxpath/xhtml/xhtml1-transitional.dtd examples/hxpath/xhtml/xhtml-lat1.ent examples/hxpath/xhtml/xhtml-special.ent examples/hxpath/xhtml/xhtml-symbol.ent examples/hxpath/xhtml/xhtml.xml examples/hxpath/XPathShell.hs examples/Makefile library exposed-modules: Text.XML.HXT.XPath, Text.XML.HXT.XPath.Arrows, Text.XML.HXT.XPath.NavTree, Text.XML.HXT.XPath.XPathArithmetic, Text.XML.HXT.XPath.XPathDataTypes, Text.XML.HXT.XPath.XPathEval, Text.XML.HXT.XPath.XPathFct, Text.XML.HXT.XPath.XPathKeywords, Text.XML.HXT.XPath.XPathParser, Text.XML.HXT.XPath.XPathToNodeSet, Text.XML.HXT.XPath.XPathToString hs-source-dirs: src ghc-options: -Wall ghc-prof-options: -caf-all build-depends: base >= 4 && < 5, containers >= 0.2 && < 1, directory >= 1 && < 2, filepath >= 1 && < 2, parsec >= 2.1 && < 4, hxt >= 9.1 && < 10 Source-Repository head Type: git Location: git://github.com/UweSchmidt/hxt.git hxt-xpath-9.1.2.2/examples/0000755000000000000000000000000012465156121013617 5ustar0000000000000000hxt-xpath-9.1.2.2/examples/Makefile0000644000000000000000000000040212465156121015253 0ustar0000000000000000# Example Applications # EXAMPLES = hunit hxpath MORE_SAMPLES = all : $(foreach i,$(EXAMPLES),$(MAKE) -C $i all ;) test : $(foreach i,$(EXAMPLES),$(MAKE) -C $i $@ ;) clean : $(foreach i,$(EXAMPLES),$(MAKE) -C $i $@ ;) .PHONY : all test clean hxt-xpath-9.1.2.2/examples/hxpath/0000755000000000000000000000000012465156121015113 5ustar0000000000000000hxt-xpath-9.1.2.2/examples/hxpath/example1.xml0000644000000000000000000000145712465156121017360 0ustar0000000000000000 ]> 200g Mehl z 2 z 3 Zuerst nehmen Sie das Mehl und mischen es mit ... hxt-xpath-9.1.2.2/examples/hxpath/W3CTestData.hs0000644000000000000000000014031112465156121017475 0ustar0000000000000000module W3CTestData where testListW3C=[ "$h - $i", "$hotelnode/location/@country", "$in//text()", "$l10n.name", "$lookup/@text", "$start + $step", "$texts[position() > 1]", "$var1|$var2", "$var1|child::child2", "$var1|key('key1','Lynne Rosenthal')", "$x=''", "$x='foo'", "$xml-source", "$y='foo'", "$zoo:bear", "' #text'", "' 6 ' div 2", "' 6 '*div", "' x 4'", "' x 4'", "'....5....|'", "'1' and '0'", "'2'>'1'", "'200'", "'ABC'", "($terms/table/expand[@language=$lang]/gentext[@key=$key])[1]", "((((((n3+5)*(3)+(((n2)+2)*(n1 - 6)))-(n4 - n2))+(-(4-6)))))", "(((ancestor::foo)[1])/@att1)", "((ancestor::foo))[1]/@att1", "(* - 4) div 2", "(* - 4)**", "(2 + number('xxx'))", "(24 div 3 +2) div (40 div 8 -3)", "(5 mod 2 = 1) and (5 mod -2 = 1) and (-5 mod 2 = -1) and (-5 mod -2 = -1)", "(77 mod $anum + n5 mod 8) mod $anum", "(ancestor-or-self::*)[@att1][1]/@att1", "(ancestor::foo)[1]/@att1", "(ancestor::foo[1])/@att1", "(ancestor::section|ancestor::simplesect |ancestor::articleinfo)[last()]", "(chapter//footnote)[2]", "(child::chapter/descendant-or-self::node())/footnote[2]", "(n1*n2*n3*n4*n5*n6)div n7 div n8 div n9 div n10", "(n1/@attrib)*(n2/@attrib)", "(n1/@attrib)+(n2/@attrib)", "(preceding-sibling::*|following-sibling::*)/ancestor::*[last()]/*[last()]", "(preceding-sibling::foo)[1]/@att1", "(preceding::foo)[1]/@att1", "(section//@title)[7]", "(xalan:nodeset($rtf)/default:docelem/test:elem3)", -- namespaces noch mal ueberdenken "* +3", "*//la | //Bflat | re", "*/p", "*[$index]", "*[$index]", "*[$index]", "*[1]", "*[3]", "*[4]", "*[@test and position()=1]", "*[@test and position()=4]", "*[@test and position()=7]", "*[@test and position()=8]", "*[@test='true']", "*[@test][1]/num", "*[@test][position()=1]/num", "*[last()=position()]", "*[last()]", "*[local-name()='bar']", "*[not(@test)][last()=position()]", "*[not(@test)][last()]", "*[position()=1]", "*[position()=3]", "*[position()=4]", "*[starts-with(name(.),'f')]", "*|@*", "*|@*|comment()|processing-instruction()|text()", "-(n-2/@attrib) - -(n-1/@attrib)", "-(n1|n2)", "-.0000000000000000000000000000000000000000123456789", "-.01", "-n-2 --n-1", "-n-2/@attrib --n-1/@attrib", "..", "../../a/b[1]", "..//foo", "../@id", "../node()", "./*[name(.) = $sortcol]", ".//*[@so]", ".//PERSONA", ".//a", ".//center", ".//center", ".//comment()", ".//f", ".//near-south/preceding-sibling::*|following-sibling::east/ancestor-or-self::*[2]", ".//text()", ".//title", "./@id", "./@theattrib", ".0000000000000000000000000000000000000000123456789", ".01", ".123456789", "/", "/*/@group", "//*", "//*", "//*[count(./*/*) > 0]", "//*[count(ancestor::*) >= 2]/../parent::*", "//ACT", "//ancestor::*", "//child1[parent::element1]", "//child1|//child2", "//child2[ancestor-or-self::element2]", "//child2[ancestor::element2]", "//child5|//child2|//child4", "//comment()", "//inc/node4", "//item[@type=current()/@name]", "//noChild1|//noChild2", "//north/dup2 | south/preceding-sibling[4] | north/dup1 | north/*", "//processing-instruction()", "//xx/descendant::*", "/doc/*[@test='true']", "/doc/a/b/@attr", "/doc/critter[@type='cat']", "/doc/mid/inner", "/doc/sub1/child1|/doc/sub2/child2", "/docs/a", "/docs/a", "/page/contents/avail/hotel", "/sss/sss/i", "/sss/sss/i", "0 > -0", "0 = -0", "0 div 0 >= 0", "0 div 0 < 0", "0 div 0", "0 or ''", "0", "0000000000", "1 = '001'", "1 = 1.00", "1 div -0 = 1 div 0", "1 div -0 = 2 div -0", "1>1", "1<1", "1<=1", "1-2", "10+5+25+20+15+50+35+40", "10+7", "100-$anum -5-15-$anum", "100-9-7-4-17-18-5", "100-n6 -4-n1 -1-11", "12", "123", "1234", "12345", "123456", "1234567", "12345678", "123456789", "1234567890", "12345678901", "123456789012", "1234567890123", "12345678901234", "123456789012345", "1234567890123456", "12345678901234567", "123456789012345678", "16-div", "1=1", "2 * -number('xxx')", "2 - number('xxx')", "2 div number('xxx')", "2 mod number('xxx')", "2", "2>1", "2>=1", "2>=2", "2<1", "2<=1", "2*3", "2+n5+7+n3", "20", "25-*", "256", "3", "3", "3*2+5*4-4*2-1", "3+6", "3-1", "32", "4", "4", "444 + $t1num", "48 mod 17 - 2 mod 9 + 13 mod 5", "5 mod 2", "5", "5", "5.*.", "5.+*", "54 div*", "555", "56 mod round(n5*2+1.444) - n6 mod 4 + 7 mod n4", "6 div -2", "6 div 2", "6", "60", "7 - -3", "7", "7", "7+-3", "70 div $anum - 18 div n6 + $anum div n2", "8", "80 div n2 + 12 div 2 - n4 div n2", "9", "9.87654321012345", "98.7654321012345", "987.654321012345", "9876.54321012345", "98765.4321012345", "987654.321012345", "9876543.21012345", "98765432.1012345", "987654321.012345", "9876543210", "9876543210.12345", "98765432101.2345", "987654321012.345", "9876543210123.45", "98765432101234.5", "FM|PERSONAE|ACT", "Name/@First", "OL", "Personal_Information/Age", "Spr/State[. = 'Open']", "a/*[last()]", "a/child::*[last()]", "a/child::comment()[last()]", "a/child::node()[last()]", "a/child::text()[last()]", "a/descendant::*[last()]", "a/x", "a['3.5' < 4]", "a['target'!=descendant::*]", "a['target'=descendant::*]", "a[('target'=descendant::*) or @squish]", "a[(@squeesh or @squish) and @squash]", "a[*=9]", "a[0 < true()]", "a[0]", "a[1 < 2]", "a[1 < 3]", "a[1]", "a[3 > following-sibling::*]", "a[3 >= following-sibling::*]", "a[3 < following-sibling::*]", "a[3 <= following-sibling::*]", "a[3-2]", "a[3.0='3.0']", "a[3=following-sibling::*]", "a[3]", "a[4 != following-sibling::*]", "a[4]", "a[@squeesh or (@squish and @squash)]", "a[@squeesh or @squish and @squash]", "a[descendant::*!='target']", "a[descendant::*='target']", "a[div=9]", "a[false()!=following-sibling::*]", "a[following-sibling::* != 4]", "a[following-sibling::* > 3]", "a[following-sibling::* >= 3]", "a[following-sibling::* < 3]", "a[following-sibling::* <= 3]", "a[following-sibling::*!=false()]", "a[following-sibling::*=3]", "a[following-sibling::*=descendant::*]", "a[following-sibling::*=true()]", "a[not(('target'=descendant::*) or @squish)]", "a[not(@*)]", "a[number('3')]", "a[position() <=3]", "a[position()!=2]", "a[position()>2]", "a[position()>=2]", "a[position()<3]", "a[position()=$first]", "a[position()=1]", "a[position()=3]", "a[position()=4]", "a[true()='stringwithchars']", "a[true()=4]", "a[true()=following-sibling::*]", "alternate/name/first", "ancestor-or-self::*", "ancestor-or-self::*[1]", "ancestor-or-self::*[1]/text()", "ancestor-or-self::*[@att1][1]/@att1", "ancestor-or-self::sub | ancestor-or-self::sub-sub", "ancestor::*", "ancestor::*[3]", "ancestor::*[count(child::*) > 1]/*[not(. = current()/ancestor-or-self::*)]", "ancestor::foo[1]/@att1", "ancestor::sub1|ancestor::sub2", "attribute :: *", "attribute :: div", "attribute*(div - 4)", "attribute::*", "attribute::*[2]", "attribute::attr1|attribute::attr2", "attribute::center-attr-2", "author/name|author/bibliography/author/chapters", "author/name|author/bibliography/author/name", "author/name|author/noElement", "author[(name/@real='no' and position()=1)]|author[(name/@real='yes' and position()=last())]", "author[name/@real='no']|author[name/@real='yes']", "author[name='Mary Brady']|author[name/@real='no']", "bar | joes:bar", "bar[(@a='1' and @b='1') or (@c='1' and @d='1')]", "bar[(@a='1' or @b='1') and (@c='1' or @d='1')]", "bar[(@a='1' or @b='1') and @c='1']", "bar[@a='1' and (@b='1' or @c='1') and @d='1']", "bar[@a='1' and @b='1' or @c='1' and @d='1']", "bar[@a='1' and @b='1']", "bar[@a='1' or (@b='1' and @c='1') or @d='1']", "bar[@a='1' or @b='1' and @c='1' or @d='1']", "bar[@a='1' or @b='1' or @c='1']", "boolean($ResultTreeFragTest)", "boolean($emptyResultTreeFragTest)", "boolean('')", "boolean('0')", "boolean(-0)", "boolean(0 div 0)", "boolean(0)", "boolean(1 div 0)", "boolean(1)", "boolean(doc)", "boolean(foo)", "ceiling(-1.5)=-1", "ceiling(0.0)", "ceiling(1)=1", "ceiling(1.1)=2", "ceiling(1.54)", "ceiling(2.999999)", "ceiling(n0)", "ceiling(n1)", "ceiling(n2)", "ceiling(number('xxx'))", "center//*", "center//child::*", "center//descendant::*", "center/child::*", "center/descendant::*", "chapter//footnote[1]", "chapter//footnote[2]", "chapter/descendant::footnote[6]", "chapter/note", "chapter/note", "child :: sub", "child1[child::child2]", "child::*", "child::*/child::*", "child::*/descendant::*", "child::*[2]", "child::article|key('key1','Carmelo Montanez')", "child::near-south-west", "child::node()", "child::sub", "child::sub1|child::sub2", "child[@deep='3']|child[@wide='3']", "child[@wide='3'] | key('one','3')", "child[@wide='3']|child[@deep='3']", "chooser", "comment ()", "concat( substring(subj,1,number(not(starts-with(.,'Re: ')))*string-length(subj)), substring(substring-after(subj,'Re: '),1, number(starts-with(.,'Re: '))*string-length(substring-after(subj,'Re: '))))", "concat($act,' - ',TITLE,' ')", "concat($mParam,$nParam,$oParam,$pParam)", "concat($str,'....5....|')", "concat('id=', string($p2))", "concat(/*, /*[@attr='whatsup'])", "concat(a, 34)", "concat(a, b)", "concat(a, b, c, d, e)", "concat(false(),'ly')", "concat(left,right,orig)", "concat(left,right,orig)", "concat(team[1], ' versus ', team[2])", "concat(team[1]/@score, '-', team[2]/@score)", "contains( unparsed-entity-uri('hatch-pic'),'grafix/OpenHatch.gif')", "contains($node,$find)", "contains('','')", "contains('ENCYCLOPEDIA', 'CYCL')", "contains('ENCYCLOPEDIA', 'TEST')", "contains('ab', 'abc')", "contains('abc', '')", "contains('abc', 'bc')", "contains('abc', 'bcd')", "contains('foo','o')", "contains('true()', 'e')", "contains(., '&')", "contains(concat(.,'BC'),concat('A','B','C'))", "contains(doc, 'CYCL')", "contains(doc, 'TEST')", "contains(doc/@attr, 'TEST')", "contains(doc/@attr, 'amwi')", "contains(main,sub)", "contains(main,sub)", "contains(main,sub)", "contains(main,sub)", "count($var1)", "count($var2)", "count(*)", "count(*)", "count(*/z[2])", "count(.//SPEECH)", "count(.//comment())", "count(/doc/alpha[last()]/h)", "count(/doc/chapter/note)", "count(a/@*)", "count(a/attribute::*)", "count(alpha/*[last()][name()='z'])", "count(ancestor::section |../ednote|following::title|../bogus)", "count(ancestor::section |ancestor::simplesect|ancestor::article)", "count(ancestor::section |ancestor::simplesect|ancestor::articleinfo)", "count(div)", "count(following-sibling::*)", "count(key('mykey', 'Introduction'))", "count(namespace::*)", "count(preceding::text())", "count(preceding::text())", "count(xalan:nodeset($rtf)/default:docelem/default:elem3)", "counter:read('index')", "counter:read('index')", "critter", "critter", "current()", "current()", "current()", "customers/customer", "d", "dat", "date", "date:getYear()", "day", "day", "day", "day", "day", "descendant-or-self::*", "descendant-or-self::*", "descendant-or-self::*[3]", "descendant-or-self::center", "descendant-or-self::far-south", "descendant-or-self::sub1|descendant-or-self::sub2", "descendant::*", "descendant::*", "descendant::*/child::*", "descendant::*[3]", "descendant::*[string-length(name(.))=1]", "descendant::child1|descendant::child2", "descendant::far-south", "display", "display", "display", "div +3", "div div mod", "div mod mod", "div", "div/@attrib div mod/@attrib", "div/@attrib mod mod/@attrib", "div/para[lang('en')]", "doc/element1[2]/child1[last()]", "document($typefile,/)", "document('')/*/xsl:template[@name=$whichtmplt]", "document('')/*/xsl:template[@name=$whichtmplt]", "document('')/*/xsl:template[@name='qq']/node()", "document('')/xsl:stylesheet/ped:test[@attrib='yeha']", "document('')/xsl:stylesheet/ped:test[@attrib='yeha']", "document('../impincl-test/mdocs11a.xml')//body", -- "document('..\mdocs\compu.xml')/market.participant/address.set/*", -- \ mag er nicht "document('bib.xml')", "document('level3/xreluri09a.xml',document('level1/level2/xreluri09b.xml'))", "document('mdocs01a.xml')//body", "document('mdocs03a.xml',section)", "document('select68.xml')//inside", "document('select68.xml')//inside", "document('terms.xml')", "document('variable20.xml')", "document('x14template.html')", "document(a)//body", "document(a)//body", "document(a)//body", "document(document(places))", "document(filename,document('level1/level2/xreluri10b.xml'))/*/body", "document(places)", "document(places)//body", "document(places,second)/*", "document(pointer/urlref/@urlstr)/market.participant/business.identity.group/business.name", "element", "element1[(((((2*10)-4)+9) div 5) mod 3 )]", "element1[(((((2*10)-4)+9) div 5) mod floor(3))]", "element1[descendant-or-self::child2]", "element1[floor(2)]", "em:foo", "expense-report/total", "expense-report/total", "ext:getPIData(doc/processing-instruction('a-pi'))", "extn1:getPIData(doc/processing-instruction('a-pi')[1])", "extn1:getPIData(doc/processing-instruction('b-pi'))", "fa/../mi | Aflat/natural/la | Csharp//* | /doc/do | *//ti", "false() and 1 div 0", "false() and false()", "false() and true()", "false() or false()", "false() or true()", "false()", "false()=''", "false()=0", "floor(-1.5)", "floor(-1.5)=-2", "floor(0.0)", "floor(1)=1", "floor(1.9)", "floor(1.9)=1", "floor(2.999999)", "floor(n0)", "floor(number('xxx'))", "following-sibling::*", "following-sibling::*/preceding-sibling::*", "following-sibling::*[1]", "following-sibling::*[2]/preceding-sibling::*", "following-sibling::*[2]/preceding-sibling::*[4]", "following-sibling::*[2]/preceding-sibling::*[4]/following-sibling::*[5]/preceding-sibling::*[4]/preceding-sibling::*[2]", "following-sibling::east", "following-sibling::node()", "following::*", "following::*[4]", "following::*[4]/../*[2]", "foo[(bar[2])='this']", "foo[(bar[2][(baz[2])='goodbye'])]", "format-number('foo','#############')", "format-number('foo','#############')", "format-number(-1 div 0,'###############################')", "format-number(-1 div 0,'###############################')", "format-number(-26931.4,'!!!,!!!.!!!')", "format-number(-26931.4,'###,###.###')", "format-number(-26931.4,'###,###.###','myminus')", "format-number(-26931.4,'###,###.###;###,###.###')", "format-number(-26931.4,'###.###,###','periodgroup')", "format-number(-26931.4,'###.###,###','periodgroup')", "format-number(-26931.4,'###.###,###','periodgroup')", "format-number(-26931.4,'###.###,###','periodgroup')", -- "format-number(-26931.4,'+!!,!!!.!!!\-!!!,!!!.!!!')", -- vom W3C auskommentiert "format-number(-26931.4,'+###,###.###;-###,###.###')", "format-number(-26931.4,'+###,###.###;_###,###.###')", "format-number(-26931.4,'-###,###.###')", "format-number(-26931.4,'-###,###.###','myminus')", "format-number(-26931.4,'_###,###.###','myminus')", "format-number(-42857.1,'###,###.###')", "format-number(-42857.1,'###,###.###','myminus')", "format-number(-42857.1,'###,###.###','myminus')", "format-number(-42857.1,'###,###.###','newminus')", "format-number(-42857.1,'###,###.###','newminus')", "format-number(-73816.9,'###,###.###')", "format-number(-73816.9,'###,###.###')", "format-number(-73816.9,'###,###.###')", "format-number(-73816.9,'###,###.###')", "format-number(0.25, '00%')", "format-number(0.4857,'###.###%')", "format-number(0.4857,'###.###c')", "format-number(0.4857,'###.###m')", "format-number(0.4857,'###.###‰')", "format-number(1 div 0,'###############################')", "format-number(1 div 0,'###############################')", "format-number(1, '#,##0')", "format-number(1, '00')", "format-number(1, '00.0')", "format-number(1000, '###0')", "format-number(1234.567,'#*###*###!###','foo:decimal1')", "format-number(12792.14*96.58,'##,###,000.000###')", "format-number(2.14*86.58,'PREFIX##00.000###SUFFIX')", "format-number(2392.14*(-36.58),'000,000.000###;###,###.000###')", "format-number(2392.14*(-36.58),'000,000.000###;-###,###.000###')", "format-number(2392.14*36.58,'000,000.000000')", "format-number(2392.14*36.58,'000,000.000000','myminus')", "format-number(2392.14*36.58,'000,000.000000;###,###.000###')", "format-number(2392.14*36.58,'000,000.000000;###,###.000###','myminus')", "format-number(239236.588,'00000.00')", -- "format-number(26931.4,'+!!!,!!!.!!!\-!!,!!!.!!!')", -- vom W3C auskommentiert "format-number(2792.14*(-36.58),'000,000.000###')", "format-number(4030201.0506,'#!!!,!!!,aaa.aaaaaa0')", "format-number(7654321.4857,'### ### ###,#####')", "format-number(931.4857,'###!###!###')", "format-number(931.4857,'000.000|###')", "format-number(95.4857,'¤###.####')", "format-number(987654321,'###,##0,00.00')", "generate-id(d)", "generate-id(xalan:nodeset($rtf)/default:docelem/default:elem4)", "growth", "growth", "human", "id('c')/@id", "id('c')/@id", "id('d b c')", "id('id0')/a/b", "id('id0')/c/c/a", "id('id10')/a", "id('id13')", "id('id2')/a | id('id5') | id('id15')/a", "id('id4')", "id('id8')/b/b", "id('id9')", "id('nomatch')/@id", "id(main/b)", "id(main/b)", "item[$n1]", "item[position()=$n]", "java:format($formatter, $date)", "java:format($formatter, $javadate)", "java:get ($counter-table, 'index')", "java:java.lang.Long.parseLong(string(.))", "java:java.text.SimpleDateFormat.new('yyyy.MM.dd hh:mm')", "java:java.util.Calendar.getInstance()", "java:java.util.Date.new($date)", "java:java.util.Hashtable.new ()", "key($keysp, 'Expressions')/subdiv/p", "key($keysp, 'Introduction')/subdiv/p", "key($keysp, 'Stylesheet Structure')/subdiv/p", "key('MonthNum',month)", "key('MonthNum',month)", "key('baz:mykey', 'Expressions')/p", "key('baz:mykey', 'Introduction')/p", "key('baz:mykey', 'Stylesheet Structure')/p", "key('bib',$lookup)", "key('bigspace', 'Expressions')/subdiv/p", "key('bigspace', 'Expressions')/subdiv/p", "key('bigspace', 'Introduction')/subdiv/p", "key('bigspace', 'Introduction')/subdiv/p", "key('bigspace', 'Stylesheet Structure')/subdiv/p", "key('bigspace', 'Stylesheet Structure')/subdiv/p", "key('filterspace', 'Expressions')/subdiv/p", "key('filterspace', 'Expressions')/subdiv/p", "key('filterspace', 'Introduction')/subdiv/p", "key('filterspace', 'Introduction')/subdiv/p", "key('filterspace', 'Stylesheet Structure')/subdiv/p", "key('filterspace', 'Stylesheet Structure')/subdiv/p", "key('k','Albany')", "key('k','Albany')", "key('k','false')[position()=1]/num", "key('k','false')[position()=2]/num", "key('k','true')[1]/num", "key('k','true')[1]/num", "key('k','true')[3]/num", "key('k','true')[3]/num", "key('k','true')[4]/num", "key('k','true')[4]/num", "key('k','true')[last()=position()]", "key('k','true')[last()]", "key('k','true')[position()=1]/num", "key('k','true')[position()=4]/num", "key('key1','Mary Brady')|key('key2','Rick Rivello')", "key('marks',key('titles', 'Expressions')/finder)", "key('mykey', 'Expressions')", "key('mykey', 'Expressions')/p", "key('mykey', 'Introduction')/p", "key('mykey', 'Patterns')", "key('mykey', 'Second Title in Structure')/p", "key('mykey', 'Stylesheet Structure')", "key('mykey', 'Stylesheet Structure')/p", "key('mykey', 1 )/p", "key('mykey', 1+1 )/p", "key('mykey', 3.0 )/p", "key('mykey', 3.7 )/p", "key('mykey',' ')/@title", "key('mykey','')/p", "key('mykey','Exp Section')/@title", "key('mykey','Expressions')/p", "key('mykey','Expressions')/p", "key('mykey','Intro Section')/@title", "key('mykey','Introduction')/p", "key('mykey','Introduction')/p", "key('mykey','SS Section')/@title", "key('mykey','Sort Section')/@title", "key('mykey','Sorting')/p", "key('mykey','Sorting')/p", "key('mykey','Stylesheet Structure')/p", "key('mykey','Stylesheet Structure')/p", "key('mykey',*//title)", "key('mykey1','foo' )/p", "key('mykey2', 1 )/p", "key('one','3') | key('two','3')", "key('smallspace', 'Expressions')/p", "key('smallspace', 'Expressions')/p", "key('smallspace', 'Introduction')/p", "key('smallspace', 'Introduction')/p", "key('smallspace', 'Stylesheet Structure')/p", "key('smallspace', 'Stylesheet Structure')/p", "key('test','foey')", "key('titles', .)", "key('two','3') | document('select59.xml')/child[@wide='3'] | child[@deep='3']", "key('which','3')", "keyword[@tag='sector']", "keyword[@tag='ticker']", "keyword[@tag='ticker']", "keyword[@tag='ticker']", "keyword[@tag='ticker']", "lang('en')", "last()", "local-name()", "local-name(.)", "local-name(baz1:a)", "local-name(baz2:b)", "local-name(baz2:b/@baz1:attrib2)", "local-name(namespace::*[1])", "local-name(namespace::*[string()='http://www.w3.org/1999/XMLSchema-instance'])", "local-name(namespace::*[string()='test'])", "local-name(xalan:nodeset($rtf)/*)", "main/a/descendant-or-self::*/@*", "main/size[@for='d']", "mi | do | fa | re", "mi[@mi2='mi2'] | do | fa/so/@so | fa | mi/@* | re | fa/@fa | do/@do", "month", "month", "month", "n", "n-2 - -n-1", "n-2 - n-1", "n-2+-n-1", "n0 div n1 div n2 div n3 div n4 div n5", "n0 div n1 div n2 div n3 div n4", "n0 div n1 div n2 div n3", "n1 div n2", "n1 mod n2", "n1*n2", "n1*n2*n3*n4", "n1*n2*n3*n4*n5*n6*n7*n8*n9*n10", "n1+n2", "n1/@attrib + n2/@attrib", "n1/@attrib div n2/@attrib", "n1/@attrib mod n2/@attrib", "n2+3+$anum+7+n5", "n4", "n6*5-8*n2+5*2", "name", "name", "name", "name", "name", "name", "name", "name((ancestor::section|../ednote |following::title|../bogus)[1])", "name((ancestor::section|ancestor::simplesect |ancestor::article)[last()])", "name(/descendant-or-self::node()/child::near-north)", "name(/descendant-or-self::node()/descendant-or-self::north)", "name(/descendant-or-self::north)", "name(/descendant-or-self::north/child::near-north)", "name(/descendant-or-self::north/descendant-or-self::north)", "name(/descendant::near-north)", "name(/descendant::near-north/descendant-or-self::near-north)", "name(/descendant::node()/descendant-or-self::near-north)", "name(ancestor::*[1])", "name(ancestor::*[1])", "name(ancestor::*[2])", "name(ancestor::*[2])", "name(ancestor::*[3])", "name(ancestor::*[3])", "name(baz1:a)", "name(baz1:a/@baz2:attrib1)", "name(baz2:b)", "name(baz2:b/@baz1:attrib2)", "name(descendant-or-self::node()/child::near-north)", "name(descendant-or-self::node()/child::node()/child::far-west)", "name(descendant-or-self::node()/child::node()/descendant-or-self::near-north)", "name(descendant-or-self::node()/descendant-or-self::node()/child::near-north)", "name(descendant-or-self::node()/descendant-or-self::node()/descendant-or-self::north)", "name(descendant-or-self::node()/descendant-or-self::north)", "name(descendant-or-self::node()/descendant::near-north)", "name(descendant-or-self::node()/descendant::node()/child::far-west)", "name(descendant-or-self::node()/descendant::node()/descendant-or-self::near-north)", "name(descendant-or-self::north/child::near-north)", "name(descendant-or-self::north/child::near-north/child::far-west)", "name(descendant-or-self::north/child::near-north/descendant-or-self::near-north)", "name(descendant-or-self::north/descendant-or-self::north)", "name(descendant-or-self::north/descendant-or-self::north/child::near-north)", "name(descendant-or-self::north/descendant-or-self::north/descendant-or-self::north)", "name(descendant-or-self::north/descendant::near-north)", "name(descendant-or-self::north/descendant::near-north/child::far-west)", "name(descendant-or-self::north/descendant::near-north/descendant-or-self::near-north)", "name(descendant::near-north/descendant-or-self::near-north)", "name(descendant::near-north/descendant-or-self::near-north/child::far-west)", "name(descendant::near-north/descendant-or-self::near-north/descendant-or-self::near-north)", "name(descendant::near-north/descendant::far-west)", "name(descendant::near-north/descendant::far-west/descendant-or-self::far-west)", "name(descendant::node()/descendant-or-self::near-north)", "name(descendant::node()/descendant-or-self::node()/child::far-west)", "name(descendant::node()/descendant-or-self::node()/descendant-or-self::near-north)", "name(descendant::node()/descendant::far-west)", "name(descendant::node()/descendant::node()/descendant-or-self::far-west)", "name(namespace::*[1])", "name(self::node()/descendant-or-self::node()/child::near-north)", "name(self::node()/descendant-or-self::node()/descendant-or-self::north)", "name(self::node()/descendant-or-self::north)", "name(self::node()/descendant-or-self::north/child::near-north)", "name(self::node()/descendant-or-self::north/descendant-or-self::north)", "name(self::node()/descendant::near-north)", "name(self::node()/descendant::near-north/child::far-west)", "name(self::node()/descendant::near-north/descendant-or-self::far-west)", "name(self::node()/descendant::node()/child::far-west)", "name(self::node()/descendant::node()/descendant-or-self::far-west)", "name(xalan:nodeset($rtf)/*)", "namespace-uri(baz1:a-two/@attrib1)", "namespace-uri(baz1:a/@baz2:attrib1)", "namespace-uri(baz2:b)", "namespace-uri(baz2:b-three)", "namespace-uri(baz2:b-three/@baz1:attrib2)", "namespace-uri(baz2:b-three/c-four)", "namespace-uri(baz2:b/@baz1:attrib2)", "namespace-uri(namespace::*[string()='http://www.w3.org/1999/XMLSchema-instance'])", "namespace-uri(namespace::*[string()='test'])", "namespace-uri(x)", "namespace-uri(xalan:nodeset($rtf)/default:docelem)", "namespace-uri(xalan:nodeset($rtf)/default:docelem/default:elem1)", "namespace-uri(xalan:nodeset($rtf)/default:docelem/test:elem3)", "namespace::*", "namespace::node()", "nitro:element(.)", "node", "node()|@*", "normalize-space($texts[1])", "normalize-space($thisvalue)", "normalize-space(' ab cd ef ')", "normalize-space()", "normalize-space(a)", "north/* | north/dup1 | north/dup2", "north/dup2 | document('select71.xml')/south/preceding-sibling[4] | north/*", "north/dup2 | north/dup1 | north/*", "not($x!='foo')", "not('')", "not('0')", "not(false() = false())", "not(false())", "not(true() = false())", "not(true())", "note[1]", "note[1]", "number($ResultTreeFragTest)", "number($emptyResultTreeFragTest)", "number($pvar2)", "number('')", "number('3')", "number('abc')", "number('xxx') - 10", "number('xxx') div 3", "number('xxx') mod 3", "number('xxx')=0", "number('xxx')=number('xxx')", "number()", "number(2)", "number(false())=0", "number(foo)", "number(n1)", "number(string(1.0))=1", "number(true())=1", "number(xalan:nodeset($rtf)/default:docelem/default:elem3[2])", "para[@id='1' and lang('en')]", "parent::*", "parent::*[1]", "parent::foo", "parent::near-north", "position()", "position()=1", "preceding-sibling::*", "preceding-sibling::*/following-sibling::*", "preceding-sibling::*[2]", "preceding-sibling::*[2]", "preceding-sibling::*[2]/following-sibling::*", "preceding-sibling::*[2]/following-sibling::*[4]", "preceding-sibling::*[2]/following-sibling::*[4]/preceding-sibling::*[5]/following-sibling::*[4]/following-sibling::*[2]", "preceding-sibling::*|following-sibling::*", "preceding-sibling::child1|//child3", "preceding-sibling::child1|following-sibling::child3", "preceding-sibling::foo[1]/@att1", "preceding-sibling::west", "preceding::*", "preceding::*[2]/../descendant::*[10]/following-sibling::east", "preceding::*[2]/../following::*", "preceding::*[4]", "preceding::foo[1]/@att1", "preceding::out-yonder-west", "preceding::text()", "preceding::text()[$this]", "primary/name/first", "primary/name/first", "processing-instruction()", "pt:xif('test')", "pt:xif(string($val))", "round(-1.1)=-1", "round(-1.5)", "round(-1.9)=-2", "round(-2.5)=-2", "round(0.0)", "round(1.1)=1", "round(1.24)", "round(1.5)=2", "round(1.9)=2", "round(2.5)", "round(2.999999)", "round(count(.//LINE) div count(.//SPEECH))", "round(n0)", "round(n1)", "round(n2)", "round(number('xxx'))", "row", "self::*", "self::*", "self::*[1]", "self::*[@center-attr-2]", "self::*[near-south]", "self::center", "self::child1|self::child2", "self::comment()", "self::foo", "self::node()", "self::node()", "self::node()", "self::node()", "self::processing-instruction()", "self::text()", "sigs", "sss//i", "sss//i", "sss/sss", "sss/sss", "starts-with('','')", "starts-with('ENCYCLOPEDIA', 'EN')", "starts-with('ENCYCLOPEDIA', 'ENCY')", "starts-with('ENCYCLOPEDIA', 'en')", "starts-with('ab', 'abc')", "starts-with('abc', '')", "starts-with('abc', 'bc')", "starts-with('true()', 'tr')", "starts-with(doc, 'ENCY')", "starts-with(doc, 'test')", "starts-with(doc/@attr, 'slam')", "starts-with(doc/@attr, 'wich')", "str:new(string(doc))", "str:toUpperCase($str-obj)", "string($ResultTreeFragTest)", "string($ResultTreeFragTest)", "string($emptyResultTreeFragTest)", "string($which)", "string('!From m!')", "string('!From n!')", "string('!From o!')", "string('!From p!')", "string('')", "string('test')", "string()", "string()", "string(0)", "string(2)", "string(av//*)", "string(doc)", "string(foo)", "string-length ()", "string-length($str)", "string-length('This is a test')", "string-length()", "string-length()", "string-length(.)", "string-length(doc)", "string-length(doc/a)", "sub1/child1|/doc/sub2/child2", "sub1/child1|sub2/child2", "subj", "substring('1999/04/01', 1, 0)", "substring('1999/04/01', 1, 4)", "substring('ENCYCLOPEDIA', 8)", "substring('ENCYCLOPEDIA', 8, 3)", "substring('abcdefghi',2,4)", "substring('abcdefghijk',0 div 0, 5)", "substring('abcdefghijk',4, 6)", "substring(@key,2,1)", "substring(doc, 1, 4)", "substring(doc/@attr, 1, 3)", "substring(doc/@attr, 2.5, 3.6)", "substring(doc/@attr, 4)", "substring(foo, 12, 3)", "substring(foo, 2, 2)", "substring-after($words,' ')", "substring-after('1999/04/01', '/')", "substring-after('1999/04/01', '1')", "substring-after('ENCYCLOPEDIA', '/')", "substring-after('ENCYCLOPEDIA', 'C')", "substring-after('abcdefghijk','l')", "substring-after(doc, '/')", "substring-after(doc/@attr, 'D')", "substring-after(doc/@attr, 'd')", "substring-after(doc/@attr, 'z')", "substring-after(foo, '/')", "substring-before('1999/04/01', '/')", "substring-before('ENCYCLOPEDIA', '/')", "substring-before('ENCYCLOPEDIA', 'C')", "substring-before('ENCYCLOPEDIA', 'c')", "substring-before('a','z')", "substring-before(doc, '/')", "substring-before(doc/@attr, 'D')", "substring-before(doc/@attr, 'd')", "substring-before(doc/@attr, 'z')", "substring-before(foo, '/')", "sum($rtf)", "sum(e)", "sum(e)", "sum(n)", "sum(n/@attrib)", "sum(x)", "sum(xalan:nodeset($rtf)/default:docelem/default:elem3)", "system-property('xsl:vendor')", "true() and false()", "true() and true()", "true() or 1 div 0", "true() or false()", "true() or true()", "true()", "true()=2", "width * depth", "xalan:nodeset($rtf)/default:docelem", "xalan:nodeset($rtf)/default:docelem/*", "xalan:nodeset($rtf)/default:docelem/default:elem1", "xalan:nodeset($rtf)/default:docelem/default:elem1/default:elem1b", "xalan:nodeset($rtf)/default:docelem/default:elem2/*", "xalan:nodeset($rtf)/default:docelem/default:elem4", "xalan:nodeset($rtf)/default:docelem/test:elem3", "xalan:nodeset($sorted)/item", "deep-equal(/,foo)" ] -- die folgenden tests wurden vom W3C auskommentiert -- ab hier ersetzen alle ersten -- durch < -- -- -- -- -- hxt-xpath-9.1.2.2/examples/hxpath/XPathShell.hs0000644000000000000000000001577712465156121017504 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : XPathShell Copyright : Copyright (C) 2008 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable XPath example program for testing xpath evaluation with both evaluation stategies, the full XPath functionality and the limited but faster one for simple XPath queries -} -- ------------------------------------------------------------ module Main where import qualified Control.Monad as M import Data.Maybe import Text.XML.HXT.Core import Text.XML.HXT.XPath import Text.XML.HXT.Curl import Text.XML.HXT.Parser.XmlCharParser( withNormNewline ) import System.Console.Haskeline import System.Console.Haskeline.IO import System.Environment import Text.ParserCombinators.Parsec ( runParser ) type NsEnv' = AssocList String String main :: IO() main = do args <- getArgs (path, env, doc) <- evalArgs args if not (null path) && not (null doc) then evalXPath path env (head doc) else startEvalLoop env doc evalArgs :: [String] -> IO (String, NsEnv', XmlTrees) evalArgs [] = evalArgs ("" : "[]" : "" : []) evalArgs [doc] = evalArgs ("" : "[]" : doc : []) evalArgs [path, doc] = evalArgs (path : "[]" : doc : []) evalArgs [path, env, ""] = return (path, buildEnv env, []) evalArgs [path, env, doc] = do (d, ne) <- loadDoc doc return (path, addEntries ne . buildEnv $ env, d) evalArgs al = evalArgs (take 3 al) buildEnv :: String -> NsEnv' buildEnv env = (addEntries . read $ env) $ defaultEnv loadDoc :: String -> IO ([XmlTree], NsEnv') loadDoc doc = do d <- runX ( readDocument [ withParseByMimeType yes , withCheckNamespaces yes , withRemoveWS yes , withValidate no , withCanonicalize yes , withCurl [] ] doc >>> (documentStatusOk `guards` this) ) let env = runLA (unlistA >>> collectNamespaceDecl) d return (d, env) showDoc :: XmlTree -> IO () showDoc doc = runX ( constA doc >>> writeDocument [ withIndent yes , withXmlPi no ] "" ) >> return () showTree :: XmlTree -> IO () showTree doc = runX ( constA doc >>> writeDocument [ withShowTree yes , withXmlPi no ] "" ) >> return () evalXPath :: String -> NsEnv' -> XmlTree -> IO() evalXPath path env doc = putStrLn . unlines $ [ "start xpath evaluation: " ++ pathS , " parsed xpath: " ++ pathString , " parsed xpath as tree:" , pathTree , "xpath result:" ] ++ xr ++ [ "end xpath evaluation: " ++ pathS ] where pathS = show $ path pathEx = runParser parseXPath (withNormNewline (toNsEnv env)) "" $ path pathString = either show show $ pathEx pathTree = either show formatXPathTree $ pathEx xr = runLA ( xshow $ getXPathTreesWithNsEnv env path) doc startEvalLoop :: NsEnv' -> XmlTrees -> IO () startEvalLoop env doc = do is0 <- initializeInput defaultSettings evalLoop0 (readCmdLine is0 "xpath> ") env doc closeInput is0 return () readCmdLine :: InputState -> String -> IO String readCmdLine is0 prompt = do line <- queryInput is0 (getInputLine prompt) let line' = stringTrim . fromMaybe "" $ line if null line' then readCmdLine is0 prompt else return line' evalLoop0 :: IO String -> NsEnv' -> XmlTrees -> IO () evalLoop0 readCmdLine' env doc = do line <- readCmdLine' case line of "" -> return () -- EOF / control-d ":q" -> return () _ -> do let ws = words line if null ws then evalLoop env doc else do evalCmd (words line) where evalLoop = evalLoop0 readCmdLine' evalCmd [] = evalLoop env doc evalCmd [":ns",uri] = evalCmd [":ns", "", uri] evalCmd [":ns", ns, uri] = evalLoop (addEntry ns uri env) doc evalCmd (":?":_) = do putStrLn . unlines $ [ "XPath Tester" , "Commands:" , ":l \tload a document" , ":ns \tset default namespace" , ":ns \tset namespace" , ":q\t\tquit" , ":s\t\tshow current document" , ":t\t\tshow current document in tree format" , ":x\t\tshow current namespace environment" , ":?\t\tthis message" , "\tevaluate XPath expression" ] evalLoop env doc evalCmd [":x"] = do putStrLn . unlines . map show $ env evalLoop env doc evalCmd [":s"] = do M.when (not . null $ doc) (showDoc . head $ doc) evalLoop env doc evalCmd [":t"] = do M.when (not . null $ doc) (showTree . head $ doc) evalLoop env doc evalCmd [":l",n] = do (nd, nv) <- loadDoc n if null nd then do putStrLn ("error when loading " ++ show n) evalLoop env doc else evalLoop (addEntries nv env) nd evalCmd ws@((':':_):_) = do putStrLn ("unknown command (:? for help): " ++ (show . unwords $ ws)) evalLoop env doc evalCmd ws = do let path = unwords ws if null doc then putStrLn "no document loaded" else evalXPath path env (head doc) evalLoop env doc defaultEnv :: NsEnv' defaultEnv = [ ("xml",xmlNamespace) , ("xmlns",xmlnsNamespace) ] -- ---------------------------------------- hxt-xpath-9.1.2.2/examples/hxpath/Makefile0000644000000000000000000000300712465156121016553 0ustar0000000000000000# $Id: Makefile,v 1.2 2005/04/14 12:52:51 hxml Exp $ HXT_HOME = ../../.. PKGFLAGS = GHCFLAGS = -Wall -O2 GHC = ghc $(GHCFLAGS) $(PKGFLAGS) prog = ./HXPath prog2 = ./XPathShell all : $(prog) $(prog2) force : $(GHC) --make -o $(prog) $(prog).hs local : ghc --make -o $(prog2) $(GHCFLAGS) -fglasgow-exts -ignore-package hxt -i../../../src $(prog2).hs $(prog) : $(prog).hs $(GHC) --make -o $@ $< $(prog2) : $(prog2).hs $(GHC) --make -o $@ $< EX = xhtml/xhtml.xml test : $(prog) @echo "===> XPath extraction examples" ; echo ; sleep 2 @$(MAKE) test1 test2 test3 test4 test1 : @echo "===> extract all text from the XHTML document" ; echo ; sleep 2 $(prog) --do-not-validate "/html/body/descendant-or-self::text()" $(EX) @echo test2 : @echo "===> extract the 42. paragraph from the XHTML document" ; echo ; sleep 2 $(prog) --do-not-validate "/descendant::p[position()=42]" $(EX) @echo test3 : @echo "===> extract the text of all top level h1 tags from the XHTML document" ; echo ; sleep 2 $(prog) --indent --do-not-validate "/child::html/child::body/child::h1/descendant-or-self::text()" $(EX) @echo test4 : @echo "===> extract all href attributes from a tags from the XHTML document" ; echo ; sleep 2 $(prog) --indent --do-not-validate "/descendant::a/attribute::href" $(EX) @echo DIST = $(HXT_HOME)/dist/examples/arrows DIST_DIR = $(DIST)/hxpath dist : [ -d $(DIST_DIR) ] || mkdir -p $(DIST_DIR) cp Makefile $(prog).hs $(prog2).hs $(DIST_DIR) clean : rm -f $(prog) *.hi *.o hxt-xpath-9.1.2.2/examples/hxpath/HXPath.hs0000644000000000000000000001042512465156121016605 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : HXPath Copyright : Copyright (C) 2005 Torbel Kuseler, Uwe Schmidt License : MIT Maintainer : Uwe Schmidt Maintainer : uwe@fh-wedel.de Stability : experimental Portability: portable HXPath - XPath Evaluator of the Haskell XML Toolbox (Arrow version) -} -- ------------------------------------------------------------ module Main where import Text.XML.HXT.Arrow.XmlState.TypeDefs import Text.XML.HXT.Core import Text.XML.HXT.Curl import Text.XML.HXT.XPath import System.Console.GetOpt import System.Environment import System.Exit import System.IO -- ------------------------------------------------------------ -- | -- the main program main :: IO () main = do argv <- getArgs -- get the commandline arguments (al, expr, src) <- cmdlineOpts argv -- and evaluate them, return a key-value list [rc] <- runX (xpath al expr src) -- run the parser arrow exitProg (rc >= c_err) -- set return code and terminate -- ------------------------------------------------------------ exitProg :: Bool -> IO a exitProg True = exitWith (ExitFailure 1) exitProg False = exitWith ExitSuccess -- ------------------------------------------------------------ -- | -- the /real/ main program -- -- runs in the trivial XmlState monad (with user state set to ()) -- so IO and access to global options is possible xpath :: SysConfigList -> String -> String -> IOSArrow b Int xpath cf expr src = configSysVars cf -- set all global config options, the output file and the >>> -- other user options are stored as key-value pairs in the stystem state readDocument [withCurl []] src >>> evalXPathExpr >>> traceMsg 1 "evaluation finished" >>> traceSource >>> traceTree >>> ( formatXPathResult $< getSysVar theIndent ) >>> writeDocument [] "-" >>> getErrStatus where evalXPathExpr :: IOSArrow XmlTree XmlTree evalXPathExpr = traceMsg 1 ("evaluating XPath expression: " ++ expr) >>> replaceChildren ( getXPathTreesInDoc expr >>> filterErrorMsg ) formatXPathResult :: Bool -> IOSArrow XmlTree XmlTree formatXPathResult indent = replaceChildren ( mkelem "xpath-result" [ sattr "expr" expr, sattr "source" src ] [ newline, getChildren >>> (this <+> newline) ] ) where newline | indent = txt "\n" | otherwise = none -- ------------------------------------------------------------ -- -- the options definition part -- see doc for System.Console.GetOpt progName :: String progName = "HXPath" options :: [OptDescr SysConfig] options = generalOptions ++ inputOptions ++ outputOptions usage :: [String] -> IO a usage errl | null errl = do hPutStrLn stdout use exitProg False | otherwise = do hPutStrLn stderr (concat errl ++ "\n" ++ use) exitProg True where header = "HXPath - XPath Evaluator of the Haskell XML Toolbox (Arrow Version)\n" ++ "Usage: " ++ progName ++ " [OPTION...] " use = usageInfo header options cmdlineOpts :: [String] -> IO ([SysConfig], String, String) cmdlineOpts argv = case (getOpt Permute options argv) of (scfg,n,[] ) -> do (ex, sa) <- src n help (getConfigAttr a_help scfg) return (scfg, ex, sa) (_,_,errs) -> usage errs where src [expr, url] = return (expr, url) src [] = usage ["XPath expression and input file/url missing"] src [_] = usage ["input file/url missing"] src _ = usage ["too many arguments"] help "1" = usage [] help _ = return () -- ------------------------------------------------------------ hxt-xpath-9.1.2.2/examples/hxpath/xhtml/0000755000000000000000000000000012465156121016247 5ustar0000000000000000hxt-xpath-9.1.2.2/examples/hxpath/xhtml/xhtml1-strict.dtd0000644000000000000000000006270212465156121021476 0ustar0000000000000000 %HTMLlat1; %HTMLsymbol; %HTMLspecial; hxt-xpath-9.1.2.2/examples/hxpath/xhtml/xhtml-symbol.ent0000644000000000000000000003345112465156121021424 0ustar0000000000000000 hxt-xpath-9.1.2.2/examples/hxpath/xhtml/xhtml1-transitional.dtd0000644000000000000000000007675612465156121022713 0ustar0000000000000000 %HTMLlat1; %HTMLsymbol; %HTMLspecial; hxt-xpath-9.1.2.2/examples/hxpath/xhtml/xhtml-special.ent0000644000000000000000000001005712465156121021534 0ustar0000000000000000 hxt-xpath-9.1.2.2/examples/hxpath/xhtml/xhtml.xml0000644000000000000000000015503112465156121020132 0ustar0000000000000000 XHTML 1.0: The Extensible HyperText Markup Language
table of contents

W3C

XHTML™ 1.0: The Extensible HyperText Markup Language

A Reformulation of HTML 4 in XML 1.0

W3C Recommendation 26 January 2000

This version:
http://www.w3.org/TR/2000/REC-xhtml1-20000126
(Postscript version, PDF version, ZIP archive, or Gzip'd TAR archive)
Latest version:
http://www.w3.org/TR/xhtml1
Previous version:
http://www.w3.org/TR/1999/PR-xhtml1-19991210
Authors:
See acknowledgements.

Copyright ©2000 W3C® (MIT, INRIA, Keio), All Rights Reserved. W3C liability, trademark, document use and software licensing rules apply.

Abstract

This specification defines XHTML 1.0, a reformulation of HTML 4 as an XML 1.0 application, and three DTDs 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.

Status of this document

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.

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.

This document has been produced as part of the W3C HTML Activity. The goals of the HTML Working Group (members only) are discussed in the HTML Working Group charter (members only).

A list of current W3C Recommendations and other technical documents can be found at http://www.w3.org/TR.

Public discussion on HTML features takes place on the mailing list www-html@w3.org (archive).

Please report errors in this document to www-html-editor@w3.org.

The list of known errors in this specification is available at http://www.w3.org/2000/01/REC-xhtml1-20000126-errata.

Contents

1. What is XHTML?

XHTML is a family of current and future document types and modules that reproduce, subset, and extend HTML 4 [HTML]. XHTML family document types are XML 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 Future Directions.

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 [XML]. It is intended to be used as a language for content that is both XML-conforming and, if some simple guidelines are followed, operates in HTML 4 conforming user agents. Developers who migrate their content to XHTML 1.0 will realize the following benefits:

  • XHTML documents are XML conforming. As such, they are readily viewed, edited, and validated with standard XML tools.
  • 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.
  • 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 [DOM].
  • As the XHTML family evolves, documents conforming to XHTML 1.0 will be more likely to interoperate within and among various XHTML environments.

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.

1.1 What is HTML 4?

HTML 4 [HTML] is an SGML (Standard Generalized Markup Language) application conforming to International Standard ISO 8879, and is widely regarded as the standard publishing language of the World Wide Web.

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.

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.

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.

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.

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.

1.2 What is XML?

XML™ is the shorthand for Extensible Markup Language, and is an acronym of Extensible Markup Language [XML].

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.

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.

1.3 Why the need for XHTML?

The benefits of migrating to XHTML 1.0 are described above. Some of the benefits of migrating to XHTML in general are:

  • 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.
  • 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.

2. Definitions

2.1 Terminology

The following terms are used in this specification. These terms extend the definitions in [RFC2119] in ways based upon similar definitions in ISO/IEC 9945-1:1990 [POSIX.1]:

Implementation-defined
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.
May
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 Document Conformance, the word "may" means that the optional feature must not be used. The term "optional" has the same definition as "may".
Must
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".
Reserved
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.
Should
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.
Supported
Certain facilities in this specification are optional. If a facility is supported, it behaves as specified by this specification.
Unspecified
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.

2.2 General Terms

Attribute
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.
DTD
A DTD, or document type definition, is a collection of XML declarations that, as a collection, defines the legal structure, elements, and attributes that are available for use in a document that complies to the DTD.
Document
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 elements that are organized as defined in the associated DTD. See Document Conformance for more information.
Element
An element is a document structuring unit declared in the DTD. The element's content model is defined in the DTD, and additional semantics may be defined in the prose description of the element.
Facilities
Functionality includes elements, attributes, and the semantics associated with those elements and attributes. An implementation supporting that functionality is said to provide the necessary facilities.
Implementation
An implementation is a system that provides collection of facilities and services that supports this specification. See User Agent Conformance for more information.
Parsing
Parsing is the act whereby a document is scanned, and the information contained within the document is filtered into the context of the elements in which the information is structured.
Rendering
Rendering is the act whereby the information in a document is presented. This presentation is done in the form most appropriate to the environment (e.g. aurally, visually, in print).
User Agent
A user agent is an implementation that retrieves and processes XHTML documents. See User Agent Conformance for more information.
Validation
Validation is a process whereby documents are verified against the associated DTD, ensuring that the structure, use of elements, and use of attributes are consistent with the definitions in the DTD.
Well-formed
A document is well-formed when it is structured according to the rules defined in Section 2.1 of the XML 1.0 Recommendation [XML]. Basically, this definition states that elements, delimited by their start and end tags, are nested properly within one another.

3. Normative Definition of XHTML 1.0

3.1 Document Conformance

This version of XHTML provides a definition of strictly conforming XHTML documents, which are restricted to tags and attributes from the XHTML namespace. See Section 3.1.2 for information on using XHTML with other namespaces, for instance, to include metadata expressed in RDF within XHTML documents.

3.1.1 Strictly Conforming Documents

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:

  1. It must validate against one of the three DTDs found in Appendix A.

  2. The root element of the document must be <html>.

  3. The root element of the document must designate the XHTML namespace using the xmlns attribute [XMLNAMES]. The namespace for XHTML is defined to be http://www.w3.org/1999/xhtml.

  4. 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 Appendix A using the respective Formal Public Identifier. The system identifier may be changed to reflect local system conventions.

    <!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">

Here is an example of a minimal XHTML document.

<?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>

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.

3.1.2 Using XHTML with other namespaces

The XHTML namespace may be used with other XML namespaces as per [XMLNAMES], 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.

The following example shows the way in which XHTML 1.0 could be used in conjunction with the MathML Recommendation:

<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>

The following example shows the way in which XHTML 1.0 markup could be incorporated into another XML namespace:

<?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>

3.2 User Agent Conformance

A conforming user agent must meet all of the following criteria:

  1. In order to be consistent with the XML 1.0 Recommendation [XML], 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 [XML].
  2. When the user agent claims to support facilities defined within this specification or required by this specification through normative reference, it must do so in ways consistent with the facilities' definition.
  3. When a user agent processes an XHTML document as generic XML, it shall only recognize attributes of type ID (e.g. the id attribute on most XHTML elements) as fragment identifiers.
  4. If a user agent encounters an element it does not recognize, it must render the element's content.
  5. 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).
  6. If a user agent encounters an attribute value it doesn't recognize, it must use the default attribute value.
  7. 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.
  8. 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.
  9. The following characters are defined in [XML] as whitespace characters:
    • Space (&#x0020;)
    • Tab (&#x0009;)
    • Carriage return (&#x000D;)
    • Line feed (&#x000A;)

    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:

    • Form feed (&#x000C;)
    • Zero-width space (&#x200B;)

    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:

    • All whitespace surrounding block elements should be removed.
    • 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.
    • Leading and trailing whitespace inside a block element must be removed.
    • Line feed characters within a block element must be converted into a space (except when the 'xml:space' attribute is set to 'preserve').
    • A sequence of white space characters must be reduced to a single space character (except when the 'xml:space' attribute is set to 'preserve').
    • 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.

    Whitespace in attribute values is processed according to [XML].

4. Differences with HTML 4

Due to the fact that XHTML is an XML application, certain practices that were perfectly legal in SGML-based HTML 4 [HTML] must be changed.

4.1 Documents must be well-formed

Well-formedness is a new concept introduced by [XML]. 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.

Although overlapping is illegal in SGML, it was widely tolerated in existing browsers.

CORRECT: nested elements.

<p>here is an emphasized <em>paragraph</em>.</p>

INCORRECT: overlapping elements

<p>here is an emphasized <em>paragraph.</p></em>

4.2 Element and attribute names must be in lower case

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.

4.3 For non-empty elements, end tags are required

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 EMPTY must have an end tag.

CORRECT: terminated elements

<p>here is a paragraph.</p><p>here is another paragraph.</p>

INCORRECT: unterminated elements

<p>here is a paragraph.<p>here is another paragraph.

4.4 Attribute values must always be quoted

All attribute values must be quoted, even those which appear to be numeric.

CORRECT: quoted attribute values

<table rows="3">

INCORRECT: unquoted attribute values

<table rows=3>

4.5 Attribute Minimization

XML does not support attribute minimization. Attribute-value pairs must be written in full. Attribute names such as compact and checked cannot occur in elements without their value being specified.

CORRECT: unminimized attributes

<dl compact="compact">

INCORRECT: minimized attributes

<dl compact>

4.6 Empty Elements

Empty elements must either have an end tag or the start tag must end with />. For instance, <br/> or <hr></hr>. See HTML Compatibility Guidelines for information on ways to ensure this is backward compatible with HTML 4 user agents.

CORRECT: terminated empty tags

<br/><hr/>

INCORRECT: unterminated empty tags

<br><hr>

4.7 Whitespace handling in attribute values

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 Section 3.3.3 of [XML].

4.8 Script and Style elements

In XHTML, the script and style elements are declared as having #PCDATA content. As a result, < and & will be treated as the start of markup, and entities such as &lt; and &amp; will be recognized as entity references by the XML processor to < and & respectively. Wrapping the content of the script or style element within a CDATA marked section avoids the expansion of these entities.

<script>
 <![CDATA[
 ... unescaped script content ...
 ]]>
 </script>

CDATA sections are recognized by the XML processor and appear as nodes in the Document Object Model, see Section 1.3 of the DOM Level 1 Recommendation [DOM].

An alternative is to use external script and style documents.

4.9 SGML exclusions

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.

For example, the HTML 4 Strict DTD forbids the nesting of an 'a' element within another 'a' 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 Appendix B.

4.10 The elements with 'id' and 'name' attributes

HTML 4 defined the name attribute for the elements a, applet, form, frame, iframe, img, and map. HTML 4 also introduced the id attribute. Both of these attributes are designed to be used as fragment identifiers.

In XML, fragment identifiers are of type ID, and there can only be a single attribute of type ID per element. Therefore, in XHTML 1.0 the id attribute is defined to be of type ID. In order to ensure that XHTML 1.0 documents are well-structured XML documents, XHTML 1.0 documents MUST use the id attribute when defining fragment identifiers, even on elements that historically have also had a name attribute. See the HTML Compatibility Guidelines for information on ensuring such anchors are backwards compatible when serving XHTML documents as media type text/html.

Note that in XHTML 1.0, the name attribute of these elements is formally deprecated, and will be removed in a subsequent version of XHTML.

5. Compatibility Issues

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 Appendix C.

5.1 Internet Media Type

As of the publication of this recommendation, the general recommended MIME labeling for XML-based applications has yet to be resolved.

However, XHTML Documents which follow the guidelines set forth in Appendix C, "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.

6. Future Directions

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.

6.1 Modularizing HTML

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.

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.

These modules will be defined in a later W3C document.

6.2 Subsets and Extensibility

Modularization brings with it several advantages:

  • It provides a formal mechanism for sub-setting XHTML.

  • It provides a formal mechanism for extending XHTML.

  • It simplifies the transformation between document types.

  • It promotes the reuse of modules in new document types.

6.3 Document Profiles

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.

For product designers this enables various groups to define their own standard profile.

For authors this will obviate the need to write several different versions of documents for different clients.

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.

Appendix A. DTDs

This appendix is normative.

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 zip file for this specification.

A.1 Document Type Definitions

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.

A.2 Entity Sets

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 (&euro; or &#8364; or &#x20AC;) is defined as part of the special characters.

Appendix B. Element Prohibitions

This appendix is normative.

The following elements have prohibitions on which elements they can contain (see Section 4.9). This prohibition applies to all depths of nesting, i.e. it contains all the descendant elements.

a
cannot contain other a elements.
pre
cannot contain the img, object, big, small, sub, or sup elements.
button
cannot contain the input, select, textarea, label, button, form, fieldset, iframe or isindex elements.
label
cannot contain other label elements.
form
cannot contain other form elements.

Appendix C. HTML Compatibility Guidelines

This appendix is informative.

This appendix summarizes design guidelines for authors who wish their XHTML documents to render on existing HTML user agents.

C.1 Processing Instructions

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.

C.2 Empty Elements

Include a space before the trailing / and > of empty elements, e.g. <br />, <hr /> and <img src="karen.jpg" alt="Karen" />. Also, use the minimized tag syntax for empty elements, e.g. <br />, as the alternative syntax <br></br> allowed by XML gives uncertain results in many existing user agents.

C.3 Element Minimization and Empty Element Content

Given an empty instance of an element whose content model is not EMPTY (for example, an empty title or paragraph) do not use the minimized form (e.g. use <p> </p> and not <p />).

C.4 Embedded Style Sheets and Scripts

Use external style sheets if your style sheet uses < or & or ]]> or --. Use external scripts if your script uses < or & or ]]> or --. 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.

C.5 Line Breaks within Attribute Values

Avoid line breaks and multiple whitespace characters within attribute values. These are handled inconsistently by user agents.

C.6 Isindex

Don't include more than one isindex element in the document head. The isindex element is deprecated in favor of the input element.

C.7 The lang and xml:lang Attributes

Use both the lang and xml:lang attributes when specifying the language of an element. The value of the xml:lang attribute takes precedence.

C.8 Fragment Identifiers

In XML, URIs [RFC2396] that end with fragment identifiers of the form "#foo" do not refer to elements with an attribute name="foo"; rather, they refer to elements with an attribute defined to be of type ID, e.g., the id attribute in HTML 4. Many existing HTML clients don't support the use of ID-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., <a id="foo" name="foo">...</a>).

Further, since the set of legal values for attributes of type ID is much smaller than for those of type CDATA, the type of the name attribute has been changed to NMTOKEN. This attribute is constrained such that it can only have the same values as type ID, or as the Name 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.

Finally, note that XHTML 1.0 has deprecated the name attribute of the a, applet, form, frame, iframe, img, and map elements, and it will be removed from XHTML in subsequent versions.

C.9 Character Encoding

To specify a character encoding in the document, use both the encoding attribute specification on the xml declaration (e.g. <?xml version="1.0" encoding="EUC-JP"?>) and a meta http-equiv statement (e.g. <meta http-equiv="Content-type" content='text/html; charset="EUC-JP"' />). The value of the encoding attribute of the xml processing instruction takes precedence.

C.10 Boolean Attributes

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: compact, nowrap, ismap, declare, noshade, checked, disabled, readonly, multiple, selected, noresize, defer.

C.11 Document Object Model and XHTML

The Document Object Model level 1 Recommendation [DOM] 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:

  1. Applications that access XHTML documents served as Internet media type text/html via the DOM can use the HTML DOM, and can rely upon element and attribute names being returned in upper-case from those interfaces.
  2. Applications that access XHTML documents served as Internet media types text/xml or application/xml 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 tbody element within table). 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.

C.12 Using Ampersands in Attribute Values

When an attribute value contains an ampersand, it must be expressed as a character entity reference (e.g. "&amp;"). For example, when the href attribute of the a element refers to a CGI script that takes parameters, it must be expressed as http://my.site.dom/cgi-bin/myscript.pl?class=guest&amp;name=user rather than as http://my.site.dom/cgi-bin/myscript.pl?class=guest&name=user.

C.13 Cascading Style Sheets (CSS) and XHTML

The Cascading Style Sheets level 2 Recommendation [CSS2] 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:

  1. CSS style sheets for XHTML should use lower case element and attribute names.
  2. 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.
  3. 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.
  4. 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.
  5. 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.

Appendix D. Acknowledgements

This appendix is informative.

This specification was written with the participation of the members of the W3C HTML working group:

Steven Pemberton, CWI (HTML Working Group Chair)
Murray Altheim, Sun Microsystems
Daniel Austin, AskJeeves (CNET: The Computer Network through July 1999)
Frank Boumphrey, HTML Writers Guild
John Burger, Mitre
Andrew W. Donoho, IBM
Sam Dooley, IBM
Klaus Hofrichter, GMD
Philipp Hoschka, W3C
Masayasu Ishikawa, W3C
Warner ten Kate, Philips Electronics
Peter King, Phone.com
Paula Klante, JetForm
Shin'ichi Matsui, Panasonic (W3C visiting engineer through September 1999)
Shane McCarron, Applied Testing and Technology (The Open Group through August 1999)
Ann Navarro, HTML Writers Guild
Zach Nies, Quark
Dave Raggett, W3C/HP (W3C lead for HTML)
Patrick Schmitz, Microsoft
Sebastian Schnitzenbaumer, Stack Overflow
Peter Stark, Phone.com
Chris Wilson, Microsoft
Ted Wugofski, Gateway 2000
Dan Zigmond, WebTV Networks

Appendix E. References

This appendix is informative.

[CSS2]
"Cascading Style Sheets, level 2 (CSS2) Specification", B. Bos, H. W. Lie, C. Lilley, I. Jacobs, 12 May 1998.
Latest version available at: http://www.w3.org/TR/REC-CSS2
[DOM]
"Document Object Model (DOM) Level 1 Specification", Lauren Wood et al., 1 October 1998.
Latest version available at: http://www.w3.org/TR/REC-DOM-Level-1
[HTML]
"HTML 4.01 Specification", D. Raggett, A. Le Hors, I. Jacobs, 24 December 1999.
Latest version available at: http://www.w3.org/TR/html401
[POSIX.1]
"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.
[RFC2046]
"RFC2046: Multipurpose Internet Mail Extensions (MIME) Part Two: Media Types", N. Freed and N. Borenstein, November 1996.
Available at http://www.ietf.org/rfc/rfc2046.txt. Note that this RFC obsoletes RFC1521, RFC1522, and RFC1590.
[RFC2119]
"RFC2119: Key words for use in RFCs to Indicate Requirement Levels", S. Bradner, March 1997.
Available at: http://www.ietf.org/rfc/rfc2119.txt
[RFC2376]
"RFC2376: XML Media Types", E. Whitehead, M. Murata, July 1998.
Available at: http://www.ietf.org/rfc/rfc2376.txt
[RFC2396]
"RFC2396: Uniform Resource Identifiers (URI): Generic Syntax", T. Berners-Lee, R. Fielding, L. Masinter, August 1998.
This document updates RFC1738 and RFC1808.
Available at: http://www.ietf.org/rfc/rfc2396.txt
[XML]
"Extensible Markup Language (XML) 1.0 Specification", T. Bray, J. Paoli, C. M. Sperberg-McQueen, 10 February 1998.
Latest version available at: http://www.w3.org/TR/REC-xml
[XMLNAMES]
"Namespaces in XML", T. Bray, D. Hollander, A. Layman, 14 January 1999.
XML namespaces provide a simple method for qualifying names used in XML documents by associating them with namespaces identified by URI.
Latest version available at: http://www.w3.org/TR/REC-xml-names

Level Triple-A conformance icon, W3C-WAI Web Content Accessibility Guidelines 1.0

table of contents
hxt-xpath-9.1.2.2/examples/hxpath/xhtml/xhtml1-frameset.dtd0000644000000000000000000010032612465156121021767 0ustar0000000000000000 %HTMLlat1; %HTMLsymbol; %HTMLspecial; hxt-xpath-9.1.2.2/examples/hxpath/xhtml/xhtml-lat1.ent0000644000000000000000000002701512465156121020757 0ustar0000000000000000 hxt-xpath-9.1.2.2/examples/hunit/0000755000000000000000000000000012465156121014746 5ustar0000000000000000hxt-xpath-9.1.2.2/examples/hunit/HUnitExample.hs0000644000000000000000000001005112465156121017642 0ustar0000000000000000-- | -- HUnit - Haskell XML Toolbox examples and tests for arrows -- -- Author: Uwe Schmidt uwe@fh-wedel.de -- module Main where import System import Test.HUnit import Text.XML.HXT.Core import Text.XML.HXT.XPath -- | -- auxiliary function to make haskell string constants with quotes more readable singleToDoubleQuote :: String -> String singleToDoubleQuote = map (\ c -> if c == '\'' then '\"' else c) testLA :: String -> String -> LA XmlTree XmlTree -> Test testLA doc expected f = TestCase $ assertEqual "LA XmlTree XmlTree:" [expected] res where res = runLA (xread >>> xshow f) doc testLAString :: String -> String -> LA XmlTree String -> Test testLAString doc expected f = TestCase $ assertEqual "LA XmlTree String:" [expected] res where res = runLA (xread >>> f) doc mkTestSeqLA :: String -> [(String, LA XmlTree XmlTree)] -> [Test] mkTestSeqLA doc = map (\ (res, f) -> testLA doc (singleToDoubleQuote res) f) nodeSetTests :: Test nodeSetTests = TestList $ [ TestLabel "node set and simple XPath tests with getXPathTrees" $ TestList $ mkTestSeqLA doc (testGetXPathTrees tests) , TestLabel "node set and simple XPath tests with getXPathNodeSet" $ TestList $ mkTestSeqLA doc (testGetXPathNodes tests) , TestLabel "node set and simple XPath tests with processFromNodeSet" $ TestList $ mkTestSeqLA doc (testProcessXPath processTests) , TestLabel "node set and simple XPath tests with processXPathTrees" $ TestList $ mkTestSeqLA doc (testProcessXPath' processTests) ] where doc = ".0.1.0.2.3.0.3.1.0.4" testGetXPathTrees = map (\ (r, xp) -> (r, getXPathTrees xp)) -- these arrows are equivalent testGetXPathNodes = map (\ (r, xp) -> (r, getFromNodeSet $< getXPathNodeSet xp)) -- except for the ordering of the result set -- which does not matter for these tests testProcessXPath = map (\ (r, xp, a) -> (r, processFromNodeSet a $< getXPathNodeSet xp)) testProcessXPath' = map (\ (r, xp, a) -> (r, processXPathTrees a xp)) tests = [ (doc , "/x" ) , (".3.0.3.1.0" , "/x/y" ) , (".3.1.0" , "/x/y/x" ) , (".0.2.4" , "/x/text()" ) , (".3.0" , "/x/y/text()" ) , (".1.0.3.1.0" , "/x//x" ) ] processTests = [ ("xxxxxx", "//text()", changeText (const "x") ) , (".0.1.0.2.3.0x.4", "/x/y/x/text()", changeText (const "x") ) , (".0.1.0.2.3.0.4", "/x/y/x", none ) , (".0.1.0.2.3.0zzz.4", "/x/y/x", txt "zzz" ) , (".0.1.0.2.3.0.3.1.0.4", "/x/y/x", addAttr "q" "3.2" ) ] -- | -- the complete set of test cases allTests :: Test allTests = TestList [ nodeSetTests ] main :: IO () main = do c <- runTestTT allTests putStrLn $ show c let errs = errors c fails = failures c System.exitWith (codeGet errs fails) codeGet :: Int -> Int -> ExitCode codeGet errs fails | fails > 0 = ExitFailure 2 | errs > 0 = ExitFailure 1 | otherwise = ExitSuccess -- ---------------------------------------------------------- hxt-xpath-9.1.2.2/examples/hunit/mini2.xml0000644000000000000000000000024712465156121016511 0ustar0000000000000000 ignore unknown important important hxt-xpath-9.1.2.2/examples/hunit/Makefile0000644000000000000000000000117612465156121016413 0ustar0000000000000000# $Id: Makefile,v 1.2 2006/05/11 14:47:18 hxml Exp $ HXT_HOME = ../../.. PKGFLAGS = GHCFLAGS = -Wall -O2 GHC = ghc $(GHCFLAGS) $(PKGFLAGS) prog = HUnitExample all : $(prog) force : $(GHC) --make $(GHCPACKAGES) -o $(prog) $(prog).hs $(prog) : $(prog).hs $(GHC) --make $(GHCPACKAGES) -o $@ $< test : $(prog) @echo "===> run HUnit examples" ; echo ; sleep 2 ./$(prog) DIST = $(HXT_HOME)/dist/examples/arrows DIST_DIR = $(DIST)/hunit DIST_FILES = mini1.xml mini2.xml Makefile $(prog).hs dist : [ -d $(DIST_DIR) ] || mkdir -p $(DIST_DIR) cp $(DIST_FILES) $(DIST_DIR) clean : rm -f $(prog) $(prog).o $(prog).hi hxt-xpath-9.1.2.2/examples/hunit/mini1.xml0000644000000000000000000000000512465156121016500 0ustar0000000000000000 hxt-xpath-9.1.2.2/src/0000755000000000000000000000000012465156121012570 5ustar0000000000000000hxt-xpath-9.1.2.2/src/Text/0000755000000000000000000000000012465156121013514 5ustar0000000000000000hxt-xpath-9.1.2.2/src/Text/XML/0000755000000000000000000000000012465156121014154 5ustar0000000000000000hxt-xpath-9.1.2.2/src/Text/XML/HXT/0000755000000000000000000000000012465156121014617 5ustar0000000000000000hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath.hs0000644000000000000000000000076712465156121016211 0ustar0000000000000000-- | -- This helper module exports elements from the basic libraries: -- XPathEval, XPathToString and XPathParser -- -- Author : Torben Kuseler module Text.XML.HXT.XPath ( module Text.XML.HXT.XPath.XPathEval , module Text.XML.HXT.XPath.XPathToString , module Text.XML.HXT.XPath.XPathParser , module Text.XML.HXT.XPath.Arrows ) where import Text.XML.HXT.XPath.XPathEval import Text.XML.HXT.XPath.XPathToString import Text.XML.HXT.XPath.XPathParser import Text.XML.HXT.XPath.Arrows hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/0000755000000000000000000000000012465156121015643 5ustar0000000000000000hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/XPathFct.hs0000644000000000000000000010743512465156121017672 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- ------------------------------------------------------------ {- | Module : Text.XML.HXT.XPath.XPathFct Copyright : Copyright (C) 2008 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable The module contains the core-functions of the XPath function library. All functions are implemented as XFct. Each XFct contains the evaluation context, the variable environment and the function arguments. -} -- ------------------------------------------------------------ module Text.XML.HXT.XPath.XPathFct ( XFct , evalFct , toXValue , xnumber , xboolean , xstring , getConvFct , stringValue -- , remDups , isNotInNodeList {- , createDocumentOrder , createDocumentOrderReverse -} , getVarTab , getKeyTab ) where import Text.XML.HXT.XPath.XPathDataTypes import Text.XML.HXT.XPath.XPathParser ( parseNumber ) import Text.XML.HXT.XPath.XPathArithmetic ( xPathAdd ) import Control.Arrow ( (>>>), (<+>) ) import Control.Arrow.ArrowList ( constA ) import Control.Arrow.ArrowIf ( ifA ) import Control.Arrow.ArrowTree ( deep ) import Control.Arrow.ListArrow ( LA, runLA ) import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.ReadDocument ( readDocument ) import Text.XML.HXT.Arrow.XmlState ( runX , withValidate , no ) import Text.XML.HXT.DOM.Interface import qualified Text.XML.HXT.DOM.XmlNode as XN import System.IO.Unsafe ( unsafePerformIO ) import Data.Char ( isAscii , isUpper , isLower , isDigit , ord ) import Data.Maybe -- ----------------------------------------------------------------------------- -- added by Tim Walkenhorst to fix Pos0 vs. Float 0.0 problems... int2XPNumber :: Int -> XPNumber int2XPNumber 0 = Pos0 int2XPNumber i = Float $ fromIntegral i -- | -- Type signature for all functions which can be used in the XPath module. type XFct = (Context -> Env -> [XPathValue] -> XPathValue) -- | -- All functions are stored in a function table. type FctTable = [(FctName, FctTableElem)] -- | -- Each table entry consists of the function and the expected function arguments. type FctTableElem = (XFct, CheckArgCount) -- | -- Tests whether the number of current function arguments is correct type CheckArgCount = ([XPathValue] -> Bool) -- ----------------------------------------------------------------------------- zero , zeroOrOne , one , two , twoOrM , twoOrThree , three :: CheckArgCount zero ex = length ex == 0 zeroOrOne ex = length ex == 0 || length ex == 1 one ex = length ex == 1 two ex = length ex == 2 twoOrM ex = length ex >= 2 twoOrThree ex = length ex == 2 || length ex == 3 three ex = length ex == 3 -- ----------------------------------------------------------------------------- -- | -- The core-functions library fctTable :: FctTable fctTable = [ ("last", (xlast, zero)), -- nodeset functions ("position",(xposition, zero)), ("count",(xcount, one)), ("id", (xid, one)), ("local-name", (xlocalName, zeroOrOne)), ("namespace-uri", (xnamespaceUri, zeroOrOne)), ("name", (xname, zeroOrOne)), ("string", (xstring, zeroOrOne)), -- string functions ("concat", (xconcat, twoOrM)), ("starts-with",(xstartsWith, two)), ("contains", (xcontains, two)), ("substring-before", (xsubstringBefore, two)), ("substring-after", (xsubstringAfter, two)), ("substring", (xsubstring, twoOrThree)), ("string-length", (xstringLength, zeroOrOne)), ("normalize-space", (xnormalizeSpace, zeroOrOne)), ("translate", (xtranslate, three)), ("boolean", (xboolean, one)), -- boolean functions ("not", (xnot, one)), ("true", (xtrue, zero)), ("false",(xfalse, zero)), ("lang", (xlang, one)), ("number",(xnumber, zeroOrOne)), -- number functions ("sum",(xsum, one)), ("floor",(xfloor, one)), ("ceiling",(xceiling, one)), ("round",(xround, one)), ("key",(xkey, two)), ("format-number",(xformatNumber, twoOrThree)), ("document", (xdocument, one)),-- extension functions for xslt 1.0 ("generate-id", (xgenerateId, zeroOrOne)) ] -- ----------------------------------------------------------------------------- -- some helper functions -- | -- Returns the table of keys, needed by xslt, from the environment getKeyTab :: Env -> KeyTab getKeyTab (_, keyTab) = keyTab -- ----------------------------------------------------------------------------- -- | -- Returns the table of variables from the environment getVarTab :: Env -> VarTab getVarTab (varTab, _) = varTab -- ----------------------------------------------------------------------------- -- | -- Returns the conversion function for the XPath results: string, boolean and number -- A nodeset can not be converted. getConvFct :: XPathValue -> Maybe XFct getConvFct (XPVNumber _) = Just xnumber getConvFct (XPVString _) = Just xstring getConvFct (XPVBool _) = Just xboolean getConvFct _ = Nothing -- ----------------------------------------------------------------------------- -- | -- Check whether a node is not a part of a node list. Needed to implement matching & testing in xslt. isNotInNodeList :: NavXmlTree -> [NavXmlTree] -> Bool isNotInNodeList n xs' = nodeID' n `notElem` map nodeID' xs' -- ----------------------------------------------------------------------------- -- | -- calculate an ID for a NODE -- -- - returns : a list of numbers, one number for each level of the tree -- Tim Walkenhorst: -- - Attributes are identified by their QName (they do not have previous siblings) -- - Elements are identified by their relative position (# of previous siblings) data IdPathStep = IdRoot String | IdPos Int | IdAttr QName deriving (Show, Eq) nodeID :: Maybe NavXmlTree -> [IdPathStep] nodeID = maybe [] nodeID' nodeID' :: NavXmlTree -> [IdPathStep] nodeID' t@(NT (NTree (XAttr qn) _) _ix _ _ _) = IdAttr qn : nodeID (upNT t) nodeID' t@(NT node ix _ _ _) | XN.isRoot node = return $ IdRoot (getRootId node) | otherwise = IdPos ix : nodeID (upNT t) where getRootId = concat . runLA (getAttrValue "rootId") -- ----------------------------------------------------------------------------- -- | -- Evaluates a function. -- Calculation of the function value is done by looking up the function name in the function table, -- check the number of arguments and calculate the funtion, if no -- argument evaluation returns an error. -- -- - returns : the function value as 'XPathValue' evalFct :: FctName -> Env -> Context -> [XPathValue] -> XPathValue evalFct name env cont args = case (lookup name fctTable) of Nothing -> XPVError ("Call to undefined function "++ name) Just (fct, checkArgCount) -> if not (checkArgCount args) then XPVError ("Call to function "++ name ++ " with wrong arguments") else case (checkArgErrors args) of Just e -> e Nothing -> fct cont env args where checkArgErrors [] = Nothing checkArgErrors ((XPVError r):_) = Just (XPVError r) checkArgErrors (_:xs) = checkArgErrors xs -- | -- Converts a list of different 'XPathValue' types in a list of one 'XPathValue' type. -- -- * 1.parameter fct : the conversion function -- toXValue :: XFct -> Context -> Env -> [XPathValue] -> [XPathValue] toXValue fct c env args = [fct c env [x] | x <- args] -- ----------------------------------------------------------------------------- -- core-funktions library -- nodeset functions -- | -- number last(): returns a number equal to the context size from the expression evaluation context xlast :: XFct xlast (_, len , _) _ _ = XPVNumber $ int2XPNumber len -- ----------------------------------------------------------------------------- -- | -- number position(): returns a number equal to the context position from the expression evaluation context xposition :: XFct xposition (pos, _ , _) _ _ = XPVNumber $ int2XPNumber pos -- ----------------------------------------------------------------------------- -- | -- number count(node-set): returns the number of nodes in the argument node-set xcount :: XFct xcount _ _ [XPVNode ns] = XPVNumber . int2XPNumber . cardNodeSet $ ns xcount _ _ _ = XPVError "Call to function count with wrong arguments" -- ----------------------------------------------------------------------------- -- | -- node-set id(object): selects elements by their unique ID xid :: XFct xid (_, _, cn) env [XPVNode ns] = isInId (getIds env) (strValues ns) [cn] where strValues = map ((\ (XPVString str) -> str) . stringValue) . fromNodeSet xid c@(_, _, cn) env arg = isInId (getIds env) ( (\(XPVString s) -> words s) (xstring c env arg)) [cn] -- ----------------------------------------------------------------------------- -- | -- returns all IDs from the variable environment as a list of strings. -- the IDs are stored in the variable: idAttr getIds :: Env -> [String] getIds env = words $ -- hier muss noch auf prefix getestet werden (\ (XPVString str) -> str) . fromJust $ lookup ("", "idAttr") $ getVarTab env -- ----------------------------------------------------------------------------- isInId :: [String] -> [String] -> NavXmlTrees -> XPathValue isInId ids str = XPVNode . toNodeSet . concatMap (filterNS ids str . descendantOrSelfAxis) -- ----------------------------------------------------------------------------- filterNS :: [String] -> [String] -> NavXmlTrees -> NavXmlTrees filterNS ids str ns = [ n | n@(NT a _ _ _ _) <- ns , or $ map (idInIdList a str) ids ] where idInIdList :: XmlTree -> [String] -> String -> Bool idInIdList al str' b = (getValue b al) `elem` str' -- ----------------------------------------------------------------------------- -- | -- string local-name(node-set?): -- returns the local part of the expanded-name of the node in the argument node-set -- that is first in document order. -- If the argument node-set is empty or the first node has no expanded-name, an empty string is returned. -- If the argument is omitted, it defaults to a node-set with the context node as its only member -- Bugfix: name(\/) is "" not "\/"! xlocalName :: XFct xlocalName (_, _, cn) _ [] = XPVString (xpLocalPartOf . subtreeNT $ cn) xlocalName _ _ [XPVNode ns] | nullNodeSet ns = XPVString "" | otherwise = XPVString (xpLocalPartOf . subtreeNT . headNodeSet $ ns) xlocalName _ _ _ = XPVError "Call to function local-name with wrong arguments" -- ----------------------------------------------------------------------------- -- | -- string namespace-uri(node-set?): -- returns the namespace URI of the expanded-name of the node in the argument node-set -- that is first in document order. -- If the argument node-set is empty, the first node has no expanded-name, -- or the namespace URI of the expanded-name -- is null, an empty string is returned. If the argument is omitted, -- it defaults to a node-set with the context node as its only member xnamespaceUri :: XFct xnamespaceUri (_, _, cn) _ [] = XPVString (xpNamespaceOf . subtreeNT $ cn) xnamespaceUri _ _ [XPVNode ns] | nullNodeSet ns = XPVString "" | otherwise = XPVString (xpNamespaceOf . subtreeNT . headNodeSet $ ns) xnamespaceUri _ _ _ = XPVError "Call to function namespace-uri with wrong arguments" -- ----------------------------------------------------------------------------- -- | -- string name(node-set?): -- returns a string containing a QName representing the expanded-name of the node -- in the argument node-set -- that is first in document order. If the argument node-set is empty or the first -- node has no expanded-name, -- an empty string is returned. If the argument it omitted, it defaults to a node-set -- with the context node as its only member. -- Tim Walkenhorst: -- Bugfix: name(\/) is "" not "\/"! xname :: XFct xname (_, _, cn) _ [] = XPVString (xpNameOf . subtreeNT $ cn) xname _ _ [XPVNode ns] | nullNodeSet ns = XPVString "" | otherwise = XPVString (xpNameOf . subtreeNT . headNodeSet $ ns) xname _ _ _ = XPVError "Call to function name with wrong arguments" -- ------------------------------------------------------------ -- string functions -- | -- some helper functions getFirstPos :: String -> String -> Int getFirstPos s sub = if (getFirstPos' s sub) > length s then -1 else getFirstPos' s sub -- ----------------------------------------------------------------------------- getFirstPos' :: String -> String -> Int getFirstPos' [] _ = 2 getFirstPos' (x:xs) sub = if strStartsWith (x:xs) sub then 0 else 1 + getFirstPos' xs sub -- ----------------------------------------------------------------------------- strStartsWith :: String -> String -> Bool strStartsWith a b = take (length b) a == b -- ----------------------------------------------------------------------------- -- | -- Returns the string-value of a node, -- the value of a namespace node is not supported stringValue :: NavXmlTree -> XPathValue stringValue = XPVString . xpTextOf . self {- textFilter = getXCmt `orElse` -- getXNamespace `orElse` multi isXText -- = (isXTag `guards` multi isXText) `orElse` -- (isXPi `guards` multi isXText) `orElse` -- (isXAttr `guards` multi isXText) `orElse` -- (isXText `guards` multi isXText) `orElse` -- getXCmt -} -- ----------------------------------------------------------------------------- -- | -- string string(object?): converts an object to a string xstring :: XFct xstring _ _ [XPVNode ns] | nullNodeSet ns = XPVString "" | otherwise = stringValue . headNodeSet $ ns xstring (_, _, cn) _ [] = stringValue cn xstring _ _ [XPVNumber (Float a)] | a == (fromInteger $ round a) = XPVString (show ((round a)::Integer)) | otherwise = XPVString (show a) xstring _ _ [XPVNumber s] = XPVString (show s) xstring _ _ [XPVBool True] = XPVString "true" xstring _ _ [XPVBool False] = XPVString "false" xstring _ _ [XPVString s] = XPVString s xstring _ _ [XPVError e] = XPVError e xstring _ _ _ = XPVError "Call to xstring with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- string concat(string, string, string*): returns the concatenation of its arguments xconcat :: XFct xconcat c env args = XPVString (foldr (\ (XPVString s) -> (s ++)) "" (toXValue xstring c env args)) -- ----------------------------------------------------------------------------- -- | -- boolean starts-with(string, string): -- returns true if the first argument string starts -- with the second argument string, and otherwise returns false xstartsWith :: XFct xstartsWith c env args = XPVBool $ (\ ((XPVString a):[XPVString b]) -> strStartsWith a b) $ toXValue xstring c env args -- ----------------------------------------------------------------------------- -- | -- boolean contains(string, string): -- returns true if the first argument string contains the second argument string, -- and otherwise returns false xcontains :: XFct xcontains c env args = XPVBool $ (\ ((XPVString s):[XPVString sub]) -> getFirstPos s sub /= -1) $ toXValue xstring c env args -- ----------------------------------------------------------------------------- -- | -- string substring-before(string, string): -- returns the substring of the first argument string that precedes the first occurrence of -- the second argument string -- in the first argument string, or the empty string if the first argument string does not -- contain the second argument string xsubstringBefore :: XFct xsubstringBefore c env args = xsubstringBefore' c env (toXValue xstring c env args) xsubstringBefore' :: XFct xsubstringBefore' _ _ ((XPVString _):[XPVString []]) = XPVString "" xsubstringBefore' _ _ ((XPVString s):[XPVString sub]) = XPVString (take (getFirstPos s sub) s) xsubstringBefore' _ _ _ = XPVError "Call to xsubstringBefore' with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- string substring-after(string, string): -- returns the substring of the first argument string that follows the first occurrence of -- the second argument string -- in the first argument string, or the empty string if the first argument string does not -- contain the second argument string xsubstringAfter :: XFct xsubstringAfter c env args = xsubstringAfter' c env (toXValue xstring c env args) xsubstringAfter' :: XFct xsubstringAfter' _ _ ((XPVString s):[XPVString []]) = XPVString s xsubstringAfter' _ _ ((XPVString s):[XPVString sub]) = if getFirstPos s sub == -1 then (XPVString "") else XPVString (drop ((getFirstPos s sub)+length sub) s) xsubstringAfter' _ _ _ = XPVError "Call to xsubstringAfter' with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- string substring(string, number, number?): -- returns the substring of the first argument starting at the position specified -- in the second argument -- with length specified in the third argument. If the third argument is not specified, -- it returns the substring -- starting at the position specified in the second argument and continuing to the end of the string. xsubstring :: XFct xsubstring c env (x:xs) = xsubstring' c env ((toXValue xstring c env [x])++(toXValue xnumber c env xs)) xsubstring _ _ _ = XPVError "Call to xsubstring with a wrong argument" xsubstring' :: XFct xsubstring' c env ((XPVString s):start:[]) = case xround c env [start] of XPVNumber NaN -> XPVString "" XPVNumber PosInf -> XPVString "" XPVNumber (Float f) -> XPVString (drop ((round f)-1) s) XPVNumber _ -> XPVString s _ -> XPVError "Call to xsubstring' with a wrong argument" xsubstring' c env ((XPVString s):start:[end]) = case xPathAdd Plus (xround c env [start]) (xround c env [end]) of XPVNumber (Float f) -> xsubstring' c env ( (XPVString (take ((round f) -1) s)):[start]) XPVNumber PosInf -> xsubstring' c env ( (XPVString s):[start]) XPVNumber _ -> XPVString "" _ -> XPVError "Call to xsubstring' with a wrong argument" xsubstring' _ _ _ = XPVError "Call to xsubstring' with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- number string-length(string?): -- returns the number of characters in the string. If the argument is omitted, -- it defaults to the context node -- converted to a string, in other words the string-value of the context node. xstringLength :: XFct xstringLength c@(_, _, cn) env [] = XPVNumber (Float (fromIntegral $ length s)) where XPVString s = xstring c env [XPVNode $ singletonNodeSet cn] xstringLength c env args = XPVNumber $ (\[XPVString s] -> int2XPNumber $ length s) $ toXValue xstring c env args -- ----------------------------------------------------------------------------- -- | -- string normalize-space(string?): -- returns the argument string with whitespace normalized by stripping leading -- and trailing whitespace and replacing sequences -- of whitespace characters by a single space. If the argument is omitted, -- it defaults to the context node converted to a string, -- in other words the string-value of the context node. -- The string is parsed by a function parseStr from XPathParser module. <-- No longer! Tim Walkenhorst xnormalizeSpace :: XFct xnormalizeSpace c@(_, _, cn) env [] = (\ (XPVString s) -> XPVString $ normStr s) $ xstring c env [XPVNode $ singletonNodeSet cn] xnormalizeSpace c env args = (\ [XPVString s] -> XPVString $ normStr s) $ toXValue xstring c env args -- Tim Walkenhorst normStr replaces the use of parseStr... normStr :: String -> String normStr = unwords . words -- ----------------------------------------------------------------------------- -- | -- string translate(string, string, string): -- returns the first argument string with occurrences of characters in the second argument string replaced by the character at -- the corresponding position in the third argument string xtranslate :: XFct xtranslate c env args = xtranslate' c env (toXValue xstring c env args) xtranslate' :: XFct xtranslate' _ _ ((XPVString a):(XPVString b):[XPVString c]) = XPVString (replace a b c) xtranslate' _ _ _ = XPVError "Call to xtranslate' with a wrong argument" replace :: String -> String -> String -> String replace str [] _ = str -- remove all characters, if there is no corresponding character in the third argument replace str (x:xs) [] = replace [ s | s <- str, x /= s] xs [] replace str (x:xs) (y:ys) = replace (rep x y str) xs ys where -- replace all characters in the first argument rep :: Char -> Char -> String -> String rep a b = foldr (\c -> if c == a then (b:) else (c:)) "" -- ------------------------------------------------------------ -- boolean functions -- | -- boolean boolean(object): converts its argument to a boolean value xboolean :: XFct xboolean _ _ [XPVNumber a] = XPVBool (a/= NaN && a/= Neg0 && a/= Pos0) xboolean _ _ [XPVString s] = XPVBool (length s /= 0) xboolean _ _ [XPVBool b] = XPVBool b xboolean _ _ [XPVNode ns] = XPVBool (not . nullNodeSet $ ns) xboolean _ _ [XPVError e] = XPVError e xboolean _ _ _ = XPVError "Call to xboolean with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- boolean not(boolean): returns true if its argument is false, and false otherwise xnot :: XFct xnot c env args = XPVBool ( (\ (XPVBool b) -> not b) (xboolean c env args) ) -- ----------------------------------------------------------------------------- -- | -- boolean true(): returns true xtrue :: XFct xtrue _ _ _ = XPVBool True -- ----------------------------------------------------------------------------- -- | -- boolean false(): returns false xfalse :: XFct xfalse _ _ _ = XPVBool False -- ----------------------------------------------------------------------------- -- | -- boolean lang(string): -- returns true or false depending on whether the language of the context node as specified by xml:lang attributes -- is the same as or is a sublanguage of the language specified by the argument string -- ----------------------------------------------------------------------------- -- -- function needs namespaces which are not supported by the toolbox (???) xlang :: XFct xlang _ _ _ = XPVError "namespaces are not supported" -- xlang c env args -- = (\ (_, _, cn) [XPVString s] -> ...) c (toXValue xstring c env args) -- ------------------------------------------------------------ -- number functions -- | -- number number(object?): converts its argument to a number xnumber :: XFct xnumber c@(_, _, cn) env [] = (\ (XPVString s) -> parseNumber s) (xstring c env [XPVNode $ singletonNodeSet cn]) xnumber c env [n@(XPVNode _)] = (\ (XPVString s) -> parseNumber s) (xstring c env [n]) xnumber _ _ [XPVBool b] | b = XPVNumber (Float 1) | otherwise = XPVNumber Pos0 xnumber _ _ [XPVString s] = parseNumber s xnumber _ _ [XPVNumber a] = XPVNumber a xnumber _ _ [XPVError e] = XPVError e xnumber _ _ _ = XPVError "Call to xnumber with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- number sum(node-set): -- returns the sum, for each node in the argument node-set, of the result of -- converting the string-values of the node to a number xsum :: XFct xsum c env [XPVNode ns] | nullNodeSet ns = XPVNumber NaN | otherwise = foldr1 (\ a b -> (xPathAdd Plus a b)) (getValues ns) where getValues :: NodeSet -> [XPathValue] getValues = foldr (\ n -> ([xnumber c env $ [stringValue n] ] ++) ) [] . fromNodeSet xsum _ _ _ = XPVError "The value of the function sum is not a nodeset" -- ----------------------------------------------------------------------------- -- | -- number floor(number): returns the largest (closest to positive infinity) number that is not greater -- than the argument and that is an integer xfloor :: XFct xfloor c env args = xfloor' (toXValue xnumber c env args) where xfloor' [XPVNumber (Float f)] | f > 0 && f < 1 = XPVNumber Pos0 | otherwise = XPVNumber (Float (fromInteger $ floor f)) xfloor' [XPVNumber a] = XPVNumber a xfloor' _ = XPVError "Call to xfloor' without a number" -- ----------------------------------------------------------------------------- -- | -- number ceiling(number): returns the smallest (closest to negative infinity) number that is not less -- than the argument and that is an integer xceiling :: XFct xceiling c env args = xceiling' (toXValue xnumber c env args) where xceiling' [XPVNumber (Float f)] | f < 0 && f > -1 = XPVNumber Pos0 | otherwise = XPVNumber (Float (fromInteger $ ceiling f)) xceiling' [XPVNumber a] = XPVNumber a xceiling' _ = XPVError "Call to xceiling' without a number" -- ----------------------------------------------------------------------------- -- | -- number round(number): -- returns the number that is closest to the argument and that is an integer. -- If there are two such numbers, then the one that is closest to positive infinity is returned. xround :: XFct xround c env args = xround' c env (toXValue xnumber c env args) xround' :: XFct xround' _ _ [XPVNumber (Float f)] | f < 0 && f >= -0.5 = XPVNumber Neg0 | f >= 0 && f < 0.5 = XPVNumber Pos0 | otherwise = XPVNumber (Float (fromInteger $ xPathRound f)) where xPathRound a = if a - (fromInteger $ floor a) < 0.5 then floor a else floor (a+1) xround' _ _ [XPVNumber a] = XPVNumber a xround' _ _ _ = XPVError "Call to xround' without a number" -- ----------------------------------------------------------------------------- -- | -- node-set key(string, object): -- does for keys what the id function does for IDs -- The first argument specifies the name of the key. -- When the second argument is of type node-set, then the result is the -- union of the result of applying the key function to the string value -- of each of the nodes in the argument node-set. -- When the second argument is of any other type, the argument is -- converted to a string xkey :: XFct xkey _ env ((XPVString s) : [XPVNode ns]) = isInKey (getKeyTab env) s (strValues . fromNodeSet $ ns) where strValues = map ((\ (XPVString str) -> str) . stringValue) xkey c env ((XPVString s) : arg) -- = isInKey (getKeyTab env) s ( (\(XPVString s) -> words s) (xstring c env arg)) = isInKey (getKeyTab env) s [str] where XPVString str = xstring c env arg xkey _ _ _ = XPVError "Call to xkey with a wrong argument" isInKey :: KeyTab -> String -> [String] -> XPathValue isInKey kt kn kv = XPVNode . toNodeSet $ ts where (_, _, ts) = unzip3 $ concat $ map (isKeyVal (isKeyName kt kn)) kv isKeyName :: KeyTab -> String -> KeyTab isKeyName kt kn = filter (isOfKeyName kn) kt isKeyVal :: KeyTab -> String -> KeyTab isKeyVal kt kv = filter (isOfKeyValue kv) kt isOfKeyName :: String -> (QName, String, NavXmlTree) -> Bool isOfKeyName kn (qn, _, _) = localPart qn == kn isOfKeyValue :: String -> (QName, String, NavXmlTree) -> Bool isOfKeyValue kv (_, v, _) = v == kv -- ----------------------------------------------------------------------------- -- | -- string format-number(number, string, string?): -- converts its first argument to a string using the format pattern string -- specified by the second argument and the decimal-format named by the -- third argument, or the default decimal-format, if there is no third argument xformatNumber :: XFct xformatNumber c env (x:xs) = xsubstring' c env (toXValue xstring c env [x] ++ toXValue xnumber c env xs) xformatNumber _ _ _ = XPVError "Call to xformatNumber with a wrong argument" -- ----------------------------------------------------------------------------- -- Poor man's document(...) function. Opens exactly one document. -- Does not support "fragment identifiers". "Base-URI" is always current directory. -- Should still be good enough for home use. xdocument :: XFct xdocument c e val = XPVNode . toNodeSet . (\ (XPVString s) -> xdocument' s) . xstring c e $ val xdocument' :: String -> [NavXmlTree] xdocument' uri = map ntree $ unsafePerformIO $ runX ( readDocument [withValidate no] uri >>> addAttr "rootId" ("doc " ++ uri) ) -- ----------------------------------------------------------------------------- -- generate-id, should be fully compliant with XSLT specification. xgenerateId :: XFct xgenerateId _ _ [XPVNode ns] | not (nullNodeSet ns) = xgenerateId' . headNodeSet $ ns xgenerateId (_, _, node) _ [] = xgenerateId' node xgenerateId _ _ _ = error "illegal arguments in xgenerateId" xgenerateId' :: NavXmlTree -> XPathValue xgenerateId' = XPVString . ("id_"++) . str2XmlId . show . nodeID . Just str2XmlId :: String -> String str2XmlId = concatMap convert where convert c = if isAscii c && (isUpper c || isLower c || isDigit c) then [c] else "_" ++ (show $ ord c) ++ "_" -- ------------------------------------------------------------ xpNamePart :: LA XmlTree String -> XmlTree -> String xpNamePart getNp = concat . runLA ( ifA isRoot (constA "") getNp ) xpLocalPartOf :: XmlTree -> String xpLocalPartOf = xpNamePart getLocalPart xpNamespaceOf :: XmlTree -> String xpNamespaceOf = xpNamePart getNamespaceUri xpNameOf :: XmlTree -> String xpNameOf = xpNamePart getName getValue :: String -> XmlTree -> String getValue n = concat . runLA (getAttrValue n) xpTextOf :: XmlTree -> String xpTextOf = concat . runLA (xshow ((getCmt >>> mkText) <+> deep isText)) -- ------------------------------------------------------------ hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/XPathEval.hs0000644000000000000000000010110212465156121020026 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.XPath.XPathEval Copyright : Copyright (C) 2006-2011 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable The core functions for evaluating the different types of XPath expressions. Each 'Expr'-constructor is mapped to an evaluation function. -} -- ------------------------------------------------------------ module Text.XML.HXT.XPath.XPathEval ( getXPath , getXPathSubTrees , getXPathNodeSet' , getXPathWithNsEnv , getXPathSubTreesWithNsEnv , getXPathNodeSetWithNsEnv' , evalExpr , addRoot' , parseXPathExpr , parseXPathExprWithNsEnv , getXPath' , getXPathSubTrees' , getXPathNodeSet'' ) where import Data.List ( partition ) import Data.Maybe ( fromJust, fromMaybe ) import Text.XML.HXT.XPath.XPathFct import Text.XML.HXT.XPath.XPathDataTypes import Text.XML.HXT.XPath.XPathArithmetic ( xPathAdd , xPathDiv , xPathMod , xPathMulti , xPathUnary ) import Text.XML.HXT.XPath.XPathParser ( parseXPath ) import Text.XML.HXT.XPath.XPathToString ( xPValue2XmlTrees ) import Text.XML.HXT.XPath.XPathToNodeSet( xPValue2XmlNodeSet , emptyXmlNodeSet ) import Text.XML.HXT.Parser.XmlCharParser( withNormNewline ) import Text.ParserCombinators.Parsec ( runParser ) -- ---------------------------------------- -- the DOM functions import Text.XML.HXT.DOM.Interface import qualified Text.XML.HXT.DOM.XmlNode as XN -- ---------------------------------------- -- the list arrow functions import Control.Arrow ( (>>>), (>>^), left ) import Control.Arrow.ArrowList ( arrL, isA ) import Control.Arrow.ArrowIf ( filterA ) import Control.Arrow.ListArrow ( runLA ) import qualified Control.Arrow.ArrowTree as AT import Text.XML.HXT.Arrow.XmlArrow ( ArrowDTD, isDTD, getDTDAttrl ) import Text.XML.HXT.Arrow.Edit ( canonicalizeForXPath ) -- ----------------------------------------------------------------------------- -- | -- Select parts of a document by a string representing a XPath expression. -- -- The main filter for selecting parts of a document via XPath. -- The string argument must be a XPath expression with an absolute location path, -- the argument tree must be a complete document tree. -- Result is a possibly empty list of XmlTrees forming the set of selected XPath values. -- XPath values other than XmlTrees (numbers, attributes, tagnames, ...) -- are converted to text nodes. getXPath :: String -> XmlTree -> XmlTrees getXPath = getXPathWithNsEnv [] -- ----------------------------------------------------------------------------- -- | -- Select parts of a document by an already parsed XPath expression getXPath' :: Expr -> XmlTree -> XmlTrees getXPath' e = runLA $ canonicalizeForXPath >>> arrL (getXPathValues' xPValue2XmlTrees e) -- ----------------------------------------------------------------------------- -- | -- Select parts of a document by a namespace aware XPath expression. -- -- Works like 'getXPath' but the prefix:localpart names in the XPath expression -- are interpreted with respect to the given namespace environment getXPathWithNsEnv :: Attributes -> String -> XmlTree -> XmlTrees getXPathWithNsEnv env s = runLA ( canonicalizeForXPath >>> arrL (getXPathValues xPValue2XmlTrees xPathErr env s) ) -- ----------------------------------------------------------------------------- -- | -- Select parts of an XML tree by a string representing an XPath expression. -- -- The main filter for selecting parts of an arbitrary XML tree via XPath. -- The string argument must be a XPath expression with an absolute location path, -- There are no restrictions on the arument tree. -- -- No canonicalization is performed before evaluating the query -- -- Result is a possibly empty list of XmlTrees forming the set of selected XPath values. -- XPath values other than XmlTrees (numbers, attributes, tagnames, ...) -- are convertet to text nodes. getXPathSubTrees :: String -> XmlTree -> XmlTrees getXPathSubTrees = getXPathSubTreesWithNsEnv [] -- ----------------------------------------------------------------------------- -- | -- Select parts of an XML tree by an XPath expression. getXPathSubTrees' :: Expr -> XmlTree -> XmlTrees getXPathSubTrees' = getXPathValues' xPValue2XmlTrees -- ----------------------------------------------------------------------------- -- | Same as 'getXPathSubTrees' but with namespace aware XPath expression getXPathSubTreesWithNsEnv :: Attributes -> String -> XmlTree -> XmlTrees getXPathSubTreesWithNsEnv nsEnv xpStr = getXPathValues xPValue2XmlTrees xPathErr nsEnv xpStr -- ----------------------------------------------------------------------------- -- | -- compute the node set of an XPath query getXPathNodeSet' :: String -> XmlTree -> XmlNodeSet getXPathNodeSet' = getXPathNodeSetWithNsEnv' [] -- ----------------------------------------------------------------------------- -- | -- compute the node set of an XPath query for an already parsed XPath expr getXPathNodeSet'' :: Expr -> XmlTree -> XmlNodeSet getXPathNodeSet'' = getXPathValues' xPValue2XmlNodeSet -- ----------------------------------------------------------------------------- -- | compute the node set of a namespace aware XPath query getXPathNodeSetWithNsEnv' :: Attributes -> String -> XmlTree -> XmlNodeSet getXPathNodeSetWithNsEnv' nsEnv xpStr = getXPathValues xPValue2XmlNodeSet (const emptyXmlNodeSet) nsEnv xpStr -- ----------------------------------------------------------------------------- -- | parse xpath, evaluate xpath expr and prepare results getXPathValues :: (XPathValue -> a) -> (String -> a) -> Attributes -> String -> XmlTree -> a getXPathValues cvRes cvErr nsEnv xpStr t = case parseXPathExprWithNsEnv nsEnv xpStr of Left parseError -> cvErr parseError Right xpExpr -> getXPathValues' cvRes xpExpr t xPathErr :: String -> [XmlTree] xPathErr parseError = [ XN.mkError c_err parseError ] -- ----------------------------------------------------------------------------- -- | parse xpath, evaluate xpath expr and prepare results getXPathValues' :: (XPathValue -> a) -> Expr -> XmlTree -> a getXPathValues' cvRes xpExpr t = cvRes xpRes where t' = addRoot' t -- we need a root node for starting xpath eval idAttr = ( ("", "idAttr") -- id attributes from DTD (if there) , idAttributesToXPathValue . getIdAttributes $ t' ) navTD = ntree t' xpRes = evalExpr (idAttr:(getVarTab varEnv),[]) (1, 1, navTD) xpExpr (XPVNode . singletonNodeSet $ navTD) addRoot' :: XmlTree -> XmlTree addRoot' t | XN.isRoot t = t | otherwise = XN.mkRoot [] [t] -- ----------------------------------------------------------------------------- -- | parse an XPath expr string -- and return an expr tree or an error message. -- Namespaces are not taken into account. parseXPathExpr :: String -> Either String Expr parseXPathExpr = parseXPathExprWithNsEnv [] -- | parse an XPath expr string with a namespace environment for qualified names in the XPath expr -- and return an expr tree or an error message parseXPathExprWithNsEnv :: Attributes -> String -> Either String Expr parseXPathExprWithNsEnv nsEnv xpStr = left fmtErr . runParser parseXPath (withNormNewline (toNsEnv nsEnv)) "" $ xpStr where fmtErr parseError = "Syntax error in XPath expression " ++ show xpStr ++ ": " ++ show parseError -- ----------------------------------------------------------------------------- -- | -- The main evaluation entry point. -- Each XPath-'Expr' is mapped to an evaluation function. The 'Env'-parameter contains the set of global variables -- for the evaluator, the 'Context'-parameter the root of the tree in which the expression is evaluated. -- evalExpr :: Env -> Context -> Expr -> XPathFilter evalExpr env cont (GenExpr Or ex) = boolEval env cont Or ex evalExpr env cont (GenExpr And ex) = boolEval env cont And ex evalExpr env cont (GenExpr Eq ex) = relEqEval env cont Eq . evalExprL env cont ex evalExpr env cont (GenExpr NEq ex) = relEqEval env cont NEq . evalExprL env cont ex evalExpr env cont (GenExpr Less ex) = relEqEval env cont Less . evalExprL env cont ex evalExpr env cont (GenExpr LessEq ex) = relEqEval env cont LessEq . evalExprL env cont ex evalExpr env cont (GenExpr Greater ex) = relEqEval env cont Greater . evalExprL env cont ex evalExpr env cont (GenExpr GreaterEq ex) = relEqEval env cont GreaterEq . evalExprL env cont ex evalExpr env cont (GenExpr Plus ex) = numEval xPathAdd Plus . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Minus ex) = numEval xPathAdd Minus . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Div ex) = numEval xPathDiv Div . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Mod ex) = numEval xPathMod Mod . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Mult ex) = numEval xPathMulti Mult . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Unary ex) = xPathUnary . xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Union ex) = unionEval . evalExprL env cont ex evalExpr env cont (FctExpr name args) = fctEval env cont name args evalExpr env _ (PathExpr Nothing (Just lp)) = locPathEval env lp evalExpr env cont (PathExpr (Just fe) (Just lp)) = locPathEval env lp . evalExpr env cont fe evalExpr env cont (FilterExpr ex) = filterEval env cont ex evalExpr env _ ex = evalSpezExpr env ex -- ----------------------------------------------------------------------------- evalExprL :: Env -> Context -> [Expr] -> XPathValue -> [XPathValue] evalExprL env cont ex ns = map (\e -> evalExpr env cont e ns) ex -- ----------------------------------------------------------------------------- evalSpezExpr :: Env -> Expr -> XPathFilter evalSpezExpr _ (NumberExpr (Float 0)) _ = XPVNumber Pos0 evalSpezExpr _ (NumberExpr (Float f)) _ = XPVNumber (Float f) evalSpezExpr _ (LiteralExpr s) _ = XPVString s evalSpezExpr env (VarExpr name) v = getVariable env name v evalSpezExpr _ _ _ = XPVError "Call to evalExpr with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- filter for evaluating a filter-expression filterEval :: Env -> Context -> [Expr] -> XPathFilter filterEval env cont (prim:predicates) ns = case evalExpr env cont prim ns of (XPVNode nns) -> nodeListResToXPathValue . evalPredL env predicates . Right . fromNodeSet $ nns _ -> XPVError "Return of a filterexpression is not a nodeset" filterEval _ _ _ _ = XPVError "Call to filterEval without an expression" -- ----------------------------------------------------------------------------- -- | -- returns the union of its arguments, the arguments have to be node-sets. unionEval :: [XPathValue] -> XPathValue unionEval vs | not (null evs) = case head evs of e@(XPVError _) -> e _ -> XPVError "A value of a union ( | ) is not a nodeset" | otherwise = XPVNode . unionsNodeSet . map theNode $ nvs where (nvs, evs) = partition isNode vs isNode (XPVNode _) = True isNode _ = False theNode (XPVNode ns) = ns theNode _ = error "illegal argument in unionEval" -- ----------------------------------------------------------------------------- -- | -- Equality or relational test for node-sets, numbers, boolean values or strings, -- each computation of two operands is done by relEqEv' relEqEval :: Env -> Context -> Op -> [XPathValue] -> XPathValue relEqEval env cont op = foldl1 (relEqEv' env cont op) relEqEv' :: Env -> Context -> Op -> XPathValue -> XPathFilter relEqEv' _ _ _ e@(XPVError _) _ = e relEqEv' _ _ _ _ e@(XPVError _) = e -- two node-sets relEqEv' env cont op a@(XPVNode _) b@(XPVNode _) = relEqTwoNodes env cont op a b -- one node-set relEqEv' env cont op a b@(XPVNode _) = relEqOneNode env cont (fromJust $ getOpFct op) a b relEqEv' env cont op a@(XPVNode _) b = relEqOneNode env cont (flip $ fromJust $ getOpFct op) b a -- test without a node-set and equality or not-equality operator relEqEv' env cont Eq a b = eqEv env cont (==) a b relEqEv' env cont NEq a b = eqEv env cont (/=) a b -- test without a node-set and less, less-equal, greater or greater-equal operator relEqEv' env cont op a b = XPVBool ((fromJust $ getOpFct op) (toXNumber a) (toXNumber b)) where toXNumber x = xnumber cont env [x] -- ----------------------------------------------------------------------------- -- | -- Equality or relational test for two node-sets. -- The comparison will be true if and only if there is a node in the first node-set -- and a node in the second node-set such that the result of performing the -- comparison on the string-values of the two nodes is true relEqTwoNodes :: Env -> Context -> Op -> XPathValue -> XPathFilter relEqTwoNodes _ _ op (XPVNode ns) (XPVNode ms) = XPVBool $ foldr (\n -> (any (fct op n) (getStrValues ms) ||)) False $ fromNodeSet ns where fct op' n' = (fromJust $ getOpFct op') (stringValue n') getStrValues = map stringValue . fromNodeSet relEqTwoNodes _ _ _ _ _ = XPVError "Call to relEqTwoNodes without a nodeset" -- ----------------------------------------------------------------------------- -- | -- Comparison between a node-set and different type. -- The node-set is converted in a boolean value if the second argument is of type boolean. -- If the argument is of type number, the node-set is converted in a number, otherwise it is converted -- in a string value. relEqOneNode :: Env -> Context -> (XPathValue -> XPathValue -> Bool) -> XPathValue -> XPathFilter relEqOneNode env cont fct arg = withXPVNode "Call to relEqOneNode without a nodeset" $ \ ns -> XPVBool (any (fct arg) (getStrValues arg ns)) where getStrValues arg' = map ((fromJust $ getConvFct arg') cont env . (:[])) . map stringValue . fromNodeSet -- ----------------------------------------------------------------------------- -- | -- No node-set is involved and the operator is equality or not-equality. -- The arguments are converted in a common type. If one argument is a boolean value -- then it is the boolean type. If a number is involved, the arguments have to converted in numbers, -- else the string type is the common type. eqEv :: Env -> Context -> (XPathValue -> XPathValue -> Bool) -> XPathValue -> XPathFilter eqEv env cont fct f@(XPVBool _) g = XPVBool (f `fct` xboolean cont env [g]) eqEv env cont fct f g@(XPVBool _) = XPVBool (xboolean cont env [f] `fct` g) eqEv env cont fct f@(XPVNumber _) g = XPVBool (f `fct` xnumber cont env [g]) eqEv env cont fct f g@(XPVNumber _) = XPVBool (xnumber cont env [f] `fct` g) eqEv env cont fct f g = XPVBool (xstring cont env [f] `fct` xstring cont env [g]) -- ----------------------------------------------------------------------------- getOpFct :: Op -> Maybe (XPathValue -> XPathValue -> Bool) getOpFct Eq = Just (==) getOpFct NEq = Just (/=) getOpFct Less = Just (<) getOpFct LessEq = Just (<=) getOpFct Greater = Just (>) getOpFct GreaterEq = Just (>=) getOpFct _ = Nothing -- ----------------------------------------------------------------------------- -- | -- Filter for accessing the root element of a document tree getRoot :: XPathFilter getRoot = withXPVNode "Call to getRoot without a nodeset" $ getRoot' where getRoot' ns | nullNodeSet ns = XPVError "Call to getRoot with empty nodeset" | otherwise = XPVNode . singletonNodeSet . getRoot'' . headNodeSet $ ns getRoot'' tree = case upNT tree of Nothing -> tree Just t -> getRoot'' t -- ----------------------------------------------------------------------------- type NodeList = NavXmlTrees type NodeListRes = Either XPathValue NodeList nodeListResToXPathValue :: NodeListRes -> XPathValue nodeListResToXPathValue = either id (XPVNode . toNodeSet) nullNL :: NodeListRes nullNL = Right [] plusNL :: NodeListRes -> NodeListRes -> NodeListRes plusNL res@(Left _) _ = res plusNL _ res@(Left _) = res plusNL (Right ns1) (Right ns2) = Right $ ns1 ++ ns2 sumNL :: [NodeListRes] -> NodeListRes sumNL = foldr plusNL nullNL mapNL :: (NavXmlTree -> NodeListRes) -> NodeListRes -> NodeListRes mapNL _ res@(Left _) = res mapNL f (Right ns) = sumNL . map f $ ns mapNL' :: (Int -> NavXmlTree -> NodeListRes) -> NodeListRes -> NodeListRes mapNL' _ res@(Left _) = res mapNL' f (Right ns) = sumNL . zipWith f [1..] $ ns -- ------------------------------------------------------------ -- | -- Filter for accessing all nodes of a XPath-axis -- -- * 1.parameter as : axis specifier -- getAxisNodes :: AxisSpec -> NodeSet -> [NodeListRes] getAxisNodes as = map (Right . (fromJust $ lookup as axisFctL)) . fromNodeSet -- | -- Axis-Function-Table. -- Each XPath axis-specifier is mapped to the corresponding axis-function axisFctL :: [(AxisSpec, (NavXmlTree -> NavXmlTrees))] axisFctL = [ (Ancestor , ancestorAxis) , (AncestorOrSelf , ancestorOrSelfAxis) , (Attribute , attributeAxis) , (Child , childAxis) , (Descendant , descendantAxis) , (DescendantOrSelf , descendantOrSelfAxis) , (Following , followingAxis) , (FollowingSibling , followingSiblingAxis) , (Parent , parentAxis) , (Preceding , precedingAxis) , (PrecedingSibling , precedingSiblingAxis) , (Self , selfAxis) ] -- ----------------------------------------------------------------------------- -- | -- evaluates a location path, -- evaluation of an absolute path starts at the document root, -- the relative path at the context node locPathEval :: Env -> LocationPath -> XPathFilter locPathEval env (LocPath Rel steps) = evalSteps env steps locPathEval env (LocPath Abs steps) = evalSteps env steps . getRoot -- ----------------------------------------------------------------------------- evalSteps :: Env -> [XStep] -> XPathFilter evalSteps env steps ns = foldl (flip $ evalStep env) ns steps -- | -- evaluate a single XPath step -- namespace-axis is not supported evalStep :: Env -> XStep -> XPathFilter evalStep _ (Step Namespace _ _ ) _ = XPVError "namespace-axis not supported" evalStep _ (Step Attribute nt _ ) ns = withXPVNode "Call to getAxis without a nodeset" evalAttr' ns where evalAttr' = nodeListResToXPathValue . sumNL . map (evalAttr nt) . getAxisNodes Attribute evalStep env (Step axisSpec nt pr) ns = withXPVNode "Call to getAxis without a nodeset" evalSingleStep ns where evalSingleStep = nodeListResToXPathValue . sumNL . map (evalStep' env pr nt) . getAxisNodes axisSpec -- ----------------------------------------------------------------------------- -- the goal: -- evalAttr :: NodeTest -> NavXmlTrees -> XPathValue evalAttr :: NodeTest -> NodeListRes -> NodeListRes evalAttr nt = mapNL (Right . evalAttrNodeTest nt) evalAttrNodeTest :: NodeTest -> NavXmlTree -> NavXmlTrees evalAttrNodeTest (NameTest qn) ns@(NT (NTree (XAttr qn1) _) _ix _ _ _) = if ( ( uri == uri1 && lp == lp1) || ((uri == "" || uri == uri1) && lp == "*") ) then [ns] else [] where uri = namespaceUri qn uri1 = namespaceUri qn1 lp = localPart qn lp1 = localPart qn1 evalAttrNodeTest (TypeTest XPNode) ns@(NT (NTree (XAttr _) _) _ix _ _ _) = [ns] evalAttrNodeTest _ _ = [] -- ----------------------------------------------------------------------------- evalStep' :: Env -> [Expr] -> NodeTest -> NodeListRes -> NodeListRes evalStep' env pr nt = evalPredL env pr . nodeTest nt evalPredL :: Env -> [Expr] -> NodeListRes -> NodeListRes evalPredL env pr ns = foldl (flip $ evalPred env) ns pr evalPred :: Env -> Expr -> NodeListRes -> NodeListRes evalPred _ _ res@(Left _) = res evalPred env ex arg@(Right ns) = mapNL' (evalPred' env ex (length ns)) arg evalPred' :: Env -> Expr -> Int -> Int -> NavXmlTree -> NodeListRes evalPred' env ex len pos x = case testPredicate env (pos, len, x) ex (XPVNode . singletonNodeSet $ x) of e@(XPVError _) -> Left e XPVBool True -> Right [x] XPVBool False -> Right [] _ -> Left $ XPVError "Value of testPredicate is not a boolean" testPredicate :: Env -> Context -> Expr -> XPathFilter testPredicate env context@(pos, _, _) ex ns = case evalExpr env context ex ns of XPVNumber (Float f) -> XPVBool (f == fromIntegral pos) XPVNumber _ -> XPVBool False _ -> xboolean context env [evalExpr env context ex ns] -- ----------------------------------------------------------------------------- -- | -- filter for selecting a special type of nodes from the current fragment tree -- -- the filter works with namespace activated and without namespaces. -- If namespaces occur in XPath names, the uris are used for matching, -- else the name prefix -- -- Bugfix : "*" (or any other name-test) must not match the root node nodeTest :: NodeTest -> NodeListRes -> NodeListRes nodeTest _ res@(Left _) = res nodeTest t (Right ns) = Right . nodeTest' t $ ns nodeTest' :: NodeTest -> NodeList -> NodeList nodeTest' (NameTest q) | isWildcardTest = filterNodes' (wildcardTest q) | otherwise = filterNodes' (nameTest q) where isWildcardTest = localPart q == "*" nodeTest' (PI n) = filterNodes' isPiNode where isPiNode = maybe False ((== n) . qualifiedName) . XN.getPiName nodeTest' (TypeTest t) = typeTest t -- | -- the filter selects the NTree part of a navigable tree and -- tests whether the node is of the necessary type -- -- * 1.parameter fct : filter function from the XmlTreeFilter module which tests the type of a node filterNodes' :: (XNode -> Bool) -> NodeList -> NodeList filterNodes' fct = filter (fct . dataNT) -- ----------------------------------------------------------------------------- nameTest :: QName -> XNode -> Bool nameTest xpName (XTag elemName _) | namespaceAware = localPart xpName == localPart elemName && namespaceUri xpName == namespaceUri elemName | otherwise = qualifiedName xpName == qualifiedName elemName where namespaceAware = not . null . namespaceUri $ xpName nameTest _ _ = False -- ----------------------------------------------------------------------------- wildcardTest :: QName -> XNode -> Bool wildcardTest xpName (XTag elemName _) | namespaceAware = namespaceUri xpName == namespaceUri elemName | prefixMatch = namePrefix xpName == namePrefix elemName | otherwise = localPart elemName /= t_root -- all names except the root name "/" where namespaceAware = not . null . namespaceUri $ xpName prefixMatch = not . null . namePrefix $ xpName wildcardTest _ _ = False -- ----------------------------------------------------------------------------- -- | -- tests whether a node is of a special type -- typeTest :: XPathNode -> NodeList -> NodeList typeTest XPNode = id typeTest XPCommentNode = filterNodes' XN.isCmt typeTest XPPINode = filterNodes' XN.isPi typeTest XPTextNode = filterNodes' XN.isText -- ----------------------------------------------------------------------------- -- | -- evaluates a boolean expression, the evaluation is non-strict boolEval :: Env -> Context -> Op -> [Expr] -> XPathFilter boolEval _ _ op [] _ = XPVBool (op == And) boolEval env cont Or (x:xs) ns = case xboolean cont env [evalExpr env cont x ns] of e@(XPVError _) -> e XPVBool True -> XPVBool True _ -> boolEval env cont Or xs ns boolEval env cont And (x:xs) ns = case xboolean cont env [evalExpr env cont x ns] of e@(XPVError _) -> e XPVBool True -> boolEval env cont And xs ns _ -> XPVBool False boolEval _ _ _ _ _ = XPVError "Call to boolEval with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- returns the value of a variable getVariable :: Env -> VarName -> XPathFilter getVariable env name _ = fromMaybe (XPVError ("Variable: " ++ show name ++ " not found")) $ lookup name (getVarTab env) -- ----------------------------------------------------------------------------- -- | -- evaluates a function, -- computation is done by 'XPathFct.evalFct' which is defined in "XPathFct". fctEval :: Env -> Context -> FctName -> [Expr] -> XPathFilter fctEval env cont name args = evalFct name env cont . evalExprL env cont args -- ----------------------------------------------------------------------------- -- | -- evaluates an arithmetic operation. -- -- 1.parameter f : arithmetic function from "XPathArithmetic" -- numEval :: (Op -> XPathValue -> XPathValue -> XPathValue) -> Op -> [XPathValue] -> XPathValue numEval f op = foldl1 (f op) -- ----------------------------------------------------------------------------- -- | -- Convert list of ID attributes from DTD into a space separated 'XPVString' -- idAttributesToXPathValue :: XmlTrees -> XPathValue idAttributesToXPathValue ts = XPVString (foldr (\ n -> ( (valueOfDTD a_value n ++ " ") ++)) [] ts) -- ----------------------------------------------------------------------------- -- | -- Extracts all ID-attributes from the document type definition (DTD). -- getIdAttributes :: XmlTree -> XmlTrees getIdAttributes = runLA $ AT.getChildren >>> isDTD >>> AT.deep (isIdAttrType) -- ---------------------------------------- isIdAttrType :: ArrowDTD a => a XmlTree XmlTree isIdAttrType = hasDTDAttrValue a_type (== k_id) valueOfDTD :: String -> XmlTree -> String valueOfDTD n = concat . runLA ( getDTDAttrl >>^ lookup1 n ) hasDTDAttrValue :: ArrowDTD a => String -> (String -> Bool) -> a XmlTree XmlTree hasDTDAttrValue an p = filterA $ getDTDAttrl >>> isA (p . lookup1 an) -- ------------------------------------------------------------ hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/XPathDataTypes.hs0000644000000000000000000002476112465156121021054 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.XPath.XPathDataTypes Copyright : Copyright (C) 2006 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable The core data types of XPath. The Type NodeSet is based on the module "NavTree" which was adapted from HXML () -} -- ------------------------------------------------------------ module Text.XML.HXT.XPath.XPathDataTypes ( module Text.XML.HXT.XPath.XPathDataTypes , module Text.XML.HXT.XPath.NavTree ) where import Data.Function ( on ) import Data.Map ( Map ) import qualified Data.Map as M import Text.XML.HXT.XPath.NavTree import Text.XML.HXT.DOM.Interface -- ----------------------------------------------------------------------------- -- -- Expr -- | Represents expression -- data Expr = GenExpr Op [Expr] -- ^ generic expression with an operator and one or more operands | PathExpr (Maybe Expr) (Maybe LocationPath) -- ^ a path expression contains an optional filter-expression -- or an optional locationpath. one expression is urgently -- necessary, both are possible | FilterExpr [Expr] -- ^ filter-expression with zero or more predicates | VarExpr VarName -- ^ variable | LiteralExpr Literal -- ^ string | NumberExpr XPNumber -- ^ number | FctExpr FctName FctArguments -- ^ a function with a name and an optional list of arguments deriving (Show, Eq) -- ----------------------------------------------------------------------------- -- -- Op -- | Represents XPath operators data Op = Or | And | Eq | NEq | Less | Greater | LessEq | GreaterEq |Plus | Minus | Div | Mod | Mult| Unary | Union deriving (Show, Eq) -- ----------------------------------------------------------------------------- -- -- | -- Represents a floating-point number according the IEEE 754 standard -- -- The standard includes a special Not-a-Number (NaN) value, -- positive and negative infinity, positive and negative zero. data XPNumber = Float Float -- ^ floating-point number | NaN -- ^ not-a-number | NegInf -- ^ negative infinity | Neg0 -- ^ negative zero | Pos0 -- ^ positive zero | PosInf -- ^ positive infinity instance Show XPNumber where show NaN = "NaN" show NegInf = "-Infinity" show Neg0 = "-0" show Pos0 = "0" show (Float f) = show f show PosInf = "Infinity" -- Negative zero is equal to positive zero, -- equality test with NaN-value is always false instance Eq XPNumber where NegInf == NegInf = True Pos0 == Neg0 = True Neg0 == Pos0 = True Pos0 == Pos0 = True Neg0 == Neg0 = True Float f == Float g = f == g PosInf == PosInf = True _ == _ = False instance Ord XPNumber where a <= b = (a < b) || (a == b) a >= b = (a > b) || (a == b) a > b = b < a NaN < _ = False _ < NaN = False _ < NegInf = False NegInf < _ = True Neg0 < Neg0 = False Pos0 < Pos0 = False Pos0 < Neg0 = False Neg0 < Pos0 = False Neg0 < Float f = 0 < f Pos0 < Float f = 0 < f Float f < Neg0 = f < 0 Float f < Pos0 = f < 0 Float f < Float g = f < g PosInf < _ = False _ < PosInf = True -- ----------------------------------------------------------------------------- -- | Represents location path -- -- A location path consists of a sequence of one or more location steps. data LocationPath = LocPath Path [XStep] deriving (Show, Eq) -- ----------------------------------------------------------------------------- -- | -- A location path is either a relative or an absolute path. data Path = Rel | Abs deriving (Show, Eq) -- | Represents location step -- -- A location step consists of an axis, a node-test and zero or more predicates. data XStep = Step AxisSpec NodeTest [Expr] deriving (Show, Eq) -- ----------------------------------------------------------------------------- -- -- AxisSpec -- | Represents XPath axis data AxisSpec = Ancestor | AncestorOrSelf | Attribute | Child | Descendant | DescendantOrSelf | Following | FollowingSibling | Namespace | Parent | Preceding | PrecedingSibling | Self deriving (Show, Eq) -- ----------------------------------------------------------------------------- -- -- NodeTest -- | Represents XPath node-tests --data NodeTest = NameTest Name -- ^ name-test data NodeTest = NameTest QName -- ^ name-test | PI String -- ^ processing-instruction-test with a literal argument | TypeTest XPathNode -- ^ all nodetype-tests deriving (Show, Eq) -- ----------------------------------------------------------------------------- -- -- XPathNode -- | Represents nodetype-tests data XPathNode = XPNode -- ^ all 7 nodetypes -- (root, element, attribute, namespace, pi, comment, text) | XPCommentNode -- ^ comment-nodes | XPPINode -- ^ processing-instruction-nodes | XPTextNode -- ^ text-nodes: cdata, character data deriving (Show, Eq) -- ----------------------------------------------------------------------------- -- -- useful type definitions type Name = (NamePrefix, LocalName) type NamePrefix = String type LocalName = String -- | Variable name type VarName = Name -- | a string type Literal = String -- | Function name type FctName = String -- | Function arguments type FctArguments = [Expr] -- | Evaluation context type Context = (ConPos ,ConLen, ConNode) -- | Context position type ConPos = Int -- | Context length type ConLen = Int -- | Context node type ConNode = NavXmlTree -- ----------------------------------------------------------------------------- -- -- XPathValue -- | Represents XPath results data XPathValue = XPVNode NodeSet -- ^ node-set | XPVBool Bool -- ^ boolean value | XPVNumber XPNumber -- ^ number according the IEEE 754 standard | XPVString String -- ^ string value | XPVError String -- ^ error message with text deriving (Show, Eq, Ord) -- ----------------------------------------------------------------------------- -- -- Basic types for navigable tree and filters -- | Node of navigable tree representation type NavXmlTree = NavTree XNode -- | List of nodes of navigable tree representation type NavXmlTrees = [NavXmlTree] -- | Set of navigable trees identified by their document position (NodePath) newtype NodeSet = NS { unNS :: Map NodePath NavXmlTree } deriving (Show) -- | path represented as list of indices starting at root type NodePath = [Int] -- | A functions that takes a XPath result and returns a XPath result type XPathFilter = XPathValue -> XPathValue -- ----------------------------------------------------------------------------- withXPVNode :: String -> (NodeSet -> XPathValue) -> XPathFilter withXPVNode s f n = case n of XPVNode ns -> f ns e@(XPVError _) -> e _ -> XPVError s -- ----------------------------------------------------------------------------- -- | node set functions emptyNodeSet :: NodeSet emptyNodeSet = NS M.empty singletonNodeSet :: NavXmlTree -> NodeSet singletonNodeSet = toNodeSet . (:[]) nullNodeSet :: NodeSet -> Bool nullNodeSet = M.null . unNS cardNodeSet :: NodeSet -> Int cardNodeSet = M.size . unNS deleteNodeSet :: NodePath -> NodeSet -> NodeSet deleteNodeSet p = NS . M.delete p . unNS insertNodeSet :: NavXmlTree -> NodeSet -> NodeSet insertNodeSet t = NS . M.insert (pathNT t) t . unNS unionNodeSet :: NodeSet -> NodeSet -> NodeSet unionNodeSet ns1 = NS . M.union (unNS ns1) . unNS unionsNodeSet :: [NodeSet] -> NodeSet unionsNodeSet = NS . foldl (\ res ns -> M.union res $ unNS ns) M.empty elemsNodeSet :: NodeSet -> [(NodePath, NavXmlTree)] elemsNodeSet = M.toList . unNS fromNodeSet :: NodeSet -> NavXmlTrees fromNodeSet = M.elems . unNS toNodeSet :: NavXmlTrees -> NodeSet toNodeSet = NS . foldl (\ m t -> M.insert (pathNT t) t m) M.empty headNodeSet :: NodeSet -> NavXmlTree headNodeSet = head . fromNodeSet withNodeSet :: (NavXmlTrees -> NavXmlTrees) -> NodeSet -> NodeSet withNodeSet f = toNodeSet . f . fromNodeSet instance Eq NodeSet where (==) = (==) `on` (M.keys . unNS) instance Ord NodeSet where compare = compare `on` (M.keys . unNS) -- ----------------------------------------------------------------------------- -- -- Env -- | XPath environment -- -- All variables are stored in the environment, -- each variable name is bound to a value. type VarTab = [(VarName, XPathValue)] type KeyTab = [(QName, String, NavXmlTree)] type Env = (VarTab, KeyTab) varEnv :: Env varEnv = ( [ (("", "name"), XPVNumber NaN) ] , [] ) -- ----------------------------------------------------------------------------- hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/XPathToNodeSet.hs0000644000000000000000000000465112465156121021016 0ustar0000000000000000-- | -- Convert an XPath result set into a node set -- module Text.XML.HXT.XPath.XPathToNodeSet ( xPValue2XmlNodeSet , emptyXmlNodeSet ) where import Text.XML.HXT.DOM.TypeDefs import Text.XML.HXT.XPath.XPathDataTypes -- ----------------------------------------------------------------------------- -- | -- Convert a a XPath-value into a XmlNodeSet represented by a tree structure -- -- The XmlNodeSet can be used to traverse a tree an process all -- marked nodes. xPValue2XmlNodeSet :: XPathValue -> XmlNodeSet xPValue2XmlNodeSet (XPVNode ns) = toNodeSet' ns xPValue2XmlNodeSet _ = emptyXmlNodeSet emptyXmlNodeSet :: XmlNodeSet emptyXmlNodeSet = XNS False [] [] leafNodeSet :: XmlNodeSet leafNodeSet = XNS True [] [] toNodeSet' :: NodeSet -> XmlNodeSet toNodeSet' = pathListToNodeSet . map toPath . fromNodeSet toPath :: NavXmlTree -> XmlNodeSet toPath = upTree leafNodeSet upTree :: XmlNodeSet -> NavXmlTree -> XmlNodeSet upTree ps (NT _ _ [] _ _) = ps -- root node reached upTree ps (NT (NTree n _) ix par _left _right) = upTree ps' $ head par where ps' = pix n pix (XAttr qn) = XNS False [qn] [] pix _ = XNS False [] [(ix, ps)] pathListToNodeSet ::[XmlNodeSet] -> XmlNodeSet pathListToNodeSet = foldr mergePaths emptyXmlNodeSet where mergePaths (XNS p1 al1 cl1) (XNS p2 al2 cl2) = XNS (p1 || p2) (al1 ++ al2) (mergeSubPaths cl1 cl2) mergeSubPaths [] sp2 = sp2 mergeSubPaths (s1:sp1) sp2 = mergeSubPath s1 (mergeSubPaths sp1 sp2) mergeSubPath s1 [] = [s1] mergeSubPath s1@(ix1,p1) sl@(s2@(ix2, p2) : sl') | ix1 < ix2 = s1 : sl | ix1 > ix2 = s2 : mergeSubPath s1 sl' -- ordered insert of s1 | otherwise = (ix1, mergePaths p1 p2) : sl' -- same ix merge subpaths -- ----------------------------------------------------------------------------- hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/NavTree.hs0000644000000000000000000001513112465156121017544 0ustar0000000000000000-- | -- Navigable tree structure which allow a program to traverse -- for XPath expressions -- copied and modified from HXML () -- module Text.XML.HXT.XPath.NavTree ( module Text.XML.HXT.XPath.NavTree , module Data.Tree.NTree.TypeDefs ) where import Data.Maybe import Data.Tree.NTree.TypeDefs import Text.XML.HXT.DOM.Interface ( XNode , xmlnsNamespace , namespaceUri ) import Text.XML.HXT.DOM.XmlNode ( isRoot , isElem , getName , getAttrl ) -- ----------------------------------------------------------------------------- -- NavTree -- -- | navigable tree with nodes of type node -- -- a navigable tree consists of a n-ary tree for the current fragment tree, -- a navigable tree for all ancestors, and two n-ary trees for -- the previous- and following siblings data NavTree a = NT { self :: (NTree a) , selfIndex :: Int , ancestors :: [NavTree a] , previousSiblings :: [NTree a] , followingSiblings :: [NTree a] } deriving (Show) -- deriving not reasonable for Eq and Ord -- ----------------------------------------------------------------------------- -- | -- converts a n-ary tree in a navigable tree ntree :: NTree a -> NavTree a ntree nd = NT nd (-1) [] [] [] -- | -- converts a navigable tree in a n-ary tree subtreeNT :: NavTree a -> NTree a subtreeNT (NT nd _ _ _ _) = nd -- | -- function for selecting the value of the current fragment tree dataNT :: NavTree a -> a dataNT (NT (NTree a _) _ _ _ _) = a -- | -- function for selecting all children of a tree childrenNT :: NavTree a -> [NTree a] childrenNT (NT (NTree _ cs) _ _ _ _) = cs -- | -- position of tree in parent indexNT :: NavTree a -> Int indexNT (NT _ ix _ _ _) = ix -- | -- path (index list) of a navigatable tree pathNT :: NavTree a -> [Int] pathNT = tail . reverse . map selfIndex . ancestorOrSelfAxis -- ----------------------------------------------------------------------------- -- functions for traversing up, down, left and right in a navigable tree upNT , downNT , leftNT , rightNT :: NavTree a -> Maybe (NavTree a) upNT (NT _ _ (p:_) _ _) = Just p upNT (NT _ _ [] _ _) = Nothing downNT t@(NT (NTree _ (c:cs)) _ u _ _) = Just (NT c 0 (t:u) [] cs) downNT (NT (NTree _ [] ) _ _ _ _) = Nothing leftNT (NT s ix u (l:ls) r) = Just (NT l (ix - 1) u ls (s:r)) leftNT (NT _ _ _ [] _) = Nothing rightNT (NT s ix u l (r:rs)) = Just (NT r (ix + 1) u (s:l) rs) rightNT (NT _ _ _ _ [] ) = Nothing -- preorderNT t = t : concatMap preorderNT (children t) -- where children = maybe [] (maybeStar rightNT) . downNT preorderNT :: NavTree a -> [NavTree a] preorderNT = visit [] where visit k t = t : maybe k (visit' k) (downNT t) visit' k t = visit (maybe k (visit' k) (rightNT t)) t revPreorderNT :: NavTree a -> [NavTree a] revPreorderNT t = t : concatMap revPreorderNT (reverse (children t)) where children = maybe [] (maybeStar rightNT) . downNT getChildrenNT :: NavTree a -> [NavTree a] getChildrenNT node = maybe [] follow (downNT node) where follow n = n : maybe [] follow (rightNT n) -- ----------------------------------------------------------------------------- -- Miscellaneous useful combinators -- | -- Kleisli composition: o' :: (b -> [c]) -> (a -> [b]) -> (a -> [c]) f `o'` g = \x -> g x >>= f -- Some useful anamorphisms: maybeStar, maybePlus :: (a -> Maybe a) -> a -> [a] maybeStar f a = a : maybe [] (maybeStar f) (f a) maybePlus f a = maybe [] (maybeStar f) (f a) -- ----------------------------------------------------------------------------- -- functions for representing XPath axes. All axes except the namespace-axis are supported parentAxis :: NavTree a -> [NavTree a] parentAxis = maybeToList . upNT ancestorAxis :: NavTree a -> [NavTree a] ancestorAxis = ancestors -- or: maybePlus upNT ancestorOrSelfAxis :: NavTree a -> [NavTree a] ancestorOrSelfAxis t = t : ancestors t -- or: maybeStar upNT childAxis :: NavTree a -> [NavTree a] childAxis = maybe [] (maybeStar rightNT) . downNT descendantAxis :: NavTree a -> [NavTree a] descendantAxis = tail . preorderNT -- concatMap preorderNT . childAxis descendantOrSelfAxis :: NavTree a -> [NavTree a] descendantOrSelfAxis = preorderNT followingSiblingAxis :: NavTree a -> [NavTree a] followingSiblingAxis = maybePlus rightNT precedingSiblingAxis :: NavTree a -> [NavTree a] precedingSiblingAxis = maybePlus leftNT selfAxis :: NavTree a -> [NavTree a] selfAxis = (:[]) followingAxis :: NavTree a -> [NavTree a] followingAxis = preorderNT `o'` followingSiblingAxis `o'` ancestorOrSelfAxis precedingAxis :: NavTree a -> [NavTree a] precedingAxis = revPreorderNT `o'` precedingSiblingAxis `o'` ancestorOrSelfAxis attributeAxis :: NavTree XNode -> [NavTree XNode] attributeAxis t@(NT xt _ a _ _) | isElem xt && not (isRoot xt) = foldr (\ (ix, attr) -> ((NT attr ix (t:a) [] []):)) [] al | otherwise = [] where aix xs = zip [(0 - length xs) .. (-1)] xs al = filter ((/= xmlnsNamespace) . maybe "" namespaceUri . getName . snd) . aix . fromMaybe [] . getAttrl $ xt -- attributes are indexed in the path with negative indices -- this corresponds to document order and makes the index paths -- for attributes and children disjoint. -- The attribute index is never referenced when navigating in trees -- ------------------------------------------------------------ hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/Arrows.hs0000644000000000000000000002612312465156121017460 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.XPath.Arrows Copyright : Copyright (C) 2006-infinity Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable Most of the XPath arrows come in two versions, one without dealing with namespaces, element and attribute names in XPath expressions are taken as they ar ignoring any prefix:localname structure. The second variant uses a namespace environment for associating the right namespace for the appropriate prefix. An entry for the empty prefix defines the default namespace for the expression. The second variant should be used, when in the application namespaces are significant, that means when namespace propagation is done for the documents to be processed. The XPath evaluator computes a result, which can be a simple value like a string or number, or a node set. The nodes in these sets are identified by their position in the document tree. Node sets are returned as a list of XmlTrees with respect to the document order. -} -- ------------------------------------------------------------ module Text.XML.HXT.XPath.Arrows ( getXPathTreesInDoc , getXPathTreesInDocWithNsEnv , getXPathTrees , getXPathTreesWithNsEnv , getElemNodeSet , getElemAndAttrNodeSet , getXPathNodeSet , getFromNodeSet , processXPathTrees , processXPathTreesWithNsEnv , processFromNodeSet ) where import Control.Arrow.ListArrows import Text.XML.HXT.XPath.XPathEval ( getXPathSubTreesWithNsEnv , getXPathNodeSetWithNsEnv' , addRoot' ) import Text.XML.HXT.DOM.Interface import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.Edit ( canonicalizeForXPath ) -- ------------------------------------------------------------ -- | -- Select parts of a whole XML document with root node by a XPath expression. -- -- The main filter for selecting parts of a document via XPath. -- -- The string argument must be a XPath expression with an absolute location path, -- the argument tree must be a complete document tree. -- -- Before evaluating the xpath query, the document is canonicalized -- with 'Text.XML.HXT.Arrow.Edit.canonicalizeForXPath' -- -- Result is a possibly empty list of XmlTrees forming the set of selected XPath values. -- XPath values other than XmlTrees (numbers, attributes, tagnames, ...) -- are convertet to text nodes. getXPathTreesInDoc :: ArrowXml a => String -> a XmlTree XmlTree getXPathTreesInDoc = getXPathTreesInDocWithNsEnv [] -- | Same as 'getXPathTreesInDoc' but with namespace environment for the XPath names getXPathTreesInDocWithNsEnv :: ArrowXml a => Attributes -> String -> a XmlTree XmlTree getXPathTreesInDocWithNsEnv env query = canonicalizeForXPath >>> arrL (getXPathSubTreesWithNsEnv env query) -- | -- Select parts of an arbitrary XML tree by a XPath expression. -- -- The main filter for selecting parts of an arbitrary XML tree via XPath. -- The string argument must be a XPath expression with an absolute location path, -- There are no restrictions on the argument tree. -- -- No canonicalization is performed before evaluating the query -- -- Result is a possibly empty list of XmlTrees forming the set of selected XPath values. -- XPath values other than XmlTrees (numbers, attributes, tagnames, ...) -- are convertet to text nodes. getXPathTrees :: ArrowXml a => String -> a XmlTree XmlTree getXPathTrees = getXPathTreesWithNsEnv [] -- | Same as 'getXPathTrees' but with namespace environment for the XPath names getXPathTreesWithNsEnv :: ArrowXml a => Attributes -> String -> a XmlTree XmlTree getXPathTreesWithNsEnv env query = arrL (getXPathSubTreesWithNsEnv env query) -- | Select a set of nodes via an XPath expression from an arbitray XML tree -- -- The result is a set of \"pointers\" to nodes. This set can be used to -- access or modify the values of the subnodes in subsequent calls to 'getFromNodeSet' or 'processFromNodeSet'. -- -- This function enables for parsing an XPath expressions and traversing the tree for node selection once -- and reuse this result possibly many times for later selection and modification operations. getXPathNodeSet :: ArrowXml a => String -> a XmlTree XmlNodeSet getXPathNodeSet = getXPathNodeSetWithNsEnv [] -- | Same as 'getXPathNodeSet' but with namespace environment for the XPath names getXPathNodeSetWithNsEnv :: ArrowXml a => Attributes -> String -> a XmlTree XmlNodeSet getXPathNodeSetWithNsEnv nsEnv query = arr (getXPathNodeSetWithNsEnv' nsEnv query) -- ------------------------------------------------------------ getNodeSet :: ArrowXml a => a XmlTree QName -> a XmlTree XmlTree -> a XmlTree XmlNodeSet getNodeSet af f = ( ( listA ( getChildren >>> getNodeSet af f ) >>> arr filterNodeSet ) &&& listA af &&& listA f ) >>^ (\ ~(cl, (al, n)) -> XNS (not . null $ n) al cl) where filterNodeSet :: [XmlNodeSet] -> ChildNodes filterNodeSet = concat . zipWith filterIx [0..] filterIx :: Int -> XmlNodeSet -> ChildNodes filterIx _ix (XNS False [] []) = [] filterIx ix ps = [(ix, ps)] -- | -- compute a node set from a tree, containing all nodes selected by the predicate arrow -- -- computation of the set of element nodes with name \"a\" is done with -- -- > getElemNodeSet (hasName "a") getElemNodeSet :: ArrowXml a => a XmlTree XmlTree -> a XmlTree XmlNodeSet getElemNodeSet f = getNodeSet none f -- | -- compute a node set from a tree, containing all nodes including attribute nodes -- elected by the predicate arrow getElemAndAttrNodeSet :: ArrowXml a => a XmlTree XmlTree -> a XmlTree XmlNodeSet getElemAndAttrNodeSet f = getNodeSet ( getAttrl >>> ( f `guards` getAttrName ) ) f -- ------------------------------------------------------------ -- | -- select all subtrees specified by a previously computed node set -- -- the following law holds: -- -- > getFromNodeSet $< getElemNodeSet f == multi f getFromNodeSet :: ArrowXml a => XmlNodeSet -> a XmlTree XmlTree getFromNodeSet xns = fromLA $ arr addRoot' >>> getFromNodeSet' xns getFromNodeSet' :: XmlNodeSet -> LA XmlTree XmlTree getFromNodeSet' (XNS t al cl) = fromLA $ ( if t then this else none ) <+> ( getAttrl >>> getFromAttrl al ) <+> ( getFromChildren (0-1) cl $< listA getChildren ) where getFromAttrl :: [QName] -> LA XmlTree XmlTree getFromAttrl l = ( catA . map hasQName $ l) `guards` this getFromChildren :: Int -> ChildNodes -> XmlTrees -> LA XmlTree XmlTree getFromChildren _ [] _ = none getFromChildren i' ((i, sp) : sps) ts = ( arrL (const t') >>> getFromNodeSet' sp ) <+> getFromChildren i sps ts' where (t', ts') = splitAt 1 . drop (i-i'-1) $ ts -- ------------------------------------------------------------ -- | -- process all subtrees selected by an XPath expression -- -- the following law holds: -- -- > processXPathTrees p xpathExpr == processFromNodeSet p $< getXPathNodeSet xpathExpr processXPathTrees :: ArrowXml a => a XmlTree XmlTree -> String -> a XmlTree XmlTree processXPathTrees f = processXPathTreesWithNsEnv f [] -- | Same as 'processXPathTrees' but with namespace environment for the XPath names processXPathTreesWithNsEnv :: ArrowXml a => a XmlTree XmlTree -> Attributes -> String -> a XmlTree XmlTree processXPathTreesWithNsEnv f nsEnv query = choiceA [ isRoot :-> processChildren pns , this :-> pns ] where pns = processFromNodeSet f $< getXPathNodeSetWithNsEnv nsEnv query -- ------------------------------------------------------------ -- | -- process all subtrees specified by a previously computed node set in bottom up manner -- -- the following law should hold: -- -- > processFromNodeSet g $< getElemNodeSet f == processBottomUp (g `when` f) -- -- when attributes are contained in the node set (see 'getElemAndAttrNodeSet'), these are processed -- after the children and before the node itself -- -- the advantage of processFromNodeSet is the separation of the selection of set of nodes to be processed (e.g. modified) -- from the real proccessing. The selection sometimes can be done once, the processing possibly many times. processFromNodeSet :: ArrowXml a => a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree processFromNodeSet f xns = ( isRoot `guards` processFromNodeSet' f xns ) `orElse` ( arr addRoot' >>> processFromNodeSet' f xns >>> getChildren ) processFromNodeSet' :: ArrowXml a => a XmlTree XmlTree -> XmlNodeSet -> a XmlTree XmlTree processFromNodeSet' f (XNS t al cl) = ( if null cl then this else replaceChildren ( processC (0-1) cl $< listA getChildren ) ) >>> ( if null al then this else processAttrl (processA al) ) >>> ( if not t then this else f ) where -- processA :: ChildNodes -> a XmlTree XmlTree processA l = f `when` ( catA . map hasQName $ l) -- processC :: ChildNodes -> XmlTrees -> a XmlTree XmlTree processC _ [] ts = arrL (const ts) processC i' ((i, sp) : sps) ts = arrL (const ts1) <+> ( arrL (const ti) >>> processFromNodeSet' f sp) <+> processC i sps ts21 where (ts1, ts2) = splitAt (i-i'-1) ts (ti, ts21) = splitAt 1 ts2 -- ------------------------------------------------------------ hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/XPathKeywords.hs0000644000000000000000000000352712465156121020762 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.XPath.XPathKeywords Copyright : Copyright (C) 2010 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable xpath keywords -} -- ------------------------------------------------------------ module Text.XML.HXT.XPath.XPathKeywords where -- ------------------------------------------------------------ -- -- string constants for representing XPath keywords and axis a_ancestor, -- axisNames a_ancestor_or_self, a_attribute, a_child, a_descendant, a_descendant_or_self, a_following, a_following_sibling, a_namespace, a_parent, a_preceding, a_preceding_sibling, a_self :: String n_comment, -- nodeTypes n_text, n_processing_instruction, n_node :: String -- ------------------------------------------------------------ a_ancestor = "ancestor" a_ancestor_or_self = "ancestor-or-self" a_attribute = "attribute" a_child = "child" a_descendant = "descendant" a_descendant_or_self = "descendant-or-self" a_following = "following" a_following_sibling = "following-sibling" a_namespace = "namespace" a_parent = "parent" a_preceding = "preceding" a_preceding_sibling = "preceding-sibling" a_self = "self" n_comment = "comment" n_text = "text" n_processing_instruction = "processing-instruction" n_node = "node" -- ------------------------------------------------------------ hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/XPathParser.hs0000644000000000000000000003702712465156121020411 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.XPath.XPathParser Copyright : Copyright (C) 2006-2010 Uwe Schmidt, Torben Kuseler License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable The XPath Parser -} -- ------------------------------------------------------------ module Text.XML.HXT.XPath.XPathParser ( parseNumber , parseXPath ) where import Text.ParserCombinators.Parsec import Text.XML.HXT.DOM.TypeDefs import Text.XML.HXT.XPath.XPathKeywords import Text.XML.HXT.XPath.XPathDataTypes import Text.XML.HXT.Parser.XmlCharParser ( XParser , XPState(..) , withNormNewline ) import Text.XML.HXT.Parser.XmlTokenParser ( separator , systemLiteral , skipS0 , ncName , qName ) -- ------------------------------------------------------------ lookupNs :: NsEnv -> XName -> Maybe XName lookupNs uris prefix | null uris = Just nullXName -- not namespace aware XPath | isNullXName prefix = maybe (Just nullXName) Just $ -- no default namespace given lookup prefix uris | otherwise = lookup prefix uris -- namespace aware enhanceAttrQName :: NsEnv -> QName -> Maybe QName enhanceAttrQName uris qn | isNullXName (namePrefix' qn) = Just qn | otherwise = enhanceQName uris qn enhanceQName :: NsEnv -> QName -> Maybe QName enhanceQName uris qn = do nsu <- lookupNs uris (namePrefix' qn) return $ setNamespaceUri' nsu qn enhanceQN :: AxisSpec -> NsEnv -> QName -> Maybe QName enhanceQN Attribute = enhanceAttrQName enhanceQN _ = enhanceQName type XPathParser a = XParser NsEnv a -- ------------------------------------------------------------ -- parse functions which are used in the XPathFct module -- | -- parsing a number, parseNumber is used in "XPathFct" -- by the number function -- -- - returns : the parsed number as 'XPNumber' float -- or 'XPVNumber' 'NaN' in case of error parseNumber :: String -> XPathValue parseNumber s = case (runParser parseNumber' (withNormNewline []) {- Map.empty -} "" s) of Left _ -> XPVNumber NaN Right x -> if (read x :: Float) == 0 then (XPVNumber Pos0) else XPVNumber (Float (read x)) parseNumber' :: XPathParser String parseNumber' = do skipS0 m <- option "" (string "-") n <- number skipS0 eof return (m ++ n) -- ------------------------------------------------------------ -- | -- the main entry point: -- parsing a XPath expression parseXPath :: XPathParser Expr parseXPath = do skipS0 xPathExpr <- expr skipS0 eof return xPathExpr -- some useful token and symbol parser lpar, rpar, lbra, rbra, slash, dslash :: XPathParser () lpar = tokenParser (symbol "(") rpar = tokenParser (symbol ")") lbra = tokenParser (symbol "[") rbra = tokenParser (symbol "]") slash = tokenParser (symbol "/") dslash = tokenParser (symbol "//") tokenParser :: XPathParser String -> XPathParser () tokenParser p = try ( do skipS0 _ <- p skipS0 ) symbolParser :: (String, a) -> XPathParser a symbolParser (s,a) = do tokenParser (symbol s) return a symbol :: String -> XPathParser String symbol s = try (string s) -- operation parser orOp, andOp, eqOp, relOp, addOp, multiOp, unionOp :: XPathParser Op orOp = symbolParser ("or", Or) andOp = symbolParser ("and", And) eqOp = symbolParser ("=", Eq) <|> symbolParser ("!=", NEq) relOp = choice [ symbolParser ("<=", LessEq) , symbolParser (">=", GreaterEq) , symbolParser ("<", Less) , symbolParser (">", Greater) ] addOp = symbolParser ("+", Plus) <|> symbolParser ("-", Minus) multiOp = choice [ symbolParser ("*", Mult) , symbolParser ("mod", Mod) , symbolParser ("div", Div) ] unionOp = symbolParser ("|", Union) -- ------------------------------------------------------------ mkExprNode :: Expr -> [(Op, Expr)] -> Expr mkExprNode e1 [] = e1 mkExprNode e1 l@((op, _): _) = if null rest then GenExpr op (e1:(map snd l)) else GenExpr op $ (e1:(map snd $ init same)) ++ [mkExprNode (snd $ last same) rest] where (same, rest) = span ((==op) . fst) l -- Tim Walkenhorst, original expr. below: -- It seems mkExprNode is called only with operators of the same precedence, that should make it fixable -- FIXED, see above! --mkExprNode e1 l@((op, _): _) = GenExpr op (e1:(map snd l)) -- Less than ideal: 1+1-1 = 3 ??? --GenExpr op (e1:(map snd l)) exprRest :: XPathParser Op -> XPathParser Expr -> XPathParser (Op, Expr) exprRest parserOp parserExpr = do op <- parserOp e2 <- parserExpr return (op, e2) -- ------------------------------------------------------------ -- abbreviation of "//" descOrSelfStep :: XStep descOrSelfStep = (Step DescendantOrSelf (TypeTest XPNode) []) -- ------------------------------------------------------------ -- Location Paths (2) -- [1] LocationPath locPath :: XPathParser LocationPath locPath = absLocPath <|> relLocPath' -- [2] AbsoluteLocationPath absLocPath :: XPathParser LocationPath absLocPath = do -- [10] dslash s <- relLocPath return (LocPath Abs ([descOrSelfStep] ++ s)) <|> do slash s <- option [] relLocPath return (LocPath Abs s) "absLocPath" -- [3] RelativeLocationPath relLocPath' :: XPathParser LocationPath relLocPath' = do rel <- relLocPath return (LocPath Rel rel) relLocPath :: XPathParser [XStep] relLocPath = do s1 <- step s2 <- many (step') return ([s1] ++ (concat s2)) "relLocPath" -- Location Steps (2.1) -- -- [4] Step step' :: XPathParser [XStep] step' = do -- [11] dslash s <- step return [descOrSelfStep,s] <|> do slash s <- step return [s] "step'" step :: XPathParser XStep step = abbrStep <|> do as <- axisSpecifier' nt <- nodeTest as pr <- many predicate return (Step as nt pr) "step" -- [5] AxisSpecifier axisSpecifier' :: XPathParser AxisSpec axisSpecifier' = do -- [13] tokenParser (symbol "@") return Attribute <|> do as <- option Child ( try ( do -- child-axis is default-axis a <- axisSpecifier tokenParser (symbol "::") return a ) ) return as "axisSpecifier'" -- Axes (2.2) -- -- [6] AxisName axisSpecifier :: XPathParser AxisSpec axisSpecifier = choice [ symbolParser (a_ancestor_or_self, AncestorOrSelf) , symbolParser (a_ancestor, Ancestor) , symbolParser (a_attribute, Attribute) , symbolParser (a_child, Child) , symbolParser (a_descendant_or_self, DescendantOrSelf) , symbolParser (a_descendant, Descendant) , symbolParser (a_following_sibling, FollowingSibling) , symbolParser (a_following, Following) , symbolParser (a_namespace, Namespace) , symbolParser (a_parent, Parent) , symbolParser (a_preceding_sibling, PrecedingSibling) , symbolParser (a_preceding, Preceding) , symbolParser (a_self, Self) ] "axisSpecifier" -- Node Tests (2.3) -- -- [7] NodeTest nodeTest :: AxisSpec -> XPathParser NodeTest nodeTest as = do nt <- try nodeType' return (TypeTest nt) <|> do processInst <- pI return (PI processInst) <|> do nt <- nameTest as return (NameTest nt) "nodeTest" pI :: XPathParser String pI = do tokenParser (symbol n_processing_instruction) li <- between lpar rpar literal return li "Processing-Instruction" -- Predicates (2.4) -- -- [8] Predicate -- [9] PredicateExpr predicate :: XPathParser Expr predicate = do ex <- between lbra rbra expr return ex -- Abbreviated Syntax (2.5) -- -- [10] AbbreviatedAbsoluteLocationPath: q.v. [2] -- [11] AbbreviatedRelativeLocationPath: q.v. [4] -- [12] AbbreviatedStep abbrStep :: XPathParser XStep abbrStep = do tokenParser (symbol "..") return (Step Parent (TypeTest XPNode) []) <|> do tokenParser (symbol ".") return (Step Self (TypeTest XPNode) []) "abbrStep" -- [13] AbbreviatedAxisSpecifier: q.v. [5] -- ------------------------------------------------------------ -- Expressions (3) -- Basics (3.1) -- -- [14] Expr expr :: XPathParser Expr expr = orExpr -- [15] PrimaryExpr primaryExpr :: XPathParser Expr primaryExpr = do vr <- variableReference return (VarExpr vr) <|> do ex <- between lpar rpar expr return ex <|> do li <- literal return (LiteralExpr li) <|> do num <- number return (NumberExpr (Float $ read num)) <|> do fc <- functionCall return (fc) "primaryExpr" -- Function Calls (3.2) -- -- [16] FunctionCall -- [17] Argument functionCall :: XPathParser Expr functionCall = do fn <- functionName arg <- between lpar rpar ( sepBy expr (separator ',') ) return (FctExpr fn arg) "functionCall" -- Node-sets (3.3) -- -- [18] UnionExpr unionExpr :: XPathParser Expr unionExpr = do e1 <- pathExpr eRest <- many (exprRest unionOp pathExpr) return (mkExprNode e1 eRest) -- [19] PathExpr pathExpr :: XPathParser Expr pathExpr = do fe <- try filterExpr path <- do dslash LocPath t1 t2 <- relLocPath' return (PathExpr (Just fe) (Just (LocPath t1 ([descOrSelfStep] ++ t2)))) <|> do slash relPath <- relLocPath' return (PathExpr (Just fe) (Just relPath)) <|> return fe return path <|> do lp <- locPath return (PathExpr Nothing (Just lp)) "pathExpr" -- [20] FilterExpr filterExpr :: XPathParser Expr filterExpr = do prim <- primaryExpr predicates <- many predicate if length predicates > 0 then return (FilterExpr (prim : predicates)) else return prim "filterExpr" -- Booleans (3.4) -- -- [21] OrExpr orExpr :: XPathParser Expr orExpr = do e1 <- andExpr eRest <- many (exprRest orOp andExpr) return (mkExprNode e1 eRest) "orExpr" -- [22] AndExpr andExpr :: XPathParser Expr andExpr = do e1 <- equalityExpr eRest <- many (exprRest andOp equalityExpr) return (mkExprNode e1 eRest) "andExpr" -- [23] EqualityExpr equalityExpr :: XPathParser Expr equalityExpr = do e1 <- relationalExpr eRest <- many (exprRest eqOp relationalExpr) return (mkExprNode e1 eRest) "equalityExpr" -- [24] RelationalExpr relationalExpr :: XPathParser Expr relationalExpr = do e1 <- additiveExpr eRest <- many (exprRest relOp additiveExpr) return (mkExprNode e1 eRest) "relationalExpr" -- Numbers (3.5) -- -- [25] AdditiveExpr additiveExpr :: XPathParser Expr additiveExpr = do e1 <- multiplicativeExpr eRest <- many (exprRest addOp multiplicativeExpr) return (mkExprNode e1 eRest) "additiveExpr" -- [26] MultiplicativeExpr multiplicativeExpr :: XPathParser Expr multiplicativeExpr = do e1 <- unaryExpr eRest <- many (exprRest multiOp unaryExpr) return (mkExprNode e1 eRest) "multiplicativeExpr" -- [27] UnaryExpr unaryExpr :: XPathParser Expr unaryExpr = do tokenParser (symbol "-") u <- unaryExpr return (GenExpr Unary [u]) <|> do u <- unionExpr return u "unaryExpr" -- Lexical Structure (3.7) -- -- [29] Literal -- systemLiteral from XmlParser is used literal :: XPathParser String literal = systemLiteral -- [30] Number number :: XPathParser String number = do tokenParser (symbol ".") d <- many1 digit return ("0." ++ d) <|> do d <- many1 digit d1 <- option "" ( do tokenParser (symbol ".") d2 <- option "0" (many1 digit) return ("." ++ d2) ) return (d ++ d1) "number" -- [35] FunctionName -- no nodetype name is allowed as a function name -- Tim Walkenhorst: -- Change in String encoding for function name -- -- previoulsy: new: -- -- name name -- pref:name {http://uri-for-pref}name functionName :: XPathParser String functionName = do (p, n) <- try qName fn <- enhanceName Attribute $ mkPrefixLocalPart p n if null p then if n `elem` ["processing-instruction", "comment", "text", "node"] then fail $ "function name: " ++ n ++ "not allowed" else return n else return $ "{" ++ namespaceUri fn ++ "}" ++ n "functionName" -- [36] VariableReference variableReference :: XPathParser (String, String) variableReference = do tokenParser (symbol "$") (p, n) <- qName vn <- enhanceName Attribute $ mkPrefixLocalPart p n return (namespaceUri vn, n) "variableReference" -- [37] NameTest nameTest :: AxisSpec -> XPathParser QName nameTest axs = do tokenParser (symbol "*") enhanceName axs $ mkPrefixLocalPart "" "*" <|> do pre <- try ( do pre' <- ncName _ <- symbol ":*" return pre' ) enhanceName axs $ mkPrefixLocalPart pre "*" <|> do (pre,local) <- qName enhanceName axs $ mkPrefixLocalPart pre local "nameTest" enhanceName :: AxisSpec -> QName -> XPathParser QName enhanceName axs qn = do uris <- getState >>= return . xps_userState case enhanceQN axs uris qn of Nothing -> fail $ "no namespace uri given for prefix " ++ show (namePrefix qn) Just qn' -> return qn' "qualified name with defined namespace uri" -- [38] NodeType nodeType' :: XPathParser XPathNode nodeType' = do nt <- nodeType lpar rpar return nt "nodeType'" nodeType :: XPathParser XPathNode nodeType = choice [ symbolParser (n_comment, XPCommentNode) , symbolParser (n_text, XPTextNode) , symbolParser (n_processing_instruction, XPPINode) , symbolParser (n_node, XPNode) ] "nodeType" -- ------------------------------------------------------------ hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/XPathToString.hs0000644000000000000000000001253012465156121020716 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.XPath.XPathToString Copyright : Copyright (C) 2008 - infinity: Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable Format an expression or value in tree- or string-representation -} -- ------------------------------------------------------------ module Text.XML.HXT.XPath.XPathToString ( expr2XPathTree , xPValue2String , xPValue2XmlTrees , nt2XPathTree , pred2XPathTree , toXPathTree , formatXPathTree ) where -- import Text.XML.HXT.DOM.XmlTree import Text.XML.HXT.DOM.Interface import Text.XML.HXT.DOM.XmlNode ( mkText , mkError ) import Text.XML.HXT.DOM.FormatXmlTree ( formatXmlTree ) import Text.XML.HXT.XPath.XPathDataTypes import Data.Char ( toLower ) import Data.Tree.Class ( formatTree ) -- ------------------------------------------------------------ type XPathTree = NTree String -- ----------------------------------------------------------------------------- -- | -- Convert an navigable tree in a xmltree -- toXPathTree :: [NavTree a] -> [NTree a] toXPathTree = map subtreeNT -- ----------------------------------------------------------------------------- formatXPathTree :: Expr -> String formatXPathTree = formatTree id . expr2XPathTree -- ----------------------------------------------------------------------------- -- | -- Format a XPath-value in string representation. -- Text output is done by 'formatXmlTree' for node-sets (trees), -- all other values are represented as strings. -- xPValue2String :: XPathValue -> String xPValue2String (XPVNode ns) = foldr (\ t -> ((formatXmlTree t ++ "\n") ++)) "" (toXPathTree . fromNodeSet $ ns) xPValue2String (XPVBool b) = map toLower (show b) xPValue2String (XPVNumber (Float f)) = show f xPValue2String (XPVNumber s) = show s xPValue2String (XPVString s) = s xPValue2String (XPVError s) = "Error: " ++ s -- ----------------------------------------------------------------------------- -- | -- Convert a a XPath-value into XmlTrees. -- xPValue2XmlTrees :: XPathValue -> XmlTrees xPValue2XmlTrees (XPVNode ns) = toXPathTree . fromNodeSet $ ns xPValue2XmlTrees (XPVBool b) = xtext (show b) xPValue2XmlTrees (XPVNumber (Float f)) = xtext (show f) xPValue2XmlTrees (XPVNumber s) = xtext (show s) xPValue2XmlTrees (XPVString s) = xtext s xPValue2XmlTrees (XPVError s) = xerr s xtext, xerr :: String -> XmlTrees xtext = (:[]) . mkText xerr = (:[]) . mkError c_err -- ----------------------------------------------------------------------------- -- | -- Format a parsed XPath-expression in tree representation. -- Text output is done by 'formatXmlTree' -- expr2XPathTree :: Expr -> XPathTree expr2XPathTree (GenExpr op ex) = NTree (show op) (map expr2XPathTree ex) expr2XPathTree (NumberExpr f) = NTree (show f) [] expr2XPathTree (LiteralExpr s) = NTree s [] expr2XPathTree (VarExpr name) = NTree ("Var: " ++ show name) [] expr2XPathTree (FctExpr n arg) = NTree ("Fct: " ++ n) (map expr2XPathTree arg) expr2XPathTree (FilterExpr []) = NTree "" [] expr2XPathTree (FilterExpr (primary:predicate)) = NTree "FilterExpr" [expr2XPathTree primary, pred2XPathTree predicate] expr2XPathTree (PathExpr Nothing (Just lp)) = locpath2XPathTree lp expr2XPathTree (PathExpr (Just fe) (Just lp)) = NTree "PathExpr" [expr2XPathTree fe, locpath2XPathTree lp] expr2XPathTree (PathExpr _ _) = NTree "" [] locpath2XPathTree :: LocationPath -> XPathTree locpath2XPathTree (LocPath rel steps) = NTree (show rel ++ "LocationPath") (map step2XPathTree steps) step2XPathTree :: XStep -> XPathTree step2XPathTree (Step axis nt []) = NTree (show axis) [nt2XPathTree nt] step2XPathTree (Step axis nt expr) = NTree (show axis) [nt2XPathTree nt, pred2XPathTree expr] nt2XPathTree :: NodeTest -> XPathTree nt2XPathTree (TypeTest s) = NTree ("TypeTest: "++ typeTest2String s) [] nt2XPathTree (PI s) = NTree ("TypeTest: processing-instruction("++ show s ++ ")") [] nt2XPathTree (NameTest s) = NTree ("NameTest: "++ show s) [] pred2XPathTree :: [Expr] -> XPathTree pred2XPathTree exprL = NTree "Predicates" (map expr2XPathTree exprL) typeTest2String :: XPathNode -> String typeTest2String XPNode = "node()" typeTest2String XPCommentNode = "comment()" typeTest2String XPPINode = "processing-instruction()" typeTest2String XPTextNode = "text()" -- ------------------------------------------------------------ hxt-xpath-9.1.2.2/src/Text/XML/HXT/XPath/XPathArithmetic.hs0000644000000000000000000001306612465156121021243 0ustar0000000000000000-- | -- The module contains arithmetic calculations according the IEEE 754 standard -- for plus, minus, unary minus, multiplication, modulo and division. -- module Text.XML.HXT.XPath.XPathArithmetic ( xPathMulti , xPathMod , xPathDiv , xPathAdd , xPathUnary ) where import Text.XML.HXT.XPath.XPathDataTypes -- | -- Unary minus: the value 'NaN' is not calculatable and returned unchanged, -- all other values can be denied. -- xPathUnary :: XPathFilter xPathUnary (XPVNumber (Float f)) = XPVNumber (Float (-f)) xPathUnary (XPVError e) = XPVError e xPathUnary (XPVNumber NaN) = XPVNumber NaN xPathUnary (XPVNumber Pos0) = XPVNumber Neg0 xPathUnary (XPVNumber Neg0) = XPVNumber Pos0 xPathUnary (XPVNumber PosInf) = XPVNumber NegInf xPathUnary (XPVNumber NegInf) = XPVNumber PosInf xPathUnary _ = XPVError "Call to unaryEval without a number" -- | -- Multiplication -- xPathMulti :: Op -> XPathValue -> XPathFilter xPathMulti _ (XPVNumber (Float a)) (XPVNumber (Float b)) = XPVNumber (Float (a * b)) xPathMulti _ (XPVNumber NegInf) (XPVNumber (Float a)) | a < 0 = XPVNumber PosInf | otherwise = XPVNumber NegInf xPathMulti _ (XPVNumber PosInf) (XPVNumber (Float a)) | a < 0 = XPVNumber NegInf | otherwise = XPVNumber PosInf xPathMulti _ (XPVNumber (Float a)) (XPVNumber NegInf) | a < 0 = XPVNumber PosInf | otherwise = XPVNumber NegInf xPathMulti _ (XPVNumber (Float a)) (XPVNumber PosInf) | a < 0 = XPVNumber NegInf | otherwise = XPVNumber PosInf xPathMulti _ (XPVNumber Pos0) (XPVNumber (Float a)) | a < 0 = XPVNumber Neg0 | otherwise = XPVNumber Pos0 xPathMulti _ (XPVNumber Neg0) (XPVNumber (Float a)) | a < 0 = XPVNumber Pos0 | otherwise = XPVNumber Neg0 xPathMulti _ (XPVNumber (Float a)) (XPVNumber Pos0) | a < 0 = XPVNumber Neg0 | otherwise = XPVNumber Pos0 xPathMulti _ (XPVNumber (Float a)) (XPVNumber Neg0) | a < 0 = XPVNumber Pos0 | otherwise = XPVNumber Neg0 xPathMulti a b c = xPathSpez a b c -- | -- Modulo -- xPathMod :: Op -> XPathValue -> XPathFilter xPathMod _ (XPVNumber (Float a)) (XPVNumber (Float b)) | floatMod a b == 0 = XPVNumber Pos0 | otherwise = XPVNumber (Float (floatMod a b)) where floatMod x y | x/y >= 0 = x - y * fromInteger(floor (x / y)) | otherwise =x - y * fromInteger(ceiling (x / y)) xPathMod _ (XPVNumber (Float a)) (XPVNumber NegInf) = XPVNumber (Float a) xPathMod _ (XPVNumber (Float a)) (XPVNumber PosInf) = XPVNumber (Float a) xPathMod _ (XPVNumber Neg0) (XPVNumber Pos0) = XPVNumber Neg0 xPathMod a b c = xPathSpez a b c -- | -- Division: the divison-operator is not according the IEEE 754 standard, -- it calculates the same as the % operator in Java and ECMAScript -- xPathDiv :: Op -> XPathValue -> XPathFilter xPathDiv _ (XPVNumber (Float a)) (XPVNumber (Float b)) = XPVNumber (Float (a / b)) xPathDiv _ (XPVNumber NegInf) (XPVNumber (Float a)) | a < 0 = XPVNumber PosInf | otherwise = XPVNumber NegInf xPathDiv _ (XPVNumber PosInf) (XPVNumber (Float a)) | a < 0 = XPVNumber NegInf | otherwise = XPVNumber PosInf xPathDiv _ (XPVNumber (Float a)) (XPVNumber NegInf) | a < 0 = XPVNumber Pos0 | otherwise = XPVNumber Neg0 xPathDiv _ (XPVNumber (Float a)) (XPVNumber PosInf) | a < 0 = XPVNumber Neg0 | otherwise = XPVNumber Pos0 xPathDiv _ (XPVNumber Neg0) (XPVNumber (Float a)) | a < 0 = XPVNumber Pos0 | otherwise = XPVNumber Neg0 xPathDiv _ (XPVNumber (Float a)) (XPVNumber Neg0) | a < 0 = XPVNumber PosInf | otherwise = XPVNumber NegInf xPathDiv _ (XPVNumber (Float a)) (XPVNumber Pos0) | a < 0 = XPVNumber NegInf | otherwise = XPVNumber PosInf xPathDiv a b c = xPathSpez a b c -- | -- Plus and minus -- -- 1.parameter op : plus or minus operation -- xPathAdd :: Op -> XPathValue -> XPathFilter xPathAdd Plus (XPVNumber (Float a)) (XPVNumber (Float b)) = if a + b == 0 then XPVNumber Pos0 else XPVNumber (Float (a+b)) xPathAdd Minus (XPVNumber (Float a)) (XPVNumber (Float b)) = if a - b == 0 then XPVNumber Pos0 else XPVNumber (Float (a-b)) xPathAdd _ (XPVNumber PosInf) (XPVNumber NegInf) = XPVNumber NaN xPathAdd _ (XPVNumber NegInf) (XPVNumber PosInf) = XPVNumber NaN xPathAdd _ (XPVNumber PosInf) _ = XPVNumber PosInf xPathAdd _ (XPVNumber NegInf) _ = XPVNumber NegInf xPathAdd _ _ (XPVNumber PosInf) = XPVNumber PosInf xPathAdd _ _ (XPVNumber NegInf) = XPVNumber NegInf xPathAdd _ (XPVNumber (Float a)) (XPVNumber Pos0) = XPVNumber (Float a) xPathAdd op (XPVNumber Pos0) (XPVNumber (Float a)) | op == Minus = XPVNumber (Float (-a)) | otherwise = XPVNumber (Float a) xPathAdd op (XPVNumber Neg0) (XPVNumber (Float a)) | op == Minus = XPVNumber (Float (-a)) | otherwise = XPVNumber (Float a) xPathAdd _ (XPVNumber (Float a)) (XPVNumber Neg0) = XPVNumber (Float a) xPathAdd _ (XPVNumber Neg0) (XPVNumber Pos0) = XPVNumber Neg0 xPathAdd _ (XPVNumber Pos0) (XPVNumber Neg0) = XPVNumber Neg0 xPathAdd _ (XPVNumber Neg0) (XPVNumber Neg0) = XPVNumber Neg0 xPathAdd _ (XPVNumber Pos0) (XPVNumber Pos0) = XPVNumber Pos0 xPathAdd a b c = xPathSpez a b c -- | -- Identically results of the operators are combined to get -- as few as possible combinations of the special IEEE values -- xPathSpez :: Op -> XPathValue -> XPathFilter xPathSpez _ (XPVError e) _ = XPVError e xPathSpez _ _ (XPVError e) = XPVError e xPathSpez _ _ _ = XPVNumber NaN