1606 lines
74 KiB
Diff
1606 lines
74 KiB
Diff
From f98c22ec71695537e0e008a0bd54affdf8a60f64 Mon Sep 17 00:00:00 2001
|
|
From: Joey Hess <joey@kitenet.net>
|
|
Date: Mon, 15 Apr 2013 17:35:57 -0400
|
|
Subject: [PATCH 2/2] expand TH
|
|
|
|
Used the EvilSplicer, and then some manual fixups, as it is apparently
|
|
buggy. Also a few module import fixes.
|
|
---
|
|
Yesod/Form/Fields.hs | 623 ++++++++++++++++++++++++++++++++++++++----------
|
|
Yesod/Form/Functions.hs | 240 +++++++++++++++----
|
|
Yesod/Form/Jquery.hs | 141 ++++++++---
|
|
Yesod/Form/MassInput.hs | 228 ++++++++++++++----
|
|
Yesod/Form/Nic.hs | 59 ++++-
|
|
5 files changed, 1042 insertions(+), 249 deletions(-)
|
|
|
|
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
|
|
index 7917ce2..db76ea2 100644
|
|
--- a/Yesod/Form/Fields.hs
|
|
+++ b/Yesod/Form/Fields.hs
|
|
@@ -46,11 +46,22 @@ module Yesod.Form.Fields
|
|
, optionsEnum
|
|
) where
|
|
|
|
+import qualified Data.Text.Lazy.Builder
|
|
+import qualified Text.Shakespeare
|
|
+import qualified Data.Monoid
|
|
+import qualified Text.Julius
|
|
+import qualified "blaze-markup" Text.Blaze.Internal
|
|
+import qualified "blaze-markup" Text.Blaze as Text.Blaze.Internal
|
|
+import qualified "blaze-html" Text.Blaze.Html
|
|
+import qualified Yesod.Widget
|
|
+import qualified Text.Css
|
|
+import qualified Control.Monad
|
|
+import qualified Data.Foldable
|
|
import Yesod.Form.Types
|
|
import Yesod.Form.I18n.English
|
|
import Yesod.Form.Functions (parseHelper)
|
|
import Yesod.Handler (getMessageRender)
|
|
-import Yesod.Widget (toWidget, whamlet, GWidget)
|
|
+import Yesod.Widget (toWidget, GWidget)
|
|
import Yesod.Message (RenderMessage (renderMessage), SomeMessage (..))
|
|
import Text.Hamlet
|
|
import Text.Blaze (ToMarkup (toMarkup), preEscapedToMarkup, unsafeByteString)
|
|
@@ -108,10 +119,24 @@ 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" :isReq:required="" value="#{showVal val}">
|
|
-|]
|
|
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amMY
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"number\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
|
|
+ Nothing;
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
|
|
+ id (Text.Blaze.Html.toHtml (showVal val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where
|
|
@@ -125,10 +150,24 @@ 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="text" :isReq:required="" value="#{showVal val}">
|
|
-|]
|
|
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amNa
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.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 (Text.Blaze.Html.toHtml (showVal val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where showVal = either id (pack . show)
|
|
@@ -136,10 +175,24 @@ $newline never
|
|
dayField :: RenderMessage master FormMessage => Field sub master 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_amNk
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
|
|
+ Nothing;
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
|
|
+ id (Text.Blaze.Html.toHtml (showVal val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where showVal = either id (pack . show)
|
|
@@ -147,10 +200,23 @@ $newline never
|
|
timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
|
|
timeField = Field
|
|
{ fieldParse = parseHelper parseTime
|
|
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
|
-$newline never
|
|
-<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}">
|
|
-|]
|
|
+ , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amNx
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ 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 (Text.Blaze.Html.toHtml (showVal val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where
|
|
@@ -163,10 +229,18 @@ $newline never
|
|
htmlField :: RenderMessage master FormMessage => Field sub master Html
|
|
htmlField = Field
|
|
{ fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance
|
|
- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
|
|
-$newline never
|
|
-<textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val}
|
|
-|]
|
|
+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_amNH
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ id (Text.Blaze.Html.toHtml (showVal val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where showVal = either id (pack . renderHtml)
|
|
@@ -192,10 +266,18 @@ instance ToHtml Textarea where
|
|
textareaField :: RenderMessage master FormMessage => Field sub master Textarea
|
|
textareaField = Field
|
|
{ fieldParse = parseHelper $ Right . Textarea
|
|
- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
|
|
-$newline never
|
|
-<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val}
|
|
-|]
|
|
+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_amNQ
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<textarea id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ id (Text.Blaze.Html.toHtml (either id unTextarea val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -203,10 +285,19 @@ hiddenField :: (PathPiece p, RenderMessage master FormMessage)
|
|
=> Field sub master 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_amNZ
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<input type=\"hidden\" id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");
|
|
+ id (Text.Blaze.Html.toHtml (either id toPathPiece val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -214,20 +305,50 @@ textField :: RenderMessage master FormMessage => Field sub master Text
|
|
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 { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"text\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml (either id id val));
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
passwordField :: RenderMessage master FormMessage => Field sub master 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_amOg
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "\" type=\"password\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
|
|
+ Nothing;
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
|
|
+ id (Text.Blaze.Html.toHtml (either id id val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -305,10 +426,24 @@ emailField = Field
|
|
then Right s
|
|
else Left $ MsgInvalidEmail s
|
|
#endif
|
|
- , 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_amOO
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"email\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
|
|
+ Nothing;
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
|
|
+ id (Text.Blaze.Html.toHtml (either id id val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -317,20 +452,60 @@ searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master
|
|
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 { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"search\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
|
|
+ Nothing;
|
|
+ Text.Hamlet.condH
|
|
+ [(autoFocus,
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " autofocus=\"\""))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml (either id id val));
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ 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 { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "').focus();}</script>") }
|
|
+
|
|
+ toWidget $ \ _render_amP5
|
|
+ -> (Text.Css.CssNoWhitespace
|
|
+ . (foldr ($) []))
|
|
+ [((++)
|
|
+ $ (map
|
|
+ Text.Css.Css
|
|
+ ((((:)
|
|
+ (Text.Css.Css'
|
|
+ (Data.Monoid.mconcat [toCss theId])
|
|
+ [(Data.Monoid.mconcat
|
|
+ [(Text.Css.fromText
|
|
+ . Text.Css.pack)
|
|
+ "-webkit-appearance"],
|
|
+ Data.Monoid.mconcat
|
|
+ [(Text.Css.fromText
|
|
+ . Text.Css.pack)
|
|
+ "textfield"])]))
|
|
+ . (foldr (.) id []))
|
|
+ [])))]
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -341,10 +516,25 @@ urlField = Field
|
|
Nothing -> Left $ MsgInvalidUrl s
|
|
Just _ -> Right s
|
|
, fieldView = \theId name attrs val isReq ->
|
|
- [whamlet|
|
|
-$newline never
|
|
-<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>
|
|
-|]
|
|
+ do { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"url\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml (either id id val));
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -353,18 +543,48 @@ selectFieldList = selectField . optionsPairs
|
|
|
|
selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master 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 { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ toWidget inside;
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") })
|
|
+ -- outside
|
|
+ (\_theId _name isSel -> do { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<option value=\"none\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isSel,
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .))
|
|
+ $ (Yesod.Widget.liftW getMessageRender))
|
|
+ >>= (\ urender_amPs -> toWidget (urender_amPs MsgSelectNone)));
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })
|
|
+ -- onOpt
|
|
+ (\_theId _name _attrs value isSel text -> do { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml value);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isSel,
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ toWidget (Text.Blaze.Html.toHtml text);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })
|
|
+ -- inside
|
|
|
|
multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a]
|
|
multiSelectFieldList = multiSelectField . optionsPairs
|
|
@@ -385,12 +605,40 @@ multiSelectField ioptlist =
|
|
view theId name attrs val isReq = do
|
|
opts <- fmap olOptions $ lift ioptlist
|
|
let selOpts = map (id &&& (optselected val)) opts
|
|
- [whamlet|
|
|
-$newline never
|
|
- <select ##{theId} name=#{name} :isReq:required multiple *{attrs}>
|
|
- $forall (opt, optsel) <- selOpts
|
|
- <option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt}
|
|
- |]
|
|
+ do { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<select id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " required"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " multiple");
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ Data.Foldable.mapM_
|
|
+ (\ (opt_amPV, optsel_amPW)
|
|
+ -> do { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<option value=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml (optionExternalValue opt_amPV));
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(optsel_amPW,
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " selected"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ toWidget (Text.Blaze.Html.toHtml (optionDisplay opt_amPV));
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</option>") })
|
|
+ selOpts;
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</select>") }
|
|
+
|
|
where
|
|
optselected (Left _) _ = False
|
|
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
|
|
@@ -400,41 +648,140 @@ radioFieldList = radioField . optionsPairs
|
|
|
|
radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master 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 { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<div id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\">");
|
|
+ toWidget inside;
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
|
|
+
|
|
+ (\theId name isSel -> do { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<label class=\"radio\" for=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "-none\"><div><input id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "-none\" type=\"radio\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"none\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isSel,
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .))
|
|
+ $ (Yesod.Widget.liftW getMessageRender))
|
|
+ >>= (\ urender_amQa -> toWidget (urender_amQa MsgSelectNone)));
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })
|
|
+
|
|
+ (\theId name attrs value isSel text -> do { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<label class=\"radio\" for=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-");
|
|
+ toWidget (Text.Blaze.Html.toHtml value);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "\"><div><input id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-");
|
|
+ toWidget (Text.Blaze.Html.toHtml value);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "\" type=\"radio\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml value);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isSel,
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ toWidget (Text.Blaze.Html.toHtml text);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></label>") })
|
|
+
|
|
|
|
boolField :: RenderMessage master FormMessage => Field sub master 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}
|
|
-
|
|
+ , fieldView = \theId name attrs val isReq -> do { Text.Hamlet.condH
|
|
+ [(not isReq,
|
|
+ do { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "-none\" type=\"radio\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "\" value=\"none\" checked");
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-none\">");
|
|
+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .))
|
|
+ $ (Yesod.Widget.liftW getMessageRender))
|
|
+ >>= (\ urender_amQx -> toWidget (urender_amQx MsgSelectNone)));
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]
|
|
+ Nothing;
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "-yes\" type=\"radio\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(showVal id val,
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-yes\">");
|
|
+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .))
|
|
+ $ (Yesod.Widget.liftW getMessageRender))
|
|
+ >>= (\ urender_amQy -> toWidget (urender_amQy MsgBoolYes)));
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "</label><input id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "-no\" type=\"radio\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"no\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(showVal not val,
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "><label for=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "-no\">");
|
|
+ (((Control.Monad.liftM (Text.Blaze.Html.toHtml .))
|
|
+ $ (Yesod.Widget.liftW getMessageRender))
|
|
+ >>= (\ urender_amQz -> toWidget (urender_amQz MsgBoolNo)));
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "</label>") }
|
|
|
|
-<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>
|
|
-<label for=#{theId}-yes>_{MsgBoolYes}
|
|
-
|
|
-<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked>
|
|
-<label for=#{theId}-no>_{MsgBoolNo}
|
|
-|]
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where
|
|
@@ -458,10 +805,22 @@ $newline never
|
|
checkBoxField :: RenderMessage m FormMessage => Field s 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 { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml theId);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "\" type=\"checkbox\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"yes\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(showVal id val,
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) " checked"))]
|
|
+ Nothing;
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -566,9 +925,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_amRu
|
|
+ -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ id (Text.Blaze.Html.toHtml id');
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"file\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required"))]
|
|
+ Nothing;
|
|
+ id ((Text.Hamlet.attrsToHtml . toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fieldEnctype = Multipart
|
|
}
|
|
|
|
@@ -594,10 +965,16 @@ fileAFormReq 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 { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<input type=\"file\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml id');
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs));
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fvErrors = errs
|
|
, fvRequired = True
|
|
}
|
|
@@ -623,10 +1000,16 @@ 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 { toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<input type=\"file\" name=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml name);
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\" id=\"");
|
|
+ toWidget (Text.Blaze.Html.toHtml id');
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ toWidget ((Text.Hamlet.attrsToHtml . toAttributes) (fsAttrs fs));
|
|
+ toWidget ((Text.Blaze.Internal.preEscapedText . pack) ">") }
|
|
+
|
|
, fvErrors = errs
|
|
, fvRequired = False
|
|
}
|
|
diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
|
|
index 89eb1e8..54974bb 100644
|
|
--- a/Yesod/Form/Functions.hs
|
|
+++ b/Yesod/Form/Functions.hs
|
|
@@ -42,6 +42,15 @@ module Yesod.Form.Functions
|
|
, parseHelper
|
|
) where
|
|
|
|
+import qualified Data.Text.Lazy.Builder
|
|
+import qualified Text.Shakespeare
|
|
+import qualified Data.Monoid
|
|
+import qualified Text.Julius
|
|
+import qualified "blaze-markup" Text.Blaze.Internal
|
|
+import qualified "blaze-markup" Text.Blaze as Text.Blaze.Markup
|
|
+import qualified Yesod.Widget
|
|
+import qualified Data.Foldable
|
|
+import qualified Text.Hamlet
|
|
import Yesod.Form.Types
|
|
import Data.Text (Text, pack)
|
|
import Control.Arrow (second)
|
|
@@ -191,10 +200,13 @@ postHelper form env = do
|
|
let token =
|
|
case reqToken req of
|
|
Nothing -> mempty
|
|
- Just n -> [shamlet|
|
|
-$newline never
|
|
-<input type=hidden name=#{tokenKey} value=#{n}>
|
|
-|]
|
|
+ Just n -> do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<input type=\"hidden\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml tokenKey);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" value=\"");
|
|
+ id (Text.Blaze.Html.toHtml n);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\">") }
|
|
m <- getYesod
|
|
langs <- languages
|
|
((res, xml), enctype) <- runFormGeneric (form token) m langs env
|
|
@@ -253,10 +265,11 @@ getKey = "_hasdata"
|
|
|
|
getHelper :: (Html -> MForm sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype)
|
|
getHelper form env = do
|
|
- let fragment = [shamlet|
|
|
-$newline never
|
|
-<input type=hidden name=#{getKey}>
|
|
-|]
|
|
+ let fragment = do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<input type=\"hidden\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml getKey);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\">") }
|
|
langs <- languages
|
|
m <- getYesod
|
|
runFormGeneric (form fragment) m langs env
|
|
@@ -270,19 +283,64 @@ renderTable, renderDivs, renderDivsNoLabels :: FormRender sub master a
|
|
renderTable aform fragment = do
|
|
(res, views') <- aFormToForm aform
|
|
let views = views' []
|
|
- let widget = [whamlet|
|
|
-$newline never
|
|
-\#{fragment}
|
|
-$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}
|
|
-|]
|
|
+ let widget = do { Yesod.Widget.toWidget (Text.Blaze.Html.toHtml fragment);
|
|
+ Data.Foldable.mapM_
|
|
+ (\ view_a9GR
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<tr");
|
|
+ Text.Hamlet.condH
|
|
+ [(or [fvRequired view_a9GR, not (fvRequired view_a9GR)],
|
|
+ do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(fvRequired view_a9GR,
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))]
|
|
+ Nothing;
|
|
+ Text.Hamlet.condH
|
|
+ [(not (fvRequired view_a9GR),
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })]
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "><td><label for=\"");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_a9GR));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_a9GR));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>");
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvTooltip view_a9GR)
|
|
+ (\ tt_a9GS
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<div class=\"tooltip\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_a9GS);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</td><td>");
|
|
+ Yesod.Widget.toWidget (fvInput view_a9GR);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>");
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvErrors view_a9GR)
|
|
+ (\ err_a9GT
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<td class=\"errors\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_a9GT);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</td>") })
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</tr>") })
|
|
+ views }
|
|
return (res, widget)
|
|
|
|
-- | render a field inside a div
|
|
@@ -295,19 +353,65 @@ renderDivsMaybeLabels :: Bool -> FormRender sub master 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 { Yesod.Widget.toWidget (Text.Blaze.Html.toHtml fragment);
|
|
+ Data.Foldable.mapM_
|
|
+ (\ view_a9Hr
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<div");
|
|
+ Text.Hamlet.condH
|
|
+ [(or [fvRequired view_a9Hr, not (fvRequired view_a9Hr)],
|
|
+ do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) " class=\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(fvRequired view_a9Hr,
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))]
|
|
+ Nothing;
|
|
+ Text.Hamlet.condH
|
|
+ [(not (fvRequired view_a9Hr),
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "optional"))]
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\"") })]
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ Text.Hamlet.condH
|
|
+ [(withLabels,
|
|
+ do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<label for=\"");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_a9Hr));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_a9Hr));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") })]
|
|
+ Nothing;
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvTooltip view_a9Hr)
|
|
+ (\ tt_a9Hs
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<div class=\"tooltip\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_a9Hs);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget (fvInput view_a9Hr);
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvErrors view_a9Hr)
|
|
+ (\ err_a9Ht
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<div class=\"errors\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_a9Ht);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div>") })
|
|
+ views }
|
|
return (res, widget)
|
|
|
|
-- | Render a form using Bootstrap-friendly shamlet syntax.
|
|
@@ -331,19 +435,61 @@ renderBootstrap 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 { Yesod.Widget.toWidget (Text.Blaze.Html.toHtml fragment);
|
|
+ Data.Foldable.mapM_
|
|
+ (\ view_a9HE
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<div class=\"control-group clearfix ");
|
|
+ Text.Hamlet.condH
|
|
+ [(fvRequired view_a9HE,
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "required "))]
|
|
+ Nothing;
|
|
+ Text.Hamlet.condH
|
|
+ [(not (fvRequired view_a9HE),
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "optional "))]
|
|
+ Nothing;
|
|
+ Text.Hamlet.condH
|
|
+ [(has (fvErrors view_a9HE),
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "error"))]
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "\"><label class=\"control-label\" for=\"");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_a9HE));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_a9HE));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "</label><div class=\"controls input\">");
|
|
+ Yesod.Widget.toWidget (fvInput view_a9HE);
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvTooltip view_a9HE)
|
|
+ (\ tt_a9HF
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<span class=\"help-block\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_a9HF);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })
|
|
+ Nothing;
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvErrors view_a9HE)
|
|
+ (\ err_a9HG
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<span class=\"help-block\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_a9HG);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</span>") })
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "</div></div>") })
|
|
+ views }
|
|
return (res, widget)
|
|
|
|
check :: RenderMessage master msg
|
|
diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs
|
|
index 85a0c76..70ac315 100644
|
|
--- a/Yesod/Form/Jquery.hs
|
|
+++ b/Yesod/Form/Jquery.hs
|
|
@@ -12,14 +12,22 @@ module Yesod.Form.Jquery
|
|
, Default (..)
|
|
) where
|
|
|
|
+import qualified Data.Text.Lazy.Builder
|
|
+import qualified Text.Shakespeare
|
|
+import qualified Data.Monoid
|
|
+import qualified Text.Julius
|
|
+import qualified "blaze-markup" Text.Blaze.Internal
|
|
+import qualified "blaze-html" Text.Blaze.Html
|
|
+import qualified Yesod.Widget
|
|
+import qualified Text.Hamlet
|
|
+import qualified Text.Julius
|
|
import Yesod.Handler
|
|
import Yesod.Core (Route)
|
|
import Yesod.Form
|
|
import Yesod.Widget
|
|
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 Yesod.Core (RenderMessage)
|
|
@@ -64,27 +72,75 @@ jqueryDayField jds = Field
|
|
. readMay
|
|
. unpack
|
|
, fieldView = \theId name attrs val isReq -> do
|
|
- toWidget [shamlet|
|
|
-$newline never
|
|
-<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
|
|
-|]
|
|
+ toWidget $ do { id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "<input id=\"");
|
|
+ id (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack) "\" type=\"date\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(isReq,
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required=\"\""))]
|
|
+ Nothing;
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) " value=\"");
|
|
+ id (Text.Blaze.Html.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_a1esc
|
|
+ -> mconcat
|
|
+ [Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "\
|
|
+ \$(function(){\
|
|
+ \ var i = document.getElementById(\""),
|
|
+ Text.Julius.Javascript (Text.Julius.toJavascript (rawJS theId)),
|
|
+ Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "\");\
|
|
+ \ if (i.type != \"date\") {\
|
|
+ \ $(i).datepicker({\
|
|
+ \ 'yy-mm-dd',\
|
|
+ \ changeMonth:"),
|
|
+ Text.Julius.Javascript
|
|
+ (Text.Julius.toJavascript (jsBool (jdsChangeMonth jds))),
|
|
+ Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ ",\
|
|
+ \ changeYear:"),
|
|
+ Text.Julius.Javascript
|
|
+ (Text.Julius.toJavascript (jsBool (jdsChangeYear jds))),
|
|
+ Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ ",\
|
|
+ \ numberOfMonths:"),
|
|
+ Text.Julius.Javascript
|
|
+ (Text.Julius.toJavascript (rawJS (mos (jdsNumberOfMonths jds)))),
|
|
+ Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ ",\
|
|
+ \ yearRange:"),
|
|
+ Text.Julius.Javascript
|
|
+ (Text.Julius.toJavascript (toJSON (jdsYearRange jds))),
|
|
+ Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "\
|
|
+ \ });\
|
|
+ \ }\
|
|
+ \});")])
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where
|
|
@@ -105,16 +161,47 @@ jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master
|
|
jqueryAutocompleteField 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 (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.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 (Text.Blaze.Html.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:2})});
|
|
-|]
|
|
+ toWidget $ Text.Julius.asJavascriptUrl
|
|
+ (\ _render_a1esq
|
|
+ -> mconcat
|
|
+ [Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "\
|
|
+ \$(function(){$(\"#"),
|
|
+ Text.Julius.Javascript (Text.Julius.toJavascript (rawJS theId)),
|
|
+ Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "\").autocomplete({source:\""),
|
|
+ Text.Julius.Javascript
|
|
+ (Data.Text.Lazy.Builder.fromText (_render_a1esq src [])),
|
|
+ Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "\",2})});")])
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs
|
|
index 62e89d6..22fdad5 100644
|
|
--- a/Yesod/Form/MassInput.hs
|
|
+++ b/Yesod/Form/MassInput.hs
|
|
@@ -9,10 +9,20 @@ module Yesod.Form.MassInput
|
|
, massTable
|
|
) where
|
|
|
|
+import qualified Data.Text.Lazy.Builder
|
|
+import qualified Text.Shakespeare
|
|
+import qualified Data.Monoid
|
|
+import qualified Text.Julius
|
|
+import qualified "blaze-markup" Text.Blaze.Internal
|
|
+import qualified "blaze-html" Text.Blaze.Html
|
|
+import qualified Yesod.Widget
|
|
+import qualified Data.Text
|
|
+import qualified Text.Hamlet
|
|
+import qualified Data.Foldable
|
|
import Yesod.Form.Types
|
|
import Yesod.Form.Functions
|
|
import Yesod.Form.Fields (boolField)
|
|
-import Yesod.Widget (GWidget, whamlet)
|
|
+import Yesod.Widget (GWidget)
|
|
import Yesod.Message (RenderMessage)
|
|
import Yesod.Handler (newIdent, GHandler)
|
|
import Text.Blaze.Html (Html)
|
|
@@ -75,16 +85,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 { Yesod.Widget.toWidget (fixXml views);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<p>");
|
|
+ Data.Foldable.mapM_
|
|
+ (\ xml_aOR7 -> Yesod.Widget.toWidget xml_aOR7) xmls;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "<input class=\"count\" type=\"hidden\" name=\"");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml countName);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "\" value=\"");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml count);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "\"><input type=\"checkbox\" name=\"");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml addName);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "\">Add another row</p>") }
|
|
+
|
|
, fvErrors = Nothing
|
|
, fvRequired = False
|
|
}])
|
|
@@ -97,10 +118,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 { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "<input type=\"hidden\" name=\"");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml deleteName);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "\" value=\"yes\">") }
|
|
+
|
|
_ -> do
|
|
(_, xml2) <- aFormToForm $ areq boolField FieldSettings
|
|
{ fsLabel = SomeMessage MsgDelete
|
|
@@ -126,32 +151,149 @@ fixme eithers =
|
|
massDivs, massTable
|
|
:: [[FieldView sub master]]
|
|
-> GWidget sub master ()
|
|
-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_aORq
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "<fieldset>");
|
|
+ Data.Foldable.mapM_
|
|
+ (\ view_aORr
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<div");
|
|
+ Text.Hamlet.condH
|
|
+ [(or [fvRequired view_aORr, not (fvRequired view_aORr)],
|
|
+ do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ " class=\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(fvRequired view_aORr,
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "required "))]
|
|
+ Nothing;
|
|
+ Text.Hamlet.condH
|
|
+ [(not (fvRequired view_aORr),
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "optional"))]
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "\"") })]
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "><label for=\"");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_aORr));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_aORr));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvTooltip view_aORr)
|
|
+ (\ tt_aORs
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "<div class=\"tooltip\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_aORs);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "</div>") })
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget (fvInput view_aORr);
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvErrors view_aORr)
|
|
+ (\ err_aORt
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "<div class=\"errors\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_aORt);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "</div>") })
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</div>") })
|
|
+ views_aORq;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "</fieldset>") })
|
|
+ viewss
|
|
+
|
|
+
|
|
+massTable viewss = Data.Foldable.mapM_
|
|
+ (\ views_aORy
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "<fieldset><table>");
|
|
+ Data.Foldable.mapM_
|
|
+ (\ view_aORz
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "<tr");
|
|
+ Text.Hamlet.condH
|
|
+ [(or [fvRequired view_aORz, not (fvRequired view_aORz)],
|
|
+ do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ " class=\"");
|
|
+ Text.Hamlet.condH
|
|
+ [(fvRequired view_aORz,
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "required "))]
|
|
+ Nothing;
|
|
+ Text.Hamlet.condH
|
|
+ [(not (fvRequired view_aORz),
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "optional"))]
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "\"") })]
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "><td><label for=\"");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvId view_aORz));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml (fvLabel view_aORz));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</label>");
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvTooltip view_aORz)
|
|
+ (\ tt_aORA
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "<div class=\"tooltip\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml tt_aORA);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "</div>") })
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "</td><td>");
|
|
+ Yesod.Widget.toWidget (fvInput view_aORz);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</td>");
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvErrors view_aORz)
|
|
+ (\ err_aORB
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "<td class=\"errors\">");
|
|
+ Yesod.Widget.toWidget (Text.Blaze.Html.toHtml err_aORB);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
|
|
+ "</td>") })
|
|
+ Nothing;
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . Data.Text.pack) "</tr>") })
|
|
+ views_aORy;
|
|
+ Yesod.Widget.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 7c65ce4..357532f 100644
|
|
--- a/Yesod/Form/Nic.hs
|
|
+++ b/Yesod/Form/Nic.hs
|
|
@@ -9,13 +9,19 @@ module Yesod.Form.Nic
|
|
, nicHtmlField
|
|
) where
|
|
|
|
+import qualified Data.Text.Lazy.Builder
|
|
+import qualified Text.Shakespeare
|
|
+import qualified Data.Monoid
|
|
+import qualified Text.Julius
|
|
+import qualified "blaze-markup" Text.Blaze.Internal
|
|
+import qualified Yesod.Widget
|
|
import Yesod.Handler
|
|
import Yesod.Core (Route, ScriptLoadPosition(..), jsLoader, Yesod)
|
|
import Yesod.Form
|
|
import Yesod.Widget
|
|
import Text.HTML.SanitizeXSS (sanitizeBalance)
|
|
-import Text.Hamlet (Html, shamlet)
|
|
-import Text.Julius (julius, rawJS)
|
|
+import Text.Hamlet (Html)
|
|
+import Text.Julius (rawJS)
|
|
#if MIN_VERSION_blaze_html(0, 5, 0)
|
|
import Text.Blaze (preEscapedToMarkup)
|
|
import Text.Blaze.Html.Renderer.String (renderHtml)
|
|
@@ -36,20 +42,49 @@ nicHtmlField :: YesodNic master => Field sub master Html
|
|
nicHtmlField = Field
|
|
{ fieldParse = \e _ -> return . Right . fmap (preEscapedText . 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 (Text.Blaze.Html.toHtml theId);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
|
|
+ id (Text.Blaze.Html.toHtml name);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
|
|
+ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">");
|
|
+ id (Text.Blaze.Html.toHtml (showVal val));
|
|
+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }
|
|
+
|
|
addScript' urlNicEdit
|
|
master <- lift 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_a1itM
|
|
+ -> Data.Monoid.mconcat
|
|
+ [Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "\
|
|
+ \bkLib.onDomLoaded(function(){new nicEditor({true}).panelInstance(\""),
|
|
+ Text.Julius.Javascript (Text.Julius.toJavascript (rawJS theId)),
|
|
+ Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "\")});")])
|
|
+
|
|
+ _ -> Text.Julius.asJavascriptUrl
|
|
+ (\ _render_a1itQ
|
|
+ -> Data.Monoid.mconcat
|
|
+ [Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "(function(){new nicEditor({true}).panelInstance(\""),
|
|
+ Text.Julius.Javascript (Text.Julius.toJavascript (rawJS theId)),
|
|
+ Text.Julius.Javascript
|
|
+ ((Data.Text.Lazy.Builder.fromText
|
|
+ . Text.Shakespeare.pack')
|
|
+ "\")})();")])
|
|
+
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where
|
|
--
|
|
1.8.2.rc3
|
|
|