extra/wikipedia/wikipedia.factor

   1 ! Copyright (C) 2012 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors ascii assocs colors.constants formatting
   5 html.entities html.parser html.parser.analyzer html.parser.printer
   6 http.client io io.styles kernel namespaces sequences splitting urls
   7 wrap.strings xml xml.data xml.traversal ;
   8 FROM: xml.data => tag? ;
   9
  10 IN: wikipedia
  11
  12 SYMBOL: language
  13 "en" language set-global
  14
  15 : with-language ( str quot -- )
  16     language swap with-variable ; inline
  17
  18 <PRIVATE
  19
  20 : wikipedia-url ( path -- url )
  21     language get swap "http://%s.wikipedia.org/wiki/%s" sprintf >url ;
  22
  23 : header. ( string -- )
  24     H{ { font-size 20 } { font-style bold } } format nl ;
  25
  26 : link ( tag -- tag/f )
  27     "a" assure-name over tag-named? [ "a" deep-tag-named ] unless ;
  28
  29 : link. ( tag -- )
  30     [ deep-children>string ] [ attrs>> "href" of ] bi
  31     wikipedia-url H{
  32         { font-name "monospace" }
  33         { foreground COLOR: blue }
  34     } [ write-object ] with-style ;
  35
  36 : item. ( tag -- )
  37     children>> [
  38         dup tag? [
  39             dup link [ link. drop ] [ children>string write ] if*
  40         ] [ [ write ] unless-empty ] if
  41     ] each nl ;
  42
  43 : items. ( seq -- )
  44     children-tags [ item. ] each nl ;
  45
  46 : historical-url ( timestamp -- url )
  47     "%B_%d" strftime wikipedia-url ;
  48
  49 : (historical-events) ( timestamp -- seq )
  50     historical-url http-get nip string>xml "ul" deep-tags-named ;
  51
  52 : items>sequence ( tag -- seq )
  53     children-tags [ deep-children>string ] map ;
  54
  55 PRIVATE>
  56
  57 : historical-events ( timestamp -- events )
  58     (historical-events) second items>sequence ;
  59
  60 : historical-events. ( timestamp -- )
  61     (historical-events) "Events" header. second items. ;
  62
  63 : historical-births ( timestamp -- births )
  64     (historical-events) third items>sequence ;
  65
  66 : historical-births. ( timestamp -- )
  67     (historical-events) "Births" header. third items. ;
  68
  69 : historical-deaths ( timestamp -- births )
  70     (historical-events) fourth items>sequence ;
  71
  72 : historical-deaths. ( timestamp -- )
  73     (historical-events) "Deaths" header. fourth items. ;
  74
  75 : article. ( name -- )
  76     wikipedia-url http-get nip parse-html
  77     "content" find-by-id-between
  78     html-text string-lines
  79     [ [ blank? ] trim ] map harvest [
  80         html-unescape 72 wrap-string print nl
  81     ] each ;