module Handler.Tutorial.Edit
  ( getTEditR, postTEditR
  ) where

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

import qualified Database.Esqueleto as E

import qualified Data.Map as Map
import qualified Data.Set as Set

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


getTEditR, postTEditR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
getTEditR = postTEditR
postTEditR tid ssh csh tutn = do
  (cid, tutid, template) <- runDB $ do
    (cid, Entity tutid Tutorial{..}) <- fetchCourseIdTutorial tid ssh csh tutn

    tutorIds <- fmap (map E.unValue) . E.select . E.from $ \tutor -> do
      E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
      return $ tutor E.^. TutorUser

    tutorInvites <- sourceInvitationsF @Tutor tutid

    let
      template = TutorialForm
        { tfName            = tutorialName
        , tfType            = tutorialType
        , tfCapacity        = tutorialCapacity
        , tfRoom            = tutorialRoom
        , tfRoomHidden      = tutorialRoomHidden
        , tfTime            = tutorialTime
        , tfRegGroup        = tutorialRegGroup
        , tfRegisterFrom    = tutorialRegisterFrom
        , tfRegisterTo      = tutorialRegisterTo
        , tfDeregisterUntil = tutorialDeregisterUntil
        , tfTutors          = Set.fromList (map Right tutorIds)
                           <> Set.mapMonotonic Left (Map.keysSet tutorInvites)
        , tfTutorControlled = tutorialTutorControlled
        }

    return (cid, tutid, template)

  ((newTutResult, newTutWidget), newTutEnctype) <- runFormPost . tutorialForm cid $ Just template

  formResult newTutResult $ \TutorialForm{..} -> do
    insertRes <- runDBJobs $ do
      now <- liftIO getCurrentTime
      insertRes <- myReplaceUnique tutid 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
        }
      when (is _Nothing insertRes) $ do
        audit $ TransactionTutorialEdit tutid

        let (invites, adds) = partitionEithers $ Set.toList tfTutors

        deleteWhere [ TutorTutorial ==. tutid ]
        insertMany_ $ map (Tutor tutid) adds

        deleteWhere [ InvitationFor ==. invRef @Tutor tutid, InvitationEmail /<-. invites ]
        sinkInvitationsF tutorInvitationConfig $ map (, tutid, (InvDBDataTutor, InvTokenDataTutor)) invites
      return insertRes
    case insertRes of
      Just _  -> addMessageI Error $ MsgTutorialNameTaken tfName
      Nothing -> do
        addMessageI Success $ MsgTutorialEdited tfName
        redirect $ CourseR tid ssh csh CTutorialListR

  let heading = prependCourseTitle tid ssh csh . MsgTutorialEditHeading $ tfName template

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