Term template angepasst

src/Handler/Term.hs

@@ -89,42 +89,21 @@ getTermEditExistR tid = do
 termEditHandler :: Maybe Term -> Handler Html
 termEditHandler term = do
     ((result, formWidget), formEnctype) <- runFormPost $ newTermForm term
-    action <- lookupPostParam "formaction"
+    case result of
-    case (result,action) of
+      (FormSuccess res) -> 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."            
-          addMessage "warning" [shamlet| #{msg} |]
-          redirect TermShowR
-        | fAct == formActionSave -> do
           -- term <- runDB $ get $ TermKey termName 
           runDB $ repsert (TermKey $ termName res) res
           let tid = termToText $ termName res
           let msg = "Semester " `T.append` tid `T.append` " erfolgreich editiert."            
           addMessage "success" [shamlet| #{msg} |]
-          redirect TermShowR   
+          redirect TermShowR
-        | otherwise -> redirect TermShowR      
+      (FormMissing  ) -> return ()
-      (FormMissing,_)   -> return ()
+      (FormFailure _) -> addMessage "warning" "Bitte Eingabe korrigieren."
-      (FormFailure _,_) -> addMessage "warning" "Bitte Eingabe korrigieren."            
     let formTitle   = "Semester editieren/anlegen" :: Text
     let actionUrl   = TermEditR
-    let formActions = defaultFormActions
     defaultLayout $ do
       setTitle [shamlet| #{formTitle} |]
       $(widgetFile "formPage")
-
-{-            
-wdgtTermForm :: (ToWidget UniWorX a) => a -> Enctype ->  Handler Html              
-wdgtTermForm formWidget formEnctype = do
-    let formTitle   = "Semester editieren/anlegen" :: Text
-    let actionUrl   = TermEditR
-    let formActions = defaultFormActions
-    defaultLayout $ do
-      setTitle [shamlet| #{formTitle} |]
-      $(widgetFile "formPage")
--}
       
 newTermForm :: Maybe Term -> Form Term
 newTermForm template html = do
@@ -136,7 +115,7 @@ newTermForm template html = do
       <*> areq dayField  (bfs ("Beginn Vorlesungen" :: Text)) (termLectureStart <$> template)
       <*> areq dayField  (bfs ("Ende Vorlesungen" :: Text)) (termLectureEnd   <$> template)
       <*> areq checkBoxField (bfs ("Aktiv" :: Text)) (termActive <$> template)
-      -- <*  bootstrapSubmit (bsSubmit "Semester bearbeiten")      
+      <*  submitButton
     return $ case result of  
       FormSuccess termResult 
         | errorMsgs <- validateTerm termResult

src/Handler/Utils/Form.hs

@@ -68,8 +68,9 @@ class (Enum a, Bounded a, Ord a, PathPiece a) => Button a where
   cssClass :: a -> ButtonCssClass
   cssClass _ = BCDefault
   
-  
+
---Some standard Buttons useful throughout  
+
+{- Abort is not useful (press Back instead); Delete should be different:
 data StandardButton = BtnDelete | BtnAbort | BtnSave
   deriving (Enum, Eq, Ord, Bounded, Read, Show)
      
@@ -85,6 +86,7 @@ instance Button StandardButton where
   cssClass BtnDelete = BCWarning
   cssClass BtnAbort  = BCDefault
   cssClass BtnSave   = BCPrimary
+-}
 
 data SubmitButton = BtnSubmit
   deriving (Enum, Eq, Ord, Bounded, Read, Show)
@@ -132,13 +134,13 @@ buttonField btn = Field {fieldParse, fieldView, fieldEnctype}
     fieldParse _ _ = return $ Left "Multiple button values"
     
     
-combinedButtonField1 :: Button a => [a] -> AForm Handler [Maybe a]
+combinedButtonField :: Button a => [a] -> AForm Handler [Maybe a]
-combinedButtonField1 btns = traverse b2f btns
+combinedButtonField btns = traverse b2f btns
   where
     b2f b = aopt (buttonField b) "" Nothing 
 
 submitButton :: AForm Handler ()
-submitButton = void $ combinedButtonField1 [BtnSubmit]
+submitButton = void $ combinedButtonField [BtnSubmit]
 
     {-
 combinedButtonField :: Button a => [a] -> Form m -> Form (a,m)

templates/formPage.hamlet

@@ -11,6 +11,3 @@
                 <div .bs-callout bs-callout-info well>
                     <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/home.hamlet

@@ -57,6 +57,8 @@
 
                       <li .list-group-item>
                         <a href=@{TermShowR}>Semester Verwaltung
+                        <a href=@{TermEditR}>Neues Semester anlegen
+
                         
                       <li .list-group-item>
                         <a href=@{CourseEditR}>Kurse anlegen