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