{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results

module Jobs.Handler.SendNotification.Allocation
  ( dispatchNotificationAllocationStaffRegister
  , dispatchNotificationAllocationRegister
  , dispatchNotificationAllocationAllocation
  , dispatchNotificationAllocationUnratedApplications
  , dispatchNotificationAllocationOutdatedRatings
  , dispatchNotificationAllocationResults
  ) where

import Import

import Handler.Utils
import Jobs.Handler.SendNotification.Utils

import Text.Hamlet

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
  

dispatchNotificationAllocationStaffRegister :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationStaffRegister nAllocation jRecipient = userMailT jRecipient $ do
  Allocation{..} <- liftHandler . runDB $ getJust nAllocation

  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
  setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationName
  editNotifications <- mkEditNotifications jRecipient
  registerDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo
  addAlternatives $
    providePreferredAlternative $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")

dispatchNotificationAllocationRegister :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationRegister nAllocation jRecipient = userMailT jRecipient $ do
  Allocation{..} <- liftHandler . runDB $ getJust nAllocation

  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
  setSubjectI $ MsgMailSubjectAllocationRegister allocationName
  editNotifications <- mkEditNotifications jRecipient
  registerDeadline <- traverse (formatTime SelFormatDateTime) allocationRegisterTo
  addAlternatives $
    providePreferredAlternative $(ihamletFile "templates/mail/allocationRegister.hamlet")

dispatchNotificationAllocationAllocation :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationAllocation nAllocation jRecipient = do
  (Allocation{..}, courses) <- runDB $ do
    allocation <- getJust nAllocation
    courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
       E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
       E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
      return ( course E.^. CourseTerm
             , course E.^. CourseSchool
             , course E.^. CourseShorthand
             , course E.^. CourseName
             )
    let courses' = courses
          & over (traverse . _1) E.unValue
          & over (traverse . _2) E.unValue
          & over (traverse . _3) E.unValue
          & over (traverse . _4) E.unValue
    return (allocation, courses')

  unless (null courses) . userMailT jRecipient $ do
    now <- liftIO getCurrentTime

    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
    setSubjectI $ MsgMailSubjectAllocationAllocation allocationName
    editNotifications <- mkEditNotifications jRecipient
    allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
    registerDeadline <- traverse (formatTime SelFormatDateTime) $ assertM (> now) allocationRegisterTo
    addAlternatives $
      providePreferredAlternative $(ihamletFile "templates/mail/allocationAllocation.hamlet")

dispatchNotificationAllocationUnratedApplications :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationUnratedApplications nAllocation jRecipient = do
  (Allocation{..}, courses) <- runDB $ do
    allocation <- getJust nAllocation
    courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
       E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
       E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation

      let
        unratedAppCount :: E.SqlExpr (E.Value Natural)
        unratedAppCount = E.subSelectCount . E.from $ \application ->
          E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
               E.&&. application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
               E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)
  
      return ( course E.^. CourseTerm
             , course E.^. CourseSchool
             , course E.^. CourseShorthand
             , course E.^. CourseName
             , unratedAppCount
             )
    let courses' = courses
          & over (traverse . _1) E.unValue
          & over (traverse . _2) E.unValue
          & over (traverse . _3) E.unValue
          & over (traverse . _4) E.unValue
          & over (traverse . _5) E.unValue
          & filter ((> 0) . view _5)
    return (allocation, courses')


  unless (null courses) . userMailT jRecipient $ do
    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
    setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationName
    editNotifications <- mkEditNotifications jRecipient
    allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
    addAlternatives $
      providePreferredAlternative $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet")

dispatchNotificationAllocationOutdatedRatings :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationOutdatedRatings nAllocation jRecipient = do
  (Allocation{..}, courses) <- runDB $ do
    allocation <- getJust nAllocation
    courses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` lecturer) -> do
      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
       E.&&. lecturer E.^. LecturerUser E.==. E.val jRecipient
      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
       E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation

      let
        outdatedRatingsAppCount :: E.SqlExpr (E.Value Natural)
        outdatedRatingsAppCount = E.subSelectCount . E.from $ \application ->
          E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
               E.&&. application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
               E.&&. E.maybe E.false (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)
  
      return ( course E.^. CourseTerm
             , course E.^. CourseSchool
             , course E.^. CourseShorthand
             , course E.^. CourseName
             , outdatedRatingsAppCount
             )
    let courses' = courses
          & over (traverse . _1) E.unValue
          & over (traverse . _2) E.unValue
          & over (traverse . _3) E.unValue
          & over (traverse . _4) E.unValue
          & over (traverse . _5) E.unValue
          & filter ((> 0) . view _5)
    return (allocation, courses')


  unless (null courses) . userMailT jRecipient $ do
    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
    setSubjectI $ MsgMailSubjectAllocationOutdatedRatings allocationName
    editNotifications <- mkEditNotifications jRecipient
    allocationDeadline <- traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
    addAlternatives $
      providePreferredAlternative $(ihamletFile "templates/mail/allocationOutdatedRatings.hamlet")

dispatchNotificationAllocationResults :: AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipient $ do
  (Allocation{..}, lecturerResults, participantResults) <- liftHandler . runDB $ do
    allocation <- getJust nAllocation

    lecturerResults' <- E.select . E.from $ \(lecturer `E.InnerJoin` course) -> do
      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
      E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
           E.&&. E.exists (E.from $ \allocationCourse ->
                              E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
                                   E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
                          )
      let allocatedCount :: E.SqlExpr (E.Value Int64)
          allocatedCount = E.subSelectCount . E.from $ \participant ->
            E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
                 E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
      let participantCount :: E.SqlExpr (E.Value Int64)
          participantCount = E.subSelectCount . E.from $ \participant ->
            E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
      return (course, allocatedCount, participantCount)
    let lecturerResults = flip map lecturerResults' $ \(Entity _ Course{..}, E.Value allocCount, E.Value partCount) -> SomeMessage $ if
          | allocCount == partCount -> MsgAllocationResultLecturerAll courseShorthand allocCount
          | allocCount == 0 -> MsgAllocationResultLecturerNone courseShorthand
          | otherwise -> MsgAllocationResultLecturer courseShorthand allocCount partCount

    doParticipantResults <- E.selectExists . E.from $ \application ->
      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation)
           E.&&. application E.^. CourseApplicationUser E.==. E.val jRecipient
    participantResults' <- E.select . E.from $ \(participant `E.InnerJoin` course) -> do
      E.on $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
      E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
           E.&&. participant E.^. CourseParticipantUser E.==. E.val jRecipient
      return course
    let participantResults = case participantResults' of
          [] | doParticipantResults -> Just []
             | otherwise            -> Nothing
          cs -> Just $ map (courseShorthand . entityVal) cs
  
    return (allocation, lecturerResults, participantResults)

  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
  setSubjectI $ MsgMailSubjectAllocationResults allocationName
  editNotifications <- mkEditNotifications jRecipient
  
  addAlternatives $
    providePreferredAlternative $(ihamletFile "templates/mail/allocationResults.hamlet")