diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index ca7a05b62..a0e2097b7 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -13,6 +13,9 @@ import Utils.Lens import Utils.Form import Handler.Utils +import Control.Monad.Writer (MonadWriter(..), execWriterT) + + data MaterialForm = MaterialForm { mfName :: MaterialName @@ -141,10 +144,18 @@ handleMaterialEdit tid ssh csh cid template dbMaterial = do insertMaterialFile' :: MaterialId -> Source Handler (Either FileId File) -> DB () insertMaterialFile' mid fs = do - oldFileIds <- E.select . E.from $ \(file `E.InnerJoin` materialFile) -> do - error "TODO" - - error "TODO" + oldFileIdVals <- E.select . E.from $ \(file `E.InnerJoin` materialFile) -> do + E.on $ materialFile E.^. MaterialFileFile E.==. file E.^. FileId + E.where_ $ materialFile E.^. MaterialFileMaterial E.==. E.val mid + 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