-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Utils.StudyFeatures
  ( UserTableStudyFeature(..)
  , _userTableField, _userTableDegree, _userTableSemester, _userTableFieldType
  , UserTableStudyFeatures(..)
  , _UserTableStudyFeatures
  , isRelevantStudyFeature, isRelevantStudyFeatureCached
  , cacheStudyFeatureRelevance
  , isCourseStudyFeature, courseUserStudyFeatures
  , isExternalExamStudyFeature, externalExamUserStudyFeatures
  , isTermStudyFeature
  ) where

import Import.NoFoundation
import Foundation.Type
import Foundation.I18n

import Utils.Term

import qualified Data.Csv as Csv

import qualified Data.Set as Set

import Data.RFC5051 (compareUnicode)

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

import qualified Data.Conduit.Combinators as C


data UserTableStudyFeature = UserTableStudyFeature
  { userTableField
  , userTableDegree    :: Text
  , userTableSemester  :: Int
  , userTableFieldType :: StudyFieldType
  } deriving (Eq, Ord, Read, Show, Generic)
makeLenses_ ''UserTableStudyFeature

deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 2
  } ''UserTableStudyFeature

newtype UserTableStudyFeatures = UserTableStudyFeatures (Set UserTableStudyFeature)
  deriving (Eq, Ord, Read, Show, Generic)
  deriving newtype ( ToJSON, FromJSON
                   , Semigroup, Monoid
                   )
makeWrapped ''UserTableStudyFeatures

_UserTableStudyFeatures :: Iso' UserTableStudyFeatures [UserTableStudyFeature]
_UserTableStudyFeatures = iso (sortBy userTableStudyFeatureSort . Set.toList . view _Wrapped) (UserTableStudyFeatures . Set.fromList)

instance Csv.ToField UserTableStudyFeature where
  toField UserTableStudyFeature{..} = encodeUtf8
    [st|#{userTableField} #{userTableDegree} (#{userTableFieldType'} #{tshow userTableSemester})|]
    where userTableFieldType' = renderMessage
            (error "Foundation inspected during renderMessage" :: UniWorX)
            [] $ ShortStudyFieldType userTableFieldType

instance Csv.ToField UserTableStudyFeatures where
  toField = Csv.toField . CsvSemicolonList . view _UserTableStudyFeatures

userTableStudyFeatureSort :: UserTableStudyFeature
                          -> UserTableStudyFeature
                          -> Ordering
userTableStudyFeatureSort = mconcat
  [ compareUnicode `on` userTableDegree
  , comparing userTableSemester
  , comparing userTableFieldType
  , compareUnicode `on` userTableField
  ]


isRelevantStudyFeature :: PersistEntity record
                       => E.SqlExpr (E.Value UTCTime)
                       -> EntityField record TermId
                       -> E.SqlExpr (Entity record)
                       -> E.SqlExpr (Entity StudyFeatures)
                       -> E.SqlExpr (E.Value Bool)
isRelevantStudyFeature now termField record studyFeatures
      = (       (       overlap studyFeatures E.>. E.val 0
                  E.||. (       E.just (studyFeatures E.^. StudyFeaturesLastObserved) E.==. studyFeatures E.^. StudyFeaturesFirstObserved
                          E.&&. termStart E.<=. E.day (studyFeatures E.^. StudyFeaturesLastObserved)
                          E.&&. E.day (studyFeatures E.^. StudyFeaturesLastObserved) E.<=. termEnd
                        )
                )
          E.&&. E.not_ (E.exists betterOverlap)
        )
  E.||. ( termIsActiveE now E.nothing (record E.^. termField)
          E.&&. E.not_ (E.exists anyOverlap)
          E.&&. studyFeatures E.^. StudyFeaturesValid
        )
  where termEnd = E.subSelectForeign record termField (E.^. TermEnd)
        termStart = E.subSelectForeign record termField (E.^. TermStart)

        overlap :: E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Int)
        overlap studyFeatures'
                     = E.min (E.day $ studyFeatures' E.^. StudyFeaturesLastObserved) termEnd
          `E.diffDays` E.maybe termStart (E.max termStart . E.day) (studyFeatures' E.^. StudyFeaturesFirstObserved)

        anyOverlap = E.from $ \studyFeatures' -> do
          E.where_ $ studyFeatures' E.^. StudyFeaturesUser E.==. studyFeatures E.^. StudyFeaturesUser
          E.where_ $ overlap studyFeatures' E.>. E.val 0

        betterOverlap = E.from $ \studyFeatures' -> do  
          E.where_ $ studyFeatures' E.^. StudyFeaturesUser E.==. studyFeatures E.^. StudyFeaturesUser
               E.&&. studyFeatures' E.^. StudyFeaturesDegree E.==. studyFeatures E.^. StudyFeaturesDegree
               E.&&. studyFeatures' E.^. StudyFeaturesField E.==. studyFeatures E.^. StudyFeaturesField
               E.&&. studyFeatures' E.^. StudyFeaturesSuperField `E.maybeEq` studyFeatures E.^. StudyFeaturesSuperField
               E.&&. studyFeatures' E.^. StudyFeaturesType E.==. studyFeatures E.^. StudyFeaturesType
          E.where_ $ E.abs (studyFeatures' E.^. StudyFeaturesSemester E.-. studyFeatures E.^. StudyFeaturesSemester) E.==. E.val 1
               E.&&. overlap studyFeatures' E.>. overlap studyFeatures

isRelevantStudyFeatureCached :: PersistEntity record
                              => EntityField record TermId
                              -> E.SqlExpr (Entity record)
                              -> E.SqlExpr (Entity StudyFeatures)
                              -> E.SqlExpr (E.Value Bool)
isRelevantStudyFeatureCached termField record studyFeatures
  = E.exists . E.from $ \relevantStudyFeatures ->
      E.where_ $ relevantStudyFeatures E.^. RelevantStudyFeaturesTerm E.==. record E.^. termField
           E.&&. relevantStudyFeatures E.^. RelevantStudyFeaturesStudyFeatures E.==. studyFeatures E.^. StudyFeaturesId

cacheStudyFeatureRelevance :: MonadResource m
                           => (E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool))
                           -> SqlPersistT m ()
cacheStudyFeatureRelevance fFilter = do
  now <- liftIO getCurrentTime

  E.insertSelectWithConflict UniqueRelevantStudyFeatures
    ( E.from $ \(studyFeatures `E.InnerJoin` term) -> do
        E.on E.true
        E.where_ $ fFilter studyFeatures
        E.where_ $ isRelevantStudyFeature (E.val now) TermId term studyFeatures
        return $ RelevantStudyFeatures E.<# (term E.^. TermId) E.<&> (studyFeatures E.^. StudyFeaturesId)
    )
    ( \_current _excluded -> [] )

  let getStudyFeatures = E.selectSource . E.from $ \studyFeatures -> do
        E.where_ $ fFilter studyFeatures
        E.where_ . E.isNothing $ studyFeatures E.^. StudyFeaturesRelevanceCached
        return $ studyFeatures E.^. StudyFeaturesId
      migrateStudyFeatures genUUID lift' (E.Value sfId) = do
        uuid <- genUUID
        lift' $ update sfId [ StudyFeaturesRelevanceCached =. Just uuid ]
   in runConduit $ getStudyFeatures .| randUUIDC (\genUUID lift' -> C.mapM_ $ migrateStudyFeatures genUUID lift')

isCourseStudyFeature :: E.SqlExpr (Entity Course) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
isCourseStudyFeature = isRelevantStudyFeatureCached CourseTerm

courseUserStudyFeatures :: MonadIO m => CourseId -> UserId -> SqlPersistT m UserTableStudyFeatures
courseUserStudyFeatures cId uid = do
  feats <- E.select . E.from $ \(course `E.InnerJoin` studyFeatures `E.InnerJoin` terms `E.InnerJoin` degree) -> do
    E.on $ degree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
    E.on $ terms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
    E.on $ isCourseStudyFeature course studyFeatures
    E.where_ $ course E.^. CourseId E.==. E.val cId
    E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
    return (terms, degree, studyFeatures)
  return . UserTableStudyFeatures . Set.fromList . flip map feats $
    \(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) -> UserTableStudyFeature
      { userTableField = fromMaybe (tshow studyTermsKey) studyTermsName
      , userTableDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName
      , userTableSemester = studyFeaturesSemester
      , userTableFieldType = studyFeaturesType
      }

isExternalExamStudyFeature :: E.SqlExpr (Entity ExternalExam) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
isExternalExamStudyFeature = isRelevantStudyFeatureCached ExternalExamTerm

externalExamUserStudyFeatures :: MonadIO m => ExternalExamId -> UserId -> SqlPersistT m UserTableStudyFeatures
externalExamUserStudyFeatures eeId uid = do
  feats <- E.select . E.from $ \(externalExam `E.InnerJoin` studyFeatures `E.InnerJoin` terms `E.InnerJoin` degree) -> do
    E.on $ degree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree
    E.on $ terms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField
    E.on $ isExternalExamStudyFeature externalExam studyFeatures
    E.where_ $ externalExam E.^. ExternalExamId E.==. E.val eeId
    E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
    return (terms, degree, studyFeatures)
  return . UserTableStudyFeatures . Set.fromList . flip map feats $
    \(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) -> UserTableStudyFeature
      { userTableField = fromMaybe (tshow studyTermsKey) studyTermsName
      , userTableDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName
      , userTableSemester = studyFeaturesSemester
      , userTableFieldType = studyFeaturesType
      }

isTermStudyFeature :: E.SqlExpr (Entity Term) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
isTermStudyFeature = isRelevantStudyFeatureCached TermId