This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Jobs/Handler/StudyFeatures.hs
2021-06-28 09:21:34 +02:00

46 lines
1.7 KiB
Haskell

module Jobs.Handler.StudyFeatures
( dispatchJobStudyFeaturesCacheRelevance
, dispatchJobStudyFeaturesRecacheRelevance
) where
import Import
import Handler.Utils.StudyFeatures
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import qualified Data.Map.Strict as Map
import System.IO.Unsafe
import Jobs.Handler.Intervals.Utils
import qualified Data.UUID as UUID
dispatchJobStudyFeaturesCacheRelevance :: JobHandler UniWorX
dispatchJobStudyFeaturesCacheRelevance = JobHandlerAtomic $
cacheStudyFeatureRelevance $ \studyFeatures -> E.isNothing $ studyFeatures E.^. StudyFeaturesRelevanceCached
{-# NOINLINE studyFeaturesRecacheRelevanceIntervalsCache #-}
studyFeaturesRecacheRelevanceIntervalsCache :: TVar (Map Natural [(Maybe UUID, Maybe UUID)])
studyFeaturesRecacheRelevanceIntervalsCache = unsafePerformIO $ newTVarIO Map.empty
dispatchJobStudyFeaturesRecacheRelevance :: Natural -> Natural -> Natural -> JobHandler UniWorX
dispatchJobStudyFeaturesRecacheRelevance numIterations epoch iteration = JobHandlerAtomic $ do
(minBoundUUID, maxBoundUUID) <- currentIntervalCached studyFeaturesRecacheRelevanceIntervalsCache 16 (UUID.fromByteString . fromStrict) numIterations epoch iteration
let
uuidFilter :: E.SqlExpr (E.Value (Maybe UUID)) -> E.SqlExpr (E.Value Bool)
uuidFilter cRef = E.and $ catMaybes
[ pure $ E.isJust cRef
, minBoundUUID <&> \b -> cRef E.>=. E.justVal b
, maxBoundUUID <&> \b -> cRef E.<. E.justVal b
]
$logDebugS "StudyFeaturesRecacheRelevance" . tshow $ (minBoundUUID, maxBoundUUID)
cacheStudyFeatureRelevance $ \studyFeatures -> uuidFilter $ studyFeatures E.^. StudyFeaturesRelevanceCached