extra/google/search/search.factor

   1 ! Copyright (C) 2011 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors arrays assocs assocs.extras classes.tuple
   5 colors.constants combinators formatting fry http.client io
   6 io.styles json.reader kernel sequences urls wrap.strings ;
   7
   8 IN: google.search
   9
  10 <PRIVATE
  11
  12 : search-url ( query -- url )
  13     URL" http://ajax.googleapis.com/ajax/services/search/web"
  14         "1.0" "v" set-query-param
  15         swap "q" set-query-param
  16         "8" "rsz" set-query-param
  17         "0" "start" set-query-param ;
  18
  19 : set-slots ( assoc obj -- )
  20     '[ swap _ set-slot-named ] assoc-each ;
  21
  22 : from-slots ( assoc class -- obj )
  23     new [ set-slots ] keep ;
  24
  25 TUPLE: search-result cacheUrl GsearchResultClass visibleUrl
  26 title content unescapedUrl url titleNoFormatting ;
  27
  28 PRIVATE>
  29
  30 : http-search ( query -- results )
  31     search-url http-get nip json>
  32     { "responseData" "results" } deep-at
  33     [ \ search-result from-slots ] map ;
  34
  35 <PRIVATE
  36
  37 : write-heading ( str -- )
  38     H{
  39         { font-size 14 }
  40         { background COLOR: light-gray }
  41     } format nl ;
  42
  43 : write-title ( str -- )
  44     H{
  45         { foreground COLOR: blue }
  46     } format nl ;
  47
  48 : write-content ( str -- )
  49     60 wrap-string print ;
  50
  51 : write-url ( str -- )
  52     dup >url H{
  53         { font-name "monospace" }
  54         { foreground COLOR: dark-green }
  55     } [ write-object ] with-style nl ;
  56
  57 PRIVATE>
  58
  59 : http-search. ( query -- )
  60     [ "Search results for '%s'" sprintf write-heading nl ]
  61     [ http-search ] bi [
  62         {
  63             [ titleNoFormatting>> write-title ]
  64             [ content>> write-content ]
  65             [ unescapedUrl>> write-url ]
  66         } cleave nl
  67     ] each ;