Form.Cart: merge renderCartBootstrap and renderOrderBootstrap

1 files changed, 45 insertions, 70 deletions

diff --git a/Form/Cart.hs b/Form/Cart.hs
index e59e3dc..cdc192b 100644
--- a/Form/Cart.hs
+++ b/Form/Cart.hs
@@ -23,16 +23,51 @@ type ItemFormCart = (Key Item, Widget, Enctype)
 -- >        <input .btn .primary type=submit value=_{MsgSubmit}>
 renderCartBootstrap :: Entity Item
                     -> Quantity
-                    -> CartItem
+                    -> Maybe CartItem
                     -> FormRender (HandlerT App IO) a
-renderCartBootstrap (Entity itemid item) quantitymax scitem aform fragment = do
+renderCartBootstrap (Entity itemid item) quantitymax mcitem aform fragment = do
     (res, views') <- aFormToForm aform
     let views = views' []
         has (Just _) = True
         has Nothing  = False
-    let widget = do
-        mr <- getMessageRender
-        [whamlet|
+        widget = maybe (noCartItemWidget views has) (yesCartItemWidget views has) mcitem
+    return (res, widget)
+  where
+    noCartItemWidget views has = [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">
+            _{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">
+            \ _{MsgOrderItem}
+|]
+    yesCartItemWidget views has citem = [whamlet|
 $newline never
 \#{fragment}
 <div class="container">
@@ -59,23 +94,22 @@ $newline never
             <span class="order-unit-quantity">
                 #{itemQuantity item}#{itemUnit item}
             <span class="order-unit-price">
-                \ (#{mr $ MsgPrice $ itemPrice item})
+                \ (_{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}
+                    _{MsgPrice $ quantityItemPrice item citem}
                 <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}
+                            \ _{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
@@ -85,7 +119,7 @@ cartItemForm :: CartId
              -> Html
              -> MForm Handler (FormResult CartItem, Widget)
 cartItemForm cartid eitem qtymax userid scitem =
-    renderCartBootstrap eitem qtymax scitem $ CartItem
+    renderCartBootstrap eitem qtymax (Just scitem) $ CartItem
         <$> pure cartid
         <*> pure itemid
         <*> areq (cartField qtymax item)
@@ -97,65 +131,6 @@ cartItemForm cartid eitem qtymax userid scitem =
     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
@@ -164,7 +139,7 @@ cartItemShopForm :: CartId
                  -> Html
                  -> MForm Handler (FormResult CartItem, Widget)
 cartItemShopForm cartid eitem quantitymax userid mscitem =
-        renderOrderBootstrap item quantitymax $ CartItem
+        renderCartBootstrap eitem quantitymax Nothing $ CartItem
     <$> pure cartid
     <*> pure itemid
     <*> areq (cartField quantitymax item)