-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

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

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

import Import

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

import Handler.Info (FAQItem(..))

import Text.Hamlet

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


dispatchNotificationAllocationStaffRegister :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationStaffRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
  allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations

  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
  case allocs of
    [Allocation{..}] ->
      setSubjectI $ MsgMailSubjectAllocationStaffRegister allocationSchool allocationName
    _other ->
      setSubjectI . MsgMailSubjectAllocationStaffRegisterMultiple $ length allocs
  editNotifications <- mkEditNotifications jRecipient
  deadlines <- forM allocs $ \alloc@Allocation{..} -> (alloc,) <$> traverse (formatTime SelFormatDateTime) allocationStaffRegisterTo
  let doRegisterDeadlines = any (is _Just . allocationStaffRegisterTo) allocs
      singleRegisterDeadline = maybe True (flip all (allocs ^.. folded . _allocationStaffRegisterTo) . (==)) $ allocs ^? _head . _allocationStaffRegisterTo
  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationStaffRegister.hamlet")

dispatchNotificationAllocationRegister :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationRegister (otoList -> nAllocations) jRecipient = userMailT jRecipient $ do
  allocs <- fmap (sortOn $ \Allocation{..} -> (allocationSchool, allocationName)) . liftHandler . runDB $ mapM getJust nAllocations

  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
  case allocs of
    [Allocation{..}] ->
      setSubjectI $ MsgMailSubjectAllocationRegister allocationSchool allocationName
    _other ->
      setSubjectI . MsgMailSubjectAllocationRegisterMultiple $ length allocs
  editNotifications <- mkEditNotifications jRecipient
  deadlines <- forM allocs $ \alloc@Allocation{..} -> (alloc,) <$> traverse (formatTime SelFormatDateTime) allocationRegisterTo
  let doRegisterDeadlines = any (is _Just . allocationRegisterTo) allocs
      singleRegisterDeadline = maybe True (flip all (allocs ^.. folded . _allocationRegisterTo) . (==)) $ allocs ^? _head . _allocationRegisterTo
  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationRegister.hamlet")

dispatchNotificationAllocationAllocation :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationAllocation (otoList -> nAllocations) jRecipient = do
  courses <- fmap (nubOrdOn $ views _2 entityKey) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
    E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
    E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId

    E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
    E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations

    E.orderBy [ E.asc $ allocation E.^. AllocationSchool
              , E.asc $ allocation E.^. AllocationName
              , E.asc $ course E.^. CourseTerm
              , E.asc $ course E.^. CourseSchool
              , E.asc $ course E.^. CourseName
              ]

    return (allocation, course)

  let allocations = nubOrdOn entityKey $ courses ^.. folded . _1

  unless (null courses) . userMailT jRecipient $ do
    now <- liftIO getCurrentTime
    let doRegisterDeadlines = any (((<) `on` NTop) (Just now) . allocationRegisterTo . entityVal) allocations

    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
    case allocations of
      [Entity _ Allocation{..}]
        -> setSubjectI $ MsgMailSubjectAllocationAllocation allocationSchool allocationName
      _other
        -> setSubjectI . MsgMailSubjectAllocationAllocationMultiple $ length allocations
    editNotifications <- mkEditNotifications jRecipient

    deadlines <- forM allocations $ \(Entity _ alloc@Allocation{..}) -> (alloc,,) <$> traverse (formatTime SelFormatDateTime) (guardOnM doRegisterDeadlines allocationRegisterTo) <*> traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
    let doDeadlines = doRegisterDeadlines || any (has $ _entityVal . _allocationStaffAllocationTo . _Just) allocations
        sameDeadlines = maybe True (flip all (allocations ^.. folded . _entityVal) . ((==) `on` bool ((, Nothing) . allocationStaffAllocationTo) ((,) <$> allocationStaffAllocationTo <*> allocationRegisterTo) doRegisterDeadlines)) $ allocations ^? _head . _entityVal

    addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationAllocation.hamlet")

dispatchNotificationAllocationUnratedApplications :: Set AllocationId -> UserId -> Handler ()
dispatchNotificationAllocationUnratedApplications (otoList -> nAllocations) jRecipient = do
  courses <- fmap (nubOrdOn (views _2 entityKey) . over (traverse . _3) (fromIntegral . E.unValue)) . runDB . E.select . E.from $ \(course `E.InnerJoin` allocationCourse `E.InnerJoin` allocation `E.InnerJoin` lecturer) -> do
    E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
    E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId

    E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
    E.where_ $ allocation E.^. AllocationId `E.in_` E.valList nAllocations

    let
      unratedAppCount :: E.SqlExpr (E.Value Word64)
      unratedAppCount = E.subSelectCount . E.from $ \application ->
        E.where_ $ application E.^. CourseApplicationCourse E.==. course E.^. CourseId
             E.&&. application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
             E.&&. E.maybe E.true (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)

    E.where_ $ unratedAppCount E.>. E.val 0

    E.orderBy [ E.asc $ allocation E.^. AllocationSchool
              , E.asc $ allocation E.^. AllocationName
              , E.asc $ course E.^. CourseTerm
              , E.asc $ course E.^. CourseSchool
              , E.asc $ course E.^. CourseName
              ]

    return (allocation, course, unratedAppCount)

  let allocations = nubOrdOn entityKey $ courses ^.. folded . _1

  unless (null courses) . userMailT jRecipient $ do
    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
    case allocations of
      [Entity _ Allocation{..}]
        -> setSubjectI $ MsgMailSubjectAllocationUnratedApplications allocationSchool allocationName
      _other
        -> setSubjectI . MsgMailSubjectAllocationUnratedApplicationsMultiple $ length allocations
    editNotifications <- mkEditNotifications jRecipient

    deadlines <- forM allocations $ \(Entity _ alloc@Allocation{..}) -> (alloc,) <$> traverse (formatTime SelFormatDateTime) allocationStaffAllocationTo
    let doDeadlines = any (has $ _entityVal . _allocationStaffAllocationTo . _Just) allocations
        sameDeadlines = maybe True (flip all (allocations ^.. folded . _entityVal) . ((==) `on` allocationStaffAllocationTo)) $ allocations ^? _head . _entityVal

    addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationUnratedApplications.hamlet")

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

    lecturerResults' <- E.select . E.from $ \(lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> do
      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
      E.where_ $ lecturer E.^. LecturerUser E.==. E.val jRecipient
           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)
                 E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
      let participantCount :: E.SqlExpr (E.Value Int64)
          participantCount = E.subSelectCount . E.from $ \participant ->
            E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
                 E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
      return (course, allocationCourse, 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
        warnSubstituteCourses = flip mapMaybe lecturerResults' $ \(Entity _ course, Entity _ AllocationCourse{..}, _, _) -> guardOn (isn't _Just allocationCourseAcceptSubstitutes) course

    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
           E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
      return course
    let participantResults = case participantResults' of
          [] | doParticipantResults -> Just []
             | otherwise            -> Nothing
          cs -> Just $ map (courseShorthand . entityVal) cs

    return (allocation, lecturerResults, warnSubstituteCourses, participantResults)

  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
  setSubjectI $ MsgMailSubjectAllocationResults allocationName
  editNotifications <- mkEditNotifications jRecipient

  studentFaqItems <- forM studentFaqItems' $ \faqItem -> (faqItem, ) <$> toTextUrl (FaqR :#: faqItem)

  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationResults.hamlet")
  where
    studentFaqItems' = [FAQAllocationNoPlaces]

dispatchNotificationAllocationNewCourse :: AllocationId -> CourseId -> UserId -> Handler ()
dispatchNotificationAllocationNewCourse nAllocation nCourse jRecipient = userMailT jRecipient $ do
  (Allocation{..}, Course{..}, hasApplied) <- liftHandler . runDB $ (,,)
    <$> getJust nAllocation
    <*> getJust nCourse
    <*> exists [CourseApplicationAllocation ==. Just nAllocation, CourseApplicationUser ==. jRecipient]

  replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
  setSubjectI $ MsgMailSubjectAllocationNewCourse allocationName
  editNotifications <- mkEditNotifications jRecipient

  cID <- encrypt nCourse
  mayApply <- lift $ orM
    [ is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand ARegisterR) True
    , is _Authorized <$> evalAccessFor (Just jRecipient) (AllocationR allocationTerm allocationSchool allocationShorthand $ AApplyR cID) True
    ]

  allocUrl <- toTextUrl $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID

  addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/allocationNewCourse.hamlet")