extra/bit/ly/ly.factor

   1 ! Copyright (C) 2010-2012 Slava Pestov, John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs http.client json.reader kernel namespaces
   4 sequences urls ;
   5 IN: bit.ly
   6
   7 SYMBOLS: bitly-api-user bitly-api-key ;
   8
   9 <PRIVATE
  10
  11 : <bitly-url> ( path -- url )
  12     "http://api.bitly.com/v3/" prepend >url
  13         bitly-api-user get "login" set-query-param
  14         bitly-api-key get "apiKey" set-query-param
  15         "json" "format" set-query-param ;
  16
  17 ERROR: bad-response json status ;
  18
  19 : check-status ( json -- json )
  20     dup "status_code" of 200 = [
  21         dup "status_txt" of
  22         bad-response
  23     ] unless ;
  24
  25 : json-data ( url -- json )
  26     http-get nip json> check-status "data" of ;
  27
  28 : get-short-url ( short-url path -- data )
  29     <bitly-url> swap "shortUrl" set-query-param json-data ;
  30
  31 : get-long-url ( long-url path -- data )
  32     <bitly-url> swap "longUrl" set-query-param json-data ;
  33
  34 PRIVATE>
  35
  36 : shorten-url ( long-url -- short-url )
  37     "shorten" get-long-url "url" of ;
  38
  39 : expand-url ( short-url -- url )
  40     "expand" get-short-url "expand" of first "long_url" of ;
  41
  42 : valid-user? ( user api-key -- ? )
  43     "validate" <bitly-url>
  44         swap "x_apiKey" set-query-param
  45         swap "x_login" set-query-param
  46     json-data "valid" of 1 = ;
  47
  48 : clicks ( short-url -- clicks )
  49     "clicks" get-short-url "clicks" of first "global_clicks" of ;
  50
  51 : referrers ( short-url -- referrers )
  52     "referrers" get-short-url "referrers" of ;
  53
  54 : countries ( short-url -- countries )
  55     "countries" get-short-url "countries" of ;
  56
  57 : clicks-by-minute ( short-url -- clicks )
  58     "clicks_by_minute" get-short-url "clicks_by_minute" of ;
  59
  60 : clicks-by-day ( short-url -- clicks )
  61     "clicks_by_day" get-short-url "clicks_by_day" of ;
  62
  63 : lookup ( long-urls -- short-urls )
  64     "lookup" <bitly-url>
  65         swap "url" set-query-param
  66     json-data "lookup" of [ "short_url" of ] map ;
  67
  68 : info ( short-url -- title )
  69     "info" get-short-url "info" of first "title" of ;