From f98c22ec71695537e0e008a0bd54affdf8a60f64 Mon Sep 17 00:00:00 2001 From: Joey Hess 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 - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amMY + -> do { 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 - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amNa + -> do { 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 - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amNk + -> do { 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 - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amNx + -> do { 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 -") } + , 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 -") } + , 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 - -|] + , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_amNZ + -> do { 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 - -|] + do { 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 - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amOg + -> do { 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 - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_amOO + -> do { 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 - -|] + do { toWidget + ((Text.Blaze.Internal.preEscapedText . pack) "") } + when autoFocus $ do -- we want this javascript to be placed immediately after the field - [whamlet| -$newline never -") } + + 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 - -|] + do { 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 -"); + toWidget inside; + toWidget + ((Text.Blaze.Internal.preEscapedText . pack) "") }) + -- outside + (\_theId _name isSel -> do { toWidget + ((Text.Blaze.Internal.preEscapedText . pack) + "") }) + -- onOpt + (\_theId _name _attrs value isSel text -> do { toWidget + ((Text.Blaze.Internal.preEscapedText . pack) "") }) + -- 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 - "); + Data.Foldable.mapM_ + (\ (opt_amPV, optsel_amPW) + -> do { toWidget + ((Text.Blaze.Internal.preEscapedText . pack) "") }) + selOpts; + toWidget + ((Text.Blaze.Internal.preEscapedText . pack) "") } + 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 -
^{inside} -|]) - (\theId name isSel -> [whamlet| -$newline never -