{-# LANGUAGE TypeApplications #-}

module Jobs.Handler.LMS 
  ( dispatchJobLmsResults
  , dispatchJobLmsUserlist
  ) where 

import Import    

-- import Jobs.Handler.Intervals.Utils
import qualified Database.Esqueleto.Experimental as E
--import qualified Database.Esqueleto.Legacy as E
-- import qualified Database.Esqueleto.PostgreSQL as E -- for insertSelect variant
import qualified Database.Esqueleto.Utils as E


dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX
dispatchJobLmsResults qid = JobHandlerAtomic act 
  where
    -- act :: YesodJobDB UniWorX ()
    act = hoist lift $ do
      now <- liftIO getCurrentTime
      {- Unfortunately, we cannot use insertSelect due to Haskell-Type changes and deletion of keys
      E.insertSelectWithConflict 
        (UniqueLmsUser $ error "insertSelectWithConflict inspected constraint") -- never executed, just a type hint
        (do 
          (luser E.:& lresult) <- 
            E.from $ E.table @LmsUser `E.innerJoin` E.table @LmsResult `E.on` (\(luser E.:& lresult) -> luser E.^. LmsUserIdent E.==. lresult E.^. LmsResultIdent 
                                                                                E.&&. luser E.^. LmsUserQualification E.==. lresult E.^. LmsResultQualification
                                                                              )          
          E.where_ $ lresult E.^. LmsResultQualification E.==. E.val qid
          return $ LmsUser E.<# E.val qid
                          E.<&> (luser   E.^. LmsUserUser)
                          E.<&> (luser   E.^. LmsUserIdent)
                          E.<&> (luser   E.^. LmsUserPin)
                          E.<&> (luser   E.^. LmsUserResetPin)
                          E.<&> (E.val $ (LmsSuccess . E.unValue) <$> (lresult E.^. LmsResultSuccess)) -- how to convert Day to LmsStatus here?
                          E.<&> (luser   E.^. LmsUserStarted)
                          E.<&> E.just (lresult E.^. LmsResultTimestamp)
                          E.<&> (luser   E.^. LmsUserEnded)
        )
        (\current _excluded ->
          [ LmsUserStatus E.=. current E.^. LmsUserStatus, LmsUserReceived E.=. current E.^. LmsUserReceived ] -- I believe this list could just be empty, since excluded is not uses?!
        )
      -- Unclear how to delete here
      -}
      -- result :: [(Entity LmsUser, Entity LmsResult)]
      results <- E.select $ do 
        (luser E.:& lresult) <- E.from $ 
            E.table @LmsUser `E.innerJoin` E.table @LmsResult 
            `E.on` (\(luser E.:& lresult) -> luser E.^. LmsUserIdent         E.==. lresult E.^. LmsResultIdent 
                                       E.&&. luser E.^. LmsUserQualification E.==. lresult E.^. LmsResultQualification)
        E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
          E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners
        return (luser, lresult)
      forM_ results $ \(Entity luid luser, Entity lrid lresult) -> do 
        -- three separate DB operations per result is not so nice. All within one transaction though.
        let lreceived = lmsResultTimestamp lresult 
            lstatus   = lmsResultSuccess   lresult & LmsSuccess
        -- always log success, since this is only transmitted once
        update luid [ LmsUserStatus   =. Just lstatus
                    , LmsUserReceived =. Just lreceived 
                    ]
        insert_ $ LmsAudit qid (lmsUserIdent luser) lstatus lreceived now
        delete lrid                   
      $logInfoS "LmsResult" [st|Processed ${tshow (length results)} LMS results|]

dispatchJobLmsUserlist :: QualificationId -> JobHandler UniWorX
dispatchJobLmsUserlist  qid = JobHandlerAtomic act 
  where
    -- act :: YesodJobDB UniWorX ()
    act = hoist lift $ do
      now <- liftIO getCurrentTime
      -- result :: [(Entity LmsUser, Entity LmsUserlist)]
      results <- E.select $ do 
        (luser E.:& lulist) <- E.from $ 
            E.table @LmsUser `E.leftJoin` E.table @LmsUserlist
            `E.on` (\(luser E.:& lulist) ->  luser E.^. LmsUserIdent         E.=?. lulist E.?. LmsUserlistIdent 
                                       E.&&. luser E.^. LmsUserQualification E.=?. lulist E.?. LmsUserlistQualification)
        E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
                  E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners
        return (luser, lulist)
      forM_ results $ \case 
        (Entity luid luser, Nothing) 
          | isJust    $ lmsUserReceived luser
          , isNothing $ lmsUserEnded    luser ->            
              update luid [LmsUserEnded =. Just now]
          | otherwise -> return () -- likely not yet started

        (Entity luid luser, Just (Entity lulid lulist)) -> do           
          let usrNoStat = isNothing $ lmsUserStatus luser
              lBlocked  = lmsUserlistFailed    lulist              
              updStatus = lBlocked && usrNoStat -- only update empty status to blocked
              lReceived = lmsUserlistTimestamp lulist
              lStatus   = LmsBlocked $ utctDay lReceived
          update luid $ [ LmsUserStatus   =. Just lStatus   | updStatus ]
                     <> [ LmsUserReceived =. Just lReceived ]
          when lBlocked . insert_ $ LmsAudit qid (lmsUserIdent luser) lStatus lReceived now -- always log blocked
          delete lulid

      $logInfoS "LmsUserlist" [st|Processed LMS Userlist with ${tshow (length results)} entries|]