module Handler.Sheet.Show
  ( getSShowR
  ) where

import Import hiding (link)

import Handler.Utils

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E

import qualified Data.Map as Map

import Handler.Sheet.Pseudonym
import Utils.Sheet


getSShowR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
getSShowR tid ssh csh shn = do
  now <- liftIO getCurrentTime
  muid <- maybeAuthId
  Entity sid sheet <- runDB $ fetchSheet tid ssh csh shn
  seeAllModificationTimestamps <- hasReadAccessTo $ CSheetR tid ssh csh shn SIsCorrR -- ordinary users should not see modification dates older than visibility

  let sftVisible :: IsDBTable m a => SheetFileType -> DBCell m a
      sftVisible sft | Just dts <- sheetFileTypeDates sheet sft
                        = dateTimeCellVisible now dts
                     | otherwise = isVisibleCell False

      sftModification :: IsDBTable m a => SheetFileType -> UTCTime -> DBCell m a
      sftModification sft mtime
        | seeAllModificationTimestamps  =  dateTimeCell mtime
        | NTop (Just mtime) > NTop (sheetFileTypeDates sheet sft)  =  dateTimeCell mtime
        | otherwise  =  mempty

  let fileData (sheetFile `E.FullOuterJoin` psFile) = do
        E.on $ sheetFile E.?. SheetFileTitle E.==. psFile E.?. PersonalisedSheetFileTitle
         E.&&. sheetFile E.?. SheetFileType  E.==. psFile E.?. PersonalisedSheetFileType
         E.&&. sheetFile E.?. SheetFileSheet E.==. psFile E.?. PersonalisedSheetFileSheet
         E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
        -- filter to requested file
        E.where_ $ (sheetFile E.?. SheetFileSheet E.==. E.justVal sid E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.justVal sid)
             E.&&. E.maybe (E.isJust . E.joinV $ sheetFile E.?. SheetFileContent) E.isJust (psFile E.?. PersonalisedSheetFileContent) -- don't show directories
             E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
        -- return desired columns
        return ( E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileTitle, sheetFile E.?. SheetFileTitle]
               , E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileModified, sheetFile E.?. SheetFileModified]
               , E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileType, sheetFile E.?. SheetFileType]
               , E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileContent, sheetFile E.?. SheetFileContent]
               )
  let colonnadeFiles = widgetColonnade $ mconcat
        [ sortable (Just "type") (i18nCell MsgSheetFileTypeHeader) $ \(_,_, E.Value ftype, _) ->
            let link = CSheetR tid ssh csh shn $ SZipR ftype
             in tellCell (Any True) $
                  anchorCell link [whamlet|#{sheetFile2markup ftype}  _{ftype}|]
            -- i18nCell ftype & cellContents %~ (\act -> act <* tell (Any True))

        -- , colFilePath (view _1) (\row -> let fType = view _3 row in let fName = view _1 row in (CSheetR tid ssh csh shn (SFileR (E.unValue fType) (E.unValue fName))))
        , sortable (Just "path") (i18nCell MsgFileTitle) $ \(E.Value fName, _, E.Value fType, _) -> anchorCell
             (CSheetR tid ssh csh shn $ SFileR fType fName)
             (str2widget fName)
        , sortable (toNothing "visible") (i18nCell MsgVisibleFrom)
            $ \(_,              _ , E.Value ftype, _) -> sftVisible ftype
        , sortable (Just "time")        (i18nCell MsgFileModified)
            $ \(_,E.Value modified, E.Value ftype, _) -> sftModification ftype modified
        -- , colFileModification (view _2)
        ]
  let psValidator = def & defaultSorting [SortAscBy "type", SortAscBy "path"]
                        & forceFilter "may-access" (Any True)
  (Any hasFiles, fileTable) <- runDB $ dbTable psValidator DBTable
    { dbtSQLQuery = fileData
    , dbtRowKey = \(sheetFile `E.FullOuterJoin` psFile) -> (sheetFile E.?. SheetFileId, psFile E.?. PersonalisedSheetFileId)
    , dbtColonnade = colonnadeFiles
    , dbtProj = return . dbrOutput :: DBRow _ -> DB (E.Value FilePath, E.Value UTCTime, E.Value SheetFileType, E.Value (Maybe FileContentReference))
    , dbtStyle = def
    , dbtFilter = mconcat
        [ singletonMap "may-access" . FilterProjected $ \(Any b) r ->
            let (E.Value fName, _, E.Value fType, _) = r :: (E.Value FilePath, E.Value UTCTime, E.Value SheetFileType, E.Value (Maybe FileContentReference))
             in (==b) <$> hasReadAccessTo (CSheetR tid ssh csh shn $ SFileR fType fName) :: DB Bool
        ]
    , dbtFilterUI = mempty
    , dbtIdent = "files" :: Text
    , dbtSorting = Map.fromList
      [ ( "type"
        , SortColumn $ \(sheetFile `E.FullOuterJoin` psFile) -> E.orderByEnum $ E.unsafeCoalesce [sheetFile E.?. SheetFileType, psFile E.?. PersonalisedSheetFileType]
        )
      , ( "path"
        , SortColumn $ \(sheetFile `E.FullOuterJoin` psFile) -> E.unsafeCoalesce [sheetFile E.?. SheetFileTitle, psFile E.?. PersonalisedSheetFileTitle]
        )
      -- , ( "visible"
      --   , SortColumn $ \(sheetFile `E.InnerJoin` _file) ->  sheetFileTypeDates sheet $ sheetFile E.^. SheetFileType -- not possible without another join for the sheet
      --   )
      , ( "time"
        , SortColumn $ \(sheetFile `E.FullOuterJoin` psFile) -> E.unsafeCoalesce [sheetFile E.?. SheetFileModified, psFile E.?. PersonalisedSheetFileModified]
        )
      ]
    , dbtParams = def
    , dbtCsvEncode = noCsvEncode
    , dbtCsvDecode = Nothing
    , dbtExtraReps = []
    }
  (hasHints, hasSolution) <- runDB $ do
    hasHints <- E.selectExists . E.from $ \sheet' ->
      E.where_ $ hasSheetFileQuery sheet' (E.val muid) SheetHint
           E.&&. sheet' E.^. SheetId E.==. E.val sid
    hasSolution <- E.selectExists . E.from $ \sheet' ->
      E.where_ $ hasSheetFileQuery sheet' (E.val muid) SheetSolution
           E.&&. sheet' E.^. SheetId E.==. E.val sid
    return (hasHints, hasSolution)
  mPseudonym <- runMaybeT $ do
    uid <- MaybeT maybeAuthId
    Entity _ SheetPseudonym{sheetPseudonymPseudonym} <- MaybeT . runDB . getBy $ UniqueSheetPseudonymUser sid uid
    return $ review _PseudonymText sheetPseudonymPseudonym
  (generateWidget, generateEnctype) <- generateFormPost $ \csrf ->
    over _2 ((toWidget csrf <>) . fvWidget) <$> mreq (buttonField BtnGenerate) "" Nothing
  let generateForm = wrapForm generateWidget def
        { formAction = Just . SomeRoute $ CSheetR tid ssh csh shn SPseudonymR
        , formEncoding = generateEnctype
        , formSubmit = FormNoSubmit
        }
  checkExamRegistration <- orM
    [ wouldHaveWriteAccessToIff [(AuthExamRegistered, True)] $ CSheetR tid ssh csh shn SubmissionNewR
    , wouldHaveReadAccessToIff  [(AuthExamRegistered, True)] $ CSheetR tid ssh csh shn SArchiveR
    ]
  mRequiredExam <- fmap join . for (guardOnM checkExamRegistration $ sheetRequireExamRegistration sheet) $ \eId -> fmap (fmap $(E.unValueN 4)) . runDB . E.selectMaybe . E.from $ \(exam `E.InnerJoin` course) -> do
    E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
    E.where_ $ exam E.^. ExamId E.==. E.val eId
    return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand, exam E.^. ExamName)
  mRequiredExamLink <- runMaybeT $ do
    (etid, essh, ecsh, examn) <- hoistMaybe mRequiredExam
    let eUrl = CExamR etid essh ecsh examn EShowR
    guardM . lift $ hasReadAccessTo eUrl
    return eUrl
  mMissingExamRegistration <- for (guardOnM checkExamRegistration $ sheetRequireExamRegistration sheet) $ \eId -> maybeT (return True) $ do
    uid <- MaybeT maybeAuthId
    lift . fmap not . runDB $ exists [ ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid ]

  checkPersonalisedFiles <- andM
    [ return . not $ sheetAllowNonPersonalisedSubmission sheet
    , return $ NTop (sheetActiveFrom sheet) <= NTop (Just now), return $ NTop (Just now) <= NTop (sheetActiveTo sheet)
    , wouldHaveWriteAccessToIff [(AuthPersonalisedSheetFiles, True)] $ CSheetR tid ssh csh shn SubmissionNewR
    ]
  mMissingPersonalisedFiles <- for (guardOnM checkPersonalisedFiles muid) $ \uid -> runDB $
    fmap not . E.selectExists . E.from $ \psFile ->
      E.where_ $ psFile E.^. PersonalisedSheetFileUser E.==. E.val uid
           E.&&. psFile E.^. PersonalisedSheetFileSheet E.==. E.val sid

  submissionModeNoneWithoutNotGradedWarning <- runMaybeT $ do
    guard $ classifySubmissionMode (sheetSubmissionMode sheet) == SubmissionModeNone
         && sheetType sheet /= NotGraded
    guardM . lift . hasWriteAccessTo $ CSheetR tid ssh csh shn SEditR
    return $ notification NotificationBroad =<< messageI Warning MsgSheetSubmissionModeNoneWithoutNotGraded

  sTypeDesc <- runDB $ sheetTypeDescription (sheetCourse sheet) (sheetType sheet)

  defaultLayout $ do
    setTitleI $ prependCourseTitle tid ssh csh $ SomeMessage shn
    let zipLink = CSheetR tid ssh csh shn SArchiveR
        visibleFrom =     visibleUTCTime SelFormatDateTime <$> sheetVisibleFrom  sheet
        hasSubmission = classifySubmissionMode (sheetSubmissionMode sheet) /= SubmissionModeNone
    sheetFrom     <- traverse (formatTime SelFormatDateTime) $  sheetActiveFrom   sheet
    sheetTo       <- traverse (formatTime SelFormatDateTime) $  sheetActiveTo     sheet
    hintsFrom     <- traverse (formatTime SelFormatDateTime) $  sheetHintFrom     sheet
    solutionFrom  <- traverse (formatTime SelFormatDateTime) $  sheetSolutionFrom sheet
    markingText   <- runMaybeT $ assertM_ (Authorized ==) (lift $ evalAccessCorrector tid ssh csh) >> hoistMaybe (sheetMarkingText sheet)
    submissionTip <- messageI Info MsgSheetCorrectorSubmissionsTip
    tr <- getTranslate
    $(widgetFile "sheetShow")
