basis/xml/tests/templating.factor

   1 USING: kernel xml sequences assocs tools.test io arrays namespaces fry
   2 accessors xml.data xml.utilities xml.writer generic sequences.deep multiline ;
   3 IN: xml.tests
   4
   5 : sub-tag
   6     T{ name f f "sub" "http://littledan.onigirihouse.com/namespaces/replace" } ;
   7
   8 SYMBOL: ref-table
   9
  10 GENERIC: (r-ref) ( xml -- )
  11 M: tag (r-ref)
  12     dup sub-tag attr [
  13         ref-table get at
  14         >>children drop
  15     ] [ drop ] if* ;
  16 M: object (r-ref) drop ;
  17
  18 : template ( xml -- )
  19     [ (r-ref) ] deep-each ;
  20
  21 ! Example
  22
  23 STRING: sample-doc
  24 <html xmlns:f='http://littledan.onigirihouse.com/namespaces/replace'>
  25 <body>
  26 <span f:sub='foo'/>
  27 <div f:sub='bar'/>
  28 <p f:sub='baz'>paragraph</p>
  29 </body></html>
  30 ;
  31
  32 STRING: expected-result
  33 <?xml version="1.0" encoding="UTF-8"?>
  34 <html xmlns:f="http://littledan.onigirihouse.com/namespaces/replace">
  35   <body>
  36     <span f:sub="foo">
  37       foo
  38     </span>
  39     <div f:sub="bar">
  40       blah
  41       <a/>
  42     </div>
  43     <p f:sub="baz"/>
  44   </body>
  45 </html>
  46 ;
  47
  48 : test-refs ( -- string )
  49     [
  50         H{
  51             { "foo" { "foo" } }
  52             { "bar" { "blah" T{ tag f T{ name f "" "a" "" } T{ attrs } f } } }
  53             { "baz" f }
  54         } ref-table set
  55         sample-doc string>xml dup template pprint-xml>string
  56     ] with-scope ;
  57
  58 expected-result '[ _ ] [ test-refs ] unit-test