blob: e59e3dc95be0350a2709c460e367d0dc7599b44d (
plain)
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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
module Form.Cart where
import Import
import Form.Fields.Quantity (cartField)
import Model.Quantity (Quantity (..))
type ItemFormCart = (Key Item, Widget, Enctype)
-- | Render a form using Bootstrap-friendly shamlet syntax.
--
-- Sample Hamlet:
--
-- > <form .form-horizontal method=post action=@{ActionR} enctype=#{formEnctype}>
-- > <fieldset>
-- > <legend>_{MsgLegend}
-- > $case result
-- > $of FormFailure reasons
-- > $forall reason <- reasons
-- > <div .alert .alert-error>#{reason}
-- > $of _
-- > ^{formWidget}
-- > <div .form-actions>
-- > <input .btn .primary type=submit value=_{MsgSubmit}>
renderCartBootstrap :: Entity Item
-> Quantity
-> CartItem
-> FormRender (HandlerT App IO) a
renderCartBootstrap (Entity itemid item) quantitymax scitem aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
has (Just _) = True
has Nothing = False
let widget = do
mr <- getMessageRender
[whamlet|
$newline never
\#{fragment}
<div class="container">
<div class="row">
<div class="form-group col-md-1 col-sm-2 col-xs-3 order-image">
$maybe imageid <- itemImage item
<img class="img-thumbnail img-cart-thumbnail" alt="#{itemIdent item}" src="@{ImageR imageid}" />
$nothing
<div class="img-thumbnail img-cart-thumbnail">
<span class="glyphicon glyphicon-camera">
<div class="form-group col-md-2 col-sm-2 col-xs-3 item-title">
#{itemIdent item}
<div class="form-group col-md-2 col-sm-3 col-xs-5">
<div class="order-quantity" data-quantity-max="#{quantitymax}">
$forall view <- views
<div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error>
<div .controls .input>
^{fvInput view}
$maybe tt <- fvTooltip view
<span .help-block>#{tt}
$maybe err <- fvErrors view
<span .help-block>#{err}
<div class="form-group col-md-2 col-sm-2 col-xs-3 order-unit">
<span class="order-unit-quantity">
#{itemQuantity item}#{itemUnit item}
<span class="order-unit-price">
\ (#{mr $ MsgPrice $ itemPrice item})
<div class="form-group col-lg-4 col-md-5 col-sm-8 col-xs-9">
<div class="row">
<div class="order-price col-md-4 col-sm-3 col-xs-4">
#{mr $ MsgPrice $ quantityItemPrice item scitem}
<div class="order-button btn-toolbar col-md-6 col-sm-6 col-xs-7">
<div class="btn-group">
<button type=submit class="btn btn-primary">
<span class="glyphicon glyphicon-ok">
\ #{mr MsgUpdateOrderItem}
<div class="btn-group">
<a href=@{CartItemDeleteR itemid}>
<div class="btn btn-danger">
<span class="glyphicon glyphicon-remove">
\ _{MsgCartItemDelete}
|]
return (res, widget)
cartItemForm :: CartId
-> Entity Item
-> Quantity
-> UserId
-> CartItem
-> Html
-> MForm Handler (FormResult CartItem, Widget)
cartItemForm cartid eitem qtymax userid scitem =
renderCartBootstrap eitem qtymax scitem $ CartItem
<$> pure cartid
<*> pure itemid
<*> areq (cartField qtymax item)
(fieldSettingsLabel MsgItemQuantity)
defaultQuantity
<*> pure userid
<*> lift (liftIO getCurrentTime)
where
defaultQuantity = Just $ cartItemQuantity scitem
Entity itemid item = eitem
-- | Render a form using Bootstrap-friendly shamlet syntax.
--
-- Sample Hamlet:
--
-- > <form .form-horizontal method=post action=@{ActionR} enctype=#{formEnctype}>
-- > <fieldset>
-- > <legend>_{MsgLegend}
-- > $case result
-- > $of FormFailure reasons
-- > $forall reason <- reasons
-- > <div .alert .alert-error>#{reason}
-- > $of _
-- > ^{formWidget}
-- > <div .form-actions>
-- > <input .btn .primary type=submit value=_{MsgSubmit}>
renderOrderBootstrap :: Item -> Quantity -> FormRender (HandlerT App IO) a
renderOrderBootstrap item quantitymax aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
has (Just _) = True
has Nothing = False
let widget = do
mr <- getMessageRender
[whamlet|
$newline never
\#{fragment}
<div class="form-group col-md-2 col-sm-3 col-xs-5 order-image">
$maybe imageid <- itemImage item
<img class="img-thumbnail" alt="#{itemIdent item}" src="@{ImageR imageid}" />
$nothing
<div class="img-thumbnail">
<span class="glyphicon glyphicon-camera">
<div class="row">
<div class="form-group col-md-2 col-sm-2 col-xs-3 item-title">
#{itemIdent item}
<div class="form-group col-lg-2 col-md-2 col-sm-2 col-xs-4 order-quantity" data-quantity-max="#{quantitymax}">
$forall view <- views
<div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error>
<label .control-label for=#{fvId view}>#{fvLabel view}
<div .controls .input>
^{fvInput view}
$maybe tt <- fvTooltip view
<span .help-block>#{tt}
$maybe err <- fvErrors view
<span .help-block>#{err}
<div class="form-group col-md-2 col-sm-2 col-xs-3 order-unit">
<span class="order-unit-price">
#{mr $ MsgPrice $ itemPrice item}
<span class="order-unit-quantity">
\ (#{itemQuantity item}#{itemUnit item})
<div class="form-group col-md-2 col-sm-2 col-xs-2 order-stock">
#{itemStock item}
<div class="order-button col-lg-2 col-md-2 col-sm-2 col-xs-3">
<button type=submit class="btn btn-lg btn-warning">
<span class="glyphicon glyphicon-shopping-cart">
\ #{mr MsgOrderItem}
|]
return (res, widget)
cartItemShopForm :: CartId
-> Entity Item
-> Quantity
-> UserId
-> Maybe CartItem
-> Html
-> MForm Handler (FormResult CartItem, Widget)
cartItemShopForm cartid eitem quantitymax userid mscitem =
renderOrderBootstrap item quantitymax $ CartItem
<$> pure cartid
<*> pure itemid
<*> areq (cartField quantitymax item)
(fieldSettingsLabel MsgItemQuantity)
defaultQuantity
<*> pure userid
<*> lift (liftIO getCurrentTime)
where
defaultQuantity = (cartItemQuantity <$> mscitem) `mplus` Just (Quantity 1)
Entity itemid item = eitem
|
