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 unicode urls ;
   8 IN: webapps.help
   9
  10 TUPLE: help-webapp < dispatcher ;
  11
  12 : links ( apropos -- seq )
  13     [ swap <simple-link> ] { } assoc>map ;
  14
  15 : ?links ( has-links? apropos -- has-links? seq/f )
  16     links [ f ] [ nip t swap ] if-empty ;
  17
  18 :: <search-action> ( help-dir -- action )
  19     <page-action>
  20         { help-webapp "search" } >>template
  21         [
  22             "search" param [ unicode:blank? ] trim [
  23                 dup "search" set-value
  24                 f swap help-dir [
  25                     [ article-apropos ?links "articles" set-value ]
  26                     [ word-apropos ?links "words" set-value ]
  27                     [ vocab-apropos ?links "vocabs" set-value ] tri
  28                 ] with-directory not "empty" set-value
  29             ] unless-empty
  30             help-navbar "navbar" set-value
  31
  32             { help-webapp "search" } <chloe-content>
  33         ] >>display
  34     <boilerplate>
  35         { help-webapp "help" } >>template ;
  36
  37 : help-url ( topic -- url )
  38     topic>filename "$help-webapp/content/" prepend >url ;
  39
  40 : <main-action> ( -- action )
  41     <action>
  42         [ "handbook" >link help-url <redirect> ] >>display ;
  43
  44 :: <help-webapp> ( help-dir -- webapp )
  45     help-webapp new-dispatcher
  46         <main-action> <secure-only> "" add-responder
  47         help-dir <search-action> <secure-only> "search" add-responder
  48         help-dir <static> <secure-only> "content" add-responder ;
  49
  50 : run-help-webapp ( -- )
  51     "docs" cache-file <help-webapp>
  52         main-responder set-global
  53     8080 httpd wait-for-server ;
  54
  55 MAIN: run-help-webapp