haxl-effectful 1.0.0 → 1.1.0

raw patch · 4 files changed

+74/−83 lines, 4 filesdep ~hspec-effectfulPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hspec-effectful

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• haxl-effectful.cabal +3/−2
• src/Effectful/Haxl.hs +56/−81
• test/Main.hs +1/−0

@@ -5,6 +5,20 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.1.0] - 2026-08-04++### Added++- `liftEff`, a function to lift arbitrary action into `GenHaxl`.++### Removed++- `GenHaxl` constructor export.++### Changed++- Internal representation of `GenHaxl`, improving performance.+ ## [1.0.0] - 2026-07-15  ### Added

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: haxl-effectful-version: 1.0.0+version: 1.1.0 category: Concurrency synopsis: Effectful bindings for Haxl description:@@ -47,6 +47,7 @@     FlexibleInstances     GADTs     ImportQualifiedPost+    ImpredicativeTypes     LambdaCase     MultiParamTypeClasses     NamedFieldPuns@@ -91,5 +92,5 @@   build-depends:     filepath >=1.5 && <1.6,     haxl-effectful,-    hspec-effectful >=1.0 && <1.1,+    hspec-effectful >=1.0 && <1.2,     text >=2.1 && <2.2,

@@ -147,8 +147,9 @@     , initEnv     , env     , withEnv-    , GenHaxl (..)+    , GenHaxl     , liftGenHaxl+    , liftEff     , dataFetch     , uncachedRequest     , cacheRequest@@ -255,15 +256,13 @@ haxl :: forall u w es a. (Monoid w) => GenHaxl u w es a -> Eff (Haxl u w ': es) a haxl g = do     env <- initEnv-    inject $ unsafeConcUnliftIO Persistent Unlimited \unlift ->-        Haxl.runHaxl env $ Haxl.GenHaxl (unlift . unHaxl g)+    inject $ unsafeConcUnliftIO Persistent Unlimited $ Haxl.runHaxl env . unHaxl g  -- | Like 'haxl', but also return everything written via the 'w' monoid during the run. haxlWithWrites :: forall u w es a. (Monoid w) => GenHaxl u w es a -> Eff (Haxl u w ': es) (a, w) haxlWithWrites g = do     env <- initEnv-    inject $ unsafeConcUnliftIO Persistent Unlimited \unlift ->-        Haxl.runHaxlWithWrites env $ Haxl.GenHaxl (unlift . unHaxl g)+    inject $ unsafeConcUnliftIO Persistent Unlimited $ Haxl.runHaxlWithWrites env . unHaxl g  -- | Like 'haxl', but also return the 'Stats' collected during the run. --@@ -272,8 +271,7 @@ haxlWithStats :: forall u w es a. (Monoid w) => GenHaxl u w es a -> Eff (Haxl u w ': es) (a, Stats) haxlWithStats g = do     env <- initEnv-    a <- inject $ unsafeConcUnliftIO Persistent Unlimited \unlift ->-        Haxl.runHaxl env $ Haxl.GenHaxl (unlift . unHaxl g)+    a <- inject $ unsafeConcUnliftIO Persistent Unlimited $ Haxl.runHaxl env . unHaxl g     stats <- unsafeEff_ . readIORef $ statsRef env     pure (a, stats) @@ -292,31 +290,22 @@ -- | The monad in which data-fetching computations are written. -- -- Note that 'GenHaxl' is not expressed in terms of 'Eff'.--- Its 'Applicative' instance batches independent fetches combined with @('<*>')@ into a single round trip.-newtype GenHaxl u w es a = GenHaxl {unHaxl :: Env u w -> Eff es (Haxl.Result u w a)}+-- Its 'Applicative' instance batches independent fetches combined with @('<*>')@+-- into a single round trip.+newtype GenHaxl u w es a = GenHaxl+    { unHaxl :: (forall r. Eff es r -> IO r) -> Haxl.GenHaxl u w a+    }  instance Functor (GenHaxl u w es) where-    fmap f (GenHaxl m) = GenHaxl $ (fmap . fmap . fmap) f m+    fmap f (GenHaxl m) = GenHaxl $ fmap f . m  instance Applicative (GenHaxl u w es) where-    pure = GenHaxl . const . pure . Done-    f <*> a = GenHaxl $ \env -> do-        unsafeConcUnliftIO Ephemeral Unlimited $ \unlift ->-            Haxl.unHaxl-                ( Haxl.GenHaxl (unlift . unHaxl f)-                    <*> Haxl.GenHaxl (unlift . unHaxl a)-                )-                env+    pure a = GenHaxl \_unlift -> pure a+    GenHaxl f <*> GenHaxl a = GenHaxl \unlift -> f unlift <*> a unlift  instance Monad (GenHaxl u w es) where     return = pure-    m >>= k = GenHaxl $ \env -> do-        unsafeConcUnliftIO Ephemeral Unlimited $ \unlift ->-            Haxl.unHaxl-                ( Haxl.GenHaxl (unlift . unHaxl m)-                    >>= \a -> Haxl.GenHaxl (unlift . unHaxl (k a))-                )-                env+    GenHaxl m >>= k = GenHaxl \unlift -> m unlift >>= \a -> unHaxl (k a) unlift  instance MonadFail (GenHaxl u w es) where     fail = liftGenHaxl . fail@@ -357,85 +346,73 @@ -- Warning: 'Haxl.GenHaxl' exposes functions such as 'Haxl.unsafeLiftIO' -- that allow arbitrary 'IO' to be injected without it being reflected in @es@. liftGenHaxl :: Haxl.GenHaxl u w a -> GenHaxl u w es a-liftGenHaxl = GenHaxl . (unsafeEff_ .) . Haxl.unHaxl--unliftGenHaxl :: GenHaxl u w es a -> Eff es (Haxl.GenHaxl u w a)-unliftGenHaxl g =-    unsafeConcUnliftIO Ephemeral Unlimited $ pure . Haxl.GenHaxl . (. unHaxl g)--unliftGenHaxl1 :: (a -> GenHaxl u w es b) -> Eff es (a -> Haxl.GenHaxl u w b)-unliftGenHaxl1 f =-    unsafeConcUnliftIO Ephemeral Unlimited \unlift -> pure \a ->-        Haxl.GenHaxl $ unlift . unHaxl (f a)+liftGenHaxl h = GenHaxl $ const h -unliftGenHaxl2 :: (a -> b -> GenHaxl u w es c) -> Eff es (a -> b -> Haxl.GenHaxl u w c)-unliftGenHaxl2 f =-    unsafeConcUnliftIO Ephemeral Unlimited \unlift -> pure \a b ->-        Haxl.GenHaxl $ unlift . unHaxl (f a b)+-- | Run an @'Eff' es@ action as part of a 'GenHaxl' computation.+--+-- The action runs on the effect environment captured by 'haxl' (or whichever+-- @haxlWith*@ function started the run), so effect state is shared with the+-- surrounding @'Eff' es@ computation and between all lifted actions.+--+-- Note that the action is opaque to Haxl: it is not batched, cached or+-- deduplicated, and it runs as soon as the computation reaches it rather than+-- when a round of fetches is dispatched. Use 'cacheResult' to have its result+-- cached against a request.+liftEff :: Eff es a -> GenHaxl u w es a+liftEff eff = GenHaxl \unlift -> Haxl.unsafeLiftIO $ unlift eff  mapGenHaxl :: (Haxl.GenHaxl u w a -> Haxl.GenHaxl u w b) -> GenHaxl u w es a -> GenHaxl u w es b-mapGenHaxl f g = GenHaxl \env -> do-    g <- unliftGenHaxl g-    unsafeEff_ $ Haxl.unHaxl (f g) env+mapGenHaxl f g = GenHaxl $ f . unHaxl g  mapGenHaxl1     :: ((a -> Haxl.GenHaxl u w b) -> Haxl.GenHaxl u w c)     -> (a -> GenHaxl u w es b)     -> GenHaxl u w es c-mapGenHaxl1 f g = GenHaxl \env -> do-    g <- unliftGenHaxl1 g-    unsafeEff_ $ Haxl.unHaxl (f g) env+mapGenHaxl1 f g = GenHaxl \unlift -> f \a -> unHaxl (g a) unlift  mapGenHaxl2     :: ((a -> b -> Haxl.GenHaxl u w c) -> Haxl.GenHaxl u w d)     -> (a -> b -> GenHaxl u w es c)     -> GenHaxl u w es d-mapGenHaxl2 f g = GenHaxl \env -> do-    g <- unliftGenHaxl2 g-    unsafeEff_ $ Haxl.unHaxl (f g) env+mapGenHaxl2 f g = GenHaxl \unlift -> f \a b -> unHaxl (g a b) unlift  mapGenHaxlCatch     :: (Haxl.GenHaxl u w a -> (e -> Haxl.GenHaxl u w a) -> Haxl.GenHaxl u w a)     -> GenHaxl u w es a     -> (e -> GenHaxl u w es a)     -> GenHaxl u w es a-mapGenHaxlCatch f g h = GenHaxl \env -> do-    g <- unliftGenHaxl g-    h <- unliftGenHaxl1 h-    unsafeEff_ $ Haxl.unHaxl (f g h) env+mapGenHaxlCatch f g h = GenHaxl \unlift ->+    f (unHaxl g unlift) \e -> unHaxl (h e) unlift --- | Lifted 'Haxl.env'+-- | Lifted 'Haxl.env'. env :: (Env u w -> a) -> GenHaxl u w es a env = liftGenHaxl . Haxl.env --- | Lifted 'Haxl.withEnv'+-- | Lifted 'Haxl.withEnv'. withEnv :: Env u w -> GenHaxl u w es a -> GenHaxl u w es a withEnv = mapGenHaxl . Haxl.withEnv --- | Lifted 'Haxl.dataFetch'+-- | Lifted 'Haxl.dataFetch'. dataFetch :: (DataSource u r, Request r a) => r a -> GenHaxl u w es a dataFetch = liftGenHaxl . Haxl.dataFetch --- | Lifted 'Haxl.uncachedRequest'+-- | Lifted 'Haxl.uncachedRequest'. uncachedRequest :: (DataSource u r, Request r a) => r a -> GenHaxl u w es a uncachedRequest = liftGenHaxl . Haxl.uncachedRequest --- | Lifted 'Haxl.cacheRequest'+-- | Lifted 'Haxl.cacheRequest'. cacheRequest :: (Request req a) => req a -> Either SomeException a -> GenHaxl u w es () cacheRequest = (liftGenHaxl .) . Haxl.cacheRequest --- | Lifted 'Haxl.dupableCacheRequest'+-- | Lifted 'Haxl.dupableCacheRequest'. dupableCacheRequest :: (Request req a) => req a -> Either SomeException a -> GenHaxl u w es () dupableCacheRequest = (liftGenHaxl .) . Haxl.dupableCacheRequest --- | Lifted 'Haxl.cacheResult'+-- | Lifted 'Haxl.cacheResult'. cacheResult :: (Request r a) => r a -> Eff es a -> GenHaxl u w es a-cacheResult r eff =-    GenHaxl \env ->-        unsafeConcUnliftIO Ephemeral Unlimited \unlift ->-            Haxl.unHaxl (Haxl.cacheResult r (unlift eff)) env+cacheResult r eff = GenHaxl \unlift -> Haxl.cacheResult r (unlift eff) --- | Lifted 'Haxl.cacheResultWithShow'+-- | Lifted 'Haxl.cacheResultWithShow'. cacheResultWithShow     :: (Hashable (r a), Typeable (r a))     => ShowReq r a@@ -443,11 +420,9 @@     -> Eff es a     -> GenHaxl u w es a cacheResultWithShow showReq req eff =-    GenHaxl \env ->-        unsafeConcUnliftIO Ephemeral Unlimited \unlift ->-            Haxl.unHaxl (Haxl.cacheResultWithShow showReq req (unlift eff)) env+    GenHaxl \unlift -> Haxl.cacheResultWithShow showReq req (unlift eff) --- | Lifted 'Haxl.cachedComputation'+-- | Lifted 'Haxl.cachedComputation'. cachedComputation     :: (Hashable (req a), Typeable (req a), Monoid w)     => req a@@ -455,7 +430,7 @@     -> GenHaxl u w es a cachedComputation = mapGenHaxl . Haxl.cachedComputation --- | Lifted 'Haxl.preCacheComputation'+-- | Lifted 'Haxl.preCacheComputation'. preCacheComputation     :: (Hashable (req a), Typeable (req a), Monoid w)     => req a@@ -463,25 +438,25 @@     -> GenHaxl u w es a preCacheComputation = mapGenHaxl . Haxl.preCacheComputation --- | Lifted 'Haxl.memoize'+-- | Lifted 'Haxl.memoize'. memoize :: (Monoid w) => GenHaxl u w es a -> GenHaxl u w es (GenHaxl u w es a) memoize = fmap liftGenHaxl . mapGenHaxl Haxl.memoize --- | Lifted 'Haxl.memoize1'+-- | Lifted 'Haxl.memoize1'. memoize1     :: (Hashable a, Monoid w)     => (a -> GenHaxl u w es b)     -> GenHaxl u w es (a -> GenHaxl u w es b) memoize1 = fmap (liftGenHaxl .) . mapGenHaxl1 Haxl.memoize1 --- | Lifted 'Haxl.memoize2'+-- | Lifted 'Haxl.memoize2'. memoize2     :: (Hashable a, Hashable b, Monoid w)     => (a -> b -> GenHaxl u w es c)     -> GenHaxl u w es (a -> b -> GenHaxl u w es c) memoize2 = fmap ((liftGenHaxl .) .) . mapGenHaxl2 Haxl.memoize2 --- | Lifted 'Haxl.memo'+-- | Lifted 'Haxl.memo'. memo     :: ( Typeable a        , Typeable k@@ -493,7 +468,7 @@     -> GenHaxl u w es a memo = mapGenHaxl . Haxl.memo --- | Lifted 'Haxl.memoFingerprint'+-- | Lifted 'Haxl.memoFingerprint'. memoFingerprint     :: (Typeable a, Monoid w)     => MemoFingerprintKey a@@ -501,22 +476,22 @@     -> GenHaxl u w es a memoFingerprint = mapGenHaxl . Haxl.memoFingerprint --- | Lifted 'Haxl.rethrowAsyncExceptions'+-- | Lifted 'Haxl.rethrowAsyncExceptions'. rethrowAsyncExceptions :: SomeException -> Eff es () rethrowAsyncExceptions = unsafeEff_ . Haxl.rethrowAsyncExceptions  tryWithRethrow :: Eff es a -> Eff es (Either SomeException a) tryWithRethrow eff = (Right <$> eff) `Effectful.catch` \e -> rethrowAsyncExceptions e >> pure (Left e) --- | Lifted 'Haxl.throw'+-- | Lifted 'Haxl.throw'. throw :: (Exception e) => e -> GenHaxl u w es a throw = liftGenHaxl . Haxl.throw --- | Lifted 'Haxl.catch'+-- | Lifted 'Haxl.catch'. catch :: (Exception e) => GenHaxl u w es a -> (e -> GenHaxl u w es a) -> GenHaxl u w es a catch = mapGenHaxlCatch Haxl.catch --- | Lifted 'Haxl.catchIf'+-- | Lifted 'Haxl.catchIf'. catchIf     :: (Exception e)     => (e -> Bool)@@ -525,14 +500,14 @@     -> GenHaxl u w es a catchIf = mapGenHaxlCatch . Haxl.catchIf --- | Lifted 'Haxl.try'+-- | Lifted 'Haxl.try'. try :: (Exception e) => GenHaxl u w es a -> GenHaxl u w es (Either e a) try = mapGenHaxl Haxl.try --- | Lifted 'Haxl.dumpCacheAsHaskell'+-- | Lifted 'Haxl.dumpCacheAsHaskell'. dumpCacheAsHaskell :: GenHaxl u w es String dumpCacheAsHaskell = dumpCacheAsHaskellFn "loadCache" "GenHaxl u w es ()" "cacheRequest" --- | Lifted 'Haxl.dumpCacheAsHaskellFn'+-- | Lifted 'Haxl.dumpCacheAsHaskellFn'. dumpCacheAsHaskellFn :: String -> String -> String -> GenHaxl u w es String dumpCacheAsHaskellFn = ((liftGenHaxl .) .) . Haxl.dumpCacheAsHaskellFn

@@ -21,6 +21,7 @@ import Effectful.Prim.IORef (modifyIORef', newIORef, readIORef) import ExampleDataSource (Id (..)) import ExampleDataSource qualified+import GHC.Stack (HasCallStack) import LoadCache (loadCache) import System.FilePath (dropFileName, (</>)) import Prelude hiding (readFile)