-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later


module Handler.Utils.Qualification
  ( module Handler.Utils.Qualification
  ) where

import Import

-- import Data.Time.Calendar (CalendarDiffDays(..))
import qualified Database.Esqueleto.Experimental as E   -- might need TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Utils as E



------------------
-- SQL Snippets --
------------------

-- TODO: consider replacing `nowaday` by `Database.Esqueleto.PostgreSQL.now_` or better `day(now_)` cast as date
validQualification :: Day -> E.SqlExpr (Entity QualificationUser) -> E.SqlExpr (E.Value Bool)
validQualification nowaday = \qualUser ->
  (E.val nowaday `E.between` (qualUser E.^. QualificationUserFirstHeld
                             ,qualUser E.^. QualificationUserValidUntil))   -- currently valid
           E.&&. E.isNothing (qualUser E.^. QualificationUserBlockedDue)    -- not blocked            

validQualification' :: Day -> E.SqlExpr (Maybe (Entity QualificationUser)) -> E.SqlExpr (E.Value Bool)
validQualification' nowaday qualUser =
  (E.justVal nowaday `E.between` (qualUser E.?. QualificationUserFirstHeld
                                 ,qualUser E.?. QualificationUserValidUntil))   -- currently valid
     E.&&. E.isNothing (E.joinV $ qualUser E.?. QualificationUserBlockedDue)    -- not blocked            


selectValidQualifications :: QualificationId -> Maybe [UserId] -> Day -> DB [Entity QualificationUser]
selectValidQualifications qid mbUids nowaday = 
  -- nowaday <- utctDay <$> liftIO getCurrentTime
  E.select $ do 
    qUser <- E.from $ E.table @QualificationUser
    E.where_ $  (qUser E.^. QualificationUserQualification E.==. E.val qid)
          E.&&. validQualification nowaday qUser
          E.&&. maybe E.true (\uids -> qUser E.^. QualificationUserUser `E.in_` E.valList uids) mbUids
    pure qUser


------------------------
-- Complete Functions --
------------------------


upsertQualificationUser :: QualificationId -> Day -> Day -> Maybe Bool -> UserId -> DB ()
upsertQualificationUser  qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do
  Entity quid _ <- upsert
    QualificationUser
      { qualificationUserFirstHeld        = qualificationUserLastRefresh
      , qualificationUserBlockedDue       = Nothing
      , qualificationUserScheduleRenewal  = fromMaybe True mbScheduleRenewal
      , ..
      }
    (
      [ QualificationUserScheduleRenewal    =. scheduleRenewal              | Just scheduleRenewal <- [mbScheduleRenewal]
      ] ++
      [ QualificationUserValidUntil         =. qualificationUserValidUntil
      , QualificationUserLastRefresh        =. qualificationUserLastRefresh
      , QualificationUserBlockedDue         =. Nothing
      ]
    )
  audit TransactionQualificationUserEdit
    { transactionQualificationUser            = quid
    , transactionQualification                = qualificationUserQualification
    , transactionUser                         = qualificationUserUser
    , transactionQualificationValidUntil      = qualificationUserValidUntil
    , transactionQualificationScheduleRenewal = mbScheduleRenewal
    }

renewValidQualificationUsers :: QualificationId -> [UserId] -> DB Int
renewValidQualificationUsers qid uids =
  -- This code works in principle, but it does not allow audit log entries.
  -- E.update $ \qu -> do
  --   E.set qu [ QualificationUserValidUntil E.+=. E.interval (CalendarDiffDays 2 0) ] -- TODO: for Testing only
  --   E.where_ $ (qu E.^. QualificationUserQualification E.==. E.val qid )
  --       E.&&.  (qu E.^. QualificationUserUser `E.in_` E.valList uids)
  get qid >>= \case     
    Just Qualification{qualificationValidDuration=Just renewalMonths} -> do
      nowaday <- utctDay <$> liftIO getCurrentTime
      quEntsAll <- selectValidQualifications qid (Just uids) nowaday     
      let maxValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) nowaday
          quEnts = filter (\q -> maxValidTo >= (q ^. _entityVal . _qualificationUserValidUntil)) quEntsAll
      forM_ quEnts $ \(Entity quId QualificationUser{..}) -> do 
        let newValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil        
        update quId [ QualificationUserValidUntil   =. newValidTo
                    , QualificationUserLastRefresh  =. nowaday
                    ]
        audit TransactionQualificationUserEdit
          { transactionQualificationUser            = quId
          , transactionQualification                = qualificationUserQualification
          , transactionUser                         = qualificationUserUser
          , transactionQualificationValidUntil      = newValidTo
          , transactionQualificationScheduleRenewal = Nothing
          }
      return $ length quEnts
    _ -> return (-1) -- qualificationId not found, isNothing qualificationValidDuration, etc.