-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Utils.Course.Cache where

import Import

import Handler.Utils
-- import Handler.Utils.Occurrences
import Handler.Exam.Form (ExamOccurrenceForm(..))

import qualified Data.Set as Set
import qualified Data.Map as Map
-- import qualified Data.Aeson  as Aeson


-- import Database.Persist.Sql (updateWhereCount)
import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E
import qualified Database.Esqueleto.Utils as E
-- import           Database.Esqueleto.PostgreSQL.JSON ((@>.))
-- import qualified Database.Esqueleto.PostgreSQL.JSON as E hiding ((?.))



--   partial JSON object to be used for filtering with "@>"
--   ensure that a GIN index for the jsonb column is created in Model.Migration.Definitions
-- occurrenceDayValue :: Day -> Value
-- occurrenceDayValue d = Aeson.object
--   [ "exceptions" Aeson..=
--     [ Aeson.object
--       [ "exception" Aeson..= ("occur"::Text)
--       , "day"       Aeson..= d
--   ] ] ]

{- More efficient DB-only version, but ignores regular schedules
getDayTutorials :: SchoolId -> Day -> DB [TutorialId]
getDayTutorials ssh d = E.unValue <<$>> E.select (do
    (trm :& crs :& tut) <- E.from $ E.table @Term
      `E.innerJoin` E.table @Course   `E.on` (\(trm :& crs)      -> crs E.^. CourseTerm E.==. trm E.^. TermId)
      `E.innerJoin` E.table @Tutorial `E.on` (\(_ :& crs :& tut) -> crs E.^. CourseId   E.==. tut E.^. TutorialCourse)
    E.where_ $ E.between (E.val d) (trm E.^. TermStart, trm E.^. TermEnd)
        E.&&.  crs E.^. CourseSchool E.==. E.val ssh
        E.&&. (E.just (tut E.^. TutorialTime) @>. E.jsonbVal (occurrenceDayValue d))
    return $ tut E.^. TutorialId
  )
-}

-- | Datatype to be used as key for memcaching DayTask related stuff; note that newtype-CacheKeys are optimized away, so multiple constructors are advisable
data CourseCacheKeys
  = CacheKeyTutorialOccurrences  SchoolId (Day,Day)                   -- ^ Map TutorialId (TutorialName, [LessonTime])
  | CacheKeyExamOccurrences      SchoolId (Day,Day) (Maybe CourseId)  -- ^ Map ExamOccurrenceId (CourseId, ExamName, ExamOccurrence)
  | CacheKeySuggsParticipantNote SchoolId TutorialId
  | CacheKeySuggsAttendanceNote  SchoolId TutorialId
  | CacheKeyTutorialCheckResults SchoolId Day
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (Hashable, Binary, NFData)

-- getDayTutorials :: SchoolId -> (Day,Day) -> DB [TutorialId]
-- getDayTutorials ssh dlimit@(dstart, dend )
--   | dstart > dend = return mempty
--   | otherwise = memcachedByClass MemcachedKeyClassTutorialOccurrences (Just . Right $ 12 * diffDay) (CacheKeyTutorialOccurrences ssh dlimit) $ do  -- same key is ok, distinguished by return type
--     candidates <- E.select $ do
--       (trm :& crs :& tut) <- E.from $ E.table @Term
--           `E.innerJoin` E.table @Course   `E.on` (\(trm :& crs)      -> crs E.^. CourseTerm E.==. trm E.^. TermId)
--           `E.innerJoin` E.table @Tutorial `E.on` (\(_ :& crs :& tut) -> crs E.^. CourseId   E.==. tut E.^. TutorialCourse)
--       E.where_ $ crs E.^. CourseSchool E.==. E.val ssh
--           E.&&.  trm E.^. TermStart    E.<=. E.val dend
--           E.&&.  trm E.^. TermEnd      E.>=. E.val dstart
--       return (trm, tut, E.just (tut E.^. TutorialTime) @>. E.jsonbVal (occurrenceDayValue dstart))
--     -- logErrorS "DAILY" $ foldMap (\(Entity{entityVal=someTerm},Entity{entityVal=Tutorial{..}},_) -> tshow someTerm <> " *** " <> ciOriginal tutorialName <> ": " <> tshow (unJSONB tutorialTime)) candidates
--     return $ mapMaybe checkCandidate candidates
--   where
--     period = Set.fromAscList [dstart..dend]

--     checkCandidate (_, Entity{entityKey=tutId}, E.unValue -> True) = Just tutId -- most common case
--     checkCandidate (Entity{entityVal=trm}, Entity{entityKey=tutId, entityVal=Tutorial{tutorialTime=JSONB occ}}, _)
--       | not $ Set.null $ Set.intersection period $ occurrencesCompute' trm occ
--         = Just tutId
--       | otherwise
--         = Nothing

-- | like the previous version above, but also returns the lessons occurring within the given time frame
--   Due to caching, we only use the more informative version, unless experiments with the full DB show otherwise
getDayTutorials :: SchoolId -> (Day,Day) -> DB (Map TutorialId (TutorialName, [LessonTime]))
getDayTutorials ssh dlimit@(dstart, dend )
  | dstart > dend = return mempty
  | otherwise = memcachedByClass MemcachedKeyClassTutorialOccurrences (Just . Right $ 12 * diffDay) (CacheKeyTutorialOccurrences ssh dlimit) $ do
    candidates <- E.select $ do
      (trm :& crs :& tut) <- E.from $ E.table @Term
          `E.innerJoin` E.table @Course   `E.on` (\(trm :& crs)      -> crs E.^. CourseTerm E.==. trm E.^. TermId)
          `E.innerJoin` E.table @Tutorial `E.on` (\(_ :& crs :& tut) -> crs E.^. CourseId   E.==. tut E.^. TutorialCourse)
      E.where_ $ crs E.^. CourseSchool E.==. E.val ssh
          E.&&.  trm E.^. TermStart    E.<=. E.val dend
          E.&&.  trm E.^. TermEnd      E.>=. E.val dstart
      return (trm, tut)
    -- logErrorS "DAILY" $ foldMap (\(Entity{entityVal=someTerm},Entity{entityVal=Tutorial{..}},_) -> tshow someTerm <> " *** " <> ciOriginal tutorialName <> ": " <> tshow (unJSONB tutorialTime)) candidates
    return $ foldMap checkCandidate candidates
  where
    checkCandidate :: (Entity Term, Entity Tutorial) -> Map TutorialId (TutorialName, [LessonTime])
    checkCandidate (Entity{entityVal=trm}, Entity{entityKey=tutId, entityVal=Tutorial{tutorialTime=JSONB occ, tutorialName=tName}})
      | let lessons = Set.filter lessonFltr $ occurringLessons trm occ
      , notNull lessons
        = Map.singleton tutId (tName , Set.toAscList lessons) -- due to Set not having a Functor instance, we need mostly need lists anyway
      | otherwise
        = mempty

    lessonFltr :: LessonTime -> Bool
    lessonFltr LessonTime{..} = dstart <= localDay lessonStart
                            &&  dend   >= localDay lessonEnd

--  -- retrieve all exam occurrences for a school for a term in a given time period; uses caching
-- getDayExamOccurrences :: SchoolId -> (Day,Day) -> DB (Map ExamOccurrenceId (CourseId, ExamName, ExamOccurrence))
-- getDayExamOccurrences ssh dlimit@(dstart, dend )
--   | dstart > dend = return mempty
--   | otherwise = memcachedByClass MemcachedKeyClassExamOccurrences (Just . Right $ 12 * diffDay) (CacheKeyExamOccurrences ssh dlimit) $ do
--     candidates <- E.select $ do
--       (trm :& crs :& exm :& occ) <- E.from $ E.table @Term
--           `E.innerJoin` E.table @Course          `E.on` (\(trm :& crs)             -> crs E.^. CourseTerm E.==. trm E.^. TermId)
--           `E.innerJoin` E.table @Exam            `E.on` (\(_ :& crs :& exm)        -> crs E.^. CourseId   E.==. exm E.^. ExamCourse)
--           `E.innerJoin` E.table @ExamOccurrence  `E.on` (\(_ :& _   :& exm :& occ) -> exm E.^. ExamId     E.==. occ E.^. ExamOccurrenceExam)
--       E.where_ $ E.val     ssh    E.==. crs E.^. CourseSchool
--         E.&&.    E.val     dstart E.<=. trm E.^. TermEnd
--         E.&&.    E.val     dend   E.>=. trm E.^. TermStart
--         E.&&. ( E.between (E.day      $ occ E.^. ExamOccurrenceStart) (E.val     dstart, E.val     dend)
--           E.||. E.between (E.dayMaybe $ occ E.^. ExamOccurrenceEnd)   (E.justVal dstart, E.justVal dend)
--           )
--       return (exm, occ)
--     return $ foldMap mkOccMap candidates
--   where
--     mkOccMap :: (Entity Exam, Entity ExamOccurrence) -> Map ExamOccurrenceId (CourseId, ExamName, ExamOccurrence)
--     mkOccMap (entityVal -> exm, Entity{..}) = Map.singleton entityKey (exm ^. _examCourse, exm ^. _examName, entityVal)

type ExamOccurrenceMap = Map ExamOccurrenceId (ExamOccurrence, CryptoUUIDExamOccurrence, (ExamId, ExamName))
type ExamToOccurrencesMap  = Map ExamId (Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm)

-- | retrieve all exam occurrences for a school in a given time period, ignoring term times; uses caching
--   if a CourseId is specified, only exams from that course are returned
getDayExamOccurrences :: Bool -> SchoolId -> Maybe CourseId -> (Day,Day) -> DB ExamOccurrenceMap
getDayExamOccurrences onlyOpen ssh mbcid dlimit@(dstart, dend)
  | dstart > dend = return mempty
  | otherwise = memcachedByClass MemcachedKeyClassExamOccurrences (Just . Right $ 12 * diffDay) (CacheKeyExamOccurrences ssh dlimit mbcid) $ do
    now <- liftIO getCurrentTime
    candidates <- E.select $ do
      (crs :& exm :& occ) <- E.from $ E.table @Course
          `E.innerJoin` E.table @Exam            `E.on` (\(crs :& exm)        -> crs E.^. CourseId   E.==. exm E.^. ExamCourse)
          `E.innerJoin` E.table @ExamOccurrence  `E.on` (\(_   :& exm :& occ) -> exm E.^. ExamId     E.==. occ E.^. ExamOccurrenceExam)
      E.where_ $ E.and $ catMaybes
        [ toMaybe onlyOpen $ E.justVal now E.>=. exm E.^. ExamRegisterFrom -- fail on null
                      E.&&.  E.val     now E.<~. exm E.^. ExamRegisterTo   -- success on null
        , mbcid <&> ((E.==. (crs E.^. CourseId)) . E.val)
        , Just $ crs E.^. CourseSchool E.==. E.val ssh
        , Just $ E.withinPeriod dlimit (occ E.^. ExamOccurrenceStart) (occ E.^. ExamOccurrenceEnd)
        ]
      -- E.orderBy [E.asc $ exm E.^. ExamName] -- we return a map, so the order does not matter
      return (occ, exm E.^. ExamId, exm E.^. ExamName) -- No Binary instance for Entity Exam, so we only extract what is needed for now
    foldMapM mkOccMap candidates
  where
    mkOccMap :: (Entity ExamOccurrence, E.Value ExamId, E.Value ExamName) -> DB ExamOccurrenceMap
    mkOccMap (Entity{..}, E.Value eId, E.Value eName) = encrypt entityKey <&> (\ceoId -> Map.singleton entityKey (entityVal, ceoId, (eId, eName)))

mkExamOccurrenceOptions :: ExamOccurrenceMap -> OptionList ExamOccurrenceId
mkExamOccurrenceOptions = mkOptionListGrouped . map (over _2 $ sortBy (compare `on` optionDisplay)) . groupSort . map mkEOOption . Map.toList
  where
    mkEOOption :: (ExamOccurrenceId, (ExamOccurrence, CryptoUUIDExamOccurrence, (ExamId, ExamName))) -> (Text, [Option ExamOccurrenceId])
    mkEOOption (eid, (ExamOccurrence{examOccurrenceName}, ceoId, (_,eName))) = (ciOriginal eName, [Option{..}])
      where
        optionDisplay       = ciOriginal examOccurrenceName
        optionExternalValue = toPathPiece ceoId
        optionInternalValue = eid

convertExamOccurrenceMap :: ExamOccurrenceMap -> ExamToOccurrencesMap
convertExamOccurrenceMap eom = Map.fromListWith (<>) $ map aux $ Map.toList eom
  where
    aux :: (ExamOccurrenceId, (ExamOccurrence, CryptoUUIDExamOccurrence, (ExamId, ExamName))) -> (ExamId, (Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm))
    aux (_, (ExamOccurrence{..}, cueoId, (eid,_))) = (eid, (Set.singleton cueoId, Set.singleton ExamOccurrenceForm
            { eofId          = Just cueoId
            , eofName        = Just examOccurrenceName
            , eofExaminer    = examOccurrenceExaminer
            , eofRoom        = examOccurrenceRoom
            , eofRoomHidden  = examOccurrenceRoomHidden
            , eofCapacity    = examOccurrenceCapacity
            , eofStart       = examOccurrenceStart
            , eofEnd         = examOccurrenceEnd
            , eofDescription = examOccurrenceDescription
            }
          ))