http.server.static: look for index.fhtml when fhtml is enabled

basis/http/http-tests.factor

@@ -235,6 +235,13 @@ test-db [
         servers>> random addr>> port>>
     ] with-scope "port" set ;
 
+: add-port ( url -- url' )
+    >url clone "port" get >>port ;
+
+: stop-test-httpd ( -- )
+    "http://localhost/quit" add-port http-get nip
+    "Goodbye" assert= ;
+
 [ ] [
     <dispatcher>
         add-quit-action
@@ -248,9 +255,6 @@ test-db [
     test-httpd
 ] unit-test
 
-: add-port ( url -- url' )
-    >url clone "port" get >>port ;
-
 [ t ] [
     "vocab:http/test/foo.html" ascii file-contents
     "http://localhost/nested/foo.html" add-port http-get nip =
@@ -279,7 +283,7 @@ test-db [
 
 
 [ ] [
-    [ "http://localhost/quit" add-port http-get 2drop ] ignore-errors
+    [ stop-test-httpd ] ignore-errors
 ] unit-test
 
 ! Dispatcher bugs
@@ -402,7 +406,7 @@ SYMBOL: a
     "vocab:http/test/foo.html" ascii file-contents =
 ] unit-test
 
-[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
+[ ] [ stop-test-httpd ] unit-test
 
 ! Check behavior of 307 redirect (reported by Chris Double)
 [ ] [
@@ -429,4 +433,16 @@ SYMBOL: a
     ] with-directory
 ] must-fail
 
-[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
+[ ] [ stop-test-httpd ] unit-test
+
+! Check that index.fhtml works
+[ ] [
+    <dispatcher>
+        "resource:basis/http/test/" <static> enable-fhtml >>default
+        add-quit-action
+    test-httpd
+] unit-test
+
+[ "OK\n\n" ] [ "http://localhost/" add-port http-get nip ] unit-test
+
+[ ] [ stop-test-httpd ] unit-test

basis/http/server/static/static.factor

@@ -7,9 +7,10 @@ io.files.info io.directories io.pathnames io.encodings.binary
 fry xml.entities destructors urls html xml.syntax
 html.templates.fhtml http http.server http.server.responses
 http.server.redirection xml.writer ;
+FROM: sets => adjoin ;
 IN: http.server.static
 
-TUPLE: file-responder root hook special allow-listings ;
+TUPLE: file-responder root hook special index-names allow-listings ;
 
 : modified-since ( request -- date )
     "if-modified-since" header ";" split1 drop
@@ -23,7 +24,8 @@ TUPLE: file-responder root hook special allow-listings ;
     file-responder new
         swap >>hook
         swap >>root
-        H{ } clone >>special ;
+        H{ } clone >>special
+        V{ "index.html" } >>index-names ;
 
 : (serve-static) ( path mime-type -- response )
     [
@@ -75,7 +77,9 @@ TUPLE: file-responder root hook special allow-listings ;
     ] if ;
 
 : find-index ( filename -- path )
-    "index.html" append-path dup exists? [ drop f ] unless ;
+    file-responder get index-names>>
+    [ append-path dup exists? [ drop f ] unless ] with map-find
+    drop ;
 
 : serve-directory ( filename -- response )
     url get path>> "/" tail? [
@@ -97,8 +101,12 @@ M: file-responder call-responder* ( path responder -- response )
     ".." over member?
     [ drop <400> ] [ "/" join serve-object ] if ;
 
-! file responder integration
+: add-index ( name responder -- )
+    index-names>> adjoin ;
+
+: serve-fhtml ( path -- response )
+    <fhtml> "text/html" <content> ;
+
 : enable-fhtml ( responder -- responder )
-    [ <fhtml> "text/html" <content> ]
+    [ serve-fhtml ] "application/x-factor-server-page" pick special>> set-at
-    "application/x-factor-server-page"
+    "index.fhtml" over add-index ;
-    pick special>> set-at ;

basis/http/test/index.fhtml

@@ -0,0 +1 @@
+<% USE: io "OK" write %>