Links und Funktionen
Sprachumschaltung

Navigationspfad
Sie sind hier: Startseite / Lehre / WS 2014/15 / Fortgeschrittene Funktionale Programmierung / Material / Codebeispiel: Yesod Applikative Formulare


Inhaltsbereich

Codebeispiel: Yesod Applikative Formulare

Code aus der Vorlesung zum Thema "Applikative Formulare mit Yesod"

Haskell source code icon YesodAForm.hs — Haskell source code, 2 KB (2072 bytes)

Dateiinhalt

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

{- Code aus der Vorlesung 
  Fortgeschrittene Funktionale Programmierung, 
  Wintersemester 2014/15,
  von Steffen Jost, Institut für Informatik, LMU München
  
   Code ist größtenteils entlehnt aus dem Buch
   "Haskell and Yesod" von Michael Snoyman, O'Reilly Verlag 
-}



module Main where

import Yesod 
import Data.Text
import Control.Applicative
import Yesod.Form 

data App = App

instance Yesod App

instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage
    
mkYesod "App" [parseRoutes|
/     HomeR GET
/car  CarR  POST
|]

fib :: Int -> Int
fib n | n <= 2    = n
      | otherwise = fib (n-1) + fib (n-2)

data Car = Car { carModel :: Text
               , carYear  :: Int
               , carColor :: Maybe Text
               } 
   deriving Show

carAForm :: AForm Handler Car
carAForm = Car 
    <$> areq textField "Model"  Nothing
    <*> areq intField  "Year"   (Just 1996)
    <*> aopt textField "Color"  Nothing

carForm :: Html -> MForm Handler (FormResult Car, Widget)
carForm = renderBootstrap carAForm


getHomeR :: Handler Html
getHomeR = do
  (widget, enctype) <- generateFormPost carForm
  defaultLayout $ do
    setTitle "Form Demo"
    [whamlet|
<h2>Form Demo
<form method=post action=@{CarR} enctype=#{enctype}>
  ^{widget}
  <button>Submit
|]

postCarR :: Handler Html
postCarR = do
  ((result,widget), enctype) <- runFormPost carForm
  case result of 
    FormSuccess car -> defaultLayout $ do
      setTitle "Form Auswerten"
      [whamlet|
          <h2>Car received:
          <p>#{show car}
          <p>
            <a href=@{HomeR}>Zurück
      |]
    _ -> defaultLayout [whamlet|
          <h2>Fehler!
          <p>Bitte nochmal eingeben:
          <form method=post action=@{CarR} enctype=#{enctype}>
            ^{widget}
            <button>Abschicken
        |]

main :: IO ()
main = warp 3000 App

Artikelaktionen


Funktionsleiste