Sheet Editing/Delete working now

FragenSJ.txt

@@ -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

messages/de.msg

@@ -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.

src/Foundation.hs

@@ -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 (SheetListR tid csh)      = return ("Übungen",Just $ CourseShowR tid csh)
-  breadcrumb (SheetShowR tid csh _shn) = return ("Übungen", Just $ SheetListR 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)

src/Handler/Sheet.hs

@@ -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
+  let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
-  case res of
+        insertUnique $ newSheet
-    (FormSuccess SheetForm{..}) -> do
+  handleSheetEdit tid csh template action
-      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")
 
 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
-        replaceRes <- myReplaceUnique sid $! newSheet
+                        { sheetCourseId  = sheetCourseId
-                      { sheetCourseId  = sheetCourseId  oldSheet
+                        , sheetCreated   = sheetCreated
-                      , sheetCreated   = sheetCreated   oldSheet
+                        , sheetCreatedBy = sheetChangedBy }
-                      , sheetCreatedBy = sheetChangedBy oldSheet }
         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!
+        deleteCascade sid
-        return ()
       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 |]
+   toWidget [julius| window.history.go(-2); |]
---   -- [julius| window.history.back(); |]
+   [whamlet| BACK |] -- TODO
+