{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Jobs.Types
  ( Job(..), Notification(..)
  , JobCtl(..)
  , JobContext(..)
  , JobState(..)
  , jobWorkerNames
  , JobWorkerId
  , showWorkerId, newWorkerId
  , JobQueue, jqInsert, jqDequeue
  , JobPriority(..), prioritiseJob
  ) where

import Import.NoFoundation hiding (Unique)

import Data.Aeson (defaultOptions, Options(..), SumEncoding(..))
import Data.Aeson.TH (deriveJSON)

import Data.List.NonEmpty (NonEmpty)

import Data.Unique

import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

import Data.PQueue.Prio.Max (MaxPQueue)
import qualified Data.PQueue.Prio.Max as PQ


data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notification }
         | JobSendTestEmail { jEmail :: Email, jMailContext :: MailContext }
         | JobQueueNotification { jNotification :: Notification }
         | JobHelpRequest { jHelpSender :: Either (Maybe Address) UserId
                          , jRequestTime :: UTCTime
                          , jSubject :: Maybe Text
                          , jHelpRequest :: Text
                          , jReferer :: Maybe Text
                          }
         | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings }
         | JobDistributeCorrections { jSheet :: SheetId }
         | JobSendCourseCommunication { jRecipientEmail :: Either UserEmail UserId
                                      , jAllRecipientAddresses :: Set Address
                                      , jCourse :: CourseId
                                      , jSender :: UserId
                                      , jMailObjectUUID :: UUID
                                      , jSubject :: Maybe Text
                                      , jMailContent :: Html
                                      }
         | JobInvitation { jInviter :: UserId
                         , jInvitee :: UserEmail
                         , jInvitationUrl :: Text
                         , jInvitationSubject :: Text
                         , jInvitationExplanation :: Html
                         }
         | JobSendPasswordReset { jRecipient :: UserId
                                }
         | JobTruncateTransactionLog
         | JobPruneInvitations
         | JobDeleteTransactionLogIPs
         | JobSynchroniseLdap { jNumIterations
                              , jEpoch
                              , jIteration :: Natural
                              }
         | JobSynchroniseLdapUser { jUser :: UserId
                                  }
         | JobChangeUserDisplayEmail { jUser :: UserId
                                     , jDisplayEmail :: UserEmail
                                     }
         | JobPruneSessionFiles
         | JobPruneUnreferencedFiles
  deriving (Eq, Ord, Show, Read, Generic, Typeable)
data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                  | NotificationSheetActive { nSheet :: SheetId }
                  | NotificationSheetSoonInactive { nSheet :: SheetId }
                  | NotificationSheetInactive { nSheet :: SheetId }
                  | NotificationCorrectionsAssigned { nUser :: UserId, nSheet :: SheetId }
                  | NotificationCorrectionsNotDistributed { nSheet :: SheetId }
                  | NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) }
                  | NotificationUserAuthModeUpdate { nUser :: UserId, nOriginalAuthMode :: AuthenticationMode }
                  | NotificationExamRegistrationActive { nExam :: ExamId }
                  | NotificationExamRegistrationSoonInactive { nExam :: ExamId }
                  | NotificationExamDeregistrationSoonInactive { nExam :: ExamId }
                  | NotificationExamResult { nExam :: ExamId }
                  | NotificationAllocationStaffRegister { nAllocation :: AllocationId }
                  | NotificationAllocationRegister { nAllocation :: AllocationId }
                  | NotificationAllocationAllocation { nAllocation :: AllocationId }
                  | NotificationAllocationUnratedApplications { nAllocation :: AllocationId }
                  | NotificationAllocationOutdatedRatings { nAllocation :: AllocationId }
                  | NotificationExamOfficeExamResults { nExam :: ExamId }
                  | NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
                  | NotificationExamOfficeExternalExamResults { nExternalExam :: ExternalExamId }
                  | NotificationAllocationResults { nAllocation :: AllocationId }
                  | NotificationCourseRegistered { nUser :: UserId, nCourse :: CourseId }
                  | NotificationSubmissionEdited { nInitiator :: UserId, nSubmission :: SubmissionId }
                  | NotificationSubmissionUserCreated { nUser :: UserId, nSubmission :: SubmissionId }
                  | NotificationSubmissionUserDeleted { nUser :: UserId, nSheet :: SheetId, nSubmission :: SubmissionId }
  deriving (Eq, Ord, Show, Read, Generic, Typeable)

instance Hashable Job
instance NFData Job
instance Hashable Notification
instance NFData Notification

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1
  , fieldLabelModifier = camelToPathPiece' 1
  , tagSingleConstructors = True
  , sumEncoding = TaggedObject "job" "data"
  } ''Job

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1
  , fieldLabelModifier = camelToPathPiece' 1
  , tagSingleConstructors = True
  , sumEncoding = TaggedObject "notification" "data"
  } ''Notification


data JobCtl = JobCtlFlush
            | JobCtlPerform QueuedJobId
            | JobCtlDetermineCrontab
            | JobCtlQueue Job
            | JobCtlGenerateHealthReport HealthCheck
            | JobCtlTest
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

instance Hashable JobCtl
instance NFData JobCtl


newtype JobWorkerId = JobWorkerId { jobWorkerUnique :: Unique }
  deriving (Eq, Ord)

showWorkerId :: JobWorkerId -> Text
-- ^ Make a `JobWorkerId` somewhat human readable as a small-ish Number
showWorkerId = tshow . hashUnique . jobWorkerUnique

newWorkerId :: MonadIO m => m JobWorkerId
newWorkerId = JobWorkerId <$> liftIO newUnique
  
data JobContext = JobContext
  { jobCrontab :: TVar (Crontab JobCtl)
  , jobConfirm :: TVar (HashMap JobCtl (NonEmpty (TMVar (Maybe SomeException))))
  }


data JobPriority = JobPrioBatch | JobPrioRealtime
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
instance Universe JobPriority
instance Finite JobPriority
instance NFData JobPriority

prioritiseJob :: JobCtl -> JobPriority
prioritiseJob  JobCtlTest                     = JobPrioRealtime
prioritiseJob (JobCtlGenerateHealthReport _)  = JobPrioRealtime
prioritiseJob  JobCtlDetermineCrontab         = JobPrioRealtime
prioritiseJob  _                              = JobPrioBatch


newtype JobQueue = JobQueue { getJobQueue :: MaxPQueue JobPriority JobCtl }
  deriving (Eq, Ord, Read, Show)
  deriving newtype (Semigroup, Monoid, NFData)

makePrisms ''JobQueue

jqInsert :: JobCtl -> JobQueue -> JobQueue
jqInsert job = force . over _JobQueue $ PQ.insertBehind (prioritiseJob job) job

jqDequeue :: JobQueue -> Maybe (JobCtl, JobQueue)
jqDequeue = fmap ((\r@(_, q) -> q `deepseq` r) . over _2 JobQueue) . PQ.maxView . getJobQueue


data JobState = JobState
  { jobWorkers :: Map (Async ()) (TVar JobQueue)
  , jobWorkerName :: Async () -> JobWorkerId
  , jobContext :: JobContext
  , jobPoolManager :: Async ()
  , jobCron :: Async ()
  , jobShutdown :: TMVar ()
  }

jobWorkerNames :: JobState -> Set JobWorkerId
jobWorkerNames JobState{..} = Set.map jobWorkerName $ Map.keysSet jobWorkers
