-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Handler.Submission.Helper.ArchiveTable
  ( mkSubmissionArchiveTable
  ) where

import Import
import Handler.Utils
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import qualified Database.Esqueleto.Internal.Internal as E (unsafeSqlFunction)


type SubmissionArchiveExpr = E.SqlExpr (Maybe (Entity SubmissionFile)) `E.FullOuterJoin` E.SqlExpr (Maybe (Entity SubmissionFile))

queryOriginal, queryCorrected :: Getter SubmissionArchiveExpr (E.SqlExpr (Maybe (Entity SubmissionFile)))
queryOriginal = to $(E.sqlFOJproj 2 1)
queryCorrected = to $(E.sqlFOJproj 2 2)


type SubmissionArchiveData = DBRow ( Maybe (Entity SubmissionFile)
                                   , Maybe (Entity SubmissionFile)
                                   )

resultOriginal, resultCorrected :: Traversal' SubmissionArchiveData (Entity SubmissionFile)
resultOriginal = _dbrOutput . _1 . _Just
resultCorrected = _dbrOutput . _2 . _Just
  

mkSubmissionArchiveTable :: TermId -> SchoolId -> CourseShorthand -> SheetName
                         -> Bool -- ^ @showCorrection@
                         -> SubmissionId
                         -> DB (Bool, Widget)
mkSubmissionArchiveTable tid ssh csh shn showCorrection smid = do
  cID <- encrypt smid :: DB CryptoFileNameSubmission -- shouldn't be expensive due to caching

  let
    dbtIdent :: Text
    dbtIdent = "files"
    
    dbtSQLQuery = runReaderT $ do
      original <- view queryOriginal
      corrected <- view queryCorrected

      lift . E.on $
              original E.?. SubmissionFileTitle E.==. corrected E.?. SubmissionFileTitle
        E.&&. original E.?. SubmissionFileSubmission E.==. corrected E.?. SubmissionFileSubmission
        E.&&. original E.?. SubmissionFileId E.!=. corrected E.?. SubmissionFileId
        E.&&. corrected E.?. SubmissionFileIsDeletion E.==. E.val (Just False)
        E.&&. E.val showCorrection -- Do not correlate files if we don't show correction; together with `may-access` this treats corrected files like they literally don't exist

      lift . E.where_ $ original E.?. SubmissionFileSubmission E.==. E.val (Just smid)
                  E.||. corrected E.?. SubmissionFileSubmission E.==. E.val (Just smid)

      lift . E.where_ . E.maybe E.true E.not_ $ original  E.?. SubmissionFileIsUpdate -- @original@ is unset or not an update
      lift . E.where_ . E.maybe E.true id     $ corrected E.?. SubmissionFileIsUpdate -- @corrected@ is unset or an update
      lift . E.where_ . E.maybe E.true E.not_ $ corrected E.?. SubmissionFileIsDeletion -- @corrected@ is unset or not a deletion
      return (original, corrected)
    dbtRowKey = (,) <$> views queryOriginal (E.?. SubmissionFileId) <*> views queryCorrected (E.?. SubmissionFileId)

    dbtProj = dbtProjId

    dbtColonnade = mconcat $ catMaybes
        [ Just . sortable (Just "path") (i18nCell MsgTableFileTitle) $ \t -> let
              mOrig = t ^? resultOriginal
              mCorr = t ^? resultCorrected
              fileTitle'' = submissionFileTitle . entityVal <$> (mOrig <|> mCorr)
              origIsFile = fmap (isJust . submissionFileContent . entityVal) mOrig
              corrIsFile = fmap (isJust . submissionFileContent . entityVal) mCorr
              isFile' = origIsFile <|> corrIsFile
            in maybeCell ((,) <$> fileTitle'' <*> isFile') $ \(fileTitle', isFile) -> if
              | Just True <- origIsFile -> anchorCell (subDownloadLink SubmissionOriginal fileTitle') [whamlet|#{fileTitle'}|]
              | otherwise               -> stringCell $ bool (<> "/") id isFile fileTitle'
        , guardOn showCorrection . sortable (toNothing "state") (i18nCell MsgTableCorState) $ \t -> case t ^? resultCorrected of
            Nothing -> cell mempty
            Just (Entity _ SubmissionFile{..}) -> tellCell (Any True) $ if
              | isJust submissionFileContent -> anchorCell (subDownloadLink SubmissionCorrected submissionFileTitle) (i18n MsgFileCorrected :: Widget)
              | otherwise -> i18nCell MsgCorrected
        , Just . sortable (Just "time") (i18nCell MsgTableFileModified) $ \t -> let
              mOrig = t ^? resultOriginal
              mCorr = t ^? resultCorrected
              origTime = submissionFileModified . entityVal <$> mOrig
              corrTime = submissionFileModified . entityVal <$> mCorr
              fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
            in maybeCell fileTime dateTimeCell
        ]
      where 
        subDownloadLink sft fileTitle' = CSubmissionR tid ssh csh shn cID $ SubDownloadR sft fileTitle'

    dbtStyle = def

    dbtSorting = mconcat
        [ singletonMap "path" . SortColumn $ \r -> (E.unsafeSqlFunction "string_to_array" :: (E.SqlExpr (E.Value (Maybe String)), E.SqlExpr (E.Value String)) -> E.SqlExpr (E.Value [String])) (E.coalesce [views queryOriginal (E.?. SubmissionFileTitle) r, views queryCorrected (E.?. SubmissionFileTitle) r], E.val "/" :: E.SqlExpr (E.Value String))
        , singletonMap "time" . SortColumn $ \r -> (E.unsafeSqlFunction "GREATEST" ([views queryOriginal (E.?. SubmissionFileModified) r, views queryCorrected (E.?. SubmissionFileModified) r] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
        ]
    dbtFilter = mconcat
        [ singletonMap "may-access" . FilterColumn $ \(Any b) r
            -> E.val b E.==. (E.val showCorrection E.||. E.isJust (views queryOriginal (E.?. SubmissionFileId) r))
        ]

    dbtFilterUI = mempty

    dbtParams = def

    dbtCsvEncode = noCsvEncode
    dbtCsvDecode = Nothing
    dbtExtraReps = []

    archiveTableValidator = def
      & defaultSorting [SortAscBy "path"]
      & forceFilter "may-access" (Any True)
   in over _1 getAny <$> dbTableWidget archiveTableValidator DBTable{..}