adjusted existing fields and functions for the new FieldSettings attribute
This commit is contained in:
parent
bdd0f80083
commit
837f796993
@ -67,6 +67,7 @@ import Text.Blaze.Renderer.String (renderHtml)
|
|||||||
import qualified Data.ByteString as S
|
import qualified Data.ByteString as S
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import Data.Text (Text, unpack, pack)
|
import Data.Text (Text, unpack, pack)
|
||||||
|
import qualified Data.Text as T (null)
|
||||||
import qualified Data.Text.Read
|
import qualified Data.Text.Read
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
|
|
||||||
@ -110,9 +111,9 @@ intField = Field
|
|||||||
Right (a, "") -> Right a
|
Right (a, "") -> Right a
|
||||||
_ -> Left $ MsgInvalidInteger s
|
_ -> Left $ MsgInvalidInteger s
|
||||||
|
|
||||||
, fieldView = \theId name val isReq -> addHamlet
|
, fieldView = \theId name theClass val isReq -> addHamlet
|
||||||
[HAMLET|\
|
[HAMLET|\
|
||||||
<input id="#{theId}" name="#{name}" type="number" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="number" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
@ -126,9 +127,9 @@ doubleField = Field
|
|||||||
Right (a, "") -> Right a
|
Right (a, "") -> Right a
|
||||||
_ -> Left $ MsgInvalidNumber s
|
_ -> Left $ MsgInvalidNumber s
|
||||||
|
|
||||||
, fieldView = \theId name val isReq -> addHamlet
|
, fieldView = \theId name theClass val isReq -> addHamlet
|
||||||
[HAMLET|\
|
[HAMLET|\
|
||||||
<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="text" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
where showVal = either id (pack . show)
|
where showVal = either id (pack . show)
|
||||||
@ -136,9 +137,9 @@ doubleField = Field
|
|||||||
dayField :: RenderMessage master FormMessage => Field sub master Day
|
dayField :: RenderMessage master FormMessage => Field sub master Day
|
||||||
dayField = Field
|
dayField = Field
|
||||||
{ fieldParse = blank $ parseDate . unpack
|
{ fieldParse = blank $ parseDate . unpack
|
||||||
, fieldView = \theId name val isReq -> addHamlet
|
, fieldView = \theId name theClass val isReq -> addHamlet
|
||||||
[HAMLET|\
|
[HAMLET|\
|
||||||
<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="date" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
where showVal = either id (pack . show)
|
where showVal = either id (pack . show)
|
||||||
@ -146,9 +147,9 @@ dayField = Field
|
|||||||
timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
|
timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
|
||||||
timeField = Field
|
timeField = Field
|
||||||
{ fieldParse = blank $ parseTime . unpack
|
{ fieldParse = blank $ parseTime . unpack
|
||||||
, fieldView = \theId name val isReq -> addHamlet
|
, fieldView = \theId name theClass val isReq -> addHamlet
|
||||||
[HAMLET|\
|
[HAMLET|\
|
||||||
<input id="#{theId}" name="#{name}" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
@ -161,9 +162,10 @@ timeField = Field
|
|||||||
htmlField :: RenderMessage master FormMessage => Field sub master Html
|
htmlField :: RenderMessage master FormMessage => Field sub master Html
|
||||||
htmlField = Field
|
htmlField = Field
|
||||||
{ fieldParse = blank $ Right . preEscapedText . sanitizeBalance
|
{ fieldParse = blank $ Right . preEscapedText . sanitizeBalance
|
||||||
, fieldView = \theId name val _isReq -> addHamlet
|
, fieldView = \theId name theClass val _isReq -> addHamlet
|
||||||
|
-- FIXME: There was a class="html" attribute, for what purpose?
|
||||||
[HAMLET|\
|
[HAMLET|\
|
||||||
<textarea id="#{theId}" name="#{name}" .html>#{showVal val}
|
<textarea id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}">#{showVal val}
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
where showVal = either id (pack . renderHtml)
|
where showVal = either id (pack . renderHtml)
|
||||||
@ -189,36 +191,36 @@ instance ToHtml Textarea where
|
|||||||
textareaField :: RenderMessage master FormMessage => Field sub master Textarea
|
textareaField :: RenderMessage master FormMessage => Field sub master Textarea
|
||||||
textareaField = Field
|
textareaField = Field
|
||||||
{ fieldParse = blank $ Right . Textarea
|
{ fieldParse = blank $ Right . Textarea
|
||||||
, fieldView = \theId name val _isReq -> addHamlet
|
, fieldView = \theId name theClass val _isReq -> addHamlet
|
||||||
[HAMLET|\
|
[HAMLET|\
|
||||||
<textarea id="#{theId}" name="#{name}">#{either id unTextarea val}
|
<textarea id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}">#{either id unTextarea val}
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
|
|
||||||
hiddenField :: RenderMessage master FormMessage => Field sub master Text
|
hiddenField :: RenderMessage master FormMessage => Field sub master Text
|
||||||
hiddenField = Field
|
hiddenField = Field
|
||||||
{ fieldParse = blank $ Right
|
{ fieldParse = blank $ Right
|
||||||
, fieldView = \theId name val _isReq -> addHamlet
|
, fieldView = \theId name theClass val _isReq -> addHamlet
|
||||||
[HAMLET|\
|
[HAMLET|\
|
||||||
<input type="hidden" id="#{theId}" name="#{name}" value="#{either id id val}">
|
<input type="hidden" id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" value="#{either id id val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
|
|
||||||
textField :: RenderMessage master FormMessage => Field sub master Text
|
textField :: RenderMessage master FormMessage => Field sub master Text
|
||||||
textField = Field
|
textField = Field
|
||||||
{ fieldParse = blank $ Right
|
{ fieldParse = blank $ Right
|
||||||
, fieldView = \theId name val isReq ->
|
, fieldView = \theId name theClass val isReq ->
|
||||||
[WHAMLET|
|
[WHAMLET|
|
||||||
<input id="#{theId}" name="#{name}" type="text" :isReq:required value="#{either id id val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="text" :isReq:required value="#{either id id val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
|
|
||||||
passwordField :: RenderMessage master FormMessage => Field sub master Text
|
passwordField :: RenderMessage master FormMessage => Field sub master Text
|
||||||
passwordField = Field
|
passwordField = Field
|
||||||
{ fieldParse = blank $ Right
|
{ fieldParse = blank $ Right
|
||||||
, fieldView = \theId name val isReq -> addHamlet
|
, fieldView = \theId name theClass val isReq -> addHamlet
|
||||||
[HAMLET|\
|
[HAMLET|\
|
||||||
<input id="#{theId}" name="#{name}" type="password" :isReq:required="" value="#{either id id val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="password" :isReq:required="" value="#{either id id val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -266,9 +268,9 @@ emailField = Field
|
|||||||
\s -> if Email.isValid (unpack s)
|
\s -> if Email.isValid (unpack s)
|
||||||
then Right s
|
then Right s
|
||||||
else Left $ MsgInvalidEmail s
|
else Left $ MsgInvalidEmail s
|
||||||
, fieldView = \theId name val isReq -> addHamlet
|
, fieldView = \theId name theClass val isReq -> addHamlet
|
||||||
[HAMLET|\
|
[HAMLET|\
|
||||||
<input id="#{theId}" name="#{name}" type="email" :isReq:required="" value="#{either id id val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="email" :isReq:required="" value="#{either id id val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -276,9 +278,9 @@ type AutoFocus = Bool
|
|||||||
searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master Text
|
searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master Text
|
||||||
searchField autoFocus = Field
|
searchField autoFocus = Field
|
||||||
{ fieldParse = blank Right
|
{ fieldParse = blank Right
|
||||||
, fieldView = \theId name val isReq -> do
|
, fieldView = \theId name theClass val isReq -> do
|
||||||
[WHAMLET|\
|
[WHAMLET|\
|
||||||
<input id="#{theId}" name="#{name}" type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
|
||||||
|]
|
|]
|
||||||
when autoFocus $ do
|
when autoFocus $ do
|
||||||
-- we want this javascript to be placed immediately after the field
|
-- we want this javascript to be placed immediately after the field
|
||||||
@ -296,9 +298,9 @@ urlField = Field
|
|||||||
case parseURI $ unpack s of
|
case parseURI $ unpack s of
|
||||||
Nothing -> Left $ MsgInvalidUrl s
|
Nothing -> Left $ MsgInvalidUrl s
|
||||||
Just _ -> Right s
|
Just _ -> Right s
|
||||||
, fieldView = \theId name val isReq ->
|
, fieldView = \theId name theClass val isReq ->
|
||||||
[WHAMLET|
|
[WHAMLET|
|
||||||
<input ##{theId} name=#{name} type=url :isReq:required value=#{either id id val}>
|
<input ##{theId} name=#{name} :T.null theClass:class="#{theClass}" type=url :isReq:required value=#{either id id val}>
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -309,12 +311,12 @@ selectField' :: (Eq a, RenderMessage master FormMessage) => GGHandler sub master
|
|||||||
selectField' = selectFieldHelper
|
selectField' = selectFieldHelper
|
||||||
(\theId name inside -> [WHAMLET|<select ##{theId} name=#{name}>^{inside}|]) -- outside
|
(\theId name inside -> [WHAMLET|<select ##{theId} name=#{name}>^{inside}|]) -- outside
|
||||||
(\_theId _name isSel -> [WHAMLET|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
|
(\_theId _name isSel -> [WHAMLET|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
|
||||||
(\_theId _name value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected>#{text}|]) -- inside
|
(\_theId _name theClass value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected :T.null theClass:class"#{theClass}">#{text}|]) -- inside
|
||||||
|
|
||||||
multiSelectField :: (Show a, Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master [a]
|
multiSelectField :: (Show a, Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master [a]
|
||||||
multiSelectField = multiSelectFieldHelper
|
multiSelectField = multiSelectFieldHelper
|
||||||
(\theId name inside -> [WHAMLET|<select ##{theId} multiple name=#{name}>^{inside}|])
|
(\theId name inside -> [WHAMLET|<select ##{theId} multiple name=#{name}>^{inside}|])
|
||||||
(\_theId _name value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected>#{text}|])
|
(\_theId _name theClass value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected :T.null theClass:class="#{theClass}">#{text}|])
|
||||||
|
|
||||||
radioField :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master a
|
radioField :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master a
|
||||||
radioField = radioField' . optionsPairs
|
radioField = radioField' . optionsPairs
|
||||||
@ -327,25 +329,25 @@ radioField' = selectFieldHelper
|
|||||||
<input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
|
<input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
|
||||||
<label for=#{theId}-none>_{MsgSelectNone}
|
<label for=#{theId}-none>_{MsgSelectNone}
|
||||||
|])
|
|])
|
||||||
(\theId name value isSel text -> [WHAMLET|
|
(\theId name theClass value isSel text -> [WHAMLET|
|
||||||
<div>
|
<div>
|
||||||
<input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked>
|
<input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked :T.null theClass:class="#{theClass}">
|
||||||
<label for=#{theId}-#{value}>#{text}
|
<label for=#{theId}-#{value}>#{text}
|
||||||
|])
|
|])
|
||||||
|
|
||||||
boolField :: RenderMessage master FormMessage => Field sub master Bool
|
boolField :: RenderMessage master FormMessage => Field sub master Bool
|
||||||
boolField = Field
|
boolField = Field
|
||||||
{ fieldParse = return . boolParser
|
{ fieldParse = return . boolParser
|
||||||
, fieldView = \theId name val isReq -> [WHAMLET|
|
, fieldView = \theId name theClass val isReq -> [WHAMLET|
|
||||||
$if not isReq
|
$if not isReq
|
||||||
<input id=#{theId}-none type=radio name=#{name} value=none checked>
|
<input id=#{theId}-none :T.null theClass:class="#{theClass}" type=radio name=#{name} value=none checked>
|
||||||
<label for=#{theId}-none>_{MsgSelectNone}
|
<label for=#{theId}-none>_{MsgSelectNone}
|
||||||
|
|
||||||
|
|
||||||
<input id=#{theId}-yes type=radio name=#{name} value=yes :showVal id val:checked>
|
<input id=#{theId}-yes :T.null theClass:class="#{theClass}" type=radio name=#{name} value=yes :showVal id val:checked>
|
||||||
<label for=#{theId}-yes>_{MsgBoolYes}
|
<label for=#{theId}-yes>_{MsgBoolYes}
|
||||||
|
|
||||||
<input id=#{theId}-no type=radio name=#{name} value=no :showVal not val:checked>
|
<input id=#{theId}-no :T.null theClass:class="#{theClass}" type=radio name=#{name} value=no :showVal not val:checked>
|
||||||
<label for=#{theId}-no>_{MsgBoolNo}
|
<label for=#{theId}-no>_{MsgBoolNo}
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -361,15 +363,16 @@ boolField = Field
|
|||||||
|
|
||||||
multiSelectFieldHelper :: (Show a, Eq a)
|
multiSelectFieldHelper :: (Show a, Eq a)
|
||||||
=> (Text -> Text -> GWidget sub master () -> GWidget sub master ())
|
=> (Text -> Text -> GWidget sub master () -> GWidget sub master ())
|
||||||
-> (Text -> Text -> Text -> Bool -> Text -> GWidget sub master ())
|
-> (Text -> Text -> Text -> Text -> Bool -> Text -> GWidget sub master ())
|
||||||
-> [(Text, a)] -> Field sub master [a]
|
-> [(Text, a)] -> Field sub master [a]
|
||||||
multiSelectFieldHelper outside inside opts = Field
|
multiSelectFieldHelper outside inside opts = Field
|
||||||
{ fieldParse = return . selectParser
|
{ fieldParse = return . selectParser
|
||||||
, fieldView = \theId name vals _ ->
|
, fieldView = \theId name theClass vals _ ->
|
||||||
outside theId name $ do
|
outside theId name $ do
|
||||||
flip mapM_ pairs $ \pair -> inside
|
flip mapM_ pairs $ \pair -> inside
|
||||||
theId
|
theId
|
||||||
name
|
name
|
||||||
|
theClass
|
||||||
(pack $ show $ fst pair)
|
(pack $ show $ fst pair)
|
||||||
((fst pair) `elem` (either (\_ -> []) selectedVals vals)) -- We are presuming that select fields can't hold invalid values
|
((fst pair) `elem` (either (\_ -> []) selectedVals vals)) -- We are presuming that select fields can't hold invalid values
|
||||||
(fst $ snd pair)
|
(fst $ snd pair)
|
||||||
@ -425,19 +428,20 @@ selectFieldHelper
|
|||||||
:: (Eq a, RenderMessage master FormMessage)
|
:: (Eq a, RenderMessage master FormMessage)
|
||||||
=> (Text -> Text -> GWidget sub master () -> GWidget sub master ())
|
=> (Text -> Text -> GWidget sub master () -> GWidget sub master ())
|
||||||
-> (Text -> Text -> Bool -> GWidget sub master ())
|
-> (Text -> Text -> Bool -> GWidget sub master ())
|
||||||
-> (Text -> Text -> Text -> Bool -> Text -> GWidget sub master ())
|
-> (Text -> Text -> Text -> Text -> Bool -> Text -> GWidget sub master ())
|
||||||
-> GGHandler sub master IO (OptionList a) -> Field sub master a
|
-> GGHandler sub master IO (OptionList a) -> Field sub master a
|
||||||
selectFieldHelper outside onOpt inside opts' = Field
|
selectFieldHelper outside onOpt inside opts' = Field
|
||||||
{ fieldParse = \x -> do
|
{ fieldParse = \x -> do
|
||||||
opts <- opts'
|
opts <- opts'
|
||||||
return $ selectParser opts x
|
return $ selectParser opts x
|
||||||
, fieldView = \theId name val isReq -> do
|
, fieldView = \theId name theClass val isReq -> do
|
||||||
opts <- fmap olOptions $ lift $ liftIOHandler opts'
|
opts <- fmap olOptions $ lift $ liftIOHandler opts'
|
||||||
outside theId name $ do
|
outside theId name $ do
|
||||||
unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts
|
unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts
|
||||||
flip mapM_ opts $ \opt -> inside
|
flip mapM_ opts $ \opt -> inside
|
||||||
theId
|
theId
|
||||||
name
|
name
|
||||||
|
theClass
|
||||||
(optionExternalValue opt)
|
(optionExternalValue opt)
|
||||||
((render opts val) == optionExternalValue opt)
|
((render opts val) == optionExternalValue opt)
|
||||||
(optionDisplay opt)
|
(optionDisplay opt)
|
||||||
@ -471,12 +475,13 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do
|
|||||||
let t = renderMessage master langs MsgValueRequired
|
let t = renderMessage master langs MsgValueRequired
|
||||||
in (FormFailure [t], Just $ toHtml t)
|
in (FormFailure [t], Just $ toHtml t)
|
||||||
Just fi -> (FormSuccess fi, Nothing)
|
Just fi -> (FormSuccess fi, Nothing)
|
||||||
|
let theClass = fsClass fs
|
||||||
let fv = FieldView
|
let fv = FieldView
|
||||||
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
|
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
|
||||||
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
|
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
|
||||||
, fvId = id'
|
, fvId = id'
|
||||||
, fvInput = [WHAMLET|
|
, fvInput = [WHAMLET|
|
||||||
<input type=file name=#{name} ##{id'}>
|
<input type=file name=#{name} ##{id'} :T.null theClass:class="#{theClass}">
|
||||||
|]
|
|]
|
||||||
, fvErrors = errs
|
, fvErrors = errs
|
||||||
, fvRequired = True
|
, fvRequired = True
|
||||||
@ -499,12 +504,13 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
|
|||||||
case Map.lookup name fenv of
|
case Map.lookup name fenv of
|
||||||
Nothing -> (FormSuccess Nothing, Nothing)
|
Nothing -> (FormSuccess Nothing, Nothing)
|
||||||
Just fi -> (FormSuccess $ Just fi, Nothing)
|
Just fi -> (FormSuccess $ Just fi, Nothing)
|
||||||
|
let theClass = fsClass fs
|
||||||
let fv = FieldView
|
let fv = FieldView
|
||||||
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
|
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
|
||||||
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
|
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
|
||||||
, fvId = id'
|
, fvId = id'
|
||||||
, fvInput = [WHAMLET|
|
, fvInput = [WHAMLET|
|
||||||
<input type=file name=#{name} ##{id'}>
|
<input type=file name=#{name} ##{id'} :T.null theClass:class="#{theClass}">
|
||||||
|]
|
|]
|
||||||
, fvErrors = errs
|
, fvErrors = errs
|
||||||
, fvRequired = False
|
, fvRequired = False
|
||||||
|
|||||||
@ -137,7 +137,7 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
|
|||||||
{ fvLabel = toHtml $ mr2 fsLabel
|
{ fvLabel = toHtml $ mr2 fsLabel
|
||||||
, fvTooltip = fmap toHtml $ fmap mr2 fsTooltip
|
, fvTooltip = fmap toHtml $ fmap mr2 fsTooltip
|
||||||
, fvId = theId
|
, fvId = theId
|
||||||
, fvInput = fieldView theId name val isReq
|
, fvInput = fieldView theId name fsClass val isReq
|
||||||
, fvErrors =
|
, fvErrors =
|
||||||
case res of
|
case res of
|
||||||
FormFailure [e] -> Just $ toHtml e
|
FormFailure [e] -> Just $ toHtml e
|
||||||
|
|||||||
@ -20,6 +20,7 @@ import Yesod.Form
|
|||||||
import Yesod.Widget
|
import Yesod.Widget
|
||||||
import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,
|
import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,
|
||||||
timeToTimeOfDay)
|
timeToTimeOfDay)
|
||||||
|
import qualified Data.Text as T (null)
|
||||||
import Data.Char (isSpace)
|
import Data.Char (isSpace)
|
||||||
import Data.Default
|
import Data.Default
|
||||||
import Text.Hamlet (shamlet)
|
import Text.Hamlet (shamlet)
|
||||||
@ -78,9 +79,9 @@ jqueryDayField jds = Field
|
|||||||
Right
|
Right
|
||||||
. readMay
|
. readMay
|
||||||
. unpack
|
. unpack
|
||||||
, fieldView = \theId name val isReq -> do
|
, fieldView = \theId name theClass val isReq -> do
|
||||||
addHtml [HTML|\
|
addHtml [HTML|\
|
||||||
<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="date" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
addScript' urlJqueryJs
|
addScript' urlJqueryJs
|
||||||
addScript' urlJqueryUiJs
|
addScript' urlJqueryUiJs
|
||||||
@ -129,9 +130,9 @@ jqueryDayTimeUTCTime (UTCTime day utcTime) =
|
|||||||
jqueryDayTimeField :: (RenderMessage master FormMessage, YesodJquery master) => Field sub master UTCTime
|
jqueryDayTimeField :: (RenderMessage master FormMessage, YesodJquery master) => Field sub master UTCTime
|
||||||
jqueryDayTimeField = Field
|
jqueryDayTimeField = Field
|
||||||
{ fieldParse = blank $ parseUTCTime . unpack
|
{ fieldParse = blank $ parseUTCTime . unpack
|
||||||
, fieldView = \theId name val isReq -> do
|
, fieldView = \theId name theClass val isReq -> do
|
||||||
addHtml [HTML|\
|
addHtml [HTML|\
|
||||||
<input id="#{theId}" name="#{name}" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
addScript' urlJqueryJs
|
addScript' urlJqueryJs
|
||||||
addScript' urlJqueryUiJs
|
addScript' urlJqueryUiJs
|
||||||
@ -159,9 +160,9 @@ jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master
|
|||||||
=> Route master -> Field sub master Text
|
=> Route master -> Field sub master Text
|
||||||
jqueryAutocompleteField src = Field
|
jqueryAutocompleteField src = Field
|
||||||
{ fieldParse = blank $ Right
|
{ fieldParse = blank $ Right
|
||||||
, fieldView = \theId name val isReq -> do
|
, fieldView = \theId name theClass val isReq -> do
|
||||||
addHtml [HTML|\
|
addHtml [HTML|\
|
||||||
<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
|
<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
|
||||||
|]
|
|]
|
||||||
addScript' urlJqueryJs
|
addScript' urlJqueryJs
|
||||||
addScript' urlJqueryUiJs
|
addScript' urlJqueryUiJs
|
||||||
|
|||||||
@ -111,6 +111,7 @@ withDelete af = do
|
|||||||
, fsTooltip = Nothing
|
, fsTooltip = Nothing
|
||||||
, fsName = Just deleteName
|
, fsName = Just deleteName
|
||||||
, fsId = Nothing
|
, fsId = Nothing
|
||||||
|
, fsClass = ""
|
||||||
} $ Just False
|
} $ Just False
|
||||||
(res, xml) <- aFormToForm af
|
(res, xml) <- aFormToForm af
|
||||||
return $ Right (res, xml $ xml2 [])
|
return $ Right (res, xml $ xml2 [])
|
||||||
|
|||||||
@ -20,6 +20,7 @@ import Text.Blaze.Renderer.String (renderHtml)
|
|||||||
import Text.Blaze (preEscapedText)
|
import Text.Blaze (preEscapedText)
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Data.Text (Text, pack)
|
import Data.Text (Text, pack)
|
||||||
|
import qualified Data.Text as T (null)
|
||||||
import Data.Maybe (listToMaybe)
|
import Data.Maybe (listToMaybe)
|
||||||
|
|
||||||
class YesodNic a where
|
class YesodNic a where
|
||||||
@ -30,14 +31,14 @@ class YesodNic a where
|
|||||||
nicHtmlField :: YesodNic master => Field sub master Html
|
nicHtmlField :: YesodNic master => Field sub master Html
|
||||||
nicHtmlField = Field
|
nicHtmlField = Field
|
||||||
{ fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe
|
{ fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe
|
||||||
, fieldView = \theId name val _isReq -> do
|
, fieldView = \theId name theClass val _isReq -> do
|
||||||
addHtml
|
addHtml
|
||||||
#if __GLASGOW_HASKELL__ >= 700
|
#if __GLASGOW_HASKELL__ >= 700
|
||||||
[shamlet|
|
[shamlet|
|
||||||
#else
|
#else
|
||||||
[$shamlet|
|
[$shamlet|
|
||||||
#endif
|
#endif
|
||||||
<textarea id="#{theId}" name="#{name}" .html>#{showVal val}
|
<textarea id="#{theId}" :T.null theClass:class="#{theClass}" name="#{name}" .html>#{showVal val}
|
||||||
|]
|
|]
|
||||||
addScript' urlNicEdit
|
addScript' urlNicEdit
|
||||||
addJulius
|
addJulius
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user