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

saving probably complete

Browse Source
This commit is contained in:
Steffen Jost 2019-04-30 19:19:09 +02:00
parent c4f47c4856
commit 3e00f4255a
1 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Handler/Material.hs
View File

@ -13,6 +13,9 @@ import Utils.Lens
import Utils.Form import Utils.Form
import Handler.Utils import Handler.Utils
import Control.Monad.Writer (MonadWriter(..), execWriterT)
data MaterialForm = MaterialForm data MaterialForm = MaterialForm
{ mfName :: MaterialName { mfName :: MaterialName
@ -141,10 +144,18 @@ handleMaterialEdit tid ssh csh cid template dbMaterial = do
insertMaterialFile' :: MaterialId -> Source Handler (Either FileId File) -> DB () insertMaterialFile' :: MaterialId -> Source Handler (Either FileId File) -> DB ()
insertMaterialFile' mid fs = do insertMaterialFile' mid fs = do
oldFileIds <- E.select . E.from $ \(file `E.InnerJoin` materialFile) -> do oldFileIdVals <- E.select . E.from $ \(file `E.InnerJoin` materialFile) -> do
error "TODO" E.on $ materialFile E.^. MaterialFileFile E.==. file E.^. FileId
E.where_ $ materialFile E.^. MaterialFileMaterial E.==. E.val mid
error "TODO" return $ file E.^. FileId
let oldFileIds = setFromList $ map E.unValue oldFileIdVals
keep <- execWriterT . runConduit $ transPipe (lift . lift) fs =$= C.mapM_ finsert
mapM_ deleteCascade $ (oldFileIds \\ keep :: Set FileId)
where
finsert (Left fileId) = tell $ singleton fileId
finsert (Right file) = lift $ do
fid <- insert file
void . insert $ MaterialFile mid fid -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step
getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html