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

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

import Handler.Utils.StudyFeatures.Parse

import qualified Data.Csv as Csv

import qualified Data.ByteString as ByteString

import qualified Data.Set as Set

import Data.RFC5051 (compareUnicode)

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


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

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

newtype UserTableStudyFeatures = UserTableStudyFeatures (Set UserTableStudyFeature)
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  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 = ByteString.intercalate "; " . map Csv.toField . view _UserTableStudyFeatures

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


isRelevantStudyFeature :: PersistEntity record
                       => EntityField record TermId
                       -> E.SqlExpr (Entity record)
                       -> E.SqlExpr (Entity StudyFeatures)
                       -> E.SqlExpr (E.Value Bool)
isRelevantStudyFeature 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.||. ( E.subSelectForeign record termField (E.^. TermActive)
          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.bool calcNow useCache $ studyFeatures E.^. StudyFeaturesRelevanceCached
  where
    useCache
      = E.exists . E.from $ \relevantStudyFeatures ->
          E.where_ $ relevantStudyFeatures E.^. RelevantStudyFeaturesTerm E.==. record E.^. termField
               E.&&. relevantStudyFeatures E.^. RelevantStudyFeaturesStudyFeatures E.==. studyFeatures E.^. StudyFeaturesId
    calcNow = isRelevantStudyFeature termField record studyFeatures

cacheStudyFeatureRelevance :: MonadIO m
                           => (E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool))
                           -> SqlPersistT m ()
cacheStudyFeatureRelevance fFilter = do
  E.insertSelectWithConflict UniqueRelevantStudyFeatures
    ( E.from $ \(studyFeatures `E.InnerJoin` term) -> do
        E.on E.true
        E.where_ $ fFilter studyFeatures
        E.where_ $ isRelevantStudyFeature TermId term studyFeatures
        return $ RelevantStudyFeatures E.<# (term E.^. TermId) E.<&> (studyFeatures E.^. StudyFeaturesId)
    )
    ( \_current _excluded -> [] )
  E.update $ \studyFeatures -> do
    E.set studyFeatures [ StudyFeaturesRelevanceCached E.=. E.true ]
    E.where_ $ fFilter studyFeatures

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


isAllocationStudyFeature :: E.SqlExpr (Entity Allocation) -> E.SqlExpr (Entity StudyFeatures) -> E.SqlExpr (E.Value Bool)
isAllocationStudyFeature = isRelevantStudyFeatureCached AllocationTerm
  
allocationUserStudyFeatures :: MonadIO m => AllocationId -> UserId -> SqlPersistT m UserTableStudyFeatures
allocationUserStudyFeatures aId uid = do
  feats <- E.select . E.from $ \(allocation `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 $ isAllocationStudyFeature allocation studyFeatures
    E.where_ $ allocation E.^. AllocationId E.==. E.val aId
    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
      }