40 lines
1.8 KiB
Haskell
40 lines
1.8 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.Legacy 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.subSelectCount . E.from $ \participant ->
|
|
E.where_ $ participant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
|
|
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
|
|
, drFormMessage = const $ return Nothing
|
|
, drAbort = SomeRoute $ CTutorialR tid ssh csh tutn TUsersR
|
|
, drSuccess = SomeRoute $ CourseR tid ssh csh CTutorialListR
|
|
, drDelete = \tutid' act -> act <* audit (TransactionTutorialDelete tutid')
|
|
}
|