extra/webapps/help/help.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs furnace.actions furnace.boilerplate
   4 furnace.redirection help.html help.topics html.components
   5 html.forms http.server http.server.dispatchers
   6 http.server.static io.directories io.files.temp io.servers
   7 kernel namespaces sequences simple-tokenizer splitting unicode
   8 urls ;
   9 IN: webapps.help
  10
  11 TUPLE: help-webapp < dispatcher ;
  12
  13 : fixup-words ( title href -- title' href' )
  14     dup "word-" head? [
  15         dup ".html" ?tail drop "," split1-last nip dup ":" append
  16         '[ " (" _ 3append ")" append _ ?head drop ] dip
  17     ] when ;
  18
  19 : links ( apropos -- seq )
  20     [ swap fixup-words <simple-link> ] { } assoc>map ;
  21
  22 : ?links ( has-links? apropos -- has-links? seq/f )
  23     links [ f ] [ nip t swap ] if-empty ;
  24
  25 : ?tokenize ( str -- str' )
  26     [ tokenize ] [ drop 1array ] recover ;
  27
  28 :: <search-action> ( help-dir -- action )
  29     <page-action>
  30         { help-webapp "search" } >>template
  31         [
  32             f "search" param [ unicode:blank? ] trim
  33             dup "search" set-value [
  34                 help-dir [
  35                     ?tokenize concat
  36                     [ article-apropos ?links "articles" set-value ]
  37                     [ word-apropos ?links "words" set-value ]
  38                     [ vocab-apropos ?links "vocabs" set-value ] tri
  39                 ] with-directory
  40             ] unless-empty not "empty" set-value
  41             help-nav "nav" set-value
  42
  43             { help-webapp "search" } <chloe-content>
  44         ] >>display
  45     <boilerplate>
  46         { help-webapp "help" } >>template ;
  47
  48 : help-url ( topic -- url )
  49     topic>filename "$help-webapp/content/" prepend >url ;
  50
  51 : <main-action> ( -- action )
  52     <action>
  53         [ "handbook" >link help-url <redirect> ] >>display ;
  54
  55 :: <help-webapp> ( help-dir -- webapp )
  56     help-webapp new-dispatcher
  57         <main-action> <secure-only> "" add-responder
  58         help-dir <search-action> <secure-only> "search" add-responder
  59         help-dir <static> <secure-only> "content" add-responder ;
  60
  61 : run-help-webapp ( -- )
  62     "docs" cache-file <help-webapp>
  63         main-responder set-global
  64     8080 httpd wait-for-server ;
  65
  66 MAIN: run-help-webapp