mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 18:42:30 +03:00
e953efeb40
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7758 Co-authored-by: Tom Harding <6302310+i-am-tom@users.noreply.github.com> GitOrigin-RevId: 311f6c4a5c629c18a55d75a5d5a74f826078e86d
82 lines
2.9 KiB
Haskell
82 lines
2.9 KiB
Haskell
{-# LANGUAGE Arrows #-}
|
||
|
||
module Hasura.IncrementalSpec (spec) where
|
||
|
||
import Control.Arrow.Extended
|
||
import Data.HashMap.Strict qualified as M
|
||
import Data.HashSet qualified as S
|
||
import Hasura.Incremental qualified as Inc
|
||
import Hasura.Prelude
|
||
import Test.Hspec
|
||
|
||
spec :: Spec
|
||
spec = do
|
||
describe "cache" $ do
|
||
it "skips re-running rules if the input didn’t change" $ do
|
||
let add1 :: (MonadState Integer m) => m ()
|
||
add1 = modify' (+ 1)
|
||
|
||
rule = proc (a, b) -> do
|
||
Inc.cache $ arrM (\_ -> add1) -< a
|
||
Inc.cache $ arrM (\_ -> add1 *> add1) -< b
|
||
|
||
(result1, state1) <- runStateT (Inc.build rule (False, False)) 0
|
||
state1 `shouldBe` 3
|
||
(result2, state2) <- runStateT (Inc.rebuild result1 (True, False)) 0
|
||
state2 `shouldBe` 1
|
||
(_, state3) <- runStateT (Inc.rebuild result2 (True, True)) 0
|
||
state3 `shouldBe` 2
|
||
|
||
it "tracks dependencies within nested uses of cache across multiple executions" do
|
||
let rule ::
|
||
(MonadWriter String m, MonadIO m) =>
|
||
Inc.Rule m (Inc.InvalidationKey, Inc.InvalidationKey) ()
|
||
rule = proc (key1, key2) -> do
|
||
dep1 <- Inc.newDependency -< key2
|
||
(key1, dep1)
|
||
>-
|
||
Inc.cache
|
||
( proc (_, dep2) ->
|
||
dep2
|
||
>-
|
||
Inc.cache
|
||
( proc dep3 -> do
|
||
Inc.dependOn -< dep3
|
||
arrM tell -< "executed"
|
||
)
|
||
)
|
||
returnA -< ()
|
||
|
||
let key1 = Inc.initialInvalidationKey
|
||
key2 = Inc.invalidate key1
|
||
|
||
(result1, log1) <- runWriterT $ Inc.build rule (key1, key1)
|
||
log1 `shouldBe` "executed"
|
||
|
||
(result2, log2) <- runWriterT $ Inc.rebuild result1 (key2, key1)
|
||
log2 `shouldBe` ""
|
||
|
||
(_, log3) <- runWriterT $ Inc.rebuild result2 (key2, key2)
|
||
log3 `shouldBe` "executed"
|
||
|
||
describe "keyed" $ do
|
||
it "preserves incrementalization when entries don’t change" $ do
|
||
let rule ::
|
||
(MonadWriter (S.HashSet (String, Integer)) m, MonadIO m) =>
|
||
Inc.Rule m (M.HashMap String Integer) (M.HashMap String Integer)
|
||
rule = proc m ->
|
||
(|
|
||
Inc.keyed
|
||
( \k v -> do
|
||
Inc.cache $ arrM (tell . S.singleton) -< (k, v)
|
||
returnA -< v * 2
|
||
)
|
||
|) m
|
||
|
||
(result1, log1) <- runWriterT . Inc.build rule $ M.fromList [("a", 1), ("b", 2)]
|
||
Inc.result result1 `shouldBe` M.fromList [("a", 2), ("b", 4)]
|
||
log1 `shouldBe` S.fromList [("a", 1), ("b", 2)]
|
||
(result2, log2) <- runWriterT . Inc.rebuild result1 $ M.fromList [("a", 1), ("b", 3), ("c", 4)]
|
||
Inc.result result2 `shouldBe` M.fromList [("a", 2), ("b", 6), ("c", 8)]
|
||
log2 `shouldBe` S.fromList [("b", 3), ("c", 4)]
|