mirror of
https://github.com/facebook/Haxl.git
synced 2024-12-24 17:23:03 +03:00
b67f7f6370
Summary: This is a complete reworking of the way that Haxl schedules I/O. The main benefits are: * Data fetches are no longer organised into rounds, but can be arbitrarily overlapped with each other and with computation. The scheduler supports an arbitrary queue of work items which it can evaluate while data-fetching is taking place in the background. To take advantage of this, data sources must implement a new form of `PerformFetch`, namely `BackgroundFetch`. The old forms of `PerformFetch` are still supported, but won't benefit from any additional concurrency. * It is now possible to specify on a per-data-source basis whether fetching should be optimised for batching or for latency. A request to a data source that doesn't benefit from batching can be submitted immediately. This is done with the new `schedulerHint` method of `DataSource`. Reviewed By: niteria Differential Revision: D4938005 fbshipit-source-id: 96f12ad05ee62d62474ee4cc1215f19d0a6fcdf3
60 lines
1.5 KiB
Haskell
60 lines
1.5 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE StandaloneDeriving #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
module SleepDataSource (
|
|
-- * initialise the state
|
|
initGlobalState,
|
|
|
|
-- * requests for this data source
|
|
SleepReq(..),
|
|
sleep,
|
|
) where
|
|
|
|
import Haxl.Prelude
|
|
import Prelude ()
|
|
|
|
import Haxl.Core
|
|
|
|
import Control.Monad hiding (mapM_)
|
|
import Data.Typeable
|
|
import Data.Hashable
|
|
import Control.Concurrent
|
|
|
|
sleep :: Int -> GenHaxl u Int
|
|
sleep n = dataFetch (Sleep n)
|
|
|
|
data SleepReq a where
|
|
Sleep :: Int -> SleepReq Int
|
|
deriving Typeable -- requests must be Typeable
|
|
|
|
deriving instance Eq (SleepReq a)
|
|
deriving instance Show (SleepReq a)
|
|
|
|
instance ShowP SleepReq where showp = show
|
|
|
|
instance Hashable (SleepReq a) where
|
|
hashWithSalt s (Sleep n) = hashWithSalt s n
|
|
|
|
instance StateKey SleepReq where
|
|
data State SleepReq = ExampleState {}
|
|
|
|
instance DataSourceName SleepReq where
|
|
dataSourceName _ = "SleepDataSource"
|
|
|
|
instance DataSource u SleepReq where
|
|
fetch _state _flags _user = BackgroundFetch $ mapM_ fetch1
|
|
schedulerHint _ = SubmitImmediately
|
|
|
|
initGlobalState :: IO (State SleepReq)
|
|
initGlobalState = return ExampleState { }
|
|
|
|
fetch1 :: BlockedFetch SleepReq -> IO ()
|
|
fetch1 (BlockedFetch (Sleep n) rvar) =
|
|
void $ forkFinally (threadDelay (n*1000) >> return n) (putResult rvar)
|