mirror of
https://github.com/facebook/Haxl.git
synced 2024-10-04 06:07:32 +03:00
c1c789a71f
Reviewed By: mic47, niteria Differential Revision: D6519157 fbshipit-source-id: 7fd977837bb7dd8463d697d685107aaf07c95255
94 lines
2.7 KiB
Haskell
94 lines
2.7 KiB
Haskell
-- Copyright (c) 2014-present, Facebook, Inc.
|
|
-- All rights reserved.
|
|
--
|
|
-- This source code is distributed under the terms of a BSD license,
|
|
-- found in the LICENSE file.
|
|
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE StandaloneDeriving #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
-- | A data source that can be made to fail in various ways, for testing
|
|
|
|
module BadDataSource (
|
|
-- * initialise the state
|
|
State(..), initGlobalState,
|
|
|
|
-- * requests for this data source
|
|
FailAfter(..),
|
|
) where
|
|
|
|
import Haxl.Prelude
|
|
import Prelude ()
|
|
|
|
import Haxl.Core
|
|
|
|
import Control.Exception
|
|
import Data.Typeable
|
|
import Data.Hashable
|
|
import Control.Concurrent
|
|
|
|
data FailAfter a where
|
|
FailAfter :: Int -> FailAfter Int
|
|
deriving Typeable
|
|
|
|
deriving instance Eq (FailAfter a)
|
|
deriving instance Show (FailAfter a)
|
|
instance ShowP FailAfter where showp = show
|
|
|
|
instance Hashable (FailAfter a) where
|
|
hashWithSalt s (FailAfter a) = hashWithSalt s (0::Int,a)
|
|
|
|
instance StateKey FailAfter where
|
|
data State FailAfter = FailAfterState
|
|
{ failAcquireDelay :: Int
|
|
, failAcquire :: IO ()
|
|
, failReleaseDelay :: Int
|
|
, failRelease :: IO ()
|
|
, failDispatchDelay :: Int
|
|
, failDispatch :: IO ()
|
|
, failWaitDelay :: Int
|
|
, failWait :: IO ()
|
|
}
|
|
|
|
instance DataSourceName FailAfter where
|
|
dataSourceName _ = "BadDataSource"
|
|
|
|
instance DataSource u FailAfter where
|
|
-- I'll define exampleFetch below
|
|
fetch state@FailAfterState{..} = asyncFetchAcquireRelease
|
|
(do threadDelay failAcquireDelay; failAcquire)
|
|
(\_ -> do threadDelay failReleaseDelay; failRelease)
|
|
(\_ -> do threadDelay failDispatchDelay; failDispatch)
|
|
(\_ -> do threadDelay failWaitDelay; failWait)
|
|
submit state
|
|
where
|
|
submit :: () -> FailAfter a -> IO (IO (Either SomeException a))
|
|
submit _ (FailAfter t) = do
|
|
threadDelay t
|
|
return (return (Left (toException (FetchError "failed request"))))
|
|
|
|
-- Every data source should define a function 'initGlobalState' that
|
|
-- initialises the state for that data source. The arguments to this
|
|
-- function might vary depending on the data source - we might need to
|
|
-- pass in resources from the environment, or parameters to set up the
|
|
-- data source.
|
|
initGlobalState :: IO (State FailAfter)
|
|
initGlobalState = do
|
|
return FailAfterState
|
|
{ failAcquireDelay = 0
|
|
, failAcquire = return ()
|
|
, failReleaseDelay = 0
|
|
, failRelease = return ()
|
|
, failDispatchDelay = 0
|
|
, failDispatch = return ()
|
|
, failWaitDelay = 0
|
|
, failWait = return ()
|
|
}
|