mirror of
https://github.com/facebook/Haxl.git
synced 2024-12-23 16:53:02 +03:00
dfd8a4655e
Summary: Test that the ApplicativeDo extension batches things correctly in the Haxl monad. Test Plan: beholdunittests Reviewed By: bnitka@fb.com Subscribers: ldbrandy, memo, watashi, smarlow, akr, bnitka, jcoens FB internal diff: D2039149 Tasks: 5504687 Signature: t1:2039149:1430501733:98fd1cf0f69663d6db3b07c3aed6e261ae9884d6
68 lines
1.4 KiB
Haskell
68 lines
1.4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module TestUtils
|
|
( makeTestEnv
|
|
, expectRoundsWithEnv
|
|
, expectRounds
|
|
, expectFetches
|
|
, testinput
|
|
, id1, id2, id3, id4
|
|
) where
|
|
|
|
import TestTypes
|
|
import MockTAO
|
|
|
|
import Data.IORef
|
|
import Data.Aeson
|
|
import Test.HUnit
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
|
|
import Haxl.Core
|
|
|
|
import Prelude()
|
|
import Haxl.Prelude
|
|
|
|
testinput :: Object
|
|
testinput = HashMap.fromList [
|
|
"A" .= (1 :: Int),
|
|
"B" .= (2 :: Int),
|
|
"C" .= (3 :: Int),
|
|
"D" .= (4 :: Int) ]
|
|
|
|
id1 :: Haxl Id
|
|
id1 = lookupInput "A"
|
|
|
|
id2 :: Haxl Id
|
|
id2 = lookupInput "B"
|
|
|
|
id3 :: Haxl Id
|
|
id3 = lookupInput "C"
|
|
|
|
id4 :: Haxl Id
|
|
id4 = lookupInput "D"
|
|
|
|
makeTestEnv :: IO (Env UserEnv)
|
|
makeTestEnv = do
|
|
tao <- MockTAO.initGlobalState
|
|
let st = stateSet tao stateEmpty
|
|
initEnv st testinput
|
|
|
|
expectRoundsWithEnv
|
|
:: (Eq a, Show a) => Int -> a -> Haxl a -> Env UserEnv -> Assertion
|
|
expectRoundsWithEnv n result haxl env = do
|
|
a <- runHaxl env haxl
|
|
assertEqual "result" result a
|
|
stats <- readIORef (statsRef env)
|
|
assertEqual "rounds" n (numRounds stats)
|
|
|
|
expectRounds :: (Eq a, Show a) => Int -> a -> Haxl a -> Assertion
|
|
expectRounds n result haxl = do
|
|
env <- makeTestEnv
|
|
expectRoundsWithEnv n result haxl env
|
|
|
|
expectFetches :: (Eq a, Show a) => Int -> Haxl a -> Assertion
|
|
expectFetches n haxl = do
|
|
env <- makeTestEnv
|
|
_ <- runHaxl env haxl
|
|
stats <- readIORef (statsRef env)
|
|
assertEqual "fetches" n (numFetches stats)
|