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