-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Utils.Tutorial
  ( fetchTutorialAux
  , fetchTutorial, fetchTutorialId, fetchCourseIdTutorialId, fetchCourseIdTutorial
  , showTutorialRoom
  ) where

import Import

import Database.Persist.Sql (SqlBackendCanRead)
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import qualified Database.Esqueleto.Internal.Internal as E
import Database.Esqueleto.Utils.TH


fetchTutorialAux :: ( SqlBackendCanRead backend
                    , E.SqlSelect b a
                    , MonadHandler m
                    , Typeable a
                    )
                 => (E.SqlExpr (Entity Tutorial) -> E.SqlExpr (Entity Course) -> b)
                 -> TermId -> SchoolId -> CourseShorthand -> TutorialName -> ReaderT backend m a
fetchTutorialAux prj tid ssh csh tutn =
    let cachId = encodeUtf8 $ tshow (tid, ssh, csh, tutn)
    in  cachedBy cachId $ do
        tutList <- E.select . E.from $ \(course `E.InnerJoin` tut) -> do
            E.on     $ course E.^. CourseId E.==. tut E.^. TutorialCourse
            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
                E.&&.  tut    E.^. TutorialName    E.==. E.val tutn
            return $ prj tut course
        case tutList of
          [tut] -> return tut
          _other  -> notFound

fetchTutorial :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> DB (Entity Tutorial)
fetchTutorial = fetchTutorialAux const

fetchTutorialId :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> YesodDB UniWorX (Key Tutorial)
fetchTutorialId tid ssh cid tutn = E.unValue <$> fetchTutorialAux (\tutorial _ -> tutorial E.^. TutorialId) tid ssh cid tutn

fetchCourseIdTutorialId  :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> YesodDB UniWorX (Key Course, Key Tutorial)
fetchCourseIdTutorialId tid ssh cid tutn = $(unValueN 2) <$> fetchTutorialAux (\tutorial course -> (course E.^. CourseId, tutorial E.^. TutorialId)) tid ssh cid tutn

fetchCourseIdTutorial  :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> YesodDB UniWorX (Key Course, Entity Tutorial)
fetchCourseIdTutorial tid ssh cid tutn = over _1 E.unValue <$> fetchTutorialAux (\tutorial course -> (course E.^. CourseId, tutorial)) tid ssh cid tutn

showTutorialRoom :: forall tutorial tutorialId courseId.
                    ( E.SqlProject Tutorial TutorialId tutorial tutorialId
                    , E.SqlProject Tutorial CourseId tutorial courseId
                    )
                 => E.SqlExpr (E.Value UserId) -> E.SqlExpr tutorial -> E.SqlExpr (E.Value Bool)
showTutorialRoom uid tutorial = E.or
  [ E.exists . E.from $ \tutor ->
      E.where_ $ tutor E.^. TutorUser E.==. uid
           E.&&. E.unSqlProjectExpr (Proxy @Tutorial) (Proxy @tutorial) (tutor E.^. TutorTutorial) E.==. tutorial `E.sqlProject` TutorialId
  , E.exists . E.from $ \(lecturer `E.InnerJoin` course) -> do
      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
      E.where_ $ lecturer E.^. LecturerUser E.==. uid
           E.&&. E.unSqlProjectExpr (Proxy @Tutorial) (Proxy @tutorial) (course E.^. CourseId) E.==. tutorial `E.sqlProject` TutorialCourse
  , E.exists . E.from $ \tutorialParticipant ->
      E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. uid
           E.&&. E.unSqlProjectExpr (Proxy @Tutorial) (Proxy @tutorial) (tutorialParticipant E.^. TutorialParticipantTutorial) E.==. tutorial `E.sqlProject` TutorialId
  ]