3

かなり標準的な画像/ファイルアップロード機能を再作成しようとしています。これにより、特定のフィールドで、「別のファイルを追加」ボタンや既存のファイルを置き換える機能などを使用して、1 つ以上のファイル/画像をアップロードできます。

ファイルのアップロードが機能しており、複数のサブフォームが機能していますが、ファイル入力で複数のサブフォームを機能させることができません。

私は問題を強調するexamples/dynamic-list.hsに大きく基づいて例（以下に示す）を作成しました。これは、postFormがビューで適切なFilePathを返しますが、「結果」では返しません。

dynamic-list.hs のもう 1 つの問題は、静的データを使用した些細な使用例しか示していないことです。ユーザー入力に応じてデータが変化する実際の動的フォームを持つことはかなり複雑なので、初心者にとって (はるかに) 役立つ、より包括的なバージョンの 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) )
      ]
4

0 に答える 0