module Handler.Utils.Exam
  ( fetchExamAux
  , fetchExam, fetchExamId, fetchCourseIdExamId, fetchCourseIdExam
  ) where

import Import.NoFoundation

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

import Utils.Lens


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

fetchExam :: MonadHandler m => TermId -> SchoolId -> CourseShorthand -> ExamName -> ReaderT SqlBackend m (Entity Exam)
fetchExam = fetchExamAux const

fetchExamId :: MonadHandler m => TermId -> SchoolId -> CourseShorthand -> ExamName -> ReaderT SqlBackend m (Key Exam)
fetchExamId tid ssh cid examn = E.unValue <$> fetchExamAux (\tutorial _ -> tutorial E.^. ExamId) tid ssh cid examn

fetchCourseIdExamId  :: MonadHandler m => TermId -> SchoolId -> CourseShorthand -> ExamName -> ReaderT SqlBackend m (Key Course, Key Exam)
fetchCourseIdExamId tid ssh cid examn = $(unValueN 2) <$> fetchExamAux (\tutorial course -> (course E.^. CourseId, tutorial E.^. ExamId)) tid ssh cid examn

fetchCourseIdExam  :: MonadHandler m => TermId -> SchoolId -> CourseShorthand -> ExamName -> ReaderT SqlBackend m (Key Course, Entity Exam)
fetchCourseIdExam tid ssh cid examn = over _1 E.unValue <$> fetchExamAux (\tutorial course -> (course E.^. CourseId, tutorial)) tid ssh cid examn