module Handler.Sheet.Form
  ( SheetForm(..), SheetPersonalisedFilesForm(..), Loads
  , makeSheetForm
  , getFtIdMap
  ) where

import Import

import Handler.Utils
import Handler.Utils.Invitations

import qualified Database.Esqueleto.Legacy as E

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

import Data.Map ((!))

import qualified Control.Monad.State.Class as State


import Handler.Sheet.CorrectorInvite


type Loads = Map (Either UserEmail UserId) (InvitationData SheetCorrector)

data SheetForm = SheetForm
      { sfName         :: SheetName
      , sfDescription  :: Maybe StoredMarkup
      , sfRequireExamRegistration :: Maybe ExamId
      , sfSheetF, sfHintF, sfSolutionF, sfMarkingF :: Maybe FileUploads
      , sfPersonalF :: Maybe SheetPersonalisedFilesForm
      , sfVisibleFrom  :: Maybe UTCTime
      , sfActiveFrom   :: Maybe UTCTime
      , sfActiveTo     :: Maybe UTCTime
      , sfHintFrom     :: Maybe UTCTime
      , sfSolutionFrom :: Maybe UTCTime
      , sfSubmissionMode :: SubmissionMode
      , sfGrouping     :: SheetGroup
      , sfType         :: SheetType ExamPartId
      , sfAutoDistribute :: Bool
      , sfMarkingText  :: Maybe StoredMarkup
      , sfAnonymousCorrection :: Bool
      , sfCorrectors   :: Loads
      , sfAuthorshipStatement :: Maybe StoredMarkup
      }

data SheetPersonalisedFilesForm = SheetPersonalisedFilesForm
  { spffFiles :: Maybe FileUploads
  , spffFilesKeepExisting :: Bool
  , spffAllowNonPersonalisedSubmission :: Bool
  }

  
getFtIdMap :: Key Sheet -> DB (SheetFileType -> Set FileReference)
getFtIdMap sId = do
  allSheetFiles <- E.select . E.from $ \sheetFile -> do
      E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sId
      return sheetFile
  return $ partitionFileType [ (sheetFileType, sf ^. _FileReference . _1) | Entity _ sf@SheetFile{..} <- allSheetFiles ]

makeSheetForm :: CourseId -> Maybe SheetId -> Maybe SheetForm -> Form SheetForm
makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateSheet $ \html -> do
    oldFileIds <- (return.) <$> case msId of
      Nothing    -> return $ partitionFileType mempty
      (Just sId) -> liftHandler $ runDB $ getFtIdMap sId
    MsgRenderer mr <- getMsgRenderer
    ctime <- ceilingQuarterHour <$> liftIO getCurrentTime
    mSchoolAuthorshipStatement <- liftHandler . runDB . runMaybeT $ do
      Entity _ Course{courseSchool} <- MaybeT . getEntity $ cId
      Entity _ School{..} <- MaybeT . getEntity $ courseSchool
      statementId <- MaybeT . return $ bool Nothing schoolSheetAuthorshipStatementDefinition (schoolSheetAuthorshipStatementMode /= SchoolAuthorshipStatementModeNone)
      MaybeT . getEntity $ statementId
      -- TODO: compare versions: school > msId if school statement is newer than msId statement, msId > school otherwise (TODO: add lastEdited to model)
    sheetPersonalisedFilesForm <- makeSheetPersonalisedFilesForm $ template >>= sfPersonalF
    flip (renderAForm FormStandard) html $ SheetForm
      <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName)         (sfName        <$> template)
      <*> aopt htmlField      (fslI MsgSheetDescription) (sfDescription <$> template)
      <*> optionalActionA (apreq (examField Nothing cId) (fslI MsgSheetRequiredExam) (sfRequireExamRegistration =<< template)) (fslI MsgSheetRequireExam & setTooltip MsgSheetRequireExamTip) (is _Just . sfRequireExamRegistration <$> template)
      <* aformSection MsgSheetFormFiles
      <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
      <*> aopt (multiFileField $ oldFileIds SheetHint)     (fslI MsgSheetHint)      (sfHintF <$> template)
      <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
      <*> aopt (multiFileField $ oldFileIds SheetMarking)  (fslI MsgSheetMarkingFiles
            & setTooltip MsgSheetMarkingTip)                  (sfMarkingF <$> template)
      <*> optionalActionA sheetPersonalisedFilesForm (fslI MsgSheetPersonalisedFiles & setTooltip MsgSheetPersonalisedFilesTip) (is _Just . sfPersonalF <$> template)
      <* aformSection MsgSheetFormTimes
      <*> aopt utcTimeField   (fslI MsgSheetVisibleFrom
            & setTooltip MsgSheetVisibleFromTip)
                                                              ((sfVisibleFrom  <$> template) <|> pure (Just ctime))
      <*> aopt utcTimeField   (fslI MsgSheetActiveFrom
            & setTooltip MsgSheetActiveFromTip)
                                                              (sfActiveFrom   <$> template)
      <*> aopt utcTimeField   (fslI MsgSheetActiveTo & setTooltip MsgSheetActiveToTip) (sfActiveTo <$> template)
      <*> aopt utcTimeField   (fslpI MsgSheetHintFrom (mr MsgSheetHintFromPlaceholder)
            & setTooltip MsgSheetHintFromTip)                 (sfHintFrom     <$> template)
      <*> aopt utcTimeField   (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder)
            & setTooltip MsgSheetSolutionFromTip)             (sfSolutionFrom <$> template)
      <* aformSection MsgSheetFormType
      <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction False))
      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        ((sfGrouping <$> template) <|> pure NoGroups)
      <*> sheetTypeAFormReq cId (fslI MsgSheetSheetType) (sfType <$> template)
      <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
      <*> aopt htmlField    (fslI MsgSheetMarking) (sfMarkingText <$> template)
      <*> apopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template)
      <*> correctorForm (maybe mempty sfCorrectors template)
      <*  aformSection MsgSheetAuthorshipStatement
      <*> optionalActionA (apreq htmlField (fslI MsgSheetAuthorshipStatement) (join (sfAuthorshipStatement <$> template) <|> authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)) (fslI MsgSheetAuthorshipStatementRequired & setTooltip MsgSheetAuthorshipStatementRequiredTip) ((is _Just . sfAuthorshipStatement <$> template) <|> (pure $ is _Just mSchoolAuthorshipStatement))  -- TODO: disable option and set accordingly if school mode prevents edits
  where
    makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm)
    makeSheetPersonalisedFilesForm template' = do
      templateDownloadMessage <- runMaybeT . hoist (liftHandler . runDB) $ do
        mbSheet <- maybe (return Nothing) (fmap Just . hoistMaybe) =<< traverse (lift . get) msId
        Course{..} <- MaybeT $ get cId
        let downloadRoute = case mbSheet of
              Just Sheet{..} -> CSheetR courseTerm courseSchool courseShorthand sheetName SPersonalFilesR
              Nothing -> CourseR courseTerm courseSchool courseShorthand CPersonalFilesR
            downloadTrigger
              = [whamlet|
                  $newline never
                  #{iconFileZip}
                  \ _{MsgSheetPersonalisedFilesDownload}
                |]
        listRoute <- for mbSheet $ \(sheetName -> shn) -> toTextUrl 
          ( CourseR courseTerm courseSchool courseShorthand CUsersR
          , [ ("courseUsers-has-personalised-sheet-files"
              , toPathPiece shn
              )
            ]
          )
        guardM . lift $ hasReadAccessTo downloadRoute
        messageIconWidget Info IconFileUser
          [whamlet|
            $newline never
            <div>
              _{MsgSheetPersonalisedFilesDownloadTemplateHere}
              <br />
              ^{modal downloadTrigger (Left (SomeRoute downloadRoute))}
            $maybe lRoute <- listRoute
              <p .explanation>
                <a href=#{lRoute} target="_blank">
                  _{MsgSheetPersonalisedFilesUsersList}
          |]
      return $ SheetPersonalisedFilesForm
        <$  maybe (pure ()) aformMessage templateDownloadMessage
        <*> aopt (zipFileField True Nothing True) (fslI MsgSheetPersonalisedFilesUpload & setTooltip MsgSheetPersonalisedFilesUploadTip) Nothing
        <*> apopt checkBoxField (fslI MsgSheetPersonalisedFilesKeepExisting & setTooltip MsgSheetPersonalisedFilesKeepExistingTip) (fmap spffFilesKeepExisting template' <|> Just True)
        <*> apopt checkBoxField (fslI MsgSheetPersonalisedFilesAllowNonPersonalisedSubmission & setTooltip MsgSheetPersonalisedFilesAllowNonPersonalisedSubmissionTip) (fmap spffAllowNonPersonalisedSubmission template' <|> Just True)

    validateSheet :: FormValidator SheetForm Handler ()
    validateSheet = do
      SheetForm{..} <- State.get

      guardValidation MsgSheetErrVisibility    $ NTop sfVisibleFrom  <= NTop sfActiveFrom
      guardValidation MsgSheetErrDeadlineEarly $ NTop sfActiveFrom   <= NTop sfActiveTo
      guardValidation MsgSheetErrHintEarly     $ NTop sfHintFrom     >= NTop sfActiveFrom
      guardValidation MsgSheetErrSolutionEarly $ NTop sfSolutionFrom >= NTop sfActiveTo

      guardValidation MsgSheetErrVisibleWithoutActive $ is _Just sfActiveFrom || is _Nothing sfVisibleFrom

      warnValidation MsgSheetWarnNoActiveTo $ is _Just sfActiveTo || is _Nothing sfActiveFrom

      warnValidation MsgSheetSubmissionModeNoneWithoutNotGraded
        $ classifySubmissionMode sfSubmissionMode /= SubmissionModeNone
       || sfType == NotGraded

      -- TODO: do authorship statement validation
      -- TODO: if school mode is none or required for this sheet (exam-related/exam-umrelated?), statementRequired must be set accordingly
      -- TODO: authorship statement definition must not be empty when statement is required

correctorForm :: Loads -> AForm Handler Loads
correctorForm loads' = wFormToAForm $ do
  currentRoute <- fromMaybe (error "correctorForm called from 404-handler") <$> liftHandler getCurrentRoute
  userId <- liftHandler requireAuthId
  MsgRenderer mr <- getMsgRenderer

  let
    loads :: Map (Either UserEmail UserId) (CorrectorState, Load)
    loads = loads' <&> \(InvDBDataSheetCorrector load cState, InvTokenDataSheetCorrector) -> (cState, load)

  countTutRes <- wpopt checkBoxField (fslI MsgCountTutProp & setTooltip MsgCountTutPropTip) . Just . any (\(_, Load{..}) -> fromMaybe False byTutorial) $ Map.elems loads

  let
    previousCorrectors :: E.SqlQuery (E.SqlExpr (Entity User))
    previousCorrectors = E.from $ \(user `E.InnerJoin` sheetCorrector `E.InnerJoin` sheet `E.InnerJoin` course `E.InnerJoin` lecturer) -> do
      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
      E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
      E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
      E.on $ sheetCorrector E.^. SheetCorrectorUser E.==. user E.^. UserId
      E.where_ $ lecturer E.^. LecturerUser E.==. E.val userId
      E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
      return user

    miAdd :: ListPosition
          -> Natural
          -> (Text -> Text)
          -> FieldView UniWorX
          -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
    miAdd _ _ nudge submitView = Just $ \csrf -> do
      (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser $ Just previousCorrectors) (fslpI MsgSheetCorrector (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "corrector")) Nothing
      let addRes' = addRes <&> \nCorrs oldData@(maybe 0 (succ . fst) . Map.lookupMax -> kStart) -> if
            | existing <- Set.intersection nCorrs . Set.fromList $ Map.elems oldData
            , not $ null existing
              -> FormFailure [mr MsgCorrectorExists]
            | otherwise
              -> FormSuccess . Map.fromList . zip [kStart..] $ Set.toList nCorrs
      return (addRes', $(widgetFile "sheetCorrectors/add"))

    miCell :: ListPosition
           -> Either UserEmail UserId
           -> Maybe (CorrectorState, Load)
           -> (Text -> Text)
           -> Form (CorrectorState, Load)
    miCell _ userIdent initRes nudge csrf = do
      (stateRes, stateView) <- mreq (selectField optionsFinite) (fslI MsgSheetCorrectorState & addName (nudge "state")) $ (fst <$> initRes) <|> Just CorrectorNormal
      (byTutRes, byTutView) <- mreq checkBoxField ("" & addName (nudge "bytut")) $ (isJust . byTutorial . snd <$> initRes) <|> Just False
      (deficitRes, deficitView) <- mreq checkBoxField ("" & addName (nudge "deficit")) $ ((/= 0) . byDeficit . snd <$> initRes) <|> Just True
      (propRes, propView) <- mreq (checkBool (>= 0) MsgProportionNegative rationalField) (fslI MsgSheetCorrectorProportion & addName (nudge "prop")) $ (byProportion . snd <$> initRes) <|> Just 0
      let
        res :: FormResult (CorrectorState, Load)
        res = (,) <$> stateRes <*> (Load <$> tutRes' <*> propRes <*> deficitRes')
        tutRes'
          | FormSuccess True <- byTutRes  = Just <$> countTutRes
          | otherwise                     = Nothing <$ byTutRes
        deficitRes' = bool 0 1 <$> deficitRes
      identWidget <- case userIdent of
        Left email -> return . toWidget $ mailtoHtml email
        Right uid -> do
          User{userEmail, userDisplayName, userSurname} <- liftHandler . runDB $ getJust uid
          return $ nameEmailWidget userEmail userDisplayName userSurname
      invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
      return (res, $(widgetFile "sheetCorrectors/cell"))


    miDelete :: Map ListPosition (Either UserEmail UserId)
             -> ListPosition
             -> MaybeT (MForm Handler) (Map ListPosition ListPosition)
    miDelete = miDeleteList

    miAllowAdd :: ListPosition
               -> Natural
               -> ListLength
               -> Bool
    miAllowAdd _ _ _ = True

    miAddEmpty :: ListPosition
               -> Natural
               -> ListLength
               -> Set ListPosition
    miAddEmpty _ _ _ = Set.empty

    miButtonAction :: forall p.
                      PathPiece p
                   => p
                   -> Maybe (SomeRoute UniWorX)
    miButtonAction frag = Just . SomeRoute $ currentRoute :#: frag

    miLayout :: ListLength
             -> Map ListPosition (Either UserEmail UserId, FormResult (CorrectorState, Load))
             -> Map ListPosition Widget
             -> Map ListPosition (FieldView UniWorX)
             -> Map (Natural, ListPosition) Widget
             -> Widget
    miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "sheetCorrectors/layout")

    miIdent :: Text
    miIdent = "correctors"

    postProcess :: Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)) -> Loads
    postProcess = Map.fromList . map postProcess' . Map.elems
      where
        postProcess' :: (Either UserEmail UserId, (CorrectorState, Load)) -> (Either UserEmail UserId, (InvitationDBData SheetCorrector, InvitationTokenData SheetCorrector))
        postProcess' = over _2 $ \(cState, load) -> (InvDBDataSheetCorrector load cState, InvTokenDataSheetCorrector)

    filledData :: Maybe (Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)))
    filledData = Just . Map.fromList . zip [0..] $ Map.toList loads -- TODO orderBy Name?!

  fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors) False filledData