git-annex-5.20150710: standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch
From 4cf9a045569ea0b51b4ee11df2dadbde330f7813 Mon Sep 17 00:00:00 2001
From: dummy <dummy@example.com>
Date: Fri, 3 Jul 2015 01:06:34 +0000
Subject: [PATCH] hack TH
1. EvilSplicer
2. Add imports
3. Fix some syntax errors in spliced code
4. Remove some persistent stuff that doesn't build.
---
Yesod/Form/Bootstrap3.hs | 189 +++++++++--
Yesod/Form/Fields.hs | 811 ++++++++++++++++++++++++++++++++++++-----------
Yesod/Form/Functions.hs | 255 ++++++++++++---
Yesod/Form/Jquery.hs | 124 ++++++--
Yesod/Form/MassInput.hs | 226 ++++++++++---
Yesod/Form/Nic.hs | 60 +++-
yesod-form.cabal | 2 +-
7 files changed, 1311 insertions(+), 356 deletions(-)
diff --git a/Yesod/Form/Bootstrap3.hs b/Yesod/Form/Bootstrap3.hs
index 8377a68..fa8b7d4 100644
--- a/Yesod/Form/Bootstrap3.hs
+++ b/Yesod/Form/Bootstrap3.hs
@@ -35,6 +35,9 @@ import Data.String (IsString(..))
import Yesod.Core
import qualified Data.Text as T
+import qualified Text.Hamlet
+import qualified Text.Blaze.Internal
+import qualified Data.Foldable
import Yesod.Form.Types
import Yesod.Form.Functions
@@ -155,44 +158,144 @@ renderBootstrap3 formLayout aform fragment = do
let views = views' []
has (Just _) = True
has Nothing = False
- widget = [whamlet|
- $newline never
- #{fragment}
- $forall view <- views
- <div .form-group :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.has-error>
- $case formLayout
- $of BootstrapBasicForm
- $if fvId view /= bootstrapSubmitId
- <label for=#{fvId view}>#{fvLabel view}
- ^{fvInput view}
- ^{helpWidget view}
- $of BootstrapInlineForm
- $if fvId view /= bootstrapSubmitId
- <label .sr-only for=#{fvId view}>#{fvLabel view}
- ^{fvInput view}
- ^{helpWidget view}
- $of BootstrapHorizontalForm labelOffset labelSize inputOffset inputSize
- $if fvId view /= bootstrapSubmitId
- <label .control-label .#{toOffset labelOffset} .#{toColumn labelSize} for=#{fvId view}>#{fvLabel view}
- <div .#{toOffset inputOffset} .#{toColumn inputSize}>
- ^{fvInput view}
- ^{helpWidget view}
- $else
- <div .#{toOffset (addGO inputOffset (addGO labelOffset labelSize))} .#{toColumn inputSize}>
- ^{fvInput view}
- ^{helpWidget view}
- |]
+ widget = do { (asWidgetT . toWidget) (toHtml fragment);
+ Data.Foldable.mapM_
+ (\ view_a2d4p
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<div class=\"form-group ");
+ Text.Hamlet.condH
+ [(fvRequired view_a2d4p,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "required "))]
+ Nothing;
+ Text.Hamlet.condH
+ [(not (fvRequired view_a2d4p),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "optional "))]
+ Nothing;
+ Text.Hamlet.condH
+ [(has (fvErrors view_a2d4p),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "has-error"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
+ case formLayout of {
+ ; BootstrapBasicForm
+ -> do { Text.Hamlet.condH
+ [((/=) (fvId view_a2d4p) bootstrapSubmitId,
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<label for=\"");
+ (asWidgetT . toWidget) (toHtml (fvId view_a2d4p));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
+ (asWidgetT . toWidget) (toHtml (fvLabel view_a2d4p));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</label>") })]
+ Nothing;
+ (asWidgetT . toWidget) (fvInput view_a2d4p);
+ (asWidgetT . toWidget) (helpWidget view_a2d4p) }
+ ; BootstrapInlineForm
+ -> do { Text.Hamlet.condH
+ [((/=) (fvId view_a2d4p) bootstrapSubmitId,
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<label class=\"sr-only\" for=\"");
+ (asWidgetT . toWidget) (toHtml (fvId view_a2d4p));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
+ (asWidgetT . toWidget) (toHtml (fvLabel view_a2d4p));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</label>") })]
+ Nothing;
+ (asWidgetT . toWidget) (fvInput view_a2d4p);
+ (asWidgetT . toWidget) (helpWidget view_a2d4p) }
+ ; BootstrapHorizontalForm labelOffset_a2d4q
+ labelSize_a2d4r
+ inputOffset_a2d4s
+ inputSize_a2d4t
+ -> Text.Hamlet.condH
+ [((/=) (fvId view_a2d4p) bootstrapSubmitId,
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<label class=\"control-label ");
+ (asWidgetT . toWidget) (toHtml (toOffset labelOffset_a2d4q));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) " ");
+ (asWidgetT . toWidget) (toHtml (toColumn labelSize_a2d4r));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\" for=\"");
+ (asWidgetT . toWidget) (toHtml (fvId view_a2d4p));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
+ (asWidgetT . toWidget) (toHtml (fvLabel view_a2d4p));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</label><div class=\"");
+ (asWidgetT . toWidget) (toHtml (toOffset inputOffset_a2d4s));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) " ");
+ (asWidgetT . toWidget) (toHtml (toColumn inputSize_a2d4t));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
+ (asWidgetT . toWidget) (fvInput view_a2d4p);
+ (asWidgetT . toWidget) (helpWidget view_a2d4p);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</div>") })]
+ (Just
+ (do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<div class=\"");
+ (asWidgetT . toWidget)
+ (toHtml
+ (toOffset
+ (addGO
+ inputOffset_a2d4s
+ (addGO labelOffset_a2d4q labelSize_a2d4r))));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) " ");
+ (asWidgetT . toWidget) (toHtml (toColumn inputSize_a2d4t));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "\">");
+ (asWidgetT . toWidget) (fvInput view_a2d4p);
+ (asWidgetT . toWidget) (helpWidget view_a2d4p);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "</div>") })) };
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</div>") })
+ views }
+
return (res, widget)
-- | (Internal) Render a help widget for tooltips and errors.
helpWidget :: FieldView site -> WidgetT site IO ()
-helpWidget view = [whamlet|
- $maybe tt <- fvTooltip view
- <span .help-block>#{tt}
- $maybe err <- fvErrors view
- <span .help-block>#{err}
-|]
+helpWidget view = do { Text.Hamlet.maybeH
+ (fvTooltip view)
+ (\ tt_a2d5x
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<span class=\"help-block\">");
+ (asWidgetT . toWidget) (toHtml tt_a2d5x);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</span>") })
+ Nothing;
+ Text.Hamlet.maybeH
+ (fvErrors view)
+ (\ err_a2d5y
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<span class=\"help-block\">");
+ (asWidgetT . toWidget) (toHtml err_a2d5y);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</span>") })
+ Nothing }
+
-- | How the 'bootstrapSubmit' button should be rendered.
@@ -247,7 +350,23 @@ mbootstrapSubmit
=> BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)
mbootstrapSubmit (BootstrapSubmit msg classes attrs) =
let res = FormSuccess ()
- widget = [whamlet|<button class="btn #{classes}" type=submit *{attrs}>_{msg}|]
+ widget = do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "<button class=\"btn ");
+ (asWidgetT . toWidget) (toHtml classes);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack)
+ "\" type=\"submit\"");
+ (asWidgetT . toWidget)
+ ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) ">");
+ ((liftM (toHtml .) getMessageRender)
+ >>=
+ (\ urender_a2d6f -> (asWidgetT . toWidget) (urender_a2d6f msg)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . T.pack) "</button>") }
+
fv = FieldView { fvLabel = ""
, fvTooltip = Nothing
, fvId = bootstrapSubmitId
@@ -314,4 +433,4 @@ bootstrapSubmitId = "b:ootstrap___unique__:::::::::::::::::submit-id"
-- > <$> areq textField nameSettings Nothing
-- > where nameSettings = withAutofocus $
-- > withPlaceholder "First name" $
--- > (bfs ("Name" :: Text))
\ No newline at end of file
+-- > (bfs ("Name" :: Text))
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
index 5fe123e..42fd7d6 100644
--- a/Yesod/Form/Fields.hs
+++ b/Yesod/Form/Fields.hs
@@ -52,8 +52,6 @@ module Yesod.Form.Fields
, Option (..)
, OptionList (..)
, mkOptionList
- , optionsPersist
- , optionsPersistKey
, optionsPairs
, optionsEnum
) where
@@ -80,6 +78,15 @@ import Control.Monad (when, unless)
import Data.Either (partitionEithers)
import Data.Maybe (listToMaybe, fromMaybe)
+import qualified Text.Blaze as Text.Blaze.Internal
+import qualified Text.Blaze.Internal
+import qualified Text.Hamlet
+import qualified Yesod.Core.Widget
+import qualified Text.Css
+import qualified Data.Monoid
+import qualified Data.Foldable
+import qualified Control.Monad
+
import qualified Blaze.ByteString.Builder.Html.Utf8 as B
import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
@@ -102,8 +109,6 @@ import Control.Applicative ((<$>), (<|>))
import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly)
-import Yesod.Persist.Core
-
defaultFormMessage :: FormMessage -> Text
defaultFormMessage = englishFormMessage
@@ -115,10 +120,25 @@ intField = Field
Right (a, "") -> Right a
_ -> Left $ MsgInvalidInteger s
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="number" step=1 :isReq:required="" value="#{showVal val}">
-|]
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nCq
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "\" type=\"number\" step=\"1\"");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ id (toHtml (showVal val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
where
@@ -133,10 +153,25 @@ doubleField = Field
Right (a, "") -> Right a
_ -> Left $ MsgInvalidNumber s
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="number" step=any :isReq:required="" value="#{showVal val}">
-|]
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nCV
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "\" type=\"number\" step=\"any\"");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ id (toHtml (showVal val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . show)
@@ -147,10 +182,24 @@ $newline never
dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day
dayField = Field
{ fieldParse = parseHelper $ parseDate . unpack
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
-|]
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nDh
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\"");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ id (toHtml (showVal val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . show)
@@ -179,10 +228,25 @@ timeFieldTypeText = timeFieldOfType "text"
timeFieldOfType :: Monad m => RenderMessage (HandlerSite m) FormMessage => Text -> Field m TimeOfDay
timeFieldOfType inputType = Field
{ fieldParse = parseHelper parseTime
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="#{inputType}" :isReq:required="" value="#{showVal val}">
-|]
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nDN
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"");
+ id (toHtml inputType);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ id (toHtml (showVal val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
where
@@ -196,10 +260,23 @@ $newline never
htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html
htmlField = Field
{ fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<textarea :isReq:required="" id="#{theId}" name="#{name}" *{attrs}>#{showVal val}
-|]
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nEc
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ id (toHtml (showVal val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }
+
, fieldEnctype = UrlEncoded
}
where showVal = either id (pack . renderHtml)
@@ -231,10 +308,22 @@ instance ToHtml Textarea where
textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea
textareaField = Field
{ fieldParse = parseHelper $ Right . Textarea
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<textarea id="#{theId}" name="#{name}" :isReq:required="" *{attrs}>#{either id unTextarea val}
-|]
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nEL
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ id (toHtml (either id unTextarea val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }
+
, fieldEnctype = UrlEncoded
}
@@ -243,10 +332,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)
=> Field m p
hiddenField = Field
{ fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece
- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
-$newline never
-<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}">
-|]
+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_a2nFl
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<input type=\"hidden\" id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");
+ id (toHtml (either id toPathPiece val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
@@ -255,20 +353,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex
textField = Field
{ fieldParse = parseHelper $ Right
, fieldView = \theId name attrs val isReq ->
- [whamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id id val}">
-|]
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\"");
+ condH
+ [(isReq,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ (asWidgetT . toWidget) (toHtml (either id id val));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
-- | Creates an input with @type="password"@.
passwordField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
passwordField = Field
{ fieldParse = parseHelper $ Right
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}">
-|]
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nG7
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "\" type=\"password\"");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ id (toHtml (either id id val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
@@ -342,10 +473,24 @@ emailField = Field
case Email.canonicalizeEmail $ encodeUtf8 s of
Just e -> Right $ decodeUtf8With lenientDecode e
Nothing -> Left $ MsgInvalidEmail s
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">
-|]
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nKu
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"email\"");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ id (toHtml (either id id val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
@@ -360,10 +505,25 @@ multiEmailField = Field
in case partitionEithers addrs of
([], good) -> Right good
(bad, _) -> Left $ MsgInvalidEmail $ cat bad
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="email" multiple :isReq:required="" value="#{either id cat val}">
-|]
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_a2nL5
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "\" type=\"email\" multiple");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ id (toHtml (either id cat val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
where
@@ -380,20 +540,74 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus
searchField autoFocus = Field
{ fieldParse = parseHelper Right
, fieldView = \theId name attrs val isReq -> do
- [whamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
-|]
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"search\"");
+ condH
+ [(isReq,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ condH
+ [(autoFocus,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " autofocus=\"\""))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ (asWidgetT . toWidget) (toHtml (either id id val));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
when autoFocus $ do
-- we want this javascript to be placed immediately after the field
- [whamlet|
-$newline never
-<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}
-|]
- toWidget [cassius|
- ##{theId}
- -webkit-appearance: textfield
- |]
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "').focus();}</script>") }
+
+ toWidget $ \ _render_a2nMA
+ -> (Text.Css.CssNoWhitespace . (foldr ($) []))
+ [((++)
+ $ (map
+ Text.Css.TopBlock
+ (((Text.Css.Block
+ {Text.Css.blockSelector = Data.Monoid.mconcat
+ [(Text.Css.fromText
+ . Text.Css.pack)
+ "#",
+ toCss theId],
+ Text.Css.blockAttrs = (Prelude.concat
+ $ ([Text.Css.Attr
+ (Data.Monoid.mconcat
+ [(Text.Css.fromText
+ . Text.Css.pack)
+ "-webkit-appearance"])
+ (Data.Monoid.mconcat
+ [(Text.Css.fromText
+ . Text.Css.pack)
+ "textfield"])]
+ :
+ (map
+ Text.Css.mixinAttrs
+ []))),
+ Text.Css.blockBlocks = (),
+ Text.Css.blockMixins = ()} :)
+ . ((foldr (.) id [])
+ . (concatMap Text.Css.mixinBlocks [] ++)))
+ [])))]
+
, fieldEnctype = UrlEncoded
}
-- | Creates an input with @type="url"@, validating the URL according to RFC3986.
@@ -404,7 +618,28 @@ urlField = Field
Nothing -> Left $ MsgInvalidUrl s
Just _ -> Right s
, fieldView = \theId name attrs val isReq ->
- [whamlet|<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>|]
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"url\"");
+ condH
+ [(isReq,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ (asWidgetT . toWidget) (toHtml (either id id val));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
@@ -423,18 +658,54 @@ selectField :: (Eq a, RenderMessage site FormMessage)
=> HandlerT site IO (OptionList a)
-> Field (HandlerT site IO) a
selectField = selectFieldHelper
- (\theId name attrs inside -> [whamlet|
-$newline never
-<select ##{theId} name=#{name} *{attrs}>^{inside}
-|]) -- outside
- (\_theId _name isSel -> [whamlet|
-$newline never
-<option value=none :isSel:selected>_{MsgSelectNone}
-|]) -- onOpt
- (\_theId _name _attrs value isSel text -> [whamlet|
-$newline never
-<option value=#{value} :isSel:selected>#{text}
-|]) -- inside
+ (\theId name attrs inside -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ (asWidgetT . toWidget) inside;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") })
+ -- outside
+ (\_theId _name isSel -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<option value=\"none\"");
+ condH
+ [(isSel,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
+ (\ urender_a2nOk
+ -> (asWidgetT . toWidget) (urender_a2nOk MsgSelectNone)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })
+ -- onOpt
+ (\_theId _name _attrs value isSel text -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\"");
+ (asWidgetT . toWidget) (toHtml value);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
+ [(isSel,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ (asWidgetT . toWidget) (toHtml text);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })
+ -- inside
-- | Creates a @\<select>@ tag for selecting multiple options.
multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
@@ -459,11 +730,45 @@ multiSelectField ioptlist =
view theId name attrs val isReq = do
opts <- fmap olOptions $ handlerToWidget ioptlist
let selOpts = map (id &&& (optselected val)) opts
- [whamlet|
- <select ##{theId} name=#{name} :isReq:required multiple *{attrs}>
- $forall (opt, optsel) <- selOpts
- <option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt}
- |]
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
+ [(isReq,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " multiple");
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ Data.Foldable.mapM_
+ (\ (opt_a2nPy, optsel_a2nPz)
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\"");
+ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_a2nPy));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
+ [(optsel_a2nPz,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ (asWidgetT . toWidget) (toHtml (optionDisplay opt_a2nPy));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })
+ selOpts;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") }
+
where
optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
@@ -489,37 +794,115 @@ checkboxesField ioptlist = (multiSelectField ioptlist)
opts <- fmap olOptions $ handlerToWidget ioptlist
let optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
- [whamlet|
- <span ##{theId}>
- $forall opt <- opts
- <label>
- <input type=checkbox name=#{name} value=#{optionExternalValue opt} *{attrs} :optselected val opt:checked>
- #{optionDisplay opt}
- |]
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<span id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
+ Data.Foldable.mapM_
+ (\ opt_a2nQo
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<label><input type=\"checkbox\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");
+ (asWidgetT . toWidget) (toHtml (optionExternalValue opt_a2nQo));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
+ [(optselected val opt_a2nQo,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
+ Nothing;
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ (asWidgetT . toWidget) (toHtml (optionDisplay opt_a2nQo));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })
+ opts;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") }
+
}
-- | Creates an input with @type="radio"@ for selecting one option.
radioField :: (Eq a, RenderMessage site FormMessage)
=> HandlerT site IO (OptionList a)
-> Field (HandlerT site IO) a
radioField = selectFieldHelper
- (\theId _name _attrs inside -> [whamlet|
-$newline never
-<div ##{theId}>^{inside}
-|])
- (\theId name isSel -> [whamlet|
-$newline never
-<label .radio for=#{theId}-none>
- <div>
- <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
- _{MsgSelectNone}
-|])
- (\theId name attrs value isSel text -> [whamlet|
-$newline never
-<label .radio for=#{theId}-#{value}>
- <div>
- <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}>
- \#{text}
-|])
+ (\theId _name _attrs inside -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<div id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
+ (asWidgetT . toWidget) inside;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
+
+ (\theId name isSel -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<label class=\"radio\" for=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "-none\"><div><input id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "-none\" type=\"radio\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"none\"");
+ condH
+ [(isSel,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
+ (\ urender_a2nR7
+ -> (asWidgetT . toWidget) (urender_a2nR7 MsgSelectNone)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })
+
+ (\theId name attrs value isSel text -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<label class=\"radio\" for=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "-");
+ (asWidgetT . toWidget) (toHtml value);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "\"><div><input id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "-");
+ (asWidgetT . toWidget) (toHtml value);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "\" type=\"radio\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");
+ (asWidgetT . toWidget) (toHtml value);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ condH
+ [(isSel,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
+ Nothing;
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ (asWidgetT . toWidget) (toHtml text);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })
+
-- | Creates a group of radio buttons to answer the question given in the message. Radio buttons are used to allow differentiating between an empty response (@Nothing@) and a no response (@Just False@). Consider using the simpler 'checkBoxField' if you don't need to make this distinction.
--
@@ -531,19 +914,83 @@ $newline never
boolField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool
boolField = Field
{ fieldParse = \e _ -> return $ boolParser e
- , fieldView = \theId name attrs val isReq -> [whamlet|
-$newline never
- $if not isReq
- <input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>
- <label for=#{theId}-none>_{MsgSelectNone}
-
-
-<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>
-<label for=#{theId}-yes>_{MsgBoolYes}
+ , fieldView = \theId name attrs val isReq -> do { condH
+ [(not isReq,
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "-none\" type=\"radio\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "\" value=\"none\" checked");
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "-none\">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
+ (\ urender_a2nSk
+ -> (asWidgetT . toWidget) (urender_a2nSk MsgSelectNone)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "-yes\" type=\"radio\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\"");
+ condH
+ [(showVal id val,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
+ Nothing;
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "-yes\">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
+ (\ urender_a2nSl
+ -> (asWidgetT . toWidget) (urender_a2nSl MsgBoolYes)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "</label><input id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "-no\" type=\"radio\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"no\"");
+ condH
+ [(showVal not val,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
+ Nothing;
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "-no\">");
+ ((Control.Monad.liftM (toHtml .) getMessageRender)
+ >>=
+ (\ urender_a2nSm
+ -> (asWidgetT . toWidget) (urender_a2nSm MsgBoolNo)));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") }
-<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked>
-<label for=#{theId}-no>_{MsgBoolNo}
-|]
, fieldEnctype = UrlEncoded
}
where
@@ -570,10 +1017,24 @@ $newline never
checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool
checkBoxField = Field
{ fieldParse = \e _ -> return $ checkBoxParser e
- , fieldView = \theId name attrs val _ -> [whamlet|
-$newline never
-<input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked>
-|]
+ , fieldView = \theId name attrs val _ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ (asWidgetT . toWidget) (toHtml theId);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "\" type=\"checkbox\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\"");
+ condH
+ [(showVal id val,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
+ Nothing;
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) attrs);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = UrlEncoded
}
@@ -619,66 +1080,6 @@ optionsPairs opts = do
optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a)
optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
--- | Selects a list of 'Entity's with the given 'Filter' and 'SelectOpt's. The @(a -> msg)@ function is then used to derive the display value for an 'OptionList'. Example usage:
---
--- > Country
--- > name Text
--- > deriving Eq -- Must derive Eq
---
--- > data CountryForm = CountryForm
--- > { country :: Entity Country
--- > }
--- >
--- > countryNameForm :: AForm Handler CountryForm
--- > countryNameForm = CountryForm
--- > <$> areq (selectField countries) "Which country do you live in?" Nothing
--- > where
--- > countries = optionsPersist [] [Asc CountryName] countryName
-optionsPersist :: ( YesodPersist site, PersistEntity a
- , PersistQuery (PersistEntityBackend a)
- , PathPiece (Key a)
- , RenderMessage site msg
- , YesodPersistBackend site ~ PersistEntityBackend a
- )
- => [Filter a]
- -> [SelectOpt a]
- -> (a -> msg)
- -> HandlerT site IO (OptionList (Entity a))
-optionsPersist filts ords toDisplay = fmap mkOptionList $ do
- mr <- getMessageRender
- pairs <- runDB $ selectList filts ords
- return $ map (\(Entity key value) -> Option
- { optionDisplay = mr (toDisplay value)
- , optionInternalValue = Entity key value
- , optionExternalValue = toPathPiece key
- }) pairs
-
--- | An alternative to 'optionsPersist' which returns just the 'Key' instead of
--- the entire 'Entity'.
---
--- Since 1.3.2
-optionsPersistKey
- :: (YesodPersist site
- , PersistEntity a
- , PersistQuery (PersistEntityBackend a)
- , PathPiece (Key a)
- , RenderMessage site msg
- , YesodPersistBackend site ~ PersistEntityBackend a
- )
- => [Filter a]
- -> [SelectOpt a]
- -> (a -> msg)
- -> HandlerT site IO (OptionList (Key a))
-
-optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do
- mr <- getMessageRender
- pairs <- runDB $ selectList filts ords
- return $ map (\(Entity key value) -> Option
- { optionDisplay = mr (toDisplay value)
- , optionInternalValue = key
- , optionExternalValue = toPathPiece key
- }) pairs
-
selectFieldHelper
:: (Eq a, RenderMessage site FormMessage)
=> (Text -> Text -> [(Text, Text)] -> WidgetT site IO () -> WidgetT site IO ())
@@ -722,9 +1123,21 @@ fileField = Field
case files of
[] -> Right Nothing
file:_ -> Right $ Just file
- , fieldView = \id' name attrs _ isReq -> toWidget [hamlet|
- <input id=#{id'} name=#{name} *{attrs} type=file :isReq:required>
- |]
+ , fieldView = \id' name attrs _ isReq -> toWidget $ \ _render_a2nUV
+ -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml id');
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"file\"");
+ condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required"))]
+ Nothing;
+ id ((attrsToHtml . toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fieldEnctype = Multipart
}
@@ -751,10 +1164,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage site langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs
, fvId = id'
- , fvInput = [whamlet|
-$newline never
-<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
-|]
+ , fvInput = do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<input type=\"file\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\"");
+ (asWidgetT . toWidget) (toHtml id');
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) (fsAttrs fs));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fvErrors = errs
, fvRequired = True
}
@@ -783,10 +1205,19 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
, fvId = id'
- , fvInput = [whamlet|
-$newline never
-<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
-|]
+ , fvInput = do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<input type=\"file\" name=\"");
+ (asWidgetT . toWidget) (toHtml name);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\"");
+ (asWidgetT . toWidget) (toHtml id');
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ (asWidgetT . toWidget) ((attrsToHtml . toAttributes) (fsAttrs fs));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
, fvErrors = errs
, fvRequired = False
}
diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
index 0d83b79..61e9b66 100644
--- a/Yesod/Form/Functions.hs
+++ b/Yesod/Form/Functions.hs
@@ -60,12 +60,14 @@ import Text.Blaze (Markup, toMarkup)
#define toHtml toMarkup
import Yesod.Core
import Network.Wai (requestMethod)
-import Text.Hamlet (shamlet)
import Data.Monoid (mempty)
import Data.Maybe (listToMaybe, fromMaybe)
import qualified Data.Map as Map
import qualified Data.Text.Encoding as TE
import Control.Arrow (first)
+import qualified Text.Hamlet
+import qualified Text.Blaze.Internal
+import qualified Data.Foldable
-- | Get a unique identifier.
newFormIdent :: Monad m => MForm m Text
@@ -217,7 +219,14 @@ postHelper form env = do
let token =
case reqToken req of
Nothing -> mempty
- Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]
+ Just n -> do { id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<input type=\"hidden\" name=\"");
+ id (toHtml tokenKey);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");
+ id (toHtml n);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\">") }
+
m <- getYesod
langs <- languages
((res, xml), enctype) <- runFormGeneric (form token) m langs env
@@ -298,7 +307,12 @@ getHelper :: MonadHandler m
-> Maybe (Env, FileEnv)
-> m (a, Enctype)
getHelper form env = do
- let fragment = [shamlet|<input type=hidden name=#{getKey}>|]
+ let fragment = do { id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<input type=\"hidden\" name=\"");
+ id (toHtml getKey);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\">") }
+
langs <- languages
m <- getYesod
runFormGeneric (form fragment) m langs env
@@ -333,10 +347,15 @@ identifyForm
identifyForm identVal form = \fragment -> do
-- Create hidden <input>.
let fragment' =
- [shamlet|
- <input type=hidden name=#{identifyFormKey} value=#{identVal}>
- #{fragment}
- |]
+ do { id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<input type=\"hidden\" name=\"");
+ id (toHtml identifyFormKey);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");
+ id (toHtml identVal);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\">");
+ id (toHtml fragment) }
+
-- Check if we got its value back.
mp <- askParams
@@ -366,22 +385,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
renderTable aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
- let widget = [whamlet|
-$newline never
-$if null views
- \#{fragment}
-$forall (isFirst, view) <- addIsFirst views
- <tr :fvRequired view:.required :not $ fvRequired view:.optional>
- <td>
- $if isFirst
- \#{fragment}
- <label for=#{fvId view}>#{fvLabel view}
- $maybe tt <- fvTooltip view
- <div .tooltip>#{tt}
- <td>^{fvInput view}
- $maybe err <- fvErrors view
- <td .errors>#{err}
-|]
+ let widget = do { Text.Hamlet.condH
+ [(null views, (asWidgetT . toWidget) (toHtml fragment))] Nothing;
+ Data.Foldable.mapM_
+ (\ (isFirst_aNqW, view_aNqX)
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<tr");
+ Text.Hamlet.condH
+ [(or [fvRequired view_aNqX, not (fvRequired view_aNqX)],
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");
+ Text.Hamlet.condH
+ [(fvRequired view_aNqX,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))]
+ Nothing;
+ Text.Hamlet.condH
+ [(not (fvRequired view_aNqX),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "><td>");
+ Text.Hamlet.condH
+ [(isFirst_aNqW, (asWidgetT . toWidget) (toHtml fragment))] Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\"");
+ (asWidgetT . toWidget) (toHtml (fvId view_aNqX));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
+ (asWidgetT . toWidget) (toHtml (fvLabel view_aNqX));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>");
+ Text.Hamlet.maybeH
+ (fvTooltip view_aNqX)
+ (\ tt_aNqY
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<div class=\"tooltip\">");
+ (asWidgetT . toWidget) (toHtml tt_aNqY);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</td><td>");
+ (asWidgetT . toWidget) (fvInput view_aNqX);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>");
+ Text.Hamlet.maybeH
+ (fvErrors view_aNqX)
+ (\ err_aNqZ
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<td class=\"errors\">");
+ (asWidgetT . toWidget) (toHtml err_aNqZ);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>") })
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</tr>") })
+ (addIsFirst views) }
+
return (res, widget)
where
addIsFirst [] = []
@@ -397,19 +464,66 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a
renderDivsMaybeLabels withLabels aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
- let widget = [whamlet|
-$newline never
-\#{fragment}
-$forall view <- views
- <div :fvRequired view:.required :not $ fvRequired view:.optional>
- $if withLabels
- <label for=#{fvId view}>#{fvLabel view}
- $maybe tt <- fvTooltip view
- <div .tooltip>#{tt}
- ^{fvInput view}
- $maybe err <- fvErrors view
- <div .errors>#{err}
-|]
+ let widget = do { (asWidgetT . toWidget) (toHtml fragment);
+ Data.Foldable.mapM_
+ (\ view_aNsz
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<div");
+ Text.Hamlet.condH
+ [(or [fvRequired view_aNsz, not (fvRequired view_aNsz)],
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");
+ Text.Hamlet.condH
+ [(fvRequired view_aNsz,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))]
+ Nothing;
+ Text.Hamlet.condH
+ [(not (fvRequired view_aNsz),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ Text.Hamlet.condH
+ [(withLabels,
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\"");
+ (asWidgetT . toWidget) (toHtml (fvId view_aNsz));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
+ (asWidgetT . toWidget) (toHtml (fvLabel view_aNsz));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]
+ Nothing;
+ Text.Hamlet.maybeH
+ (fvTooltip view_aNsz)
+ (\ tt_aNsL
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<div class=\"tooltip\">");
+ (asWidgetT . toWidget) (toHtml tt_aNsL);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
+ Nothing;
+ (asWidgetT . toWidget) (fvInput view_aNsz);
+ Text.Hamlet.maybeH
+ (fvErrors view_aNsz)
+ (\ err_aNsP
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<div class=\"errors\">");
+ (asWidgetT . toWidget) (toHtml err_aNsP);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
+ views }
+
return (res, widget)
-- | Render a form using Bootstrap v2-friendly shamlet syntax.
@@ -437,19 +551,62 @@ renderBootstrap2 aform fragment = do
let views = views' []
has (Just _) = True
has Nothing = False
- let widget = [whamlet|
- $newline never
- \#{fragment}
- $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}
- |]
+ let widget = do { (asWidgetT . toWidget) (toHtml fragment);
+ Data.Foldable.mapM_
+ (\ view_aNw8
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<div class=\"control-group clearfix ");
+ Text.Hamlet.condH
+ [(fvRequired view_aNw8,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))]
+ Nothing;
+ Text.Hamlet.condH
+ [(not (fvRequired view_aNw8),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "optional "))]
+ Nothing;
+ Text.Hamlet.condH
+ [(has (fvErrors view_aNw8),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "error"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "\"><label class=\"control-label\" for=\"");
+ (asWidgetT . toWidget) (toHtml (fvId view_aNw8));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
+ (asWidgetT . toWidget) (toHtml (fvLabel view_aNw8));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "</label><div class=\"controls input\">");
+ (asWidgetT . toWidget) (fvInput view_aNw8);
+ Text.Hamlet.maybeH
+ (fvTooltip view_aNw8)
+ (\ tt_aNw9
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<span class=\"help-block\">");
+ (asWidgetT . toWidget) (toHtml tt_aNw9);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })
+ Nothing;
+ Text.Hamlet.maybeH
+ (fvErrors view_aNw8)
+ (\ err_aNwa
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<span class=\"help-block\">");
+ (asWidgetT . toWidget) (toHtml err_aNwa);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></div>") })
+ views }
+
return (res, widget)
-- | Deprecated synonym for 'renderBootstrap2'.
diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs
index 63e3d57..47503c2 100644
--- a/Yesod/Form/Jquery.hs
+++ b/Yesod/Form/Jquery.hs
@@ -18,11 +18,23 @@ import Yesod.Core
import Yesod.Form
import Data.Time (Day)
import Data.Default
-import Text.Hamlet (shamlet)
-import Text.Julius (julius, rawJS)
+import Text.Julius (rawJS)
import Data.Text (Text, pack, unpack)
import Data.Monoid (mconcat)
+import qualified Text.Blaze as Text.Blaze.Internal
+import qualified Text.Blaze.Internal
+import qualified Text.Hamlet
+import qualified Yesod.Core.Widget
+import qualified Text.Css
+import qualified Data.Monoid
+import qualified Data.Foldable
+import qualified Control.Monad
+import qualified Text.Julius
+import qualified Data.Text.Lazy.Builder
+import qualified Text.Shakespeare
+import qualified Data.Text.Lazy.Builder as Data.Text.Internal.Builder
+
-- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme.
googleHostedJqueryUiCss :: Text -> Text
googleHostedJqueryUiCss theme = mconcat
@@ -71,27 +83,54 @@ jqueryDayField' jds inputType = Field
. readMay
. unpack
, fieldView = \theId name attrs val isReq -> do
- toWidget [shamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="#{inputType}" :isReq:required="" value="#{showVal val}">
-|]
+ toWidget $ do { id
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"");
+ id (toHtml inputType);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ Text.Hamlet.condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ id (toHtml (showVal val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
- toWidget [julius|
-$(function(){
- var i = document.getElementById("#{rawJS theId}");
- if (i.type != "date") {
- $(i).datepicker({
- dateFormat:'yy-mm-dd',
- changeMonth:#{jsBool $ jdsChangeMonth jds},
- changeYear:#{jsBool $ jdsChangeYear jds},
- numberOfMonths:#{rawJS $ mos $ jdsNumberOfMonths jds},
- yearRange:#{toJSON $ jdsYearRange jds}
- });
- }
-});
-|]
+ toWidget $ Text.Julius.asJavascriptUrl
+ (\ _render_a3iGM
+ -> mconcat
+ [Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\n\n$(function(){\n\n var i = document.getElementById(\""),
+ Text.Julius.toJavascript (rawJS theId),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\");\n\n if (i.type != \"date\") {\n\n $(i).datepicker({\n\n dateFormat:'yy-mm-dd',\n\n changeMonth:"),
+ Text.Julius.toJavascript (jsBool (jdsChangeMonth jds)),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ ",\n\n changeYear:"),
+ Text.Julius.toJavascript (jsBool (jdsChangeYear jds)),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ ",\n\n numberOfMonths:"),
+ Text.Julius.toJavascript (rawJS (mos (jdsNumberOfMonths jds))),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ ",\n\n yearRange:"),
+ Text.Julius.toJavascript (toJSON (jdsYearRange jds)),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\n\n });\n\n }\n\n});")])
+
, fieldEnctype = UrlEncoded
}
where
@@ -118,16 +157,47 @@ jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site)
jqueryAutocompleteField' minLen src = Field
{ fieldParse = parseHelper $ Right
, fieldView = \theId name attrs val isReq -> do
- toWidget [shamlet|
-$newline never
-<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
-|]
+ toWidget $ do { id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<input class=\"autocomplete\" id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\"");
+ Text.Hamlet.condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
+ Nothing;
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
+ id (toHtml (either id id val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
+
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
- toWidget [julius|
-$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:#{toJSON minLen}})});
-|]
+ toWidget $ Text.Julius.asJavascriptUrl
+ (\ _render_a3iHO
+ -> mconcat
+ [Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\n\n$(function(){$(\"#"),
+ Text.Julius.toJavascript (rawJS theId),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\").autocomplete({source:\""),
+ Text.Julius.Javascript
+ (Data.Text.Internal.Builder.fromText (_render_a3iHO src [])),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\",minLength:"),
+ Text.Julius.toJavascript (toJSON minLen),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "})});")])
+
, fieldEnctype = UrlEncoded
}
diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs
index a2b434d..29b45b5 100644
--- a/Yesod/Form/MassInput.hs
+++ b/Yesod/Form/MassInput.hs
@@ -22,6 +22,16 @@ import Data.Traversable (sequenceA)
import qualified Data.Map as Map
import Data.Maybe (listToMaybe)
+import qualified Data.Text
+import qualified Text.Blaze as Text.Blaze.Internal
+import qualified Text.Blaze.Internal
+import qualified Text.Hamlet
+import qualified Yesod.Core.Widget
+import qualified Text.Css
+import qualified Data.Monoid
+import qualified Data.Foldable
+import qualified Control.Monad
+
down :: Monad m => Int -> MForm m ()
down 0 = return ()
down i | i < 0 = error "called down with a negative number"
@@ -70,16 +80,27 @@ inputList label fixXml single mdef = formToAForm $ do
{ fvLabel = label
, fvTooltip = Nothing
, fvId = theId
- , fvInput = [whamlet|
-$newline never
-^{fixXml views}
-<p>
- $forall xml <- xmls
- ^{xml}
- <input .count type=hidden name=#{countName} value=#{count}>
- <input type=checkbox name=#{addName}>
- Add another row
-|]
+ , fvInput = do { (asWidgetT . toWidget) (fixXml views);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<p>");
+ Data.Foldable.mapM_
+ (\ xml_a3hPg -> (asWidgetT . toWidget) xml_a3hPg) xmls;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<input class=\"count\" type=\"hidden\" name=\"");
+ (asWidgetT . toWidget) (toHtml countName);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "\" value=\"");
+ (asWidgetT . toWidget) (toHtml count);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "\"><input type=\"checkbox\" name=\"");
+ (asWidgetT . toWidget) (toHtml addName);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "\">Add another row</p>") }
+
, fvErrors = Nothing
, fvRequired = False
}])
@@ -92,10 +113,14 @@ withDelete af = do
deleteName <- newFormIdent
(menv, _, _) <- ask
res <- case menv >>= Map.lookup deleteName . fst of
- Just ("yes":_) -> return $ Left [whamlet|
-$newline never
-<input type=hidden name=#{deleteName} value=yes>
-|]
+ Just ("yes":_) -> return $ Left $ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<input type=\"hidden\" name=\"");
+ (asWidgetT . toWidget) (toHtml deleteName);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "\" value=\"yes\">") }
+
_ -> do
(_, xml2) <- aFormToForm $ areq checkBoxField FieldSettings
{ fsLabel = SomeMessage MsgDelete
@@ -121,32 +146,149 @@ fixme eithers =
massDivs, massTable
:: [[FieldView site]]
-> WidgetT site IO ()
-massDivs viewss = [whamlet|
-$newline never
-$forall views <- viewss
- <fieldset>
- $forall view <- views
- <div :fvRequired view:.required :not $ fvRequired view:.optional>
- <label for=#{fvId view}>#{fvLabel view}
- $maybe tt <- fvTooltip view
- <div .tooltip>#{tt}
- ^{fvInput view}
- $maybe err <- fvErrors view
- <div .errors>#{err}
-|]
+massDivs viewss = Data.Foldable.mapM_
+ (\ views_a3hPz
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<fieldset>");
+ Data.Foldable.mapM_
+ (\ view_a3hPA
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<div");
+ Text.Hamlet.condH
+ [(or [fvRequired view_a3hPA, not (fvRequired view_a3hPA)],
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ " class=\"");
+ Text.Hamlet.condH
+ [(fvRequired view_a3hPA,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "required "))]
+ Nothing;
+ Text.Hamlet.condH
+ [(not (fvRequired view_a3hPA),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "optional"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "\"") })]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "><label for=\"");
+ (asWidgetT . toWidget) (toHtml (fvId view_a3hPA));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");
+ (asWidgetT . toWidget) (toHtml (fvLabel view_a3hPA));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");
+ Text.Hamlet.maybeH
+ (fvTooltip view_a3hPA)
+ (\ tt_a3hPB
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<div class=\"tooltip\">");
+ (asWidgetT . toWidget) (toHtml tt_a3hPB);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</div>") })
+ Nothing;
+ (asWidgetT . toWidget) (fvInput view_a3hPA);
+ Text.Hamlet.maybeH
+ (fvErrors view_a3hPA)
+ (\ err_a3hPC
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<div class=\"errors\">");
+ (asWidgetT . toWidget) (toHtml err_a3hPC);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</div>") })
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</div>") })
+ views_a3hPz;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</fieldset>") })
+ viewss
+
+
+massTable viewss = Data.Foldable.mapM_
+ (\ views_a3hPH
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<fieldset><table>");
+ Data.Foldable.mapM_
+ (\ view_a3hPI
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<tr");
+ Text.Hamlet.condH
+ [(or [fvRequired view_a3hPI, not (fvRequired view_a3hPI)],
+ do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ " class=\"");
+ Text.Hamlet.condH
+ [(fvRequired view_a3hPI,
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "required "))]
+ Nothing;
+ Text.Hamlet.condH
+ [(not (fvRequired view_a3hPI),
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "optional"))]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "\"") })]
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "><td><label for=\"");
+ (asWidgetT . toWidget) (toHtml (fvId view_a3hPI));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");
+ (asWidgetT . toWidget) (toHtml (fvLabel view_a3hPI));
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");
+ Text.Hamlet.maybeH
+ (fvTooltip view_a3hPI)
+ (\ tt_a3hPJ
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<div class=\"tooltip\">");
+ (asWidgetT . toWidget) (toHtml tt_a3hPJ);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</div>") })
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</td><td>");
+ (asWidgetT . toWidget) (fvInput view_a3hPI);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</td>");
+ Text.Hamlet.maybeH
+ (fvErrors view_a3hPI)
+ (\ err_a3hPK
+ -> do { (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "<td class=\"errors\">");
+ (asWidgetT . toWidget) (toHtml err_a3hPK);
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</td>") })
+ Nothing;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</tr>") })
+ views_a3hPH;
+ (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
+ "</table></fieldset>") })
+ viewss
-massTable viewss = [whamlet|
-$newline never
-$forall views <- viewss
- <fieldset>
- <table>
- $forall view <- views
- <tr :fvRequired view:.required :not $ fvRequired view:.optional>
- <td>
- <label for=#{fvId view}>#{fvLabel view}
- $maybe tt <- fvTooltip view
- <div .tooltip>#{tt}
- <td>^{fvInput view}
- $maybe err <- fvErrors view
- <td .errors>#{err}
-|]
diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs
index 2862678..a773553 100644
--- a/Yesod/Form/Nic.hs
+++ b/Yesod/Form/Nic.hs
@@ -12,12 +12,24 @@ module Yesod.Form.Nic
import Yesod.Core
import Yesod.Form
import Text.HTML.SanitizeXSS (sanitizeBalance)
-import Text.Hamlet (shamlet)
-import Text.Julius (julius, rawJS)
+import Text.Julius (rawJS)
import Text.Blaze.Html.Renderer.String (renderHtml)
import Data.Text (Text, pack)
import Data.Maybe (listToMaybe)
+import qualified Text.Blaze as Text.Blaze.Internal
+import qualified Text.Blaze.Internal
+import qualified Text.Hamlet
+import qualified Yesod.Core.Widget
+import qualified Text.Css
+import qualified Data.Monoid
+import qualified Data.Foldable
+import qualified Control.Monad
+import qualified Text.Julius
+import qualified Data.Text.Lazy.Builder
+import qualified Data.Text.Lazy.Builder as Data.Text.Internal.Builder
+import qualified Text.Shakespeare
+
class Yesod a => YesodNic a where
-- | NIC Editor Javascript file.
urlNicEdit :: a -> Either (Route a) Text
@@ -27,20 +39,44 @@ nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html
nicHtmlField = Field
{ fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e
, fieldView = \theId name attrs val _isReq -> do
- toWidget [shamlet|
-$newline never
- <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
-|]
+ toWidget $ do { id
+ ((Text.Blaze.Internal.preEscapedText . pack)
+ "<textarea class=\"html\" id=\"");
+ id (toHtml theId);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ id (toHtml (showVal val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }
+
addScript' urlNicEdit
master <- getYesod
toWidget $
case jsLoader master of
- BottomOfHeadBlocking -> [julius|
-bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")});
-|]
- _ -> [julius|
-(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})();
-|]
+ BottomOfHeadBlocking -> Text.Julius.asJavascriptUrl
+ (\ _render_a3hYy
+ -> Data.Monoid.mconcat
+ [Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\n\nbkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance(\""),
+ Text.Julius.toJavascript (rawJS theId),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\")});")])
+
+ _ -> Text.Julius.asJavascriptUrl
+ (\ _render_a3i1Q
+ -> Data.Monoid.mconcat
+ [Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\n\n(function(){new nicEditor({fullPanel:true}).panelInstance(\""),
+ Text.Julius.toJavascript (rawJS theId),
+ Text.Julius.Javascript
+ ((Data.Text.Internal.Builder.fromText . Text.Shakespeare.pack')
+ "\")})();")])
+
, fieldEnctype = UrlEncoded
}
where
diff --git a/yesod-form.cabal b/yesod-form.cabal
index 7849763..9694fe1 100644
--- a/yesod-form.cabal
+++ b/yesod-form.cabal
@@ -23,7 +23,7 @@ library
, yesod-core >= 1.4 && < 1.5
, yesod-persistent >= 1.4 && < 1.5
, time >= 1.1.4
- , shakespeare >= 2.0
+ , shakespeare >= 2.0.5
, persistent
, template-haskell
, transformers >= 0.2.2
--
2.1.4