From 73edd4758bd1049b620fe208855ddf4f369a1a39 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 17 Jan 2012 14:17:28 +0200
Subject: [PATCH] renderBootstrap #212

---
 yesod-form/Yesod/Form/Functions.hs | 36 ++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs
index fb4deaa7..59cc912d 100644
--- a/yesod-form/Yesod/Form/Functions.hs
+++ b/yesod-form/Yesod/Form/Functions.hs
@@ -27,6 +27,7 @@ module Yesod.Form.Functions
     , FormRender
     , renderTable
     , renderDivs
+    , renderBootstrap
       -- * Validation
     , check
     , checkBool
@@ -292,6 +293,41 @@ $forall view <- views
 |]
     return (res, widget)
 
+-- | Render a form using Bootstrap-friendly HTML syntax.
+--
+-- Sample Hamlet:
+--
+-- >        <form method=post action=@{ActionR} enctype=#{formEnctype}>
+-- >          <fieldset>
+-- >            <legend>_{MsgLegend}
+-- >            $case result
+-- >              $of FormFailure reasons
+-- >                $forall reason <- reasons
+-- >                  <div .alert-message .error>#{reason}
+-- >              $of _
+-- >            ^{formWidget}
+-- >            <div .actions>
+-- >              <input .btn .primary type=submit value=_{MsgSubmit}>
+renderBootstrap :: FormRender sub master a
+renderBootstrap aform fragment = do
+    (res, views') <- aFormToForm aform
+    let views = views' []
+        has (Just _) = True
+        has Nothing  = False
+    let widget = [whamlet|
+\#{fragment}
+$forall view <- views
+    <div .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error>
+        <label for=#{fvId view}>#{fvLabel view}
+        <div.input>
+            ^{fvInput view}
+            $maybe tt <- fvTooltip view
+                <span .help-block>#{tt}
+            $maybe err <- fvErrors view
+                <span .help-block>#{err}
+|]
+    return (res, widget)
+
 check :: RenderMessage master msg
       => (a -> Either msg a) -> Field sub master a -> Field sub master a
 check f = checkM $ return . f