Yesod フォーム
ホーム
目次
Stack のインストール
macOS
$ curl -sSL https://get.haskellstack.org/ | sh
Windows
下記サイトよりインストーラーをダウンロード
Get Started with Haskell WindowsLinux
$ wget -qO- https://get.haskellstack.org/ | sh
詳しくは下記サイトを参照
Get started with Haskellプロジェクトの作成
よりシンプルにするために、プロジェクトを手動で作ります。
$ mkdir yesod-web
$ cd yesod-web
$ mkdir src
サンプル 1
「yesod-web」プロジェクト内に、次の内容の「yesod-web.cabal」というファイルを 作ります。
name: yesod-web
version: 0.1.0.0
category: Web
build-type: Simple
cabal-version: >=1.10
executable yesod-web
main-is: Main.hs
build-depends: base >=4.10 && <4.11
, yesod
, text
, time
, yesod-form
hs-source-dirs: src
default-language: Haskell2010
「yesod-web」プロジェクト内の「src」ディレクトリ内に、
次の内容の「Main.hs」というファイルを作ります。
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Applicative ((<$>), (<*>))
import Data.Text (Text)
import Data.Time (Day)
import Yesod
import Yesod.Form.Jquery
data App = App
mkYesod "App" [parseRoutes|
/ HomeR GET
/person PersonR POST
|]
instance Yesod App
-- 標準の英語のメッセージを使用するようにアプリケーションに指示します。
-- 国際化が必要な場合は、代わりに翻訳機能を提供することができます。
instance RenderMessage App FormMessage where
renderMessage _ _ = defaultFormMessage
-- そしてjQueryライブラリの場所を教えてください。 デフォルトを使います。
-- これはGoogle CDNを指しています。
instance YesodJquery App
-- フォームから受け取りたいデータ型
data Person = Person
{ personName :: Text
, personBirthday :: Day
, personFavoriteColor :: Maybe Text
, personEmail :: Text
, personWebsite :: Maybe Text
}
deriving Show
personForm :: Html -> MForm Handler (FormResult Person, Widget)
personForm = renderDivs $ Person
<$> areq textField "Name" Nothing
<*> areq (jqueryDayField def
{ jdsChangeYear = True -- give a year dropdown
, jdsYearRange = "1900:-5" -- 1900 till five years ago
}) "Birthday" Nothing
<*> aopt textField "Favorite color" Nothing
<*> areq emailField "Email address" Nothing
<*> aopt urlField "Website" Nothing
-- GETハンドラはフォームを表示します
getHomeR :: Handler Html
getHomeR = do
-- 表示するフォームを生成する
(widget, enctype) <- generateFormPost personForm
defaultLayout
[whamlet|
<p>
生成されたウィジェットはフォームの内容のみを含みます。
フォームタグ自体ではありません。
<form method=post action=@{PersonR} enctype=#{enctype}>
^{widget}
<p>送信ボタンも含まれていません。
<button>Submit
|]
-- POSTハンドラがフォームを処理します。
-- 成功した場合は、解析されたPersonが表示されます。
-- それ以外の場合は、エラーメッセージとともにフォームを再度表示します。
postPersonR :: Handler Html
postPersonR = do
((result, widget), enctype) <- runFormPost personForm
case result of
FormSuccess person -> defaultLayout [whamlet|#{show person}|]
_ -> defaultLayout
[whamlet|
<p>Invalid input, let's try again.
<form method=post action=@{PersonR} enctype=#{enctype}>
^{widget}
<button>Submit
|]
main :: IO ()
main = warp 3000 App
ビルドと実行
ビルド
$ stack init
$ stack build
初回のビルドは「Yesod」の開発環境と実行環境をインストールするため、 非常に時間がかかります。2回目からのビルドはすぐに終わります。 「stack init」は、初回の1回だけで構いません。
なお、「Yesod」のオフィシャルページでは、「Yesod コマンド」 をインストールしなければならないことになっていますが、 インストールしなくても問題なくビルドできます。 もしビルドできない場合は次のようにして、 「yesod コマンド」をインストールしてください。
$ stack install yesod-bin
インストールには、すごく時間がかかります。
実行
$ stack exec yesod-web
ブラウザを起動して「https://localhost:3000/」
へアクセスすると次のように表示されます。
日本語も入力できますが、送信後は正しく表示されません。
終了させるには、 ターミナルで、Controlキーを押しながらc
を押します。
^C
サンプル 2
Main.hs
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Applicative
import Data.Text (Text)
import Yesod
data App = App
mkYesod "App" [parseRoutes|
/ HomeR GET
|]
instance Yesod App
instance RenderMessage App FormMessage where
renderMessage _ _ = defaultFormMessage
data Person = Person
{ personName :: Text
, personAge :: Int
}
deriving Show
personForm :: Html -> MForm Handler (FormResult Person, Widget)
personForm extra = do
(nameRes, nameView) <- mreq textField "this is not used" Nothing
(ageRes, ageView) <- mreq intField "neither is this" Nothing
let personRes = Person <$> nameRes <*> ageRes
let widget = do
toWidget
[lucius|
##{fvId ageView} {
width: 3em;
}
|]
[whamlet|
#{extra}
<p>
Hello, my name is #
^{fvInput nameView}
\ and I am #
^{fvInput ageView}
\ years old. #
<input type=submit value="Introduce myself">
|]
return (personRes, widget)
getHomeR :: Handler Html
getHomeR = do
((res, widget), enctype) <- runFormGet personForm
defaultLayout
[whamlet|
<p>Result: #{show res}
<form enctype=#{enctype}>
^{widget}
|]
main :: IO ()
main = warp 3000 App
「yesod-web.cabal」は「サンプル 1」と同じものを使います。
サンプル 3
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Applicative
import Data.Text (Text)
import Yesod
data App = App
mkYesod "App" [parseRoutes|
/ HomeR GET
/input InputR GET
|]
instance Yesod App
instance RenderMessage App FormMessage where
renderMessage _ _ = defaultFormMessage
data Person = Person
{ personName :: Text
, personAge :: Int
}
deriving Show
getHomeR :: Handler Html
getHomeR = defaultLayout
[whamlet|
<form action=@{InputR}>
<p>
My name is
<input type=text name=name>
and I am
<input type=text name=age>
years old.
<input type=submit value="Introduce myself">
|]
getInputR :: Handler Html
getInputR = do
person <- runInputGet $ Person
<$> ireq textField "name"
<*> ireq intField "age"
defaultLayout [whamlet|#{show person}|]
main :: IO ()
main = warp 3000 App
サンプル 4
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Applicative
import Data.Text (Text)
import Data.Time
import Yesod
newtype UserId = UserId Int
deriving Show
data App = App
mkYesod "App" [parseRoutes|
/ HomeR GET POST
|]
instance Yesod App
instance RenderMessage App FormMessage where
renderMessage _ _ = defaultFormMessage
type Form a = Html -> MForm Handler (FormResult a, Widget)
data Blog = Blog
{ blogTitle :: Text
, blogContents :: Textarea
, blogUser :: UserId
, blogPosted :: UTCTime
}
deriving Show
form :: UserId -> Form Blog
form userId = renderDivs $ Blog
<$> areq textField "Title" Nothing
<*> areq textareaField "Contents" Nothing
<*> pure userId
<*> lift (liftIO getCurrentTime)
getHomeR :: Handler Html
getHomeR = do
let userId = UserId 5 -- again, see the authentication chapter
((res, widget), enctype) <- runFormPost $ form userId
defaultLayout
[whamlet|
<p>:Previous result: #{show res}
<form method=post action=@{HomeR} enctype=#{enctype}>
^{widget}
<input type=submit>
|]
postHomeR :: Handler Html
postHomeR = getHomeR
main :: IO ()
main = warp 3000 App
22958 visits
Posted: Feb. 24, 2019
Update: Feb. 24, 2019