1bc5734037
This goes all the way up to Yesod, but everything above Wai is a real hack job, removing TH left and right.
675 lines
24 KiB
Diff
675 lines
24 KiB
Diff
From c47d263779fba34629130398f1b08be1b8e468f7 Mon Sep 17 00:00:00 2001
|
|
From: Joey Hess <joey@kitenet.net>
|
|
Date: Thu, 28 Feb 2013 23:40:05 -0400
|
|
Subject: [PATCH] avoid TH (hack job)
|
|
|
|
---
|
|
Yesod/Form/Fields.hs | 93 ++++++++++++++++++++++++++++---------
|
|
Yesod/Form/Functions.hs | 118 ++++++++++++++++++++++++++++++++---------------
|
|
Yesod/Form/Jquery.hs | 13 ++++--
|
|
Yesod/Form/MassInput.hs | 18 ++++++--
|
|
yesod-form.cabal | 1 -
|
|
5 files changed, 173 insertions(+), 70 deletions(-)
|
|
|
|
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
|
|
index adc59de..353c8d0 100644
|
|
--- a/Yesod/Form/Fields.hs
|
|
+++ b/Yesod/Form/Fields.hs
|
|
@@ -50,7 +50,7 @@ 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 +108,12 @@ intField = Field
|
|
Right (a, "") -> Right a
|
|
_ -> Left $ MsgInvalidInteger s
|
|
|
|
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
|
+ , fieldView = \theId name attrs val isReq -> error "intField TH TODO"
|
|
+{- toWidget [hamlet|
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} type="number" :isReq:required="" value="#{showVal val}">
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where
|
|
@@ -125,32 +127,40 @@ doubleField = Field
|
|
Right (a, "") -> Right a
|
|
_ -> Left $ MsgInvalidNumber s
|
|
|
|
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
|
+ , fieldView = \theId name attrs val isReq -> error "doubleField TH TODO"
|
|
+{-
|
|
+ - toWidget [hamlet|
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{showVal val}">
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
- where showVal = either id (pack . show)
|
|
+{-
|
|
+ where showVal = either id (pack . show)-}
|
|
|
|
dayField :: RenderMessage master FormMessage => Field sub master Day
|
|
dayField = Field
|
|
{ fieldParse = parseHelper $ parseDate . unpack
|
|
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
|
+ , fieldView = \theId name attrs val isReq -> error "dayfield TH TODO"
|
|
+{- toWidget [hamlet|
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
- where showVal = either id (pack . show)
|
|
+{- where showVal = either id (pack . show) -}
|
|
|
|
timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
|
|
timeField = Field
|
|
{ fieldParse = parseHelper parseTime
|
|
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
|
+ , fieldView = \theId name attrs val isReq -> error "timefield TH TODO"
|
|
+{- toWidget [hamlet|
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}">
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where
|
|
@@ -163,10 +173,12 @@ $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|
|
|
+ , fieldView = \theId name attrs val _isReq -> error "htmlField TH TODO"
|
|
+{- toWidget [hamlet|
|
|
$newline never
|
|
<textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val}
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where showVal = either id (pack . renderHtml)
|
|
@@ -192,10 +204,12 @@ 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|
|
|
+ , fieldView = \theId name attrs val _isReq -> error "textAreafield TH TODO"
|
|
+{- toWidget [hamlet|
|
|
$newline never
|
|
<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val}
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -203,31 +217,37 @@ 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|
|
|
+ , fieldView = \theId name attrs val _isReq -> error "hiddenfield TH TODO"
|
|
+{- toWidget [hamlet|
|
|
$newline never
|
|
<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}">
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
textField :: RenderMessage master FormMessage => Field sub master Text
|
|
textField = Field
|
|
{ fieldParse = parseHelper $ Right
|
|
- , fieldView = \theId name attrs val isReq ->
|
|
+ , fieldView = \theId name attrs val isReq -> error "textField TH TODO"
|
|
+{-
|
|
[whamlet|
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id id val}">
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
passwordField :: RenderMessage master FormMessage => Field sub master Text
|
|
passwordField = Field
|
|
{ fieldParse = parseHelper $ Right
|
|
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
|
+ , fieldView = \theId name attrs val isReq -> error "passwordfield TH TODO"
|
|
+{- toWidget [hamlet|
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}">
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -305,10 +325,13 @@ emailField = Field
|
|
then Right s
|
|
else Left $ MsgInvalidEmail s
|
|
#endif
|
|
- , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
|
+ , fieldView = \theId name attrs val isReq -> error "emailField TH TODO"
|
|
+{-
|
|
+toWidget [hamlet|
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -316,7 +339,8 @@ type AutoFocus = Bool
|
|
searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master Text
|
|
searchField autoFocus = Field
|
|
{ fieldParse = parseHelper Right
|
|
- , fieldView = \theId name attrs val isReq -> do
|
|
+ , fieldView = \theId name attrs val isReq -> error "searchfield TH TODO"
|
|
+{-
|
|
[whamlet|\
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
|
|
@@ -331,6 +355,7 @@ $newline never
|
|
##{theId}
|
|
-webkit-appearance: textfield
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -340,11 +365,13 @@ urlField = Field
|
|
case parseURI $ unpack s of
|
|
Nothing -> Left $ MsgInvalidUrl s
|
|
Just _ -> Right s
|
|
- , fieldView = \theId name attrs val isReq ->
|
|
+ , fieldView = \theId name attrs val isReq -> error "urlField TH TODO"
|
|
+{-
|
|
[whamlet|
|
|
$newline never
|
|
<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -352,6 +379,8 @@ selectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master
|
|
selectFieldList = selectField . optionsPairs
|
|
|
|
selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
|
|
+selectField = error "selectfield TH TODO"
|
|
+{-
|
|
selectField = selectFieldHelper
|
|
(\theId name attrs inside -> [whamlet|
|
|
$newline never
|
|
@@ -365,6 +394,7 @@ $newline never
|
|
$newline never
|
|
<option value=#{value} :isSel:selected>#{text}
|
|
|]) -- inside
|
|
+-}
|
|
|
|
multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a]
|
|
multiSelectFieldList = multiSelectField . optionsPairs
|
|
@@ -382,7 +412,8 @@ multiSelectField ioptlist =
|
|
Nothing -> return $ Left "Error parsing values"
|
|
Just res -> return $ Right $ Just res
|
|
|
|
- view theId name attrs val isReq = do
|
|
+ view theId name attrs val isReq = error "multiSelectField TH TODO"
|
|
+{-
|
|
opts <- fmap olOptions $ lift ioptlist
|
|
let selOpts = map (id &&& (optselected val)) opts
|
|
[whamlet|
|
|
@@ -394,12 +425,15 @@ $newline never
|
|
where
|
|
optselected (Left _) _ = False
|
|
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
|
|
+-}
|
|
|
|
radioFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master a
|
|
radioFieldList = radioField . optionsPairs
|
|
|
|
radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
|
|
-radioField = selectFieldHelper
|
|
+radioField = error "radioField TH TODO"
|
|
+{-
|
|
+ selectFieldHelper
|
|
(\theId _name _attrs inside -> [whamlet|
|
|
$newline never
|
|
<div ##{theId}>^{inside}
|
|
@@ -418,11 +452,14 @@ $newline never
|
|
<input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}>
|
|
\#{text}
|
|
|])
|
|
+-}
|
|
|
|
boolField :: RenderMessage master FormMessage => Field sub master Bool
|
|
boolField = Field
|
|
{ fieldParse = \e _ -> return $ boolParser e
|
|
- , fieldView = \theId name attrs val isReq -> [whamlet|
|
|
+ , fieldView = \theId name attrs val isReq -> error "boolField TH TODO"
|
|
+{-
|
|
+[whamlet|
|
|
$newline never
|
|
$if not isReq
|
|
<input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>
|
|
@@ -435,6 +472,7 @@ $newline never
|
|
<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 +496,13 @@ $newline never
|
|
checkBoxField :: RenderMessage m FormMessage => Field s m Bool
|
|
checkBoxField = Field
|
|
{ fieldParse = \e _ -> return $ checkBoxParser e
|
|
- , fieldView = \theId name attrs val _ -> [whamlet|
|
|
+ , fieldView = \theId name attrs val _ -> error "checkBoxField TH TODO"
|
|
+{-
|
|
+ [whamlet|
|
|
$newline never
|
|
<input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked>
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
@@ -566,9 +607,11 @@ fileField = Field
|
|
case files of
|
|
[] -> Right Nothing
|
|
file:_ -> Right $ Just file
|
|
- , fieldView = \id' name attrs _ isReq -> toWidget [hamlet|
|
|
+ , fieldView = \id' name attrs _ isReq -> error "fieldField TODO"
|
|
+{- toWidget [hamlet|
|
|
<input id=#{id'} name=#{name} *{attrs} type=file :isReq:required>
|
|
|]
|
|
+-}
|
|
, fieldEnctype = Multipart
|
|
}
|
|
|
|
@@ -594,10 +637,13 @@ 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|
|
|
+ , fvInput = error "fileAFormReq TH TODO"
|
|
+{-
|
|
+[whamlet|
|
|
$newline never
|
|
<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
|
|
|]
|
|
+-}
|
|
, fvErrors = errs
|
|
, fvRequired = True
|
|
}
|
|
@@ -623,10 +669,13 @@ 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|
|
|
+ , fvInput = error "fileAFormOpt TH TODO"
|
|
+{-
|
|
+[whamlet|
|
|
$newline never
|
|
<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
|
|
|]
|
|
+-}
|
|
, fvErrors = errs
|
|
, fvRequired = False
|
|
}
|
|
diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
|
|
index db3e493..a51e132 100644
|
|
--- a/Yesod/Form/Functions.hs
|
|
+++ b/Yesod/Form/Functions.hs
|
|
@@ -44,20 +44,21 @@ module Yesod.Form.Functions
|
|
|
|
import Yesod.Form.Types
|
|
import Data.Text (Text, pack)
|
|
+import Data.Foldable
|
|
import Control.Arrow (second)
|
|
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
|
|
import Control.Monad.Trans.Class (lift)
|
|
import Control.Monad (liftM, join)
|
|
import Crypto.Classes (constTimeEq)
|
|
import Text.Blaze (Markup, toMarkup)
|
|
+import qualified Text.Blaze.Internal
|
|
#define Html Markup
|
|
#define toHtml toMarkup
|
|
import Yesod.Handler (GHandler, getRequest, runRequestBody, newIdent, getYesod)
|
|
import Yesod.Core (RenderMessage, SomeMessage (..))
|
|
-import Yesod.Widget (GWidget, whamlet)
|
|
+import Yesod.Widget (GWidget, toWidget)
|
|
import Yesod.Request (reqToken, reqWaiRequest, reqGetParams, languages)
|
|
import Network.Wai (requestMethod)
|
|
-import Text.Hamlet (shamlet)
|
|
import Data.Monoid (mempty)
|
|
import Data.Maybe (listToMaybe, fromMaybe)
|
|
import Yesod.Message (RenderMessage (..))
|
|
@@ -66,6 +67,7 @@ import qualified Data.Text.Encoding as TE
|
|
import Control.Applicative ((<$>))
|
|
import Control.Arrow (first)
|
|
import Yesod.Request (FileInfo)
|
|
+import Text.Hamlet (condH, maybeH)
|
|
|
|
-- | Get a unique identifier.
|
|
newFormIdent :: MForm sub master Text
|
|
@@ -189,26 +191,7 @@ postHelper :: RenderMessage master FormMessage
|
|
postHelper form env = do
|
|
req <- getRequest
|
|
let tokenKey = "_token"
|
|
- let token =
|
|
- case reqToken req of
|
|
- Nothing -> mempty
|
|
- Just n -> [shamlet|
|
|
-$newline never
|
|
-<input type=hidden name=#{tokenKey} value=#{n}>
|
|
-|]
|
|
- m <- getYesod
|
|
- langs <- languages
|
|
- ((res, xml), enctype) <- runFormGeneric (form token) m langs env
|
|
- let res' =
|
|
- case (res, env) of
|
|
- (FormSuccess{}, Just (params, _))
|
|
- | not (Map.lookup tokenKey params === reqToken req) ->
|
|
- FormFailure [renderMessage m langs MsgCsrfWarning]
|
|
- _ -> res
|
|
- where (Just [t1]) === (Just t2) = TE.encodeUtf8 t1 `constTimeEq` TE.encodeUtf8 t2
|
|
- Nothing === Nothing = True -- It's important to use constTimeEq
|
|
- _ === _ = False -- in order to avoid timing attacks.
|
|
- return ((res', xml), enctype)
|
|
+ error "yesod-form postHelper needs TH, disabled"
|
|
|
|
-- | Similar to 'runFormPost', except it always ignore the currently available
|
|
-- environment. This is necessary in cases like a wizard UI, where a single
|
|
@@ -253,7 +236,8 @@ getKey :: Text
|
|
getKey = "_hasdata"
|
|
|
|
getHelper :: (Html -> MForm sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype)
|
|
-getHelper form env = do
|
|
+getHelper form env = error "yesod-form getHelper needs TH, disabled"
|
|
+{-
|
|
let fragment = [shamlet|
|
|
$newline never
|
|
<input type=hidden name=#{getKey}>
|
|
@@ -261,6 +245,7 @@ $newline never
|
|
langs <- languages
|
|
m <- getYesod
|
|
runFormGeneric (form fragment) m langs env
|
|
+-}
|
|
|
|
type FormRender sub master a =
|
|
AForm sub master a
|
|
@@ -271,6 +256,7 @@ renderTable, renderDivs, renderDivsNoLabels :: FormRender sub master a
|
|
renderTable aform fragment = do
|
|
(res, views') <- aFormToForm aform
|
|
let views = views' []
|
|
+{-
|
|
let widget = [whamlet|
|
|
$newline never
|
|
\#{fragment}
|
|
@@ -285,6 +271,8 @@ $forall view <- views
|
|
<td .errors>#{err}
|
|
|]
|
|
return (res, widget)
|
|
+-}
|
|
+ error "yesod-form renderTable, needs TN, not implemented"
|
|
|
|
-- | render a field inside a div
|
|
renderDivs = renderDivsMaybeLabels True
|
|
@@ -293,7 +281,8 @@ renderDivs = renderDivsMaybeLabels True
|
|
renderDivsNoLabels = renderDivsMaybeLabels False
|
|
|
|
renderDivsMaybeLabels :: Bool -> FormRender sub master a
|
|
-renderDivsMaybeLabels withLabels aform fragment = do
|
|
+renderDivsMaybeLabels withLabels aform fragment = error "yesod-form renderDivsMaybeLabels needs TH, not implemented"
|
|
+{-
|
|
(res, views') <- aFormToForm aform
|
|
let views = views' []
|
|
let widget = [whamlet|
|
|
@@ -310,6 +299,7 @@ $forall view <- views
|
|
<div .errors>#{err}
|
|
|]
|
|
return (res, widget)
|
|
+-}
|
|
|
|
-- | Render a form using Bootstrap-friendly shamlet syntax.
|
|
--
|
|
@@ -332,19 +322,73 @@ 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.toHtml fragment);
|
|
+ Data.Foldable.mapM_
|
|
+ (\ view_a55Y
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<div class=\"control-group clearfix ");
|
|
+ Text.Hamlet.condH
|
|
+ [(fvRequired view_a55Y,
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "required "))]
|
|
+ Nothing;
|
|
+ Text.Hamlet.condH
|
|
+ [(not (fvRequired view_a55Y),
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "optional "))]
|
|
+ Nothing;
|
|
+ Text.Hamlet.condH
|
|
+ [(has (fvErrors view_a55Y),
|
|
+ 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.toHtml (fvId view_a55Y));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "\">");
|
|
+ Yesod.Widget.toWidget
|
|
+ (Text.Blaze.toHtml (fvLabel view_a55Y));
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "</label><div class=\"controls input\">");
|
|
+ Yesod.Widget.toWidget (fvInput view_a55Y);
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvTooltip view_a55Y)
|
|
+ (\ tt_a55Z
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<span class=\"help-block\">");
|
|
+ Yesod.Widget.toWidget
|
|
+ (Text.Blaze.toHtml tt_a55Z);
|
|
+ Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "</span>") })
|
|
+ Nothing;
|
|
+ Text.Hamlet.maybeH
|
|
+ (fvErrors view_a55Y)
|
|
+ (\ err_a560
|
|
+ -> do { Yesod.Widget.toWidget
|
|
+ ((Text.Blaze.Internal.preEscapedText . pack)
|
|
+ "<span class=\"help-block\">");
|
|
+ Yesod.Widget.toWidget
|
|
+ (Text.Blaze.toHtml err_a560);
|
|
+ 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..656a8e0 100644
|
|
--- a/Yesod/Form/Jquery.hs
|
|
+++ b/Yesod/Form/Jquery.hs
|
|
@@ -18,8 +18,7 @@ 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)
|
|
@@ -63,7 +62,8 @@ jqueryDayField jds = Field
|
|
Right
|
|
. readMay
|
|
. unpack
|
|
- , fieldView = \theId name attrs val isReq -> do
|
|
+ , fieldView = \theId name attrs val isReq -> error "jqueryDayField TH TODO"
|
|
+{-
|
|
toWidget [shamlet|
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
|
|
@@ -85,10 +85,11 @@ $(function(){
|
|
}
|
|
});
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
where
|
|
- showVal = either id (pack . show)
|
|
+{- showVal = either id (pack . show) -}
|
|
jsBool True = toJSON True
|
|
jsBool False = toJSON False
|
|
mos (Left i) = show i
|
|
@@ -104,7 +105,8 @@ jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master
|
|
=> Route master -> Field sub master Text
|
|
jqueryAutocompleteField src = Field
|
|
{ fieldParse = parseHelper $ Right
|
|
- , fieldView = \theId name attrs val isReq -> do
|
|
+ , fieldView = \theId name attrs val isReq -> error "jqueryAutocompleteField TH TODO"
|
|
+{-
|
|
toWidget [shamlet|
|
|
$newline never
|
|
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
|
|
@@ -115,6 +117,7 @@ $newline never
|
|
toWidget [julius|
|
|
$(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:2})});
|
|
|]
|
|
+-}
|
|
, fieldEnctype = UrlEncoded
|
|
}
|
|
|
|
diff --git a/Yesod/Form/MassInput.hs b/Yesod/Form/MassInput.hs
|
|
index 62e89d6..14a4125 100644
|
|
--- a/Yesod/Form/MassInput.hs
|
|
+++ b/Yesod/Form/MassInput.hs
|
|
@@ -12,7 +12,7 @@ module Yesod.Form.MassInput
|
|
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,7 +75,8 @@ inputList label fixXml single mdef = formToAForm $ do
|
|
{ fvLabel = label
|
|
, fvTooltip = Nothing
|
|
, fvId = theId
|
|
- , fvInput = [whamlet|
|
|
+ , fvInput = error "inputList TH TODO"
|
|
+{-[whamlet|
|
|
$newline never
|
|
^{fixXml views}
|
|
<p>
|
|
@@ -85,6 +86,7 @@ $newline never
|
|
<input type=checkbox name=#{addName}>
|
|
Add another row
|
|
|]
|
|
+-}
|
|
, fvErrors = Nothing
|
|
, fvRequired = False
|
|
}])
|
|
@@ -97,10 +99,12 @@ withDelete af = do
|
|
deleteName <- newFormIdent
|
|
(menv, _, _) <- ask
|
|
res <- case menv >>= Map.lookup deleteName . fst of
|
|
- Just ("yes":_) -> return $ Left [whamlet|
|
|
+ Just ("yes":_) -> return $ Left $ error "withDelete TH TODO"
|
|
+{- [whamlet|
|
|
$newline never
|
|
<input type=hidden name=#{deleteName} value=yes>
|
|
|]
|
|
+-}
|
|
_ -> do
|
|
(_, xml2) <- aFormToForm $ areq boolField FieldSettings
|
|
{ fsLabel = SomeMessage MsgDelete
|
|
@@ -126,7 +130,8 @@ fixme eithers =
|
|
massDivs, massTable
|
|
:: [[FieldView sub master]]
|
|
-> GWidget sub master ()
|
|
-massDivs viewss = [whamlet|
|
|
+massDivs viewss = error "massDivs TODO"
|
|
+{-[whamlet|
|
|
$newline never
|
|
$forall views <- viewss
|
|
<fieldset>
|
|
@@ -139,8 +144,10 @@ $forall views <- viewss
|
|
$maybe err <- fvErrors view
|
|
<div .errors>#{err}
|
|
|]
|
|
+-}
|
|
|
|
-massTable viewss = [whamlet|
|
|
+massTable viewss = error "massTable TH TODO"
|
|
+{- [whamlet|
|
|
$newline never
|
|
$forall views <- viewss
|
|
<fieldset>
|
|
@@ -155,3 +162,4 @@ $forall views <- viewss
|
|
$maybe err <- fvErrors view
|
|
<td .errors>#{err}
|
|
|]
|
|
+-}
|
|
diff --git a/yesod-form.cabal b/yesod-form.cabal
|
|
index b0ac64e..249de69 100644
|
|
--- a/yesod-form.cabal
|
|
+++ b/yesod-form.cabal
|
|
@@ -45,7 +45,6 @@ library
|
|
Yesod.Form.Input
|
|
Yesod.Form.Fields
|
|
Yesod.Form.Jquery
|
|
- Yesod.Form.Nic
|
|
Yesod.Form.MassInput
|
|
Yesod.Form.I18n.English
|
|
Yesod.Form.I18n.Portuguese
|
|
--
|
|
1.7.10.4
|
|
|