extra/hacker-news/hacker-news.factor

   1 ! Copyright (C) 2012 Doug Coleman.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3
   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 ;
   8
   9 IN: hacker-news
  10
  11 CONSTANT: christmas-red COLOR: #bc2c21
  12 CONSTANT: christmas-green COLOR: #376627
  13
  14 <PRIVATE
  15 : hacker-news-ids ( endpoint -- ids )
  16     "https://hacker-news.firebaseio.com/v0/%s.json?print=pretty" sprintf http-get-json nip ;
  17
  18 : hacker-news-id>json-url ( n -- url )
  19     "https://hacker-news.firebaseio.com/v0/item/%d.json?print=pretty" sprintf ;
  20
  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 ;
  24
  25 : hacker-news-items-timeout ( n endpoint timeout -- seq )
  26     [
  27         hacker-news-ids swap index-or-length head
  28         [ hacker-news-id>json-url http-get-json ]
  29     ] dip parallel-map-timeout ;
  30
  31 : hacker-news-top-stories ( n -- seq )
  32     "topstories" hacker-news-items ;
  33
  34 : hacker-news-new-stories ( n -- seq )
  35     "newstories" hacker-news-items ;
  36
  37 : hacker-news-best-stories ( n -- seq )
  38     "beststories" hacker-news-items ;
  39
  40 : hacker-news-ask-stories ( n -- seq )
  41     "askstories" hacker-news-items ;
  42
  43 : hacker-news-show-stories ( n -- seq )
  44     "showstories" hacker-news-items ;
  45
  46 : hacker-news-job-stories ( n -- seq )
  47     "jobstories" hacker-news-items ;
  48
  49 : christmas-day? ( -- ? )
  50     now-utc dup christmas-day same-day? ;
  51
  52 : number-color ( n -- color )
  53     christmas-day? [
  54         odd? christmas-red christmas-green ?
  55     ] [
  56         drop COLOR: #a0a0a0
  57     ] if ;
  58
  59 : background-color ( -- color )
  60     christmas-day? COLOR: #bc2c21 COLOR: #ff6600 ? ;
  61
  62 : write-number ( n -- )
  63     [ "%2d. " sprintf H{ } clone ] keep
  64     number-color foreground pick set-at format ;
  65
  66 : write-title ( title url -- )
  67     '[
  68         _ presented ,,
  69         ui-running? text-color COLOR: white ? foreground ,,
  70     ] H{ } make format ;
  71
  72 : write-link ( title url -- )
  73     '[
  74         _ presented ,,
  75         COLOR: #888888 foreground ,,
  76     ] H{ } make format ;
  77
  78 : write-text ( str -- )
  79     text-color foreground associate format ;
  80
  81 : post>user-url ( post -- user-url )
  82     "by" of "https://news.ycombinator.com/user?id=" prepend >url ;
  83
  84 : post>comments-url ( post -- user-url )
  85     "id" of "https://news.ycombinator.com/item?id=%d" sprintf >url ;
  86
  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 ;
  90
  91 PRIVATE>
  92
  93 : post. ( post index -- )
  94     write-number
  95     {
  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* ]
 101         [
 102             dup "descendants" of [
 103                 " | " write-text
 104                 [ "descendants" of [ "discuss" ] [ "%d comments" sprintf ] if-zero ]
 105                 [ post>comments-url ] bi write-link
 106             ] [
 107                 drop
 108             ] if nl nl
 109         ]
 110     } cleave ;
 111
 112 : banner. ( str -- )
 113     "https://news.ycombinator.com" >url presented associate
 114     H{
 115         { font-size 20 }
 116         { font-style bold }
 117         { foreground COLOR: black }
 118     } assoc-union
 119     background-color background pick set-at
 120     format nl ;
 121
 122 : hacker-news-feed. ( seq -- )
 123     [ 1 + post. ] each-index ;
 124
 125 : hacker-news. ( str seq -- )
 126     [ banner. ]
 127     [ hacker-news-feed. ] bi* ;
 128
 129 : hacker-news-top. ( -- )
 130     "Hacker News - Top"
 131     30 hacker-news-top-stories
 132     hacker-news. ;
 133
 134 : hacker-news-new. ( -- )
 135     "Hacker News - New"
 136     50 hacker-news-new-stories
 137     hacker-news. ;
 138
 139 : hacker-news-best. ( -- )
 140     "Hacker News - Best"
 141     50 hacker-news-best-stories
 142     hacker-news. ;
 143
 144 : hacker-news-ask. ( -- )
 145     "Hacker News - Ask"
 146     50 hacker-news-ask-stories
 147     hacker-news. ;
 148
 149 : hacker-news-show. ( -- )
 150     "Hacker News - Show"
 151     50 hacker-news-show-stories
 152     hacker-news. ;
 153
 154 : hacker-news-job. ( -- )
 155     "Hacker News - Job"
 156     50 hacker-news-job-stories
 157     hacker-news. ;
 158
 159 : filter-comments ( seq -- seq' ) "type" of "comment" = ;
 160 : reject-deleted ( seq -- seq' ) [ "deleted" of ] reject ;
 161
 162 : closure-with ( vertex quot1: ( key -- vertices ) quot2: ( vertex -- keys ) -- set )
 163     over '[ @ [ @ _ map ] closure ] call ; inline
 164
 165 : parallel-closure-with ( vertex quot1: ( key -- vertices ) quot2: ( vertex -- edges ) -- set )
 166     over '[ @ [ @ _ parallel-map ] closure ] call ; inline
 167
 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 ;