From 3a17bd1223fcd7a750bc0e5e94ec5b97ad2e573b Mon Sep 17 00:00:00 2001 From: foo Date: Sun, 22 Sep 2013 05:14:21 +0000 Subject: [PATCH] spliced TH Used EvilSplicer. Needed a few syntax fixes, and a lot of added imports. --- Yesod/Form/Fields.hs | 747 ++++++++++++++++++++++++++++++++++++----------- Yesod/Form/Functions.hs | 237 ++++++++++++--- Yesod/Form/Jquery.hs | 125 ++++++-- Yesod/Form/MassInput.hs | 233 ++++++++++++--- Yesod/Form/Nic.hs | 61 +++- yesod-form.cabal | 1 + 6 files changed, 1123 insertions(+), 281 deletions(-) diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs index 5c16d7e..edd9715 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -41,8 +41,6 @@ module Yesod.Form.Fields , Option (..) , OptionList (..) , mkOptionList - , optionsPersist - , optionsPersistKey , optionsPairs , optionsEnum ) where @@ -68,6 +66,15 @@ import Text.HTML.SanitizeXSS (sanitizeBalance) import Control.Monad (when, unless) 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) @@ -80,14 +87,12 @@ import Data.Text (Text, unpack, pack) import qualified Data.Text.Read import qualified Data.Map as Map -import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery, YesodDB) import Control.Arrow ((&&&)) import Control.Applicative ((<$>), (<|>)) import Data.Attoparsec.Text (Parser, char, string, digit, skipSpace, endOfInput, parseOnly) -import Yesod.Persist.Core defaultFormMessage :: FormMessage -> Text defaultFormMessage = englishFormMessage @@ -100,10 +105,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_arOn + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "") } + , fieldEnctype = UrlEncoded } where @@ -117,10 +136,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_arOz + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "") } + , fieldEnctype = UrlEncoded } where showVal = either id (pack . show) @@ -128,10 +161,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 - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arOJ + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "") } + , fieldEnctype = UrlEncoded } where showVal = either id (pack . show) @@ -139,10 +186,23 @@ $newline never timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay timeField = Field { fieldParse = parseHelper parseTime - , fieldView = \theId name attrs val isReq -> toWidget [hamlet| -$newline never - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arOW + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "") } + , fieldEnctype = UrlEncoded } where @@ -155,10 +215,18 @@ $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 -") } + , fieldEnctype = UrlEncoded } where showVal = either id (pack . renderHtml) @@ -166,7 +234,7 @@ $newline never -- | A newtype wrapper around a 'Text' that converts newlines to HTML -- br-tags. newtype Textarea = Textarea { unTextarea :: Text } - deriving (Show, Read, Eq, PersistField, PersistFieldSql, Ord) + deriving (Show, Read, Eq, PersistField, Ord) instance ToHtml Textarea where toHtml = unsafeByteString @@ -184,10 +252,18 @@ 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 -") } + , fieldEnctype = UrlEncoded } @@ -195,10 +271,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 - -|] + , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_arPo + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) + "") } + , fieldEnctype = UrlEncoded } @@ -206,20 +291,55 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex textField = Field { fieldParse = parseHelper $ Right , fieldView = \theId name attrs val isReq -> - [whamlet| -$newline never - -|] + do { (Yesod.Core.Widget.asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "") } + , fieldEnctype = UrlEncoded } 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 - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arPF + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "") } + , fieldEnctype = UrlEncoded } @@ -291,10 +411,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 - -|] + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arQe + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "") } + , fieldEnctype = UrlEncoded } @@ -303,20 +437,78 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus searchField autoFocus = Field { fieldParse = parseHelper Right , fieldView = \theId name attrs val isReq -> do - [whamlet|\ -$newline never - -|] + do { (Yesod.Core.Widget.asWidgetT . 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_arQv + -> (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 = (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 } @@ -327,7 +519,30 @@ urlField = Field Nothing -> Left $ MsgInvalidUrl s Just _ -> Right s , fieldView = \theId name attrs val isReq -> - [whamlet||] + do { (Yesod.Core.Widget.asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "") } + , fieldEnctype = UrlEncoded } @@ -340,18 +555,56 @@ 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 -"); + (Yesod.Core.Widget.asWidgetT . toWidget) inside; + (Yesod.Core.Widget.asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "") }) + -- outside + (\_theId _name isSel -> do { (Yesod.Core.Widget.asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) + "") }) + -- onOpt + (\_theId _name _attrs value isSel text -> do { (Yesod.Core.Widget.asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "") }) + -- inside multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)] @@ -374,11 +627,48 @@ multiSelectField ioptlist = view theId name attrs val isReq = do opts <- fmap olOptions $ handlerToWidget ioptlist let selOpts = map (id &&& (optselected val)) opts - [whamlet| - "); + Data.Foldable.mapM_ + (\ (opt_arRl, optsel_arRm) + -> do { (Yesod.Core.Widget.asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "") }) + selOpts; + (Yesod.Core.Widget.asWidgetT . toWidget) + ((Text.Blaze.Internal.preEscapedText . pack) "") } + where optselected (Left _) _ = False optselected (Right vals) opt = (optionInternalValue opt) `elem` vals @@ -392,41 +682,167 @@ 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 -
^{inside} -|]) - (\theId name isSel -> [whamlet| -$newline never -