fradrive/src/Handler/Tutorial/Delete.hs
2019-09-30 16:57:06 +02:00

40 lines
1.7 KiB
Haskell

module Handler.Tutorial.Delete
( getTDeleteR, postTDeleteR
) where
import Import
import Handler.Utils
import Handler.Utils.Tutorial
import Handler.Utils.Delete
import qualified Database.Esqueleto as E
import qualified Data.Set as Set
import qualified Data.CaseInsensitive as CI
getTDeleteR, postTDeleteR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
getTDeleteR = postTDeleteR
postTDeleteR tid ssh csh tutn = do
tutid <- runDB $ fetchTutorialId tid ssh csh tutn
deleteR DeleteRoute
{ drRecords = Set.singleton tutid
, drUnjoin = \(_ `E.InnerJoin` tutorial) -> tutorial
, drGetInfo = \(course `E.InnerJoin` tutorial) -> do
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
let participants = E.sub_select . E.from $ \participant -> do
E.where_ $ participant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
return E.countRows
return (course, tutorial, participants :: E.SqlExpr (E.Value Int))
, drRenderRecord = \(Entity _ Course{..}, Entity _ Tutorial{..}, E.Value ps) ->
return [whamlet|_{prependCourseTitle courseTerm courseSchool courseShorthand (CI.original tutorialName)} (_{MsgParticipantsN ps})|]
, drRecordConfirmString = \(Entity _ Course{..}, Entity _ Tutorial{..}, E.Value ps) ->
return [st|#{termToText (unTermKey courseTerm)}/#{unSchoolKey courseSchool}/#{courseShorthand}/#{tutorialName}+#{tshow ps}|]
, drCaption = SomeMessage MsgTutorialDeleteQuestion
, drSuccessMessage = SomeMessage MsgTutorialDeleted
, drAbort = SomeRoute $ CTutorialR tid ssh csh tutn TUsersR
, drSuccess = SomeRoute $ CourseR tid ssh csh CTutorialListR
, drDelete = const id -- TODO: audit
}