Form Missing eliminated for GET request
This commit is contained in:
parent
af6d97454d
commit
a5428bfc30
@ -5,6 +5,8 @@ Page n@Int64: #{tshow n}
|
||||
TermEdited tid@TermIdentifier: Semester #{termToText tid} erfolgreich editiert.
|
||||
TermNewTitle: Semester editiere/anlegen.
|
||||
InvalidInput: Eingaben bitte korrigieren.
|
||||
Term: Semester
|
||||
TermPlaceholder: W/S + vierstellige Jahreszahl
|
||||
|
||||
CourseNewOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich erstellt.
|
||||
CourseEditOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} wurde erfolgreich geändert.
|
||||
@ -55,3 +57,4 @@ TermsHeading: Semesterübersicht
|
||||
|
||||
NumCourses n@Int64: #{tshow n} Kurse
|
||||
CloseAlert: Schliessen
|
||||
|
||||
|
||||
@ -127,24 +127,26 @@ postCShowR tid csh = do
|
||||
getCourseNewR :: Handler Html
|
||||
getCourseNewR = do
|
||||
-- TODO: Defaults für Semester hier ermitteln und übergeben
|
||||
courseEditHandler Nothing
|
||||
courseEditHandler True Nothing
|
||||
|
||||
postCourseNewR :: Handler Html
|
||||
postCourseNewR = courseEditHandler Nothing
|
||||
postCourseNewR = courseEditHandler False Nothing
|
||||
|
||||
getCEditR :: TermId -> Text -> Handler Html
|
||||
getCEditR tid csh = do
|
||||
course <- runDB $ getBy $ CourseTermShort tid csh
|
||||
courseEditHandler course
|
||||
courseEditHandler True course
|
||||
|
||||
postCEditR :: TermId -> Text -> Handler Html
|
||||
postCEditR = getCEditR
|
||||
postCEditR tid csh = do
|
||||
course <- runDB $ getBy $ CourseTermShort tid csh
|
||||
courseEditHandler False course
|
||||
|
||||
getCourseEditIDR :: CryptoUUIDCourse -> Handler Html
|
||||
getCourseEditIDR cID = do
|
||||
cIDKey <- getsYesod appCryptoIDKey
|
||||
courseID <- UUID.decrypt cIDKey cID
|
||||
courseEditHandler =<< runDB (getEntity courseID)
|
||||
courseEditHandler True =<< runDB (getEntity courseID)
|
||||
|
||||
|
||||
courseDeleteHandler :: Handler Html -- not called anywhere yet
|
||||
@ -158,8 +160,8 @@ courseDeleteHandler = undefined
|
||||
redirect $ TermCourseListR $ cfTerm res
|
||||
-}
|
||||
|
||||
courseEditHandler :: Maybe (Entity Course) -> Handler Html
|
||||
courseEditHandler course = do
|
||||
courseEditHandler :: Bool -> Maybe (Entity Course) -> Handler Html
|
||||
courseEditHandler isGet course = do
|
||||
aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
|
||||
((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course
|
||||
case result of
|
||||
@ -250,6 +252,7 @@ courseEditHandler course = do
|
||||
-- else addMessageI "danger" $ MsgCourseEditDupShort tident csh
|
||||
|
||||
(FormFailure _) -> addMessageI "warning" MsgInvalidInput
|
||||
(FormMissing) | isGet -> return ()
|
||||
other -> addMessage "error" $ [shamlet| Error: #{show other}|]
|
||||
let formTitle = "Kurs editieren/anlegen" :: Text
|
||||
actionUrl <- fromMaybe CourseNewR <$> getCurrentRoute
|
||||
|
||||
@ -133,13 +133,14 @@ termEditHandler term = do
|
||||
|
||||
newTermForm :: Maybe Term -> Form Term
|
||||
newTermForm template html = do
|
||||
renderMessage <- getMessageRender
|
||||
(result, widget) <- flip (renderAForm FormStandard) html $ Term
|
||||
<$> areq termNewField (bfs ("Semester" :: Text)) (termName <$> template)
|
||||
<*> areq dayField (bfs ("Erster Tag" :: Text)) (termStart <$> template)
|
||||
<*> areq dayField (bfs ("Letzer Tag" :: Text)) (termEnd <$> template)
|
||||
<$> areq termNewField (fslpI MsgTerm (renderMessage MsgTermPlaceholder)) (termName <$> template)
|
||||
<*> areq dayField (fsl ("Erster Tag" :: Text)) (termStart <$> template)
|
||||
<*> areq dayField (fsl ("Letzer Tag" :: Text)) (termEnd <$> template)
|
||||
<*> pure [] -- TODO: List of Day field required, must probably be done as its own form and then combined
|
||||
<*> areq dayField (bfs ("Beginn Vorlesungen" :: Text)) (termLectureStart <$> template)
|
||||
<*> areq dayField (bfs ("Ende Vorlesungen" :: Text)) (termLectureEnd <$> template)
|
||||
<*> areq dayField (fsl "Beginn Vorlesungen") (termLectureStart <$> template)
|
||||
<*> areq dayField (fsl ("Ende Vorlesungen" :: Text)) (termLectureEnd <$> template)
|
||||
<*> areq checkBoxField (bfs ("Aktiv" :: Text)) (termActive <$> template)
|
||||
<* submitButton
|
||||
return $ case result of
|
||||
|
||||
@ -378,12 +378,39 @@ utcTimeField = Field
|
||||
showTime = fromString . (formatTime germanTimeLocale fieldTimeFormat)
|
||||
|
||||
|
||||
fsm :: RenderMessage UniWorX msg => msg -> FieldSettings UniWorX
|
||||
fsm :: RenderMessage UniWorX msg => msg -> FieldSettings UniWorX -- DEPRECATED
|
||||
fsm = bfs -- TODO: get rid of Bootstrap
|
||||
|
||||
fsb :: Text -> FieldSettings site
|
||||
fsb :: Text -> FieldSettings site -- DEPRECATED
|
||||
fsb = bfs -- Just to avoid annoying Ambiguous Type Errors
|
||||
|
||||
fsl :: Text -> FieldSettings UniWorX
|
||||
fsl label =
|
||||
FieldSettings { fsLabel = (SomeMessage label)
|
||||
, fsTooltip = Nothing
|
||||
, fsId = Nothing
|
||||
, fsName = Nothing
|
||||
, fsAttrs = []
|
||||
}
|
||||
|
||||
fslp :: Text -> Text -> FieldSettings UniWorX
|
||||
fslp label placeholder =
|
||||
FieldSettings { fsLabel = (SomeMessage label)
|
||||
, fsTooltip = Nothing
|
||||
, fsId = Nothing
|
||||
, fsName = Nothing
|
||||
, fsAttrs = [("placeholder", placeholder)]
|
||||
}
|
||||
|
||||
fslpI :: RenderMessage UniWorX msg => msg -> Text -> FieldSettings UniWorX
|
||||
fslpI label placeholder =
|
||||
FieldSettings { fsLabel = (SomeMessage label)
|
||||
, fsTooltip = Nothing
|
||||
, fsId = Nothing
|
||||
, fsName = Nothing
|
||||
, fsAttrs = [("placeholder", placeholder)]
|
||||
}
|
||||
|
||||
addAttr :: Text -> Text -> FieldSettings site -> FieldSettings site
|
||||
addAttr attr valu fs = fs { fsAttrs=newAttrs (fsAttrs fs) }
|
||||
where
|
||||
|
||||
Loading…
Reference in New Issue
Block a user