webapps.help: tokenize and collapse search terms

[factor.git] / extra / webapps / help / help.factor

diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor
index 17d3d361c652a8f1180ae8efe83ee33cd9ed1e13..faa1b11a5a511488b4e58ddcea7e9f836fc8c3fe 100644 (file)
--- a/extra/webapps/help/help.factor
+++ b/extra/webapps/help/help.factor
@@ -1,51 +1,66 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors db.sqlite furnace.actions furnace.alloy kernel
-http.server.dispatchers http.server.static furnace.redirection
-urls validators locals io.files io.directories help.html
-html.forms html.components http.server namespaces ;
+USING: accessors assocs furnace.actions furnace.boilerplate
+furnace.redirection help.html help.topics html.components
+html.forms http.server http.server.dispatchers
+http.server.static io.directories io.files.temp io.servers
+kernel namespaces sequences simple-tokenizer splitting unicode
+urls ;
 IN: webapps.help
 
 TUPLE: help-webapp < dispatcher ;
 
-M: result link-title title>> ;
+: fixup-words ( title href -- title' href' )
+    dup "word-" head? [
+        dup ".html" ?tail drop "," split1-last nip dup ":" append
+        '[ " (" _ 3append ")" append _ ?head drop ] dip
+    ] when ;
 
-M: result link-href href>> ;
+: links ( apropos -- seq )
+    [ swap fixup-words <simple-link> ] { } assoc>map ;
+
+: ?links ( has-links? apropos -- has-links? seq/f )
+    links [ f ] [ nip t swap ] if-empty ;
+
+: ?tokenize ( str -- str' )
+    [ tokenize ] [ drop 1array ] recover ;
 
 :: <search-action> ( help-dir -- action )
     <page-action>
         { help-webapp "search" } >>template
-
         [
-            {
-                { "search" [ 1 v-min-length 50 v-max-length v-one-line ] }
-            } validate-params
-
-            help-dir [
-                "search" value article-apropos "articles" set-value
-                "search" value word-apropos "words" set-value
-                "search" value vocab-apropos "vocabs" set-value
-            ] with-directory
+            f "search" param [ unicode:blank? ] trim
+            dup "search" set-value [
+                help-dir [
+                    ?tokenize concat
+                    [ article-apropos ?links "articles" set-value ]
+                    [ word-apropos ?links "words" set-value ]
+                    [ vocab-apropos ?links "vocabs" set-value ] tri
+                ] with-directory
+            ] unless-empty not "empty" set-value
+            help-nav "nav" set-value
 
             { help-webapp "search" } <chloe-content>
-        ] >>submit ;
+        ] >>display
+    <boilerplate>
+        { help-webapp "help" } >>template ;
+
+: help-url ( topic -- url )
+    topic>filename "$help-webapp/content/" prepend >url ;
 
 : <main-action> ( -- action )
-    <page-action>
-        { help-webapp "help" } >>template ;
+    <action>
+        [ "handbook" >link help-url <redirect> ] >>display ;
 
-:: <help-webapp> ( help-dir help-db -- webapp )
+:: <help-webapp> ( help-dir -- webapp )
     help-webapp new-dispatcher
-        <main-action> "" add-responder
-        help-dir <search-action> help-db [ <alloy> ] when* "search" add-responder
-        help-dir <static> "content" add-responder
-        "resource:basis/definitions/icons/" <static> "icons" add-responder ;
+        <main-action> <secure-only> "" add-responder
+        help-dir <search-action> <secure-only> "search" add-responder
+        help-dir <static> <secure-only> "content" add-responder ;
 
 : run-help-webapp ( -- )
-    "resource:temp/docs"
-    "resource:help.db" <sqlite-db>
-    <help-webapp>
+    "docs" cache-file <help-webapp>
         main-responder set-global
-    8080 httpd drop ;
+    8080 httpd wait-for-server ;
 
 MAIN: run-help-webapp