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

Deletion stub

Browse Source
This commit is contained in:
Steffen Jost 2019-04-30 22:20:21 +02:00
parent 3e00f4255a
commit 09d8c0bb07
2 changed files with 33 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/de.msg
View File

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

40
src/Handler/Material.hs
View File

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