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

Author: Pepe Iborra

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
 

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 ->