Yesodでファイルアップロード

Yesodにもだいぶ慣れてきました。慣れるまではなかなかコンパイルを通せず苦労しますが、コンパイルに通りさえすれば意図通りに動かないということはまずありません。
YesodはHaskellの素晴らしさを見事に受け継いでいるな、と感じます。

さて今回はファイルアップロードのTipsを。

ポイントはFileInfoという型と、fileAFormReq(Opt)関数です。
アップロードされたファイルはFileInfoで受け取ります。
input type="file"を構成するのは、fileAFormReq(Opt)関数です。

ハンドラの例。

module Handler.File where

import Import
import Data.Text (append)

data FileForm = FileForm {
  file1 :: FileInfo
  , file2 :: Maybe FileInfo
}

fileForm :: Html -> Form Jabara Jabara (FormResult FileForm, Widget)
fileForm = renderDivs $ FileForm
  <$> fileAFormReq ""
  <*> fileAFormOpt ""

getFileR :: Handler RepHtml
getFileR = do
  form <- runFormPost fileForm
  processForm form

postFileR :: Handler RepHtml
postFileR = do
  form <- runFormPost fileForm
  processForm form

processForm :: ((FormResult FileForm, Widget), Enctype) -> Handler RepHtml
processForm ((FormSuccess file, widget), enctype) = do
  message <- return $ (fileContentType $ file1 file) `append` "  " `append` (fileName $ file1 file)
  defaultLayout $ do
    setTitle "File"
    $(widgetFile "file")
processForm ((_, widget), enctype) = do
  message <- return ("no file." :: String)
  defaultLayout $ do
    setTitle "File"
    $(widgetFile "file")

HTMLテンプレートの例。

<form method=post action=@{FileR} enctype=#{enctype}>
  ^{widget}
  <input type=submit>

<strong>#{message}

分かればかんたん。