9 files changed, 95 insertions(+), 7 deletions(-)

M form.html
M src/Text/HTML/Form/Query.hs
M src/Text/HTML/Form/WebApp.hs
M src/Text/HTML/Form/WebApp/Ginger.hs
M tpl/base.html
A tpl/files.html
A tpl/image-button.html
A tpl/reset.html
A tpl/submit.html

@@ 11,6 11,7 @@
     <label><input type="radio" name="char" value="horatio" />Prof Graw Horatio</label>
     <label><input type="radio" name="char" value="udo" />Udo Malaaki</label>
     <label><input type="radio" name="char" value="elgar" />Magus Elgar</label>
+    <label><input type="file" name="file" />Upload a file!</label>
   </form>
 </body>
 </html>

@@ 18,7 18,7 @@ renderQuery' :: Form -> [(String, String)]
 renderQuery' form = concatMap renderInput' $ inputs form
 renderInput' :: Input -> [(String, String)]
 renderInput' Input { inputType = inputType' }
-    | inputType' `elem` ["submit", "reset", "button"] = []
+    | inputType' `elem` ["submit", "reset", "button", "file"] = []
 renderInput' Input { checked = False, inputType = inputType' }
     | inputType' `elem` ["radio", "checkbox"] = []
 renderInput' Input { inputType = "<select>",

@@ 4,16 4,21 @@ module Text.HTML.Form.WebApp (renderPage, Form(..)) where
 import Data.ByteString as BS
 import Data.Text as Txt
 import Data.Text.Encoding as Txt
+import Data.List as L
 import Text.Read (readMaybe)
 import Network.URI (unEscapeString)
 import System.IO (readFile')
-import System.FilePath ((</>))
-import System.Directory (XdgDirectory(..), getXdgDirectory, doesFileExist)
+import System.FilePath ((</>), normalise)
+import System.Directory (XdgDirectory(..), getXdgDirectory, doesFileExist,
+        doesDirectoryExist, listDirectory, getHomeDirectory)
 
 import Text.HTML.Form (Form(..), Input(..))
-import Text.HTML.Form.WebApp.Ginger (template, resolveSource)
+import Text.HTML.Form.WebApp.Ginger (template, template', resolveSource, list')
 import Text.HTML.Form.Query (renderQueryString, renderQuery')
 
+import Text.Ginger.GVal as V (GVal(..), toGVal, orderedDict, (~>))
+import Text.Ginger.Html (html)
+
 type Query = [(ByteString, Maybe ByteString)]
 renderPage :: Form -> [Text] -> Query -> IO (Maybe (Either Query Text))
 renderPage form (n:path) query


@@ 78,6 83,27 @@ renderInput form ix input@Input { inputType="reset" } [] qs =
 renderInput form ix input@Input { inputType="reset" } ["_"] _ =
     template "reset.html" form ix input
         [(utf8' k, Just $ utf8' v) | (k, v) <- renderQuery' form]
+renderInput form ix input@Input { inputType="file" } path qs = do
+    home <- getHomeDirectory
+    let filepath = normalise $ L.foldl (</>) home $ L.map Txt.unpack path
+    subfiles <- listDirectory filepath
+    (dirs, files) <- partitionM (doesDirectoryExist' filepath) subfiles
+    template' "files.html" form ix input qs $ \x -> case x of
+        "path" -> (list'$L.map buildBreadcrumb$L.inits$L.map Txt.unpack path) {
+            asText = Txt.pack filepath,
+            asHtml = html $ Txt.pack filepath
+          }
+        "files" -> toGVal files
+        "dirs" -> toGVal dirs
+        _ -> toGVal ()
+  where
+    buildBreadcrumb :: [String] -> GVal m
+    buildBreadcrumb [] = toGVal False
+    buildBreadcrumb path' = orderedDict [
+        "name" ~> L.last path',
+        "link" ~> ('/':show ix ++ '/':L.intercalate "/" path')
+      ]
+    doesDirectoryExist' parent file = doesDirectoryExist $ parent </> file
 renderInput form ix input [keyboard] qs =
     renderInput form ix input [keyboard, ""] qs
 renderInput form ix input [keyboard, ""] qs | Just (Just _) <- resolveSource path =


@@ 124,3 150,10 @@ get k' qs
     | Just (Just ret) <- utf8 k' `lookup` qs =
         Txt.unpack $ Txt.decodeUtf8 ret
     | otherwise = ""
+
+partitionM :: Monad f => (a -> f Bool) -> [a] -> f ([a], [a])
+partitionM _ [] = pure ([], [])
+partitionM f (x:xs) = do
+    res <- f x
+    (as,bs) <- partitionM f xs
+    pure ([x | res]++as, [x | not res]++bs)

@@ 1,5 1,5 @@
 {-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
-module Text.HTML.Form.WebApp.Ginger(template, resolveSource) where
+module Text.HTML.Form.WebApp.Ginger(template, template', resolveSource, list') where
 
 import Text.HTML.Form
 import Text.HTML.Form.Query (renderQueryString')


@@ 29,7 29,12 @@ import qualified Data.Map as M
 type Query = [(ByteString, Maybe ByteString)]
 template :: Monad m => String -> Form -> Int -> Input -> Query ->
         m (Maybe (Either Query Text))
-template name form ix input query
+template name form ix input query =
+    template' name form ix input query $ const $ toGVal ()
+template' :: Monad m => String -> Form -> Int -> Input -> Query ->
+        (Text -> GVal (Run SourcePos (Writer Html) Html)) ->
+        m (Maybe (Either Query Text))
+template' name form ix input query ctxt'
     | Just (Right tpl) <- parseGingerFile resolveSource name =
         return $ Just $ Right $ htmlSource $
             flip runGinger tpl $ makeContextHtml ctxt


@@ 44,7 49,7 @@ template name form ix input query
         Prelude.zip [0..] $ inputs form
     ctxt "input" = input2gval (ix, input) query
     ctxt "xURI" = fromFunction xURI
-    ctxt _ = toGVal ()
+    ctxt x = ctxt' x
     xURI [(_, uri)] = let uri' = Txt.unpack $ asText uri in
         return$toGVal$Txt.pack $ escapeURIString isUnescapedInURIComponent uri'
     xURI _ = return $ toGVal ()

@@ 13,6 13,7 @@
     .readonly { font-style: italic }
     .disabled { text-decoration: line-through }
     .selected { border-right: thick solid green }
+    :link { color: white }
 
     input, select, textarea { display: none; }
 

@@ 0,0 1,15 @@
+{% extends "base.html" %}
+
+{%- block main -%}
+  <ul>{% for ancestor in path %}{% if ancestor %}
+    <li><a href="{{ ancestor.link }}">{{ ancestor.name }}</a></li>
+  {% endif %}{% endfor %}</ul>
+  <ul>{% for dir in dirs %}
+    <li><a href="{{ dir }}/">{{ dir }}</a></li>
+  {% endfor %}</ul>
+  <ul>{% for file in files %}
+    <li><a href="/{{ input.index }}/={{ path|xURI }}{{ '/'|xURI }}{{ file|xURI }}">
+      {{ file }}
+    </a></li>
+  {% endfor %}</ul>
+{%- endblock -%}

@@ 0,0 1,15 @@
+{% extends "base.html" %}
+
+{# NOTE: This is pretty much a legacy input type now.
+   We should be sending x/y coordinates to the server,
+   but that'd be frustrating to operate using e.g. a TV remote. #}
+
+{%- block main -%}<section>
+  <img src="{{ input.src }}" alt="{{ input.alt }}" title="{{ input.alt }}" />
+  <div>{{ input.description }}</div>
+  <hr />
+  <!-- TODO: Internationalize! -->
+  <p><a href="_{{Q}}">Upload</a> to
+    <code>{{ input.form.action|default(form.action) }}
+        ({{ input.form.method|default(form.method) }})</code></p>
+</section>{%- endblock -%}

@@ 0,0 1,8 @@
+{% extends "base.html" %}
+
+{%- block main -%}<section>
+  <div>{{ input.description }}</div>
+  <hr />
+  <!-- TODO: Internationalize! -->
+  <p>Restore <a href="_">defaults</a>!</p>
+</section>{%- endblock -%}

@@ 0,0 1,10 @@
+{% extends "base.html" %}
+
+{%- block main -%}<section>
+  <div>{{ input.description }}</div>
+  <hr />
+  <!-- TODO: Internationalize! -->
+  <p><a href="_{{Q}}">Upload</a> to
+    <code>{{ input.form.action|default(form.action) }}
+        ({{ input.form.method|default(form.method) }})</code></p>
+</section>{%- endblock -%}