Form error demonstration added to 'AdminTestR'

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:
+              <ul>
+                <li>#{show i}
+                <li>#{show b}
+                <li>#{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
+                <ul>
+                  $forall m <- msgs
+                    <li>#{m}
+        |]
+
+  let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
+  siteLayout locallyDefinedPageHeading $ do
+  -- defaultLayout $ do
+    setTitle "Uni2work Admin Testpage"
     $(widgetFile "adminTest")
 
+    [whamlet|<h2>Formular Demonstration|]
+    $(widgetFile "formPage")
+    showDemoResult
+
 
 getAdminErrMsgR, postAdminErrMsgR :: Handler Html
 getAdminErrMsgR = postAdminErrMsgR

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{..}

templates/formPage.hamlet

@@ -1,2 +1,5 @@
-<form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
+$newline never
-  ^{formWidget}
+$#TODO: anchor must be generic for working with multiple forms
+<a name="forms">
+  <form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
+    ^{formWidget}

templates/formPageI18n.hamlet

@@ -1,5 +1,8 @@
+$newline never
 $maybe text <- formText
   <h2>
     _{text}
-<form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
+$#TODO: anchor must be generic for working with multiple forms
-   ^{formWidget}
+<a name="forms">
+  <form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
+    ^{formWidget}