diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index a159489fe..77c7c42de 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -54,6 +54,24 @@ emailTestForm = (,)
SelFormatDate -> d
SelFormatTime -> t
+makeDemoForm :: Int -> Form (Int,Bool,Double)
+makeDemoForm n = identifyForm "adminTestForm" $ \html -> do -- Important: used identForm instead!
+ (result, widget) <- flip (renderAForm FormStandard) html $ (,,)
+ <$> areq (minIntField n "Zahl") (fromString $ "Ganzzahl > " ++ show n) Nothing
+ <* aformSection MsgFormBehaviour
+ <*> areq checkBoxField "Muss nächste Zahl größer sein?" (Just True)
+ <*> areq doubleField "Fliesskommazahl" Nothing
+ <* submitButton
+ return $ case result of
+ FormSuccess fsres
+ | errorMsgs <- validateResult fsres
+ , not $ null errorMsgs -> (FormFailure errorMsgs, widget)
+ _otherwise -> (result, widget)
+ where
+ validateResult :: (Int,Bool,Double) -> [Text]
+ validateResult (i,True,d) | (fromIntegral i) >= d = [tshow d <> " ist nicht größer als " <> tshow i, "Zweite Fehlermeldung", "Dritte Fehlermeldung"]
+ validateResult _other = []
+
getAdminTestR, postAdminTestR :: Handler Html -- Demo Page. Referenzimplementierungen sollte hier gezeigt werden!
getAdminTestR = postAdminTestR
@@ -81,10 +99,43 @@ postAdminTestR = do
^{emailWidget}
|]
- defaultLayout $
- -- setTitle "Uni2work Admin Testpage"
+
+ let demoFormAction (_i,_b,_d) = addMessage Info "All ok."
+ ((demoResult, formWidget),formEnctype) <- runFormPost $ makeDemoForm 7
+ formResult demoResult demoFormAction
+ let actionUrl = AdminTestR
+ let showDemoResult = [whamlet|
+ $maybe (i,b,d) <- formResult' demoResult
+ Received values:
+
+ - #{show i}
+
- #{show b}
+
- #{show d}
+ $nothing
+ No form values received, due to #
+ $# Using formResult' above means that we usually to not distinguish the following two cases here, sind formResult does this already:
+ $case demoResult
+ $of FormSuccess _
+ $# Already dealt with above, to showecase usage of formResult' as normally done.
+ success, which should not happen here.
+ $of FormMissing
+ Form data missing, probably empty.
+ $of FormFailure msgs
+
+ $forall m <- msgs
+ - #{m}
+ |]
+
+ let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
+ siteLayout locallyDefinedPageHeading $ do
+ -- defaultLayout $ do
+ setTitle "Uni2work Admin Testpage"
$(widgetFile "adminTest")
+ [whamlet|
Formular Demonstration|]
+ $(widgetFile "formPage")
+ showDemoResult
+
getAdminErrMsgR, postAdminErrMsgR :: Handler Html
getAdminErrMsgR = postAdminErrMsgR
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 237689dd5..995bcd12f 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -156,10 +156,11 @@ natIntField ::(Monad m, RenderMessage (HandlerSite m) FormMessage) => Text -> Fi
natIntField = natField
posIntField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
-posIntField d = checkBool (>= 1) (T.append d " muss eine positive Zahl sein.") intField
+posIntField d = checkBool (> 0) (T.append d " muss eine positive Zahl sein.") intField
+-- | Field to request integral number > 'm'
minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i
-minIntField m d = checkBool (>= m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) intField
+minIntField m d = checkBool (> m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) intField
pointsField :: (Monad m, HandlerSite m ~ UniWorX) => Field m Points --TODO allow fractions
pointsField = checkBool (>= 0) MsgPointsNotPositive Field{..}
diff --git a/templates/formPage.hamlet b/templates/formPage.hamlet
index c0b36d13f..0e5b34298 100644
--- a/templates/formPage.hamlet
+++ b/templates/formPage.hamlet
@@ -1,2 +1,5 @@
-