Пищеварительные функторы: поле для загрузки нескольких файлов?

Question

Я пытаюсь воссоздать довольно стандартную функцию загрузки изображений / файлов, при которой данное поле позволяет загружать один или несколько файлов / изображений с помощью чего-то вроде кнопки "добавить другой файл" и / или возможности замены существующих файлов.

У меня работает загрузка файлов, и у меня работает несколько подчиненных форм, но я не могу получить несколько подчиненных, работающих с вводом файлов.

Я создал пример (показанный ниже), в значительной степени основанный на examples / dynamic-list.hs, который подчеркивает проблему, которая заключается в том, что postForm возвращает соответствующий FilePath в представлении, но не возвращает его в "результате".

Другая проблема с dynamic-list.hs заключается в том, что он показывает только тривиальный вариант использования статических данных. Наличие реальной динамической формы, в которой данные изменяются в ответ на пользовательский ввод, значительно сложнее, поэтому я надеюсь, что смогу разработать более полную версию dynamic-list.hs, которая была бы (намного) более полезной для начинающих.

Мой код до сих пор:

{-# LANGUAGE OverloadedStrings, PackageImports, TupleSections, ScopedTypeVariables, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}

module Handler.Test where

import           Prelude hiding (div, span)
import           Control.Applicative
import           Control.Monad
import           Control.Monad.Trans

import           Data.Maybe
import           Data.Text hiding (unlines, intercalate, concat)
import           Data.Text.Encoding

import           Snap.Core hiding (method)
import           Snap.Snaplet

------------------------------------------------------------------------------
import           Heist.Splices.Html
import           Text.Digestive
import           Text.Digestive.Snap 
import           Text.Digestive.Heist
import           Text.Blaze.Html5 as H
import           Text.Digestive.Blaze.Html5 as DH
import qualified Text.Blaze.Html5.Attributes as A
import           Text.Digestive.Form
import           Text.Digestive.Util

import           Text.Blaze.Renderer.XmlHtml

import Data.List as L
------------------------------------------------------------------------------
import Application

import Helpers.Forms
import Helpers.Theme
import Debug.Trace
------------------------------------------------------------------------------

handleEntityTest :: Handler App App ()
handleEntityTest = undefined

type Product = Text
type Quantity = Int
--------------------------------------------------------------------------------
data Order = Order {
    orderName  :: Text
  , orderItems :: [OrderItem]
} deriving (Show)

data OrderItem = OrderItem
  { orderProduct :: Text
  , orderQuantity :: Quantity
  , orderFile :: Maybe FilePath
  } deriving (Show)
--------------------------------------------------------------------------------

orderForm :: Monad m => Order -> Form Html m Order
orderForm order = Order 
  <$> "orderName" .: text (Just $ orderName order)
  <*> "orderItems" .: listOf orderItemForm (Just $ orderItems order)

orderItemForm :: Monad m => Formlet Html m OrderItem
orderItemForm def = OrderItem
  <$> "product" .: text (orderProduct <$> def)
  <*> "quantity" .: stringRead "Can't parse quantity" (orderQuantity <$> def)
  <*> "file" .: file
--------------------------------------------------------------------------------
orderView :: View H.Html -> H.Html
orderView view = do
  DH.form view "" $ do
    DH.label "name" view "Order name: "
    DH.inputText "orderName" view
    H.br    
    DH.label "orderItems.indices" view "(Usually hidden) Indices: "
    DH.inputText "orderItems.indices" view
    H.br
    mapM_ orderItemView $ listSubViews "orderItems" view
    H.br
    DH.inputSubmit "Submit"     

orderItemView :: View H.Html -> H.Html
orderItemView view = do
  childErrorList "" view
  DH.label "product" view "Product: "
  DH.inputText "product" view
  H.br
  DH.label "quantity" view "Quantity: "
  DH.inputText "quantity" view
  H.br
  DH.label "file" view "file"
  DH.inputFile "file" view  
  H.br
-------------------------------------------------------

handleTest :: Handler App App ()
handleTest = do
  r <- runFormWith defaultFormConfig "test" $ orderForm $ Order "test form" [(OrderItem "" 0 Nothing)]
  case r of
    (view, Nothing) -> do
      -- GET
      renderPageHtml "Initial form view" $ toHtml $ orderView $ debugForm view
      -- POST  
    (view, Just order) -> do
      s <- runFormWith (defaultFormConfig { method = Just Get }) "test" $ orderForm $ order {orderItems = ((orderItems order) ++ [(OrderItem "" 0 Nothing)]) }
      case s of 
        (view', Nothing) -> do
          renderPageHtml "Subsequent form view" $ html 
            where 
              html = do
                p $ do 
                  mapM_ div [ br, br, br
                     , orderView $ debugForm view'
                     , toHtml $ show order
                    ]
        (view', Just order) -> do
          renderPageHtml "Subsequent form view" $ p "This shouldn't ever happen"

------------------------------------------------------------
debugForm :: View Html -> View Html
debugForm v = trace (t) v
  where 
    showTuple (path,input) = ("path : " ++ (show path) ++ "=" ++ (show input))
    t = unlines $ [
          (""), ("")
        , ("viewName : " ++ (unpack $ viewName v)  )
        , ("viewMethod : " ++ (show $ viewMethod v)  )
        , ("viewContext : " ++ (show $ viewContext v)  )
        --, ("viewInput : " ++ (unlines $ fmap (\(path, input) -> (show path) ++ "=" ++ (show input) ) $ viewInput v  ))
        , ("viewInput : " ++ (unlines $ fmap showTuple $ viewInput v  ))
        , ("debugViews : " ++ (unlines $ fmap show $ debugViewPaths v) )
      ]