Sheet Editing/Delete working now
This commit is contained in:
SJost
parent
5364190a38
commit
85d128a244
@ -7,10 +7,12 @@
|
||||
- Utils.getKeyBy404 effiziente Variante, welche nur den Key liefert? Esq?
|
||||
(Sheet.hs -> fetchSheet)
|
||||
|
||||
- Handler.Sheet.postSheetDelR: deleteCascade für Files?
|
||||
- Handler.Sheet.postSheetDelR: deleteCascade für Files? Klappt das?
|
||||
|
||||
- Verständnis: Getrennte Handler get/post Handler in SheetEditR haben nicht funktioniert. Warum?
|
||||
|
||||
- Sheets.redirectBack(): Wollen wir das wirklich? Schöner?
|
||||
|
||||
** i18n:
|
||||
- i18n der
|
||||
Links -> MenuItems verwenden wie bisher
|
||||
|
||||
@ -10,7 +10,7 @@ CourseEditDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText ti
|
||||
SheetNewOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Neues Übungsblatt #{sheetName} wurde im Kurs #{termToText tid}-#{courseShortHand} erfolgreich erstellt.
|
||||
SheetTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand} #{sheetName}
|
||||
SheetTitleNew tid@TermIdentifier courseShortHand@Text : #{termToText tid}-#{courseShortHand}: Neues Übungsblatt
|
||||
SheetEditOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} aus Kurs #{termToText tid}-#{courseShortHand} wurde bearbeitet.
|
||||
SheetEditOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} aus Kurs #{termToText tid}-#{courseShortHand} wurde gespeichert.
|
||||
SheetNameDup tid@TermIdentifier courseShortHand@Text sheetName@Text: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{termToText tid}-#{courseShortHand}.
|
||||
SheetDelTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} wirklich aus Kurs #{termToText tid}-#{courseShortHand} herauslöschen?
|
||||
SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{show submissionNo} Abgaben.
|
||||
|
||||
@ -267,8 +267,11 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb CourseNewR = return ("Neu", Just CourseListR)
|
||||
breadcrumb (CourseEditR _ _) = return ("Editieren", Just CourseListR)
|
||||
|
||||
breadcrumb (SheetListR tid csh) = return ("Kurs", Just $ CourseShowR tid csh)
|
||||
breadcrumb (SheetShowR tid csh _shn) = return ("Übungen", Just $ SheetListR tid csh)
|
||||
breadcrumb (SheetListR tid csh) = return ("Übungen",Just $ CourseShowR tid csh)
|
||||
breadcrumb (SheetNewR tid csh) = return ("Neu", Just $ SheetListR tid csh)
|
||||
breadcrumb (SheetShowR tid csh shn) = return (shn, Just $ SheetListR tid csh)
|
||||
breadcrumb (SheetEditR tid csh shn) = return ("Edit", Just $ SheetShowR tid csh shn)
|
||||
breadcrumb (SheetDelR tid csh shn) = return ("DELETE", Just $ SheetShowR tid csh shn)
|
||||
|
||||
breadcrumb SubmissionListR = return ("Abgaben", Just HomeR)
|
||||
breadcrumb (SubmissionR _) = return ("Abgabe", Just SubmissionListR)
|
||||
|
||||
@ -65,7 +65,7 @@ makeSheetForm template = identForm FIDsheet $ \html -> do
|
||||
-- Erstmal nur mit ZIP arbeiten
|
||||
(result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
|
||||
<$> areq textField (fsb "Name") (sfName <$> template)
|
||||
<*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfMarkingText <$> template)
|
||||
<*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfDescription <$> template)
|
||||
<*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template)
|
||||
<*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template)
|
||||
<*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template)
|
||||
@ -145,7 +145,8 @@ getSheetList courseEnt = do
|
||||
, headed "Korrigiert" $ toWgt . snd . trd3
|
||||
, headed "Eingereicht" $ toWgt . fst . trd3
|
||||
-- TODO: only show edit button for allowed course assistants
|
||||
, headed "" $ \s -> linkButton "Edit" BCLink $ SheetEditR tid csh $ sheetName $ snd3 s
|
||||
, headed "" $ \s -> linkButton "Edit" BCLink $ SheetEditR tid csh $ sheetName $ snd3 s
|
||||
, headed "" $ \s -> linkButton "Delete" BCLink $ SheetDelR tid csh $ sheetName $ snd3 s
|
||||
]
|
||||
let pageActions =
|
||||
[ NavbarLeft $ MenuItem
|
||||
@ -209,131 +210,23 @@ getSheetFileR tid csh shn typ title = do
|
||||
[] -> notFound
|
||||
_other -> error "Multiple matching files found."
|
||||
|
||||
{-
|
||||
|
||||
getSheetNewR :: TermId -> Text -> Handler Html
|
||||
getSheetNewR tid csh = do
|
||||
let tident = unTermKey tid
|
||||
aid <- requireAuthId
|
||||
(Entity cid course) <- runDB $ getBy404 $ CourseTermShort tid csh
|
||||
let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days
|
||||
((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm cid template
|
||||
case res of
|
||||
(FormSuccess SheetForm{..}) -> do
|
||||
actTime <- liftIO getCurrentTime
|
||||
let newSheet = Sheet
|
||||
{ sheetCourseId = cid
|
||||
, sheetName = sfName
|
||||
, sheetDescription = sfDescription
|
||||
, sheetType = sfType
|
||||
, sheetGrouping = sfGrouping
|
||||
, sheetMarkingText = sfMarkingText
|
||||
, sheetVisibleFrom = sfVisibleFrom
|
||||
, sheetActiveFrom = sfActiveFrom
|
||||
, sheetActiveTo = sfActiveTo
|
||||
, sheetHintFrom = sfHintFrom
|
||||
, sheetSolutionFrom = sfSolutionFrom
|
||||
, sheetCreated = actTime
|
||||
, sheetChanged = actTime
|
||||
, sheetCreatedBy = aid
|
||||
, sheetChangedBy = aid
|
||||
}
|
||||
saveOkay <- runDB $ do
|
||||
insertOkay <- insertUnique newSheet
|
||||
case insertOkay of
|
||||
Nothing -> insertOkay <$ addMessageI "danger" (MsgSheetNameDup tident csh sfName)
|
||||
(Just sid) -> do
|
||||
-- Save Files in DB:
|
||||
whenIsJust sfSheetF $ insertSheetFile sid SheetExercise
|
||||
whenIsJust sfHintF $ insertSheetFile sid SheetHint
|
||||
whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution
|
||||
addMessageI "info" $ MsgSheetNewOk tident csh sfName
|
||||
return insertOkay
|
||||
when (isJust saveOkay) $ redirect $ SheetShowR tid csh sfName
|
||||
(FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
|
||||
_ -> return ()
|
||||
let formTitle = "Neues Übungsblatt anlegen" :: Text
|
||||
let actionUrl = SheetNewR tid csh
|
||||
-- actionUrl <- getCurrentRoute
|
||||
defaultLayout $ do
|
||||
setTitleI $ MsgSheetTitle tident csh "NEW"
|
||||
$(widgetFile "formPage")
|
||||
let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
|
||||
insertUnique $ newSheet
|
||||
handleSheetEdit tid csh template action
|
||||
|
||||
postSheetNewR :: TermId -> Text -> Handler Html
|
||||
postSheetNewR = getSheetNewR
|
||||
|
||||
getSheetEditR :: TermId -> Text -> SheetId -> Handler Html
|
||||
getSheetEditR tid csh sid = do
|
||||
let tident = unTermKey tid
|
||||
aid <- requireAuthId
|
||||
sheet@(Sheet {..}) <- runDB $ get404 sid
|
||||
let template = Just $ SheetForm
|
||||
{ sfName = sheetName
|
||||
, sfDescription = sheetDescription
|
||||
, sfType = sheetType
|
||||
, sfGrouping = sheetGrouping
|
||||
, sfMarkingText = sheetMarkingText
|
||||
, sfVisibleFrom = sheetVisibleFrom
|
||||
, sfActiveFrom = sheetActiveFrom
|
||||
, sfActiveTo = sheetActiveTo
|
||||
, sfSheetF = Nothing -- TODO
|
||||
, sfHintFrom = sheetHintFrom
|
||||
, sfHintF = Nothing -- TODO
|
||||
, sfSolutionFrom = sheetSolutionFrom
|
||||
, sfSolutionF = Nothing -- TODO
|
||||
}
|
||||
((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm sheetCourseId template
|
||||
case res of
|
||||
(FormSuccess SheetForm{..}) -> do
|
||||
actTime <- liftIO getCurrentTime
|
||||
let newSheet = Sheet
|
||||
{ sheetCourseId = sheetCourseId -- Bad puns?
|
||||
, sheetName = sfName
|
||||
, sheetDescription = sfDescription
|
||||
, sheetType = sfType
|
||||
, sheetGrouping = sfGrouping
|
||||
, sheetMarkingText = sfMarkingText
|
||||
, sheetVisibleFrom = sfVisibleFrom
|
||||
, sheetActiveFrom = sfActiveFrom
|
||||
, sheetActiveTo = sfActiveTo
|
||||
, sheetHintFrom = sfHintFrom
|
||||
, sheetSolutionFrom = sfSolutionFrom
|
||||
, sheetCreated = sheetCreated -- Bad puns?
|
||||
, sheetChanged = actTime
|
||||
, sheetCreatedBy = sheetChangedBy -- Bad puns?
|
||||
, sheetChangedBy = aid
|
||||
}
|
||||
saveOkay <- runDB $ do
|
||||
addMessage "debug" "Attempting update!"
|
||||
insertOkay <- myReplaceUnique sid newSheet
|
||||
case insertOkay of
|
||||
(Just _) -> insertOkay <$ addMessageI "danger" (MsgSheetNameDup tident csh sfName)
|
||||
Nothing -> do
|
||||
-- Save Files in DB:
|
||||
whenIsJust sfSheetF $ insertSheetFile sid SheetExercise
|
||||
whenIsJust sfHintF $ insertSheetFile sid SheetHint
|
||||
whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution
|
||||
addMessageI "info" $ MsgSheetEditOk tident csh sfName
|
||||
return insertOkay
|
||||
when (isJust saveOkay) $ redirect $ SheetShowR tid csh sfName
|
||||
(FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
|
||||
_ -> return ()
|
||||
let formTitle = "Übungsblatt bearbeiten" :: Text
|
||||
let actionUrl = SheetEditR tid csh sid
|
||||
-- actionUrl <- getCurrentRoute
|
||||
defaultLayout $ do
|
||||
setTitleI $ MsgSheetTitle tident csh sheetName
|
||||
$(widgetFile "formPage")
|
||||
-}
|
||||
|
||||
getSheetNewR :: TermId -> Text -> Handler Html
|
||||
getSheetNewR tid csh = do
|
||||
let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days
|
||||
handleSheetEdit tid csh Nothing (error "No DBActione expected") -- TODO
|
||||
|
||||
getSheetEditR :: TermId -> Text -> Text -> Handler Html
|
||||
getSheetEditR tid csh shn = do
|
||||
sheetEnt <- runDB $ fetchSheet tid csh shn
|
||||
let sheet@(Sheet {..}) = entityVal sheetEnt
|
||||
let sid = entityKey sheetEnt
|
||||
let oldSheet@(Sheet {..}) = entityVal sheetEnt
|
||||
let template = Just $ SheetForm
|
||||
{ sfName = sheetName
|
||||
, sfDescription = sheetDescription
|
||||
@ -349,26 +242,18 @@ getSheetEditR tid csh shn = do
|
||||
, sfSolutionFrom = sheetSolutionFrom
|
||||
, sfSolutionF = Nothing -- TODO
|
||||
}
|
||||
handleSheetEdit tid csh Nothing (error "No DBActione expected") -- TODO
|
||||
|
||||
postSheetNewR :: TermId -> Text -> Handler Html
|
||||
postSheetNewR tid csh = do
|
||||
let action newSheet = insertUnique $ newSheet
|
||||
-- More specific error message for new sheet could go here, if insertUnique returns Nothing
|
||||
handleSheetEdit tid csh Nothing action
|
||||
|
||||
postSheetEditR :: TermId -> Text -> Text -> Handler Html
|
||||
postSheetEditR tid csh shn = do
|
||||
let action newSheet = do
|
||||
Entity { entityKey=sid, entityVal=oldSheet } <- fetchSheet tid csh shn
|
||||
replaceRes <- myReplaceUnique sid $! newSheet
|
||||
{ sheetCourseId = sheetCourseId oldSheet
|
||||
, sheetCreated = sheetCreated oldSheet
|
||||
, sheetCreatedBy = sheetChangedBy oldSheet }
|
||||
replaceRes <- myReplaceUnique sid $ newSheet
|
||||
{ sheetCourseId = sheetCourseId
|
||||
, sheetCreated = sheetCreated
|
||||
, sheetCreatedBy = sheetChangedBy }
|
||||
case replaceRes of
|
||||
Nothing -> return $ Just sid
|
||||
(Just _err) -> return $ Nothing -- More specific error message for edit old sheet could go here
|
||||
handleSheetEdit tid csh Nothing action
|
||||
handleSheetEdit tid csh template action
|
||||
|
||||
postSheetEditR :: TermId -> Text -> Text -> Handler Html
|
||||
postSheetEditR = getSheetEditR
|
||||
|
||||
handleSheetEdit :: TermId -> Text -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html
|
||||
handleSheetEdit tid csh template dbAction = do
|
||||
@ -431,9 +316,9 @@ getSheetDelR tid csh shn = do
|
||||
runDB $ do
|
||||
-- (Entity cid _course) <- getBy404 $ CourseTermShort tid csh
|
||||
cid <- getKeyBy404 $ CourseTermShort tid csh
|
||||
sid <- getKeyBy404 $ CourseSheet cid shn
|
||||
-- deleteBy $ CourseSheet cid shn
|
||||
-- TODO: deleteCascade um ggf. SheetFiles und Dateien zu löschen!
|
||||
return ()
|
||||
deleteCascade sid
|
||||
setMessageI $ MsgSheetDelOk tident csh shn
|
||||
redirect $ SheetListR tid csh
|
||||
_other -> do
|
||||
@ -463,6 +348,7 @@ insertSheetFile sid ftype finfo = do
|
||||
redirectBack :: Handler Html
|
||||
-- -- redirectBack :: HandlerT UniWorX IO Html
|
||||
redirectBack = defaultLayout $ do
|
||||
[whamlet| BACK |]
|
||||
-- -- [julius| window.history.back(); |]
|
||||
toWidget [julius| window.history.go(-2); |]
|
||||
[whamlet| BACK |] -- TODO
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user