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

import Import

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


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