steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

refactoring

db4
Doug Coleman 2008-10-19 15:52:59 -05:00
parent 307ad5e9e6
commit ef51d1bbf0
1 changed files with 57 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
extra/html/parser/analyzer/analyzer.factor
View File

@ -3,7 +3,7 @@
USING: assocs html.parser kernel math sequences strings ascii USING: assocs html.parser kernel math sequences strings ascii
arrays generalizations shuffle unicode.case namespaces make arrays generalizations shuffle unicode.case namespaces make
splitting http accessors io combinators http.client urls splitting http accessors io combinators http.client urls
urls.encoding fry ; urls.encoding fry prettyprint ;
IN: html.parser.analyzer IN: html.parser.analyzer
TUPLE: link attributes clickable ; TUPLE: link attributes clickable ;
@ -19,35 +19,34 @@ TUPLE: link attributes clickable ;
'[ _ [ second @ ] find-from rot drop swap 1+ ] '[ _ [ second @ ] find-from rot drop swap 1+ ]
[ f 0 ] 2dip times drop first2 ; inline [ f 0 ] 2dip times drop first2 ; inline
: find-first-name ( str vector -- i/f tag/f ) : find-first-name ( vector string -- i/f tag/f )
[ >lower ] dip [ name>> = ] with find ; inline >lower '[ name>> _ = ] find ; inline
: find-matching-close ( str vector -- i/f tag/f ) : find-matching-close ( vector string -- i/f tag/f )
[ >lower ] dip >lower
[ [ name>> = ] [ closing?>> ] bi and ] with find ; inline '[ [ name>> _ = ] [ closing?>> ] bi and ] find ; inline
: find-between* ( i/f tag/f vector -- vector ) : find-between* ( vector i/f tag/f -- vector )
pick integer? [ over integer? [
rot tail-slice [ tail-slice ] [ name>> ] bi*
>r name>> r> dupd find-matching-close drop dup [ 1+ ] when
[ find-matching-close drop dup [ 1+ ] when ] keep [ head ] [ first ] if*
swap [ head ] [ first ] if*
] [ ] [
3drop V{ } clone 3drop V{ } clone
] if ; inline ] if ; inline
: find-between ( i/f tag/f vector -- vector ) : find-between ( vector i/f tag/f -- vector )
find-between* dup length 3 >= [ find-between* dup length 3 >= [
[ rest-slice but-last-slice ] keep like [ rest-slice but-last-slice ] keep like
] when ; inline ] when ; inline
: find-between-first ( string vector -- vector' ) : find-between-first ( vector string -- vector' )
[ find-first-name ] keep find-between ; inline dupd find-first-name find-between ; inline
: find-between-all ( vector quot -- seq ) : find-between-all ( vector quot -- seq )
[ [ [ closing?>> not ] bi and ] curry find-all ] curry dupd
[ [ >r first2 r> find-between* ] curry map ] bi ; inline '[ _ [ closing?>> not ] bi and ] find-all
[ first2 find-between* ] with map ;
: remove-blank-text ( vector -- vector' ) : remove-blank-text ( vector -- vector' )
[ [
@ -61,27 +60,40 @@ TUPLE: link attributes clickable ;
[ [ [ blank? ] trim ] change-text ] when [ [ [ blank? ] trim ] change-text ] when
] map ; ] map ;
: find-by-id ( id vector -- vector ) : find-by-id ( vector id -- vector' )
[ attributes>> "id" swap at = ] with filter ; '[ attributes>> "id" at _ = ] find ;
: find-by-class ( vector id -- vector' )
'[ attributes>> "class" at _ = ] find ;
: find-by-class ( id vector -- vector ) : find-by-name ( vector string -- vector )
[ attributes>> "class" swap at = ] with filter ; >lower '[ name>> _ = ] find ;
: find-by-name ( str vector -- vector ) : find-by-id-between ( vector string -- vector' )
[ >lower ] dip [ name>> = ] with filter ; dupd
'[ attributes>> "id" swap at _ = ] find find-between* ;
: find-by-class-between ( vector string -- vector' )
dupd
'[ attributes>> "class" swap at _ = ] find find-between* ;
: find-by-class-id-between ( vector class id -- vector' )
'[
[ attributes>> "class" swap at _ = ]
[ attributes>> "id" swap at _ = ] bi and
] dupd find find-between* ;
: find-by-attribute-key ( key vector -- vector ) : find-by-attribute-key ( vector key -- vector' )
[ >lower ] dip >lower
[ attributes>> at ] with filter [ attributes>> at _ = ] filter sift ;
sift ;
: find-by-attribute-key-value ( value key vector -- vector ) : find-by-attribute-key-value ( vector value key -- vector' )
[ >lower ] dip >lower
[ attributes>> at over = ] with filter nip [ attributes>> at over = ] with filter nip
sift ; sift ;
: find-first-attribute-key-value ( value key vector -- i/f tag/f ) : find-first-attribute-key-value ( vector value key -- i/f tag/f )
[ >lower ] dip >lower
[ attributes>> at over = ] with find rot drop ; [ attributes>> at over = ] with find rot drop ;
: tag-link ( tag -- link/f ) : tag-link ( tag -- link/f )
@ -121,9 +133,9 @@ TUPLE: link attributes clickable ;
swap [ >r first2 r> find-between* ] curry map swap [ >r first2 r> find-between* ] curry map
[ [ name>> { "form" "input" } member? ] filter ] map ; [ [ name>> { "form" "input" } member? ] filter ] map ;
: find-html-objects ( string vector -- vector' ) : find-html-objects ( vector string -- vector' )
[ find-opening-tags-by-name ] keep dupd find-opening-tags-by-name
[ [ first2 ] dip find-between* ] curry map ; [ first2 find-between* ] curry map ;
: form-action ( vector -- string ) : form-action ( vector -- string )
[ name>> "form" = ] find nip [ name>> "form" = ] find nip
@ -150,3 +162,12 @@ TUPLE: link attributes clickable ;
: query>assoc* ( str -- hash ) : query>assoc* ( str -- hash )
"?" split1 nip query>assoc ; "?" split1 nip query>assoc ;
: html-class? ( tag string -- ? )
swap attributes>> "class" swap at = ;
: html-id? ( tag string -- ? )
swap attributes>> "id" swap at = ;
: opening-tag? ( tag -- ? )
closing?>> not ;