1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-23 15:32:27 +03:00
graphql-engine/server/src-lib/Hasura/Incremental/Internal/Cache.hs
Brandon Simmons b167120f96 server: add explicit export lists in OSS server and enforce with warning
We'll see if this improves compile times at all, but I think it's worth
doing as at least the most minimal form of module documentation.

This was accomplished by first compiling everything with
-ddump-minimal-imports, and then a bunch of scripting (with help from
ormolu)

**EDIT** it doesn't seem to improve CI compile times but the noise floor is high as it looks like we're not caching library dependencies anymore

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2730
GitOrigin-RevId: 667eb8de1e0f1af70420cbec90402922b8b84cb4
2021-11-04 16:09:38 +00:00

102 lines
4.3 KiB
Haskell

{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}
module Hasura.Incremental.Internal.Cache
( ArrowCache (..),
DependT,
MonadDepend (..),
)
where
import Control.Arrow.Extended
import Control.Monad.Unique
import Hasura.Incremental.Internal.Dependency
import Hasura.Incremental.Internal.Rule
import Hasura.Incremental.Select
import Hasura.Prelude
class (ArrowKleisli m arr) => ArrowCache m arr | arr -> m where
-- | Adds equality-based caching to the given arrow. After each execution of the arrow, its input
-- and result values are cached. On the next execution, the new input value is compared via '=='
-- to the previous input value. If they are the same, the previous result is returned /without/
-- re-executing the arrow. Otherwise, the old cached values are discarded, and the arrow is
-- re-executed to produce a new set of cached values.
--
-- Indescriminate use of 'cache' is likely to have little effect except to increase memory usage,
-- since the input and result of each execution must be retained in memory. Avoid using 'cache'
-- around arrows with large input or output that is likely to change often unless profiling
-- indicates it is computationally expensive enough to be worth the memory overhead.
--
-- __Note that only direct inputs and outputs of the given arrow are cached.__ If an arrow
-- provides access to values through a side-channel, they will __not__ participate in caching.
cache :: (Cacheable a) => arr a b -> arr a b
-- | Creates a new 'Dependency', which allows fine-grained caching of composite values; see the
-- documentation for 'Dependency' for more details.
newDependency :: arr a (Dependency a)
-- | Extract the value from a 'Dependency', incurring a dependency on its entirety. To depend on
-- only a portion of the value, use 'selectD' or 'selectKeyD' before passing it to 'dependOn'.
dependOn :: (Cacheable a) => arr (Dependency a) a
-- | Run a monadic sub-computation with the ability to access dependencies; see 'MonadDepend' for
-- more details.
bindDepend :: arr (DependT m a) a
instance (ArrowChoice arr, ArrowCache m arr) => ArrowCache m (ErrorA e arr) where
cache (ErrorA f) = ErrorA (cache f)
{-# INLINE cache #-}
newDependency = liftA newDependency
{-# INLINE newDependency #-}
dependOn = liftA dependOn
{-# INLINE dependOn #-}
bindDepend = liftA bindDepend
{-# INLINE bindDepend #-}
instance (Monoid w, ArrowCache m arr) => ArrowCache m (WriterA w arr) where
cache (WriterA f) = WriterA (cache f)
{-# INLINE cache #-}
newDependency = liftA newDependency
{-# INLINE newDependency #-}
dependOn = liftA dependOn
{-# INLINE dependOn #-}
bindDepend = liftA bindDepend
{-# INLINE bindDepend #-}
instance (MonadUnique m) => ArrowCache m (Rule m) where
cache r0 = Rule \s a k -> do
let Rule r = listenAccesses r0
r s a \s' (b, accesses) r' -> k s' b (cached accesses a b r')
where
listenAccesses :: Rule m a b -> Rule m a (b, Accesses)
listenAccesses (Rule r) = Rule \s a k -> r mempty a \s' b r' ->
(k $! (s <> s')) (b, s') (listenAccesses r')
cached accesses a b (Rule r) = Rule \s a' k ->
if
| unchanged accesses a a' -> (k $! (s <> accesses)) b (cached accesses a b (Rule r))
| otherwise -> r s a' \s' (b', accesses') r' -> k s' b' (cached accesses' a' b' r')
newDependency = Rule \s a k -> do
key <- DependencyRoot <$> newUniqueS
k s (Dependency key a) (arr (Dependency key))
{-# INLINEABLE newDependency #-}
dependOn = Rule \s (Dependency key v) k -> (k $! recordAccess key AccessedAll s) v dependOn
bindDepend = Rule \s m k -> runStateT (unDependT m) s >>= \(v, s') -> k s' v bindDepend
-- | A restricted, monadic variant of 'ArrowCache' that can only read dependencies, not create new
-- ones or add local caching. This serves as a limited adapter between arrow and monadic code.
class (Monad m) => MonadDepend m where
dependOnM :: (Cacheable a) => Dependency a -> m a
instance (MonadDepend m) => MonadDepend (ExceptT e m) where
dependOnM = lift . dependOnM
newtype DependT m a = DependT {unDependT :: StateT Accesses m a}
deriving (Functor, Applicative, Monad, MonadTrans, MonadError e)
instance (Monad m) => MonadDepend (DependT m) where
dependOnM (Dependency key v) = DependT (modify' (recordAccess key AccessedAll) $> v)