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

module Handler.Submission.AuthorshipStatements
  ( getSubAuthorshipStatementsR
  ) where

import Import
import Handler.Utils
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E


type AuthorshipStatementsExpr = E.SqlExpr (Entity AuthorshipStatementSubmission)
                  `E.InnerJoin` E.SqlExpr (Entity User)
                  `E.InnerJoin` E.SqlExpr (Entity AuthorshipStatementDefinition)

queryAuthorshipStatement :: Getter AuthorshipStatementsExpr (E.SqlExpr (Entity AuthorshipStatementSubmission))
queryAuthorshipStatement = to $(E.sqlIJproj 3 1)

queryUser :: Getter AuthorshipStatementsExpr (E.SqlExpr (Entity User))
queryUser = to $(E.sqlIJproj 3 2)
  
queryDefinition :: Getter AuthorshipStatementsExpr (E.SqlExpr (Entity AuthorshipStatementDefinition))
queryDefinition = to $(E.sqlIJproj 3 3)


type AuthorshipStatementsData = DBRow ( Entity AuthorshipStatementSubmission
                                      , Entity User
                                      , Entity AuthorshipStatementDefinition
                                      )

resultAuthorshipStatement :: Lens' AuthorshipStatementsData (Entity AuthorshipStatementSubmission)
resultAuthorshipStatement = _dbrOutput . _1

resultUser :: Lens' AuthorshipStatementsData (Entity User)
resultUser = _dbrOutput . _2
  
resultDefinition :: Lens' AuthorshipStatementsData (Entity AuthorshipStatementDefinition)
resultDefinition = _dbrOutput . _3
  

getSubAuthorshipStatementsR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getSubAuthorshipStatementsR tid ssh csh shn cID = do
  authorshipStatementTable <- runDB $ do
    subId <- decrypt cID
    Submission{..} <- get404 subId
    isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True
    mASDefinition <- getSheetAuthorshipStatement =<< getEntity404 submissionSheet
    
    let dbtIdent :: Text
        dbtIdent = "authorship-statements"

        dbtSQLQuery = runReaderT $ do
          authorshipStatement <- view queryAuthorshipStatement
          user <- view queryUser
          definition <- view queryDefinition

          lift $ do
            E.on $ definition E.^. AuthorshipStatementDefinitionId E.==. authorshipStatement E.^. AuthorshipStatementSubmissionStatement
            E.on $ user E.^. UserId E.==. authorshipStatement E.^. AuthorshipStatementSubmissionUser

            E.where_ $ authorshipStatement E.^. AuthorshipStatementSubmissionSubmission E.==. E.val subId

          return (authorshipStatement, user, definition)
        dbtRowKey = views queryAuthorshipStatement (E.^. AuthorshipStatementSubmissionId)

        dbtProj = dbtProjId

        dbtColonnade :: Colonnade Sortable AuthorshipStatementsData (DBCell (HandlerFor UniWorX) ())
        dbtColonnade = mconcat $ catMaybes
          [ pure . sortable (Just "authorship-statement-time") (i18nCell MsgSubmissionColumnAuthorshipStatementTime) $ views (resultAuthorshipStatement . _entityVal . _authorshipStatementSubmissionTime) dateTimeCell
          , pure $ colUserDisplayName (resultUser . _entityVal . $(multifocusG 2) _userDisplayName _userSurname)
          , guardOn isLecturer $ colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
          , pure $ lmap (view $ resultUser . _entityVal) colUserEmail
          , pure . sortable Nothing (i18nCell MsgSubmissionColumnAuthorshipStatementWording) $ views resultDefinition definitionCell
          ]
          where
            definitionCell (Entity asdId asd)
                = withColor . (cellAttrs %~ addAttrsClass "table__td--center") . modalCell $ authorshipStatementWidget asd
              where
                withColor c
                  | Just (Entity currASDId _) <- mASDefinition
                  = c
                  & cellAttrs %~ addAttrsClass "heated"
                  & cellAttrs <>~ pure ("style", [st|--hotness: #{tshow (boolHeat (asdId /= currASDId))}|])
                  | otherwise
                  = c

        dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }

        dbtSorting = mconcat
          [ singletonMap "authorship-statement-time" . SortColumn $ views queryAuthorshipStatement (E.^. AuthorshipStatementSubmissionTime)
          , sortUserName' (queryUser . $(multifocusG 2) (to (E.^. UserDisplayName)) (to (E.^. UserSurname)))
          , sortUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
          , uncurry singletonMap $ sortUserEmail (view queryUser)
          ]
        dbtFilter = mconcat
          [ fltrUserName' (queryUser . to (E.^. UserDisplayName))
          , fltrUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
          , uncurry singletonMap $ fltrUserEmail (view queryUser)
          , singletonMap "authorship-statement-current" . FilterColumn $ \(view queryAuthorshipStatement -> subStmt) (Last isCurrent)
              -> let isCurrent'
                       | Just (Entity asdId _) <- mASDefinition
                       = subStmt E.^. AuthorshipStatementSubmissionStatement E.==. E.val asdId
                       | otherwise
                       = E.false
                  in maybe E.true ((E.==. isCurrent') . E.val) isCurrent
          ]

        dbtFilterUI = mconcat $ catMaybes
          [ pure fltrUserNameUI'
          , guardOn isLecturer fltrUserMatriculationUI
          , pure fltrUserEmailUI
          , pure . flip (prismAForm $ singletonFilter "authorship-statement-current" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgSubmissionFilterAuthorshipStatementCurrent)
          ]

        dbtParams = def

        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []

        asPSValidator = def
          & defaultSorting [SortDescBy "authorship-statement-time"]
          & restrictFilter lecturerFilter & restrictSorting lecturerSorting
          where
            lecturerFilter fk _
              | isLecturer = True
              | otherwise  = fk /= "user-matriculation"
            lecturerSorting sk _
              | isLecturer = True
              | otherwise  = sk /= "user-matriculation"
     in dbTableWidget' asPSValidator DBTable{..}

  let (heading, title) = ( MsgSubmissionAuthorshipStatementsHeading tid ssh csh shn cID
                         , MsgSubmissionAuthorshipStatementsTitle tid ssh csh shn cID
                         )

  siteLayoutMsg heading $ do
    setTitleI title

    authorshipStatementTable