1 ! Copyright (C) 2011-2012 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors assocs calendar calendar.format colors
5 combinators formatting fry http.client io io.styles json
6 json.reader kernel make math sequences urls ;
12 TUPLE: page url data before after ;
14 : json-page ( url -- page )
15 >url dup http-get nip json> "data" of {
17 [ "before" of [ f ] when-json-null ]
18 [ "after" of [ f ] when-json-null ]
21 : get-user ( username -- page )
22 "http://api.reddit.com/user/%s" sprintf json-page ;
24 : get-user-info ( username -- user )
25 "http://api.reddit.com/user/%s/about" sprintf
28 : get-url-info ( url -- page )
29 "http://api.reddit.com/api/info?url=%s" sprintf json-page ;
31 : search-reddit ( query -- page )
32 "http://api.reddit.com/search?q=%s" sprintf json-page ;
34 : search-subreddits ( query -- page )
35 "http://api.reddit.com/reddits/search?q=%s" sprintf json-page ;
37 : get-domains ( query -- page )
38 "http://api.reddit.com/domain/%s" sprintf json-page ;
40 : get-subreddit ( subreddit -- page )
41 "http://api.reddit.com/r/%s" sprintf json-page ;
43 : next-page ( page -- page' )
44 [ url>> ] [ after>> "after" set-query-param ] bi json-page ;
46 : all-pages ( page -- data )
48 [ [ data>> , ] [ dup after>> ] bi ]
49 [ next-page ] while drop
54 : user-links ( username -- stories )
55 get-user data>> [ "kind" of "t3" = ] filter
56 [ "data" of "url" of ] map ;
58 : user-comments ( username -- comments )
59 get-user data>> [ "kind" of "t1" = ] filter
60 [ "data" of "body" of ] map ;
62 : user-karma ( username -- karma )
63 get-user-info "data" of "link_karma" of ;
65 : url-score ( url -- score )
66 get-url-info data>> [ "score" of ] map-sum ;
68 : subreddit-links ( subreddit -- links )
69 get-subreddit data>> [ "url" of ] map ;
71 : story>comments-url ( story -- url )
72 "permalink" of "http://reddit.com" prepend >url ;
74 : story>author-url ( story -- url )
75 "author" of "http://reddit.com/user/" prepend >url ;
79 : write-title ( title url -- )
82 COLOR: blue foreground ,,
85 : write-link ( title url -- )
88 COLOR: #888888 foreground ,,
91 : write-text ( str -- )
92 H{ { foreground COLOR: #888888 } } format ;
96 : subreddit. ( subreddit -- )
97 get-subreddit data>> [
98 1 + "%2d. " sprintf write-text "data" of {
99 [ [ "title" of ] [ "url" of ] bi write-title ]
100 [ "domain" of " (%s)\n" sprintf write-text ]
101 [ "score" of " %d points, " sprintf write-text ]
103 [ "num_comments" of "%d comments" sprintf ]
104 [ story>comments-url ] bi write-link
107 "created_utc" of unix-time>timestamp
108 relative-time ", posted " write-text write-text
110 [ " by " write-text [ "author" of ] [ story>author-url ] bi write-link nl nl ]
114 : domain-stats ( domain -- stats )
115 get-domains all-pages [
116 "created" of 1000 * millis>timestamp year>>
117 ] collect-by [ [ "score" of ] map-sum ] assoc-map ;