From 214a511de61ae5de04fab4baf25e76fe838d60e3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 13 Oct 2014 17:09:12 -0400 Subject: update for yesod-form-1.4.0.2 --- .../haskell-patches/yesod-form_spliced-TH.patch | 182 ++++++++------------- 1 file changed, 68 insertions(+), 114 deletions(-) (limited to 'standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch') diff --git a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch index c5662a85b..e29c7de11 100644 --- a/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch +++ b/standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch @@ -1,20 +1,5 @@ -From 6aabd510081681f81f4259190be32fbb2819b46c Mon Sep 17 00:00:00 2001 -From: Joey Hess -Date: Fri, 12 Sep 2014 21:30:27 -0400 -Subject: [PATCH] splice TH - ---- - Yesod/Form/Bootstrap3.hs | 183 +++++++++--- - Yesod/Form/Fields.hs | 753 ++++++++++++++++++++++++++++++++++++++--------- - Yesod/Form/Functions.hs | 257 +++++++++++++--- - Yesod/Form/Jquery.hs | 134 +++++++-- - Yesod/Form/MassInput.hs | 226 +++++++++++--- - Yesod/Form/Nic.hs | 67 ++++- - yesod-form.cabal | 1 - - 7 files changed, 1319 insertions(+), 302 deletions(-) - diff --git a/Yesod/Form/Bootstrap3.hs b/Yesod/Form/Bootstrap3.hs -index 84e85fc..943c416 100644 +index 84e85fc..1954fb4 100644 --- a/Yesod/Form/Bootstrap3.hs +++ b/Yesod/Form/Bootstrap3.hs @@ -26,6 +26,9 @@ import Data.String (IsString(..)) @@ -27,7 +12,7 @@ index 84e85fc..943c416 100644 import Yesod.Form.Types import Yesod.Form.Functions -@@ -152,44 +152,144 @@ renderBootstrap3 formLayout aform fragment = do +@@ -152,44 +155,144 @@ renderBootstrap3 formLayout aform fragment = do let views = views' [] has (Just _) = True has Nothing = False @@ -205,7 +190,7 @@ index 84e85fc..943c416 100644 -- | How the 'bootstrapSubmit' button should be rendered. -@@ -244,7 +344,22 @@ mbootstrapSubmit +@@ -244,7 +347,22 @@ mbootstrapSubmit => BootstrapSubmit msg -> MForm m (FormResult (), FieldView site) mbootstrapSubmit (BootstrapSubmit msg classes attrs) = let res = FormSuccess () @@ -230,7 +215,7 @@ index 84e85fc..943c416 100644 , fvTooltip = Nothing , fvId = bootstrapSubmitId diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs -index c6091a9..3d7b267 100644 +index 8173e78..8ee847d 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -1,4 +1,3 @@ @@ -280,7 +265,7 @@ index c6091a9..3d7b267 100644 import qualified Blaze.ByteString.Builder.Html.Utf8 as B import Blaze.ByteString.Builder (writeByteString, toLazyByteString) import Blaze.ByteString.Builder.Internal.Write (fromWriteList) -@@ -91,15 +92,12 @@ import qualified Data.Text as T (drop, dropWhile) +@@ -87,15 +88,12 @@ import qualified Data.Text as T (drop, dropWhile) import qualified Data.Text.Read import qualified Data.Map as Map @@ -296,7 +281,7 @@ index c6091a9..3d7b267 100644 defaultFormMessage :: FormMessage -> Text defaultFormMessage = englishFormMessage -@@ -111,10 +109,25 @@ intField = Field +@@ -107,10 +105,25 @@ intField = Field Right (a, "") -> Right a _ -> Left $ MsgInvalidInteger s @@ -326,7 +311,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } where -@@ -128,10 +141,25 @@ doubleField = Field +@@ -124,10 +137,25 @@ doubleField = Field Right (a, "") -> Right a _ -> Left $ MsgInvalidNumber s @@ -356,7 +341,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } where showVal = either id (pack . show) -@@ -139,10 +167,24 @@ $newline never +@@ -135,10 +163,24 @@ $newline never dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day dayField = Field { fieldParse = parseHelper $ parseDate . unpack @@ -385,7 +370,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } where showVal = either id (pack . show) -@@ -150,10 +192,23 @@ $newline never +@@ -146,10 +188,23 @@ $newline never timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay timeField = Field { fieldParse = parseHelper parseTime @@ -413,7 +398,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } where -@@ -166,10 +221,23 @@ $newline never +@@ -162,10 +217,23 @@ $newline never htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html htmlField = Field { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance @@ -441,13 +426,12 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } where showVal = either id (pack . renderHtml) -@@ -197,10 +265,18 @@ instance ToHtml Textarea where - textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea +@@ -194,9 +262,17 @@ textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m textareaField = Field { fieldParse = parseHelper $ Right . Textarea -- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet| + , fieldView = \theId name attrs val isReq -> toWidget [hamlet| -$newline never --") } -+ , fieldEnctype = UrlEncoded } -@@ -208,10 +284,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage) +@@ -204,10 +280,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage) => Field m p hiddenField = Field { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece @@ -488,7 +471,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } -@@ -219,20 +304,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex +@@ -215,20 +300,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex textField = Field { fieldParse = parseHelper $ Right , fieldView = \theId name attrs val isReq -> @@ -550,7 +533,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } -@@ -304,10 +422,24 @@ emailField = Field +@@ -300,10 +418,24 @@ emailField = Field case Email.canonicalizeEmail $ encodeUtf8 s of Just e -> Right $ decodeUtf8With lenientDecode e Nothing -> Left $ MsgInvalidEmail s @@ -579,7 +562,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } -@@ -322,10 +454,25 @@ multiEmailField = Field +@@ -318,10 +450,25 @@ multiEmailField = Field in case partitionEithers addrs of ([], good) -> Right good (bad, _) -> Left $ MsgInvalidEmail $ cat bad @@ -609,7 +592,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } where -@@ -341,20 +488,75 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus +@@ -337,20 +484,75 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus searchField autoFocus = Field { fieldParse = parseHelper Right , fieldView = \theId name attrs val isReq -> do @@ -697,7 +680,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } -@@ -365,7 +567,28 @@ urlField = Field +@@ -361,7 +563,28 @@ urlField = Field Nothing -> Left $ MsgInvalidUrl s Just _ -> Right s , fieldView = \theId name attrs val isReq -> @@ -727,7 +710,7 @@ index c6091a9..3d7b267 100644 , fieldEnctype = UrlEncoded } -@@ -378,18 +601,54 @@ selectField :: (Eq a, RenderMessage site FormMessage) +@@ -374,18 +597,54 @@ selectField :: (Eq a, RenderMessage site FormMessage) => HandlerT site IO (OptionList a) -> Field (HandlerT site IO) a selectField = selectFieldHelper @@ -794,7 +777,7 @@ index c6091a9..3d7b267 100644 multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)] -@@ -412,11 +671,45 @@ multiSelectField ioptlist = +@@ -408,11 +667,45 @@ multiSelectField ioptlist = view theId name attrs val isReq = do opts <- fmap olOptions $ handlerToWidget ioptlist let selOpts = map (id &&& (optselected val)) opts @@ -845,7 +828,7 @@ index c6091a9..3d7b267 100644 where optselected (Left _) _ = False optselected (Right vals) opt = (optionInternalValue opt) `elem` vals -@@ -439,54 +732,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist) +@@ -435,54 +728,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist) opts <- fmap olOptions $ handlerToWidget ioptlist let optselected (Left _) _ = False optselected (Right vals) opt = (optionInternalValue opt) `elem` vals @@ -993,6 +976,9 @@ index c6091a9..3d7b267 100644 - -