extra/reddit/reddit.factor

   1 ! Copyright (C) 2011-2012 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors assocs calendar calendar.format colors
   5 combinators formatting http.client io io.styles json
   6 json.reader kernel make math sequences urls ;
   7
   8 IN: reddit
   9
  10 <PRIVATE
  11
  12 TUPLE: page url data before after ;
  13
  14 : json-page ( url -- page )
  15     >url dup http-get nip json> "data" of {
  16         [ "children" of ]
  17         [ "before" of [ f ] when-json-null ]
  18         [ "after" of [ f ] when-json-null ]
  19     } cleave \ page boa ;
  20
  21 : get-user ( username -- page )
  22     "http://api.reddit.com/user/%s" sprintf json-page ;
  23
  24 : get-user-info ( username -- user )
  25     "http://api.reddit.com/user/%s/about" sprintf
  26     http-get nip json> ;
  27
  28 : get-url-info ( url -- page )
  29     "http://api.reddit.com/api/info?url=%s" sprintf json-page ;
  30
  31 : search-reddit ( query -- page )
  32     "http://api.reddit.com/search?q=%s" sprintf json-page ;
  33
  34 : search-subreddits ( query -- page )
  35     "http://api.reddit.com/reddits/search?q=%s" sprintf json-page ;
  36
  37 : get-domains ( query -- page )
  38     "http://api.reddit.com/domain/%s" sprintf json-page ;
  39
  40 : get-subreddit ( subreddit -- page )
  41     "http://api.reddit.com/r/%s" sprintf json-page ;
  42
  43 : next-page ( page -- page' )
  44     [ url>> ] [ after>> "after" set-query-param ] bi json-page ;
  45
  46 : all-pages ( page -- data )
  47     [
  48         [ [ data>> , ] [ dup after>> ] bi ]
  49         [ next-page ] while drop
  50     ] { } make concat ;
  51
  52 PRIVATE>
  53
  54 : user-links ( username -- stories )
  55     get-user data>> [ "kind" of "t3" = ] filter
  56     [ "data" of "url" of ] map ;
  57
  58 : user-comments ( username -- comments )
  59     get-user data>> [ "kind" of "t1" = ] filter
  60     [ "data" of "body" of ] map ;
  61
  62 : user-karma ( username -- karma )
  63     get-user-info "data" of "link_karma" of ;
  64
  65 : url-score ( url -- score )
  66     get-url-info data>> [ "score" of ] map-sum ;
  67
  68 : subreddit-links ( subreddit -- links )
  69     get-subreddit data>> [ "url" of ] map ;
  70
  71 : story>comments-url ( story -- url )
  72     "permalink" of "http://reddit.com" prepend >url ;
  73
  74 : story>author-url ( story -- url )
  75     "author" of "http://reddit.com/user/" prepend >url ;
  76
  77 <PRIVATE
  78
  79 : write-title ( title url -- )
  80     '[
  81         _ presented ,,
  82         COLOR: blue foreground ,,
  83     ] H{ } make format ;
  84
  85 : write-link ( title url -- )
  86     '[
  87         _ presented ,,
  88         COLOR: #888888 foreground ,,
  89     ] H{ } make format ;
  90
  91 : write-text ( str -- )
  92     H{ { foreground COLOR: #888888 } } format ;
  93
  94 PRIVATE>
  95
  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 ]
 102             [
 103                 [ "num_comments" of "%d comments" sprintf ]
 104                 [ story>comments-url ] bi write-link
 105             ]
 106             [
 107                 "created_utc" of unix-time>timestamp
 108                 relative-time ", posted " write-text write-text
 109             ]
 110             [ " by " write-text [ "author" of ] [ story>author-url ] bi write-link nl nl ]
 111         } cleave
 112     ] each-index ;
 113
 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 ;