1 USING: assocs html.parser kernel math sequences strings ascii
2 arrays generalizations shuffle unicode.case namespaces splitting
3 http sequences.lib accessors io combinators http.client urls ;
4 IN: html.parser.analyzer
6 TUPLE: link attributes clickable ;
8 : scrape-html ( url -- vector )
9 http-get nip parse-html ;
12 [ >r + dup r> ?nth* [ 2drop f f ] unless ] [ 2drop f ] if ; inline
14 : find-relative ( seq quot n -- i elt )
15 >r over [ find drop ] dip r> swap pick
16 (find-relative) ; inline
18 : (find-all) ( n seq quot -- )
19 2dup >r >r find-from [
20 dupd 2array , 1+ r> r> (find-all)
25 : find-all ( seq quot -- alist )
26 [ 0 -rot (find-all) ] { } make ; inline
28 : (find-nth) ( offset seq quot n count -- obj )
29 >r >r [ find-from ] 2keep 4 npick [
33 >r >r >r >r drop 1+ r> r> r> r>
40 : find-nth ( seq quot n -- i elt )
41 0 -roll 0 (find-nth) ; inline
43 : find-nth-relative ( seq quot n offest -- i elt )
44 >r [ find-nth ] 3keep 2drop nip r> swap pick
45 (find-relative) ; inline
47 : remove-blank-text ( vector -- vector' )
50 text>> [ blank? ] all? not
56 : trim-text ( vector -- vector' )
59 [ [ blank? ] trim ] change-text
63 : find-by-id ( id vector -- vector )
64 [ attributes>> "id" swap at = ] with filter ;
66 : find-by-class ( id vector -- vector )
67 [ attributes>> "class" swap at = ] with filter ;
69 : find-by-name ( str vector -- vector )
71 [ name>> = ] with filter ;
73 : find-first-name ( str vector -- i/f tag/f )
75 [ name>> = ] with find ;
77 : find-matching-close ( str vector -- i/f tag/f )
79 [ [ name>> = ] keep closing?>> and ] with find ;
81 : find-by-attribute-key ( key vector -- vector )
83 [ attributes>> at ] with filter
86 : find-by-attribute-key-value ( value key vector -- vector )
88 [ attributes>> at over = ] with filter nip
91 : find-first-attribute-key-value ( value key vector -- i/f tag/f )
93 [ attributes>> at over = ] with find rot drop ;
95 : find-between* ( i/f tag/f vector -- vector )
99 [ find-matching-close drop dup [ 1+ ] when ] keep
100 swap [ head ] [ first ] if*
105 : find-between ( i/f tag/f vector -- vector )
106 find-between* dup length 3 >= [
107 [ rest-slice but-last-slice ] keep like
110 : find-between-first ( string vector -- vector' )
111 [ find-first-name ] keep find-between ;
113 : find-between-all ( vector quot -- seq )
114 [ [ [ closing?>> not ] bi and ] curry find-all ] curry
115 [ [ >r first2 r> find-between* ] curry map ] bi ;
117 : tag-link ( tag -- link/f )
118 attributes>> [ "href" swap at ] [ f ] if* ;
120 : find-links ( vector -- vector' )
121 [ [ name>> "a" = ] [ attributes>> "href" swap at ] bi and ]
124 : <link> ( vector -- link )
125 [ first attributes>> ]
126 [ [ name>> { text "img" } member? ] filter ] bi
129 : link. ( vector -- )
130 [ attributes>> "href" swap at write nl ]
131 [ clickable>> [ bl bl text>> print ] each nl ] bi ;
133 : find-by-text ( seq quot -- tag )
134 [ dup name>> text = ] prepose find drop ;
136 : find-opening-tags-by-name ( name seq -- seq )
137 [ [ name>> = ] keep closing?>> not and ] with find-all ;
139 : href-contains? ( str tag -- ? )
140 attributes>> "href" swap at* [ subseq? ] [ 2drop f ] if ;
142 : find-hrefs ( vector -- vector' )
146 [ attributes>> "href" swap key? ] bi and ] filter
147 ] map sift [ [ attributes>> "href" swap at ] map ] map concat ;
149 : find-forms ( vector -- vector' )
150 "form" over find-opening-tags-by-name
151 swap [ >r first2 r> find-between* ] curry map
152 [ [ name>> { "form" "input" } member? ] filter ] map ;
154 : find-html-objects ( string vector -- vector' )
155 [ find-opening-tags-by-name ] keep
156 [ >r first2 r> find-between* ] curry map ;
158 : form-action ( vector -- string )
159 [ name>> "form" = ] find nip
160 attributes>> "action" swap at ;
162 : hidden-form-values ( vector -- strings )
163 [ attributes>> "type" swap at "hidden" = ] filter ;
168 [ bl bl bl bl [ write "=" write ] [ write bl ] bi* nl ] assoc-each ;
170 : form. ( vector -- )
171 [ closing?>> not ] filter
174 { [ dup name>> "form" = ]
175 [ "form action: " write attributes>> "action" swap at print ] }
176 { [ dup name>> "input" = ] [ input. ] }
181 : query>assoc* ( str -- hash )
182 "?" split1 nip query>assoc ;