factor/basis/xml/syntax/syntax-tests.factor

! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: xml io kernel math sequences strings xml.traversal
tools.test math.parser xml.syntax xml.data xml.syntax.private
accessors multiline locals inverse xml.writer splitting classes
xml.private ;
IN: xml.syntax.tests

! TAGS test

TAGS: calculate ( tag -- n )

: calc-2children ( tag -- n n )
    children-tags first2 [ calculate ] dip calculate ;

TAG: number calculate
    children>string string>number ;
TAG: add calculate
    calc-2children + ;
TAG: minus calculate
    calc-2children - ;
TAG: times calculate
    calc-2children * ;
TAG: divide calculate
    calc-2children / ;
TAG: neg calculate
    children-tags first calculate neg ;

: calc-arith ( string -- n )
    string>xml first-child-tag calculate ;

[ 32 ] [
    "<math><times><add><number>1</number><number>3</number></add><neg><number>-8</number></neg></times></math>"
    calc-arith
] unit-test

XML-NS: foo http://blah.com

[ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test

! XML literals

[ "a" "c" { "a" "c" f } ] [
    "<?xml version='1.0'?><x><-a-><b val=<-c->/><-></x>"
    string>doc
    [ second var>> ]
    [ fourth "val" attr var>> ]
    [ extract-variables ] tri
] unit-test

[ """<?xml version="1.0" encoding="UTF-8"?>
<x>
  one
  <b val="two"/>
  y
  <foo/>
</x>""" ] [
    [let "one" :> a "two" :> c "y" :> x [XML <-x-> <foo/> XML] :> d
        <XML
            <x> <-a-> <b val=<-c->/> <-d-> </x>
        XML> pprint-xml>string
    ]
] unit-test

[ """<?xml version="1.0" encoding="UTF-8"?>
<doc>
  <item>
    one
  </item>
  <item>
    two
  </item>
  <item>
    three
  </item>
</doc>""" ] [
    "one two three" " " split
    [ [XML <item><-></item> XML] ] map
    <XML <doc><-></doc> XML> pprint-xml>string
] unit-test

[ """<?xml version="1.0" encoding="UTF-8"?>
<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>""" ]
[ 3 f "http://factorcode.org/" "hello" \ drop
  <XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
  pprint-xml>string  ] unit-test

[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml>string ] unit-test
[ "<x></x>" ] [ f [XML <x><-></x> XML] xml>string ] unit-test

[ [XML <-> XML] ] must-infer
[ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer

[ xml-chunk ] [ [ [XML <foo/> XML] ] first class-of ] unit-test
[ xml ] [ [ <XML <foo/> XML> ] first class-of ] unit-test
[ xml-chunk ] [ [ [XML <foo val=<->/> XML] ] third class-of ] unit-test
[ xml ] [ [ <XML <foo val=<->/> XML> ] third class-of ] unit-test
[ 1 ] [ [ [XML <foo/> XML] ] length ] unit-test
[ 1 ] [ [ <XML <foo/> XML> ] length ] unit-test

[ "" ] [ [XML XML] concat ] unit-test

[ "foo" ] [ [XML <a>foo</a> XML] [ [XML <a><-></a> XML] ] undo ] unit-test
[ "foo" ] [ [XML <a bar='foo'/> XML] [ [XML <a bar=<-> /> XML] ] undo ] unit-test
[ "foo" "baz" ] [ [XML <a bar='foo'>baz</a> XML] [ [XML <a bar=<->><-></a> XML] ] undo ] unit-test

: dispatch ( xml -- string )
    {
        { [ [XML <a><-></a> XML] ] [ "a" prepend ] }
        { [ [XML <b><-></b> XML] ] [ "b" prepend ] }
        { [ [XML <b val='yes'/> XML] ] [ "byes" ] }
        { [ [XML <b val=<->/> XML] ] [ "bno" prepend ] }
    } switch ;

[ "apple" ] [ [XML <a>pple</a> XML] dispatch ] unit-test
[ "banana" ] [ [XML <b>anana</b> XML] dispatch ] unit-test
[ "byes" ] [ [XML <b val="yes"/> XML] dispatch ] unit-test
[ "bnowhere" ] [ [XML <b val="where"/> XML] dispatch ] unit-test
[ "baboon" ] [ [XML <b val="something">aboon</b> XML] dispatch ] unit-test
[ "apple" ] [ <XML <a>pple</a> XML> dispatch ] unit-test
[ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch ] unit-test

: dispatch-doc ( xml -- string )
    {
        { [ <XML <a><-></a> XML> ] [ "a" prepend ] }
        { [ <XML <b><-></b> XML> ] [ "b" prepend ] }
        { [ <XML <b val='yes'/> XML> ] [ "byes" ] }
        { [ <XML <b val=<->/> XML> ] [ "bno" prepend ] }
    } switch ;

[ "apple" ] [ <XML <a>pple</a> XML> dispatch-doc ] unit-test
[ "apple" ] [ [XML <a>pple</a> XML] dispatch-doc ] unit-test
[ "apple" ] [ <XML <a>pple</a> XML> body>> dispatch-doc ] unit-test

! Make sure nested XML documents interpolate correctly
{
    """<?xml version="1.0" encoding="UTF-8"?><color><blue>it's blue!</blue></color>"""
} [
    "it's blue!" <XML <blue><-></blue> XML>
    <XML <color><-></color> XML> xml>string
] unit-test

{
    """<?xml version="1.0" encoding="UTF-8"?><a>asdf<asdf/>asdf2</a>"""
} [
    default-prolog
    "asdf"
    "asdf" f f <tag>
    "asdf2" <xml>
    <XML <a><-></a> XML> xml>string
] unit-test