diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index a78362fb1..38eaea847 100644 --- a/src/Handler/Term.hs +++ b/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,action) of - (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 + case result of + (FormSuccess res) -> 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 - | otherwise -> redirect TermShowR - (FormMissing,_) -> return () - (FormFailure _,_) -> addMessage "warning" "Bitte Eingabe korrigieren." + redirect TermShowR + (FormMissing ) -> return () + (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 diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index b286f7a73..3398b22a2 100644 --- a/src/Handler/Utils/Form.hs +++ b/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] -combinedButtonField1 btns = traverse b2f btns +combinedButtonField :: Button a => [a] -> AForm Handler [Maybe a] +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) diff --git a/templates/formPage.hamlet b/templates/formPage.hamlet index 387e3221b..aa2d687d1 100644 --- a/templates/formPage.hamlet +++ b/templates/formPage.hamlet @@ -11,6 +11,3 @@
^{formWidget} -
- $forall (fAct,bLbl,bCl) <- formActions -