{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

module Handler.Utils.Sheet where

import Import

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E




fetchSheetAux ::  ( BaseBackend backend ~ SqlBackend
                  , E.SqlSelect b a
                  , Typeable a, MonadHandler m, IsPersistBackend backend
                  , PersistQueryRead backend, PersistUniqueRead backend
                  )
  =>  (E.SqlExpr (Entity Sheet) -> b)
      -> TermId -> SchoolId -> CourseShorthand -> SheetName -> ReaderT backend m a
fetchSheetAux prj tid ssh csh shn =
    let cachId = encodeUtf8 $ tshow (tid,ssh,csh,shn)
    in  cachedBy cachId $ do
    -- Mit Yesod:
    -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
    -- getBy404 $ CourseSheet cid shn
    -- Mit Esqueleto:
        sheetList <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
            E.on     $ course E.^. CourseId E.==. sheet E.^. SheetCourse
            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.&&.  sheet  E.^. SheetName       E.==. E.val shn
            return $ prj sheet
        case sheetList of
          [sheet] -> return sheet
          _other  -> notFound

fetchSheet :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Entity Sheet)
fetchSheet = fetchSheetAux id

fetchSheetId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet)
fetchSheetId tid ssh cid shn = E.unValue <$> fetchSheetAux (E.^. SheetId) tid ssh cid shn

fetchSheetIdCourseId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet, Key Course)
fetchSheetIdCourseId tid ssh cid shn = bimap E.unValue E.unValue <$> fetchSheetAux ((,) <$> (E.^. SheetId) <*> (E.^. SheetCourse)) tid ssh cid shn