1 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: xml io kernel math sequences strings xml.traversal
4 tools.test math.parser xml.syntax xml.data xml.syntax.private
5 accessors multiline locals inverse xml.writer splitting classes ;
10 TAGS: calculate ( tag -- n )
12 : calc-2children ( tag -- n n )
13 children-tags first2 [ calculate ] dip calculate ;
16 children>string string>number ;
26 children-tags first calculate neg ;
28 : calc-arith ( string -- n )
29 string>xml first-child-tag calculate ;
32 "<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
36 \ calc-arith must-infer
38 XML-NS: foo http://blah.com
40 [ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test
44 [ "a" "c" { "a" "c" f } ] [
45 "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
48 [ fourth "val" attr var>> ]
49 [ extract-variables ] tri
52 [ {" <?xml version="1.0" encoding="UTF-8"?>
59 [let* | a [ "one" ] c [ "two" ] x [ "y" ]
60 d [ [XML <-x-> <foo/> XML] ] |
62 <x> <-a-> <b val=<-c->/> <-d-> </x>
63 XML> pprint-xml>string
67 [ {" <?xml version="1.0" encoding="UTF-8"?>
79 "one two three" " " split
80 [ [XML <item><-></item> XML] ] map
81 <XML <doc><-></doc> XML> pprint-xml>string
84 [ {" <?xml version="1.0" encoding="UTF-8"?>
85 <x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} ]
86 [ 3 f "http://factorcode.org/" "hello" \ drop
87 <XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
88 pprint-xml>string ] unit-test
90 [ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml>string ] unit-test
91 [ "<x></x>" ] [ f [XML <x><-></x> XML] xml>string ] unit-test
94 [ [XML <-> XML] ] must-infer
95 [ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
97 [ xml-chunk ] [ [ [XML <foo/> XML] ] first class ] unit-test
98 [ xml ] [ [ <XML <foo/> XML> ] first class ] unit-test
99 [ xml-chunk ] [ [ [XML <foo val=<->/> XML] ] third class ] unit-test
100 [ xml ] [ [ <XML <foo val=<->/> XML> ] third class ] unit-test
101 [ 1 ] [ [ [XML <foo/> XML] ] length ] unit-test
102 [ 1 ] [ [ <XML <foo/> XML> ] length ] unit-test
104 [ "" ] [ [XML XML] concat ] unit-test
108 [ "foo" ] [ [XML <a>foo</a> XML] [ [XML <a><-></a> XML] ] undo ] unit-test
109 [ "foo" ] [ [XML <a bar='foo'/> XML] [ [XML <a bar=<-> /> XML] ] undo ] unit-test
110 [ "foo" "baz" ] [ [XML <a bar='foo'>baz</a> XML] [ [XML <a bar=<->><-></a> XML] ] undo ] unit-test
112 : dispatch ( xml -- string )
114 { [ [XML <a><-></a> XML] ] [ "a" prepend ] }
115 { [ [XML <b><-></b> XML] ] [ "b" prepend ] }
116 { [ [XML <b val='yes'/> XML] ] [ "byes" ] }
117 { [ [XML <b val=<->/> XML] ] [ "bno" prepend ] }
120 [ "apple" ] [ [XML <a>pple</a> XML] dispatch ] unit-test
121 [ "banana" ] [ [XML <b>anana</b> XML] dispatch ] unit-test
122 [ "byes" ] [ [XML <b val="yes"/> XML] dispatch ] unit-test
123 [ "bnowhere" ] [ [XML <b val="where"/> XML] dispatch ] unit-test
124 [ "baboon" ] [ [XML <b val="something">aboon</b> XML] dispatch ] unit-test
125 [ "apple" ] [ <XML <a>pple</a> XML> dispatch ] unit-test
126 [ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch ] unit-test
128 : dispatch-doc ( xml -- string )
130 { [ <XML <a><-></a> XML> ] [ "a" prepend ] }
131 { [ <XML <b><-></b> XML> ] [ "b" prepend ] }
132 { [ <XML <b val='yes'/> XML> ] [ "byes" ] }
133 { [ <XML <b val=<->/> XML> ] [ "bno" prepend ] }
136 [ "apple" ] [ <XML <a>pple</a> XML> dispatch-doc ] unit-test
137 [ "apple" ] [ [XML <a>pple</a> XML] dispatch-doc ] unit-test
138 [ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch-doc ] unit-test