html.parser.analyzer: cleanup, fix find-by-class-id-between.

db4
John Benediktsson 2014-02-17 15:17:24 -08:00
parent 3c53214b43
commit 6ecb291710
1 changed files with 17 additions and 35 deletions

View File

@ -10,13 +10,13 @@ IN: html.parser.analyzer
http-get parse-html ; http-get parse-html ;
: attribute ( tag string -- obj/f ) : attribute ( tag string -- obj/f )
swap attributes>> [ at ] [ drop f ] if* ; swap attributes>> at ;
: attribute* ( tag string -- obj ? ) : attribute* ( tag string -- obj ? )
swap attributes>> [ at* ] [ drop f f ] if* ; swap attributes>> at* ;
: attribute? ( tag string -- obj ) : attribute? ( tag string -- ? )
swap attributes>> [ key? ] [ drop f ] if* ; swap attributes>> key? ;
: find-all ( seq quot -- alist ) : find-all ( seq quot -- alist )
[ <enum> >alist ] [ '[ second @ ] ] bi* filter ; inline [ <enum> >alist ] [ '[ second @ ] ] bi* filter ; inline
@ -99,7 +99,7 @@ ERROR: undefined-find-nth m n seq quot ;
] map ; ] map ;
: find-by-id ( vector id -- vector' elt/f ) : find-by-id ( vector id -- vector' elt/f )
'[ "id" attribute _ = ] find ; '[ _ html-id? ] find ;
: find-by-class ( vector id -- vector' elt/f ) : find-by-class ( vector id -- vector' elt/f )
'[ _ html-class? ] find ; '[ _ html-class? ] find ;
@ -108,49 +108,32 @@ ERROR: undefined-find-nth m n seq quot ;
>lower '[ name>> _ = ] find ; >lower '[ name>> _ = ] find ;
: find-by-id-between ( vector string -- vector' ) : find-by-id-between ( vector string -- vector' )
dupd '[ _ html-id? ] dupd find find-between* ;
'[ "id" attribute _ = ] find find-between* ;
: find-by-class-between ( vector string -- vector' ) : find-by-class-between ( vector string -- vector' )
dupd '[ _ html-class? ] dupd find find-between* ;
'[ _ html-class? ] find find-between* ;
: find-by-class-id-between ( vector class id -- vector' ) : find-by-class-id-between ( vector class id -- vector' )
[
'[ '[
[ _ html-class? ] [ _ html-class? ] [ _ html-id? ] bi and
[ "id" attribute _ = ] bi and ] dupd find find-between* ;
] find
] [
2drop find-between*
] 3bi ;
: find-by-attribute-key ( vector key -- vector' elt/? ) : find-by-attribute-key ( vector key -- vector' )
>lower >lower '[ _ attribute? ] filter sift ;
[ attributes>> at _ = ] filter sift ;
: find-by-attribute-key-value ( vector value key -- vector' ) : find-by-attribute-key-value ( vector value key -- vector' )
>lower >lower swap '[ _ attribute _ = ] filter sift ;
[ attributes>> at over = ] with filter nip sift ;
: find-first-attribute-key-value ( vector value key -- i/f tag/f ) : find-first-attribute-key-value ( vector value key -- i/f tag/f )
>lower >lower swap '[ _ attribute _ = ] find ;
[ attributes>> at over = ] with find rot drop ;
: tag-link ( tag -- link/f ) "href" attribute ;
: find-links ( vector -- vector' ) : find-links ( vector -- vector' )
[ { [ name>> "a" = ] [ "href" attribute ] } 1&& ] [ { [ name>> "a" = ] [ "href" attribute ] } 1&& ]
find-between-all ; find-between-all ;
: find-images ( vector -- vector' ) : find-images ( vector -- vector' )
[ [ { [ name>> "img" = ] [ "src" attribute ] } 1&& ] filter sift
{ [ "src" attribute ] map ;
[ name>> "img" = ]
[ "src" attribute ]
} 1&&
] find-all
values [ "src" attribute ] map ;
: find-by-text ( seq quot -- tag ) : find-by-text ( seq quot -- tag )
[ dup name>> text = ] prepose find drop ; inline [ dup name>> text = ] prepose find drop ; inline
@ -192,8 +175,7 @@ ERROR: undefined-find-nth m n seq quot ;
[ "type" attribute "hidden" = ] filter ; [ "type" attribute "hidden" = ] filter ;
: input. ( tag -- ) : input. ( tag -- )
dup name>> print [ name>> print ] [ attributes>> ] bi
attributes>>
[ bl bl bl bl [ write "=" write ] [ write bl ] bi* nl ] assoc-each ; [ bl bl bl bl [ write "=" write ] [ write bl ] bi* nl ] assoc-each ;
: form. ( vector -- ) : form. ( vector -- )