Generic form button utility

src/Handler/Term.hs

@@ -4,6 +4,8 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+
 module Handler.Term where
 
 import Import
@@ -65,26 +67,22 @@ getEditTermMaybeR :: Maybe Term -> Handler Html
 getEditTermMaybeR mbTerm= do 
     aid <- requireAuthId
     (formWidget, formEnctype) <- generateFormPost $ newTermForm mbTerm
-    let formtitle = "Semester editieren/anlegen" :: Text
+    wdgtTermForm formWidget formEnctype
-    let actionurl = EditTermR
-    defaultLayout $ do
-      setTitle [shamlet| #{formtitle} |]
-      $(widgetFile "generic_form_delete")
-        
         
 postEditTermR :: Handler Html
 postEditTermR = do
     aid <- requireAuthId
     ((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing
-    action <- lookupPostParam "action"
+    action <- lookupPostParam "formaction"
     case (result,action) of
-      (FormSuccess res, Just "delete") -> do
+      (FormSuccess res, fAct) 
+        | fAct == formActionDelete -> do
           runDB $ delete (TermKey $ termName res) 
           let tid = termToText $ termName res
           let msg = "Semester " `T.append` tid `T.append` " erfolgreich gelöscht."            
           setMessage [shamlet| #{msg} |]
           redirect ShowTermsR
-      (FormSuccess res, Just "save") -> do
+        | fAct == formActionSave -> do
           -- term <- runDB $ get $ TermKey termName 
           runDB $ repsert (TermKey $ termName res) res
           let tid = termToText $ termName res
@@ -100,15 +98,10 @@ postEditTermR = do
                                     Ende des Semesters liegt vor dem Start!
                       |]
           redirect ShowTermsR   
-      (FormSuccess res, _) ->
+        | otherwise -> redirect ShowTermsR
-          redirect ShowTermsR
       (FormMissing,_) -> do
             setMessage "Keine Formulardaten erhalten."
-            let formtitle = "Semester editieren/anlegen" :: Text
+            wdgtTermForm formWidget formEnctype
-            let actionurl = EditTermR  
-            defaultLayout $ do 
-              setTitle [shamlet| #{formtitle} |]
-              $(widgetFile "generic_form_delete")
             
       (FormFailure errorMsgs,_) -> do
             setMessage [shamlet|
@@ -117,12 +110,17 @@ postEditTermR = do
                     $forall errmsg <- errorMsgs
                       <li> #{errmsg} 
               |]
-            let formtitle = "Semester editieren/anlegen" :: Text
+            wdgtTermForm formWidget formEnctype
-            let actionurl = EditTermR  
+
-            defaultLayout $ do 
+wdgtTermForm :: (ToWidget UniWorX a) => a -> Enctype ->  Handler Html              
-              setTitle [shamlet| #{formtitle} |]
+wdgtTermForm formWidget formEnctype = do
-              $(widgetFile "generic_form_delete")
+    let formTitle   = "Semester editieren/anlegen" :: Text
-                  
+    let actionUrl   = EditTermR
+    let formActions = defaultFormActions
+    defaultLayout $ do
+      setTitle [shamlet| #{formTitle} |]
+      $(widgetFile "generic_form")
+          
 newTermForm :: Maybe Term -> Form Term
 newTermForm template = 
     renderBootstrap3 bsHorizontalDefault $ Term

src/Handler/Utils.hs

@@ -7,4 +7,5 @@ module Handler.Utils
 import Handler.Utils.DateTime as Handler.Utils
 import Handler.Utils.Term as Handler.Utils
 import Handler.Utils.Bootstrap3 as Handler.Utils
+import Handler.Utils.Form as Handler.Utils
 

src/Handler/Utils/Form.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Handler.Utils.Form where
+
+import Import
+import Data.String (IsString(..))
+-- import Yesod.Core
+-- import qualified Data.Text as T
+-- import Yesod.Form.Types
+-- import Yesod.Form.Functions
+
+formBtnSave  :: (Text,Text,Text)
+formBtnSave   = ("save"  ,"Speichern"  ,"btn-primary")
+
+formBtnAbort :: (Text,Text,Text)
+formBtnAbort  = ("abort" ,"Abbrechen"  ,"btn-default")
+
+formBtnDelete ::(Text,Text,Text)
+formBtnDelete = ("delete","Löschen"    ,"btn-warning")
+
+formActionSave :: Maybe Text
+formActionSave   = Just $ fst3 formBtnSave
+
+formActionAbort :: Maybe Text
+formActionAbort  = Just $ fst3 formBtnAbort
+
+formActionDelete :: Maybe Text
+formActionDelete = Just $ fst3 formBtnDelete
+
+defaultFormActions :: [(Text,Text,Text)]
+defaultFormActions =  [ formBtnDelete
+                      , formBtnAbort
+                      , formBtnSave
+                      ]

templates/generic_form.hamlet

@@ -4,10 +4,13 @@
             <div .col-lg-12>
                 <div .page-header>
                     <h1 #forms>
-                      #{formtitle}
+                      #{formTitle}
 
         <div .row>
             <div .col-lg-6>
                 <div .bs-callout bs-callout-info well>
-                    <form .form-horizontal method=post action=@{actionurl}#forms enctype=#{formEnctype}>
+                    <form .form-horizontal method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
                         ^{formWidget}                        
+                        <div .btn-group>
+                          $forall (fAct,bLbl,bCl) <- formActions
+                            <button .btn .#{bCl} type=submit name=formaction value=#{fAct}>#{bLbl}

templates/generic_form_delete.hamlet

@@ -1,17 +0,0 @@
-<div .container>
-    <div .bs-docs-section>
-        <div .row>
-            <div .col-lg-12>
-                <div .page-header>
-                    <h1 #forms>
-                      #{formtitle}
-
-        <div .row>
-            <div .col-lg-6>
-                <div .bs-callout bs-callout-info well>
-                    <form .form-horizontal method=post action=@{actionurl}#forms enctype=#{formEnctype}>
-                        ^{formWidget}
-                        <div .btn-group>
-                          <button .btn .btn-warning type=submit name=action value=delete>Löschen
-                          <button .btn .btn-default type=submit name=action value=abort>Abbrechen
-                          <button .btn .btn-primary type=submit name=action value=save>Speichern