module Handler.Tutorial.New
  ( getCTutorialNewR, postCTutorialNewR
  ) where

import Import
import Handler.Utils
import Handler.Utils.Invitations
import Jobs.Queue

import qualified Data.Set as Set

import Handler.Tutorial.Form
import Handler.Tutorial.TutorInvite


getCTutorialNewR, postCTutorialNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCTutorialNewR = postCTutorialNewR
postCTutorialNewR tid ssh csh = do
  cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh

  ((newTutResult, newTutWidget), newTutEnctype) <- runFormPost $ tutorialForm cid Nothing

  formResult newTutResult $ \TutorialForm{..} -> do
    insertRes <- runDBJobs $ do
      now <- liftIO getCurrentTime
      insertRes <- insertUnique Tutorial
        { tutorialName            = tfName
        , tutorialCourse          = cid
        , tutorialType            = tfType
        , tutorialCapacity        = tfCapacity
        , tutorialRoom            = tfRoom
        , tutorialRoomHidden      = tfRoomHidden
        , tutorialTime            = tfTime
        , tutorialRegGroup        = tfRegGroup
        , tutorialRegisterFrom    = tfRegisterFrom
        , tutorialRegisterTo      = tfRegisterTo
        , tutorialDeregisterUntil = tfDeregisterUntil
        , tutorialLastChanged     = now
        , tutorialTutorControlled = tfTutorControlled
        }
      whenIsJust insertRes $ \tutid -> do
        audit $ TransactionTutorialEdit tutid

        let (invites, adds) = partitionEithers $ Set.toList tfTutors
        insertMany_ $ map (Tutor tutid) adds
        memcachedByInvalidate AuthCacheTutorList $ Proxy @(Set UserId)
        sinkInvitationsF tutorInvitationConfig $ map (, tutid, (InvDBDataTutor, InvTokenDataTutor)) invites
      return insertRes
    case insertRes of
      Nothing -> addMessageI Error $ MsgTutorialNameTaken tfName
      Just _  -> do
        addMessageI Success $ MsgTutorialCreated tfName
        redirect $ CourseR tid ssh csh CTutorialListR

  let heading = prependCourseTitle tid ssh csh MsgTutorialNew

  siteLayoutMsg heading $ do
    setTitleI heading
    let
      newTutForm = wrapForm newTutWidget def
        { formMethod = POST
        , formAction = Just . SomeRoute $ CourseR tid ssh csh CTutorialNewR
        , formEncoding = newTutEnctype
        }
    $(widgetFile "tutorial-new")