106 lines
2.9 KiB
Factor
106 lines
2.9 KiB
Factor
! Copyright (C) 2009 Daniel Ehrenberg.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: xml xml.state kernel sequences fry assocs xml.data
|
|
accessors strings make multiline parser namespaces macros
|
|
sequences.deep generalizations locals words combinators
|
|
math present arrays ;
|
|
IN: xml.interpolate
|
|
|
|
<PRIVATE
|
|
|
|
: string>chunk ( string -- chunk )
|
|
t interpolating? [ string>xml-chunk ] with-variable ;
|
|
|
|
: string>doc ( string -- xml )
|
|
t interpolating? [ string>xml ] with-variable ;
|
|
|
|
DEFER: interpolate-sequence
|
|
|
|
: interpolate-attrs ( table attrs -- attrs )
|
|
swap '[
|
|
dup interpolated?
|
|
[ var>> _ at dup [ present ] when ] when
|
|
] assoc-map [ nip ] assoc-filter ;
|
|
|
|
: interpolate-tag ( table tag -- tag )
|
|
[ nip name>> ]
|
|
[ attrs>> interpolate-attrs ]
|
|
[ children>> [ interpolate-sequence ] [ drop f ] if* ] 2tri
|
|
<tag> ;
|
|
|
|
GENERIC: push-item ( item -- )
|
|
M: string push-item , ;
|
|
M: xml-data push-item , ;
|
|
M: object push-item present , ;
|
|
M: sequence push-item
|
|
[ dup array? [ % ] [ , ] if ] each ;
|
|
|
|
GENERIC: interpolate-item ( table item -- )
|
|
M: object interpolate-item nip , ;
|
|
M: tag interpolate-item interpolate-tag , ;
|
|
M: interpolated interpolate-item
|
|
var>> swap at push-item ;
|
|
|
|
: interpolate-sequence ( table seq -- seq )
|
|
[ [ interpolate-item ] with each ] { } make ;
|
|
|
|
: interpolate-xml-doc ( table xml -- xml )
|
|
(clone) [ interpolate-tag ] change-body ;
|
|
|
|
GENERIC# (each-interpolated) 1 ( item quot -- ) inline
|
|
M: interpolated (each-interpolated) call ;
|
|
M: tag (each-interpolated)
|
|
swap attrs>> values
|
|
[ interpolated? ] filter
|
|
swap each ;
|
|
M: xml (each-interpolated)
|
|
[ body>> ] dip (each-interpolated) ;
|
|
M: object (each-interpolated) 2drop ;
|
|
|
|
: each-interpolated ( xml quot -- )
|
|
'[ _ (each-interpolated) ] deep-each ; inline
|
|
|
|
:: number<-> ( doc -- doc )
|
|
0 :> n! doc [
|
|
dup var>> [ n >>var n 1+ n! ] unless drop
|
|
] each-interpolated doc ;
|
|
|
|
MACRO: interpolate-xml ( string -- doc )
|
|
string>doc number<-> '[ _ interpolate-xml-doc ] ;
|
|
|
|
MACRO: interpolate-chunk ( string -- chunk )
|
|
string>chunk number<-> '[ _ interpolate-sequence ] ;
|
|
|
|
: >search-hash ( seq -- hash )
|
|
[ dup search ] H{ } map>assoc ;
|
|
|
|
: extract-variables ( xml -- seq )
|
|
[ [ var>> , ] each-interpolated ] { } make ;
|
|
|
|
: nenum ( ... n -- assoc )
|
|
narray <enum> ; inline
|
|
|
|
: collect ( accum seq -- accum )
|
|
{
|
|
{ [ dup [ ] all? ] [ >search-hash parsed ] } ! locals
|
|
{ [ dup [ not ] all? ] [ ! fry
|
|
length parsed \ nenum parsed
|
|
] }
|
|
[ drop "XML interpolation contains both fry and locals" throw ] ! mixed
|
|
} cond ;
|
|
|
|
: parse-def ( accum delimiter word -- accum )
|
|
[
|
|
parse-multiline-string but-last
|
|
[ string>chunk extract-variables collect ] keep
|
|
parsed
|
|
] dip parsed ;
|
|
|
|
PRIVATE>
|
|
|
|
: <XML
|
|
"XML>" \ interpolate-xml parse-def ; parsing
|
|
|
|
: [XML
|
|
"XML]" \ interpolate-chunk parse-def ; parsing
|