Haxl/tests/SleepDataSource.hs
Simon Marlow b67f7f6370 Haxl 2
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
2017-10-03 00:28:54 -07:00

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)