haxl 0.4.0.0 → 0.4.0.1

raw patch · 6 files changed

+284/−1 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

haxl.cabal +6/−1
tests/AdoTests.hs +49/−0
tests/AllTests.hs +31/−0
tests/Bench.hs +56/−0
tests/MemoizationTests.hs +74/−0
tests/ProfileTests.hs +68/−0

haxl.cabal view

@@ -1,5 +1,5 @@ name:                haxl-version:             0.4.0.0+version:             0.4.0.1 synopsis:            A Haskell library for efficient, concurrent,                      and concise data access. homepage:            https://github.com/facebook/Haxl@@ -113,12 +113,17 @@     TestMain.hs    other-modules:+    AdoTests+    AllTests     BatchTests+    Bench     CoreTests     DataCacheTest     ExampleDataSource     LoadCache+    MemoizationTests     MockTAO+    ProfileTests     TestExampleDataSource     TestTypes     TestUtils

+ tests/AdoTests.hs view

@@ -0,0 +1,49 @@+{-# LANGUAGE RebindableSyntax, OverloadedStrings, ApplicativeDo #-}+module AdoTests (tests) where++import TestUtils+import MockTAO++import Control.Applicative+import Test.HUnit++import Prelude()+import Haxl.Prelude++-- -----------------------------------------------------------------------------++--+-- Test ApplicativeDo batching+--+ado1 = expectRounds 1 12 ado1_++ado1_ = do+  a <- friendsOf =<< id1+  b <- friendsOf =<< id2+  return (length (a ++ b))++ado2 = expectRounds 1 12 ado2_++ado2_ = do+  x <- id1+  a <- friendsOf x+  y <- id2+  b <- friendsOf y+  return (length (a ++ b))++ado3 = expectRounds 2 11 ado3_++ado3_ = do+  x <- id1+  a <- friendsOf x+  a' <- friendsOf =<< if null a then id3 else id4+  y <- id2+  b <- friendsOf y+  b' <- friendsOf  =<< if null b then id4 else id3+  return (length (a' ++ b'))++tests = TestList+  [ TestLabel "ado1" $ TestCase ado1+  , TestLabel "ado2" $ TestCase ado2+  , TestLabel "ado3" $ TestCase ado3+  ]

+ tests/AllTests.hs view

@@ -0,0 +1,31 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module AllTests (allTests) where++import TestExampleDataSource+import BatchTests+import CoreTests+import DataCacheTest+#ifdef HAVE_APPLICATIVEDO+import AdoTests+#endif+#if __GLASGOW_HASKELL__ >= 710+import ProfileTests+#endif+import MemoizationTests++import Test.HUnit++allTests :: Test+allTests = TestList+  [ TestLabel "ExampleDataSource" TestExampleDataSource.tests+  , TestLabel "BatchTests" BatchTests.tests+  , TestLabel "CoreTests" CoreTests.tests+  , TestLabel "DataCacheTests" DataCacheTest.tests+#ifdef HAVE_APPLICATIVEDO+  , TestLabel "AdoTests" AdoTests.tests+#endif+#if __GLASGOW_HASKELL__ >= 710+  , TestLabel "ProfileTests" ProfileTests.tests+#endif+  , TestLabel "MemoizationTests" MemoizationTests.tests+  ]

+ tests/Bench.hs view

@@ -0,0 +1,56 @@+{-# LANGUAGE RankNTypes, GADTs, BangPatterns, DeriveDataTypeable,+    StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind -fno-warn-type-defaults #-}++module Bench where++import Haxl.Core.DataCache as DataCache+import Haxl.Core.Types++import Prelude hiding (mapM)++import Data.Hashable+import Data.Time.Clock+import Data.Traversable+import Data.Typeable+import System.Environment+import Text.Printf++data TestReq a where+  ReqInt    :: {-# UNPACK #-} !Int -> TestReq Int+  ReqDouble :: {-# UNPACK #-} !Int -> TestReq Double+  ReqBool   :: {-# UNPACK #-} !Int -> TestReq Bool+  deriving Typeable++deriving instance Eq (TestReq a)+deriving instance Show (TestReq a)++instance Hashable (TestReq a) where+  hashWithSalt salt (ReqInt i) = hashWithSalt salt (0::Int, i)+  hashWithSalt salt (ReqDouble i) = hashWithSalt salt (1::Int, i)+  hashWithSalt salt (ReqBool i) = hashWithSalt salt (2::Int, i)++main = do+  [n] <- fmap (fmap read) getArgs+  t0 <- getCurrentTime+  let+     f 0  !cache = return cache+     f !n !cache = do+       m <- newResult 0+       f (n-1) (DataCache.insert (ReqInt n) m cache)+  --+  cache <- f n emptyDataCache+  let m = DataCache.lookup (ReqInt (n `div` 2)) cache+  print =<< mapM takeResult m+  t1 <- getCurrentTime+  printf "insert: %.2fs\n" (realToFrac (t1 `diffUTCTime` t0) :: Double)++  t0 <- getCurrentTime+  let+     f 0  !m = return m+     f !n !m = case DataCache.lookup (ReqInt n) cache of+                 Nothing -> f (n-1) m+                 Just _  -> f (n-1) (m+1)+  f n 0 >>= print+  t1 <- getCurrentTime+  printf "lookup: %.2fs\n" (realToFrac (t1 `diffUTCTime` t0) :: Double)

+ tests/MemoizationTests.hs view

@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+module MemoizationTests (tests) where++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative+#endif+import Data.IORef++import Test.HUnit++import Haxl.Core+import Haxl.Core.Monad++import ExampleDataSource++memoSoundness :: Test+memoSoundness = TestCase $ do+  iEnv <- do+    exState <- ExampleDataSource.initGlobalState+    initEnv (stateSet exState stateEmpty) ()++  unMemoizedWombats <- runHaxl iEnv $ listWombats 100++  (initialGet, subsequentGet) <- runHaxl iEnv $ do+    wombatsMemo <- newMemoWith (listWombats 100)+    let memoizedWombats = runMemo wombatsMemo++    initialGet <- memoizedWombats+    subsequentGet <- memoizedWombats++    return (initialGet, subsequentGet)++  assertBool "Memo Soundness 1" $ initialGet == unMemoizedWombats+  assertBool "Memo Soundness 2" $ subsequentGet == unMemoizedWombats++  let impure runCounterRef = unsafeLiftIO $ do+        modifyIORef runCounterRef succ+        readIORef runCounterRef++      initialRunCounter = 0 :: Int++  runCounterRef <- newIORef initialRunCounter++  (initialImpureGet, subsequentImpureGet) <- runHaxl iEnv $ do+    impureMemo <- newMemoWith (impure runCounterRef)+    let memoizedImpure = runMemo impureMemo++    initialImpureGet <- memoizedImpure+    subsequentImpureGet <- memoizedImpure++    return (initialImpureGet, subsequentImpureGet)++  assertBool "Memo Soundness 3" $ initialImpureGet == succ initialRunCounter+  assertBool "Memo Soundness 4" $ subsequentImpureGet == initialImpureGet++  let fMemoVal = 42 :: Int++  dependentResult <- runHaxl iEnv $ do+    fMemoRef <- newMemo+    gMemoRef <- newMemo++    let f = runMemo fMemoRef+        g = runMemo gMemoRef++    prepareMemo fMemoRef $ return fMemoVal+    prepareMemo gMemoRef $ succ <$> f++    a <- f+    b <- g+    return (a + b)++  assertBool "Memo Soundness 5" $ dependentResult == fMemoVal + succ fMemoVal++tests = TestList [TestLabel "Memo Soundness" memoSoundness]

+ tests/ProfileTests.hs view

@@ -0,0 +1,68 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module ProfileTests where++import Haxl.Prelude+import Data.List++import Haxl.Core+import Haxl.Core.Monad++import Test.HUnit++import Control.DeepSeq (force)+import Control.Exception (evaluate)+import Data.IORef+import qualified Data.HashMap.Strict as HashMap+import qualified Data.HashSet as HashSet++import TestUtils++mkProfilingEnv = do+  env <- makeTestEnv+  return env { flags = (flags env) { report = 4 } }++collectsdata :: Assertion+collectsdata = do+  env <- mkProfilingEnv+  _x <- runHaxl env $+          withLabel "bar" $+            withLabel "foo" $+              if length (intersect ["a"::Text, "b"] ["c"]) > 1+              then return 5+              else return (4::Int)+  profData <- profile <$> readIORef (profRef env)+  assertEqual "has data" 3 $ HashMap.size profData+  assertBool "foo allocates" $+    case profileAllocs <$> HashMap.lookup "foo" profData of+      Just x -> x > 0+      Nothing -> False+  assertEqual "bar does not allocate" (Just 0) $+    profileAllocs <$> HashMap.lookup "bar" profData+  assertEqual "foo's parent" (Just ["bar"]) $+    HashSet.toList . profileDeps <$> HashMap.lookup "foo" profData++exceptions :: Assertion+exceptions = do+  env <- mkProfilingEnv+  _x <- runHaxl env $+          withLabel "outer" $+            tryToHaxlException $ withLabel "inner" $+              unsafeLiftIO $ evaluate $ force (error "pure exception" :: Int)+  profData <- profile <$> readIORef (profRef env)+  assertBool "inner label not added" $+    not $ HashMap.member "inner" profData++  env2 <- mkProfilingEnv+  _x <- runHaxl env2 $+          withLabel "outer" $+            tryToHaxlException $ withLabel "inner" $+              throw $ NotFound "haxl exception"+  profData <- profile <$> readIORef (profRef env2)+  assertBool "inner label added" $+    HashMap.member "inner" profData++tests = TestList+  [ TestLabel "collectsdata" $ TestCase collectsdata+  , TestLabel "exceptions" $ TestCase exceptions+  ]