From 09d8c0bb07e05edcf44ed309d3a9b5ddc8bf01aa Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Tue, 30 Apr 2019 22:20:21 +0200
Subject: [PATCH] Deletion stub

---
 messages/uniworx/de.msg |  2 ++
 src/Handler/Material.hs | 40 +++++++++++++++++++++++++++++++---------
 2 files changed, 33 insertions(+), 9 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 1f391452a..746d60dce 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -224,6 +224,8 @@ MaterialEditHeading materialName@MaterialName: Material "#{materialName}" editie
 MaterialEditTitle materialName@MaterialName: Material "#{materialName}" editieren
 MaterialSaveOk  tid@TermId ssh@SchoolId csh@CourseShorthand materialName@MaterialName: Material "#{materialName}" erfolgreich gespeichert in Kurs #{display tid}-#{display ssh}-#{csh}
 MaterialNameDup tid@TermId ssh@SchoolId csh@CourseShorthand materialName@MaterialName: Es gibt bereits Material mit Namen "#{materialName}" in diesem Kurs #{display tid}-#{display ssh}-#{csh}
+MaterialDeleteQuestion: Wollen Sie das unten aufgeführte Material wirklich löschen?
+MaterialDeleted materialName@MaterialName: Material "#{materialName}" gelöscht
 
 
 Unauthorized: Sie haben hierfür keine explizite Berechtigung.
diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs
index a0e2097b7..b989e45e0 100644
--- a/src/Handler/Material.hs
+++ b/src/Handler/Material.hs
@@ -12,6 +12,7 @@ import qualified Database.Esqueleto as E
 import Utils.Lens
 import Utils.Form
 import Handler.Utils
+import Handler.Utils.Delete
 
 import Control.Monad.Writer (MonadWriter(..), execWriterT)
 
@@ -58,6 +59,19 @@ makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
       <*> aopt (multiFileField oldFileIds)
                               (fslI MsgMaterialFiles)        (mfFiles <$> template)
 
+fetchMaterial :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> DB (CourseId, Entity Material)
+fetchMaterial tid ssh csh mnm = do
+  [(E.Value cid, matEnt)] <- E.select . E.from  $ -- uniqueness guaranteed by DB constraints
+    \(course `E.InnerJoin` material) -> do
+      E.on     $ course   E.^. CourseId   E.==.   material E.^. MaterialCourse
+      E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
+          E.&&.  course   E.^. CourseSchool    E.==. E.val ssh
+          E.&&.  course   E.^. CourseShorthand E.==. E.val csh
+          E.&&.  material E.^. MaterialName    E.==. E.val mnm
+      return (course E.^. CourseId, material)
+  return (cid, matEnt)
+
+
 getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getMaterialListR = error "unimplemented" -- TODO
 
@@ -69,14 +83,7 @@ getMEditR, postMEditR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -
 getMEditR = postMEditR
 postMEditR tid ssh csh mnm = do
   (cid, Entity mid Material{..}, files) <- runDB $ do
-    [(E.Value cid, matEnt)] <- E.select . E.from  $ -- uniqueness guaranteed
-      \(course `E.InnerJoin` material) -> do
-        E.on     $ course   E.^. CourseId   E.==.   material E.^. MaterialCourse
-        E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
-            E.&&.  course   E.^. CourseSchool    E.==. E.val ssh
-            E.&&.  course   E.^. CourseShorthand E.==. E.val csh
-            E.&&.  material E.^. MaterialName    E.==. E.val mnm
-        return (course E.^. CourseId, material)
+    (cid, matEnt) <- fetchMaterial tid ssh csh mnm
     fileIds <- E.select . E.from $ \(matFile `E.InnerJoin` file) -> do
       E.on     $ matFile  E.^. MaterialFileFile     E.==. file E.^. FileId
       E.where_ $ matFile  E.^. MaterialFileMaterial E.==. E.val (entityKey matEnt)
@@ -160,4 +167,19 @@ handleMaterialEdit tid ssh csh cid template dbMaterial = do
 
 getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand ->  MaterialName -> Handler Html
 getMDelR = postMDelR
-postMDelR = error "unimplemented" -- TODO
\ No newline at end of file
+postMDelR tid ssh csh mnm = do
+  (_cid, _matEnt) <- runDB $ fetchMaterial tid ssh csh mnm
+  error "todo"
+  {-
+  deleteR DeleteRoute
+    { drRecords = Set.singleton $ entityKey matEnt
+    , drGetInfo = error "todo"
+    , drUnjoin  = error "todo"
+    , drRenderRecord = error "todo"
+    , drRecordConfirmString = error "todo"
+    , drCaption        = SomeMessage   MsgMaterialDeleteQuestion
+    , drSuccessMessage = SomeMessage $ MsgMaterialDeleted mnm
+    , drSuccess = SomeRoute $ CourseR tid ssh csh   MaterialListR
+    , drAbort   = SomeRoute $ CourseR tid ssh csh $ MaterialR mnm MShowR
+    }
+  -}
\ No newline at end of file