1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
-- Fortgeschrittene Funktionale Programmierung,
-- LMU, TCS, Wintersemester 2015/16
-- Steffen Jost, Alexander Isenko
--
-- Übungsblatt 11. 13.01.2016
--
-- Teilaufgabe
-- A11-3 Yesod: Applikative Formulare
--
-- Betrachten Sie das Beispiel aus der Vorlesung zu applikativen Formularen.
-- Der Code ist hier vollständig enthalten und sollte problemlos ausführbar sein.
-- a)
-- Erweiteren Sie diese Webapplikation um eine Seite, auf der ein Benutzer
-- mit einem Formular zur Eingabe einer positiven ganzen Zahl auffordert.
-- Der Benutzer wird ggf. solange erneut aufgefordert, bis eine positive ganze Zahl ermittelt wurde;
-- danach wird die Zahl einfach auf dem Bildschirm ausgegeben.
-- b)
-- Erweitern Sie Ihr Programm aus der vorherigen Teilausgabe, so dass
-- je nach der eingegebenen Zahl ein Formular zur Eingabe dieser Anzahl
-- an Autos (gemäß dem Beispiel) abgefragt werden.
--
-- Nutzen Sie dazu die Möglichkeit zur Kombination mehrerer Formulare in Yesod!
-- Auch für 5 Autos soll nur ein einziges Formular mit einem einzelnen Absenden-Knopf
-- angzeigt werden, welches entsprechend viele Felder für 5 Autos enthält.
--
-- Nach dem Absenden des Formulares, sollen die eingegebenen Autos einfach nur
-- auf dem Bildschrim dargestellt werden.
--
-- Ein Beispiel zur Kombination zweier Formulare zu einem einzigen Formular:
--
-- twoCarAForm :: AForm Handler (Car,Car)
-- twoCarAForm = (,) <$> carAForm <*> carAForm
--
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
import Yesod
import Data.Text (Text)
import qualified Data.Text as T
import Control.Applicative
import Data.Traversable (sequenceA)
import Yesod.Form
{- LÖSUNGSVORSCHLAG -}
main :: IO ()
main = warp 3000 CarApp
data CarApp = CarApp
instance Yesod CarApp
instance RenderMessage CarApp FormMessage where
renderMessage _ _ = defaultFormMessage
mkYesod "CarApp" [parseRoutes|
/ HomeR
/car/#Int CarR
|]
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
-- Beispiel zur Kombination zweier applikativer Formulare zu einem:
twoCarAForm :: AForm Handler (Car,Car)
twoCarAForm = (,) <$> carAForm <*> carAForm
handleHomeR :: Handler Html
handleHomeR = do
((result, widget), enctype) <- runFormPost . renderBootstrap2 $ areq intField "Number of Cars" Nothing
case result of
FormMissing -> defaultLayout $ do
[whamlet|
<h2>Form Demo
<form method=post action=@{HomeR} enctype=#{enctype}>
^{widget}
<button>Submit
|]
FormSuccess n -> redirect $ CarR n
handleCarR :: Int -> Handler Html
handleCarR n = do
((result,widget), enctype) <- runFormPost . renderBootstrap2 . sequenceA . replicate n $ carAForm
case result of
FormMissing -> defaultLayout $ do
setTitle "Form Demo"
[whamlet|
<h2>Form Demo
<form method=post action=@{CarR n} enctype=#{enctype}>
^{widget}
<button>Submit
|]
FormSuccess cars -> defaultLayout $ do
setTitle "Form Auswerten"
[whamlet|
<h2>#{n} Cars should have been received:
<ul>
$forall acar <- cars
<li>#{show acar}
<p>
<a href=@{HomeR}>Zurück
|]
_ -> defaultLayout [whamlet|
<h2>Fehler!
<p>Bitte nochmal eingeben:
<form method=post action=@{CarR n} enctype=#{enctype}>
^{widget}
<button>Abschicken
|]
-- das gemeinsame hamlet-widget bei
-- FormMissing und FormFailure text
-- kann man natürlich auch nur einmal
-- in einer lokalen Variable definieren
--
-- Weiter geht es mit der Datei FFP_U11-4_TemplateHaskell.hs
--
|
