module Handler.Sheet.New
  ( getSheetNewR, postSheetNewR
  ) where

import Import

import Handler.Utils

import qualified Database.Esqueleto.Legacy as E

import qualified Data.Map as Map

import Data.Time.Clock.System (systemEpochDay)


import Handler.Sheet.CorrectorInvite
import Handler.Sheet.Form
import Handler.Sheet.Edit


getSheetNewR, postSheetNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getSheetNewR = postSheetNewR
postSheetNewR tid ssh csh = do
  parShn <- runInputGetResult $ iopt ciField "shn"
  let searchShn sheet = case parShn of
        (FormSuccess (Just shn)) -> E.where_ $ sheet E.^. SheetName E.==. E.val shn
        _other -> return ()
  now <- liftIO getCurrentTime
  template <- runDB $ do
    lastSheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
      E.on     $ course E.^. CourseId E.==. sheet E.^. SheetCourse
      E.where_ $ course E.^. CourseTerm      E.==. E.val tid
          E.&&.  course E.^. CourseSchool    E.==. E.val ssh
          E.&&.  course E.^. CourseShorthand E.==. E.val csh
      searchShn sheet
      E.orderBy [E.desc (sheet E.^. SheetActiveFrom)]
      E.limit 1
      let
        firstEdit = E.subSelectMaybe . E.from $ \sheetEdit -> do
          E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
          return . E.min_ $ sheetEdit E.^. SheetEditTime
      return (sheet, firstEdit)
    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
    loads <- defaultLoads cid
    for (lastSheets ^? _head) $ \(Entity _ Sheet{..}, E.Value fEdit) -> do
      let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now
      mStmt <- traverse getJust sheetAuthorshipStatement
      return SheetForm
        { sfName           = stepTextCounterCI sheetName
        , sfDescription    = sheetDescription
        , sfType           = review _SqlKey <$> sheetType
        , sfGrouping       = sheetGrouping
        , sfVisibleFrom    = addTime <$> sheetVisibleFrom
        , sfActiveFrom     = addTime <$> sheetActiveFrom
        , sfActiveTo       = addTime <$> sheetActiveTo
        , sfSubmissionMode = sheetSubmissionMode
        , sfSheetF         = Nothing
        , sfHintFrom       = addTime <$> sheetHintFrom
        , sfHintF          = Nothing
        , sfSolutionFrom   = addTime <$> sheetSolutionFrom
        , sfSolutionF      = Nothing
        , sfMarkingF       = Nothing
        , sfMarkingText    = sheetMarkingText
        , sfAutoDistribute = sheetAutoDistribute
        , sfCorrectors     = loads
        , sfAnonymousCorrection = sheetAnonymousCorrection
        , sfRequireExamRegistration = Nothing
        , sfPersonalF      = Nothing
        , sfAuthorshipStatementMode = sheetAuthorshipStatementMode
        , sfAuthorshipStatementExam = sheetAuthorshipStatementExam
        , sfAuthorshipStatement = authorshipStatementDefinitionContent <$> mStmt
        }
  let action = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
        insertUnique
  handleSheetEdit tid ssh csh Nothing template action

defaultLoads :: CourseId -> DB Loads
-- ^ Generate `Loads` in such a way that minimal editing is required
--
-- For every user, that ever was a corrector for this course, return their last `Load`.
-- "Last `Load`" is taken to mean their `Load` on the `Sheet` with the most recent creation time (first edit).
defaultLoads cId =
  fmap toMap . E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> E.distinctOnOrderBy [E.asc (sheetCorrector E.^. SheetCorrectorUser)] $ do
    E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet

    let creationTime = E.subSelectMaybe . E.from $ \sheetEdit -> do
          E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
          return . E.min_ $ sheetEdit E.^. SheetEditTime

    E.where_ $ sheet E.^. SheetCourse E.==. E.val cId

    E.orderBy [E.desc creationTime]

    return (sheetCorrector E.^. SheetCorrectorUser, sheetCorrector E.^. SheetCorrectorLoad, sheetCorrector E.^. SheetCorrectorState)
  where
    toMap :: [(E.Value UserId, E.Value Load, E.Value CorrectorState)] -> Loads
    toMap = foldMap $ \(E.Value uid, E.Value cLoad, E.Value cState) -> Map.singleton (Right uid) (InvDBDataSheetCorrector cLoad cState, InvTokenDataSheetCorrector)
