module Handler.Utils.Exam
  ( fetchExamAux
  , fetchExam, fetchExamId, fetchCourseIdExamId, fetchCourseIdExam
  , examBonus, examBonusPossible, examBonusAchieved
  ) 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

import qualified Data.Conduit.List as C

import qualified Data.Map as Map


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


examBonus :: MonadHandler m => Entity Exam -> ReaderT SqlBackend m (Map UserId SheetTypeSummary)
examBonus (Entity eId Exam{..}) = runConduit $
  let
    rawData = E.selectSource . E.from $ \((examRegistration `E.LeftOuterJoin` examOccurrence) `E.InnerJoin` (sheet `E.InnerJoin` submission)) -> E.distinctOnOrderBy [ E.asc $ examRegistration E.^. ExamRegistrationUser, E.asc $ sheet E.^. SheetId ] $ do
      E.on $ submission E.?. SubmissionSheet E.==. E.just (sheet E.^. SheetId)
      E.on $ E.exists (E.from $ \submissionUser -> E.where_ $ submissionUser E.^. SubmissionUserUser E.==. examRegistration E.^. ExamRegistrationUser
                                                        E.&&. E.just (submissionUser E.^. SubmissionUserSubmission) E.==. submission E.?. SubmissionId
                      )
      E.on $ examRegistration E.^. ExamRegistrationOccurrence E.==. examOccurrence E.?. ExamOccurrenceId
      E.where_ $ sheet E.^. SheetCourse E.==. E.val examCourse
           E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val eId
      E.where_ $ E.case_ 
        [ E.when_
            ( E.not_ . E.isNothing $ examRegistration E.^. ExamRegistrationOccurrence )
          E.then_
            (       E.just (sheet E.^. SheetActiveTo) E.<=. examOccurrence E.?. ExamOccurrenceStart
              E.&&. sheet E.^. SheetVisibleFrom E.<=. examOccurrence E.?. ExamOccurrenceStart
            )
        ]
        ( E.else_ . E.not_ . E.isNothing $ sheet E.^. SheetVisibleFrom
        )
      return (examRegistration E.^. ExamRegistrationUser, sheet E.^. SheetType, submission)
    accum = C.fold ?? Map.empty $ \acc (E.Value uid, E.Value sheetType, fmap entityVal -> sub) ->
      Map.unionWith mappend acc . Map.singleton uid . sheetTypeSum sheetType . (>>= submissionRatingPoints) $ assertM submissionRatingDone sub
   in rawData .| accum

examBonusPossible, examBonusAchieved :: UserId -> Map UserId SheetTypeSummary -> Maybe SheetGradeSummary
examBonusPossible uid bonusMap = normalSummary <$> Map.lookup uid bonusMap
examBonusAchieved uid bonusMap = (mappend <$> normalSummary <*> bonusSummary) <$> Map.lookup uid bonusMap