module Handler.Tutorial.Users
  ( getTUsersR, postTUsersR
  ) where

import Import

import Utils.Form
-- import Utils.DB
import Handler.Utils
import Handler.Utils.Tutorial
import Database.Persist.Sql (deleteWhereCount)

import qualified Data.CaseInsensitive as CI
import Data.Function ((&))

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

import qualified Database.Esqueleto as E

import Handler.Course.Users


data TutorialUserAction = TutorialUserSendMail | TutorialUserDeregister
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)

instance Universe TutorialUserAction
instance Finite TutorialUserAction
nullaryPathPiece ''TutorialUserAction $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''TutorialUserAction id


getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
getTUsersR = postTUsersR
postTUsersR tid ssh csh tutn = do
  (Entity tutid Tutorial{..}, (participantRes, participantTable)) <- runDB $ do
    tut@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
    let colChoices  = mconcat
          [ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
          , colUserName
          , colUserEmail
          , colUserMatriclenr
          , colUserDegreeShort
          , colUserField
          , colUserSemester
          ]
        psValidator = def
          & defaultSortingByName
          & restrictSorting (\name _ -> none (== name) ["note"]) -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
        isInTut q = E.exists . E.from $ \tutorialParticipant ->
          E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. queryUser q E.^. UserId
               E.&&. tutorialParticipant E.^. TutorialParticipantTutorial E.==. E.val tutid

    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
    table <- makeCourseUserTable cid (Map.fromList $ map (id &&& pure) universeF) isInTut colChoices psValidator
    return (tut, table)

  formResult participantRes $ \case
    (TutorialUserSendMail, selectedUsers) -> do
        cids <- traverse encrypt $ Set.toList selectedUsers :: Handler [CryptoUUIDUser]
        redirect (CTutorialR tid ssh csh tutn TCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cids])
    (TutorialUserDeregister,selectedUsers) -> do
        nrDel <- runDB $ deleteWhereCount
          [ TutorialParticipantTutorial ==. tutid
          , TutorialParticipantUser <-. Set.toList selectedUsers
          ]
        addMessageI Success $ MsgTutorialUsersDeregistered nrDel
        redirect $ CTutorialR tid ssh csh tutn TUsersR

  let heading = prependCourseTitle tid ssh csh $ CI.original tutorialName
  siteLayoutMsg heading $ do
    setTitleI heading
    $(widgetFile "tutorial-participants")