module Handler.Course.Application
  ( getCAFilesR
  , getCApplicationsR, postCApplicationsR
  ) where

import Import

import Handler.Utils
import Handler.Utils.Table.Columns

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

import System.FilePath (addExtension)

import qualified Data.Conduit.List as C


getCAFilesR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> Handler TypedContent
getCAFilesR tid ssh csh cID = do
  appId <- decrypt cID
  User{..} <- runDB $ do
    CourseApplication{..} <- get404 appId
    Course{..} <- get404 courseApplicationCourse
    let matches = and
          [ tid == courseTerm
          , ssh == courseSchool
          , csh == courseShorthand
          ]
    unless matches . redirectWith movedPermanently301 $ CApplicationR courseTerm courseSchool courseShorthand cID CAFilesR
    get404 courseApplicationUser

  archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseApplicationArchiveName tid ssh csh cID userDisplayName
  let
    fsSource = E.selectSource . E.from $ \(courseApplicationFile `E.InnerJoin` file) -> do
      E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file E.^. FileId
      E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
      return file

  serveSomeFiles archiveName $ fsSource .| C.map entityVal


type CourseApplicationsTableExpr = (              E.SqlExpr (Entity CourseApplication)
                                    `E.InnerJoin` E.SqlExpr (Entity User)
                                   )
                 `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity Allocation))
                 `E.LeftOuterJoin` (              E.SqlExpr (Maybe (Entity StudyFeatures))
                                    `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
                                    `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
                                   )
type CourseApplicationsTableData = DBRow ( Entity CourseApplication
                                         , Entity User
                                         , E.Value Bool -- hasFiles
                                         , Maybe (Entity Allocation)
                                         , Maybe (Entity StudyFeatures)
                                         , Maybe (Entity StudyTerms)
                                         , Maybe (Entity StudyDegree)
                                         )
  
courseApplicationsIdent :: Text
courseApplicationsIdent = "applications"

queryCourseApplication :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity CourseApplication))
queryCourseApplication = to $ $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)

queryUser :: Getter CourseApplicationsTableExpr (E.SqlExpr (Entity User))
queryUser = to $ $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)

queryHasFiles :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool))
queryHasFiles = to $ hasFiles . $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
  where
    hasFiles appl = E.exists . E.from $ \courseApplicationFile ->
      E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. appl E.^. CourseApplicationId

queryAllocation :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity Allocation)))
queryAllocation = to $(sqlLOJproj 3 2)

queryStudyFeatures :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyFeatures)))
queryStudyFeatures = to $ $(sqlIJproj 3 1) . $(sqlLOJproj 3 3)

queryStudyTerms :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyTerms)))
queryStudyTerms = to $ $(sqlIJproj 3 2) . $(sqlLOJproj 3 3)

queryStudyDegree :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity StudyDegree)))
queryStudyDegree = to $ $(sqlIJproj 3 3) . $(sqlLOJproj 3 3)

resultCourseApplication :: Lens' CourseApplicationsTableData (Entity CourseApplication)
resultCourseApplication = _dbrOutput . _1

resultUser :: Lens' CourseApplicationsTableData (Entity User)
resultUser = _dbrOutput . _2

resultHasFiles :: Lens' CourseApplicationsTableData Bool
resultHasFiles = _dbrOutput . _3 . _Value

resultAllocation :: Traversal' CourseApplicationsTableData (Entity Allocation)
resultAllocation = _dbrOutput . _4 . _Just

resultStudyFeatures :: Traversal' CourseApplicationsTableData (Entity StudyFeatures)
resultStudyFeatures = _dbrOutput . _5 . _Just

resultStudyTerms :: Traversal' CourseApplicationsTableData (Entity StudyTerms)
resultStudyTerms = _dbrOutput . _6 . _Just

resultStudyDegree :: Traversal' CourseApplicationsTableData (Entity StudyDegree)
resultStudyDegree = _dbrOutput . _7 . _Just

getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCApplicationsR = postCApplicationsR
postCApplicationsR tid ssh csh = do
  table <- runDB $ do
    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh

    let
      allocationLink :: Allocation -> SomeRoute UniWorX
      allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR

      participantLink :: MonadCrypto m => UserId -> m (SomeRoute UniWorX)
      participantLink uid = do
        cID <- encrypt uid
        return . SomeRoute . CourseR tid ssh csh $ CUserR cID
      
      dbtSQLQuery :: CourseApplicationsTableExpr -> E.SqlQuery _
      dbtSQLQuery = runReaderT $ do
        courseApplication <- view queryCourseApplication
        hasFiles <- view queryHasFiles
        user <- view queryUser
        allocation <- view queryAllocation
        studyFeatures <- view queryStudyFeatures
        studyTerms <- view queryStudyTerms
        studyDegree <- view queryStudyDegree

        lift $ do
          E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
          E.on $ studyTerms E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
          E.on $ studyFeatures E.?. StudyFeaturesId E.==. courseApplication E.^. CourseApplicationField
          E.on $ courseApplication E.^. CourseApplicationAllocation E.==. allocation E.?. AllocationId
          E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser
          E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid

        return (courseApplication, user, hasFiles, allocation, studyFeatures, studyTerms, studyDegree)

      dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) CourseApplicationsTableData
      dbtProj = runReaderT $ do
        appId <- view $ resultCourseApplication . _entityKey
        cID <- encrypt appId
        
        guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR -- TODO: replace with CAShowR

        view id

      dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId)

      dbtColonnade :: Colonnade Sortable _ _
      dbtColonnade = mconcat
        [ emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand)
        , colApplicationId (resultCourseApplication . _entityKey)
        , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
        , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
        , emptyOpticColonnade (resultStudyTerms . _entityVal) colStudyTerms
        , emptyOpticColonnade (resultStudyDegree . _entityVal) colStudyDegree
        , emptyOpticColonnade (resultStudyFeatures . _entityVal . _studyFeaturesSemester) colStudyFeaturesSemester
        , colApplicationText (resultCourseApplication . _entityVal . _courseApplicationText)
        , lmap ((tid, ssh, csh), ) $ colApplicationFiles ($(multifocusL 5) (_1 . _1) (_1 . _2) (_1 . _3) (_2 . resultCourseApplication . _entityKey) (_2 . resultHasFiles))
        , colApplicationVeto (resultCourseApplication . _entityVal . _courseApplicationRatingVeto)
        , colApplicationRatingPoints (resultCourseApplication . _entityVal . _courseApplicationRatingPoints)
        , colApplicationRatingComment (resultCourseApplication . _entityVal . _courseApplicationRatingComment)
        ]

      dbtSorting = mconcat
        [ sortAllocationShorthand $ queryAllocation . to (E.?. AllocationShorthand)
        , sortUserName' $ $(multifocusG 2) (queryUser . to (E.^. UserDisplayName)) (queryUser . to (E.^. UserSurname))
        , sortUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
        , sortStudyTerms queryStudyTerms
        , sortStudyDegree queryStudyDegree
        , sortStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester)
        , sortApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
        , sortApplicationFiles queryHasFiles
        , sortApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
        , sortApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints)
        , sortApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment)
        ]

      dbtFilter = mconcat
        [ fltrAllocation queryAllocation
        , fltrUserName' $ queryUser . to (E.^. UserDisplayName)
        , fltrUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
        , fltrStudyTerms queryStudyTerms
        , fltrStudyDegree queryStudyDegree
        , fltrStudyFeaturesSemester $ queryStudyFeatures . to (E.?. StudyFeaturesSemester)
        , fltrApplicationText $ queryCourseApplication . to (E.^. CourseApplicationText)
        , fltrApplicationFiles queryHasFiles
        , fltrApplicationVeto $ queryCourseApplication . to (E.^. CourseApplicationRatingVeto)
        , fltrApplicationRatingPoints $ queryCourseApplication . to (E.^. CourseApplicationRatingPoints)
        , fltrApplicationRatingComment $ queryCourseApplication . to (E.^. CourseApplicationRatingComment)
        ]
      dbtFilterUI = mconcat
        [ fltrAllocationUI
        , fltrUserNameUI'
        , fltrUserMatriculationUI
        , fltrStudyTermsUI
        , fltrStudyDegreeUI
        , fltrStudyFeaturesSemesterUI
        , fltrApplicationTextUI
        , fltrApplicationFilesUI
        , fltrApplicationVetoUI
        , fltrApplicationRatingPointsUI
        , fltrApplicationRatingCommentUI
        ]

      dbtStyle = def
        { dbsFilterLayout = defaultDBSFilterLayout
        }
      dbtParams = def

      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing

      dbtIdent = courseApplicationsIdent

      psValidator :: PSValidator _ _
      psValidator = def

    dbTableWidget' psValidator DBTable{..}

  let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle

  siteLayoutMsg title $ do
    setTitleI title
    table