Introduce wrapForm'

This commit is contained in:
Gregor Kleen 2019-05-08 14:58:40 +02:00
parent ffa1206078
commit e5dbbe38ad
2 changed files with 17 additions and 10 deletions

View File

@ -351,11 +351,15 @@ autosubmitButton = combinedButtonFieldF_ (Proxy @ButtonSubmit) $ "" & addAutosub
-- | just Html for a Submit-Button
submitButtonView :: forall site . Button site ButtonSubmit => WidgetT site IO ()
submitButtonView = do
let bField :: Field (HandlerT site IO) ButtonSubmit
bField = buttonField BtnSubmit
submitButtonView = buttonView BtnSubmit
buttonView :: forall site button. Button site button => button -> WidgetT site IO ()
buttonView btn = do
let bField :: Field (HandlerT site IO) button
bField = buttonField btn
btnId <- newIdent
fieldView bField btnId "" mempty (Right BtnSubmit) False
fieldView bField btnId "" mempty (Right btn) False
buttonForm :: (Button site a, Finite a) => Html -> MForm (HandlerT site IO) (FormResult a, WidgetT site IO ())
@ -478,8 +482,11 @@ instance Default (FormSettings site) where
, formAnchor = Nothing :: Maybe Text
}
wrapForm :: (Button site ButtonSubmit) => WidgetT site IO () -> FormSettings site -> WidgetT site IO ()
wrapForm formWidget FormSettings{..} = do
wrapForm :: Button site ButtonSubmit => WidgetT site IO () -> FormSettings site -> WidgetT site IO ()
wrapForm = wrapForm' BtnSubmit
wrapForm' :: Button site button => button -> WidgetT site IO () -> FormSettings site -> WidgetT site IO ()
wrapForm' btn formWidget FormSettings{..} = do
formId <- maybe newIdent (return . toPathPiece) formAnchor
formActionUrl <- traverse toTextUrl formAction
$(widgetFile "widgets/form/form")

View File

@ -7,12 +7,12 @@ $# Wrapper for all kinds of forms
^{formWidget}
$of FormSubmit
^{formWidget}
^{submitButtonView}
^{buttonView btn}
$of FormDualSubmit
^{submitButtonView}
^{buttonView btn}
^{formWidget}
^{submitButtonView}
^{buttonView btn}
$of FormAutoSubmit
^{formWidget}
<button type=submit uw-auto-submit-button>
^{btnLabel BtnSubmit}
^{btnLabel btn}