scheduler hint with request

Summary: https://www.internalfb.com/diff/D57330122?dst_version_fbid=975275170917805&transaction_fbid=1863882647422768 Reviewed By: simonmar Differential Revision: D57379154 fbshipit-source-id: 77593417465cf6d34e0813abc2dffaa389ba1584
facebook · May 16, 2024 · 42b72a2 · 42b72a2
1 parent 6cd30c0
commit 42b72a2
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 1 deletion.
diff --git a/Haxl/Core/DataSource.hs b/Haxl/Core/DataSource.hs
@@ -107,6 +107,9 @@ class (DataSourceName req, StateKey req, ShowP req) => DataSource u req where
   schedulerHint :: u -> SchedulerHint req
   schedulerHint _ = TryToBatch
 
+  schedulerHintState :: Maybe (State req) -> u -> SchedulerHint req
+  schedulerHintState _ u = schedulerHint u
+
   classifyFailure :: u -> req a -> SomeException -> FailureClassification
   classifyFailure _ _ _ = StandardFailure
 

diff --git a/Haxl/Core/Fetch.hs b/Haxl/Core/Fetch.hs
@@ -264,7 +264,9 @@ dataFetchWithInsert showFn insertFn req =
         blockedFetch = BlockedFetch req rvar
         blockedFetchI = BlockedFetchInternal fid
         submitFetch = do
-          case schedulerHint userEnv :: SchedulerHint r of
+          let hint :: SchedulerHint r
+              hint = schedulerHintState (stateGet states) userEnv
+          case hint of
             SubmitImmediately ->
               performFetches env [BlockedFetches [blockedFetch] [blockedFetchI]]
             TryToBatch ->