fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixes #202. Not a bug actually.

Browse Source
This commit is contained in:
SJost 2018-10-11 12:04:40 +02:00
parent 39e96e6ccd
commit b87c3c4ca7
3 changed files with 5 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
models
View File

@ -150,7 +150,7 @@ SubmissionFile
isDeletion Bool -- only set if isUpdate is also set, but file was deleted by corrector isDeletion Bool -- only set if isUpdate is also set, but file was deleted by corrector
UniqueSubmissionFile file submission isUpdate UniqueSubmissionFile file submission isUpdate
deriving Show deriving Show
SubmissionUser SubmissionUser -- Actual submission participant
user UserId user UserId
submission SubmissionId submission SubmissionId
UniqueSubmissionUser user submission UniqueSubmissionUser user submission
@ -161,7 +161,7 @@ SubmissionGroupEdit
user UserId user UserId
time UTCTime time UTCTime
submissionGroup SubmissionGroupId submissionGroup SubmissionGroupId
SubmissionGroupUser SubmissionGroupUser -- Registered submission groups, independent of actual SubmissionUser
submissionGroup SubmissionGroupId submissionGroup SubmissionGroupId
user UserId user UserId
UniqueSubmissionGroupUser submissionGroup user UniqueSubmissionGroupUser submissionGroup user

6
src/Handler/Utils/Form.hs
View File

@ -165,18 +165,16 @@ buttonForm csrf = do
$forall bView <- btnViews $forall bView <- btnViews
^{fvInput bView} ^{fvInput bView}
|] |]
$logDebugS "FormResult" $ tshow results
return (accResult results,widget) return (accResult results,widget)
where where
accResult :: Foldable f => f (FormResult (Maybe a)) -> FormResult a accResult :: Foldable f => f (FormResult (Maybe a)) -> FormResult a
accResult = Foldable.foldr accResult' FormMissing accResult = Foldable.foldr accResult' FormMissing
accResult' :: FormResult (Maybe a) -> FormResult a -> FormResult a accResult' :: FormResult (Maybe a) -> FormResult a -> FormResult a
-- TODO: Does not work for Forms with more than 3 buttons, since all deliver FormFailure except for one! -- Find the single FormSuccess Just _; Expected behaviour: all buttons deliver FormFailure, except for one.
-- TODO: Maybe change buttonField?
accResult' (FormSuccess (Just _)) (FormSuccess _) = FormFailure ["Ambiguous button parse"] accResult' (FormSuccess (Just _)) (FormSuccess _) = FormFailure ["Ambiguous button parse"]
accResult' (FormSuccess (Just x)) _ = FormSuccess x accResult' (FormSuccess (Just x)) _ = FormSuccess x
accResult' _ x@(FormSuccess _) = x --SJ: Is this safe? Shouldn't Failure override Success? accResult' _ x@(FormSuccess _) = x --Safe: most buttons deliver FormFailure, one delivers FormSuccess
accResult' (FormSuccess Nothing) x = x accResult' (FormSuccess Nothing) x = x
accResult' FormMissing _ = FormMissing accResult' FormMissing _ = FormMissing
accResult' (FormFailure errs) _ = FormFailure errs accResult' (FormFailure errs) _ = FormFailure errs

2
src/Utils/Form.hs
View File

@ -195,7 +195,7 @@ buttonField btn = Field {fieldParse, fieldView, fieldEnctype}
fieldParse [] _ = return $ Right Nothing fieldParse [] _ = return $ Right Nothing
fieldParse [str] _ fieldParse [str] _
| str == toPathPiece btn = return $ Right $ Just btn | str == toPathPiece btn = return $ Right $ Just btn
| otherwise = return $ Left "Wrong button value" -- SJ: Right Nothing?! | otherwise = return $ Left "Wrong button value"
fieldParse _ _ = return $ Left "Multiple button values" fieldParse _ _ = return $ Left "Multiple button values"
combinedButtonField :: (Button site a, Show (ButtonCssClass site)) => [a] -> AForm (HandlerT site IO) [Maybe a] combinedButtonField :: (Button site a, Show (ButtonCssClass site)) => [a] -> AForm (HandlerT site IO) [Maybe a]