From 38834f94992679d8c4d936fec12eb32b82073553 Mon Sep 17 00:00:00 2001 From: dummy Date: Wed, 21 May 2014 05:23:19 +0000 Subject: [PATCH] splice TH --- Yesod/Form/Fields.hs | 738 +++++++++++++++++++++++++++++++++--------------- Yesod/Form/Functions.hs | 289 +++++++++++++------ Yesod/Form/Jquery.hs | 129 +++++++-- Yesod/Form/MassInput.hs | 233 ++++++++++++--- Yesod/Form/Nic.hs | 65 ++++- yesod-form.cabal | 1 - 6 files changed, 1054 insertions(+), 401 deletions(-) diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs index cd67820..46b5d96 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -18,9 +17,6 @@ module Yesod.Form.Fields , timeField , htmlField , emailField - , multiEmailField - , searchField - , AutoFocus , urlField , doubleField , parseDate @@ -37,15 +33,11 @@ module Yesod.Form.Fields , selectFieldList , radioField , radioFieldList - , checkboxesFieldList - , checkboxesField , multiSelectField , multiSelectFieldList , Option (..) , OptionList (..) , mkOptionList - , optionsPersist - , optionsPersistKey , optionsPairs , optionsEnum ) where @@ -72,6 +64,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) @@ -84,15 +85,12 @@ import Data.Text as T (Text, concat, intercalate, unpack, pack, splitOn) import qualified Data.Text.Read import qualified Data.Map as Map -import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery) 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 @@ -104,10 +102,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 @@ -121,10 +133,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) @@ -132,10 +158,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) @@ -143,10 +183,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 @@ -159,10 +212,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) @@ -171,8 +232,6 @@ $newline never -- br-tags. newtype Textarea = Textarea { unTextarea :: Text } deriving (Show, Read, Eq, PersistField, Ord, ToJSON, FromJSON) -instance PersistFieldSql Textarea where - sqlType _ = SqlString instance ToHtml Textarea where toHtml = unsafeByteString @@ -190,10 +249,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 } @@ -201,10 +268,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 } @@ -212,20 +288,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 } @@ -297,57 +408,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 - -|] - , fieldEnctype = UrlEncoded - } + , fieldView = \theId name attrs val isReq -> toWidget $ \ _render_arQe + -> do { id + ((Text.Blaze.Internal.preEscapedText . pack) "") } --- | --- --- Since 1.3.7 -multiEmailField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m [Text] -multiEmailField = Field - { fieldParse = parseHelper $ - \s -> - let addrs = map validate $ splitOn "," s - in case partitionEithers addrs of - ([], good) -> Right good - (bad, _) -> Left $ MsgInvalidEmail $ cat bad - , fieldView = \theId name attrs val isReq -> toWidget [hamlet| -$newline never - -|] - , fieldEnctype = UrlEncoded - } - where - -- report offending address along with error - validate a = case Email.validate $ encodeUtf8 a of - Left e -> Left $ T.concat [a, " (", pack e, ")"] - Right r -> Right $ emailToText r - cat = intercalate ", " - emailToText = decodeUtf8With lenientDecode . Email.toByteString - -type AutoFocus = Bool -searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus -> Field m Text -searchField autoFocus = Field - { fieldParse = parseHelper Right - , fieldView = \theId name attrs val isReq -> do - [whamlet| -$newline never - -|] - when autoFocus $ do - -- we want this javascript to be placed immediately after the field - [whamlet| -$newline never -