Yesod   セッション

ホーム   目次


Stack のインストール

macOS


$ curl -sSL https://get.haskellstack.org/ | sh
    

Windows

下記サイトよりインストーラーをダウンロード

Get Started with Haskell Windows

Linux


$ 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
                    , clientsession
  hs-source-dirs:     src
  default-language:   Haskell2010
    

「yesod-web」プロジェクト内の「src」ディレクトリ内に、 次の内容の「Main.hs」というファイルを作ります。


{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
import           Control.Applicative ((<$>), (<*>))
import qualified Web.ClientSession   as CS
import           Yesod

data App = App

mkYesod "App" [parseRoutes|
/ HomeR GET POST
|]

getHomeR :: Handler Html
getHomeR = do
    sess <- getSession
    defaultLayout
        [whamlet|
            <form method=post>
                <input type=text name=key>
                <input type=text name=val>
                <input type=submit>
            <h1>#{show sess}
        |]

postHomeR :: Handler ()
postHomeR = do
    (key, mval) <- runInputPost $ (,) <$> ireq textField "key" <*> iopt textField "val"
    case mval of
        Nothing -> deleteSession key
        Just val -> setSession key val
    liftIO $ print (key, mval)
    redirect HomeR

instance Yesod App where
    -- Make the session timeout 1 minute so that it's easier to play with
    makeSessionBackend _ = do
        backend <- defaultClientSessionBackend 1 "keyfile.aes"
        return $ Just backend

instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage

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/」 へアクセスすると次のように表示されます。

サンプル 2

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
  hs-source-dirs:     src
  default-language:   Haskell2010
    

Main.hs


{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
import           Yesod

data App = App

mkYesod "App" [parseRoutes|
/            HomeR       GET
/set-message SetMessageR POST
|]

instance Yesod App where
    defaultLayout widget = do
        pc <- widgetToPageContent widget
        mmsg <- getMessage
        withUrlRenderer
            [hamlet|
                $doctype 5
                <html>
                    <head>
                        <title>#{pageTitle pc}
                        ^{pageHead pc}
                    <body>
                        $maybe msg <- mmsg
                            <p>Your message was: #{msg}
                        ^{pageBody pc}
            |]

instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage

getHomeR :: Handler Html
getHomeR = defaultLayout
    [whamlet|
        <form method=post action=@{SetMessageR}>
            My message is: #
            <input type=text name=message>
            <button>Go
    |]

postSetMessageR :: Handler ()
postSetMessageR = do
    msg <- runInputPost $ ireq textField "message"
    setMessage $ toHtml msg
    redirect HomeR

main :: IO ()
main = warp 3000 App
    

ビルドと実行


$ stack build
$ stack exec yesod-web
    

ブラウザを起動して「https://localhost:3000/」 へアクセスすると次のように表示されます。

メッセージを入力して「Go」ボタンをクリックすると次のように表示されます。

続けて、メッセージを入力できます。

サンプル 3

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
  hs-source-dirs:     src
  default-language:   Haskell2010
    

Main.hs


{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
import           Yesod

data App = App

mkYesod "App" [parseRoutes|
/         HomeR     GET
/setname  SetNameR  GET POST
/sayhello SayHelloR GET
|]

instance Yesod App

instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage

getHomeR :: Handler Html
getHomeR = defaultLayout
    [whamlet|
        <p>
            <a href=@{SetNameR}>:Set your name
        <p>
            <a href=@{SayHelloR}>Say hello
    |]

-- Display the set name form
getSetNameR :: Handler Html
getSetNameR = defaultLayout
    [whamlet|
        <form method=post>
            My name is #
            <input type=text name=name>
            . #
            <input type=submit value="Set name">
    |]

-- Retreive the submitted name from the user
postSetNameR :: Handler ()
postSetNameR = do
    -- Get the submitted name and set it in the session
    name <- runInputPost $ ireq textField "name"
    setSession "name" name

    -- After we get a name, redirect to the ultimate destination.
    -- If no destination is set, default to the homepage
    redirectUltDest HomeR

getSayHelloR :: Handler Html
getSayHelloR = do
    -- Lookup the name value set in the session
    mname <- lookupSession "name"
    case mname of
        Nothing -> do
            -- No name in the session, set the current page as
            -- the ultimate destination and redirect to the
            -- SetName page
            setUltDestCurrent
            setMessage "Please tell me your name"
            redirect SetNameR
        Just name -> defaultLayout [whamlet|

Welcome #{name}|] main :: IO () main = warp 3000 App

ビルドと実行


$ stack build
$ stack exec yesod-web
    

ブラウザを起動して「https://localhost:3000/」 へアクセスすると次のように表示されます。

「Set your name」をクリックすると次のように表示されます。

名前を入力して「Set name」をクリックすると元の画面に戻ります。次に 「Say hello」をクリックすると次のような画面が表示されます。


6361 visits
Posted: Feb. 14, 2019
Update: Feb. 25, 2019

ホーム   目次   ページトップ