1 ! Copyright (C) 2012 Doug Coleman.
2 ! See https://factorcode.org/license.txt for BSD license.
4 USING: accessors assocs calendar calendar.format
5 calendar.holidays.us colors combinators concurrency.combinators
6 formatting graphs hashtables http.client io io.styles json
7 json.http kernel make math sequences sets ui ui.theme urls ;
11 CONSTANT: christmas-red COLOR: #bc2c21
12 CONSTANT: christmas-green COLOR: #376627
15 : hacker-news-ids ( endpoint -- ids )
16 "https://hacker-news.firebaseio.com/v0/%s.json?print=pretty" sprintf http-get-json nip ;
18 : hacker-news-id>json-url ( n -- url )
19 "https://hacker-news.firebaseio.com/v0/item/%d.json?print=pretty" sprintf ;
21 : hacker-news-items ( n endpoint -- seq )
22 hacker-news-ids swap index-or-length head
23 [ hacker-news-id>json-url http-get-json ] parallel-map ;
25 : hacker-news-items-timeout ( n endpoint timeout -- seq )
27 hacker-news-ids swap index-or-length head
28 [ hacker-news-id>json-url http-get-json ]
29 ] dip parallel-map-timeout ;
31 : hacker-news-top-stories ( n -- seq )
32 "topstories" hacker-news-items ;
34 : hacker-news-new-stories ( n -- seq )
35 "newstories" hacker-news-items ;
37 : hacker-news-best-stories ( n -- seq )
38 "beststories" hacker-news-items ;
40 : hacker-news-ask-stories ( n -- seq )
41 "askstories" hacker-news-items ;
43 : hacker-news-show-stories ( n -- seq )
44 "showstories" hacker-news-items ;
46 : hacker-news-job-stories ( n -- seq )
47 "jobstories" hacker-news-items ;
49 : christmas-day? ( -- ? )
50 now-utc dup christmas-day same-day? ;
52 : number-color ( n -- color )
54 odd? christmas-red christmas-green ?
59 : background-color ( -- color )
60 christmas-day? COLOR: #bc2c21 COLOR: #ff6600 ? ;
62 : write-number ( n -- )
63 [ "%2d. " sprintf H{ } clone ] keep
64 number-color foreground pick set-at format ;
66 : write-title ( title url -- )
69 ui-running? text-color COLOR: white ? foreground ,,
72 : write-link ( title url -- )
75 COLOR: #888888 foreground ,,
78 : write-text ( str -- )
79 text-color foreground associate format ;
81 : post>user-url ( post -- user-url )
82 "by" of "https://news.ycombinator.com/user?id=" prepend >url ;
84 : post>comments-url ( post -- user-url )
85 "id" of "https://news.ycombinator.com/item?id=%d" sprintf >url ;
87 ! Api is funky, gives id=0 and /comment/2342342 for self-post ads
88 : post>url ( post -- url )
89 dup "url" of "self" = [ post>comments-url ] [ "url" of >url ] if ;
93 : post. ( post index -- )
96 [ [ "title" of ] [ "url" of ] bi write-title ]
97 [ post>url host>> " (" ")" surround write-text nl ]
98 [ "score" of " %d points" sprintf write-text ]
99 [ dup "by" of [ " by " write-text [ "by" of ] [ post>user-url ] bi write-link ] [ drop ] if ]
100 [ "time" of [ " " write-text unix-time>timestamp relative-time write-text ] when* ]
102 dup "descendants" of [
104 [ "descendants" of [ "discuss" ] [ "%d comments" sprintf ] if-zero ]
105 [ post>comments-url ] bi write-link
113 "https://news.ycombinator.com" >url presented associate
117 { foreground COLOR: black }
119 background-color background pick set-at
122 : hacker-news-feed. ( seq -- )
123 [ 1 + post. ] each-index ;
125 : hacker-news. ( str seq -- )
127 [ hacker-news-feed. ] bi* ;
129 : hacker-news-top. ( -- )
131 30 hacker-news-top-stories
134 : hacker-news-new. ( -- )
136 50 hacker-news-new-stories
139 : hacker-news-best. ( -- )
141 50 hacker-news-best-stories
144 : hacker-news-ask. ( -- )
146 50 hacker-news-ask-stories
149 : hacker-news-show. ( -- )
151 50 hacker-news-show-stories
154 : hacker-news-job. ( -- )
156 50 hacker-news-job-stories
159 : filter-comments ( seq -- seq' ) "type" of "comment" = ;
160 : reject-deleted ( seq -- seq' ) [ "deleted" of ] reject ;
162 : closure-with ( vertex quot1: ( key -- vertices ) quot2: ( vertex -- keys ) -- set )
163 over '[ @ [ @ _ map ] closure ] call ; inline
165 : parallel-closure-with ( vertex quot1: ( key -- vertices ) quot2: ( vertex -- edges ) -- set )
166 over '[ @ [ @ _ parallel-map ] closure ] call ; inline
168 ! Yes, there is no api that grabs multiple comments in a single call. (4/17/2023)
169 : hacker-news-comments ( id -- seq )
170 [ hacker-news-id>json-url http-get-json nip ]
171 [ "kids" of ] parallel-closure-with members ;