module Handler.ExternalExam.Form
  ( ExternalExamForm(..)
  , externalExamForm
  ) where

import Import
import Handler.Utils

import Handler.ExternalExam.StaffInvite ()

import qualified Data.Set as Set
import Data.Map ((!))

import qualified Control.Monad.State.Class as State


data ExternalExamForm = ExternalExamForm
  { eefTerm :: TermId
  , eefSchool :: SchoolId
  , eefCourseName :: CI Text
  , eefExamName :: CI Text
  , eefDefaultTime :: Maybe UTCTime
  , eefGradingMode :: ExamGradingMode
  , eefOfficeSchools :: Set SchoolId
  , eefStaff :: Set (Either UserEmail UserId)
  }

makeLenses_ ''ExternalExamForm

externalExamForm :: Maybe ExternalExamForm -> Form ExternalExamForm
externalExamForm template = validateForm validateExternalExam $ \html -> do
  uid <- requireAuthId
  cRoute <- fromMaybe (error "tutorialForm called from 404-Handler") <$> getCurrentRoute
  MsgRenderer mr <- getMsgRenderer

  let termsField = case template of
        Just template' -> termsSetField [eefTerm template']
        _other         -> termsAllowedField

  (lecturerSchools, adminSchools, oldSchool) <- liftHandler . runDB $ do
      lecturerSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolLecturer]] []
      protoAdminSchools  <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin]] []
      adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools
      let oldSchool = eefSchool <$> template
      return (lecturerSchools, adminSchools, oldSchool)
  let userSchools = nub . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools

  flip (renderAForm FormStandard) html $ ExternalExamForm
    <$> areq termsField (fslI MsgExternalExamSemester) (eefTerm <$> template)
    <*> areq (schoolFieldFor userSchools) (fslI MsgExternalExamSchool) (eefSchool <$> template)
    <*> areq (textField & cfStrip & cfCI) (fslI MsgExternalExamCourseName & setTooltip MsgExternalExamCourseNameTip & addPlaceholder (mr MsgExternalExamCourseNamePlaceholder)) (eefCourseName <$> template)
    <*> areq (textField & cfStrip & cfCI) (fslI MsgExternalExamExamName & setTooltip MsgExternalExamExamNameTip & addPlaceholder (mr MsgExternalExamExamNamePlaceholder)) (eefExamName <$> template)
    <*> aopt utcTimeField (fslI MsgExternalExamDefaultTime & setTooltip MsgExternalExamDefaultTimeTip & addPlaceholder (mr MsgExternalExamDefaultTimePlaceholder)) (eefDefaultTime <$> template)
    <*> apopt (selectField optionsFinite) (fslI MsgExamGradingMode & setTooltip MsgExamGradingModeTip) (eefGradingMode <$> template <|> Just ExamGradingMixed)
    <*> (Set.fromList <$> officeSchoolForm cRoute (Set.toList . eefOfficeSchools <$> template))
    <*> (Set.fromList <$> staffForm cRoute ((Set.toList . eefStaff <$> template) <|> pure (pure $ Right uid)))
  where
    officeSchoolForm cRoute = massInputAccumA miAdd miCell miButtonAction miLayout miIdent fSettings fRequired
      where
        miAdd mkUnique submitView csrf = do
          (schoolRes, addView) <- mpopt schoolField ("" & addName (mkUnique "school")) Nothing
          let schoolRes' = schoolRes <&> \newDat oldDat -> FormSuccess (guardOn (newDat `notElem` oldDat) newDat)
          return (schoolRes', $(widgetFile "external-exam/schoolMassInput/add"))
        miCell ssh = do
          School{..} <- liftHandler . runDB $ getJust ssh
          $(widgetFile "external-exam/schoolMassInput/cell")
        miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
        miButtonAction = Just . SomeRoute . (cRoute :#:)
        miLayout :: MassInputLayout ListLength SchoolId ()
        miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "external-exam/schoolMassInput/layout")
        miIdent :: Text
        miIdent = "external-exams-school"
        fSettings = fslI MsgExternalExamExamOfficeSchools & setTooltip MsgExternalExamExamOfficeSchoolsTip
        fRequired = False
    staffForm :: Route UniWorX -> Maybe [Either UserEmail UserId] -> AForm Handler [Either UserEmail UserId]
    staffForm cRoute = massInputAccumA miAdd miCell miButtonAction miLayout miIdent fSettings fRequired
      where
        miAdd mkUnique submitView csrf = do
          MsgRenderer mr <- getMsgRenderer
          (usersRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) (fslI MsgExternalExamStaffEmail & addName (mkUnique "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
          let
            usersRes' = usersRes <&> \newDat oldDat -> if
              | existing <- newDat `Set.intersection` Set.fromList oldDat
              , not $ Set.null existing
                -> FormFailure [mr MsgExternalExamStaffAlreadyAdded]
              | otherwise
                -> FormSuccess $ Set.toList newDat
          return (usersRes', $(widgetFile "external-exam/staffMassInput/add"))
        miCell (Left email) = do
          invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
          $(widgetFile "external-exam/staffMassInput/cellInvitation")
        miCell (Right userId) = do
          User{..} <- liftHandler . runDB $ getJust userId
          $(widgetFile "external-exam/staffMassInput/cellKnown")
        miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
        miButtonAction = Just . SomeRoute . (cRoute :#:)
        miLayout :: MassInputLayout ListLength (Either UserEmail UserId) ()
        miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "external-exam/staffMassInput/layout")
        miIdent :: Text
        miIdent = "external-exams-staff"
        fSettings = fslI MsgExternalExamStaff & setTooltip MsgExternalExamStaffTip
        fRequired = True

validateExternalExam :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => FormValidator ExternalExamForm m ()
validateExternalExam = do
  State.modify $ \eeForm -> eeForm & over _eefOfficeSchools (Set.delete $ eeForm ^. _eefSchool)

  ExternalExamForm{..} <- State.get

  isAdmin <- hasWriteAccessTo $ SchoolR eefSchool SchoolEditR
  unless isAdmin $ do
    uid <- requireAuthId
    guardValidation MsgExternalExamUserMustBeStaff $ Right uid `Set.member` eefStaff

  courseExists <- liftHandler . runDB . existsBy $ TermSchoolCourseName eefTerm eefSchool eefCourseName
  guardValidation MsgExternalExamCourseExists $ not courseExists