cauldron 0.8.0.0 → 0.9.0.0

raw patch · 14 files changed

+449/−310 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−0
• README.md +1/−1
• app/Main.hs +25/−25
• cauldron.cabal +2/−2
• lib-graph/Cauldron/Graph.hs +1/−1
• lib/Cauldron.hs +288/−192
• lib/Cauldron/Args/Internal.hs +4/−2
• lib/Cauldron/Beans.hs +7/−7
• lib/Cauldron/Builder.hs +0/−2
• lib/Cauldron/Managed.hs +25/−7
• test/appTests.hs +8/−8
• test/codecTests.hs +5/−5
• test/managedTests.hs +2/−2
• test/tests.hs +61/−56

@@ -1,5 +1,25 @@ # Revision history for cauldron +## 0.9.0.0++* breaking change: `SomeRecipe` type hidden.+* breaking change: `recipe` now produces a `Cauldron`, not a `SomeRecipe`.+* breaking change: `withRecipe` is now `lookup` and works on `Cauldron`s.+* breaking change: `withRecipeCallstack` gone. Use `lookup`.+* breaking change: `IsList` instance for `Cauldron` has changed its `Item` type.+* breaking change: the `bean` field of `Recipe` is now called `bare`.+* new (|=|) and (䷱) operators.++## 0.8.1.0++* Add `Cauldron.Managed.runManaged`.++* `Monoid` and `Semigroup` instances for `Managed`, like the ones from the+  [managed](https://hackage.haskell.org/package/managed) library.++* Export `Cauldron.Args.Args` from `Cauldron`. This should make some IDE+  messages clearer.+ ## 0.8.0.0  * doc and test changes.

@@ -169,7 +169,7 @@  # Acknowledgements -This package contains vendored code from Grabriella Gonzalez's+This package contains vendored code from Gabriella Gonzalez's [managed](https://hackage.haskell.org/package/managed) library.  Also vendored code from Andrey Mokhov's

@@ -194,30 +194,30 @@  cauldron :: Cauldron IO cauldron :: Cauldron IO =-  [ recipe @A $ val $ pure makeA,-    recipe @B $ val $ pure makeB,-    recipe @C $ val $ wire makeC,-    recipe @D $ val $ wire makeD,-    recipe @E $ val $ wire makeE,-    recipe @F $ val $ wire makeF,-    recipe @G $-      Recipe-        { bean = val $ wire makeG,-          decos =-            [ val $ wire makeGDeco1-            ]-        },-    recipe @H $ val $ wire makeH,-    recipe @Z-      Recipe-        { bean = val $ wire makeZ,-          decos =-            [ val $ wire makeZDeco1,-              val $ wire makeZDeco2-            ]-        },-    recipe @Result $ val $ wire Result-  ]+    [ recipe @A $ val $ pure makeA,+      recipe @B $ val $ pure makeB,+      recipe @C $ val $ wire makeC,+      recipe @D $ val $ wire makeD,+      recipe @E $ val $ wire makeE,+      recipe @F $ val $ wire makeF,+      recipe @G $+        Recipe+          { bare = val $ wire makeG,+            decos =+              [ val $ wire makeGDeco1+              ]+          },+      recipe @H $ val $ wire makeH,+      recipe @Z+        Recipe+          { bare = val $ wire makeZ,+            decos =+              [ val $ wire makeZDeco1,+                val $ wire makeZDeco2+              ]+          },+      recipe @Result $ val $ wire Result+    ]  main :: IO () main = do@@ -240,7 +240,7 @@       print z       runInitializer       pure $ Nothing-  let depGraph = getDependencyGraph cauldron+  let depGraph = getDependencyGraph [cauldron]   writeAsDot (defaultStyle merr) "beans.dot" depGraph   writeAsDot (defaultStyle merr) "beans-no-agg.dot" $ removeAggregates $ depGraph   writeAsDot (defaultStyle merr) "beans-no-agg-no-decos.dot" $ removeDecos $ removeAggregates $ depGraph

@@ -1,6 +1,6 @@ cabal-version:      3.4 name:               cauldron-version:            0.8.0.0+version:            0.9.0.0 synopsis:           Dependency injection library description:        Dependency injection library that wires things at runtime. license:            BSD-3-Clause@@ -12,7 +12,7 @@ extra-doc-files:    README.md, CHANGELOG.md -- extra-source-files: category: Dependency Injection-tested-with: GHC ==9.8.2+tested-with: GHC ==9.10.1, GHC==9.12.2 source-repository    head     type:     git     location: https://github.com/danidiaz/cauldron.git

@@ -96,7 +96,7 @@ import Data.Set (Set) import Data.Set qualified as Set import Data.String-import Data.Tree (Tree(..), Forest)+import Data.Tree (Forest, Tree (..)) import GHC.Generics  -- | The 'AdjacencyMap' data type represents a graph by a map of vertices to

@@ -1,12 +1,10 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RequiredTypeArguments #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE NoFieldSelectors #-}@@ -21,12 +19,11 @@ -- This library should be used at the ["composition root"](https://stackoverflow.com/questions/6277771/what-is-a-composition-root-in-the-context-of-dependency-injection) of the application, -- and only there: the components we are wiring together need not be aware that the library exists. ----- These extensions, while not required, play well with the library:+-- These extensions, while not required, can play well with the library: ----- @--- {-# LANGUAGE ApplicativeDo #-} -- For building complex values in the Args applicative.--- {-# LANGUAGE OverloadedLists #-} -- For avoiding explicit calls to fromRecipeList and fromDecoList--- @+-- * @ApplicativeDo@ For advanced fiddling in the 'Args' applicative.+-- * @OverloadedLists@ For avoiding explicit calls to 'mconcat' when building+--   a 'Cauldron' from a list of 'Cauldron's, and for avoiding explicit calls to 'fromDecoList'. -- -- An example of using a 'Cauldron' to wire the constructors of dummy @A@, @B@, @C@ datatypes: --@@ -42,10 +39,10 @@ -- makeC = \_ _ -> pure C -- :} ----- The basic idea is to fill up the 'Cauldron' with 'recipe's. 'Recipe's are+-- The basic idea is to fill the 'Cauldron' with 'recipe's. 'Recipe's are -- built by 'wire'ing the arguments of a constructor function, and then using--- functions like 'val' or 'eff' depending on whether the constructor is--- effectful or not. More sophisticated 'Recipe's can also have decorators.+-- functions like 'val_' or 'eff_' depending on whether the constructor is+-- effectful or not. More complex 'Recipe's can also have decorators. -- -- The we 'cook' the 'Cauldron' passing as a type argument the type of the bean -- that we want to extract, along with a 'Fire' argument that regulates what@@ -54,31 +51,33 @@ -- >>> :{ -- do --   let cauldron :: Cauldron IO---       cauldron = [---           recipe @A $ val $ wire makeA,---           recipe @B $ val $ wire makeB,---           recipe @C $ eff $ wire makeC -- we use eff because the constructor has IO effects+--       cauldron = mconcat [+--           recipe @A $ val_ $ wire makeA,+--           recipe @B $ val_ $ wire makeB,+--           recipe @C $ eff_ $ wire makeC -- we use eff because the constructor has IO effects --         ]---   action <- cook @C forbidDepCycles cauldron & either throwIO pure+--   action <- cauldron & cook @C forbidDepCycles & either throwIO pure --   action -- :} -- C -- -- __Note__: It's better to avoid having beans whose types are functions or--- tuples, because those types are given special treatment. See the docs for--- 'wire', 'val', and 'eff'.---+-- tuples, because the library gives those types special treatment. See the docs+-- for 'wire', 'val', and 'eff'. module Cauldron   ( -- * Filling the cauldron     Cauldron,     empty,+    recipe,+    singleton,+    (|=|),+    (䷱),     insert,     adjust,+    Cauldron.lookup,     delete,     keysSet,     restrictKeys,-    fromRecipeList,-    toRecipeMap,     hoistCauldron,     hoistCauldron', @@ -94,33 +93,33 @@     -- ** How decorators work     -- $decos -    -- ** Hiding a 'Recipe''s bean type-    SomeRecipe,-    recipe,-    withRecipe,-    getRecipeCallStack,-     -- * Constructors     -- $constructors     Constructor,+    Args,     arg,     wire,     val_,-    val,-    val',     eff_,     ioEff_,++    -- ** Registering aggregate beans+    -- $secondarybeans+    val,+    val',     eff,-    ioEff,     eff',+    ioEff,++    -- ** "with"-like constructors+    -- $managedconstructors++    -- ** Sundry constructor helpers     getConstructorArgs,     getConstructorCallStack,     hoistConstructor,     hoistConstructor', -    -- ** Registering aggregate beans-    -- $secondarybeans-     -- * Cooking the beans     cook,     nest,@@ -166,6 +165,7 @@ import Cauldron.Graph.Export.Dot qualified as Dot import Control.Applicative ((<|>)) import Control.Exception (Exception (..))+import Control.Monad (guard) import Control.Monad.Fix import Control.Monad.IO.Class import Data.Bifunctor (first)@@ -214,11 +214,6 @@ instance Monoid (Cauldron m) where   mempty = Cauldron Map.empty -instance IsList (Cauldron m) where-  type Item (Cauldron m) = SomeRecipe m-  toList (Cauldron {recipeMap}) = Map.elems recipeMap-  fromList = fromRecipeList- -- | Change the monad used by the 'Recipe's in the 'Cauldron'. hoistCauldron :: (forall x. m x -> n x) -> Cauldron m -> Cauldron n hoistCauldron f (Cauldron {recipeMap}) = Cauldron {recipeMap = hoistSomeRecipe f <$> recipeMap}@@ -241,36 +236,35 @@ -- need to hide each recipe's bean type. This wrapper allows that. type SomeRecipe :: (Type -> Type) -> Type data SomeRecipe m where-  SomeRecipe :: (Typeable bean) => {_recipeCallStack :: CallStack, _recipe :: Recipe m bean} -> SomeRecipe m+  SomeRecipe :: (Typeable bean) => {_recipeCallStacks :: NonEmpty CallStack, _recipe :: Recipe m bean} -> SomeRecipe m --- | Build a 'SomeRecipe' from a 'Recipe' or a 'Constructor'. See 'ToRecipe'.+-- | Access a 'Recipe' inside a 'Cauldron', if it exists there. ----- Useful in combination with 'fromRecipeList'.-recipe ::-  forall {recipelike} {m} bean.-  (ToRecipe recipelike, Typeable bean, HasCallStack) =>-  -- | A 'Recipe' or a 'Constructor'.-  recipelike m bean ->-  SomeRecipe m-recipe theRecipe = withFrozenCallStack do-  SomeRecipe callStack (toRecipe theRecipe)---- | Access the 'Recipe' inside a 'SomeRecipe'.-withRecipe :: forall {m} r. (forall bean. (Typeable bean) => Recipe m bean -> r) -> SomeRecipe m -> r-withRecipe f (SomeRecipe {_recipe}) = f _recipe--getRecipeRep :: SomeRecipe m -> TypeRep-getRecipeRep = withRecipe go-  where-    go :: forall bean m. (Typeable bean) => Recipe m bean -> TypeRep-    go _ = typeRep (Proxy @bean)+-- A callback is used because 'Cauldron's are heterogenous containers.+--+-- Besides the 'Recipe', the callback also receives a 'NonEmpty' list of+-- 'CallStack's conveying the locations at which the the 'Recipe' was added and+-- 'adjust'ed.+lookup :: forall {m} (bean :: Type) r. (Typeable bean) => (NonEmpty CallStack -> Recipe m bean -> r) -> Cauldron m -> Maybe r+lookup f (Cauldron {recipeMap}) = withFrozenCallStack do+  let rep = typeRep (Proxy @bean)+  case recipeMap & Map.lookup rep of+    Nothing -> Nothing+    Just SomeRecipe {_recipeCallStacks, _recipe} ->+      case Wrap1 _recipe of+        Wrap1 @_ @ta _ ->+          case testEquality (Type.Reflection.typeRep @bean) (Type.Reflection.typeRep @ta) of+            Nothing -> error "should never happen"+            Just Refl -> Just $ f _recipeCallStacks _recipe -fromRecipeList :: [SomeRecipe m] -> Cauldron m-fromRecipeList =-  foldMap \sr -> Cauldron {recipeMap = Map.singleton (getRecipeRep sr) sr}+-- -- The alternative would be to introduce @_recipe = _recipe :: Recipe m a@+-- -- "The type abstraction syntax can be used in patterns that match a data constructor. The syntax can’t be used with record patterns or infix patterns."+-- -- [Type Abstractions in Patterns](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_abstractions.html#type-abstractions-in-patterns)+newtype Wrap1 f a = Wrap1 (f a) -toRecipeMap :: Cauldron m -> Map TypeRep (SomeRecipe m)-toRecipeMap Cauldron {recipeMap} = recipeMap+-- | Access the 'Recipe' inside a 'SomeRecipe'.+withRecipe' :: forall {m} r. (forall bean. (Typeable bean) => NonEmpty CallStack -> Recipe m bean -> r) -> SomeRecipe m -> r+withRecipe' f (SomeRecipe {_recipeCallStacks, _recipe}) = f _recipeCallStacks _recipe  hoistSomeRecipe :: (forall x. m x -> n x) -> SomeRecipe m -> SomeRecipe n hoistSomeRecipe f r@SomeRecipe {_recipe} = r {_recipe = hoistRecipe f _recipe}@@ -281,35 +275,45 @@   (forall x. (Typeable x) => Int -> Args (m (Regs x)) -> Args (n (Regs x))) ->   SomeRecipe m ->   SomeRecipe n-hoistSomeRecipe' f fds sr = withRecipe go sr+hoistSomeRecipe' f fds sr = withRecipe' go sr   where-    go :: forall bean. (Typeable bean) => Recipe m bean -> SomeRecipe n-    go r = sr {_recipe = hoistRecipe' (f @bean) (fds @bean) r}+    go :: forall bean. (Typeable bean) => NonEmpty CallStack -> Recipe m bean -> SomeRecipe n+    go _ r = sr {_recipe = hoistRecipe' (f @bean) (fds @bean) r} +-- | Somewhat unusual instance, in that the 'Cauldron' 'Item' is again a 'Cauldron'. Mostly+-- useful to avoid explicit 'mconcat's when building 'Cauldron's from lists.+instance IsList (Cauldron m) where+  type Item (Cauldron m) = Cauldron m++  toList (Cauldron {recipeMap}) = do+    (k, v) <- Map.toList recipeMap+    [Cauldron {recipeMap = Map.singleton k v}]+  fromList = mconcat+ -- | Instructions for how to build a value of type @bean@ while possibly -- performing actions in the monad @m@. -- -- Because the instructions aren't really run until the 'Cauldron' is 'cook'ed, -- they can be modified with functions like 'adjust', in order to change the--- base bean 'Constructor', or add or remove decorators.+-- base bean 'Constructor' or add or remove decorators. type Recipe :: (Type -> Type) -> Type -> Type data Recipe m bean = Recipe   { -- | How to build the bean itself.-    bean :: Constructor m bean,+    bare :: Constructor m bean,     -- | A 'Data.Sequence.Sequence' of decorators that will wrap the bean. There might be no decorators.     --     -- See 'fromDecoList', 'Data.Sequence.|>' and 'Data.Sequence.<|'.     decos :: Seq (Constructor m bean)   } -fromDecoList :: [Constructor m bean] -> Seq (Constructor m bean)+fromDecoList :: forall m bean. [Constructor m bean] -> Seq (Constructor m bean) fromDecoList = Data.Sequence.fromList  -- | Convenience typeclass that allows passing either 'Recipe's or 'Constructor's--- to the 'insert' and 'recipe' functions.+-- to the 'recipe' and 'insert' functions. type ToRecipe :: ((Type -> Type) -> Type -> Type) -> Constraint class ToRecipe recipelike where-  toRecipe :: recipelike m bean -> Recipe m bean+  toRecipe :: forall m bean. recipelike m bean -> Recipe m bean  -- | Simply identity. instance ToRecipe Recipe where@@ -317,35 +321,36 @@  -- | 'Constructor' is converted to a 'Recipe' without decorators. instance ToRecipe Constructor where-  toRecipe bean = Recipe {bean, decos = Data.Sequence.empty}+  toRecipe bare = Recipe {bare, decos = Data.Sequence.empty}  -- | Change the monad used by the bean\'s main 'Constructor' and its decos.-hoistRecipe :: (forall x. m x -> n x) -> Recipe m bean -> Recipe n bean-hoistRecipe f (Recipe {bean, decos}) =+hoistRecipe :: forall m n bean. (forall x. m x -> n x) -> Recipe m bean -> Recipe n bean+hoistRecipe f (Recipe {bare, decos}) =   Recipe-    { bean = hoistConstructor f bean,+    { bare = hoistConstructor f bare,       decos = hoistConstructor f <$> decos     }  -- | More general form of 'hoistRecipe' that enables precise control over the inner `Args` -- of each constructor in the 'Recipe'. hoistRecipe' ::+  forall m n bean.   -- | Transformation to apply to the base constructor.   (Args (m (Regs bean)) -> Args (n (Regs bean))) ->   -- | Transformation to apply to each decorator. Takes the decorator index as parameter.   (Int -> Args (m (Regs bean)) -> Args (n (Regs bean))) ->   Recipe m bean ->   Recipe n bean-hoistRecipe' f fds (Recipe {bean, decos}) =+hoistRecipe' f fds (Recipe {bare, decos}) =   Recipe-    { bean = hoistConstructor' f bean,+    { bare = hoistConstructor' f bare,       decos = Data.Sequence.mapWithIndex (\i deco -> hoistConstructor' (fds i) deco) decos     }  -- $decos ----- Decorators are 'Constructor's which, instead constructing the original--- version of a bean, they modify it in some way (but without changing its+-- Decorators are 'Constructor's which, instead of constructing the original+-- version of a bean, modify it in some way (but without changing its -- type). Because they modify the bean, typically decorators will take the bean -- as an argument. --@@ -371,17 +376,18 @@ -- -- >>> :{ -- do---   let cauldron :: Cauldron IO---       cauldron = [---           recipe @Foo $ Recipe {---             bean = val $ wire makeFoo,---             decos = [---                  val $ wire makeFooDeco1,---                  eff $ wire makeFooDeco2---               ]---           }---         ]---   action <- cook @Foo forbidDepCycles cauldron & either throwIO pure+--   action <-+--     mconcat [+--       recipe @Foo $ Recipe {+--         bare = val $ wire makeFoo,+--         decos = [+--              val $ wire makeFooDeco1,+--              eff $ wire makeFooDeco2+--           ]+--       }+--     ]+--     & cook @Foo forbidDepCycles+--     & either throwIO pure --   Foo {sayFoo} <- action --   sayFoo -- :}@@ -396,15 +402,37 @@ -- -- Bean-producing and bean-decorating functions need to be coaxed into -- 'Constructor's in order to be used in 'Cauldron's.--- +-- -- First we fill the arguments of the function in an 'Args' context, either one -- by one using 'arg's and 'Applicative' operators, or all in a single swoop, -- using 'wire'. -- -- Then, depending on whether the function produces the desired bean directly,--- or through an effect, we use functions like 'val', 'val_', 'eff' or 'eff_' on+-- or through an effect, we use functions like 'val_', 'val', 'eff_' or 'eff' on -- the 'Args' value.++-- $managedconstructors --+-- Some effectful constructor functions, in order to manage the acquisition and+-- release of the bean they produce, use the common idiom or returning a+-- higher-order function that takes a callback. A typical example is+-- 'System.IO.withFile'.+--+-- These effecful constructor functions can be coaxed into 'Constructor's that+-- have their effects in a monad like 'Cauldron.Managed.Managed'.+--+-- We need to wrap the callback-accepting part in 'Cauldron.Managed.managed',+-- before we lift the function to 'Cauldron.Args.Args' using 'wire':+--+-- >>> :{+-- -- We treat the 'IOMode' as if it were a bean dependency.+-- handleBean :: Constructor Managed Handle+-- handleBean = eff_ $ wire $ \mode -> managed $ withFile "/tmp/foo.txt" mode+-- :}+--+-- Annoyingly, this forces us to be a bit more verbose and explicitly mention+-- the constructor parameters (in the example, @mode@) in order to reach the+-- part that we wrap in 'Cauldron.Managed.Managed'.  data ConstructorReps where   ConstructorReps ::@@ -414,6 +442,63 @@     } ->     ConstructorReps +-- | Create a 'Cauldron' consisting of a single 'Recipe'.+--+-- 'recipe' and 'singleton' are the same function.+--+-- For readability, the @bean@ type is often passed as a type application, despite+-- not being strictly required:+--+-- >>> :{+-- oneRecipe :: Cauldron IO+-- oneRecipe = recipe @Bool $ val_ $ pure $ False+-- :}+--+-- Typical usage involves putting singleton 'Cauldron's in a list and 'mconcat'ting them:+--+-- >>> :{+-- twoRecipes :: Cauldron IO+-- twoRecipes = mconcat [+--      recipe $ val_ $ pure $ False,+--      recipe @Char $ val_ $ wire $ \(_ :: Bool) -> 'b'+--    ]+-- :}+recipe,+  singleton ::+    forall {recipelike} {m} bean.+    (Typeable bean, ToRecipe recipelike, HasCallStack) =>+    -- | A 'Recipe' or a 'Constructor'.+    recipelike m bean ->+    Cauldron m+singleton theRecipe = withFrozenCallStack do+  mempty & insert theRecipe+recipe theRecipe = withFrozenCallStack do+  mempty & insert theRecipe++-- | Operator variant of 'recipe' where the @bean@ type is a [required type argument](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/required_type_arguments.html).+--+-- '(|=|)' and '(䷱)' are the same function.+--+-- >>> :{+-- oneRecipe, oneRecipe' :: Cauldron IO+-- oneRecipe = Bool |=| val $ pure $ False+-- oneRecipe' = Bool ䷱ val $ pure $ False+-- :}+(|=|),+  (䷱) ::+    forall {recipelike} {m}.+    (ToRecipe recipelike, HasCallStack) =>+    forall bean ->+    (Typeable bean) =>+    recipelike m bean ->+    Cauldron m+(|=|) _ recipelike = withFrozenCallStack do singleton recipelike+(䷱) _ recipelike = withFrozenCallStack do singleton recipelike++infixr 0 |=|++infixr 0 ䷱+ -- | Put a 'Recipe' into the 'Cauldron'. -- -- Only one recipe is allowed for each bean type, so 'insert' for a@@ -427,12 +512,12 @@   Cauldron m insert recipelike Cauldron {recipeMap} = withFrozenCallStack do   let rep = typeRep (Proxy @bean)-  Cauldron {recipeMap = Map.insert rep (SomeRecipe callStack (toRecipe recipelike)) recipeMap}+  Cauldron {recipeMap = Map.insert rep (SomeRecipe (Data.List.NonEmpty.singleton callStack) (toRecipe recipelike)) recipeMap} --- | Tweak a 'Recipe' inside the 'Cauldron', if the recipe exists.+-- | Tweak a 'Recipe' inside the 'Cauldron', if it exists there. adjust ::   forall {m} bean.-  (Typeable bean) =>+  (Typeable bean, HasCallStack) =>   (Recipe m bean -> Recipe m bean) ->   Cauldron m ->   Cauldron m@@ -443,10 +528,14 @@         recipeMap           & Map.adjust             do-              \r@SomeRecipe {_recipe = _recipe :: Recipe m a} ->+              \SomeRecipe {_recipeCallStacks, _recipe = _recipe :: Recipe m a} ->                 case testEquality (Type.Reflection.typeRep @bean) (Type.Reflection.typeRep @a) of                   Nothing -> error "should never happen"-                  Just Refl -> r {_recipe = f _recipe}+                  Just Refl ->+                    SomeRecipe+                      { _recipeCallStacks = _recipeCallStacks `Data.List.NonEmpty.appendList` [callStack],+                        _recipe = f _recipe+                      }             rep     } @@ -484,10 +573,9 @@ -- :} -- -- >>> :{---   cook @A forbidDepCycles ([---       recipe @A $ val $ wire loopyA---       ] :: Cauldron IO)---       & \case Left (DependencyCycleError _) -> "self dep is forbidden"; _ -> "oops"+--   (recipe @A $ val $ wire loopyA :: Cauldron IO)+--      & cook @A forbidDepCycles+--      & \case Left (DependencyCycleError _) -> "self dep is forbidden"; _ -> "oops" -- :} -- "self dep is forbidden" forbidDepCycles :: (Monad m) => Fire m@@ -523,9 +611,8 @@ -- :} -- -- >>> :{---   cook @A allowSelfDeps ([---       recipe @A $ val $ wire loopyA---       ] :: Cauldron IO)+--   (recipe @A $ val $ wire loopyA :: Cauldron IO)+--       & cook @A allowSelfDeps --       & \case Left (DependencyCycleError _) -> "oops"; _ -> "self dep is ok" -- :} -- "self dep is ok"@@ -540,11 +627,12 @@ -- :} -- -- >>> :{---   cook @U allowSelfDeps ([+--   mconcat [ --       recipe @U $ val $ wire loopyU,---       recipe @V $ val $ wire loopyV---       ] :: Cauldron IO)---       & \case Left (DependencyCycleError _) -> "cycle between 2 deps"; _ -> "oops"+--       recipe @V $ val $ wire loopyV :: Cauldron IO+--   ]+--    & cook @U allowSelfDeps+--    & \case Left (DependencyCycleError _) -> "cycle between 2 deps"; _ -> "oops" -- :} -- "cycle between 2 deps" allowSelfDeps :: (MonadFix m) => Fire m@@ -577,11 +665,12 @@ -- :} -- -- >>> :{---   cook @U allowDepCycles ([+--   mconcat [ --       recipe @U $ val $ wire loopyU,---       recipe @V $ val $ wire loopyV---       ] :: Cauldron IO)---       & \case Left (DependencyCycleError _) -> "oops"; _ -> "cycles are ok"+--       recipe @V $ val $ wire loopyV :: Cauldron IO+--   ]+--     & cook @U allowDepCycles+--     & \case Left (DependencyCycleError _) -> "oops"; _ -> "cycles are ok" -- :} -- "cycles are ok" allowDepCycles :: (MonadFix m) => Fire m@@ -596,7 +685,7 @@     }  fixyFollowPlanCauldron :: (MonadFix m) => Cauldron m -> BeanGetter -> Beans -> [BeanConstructionStep] -> m Beans-fixyFollowPlanCauldron = \cauldron previous initial plan -> do+fixyFollowPlanCauldron cauldron previous initial plan = do   mfix do     \final -> do       -- We prefer the final beans.@@ -640,8 +729,8 @@     AggregateBean TypeRep   deriving stock (Show, Eq, Ord) --- | Build the requested @bean@ using the 'Recipe's stored in the 'Cauldron'.--- The 'Cauldron' must contain a 'Recipe' for the requested bean, as well as+-- | Build the requested @bean@ using the 'Recipe's stored in 'Cauldron'.+-- The 'Cauldron's must contain a 'Recipe' for the requested bean, as well as -- 'Recipe's for producing all of its transitive dependencies. -- -- >>> :{@@ -649,7 +738,8 @@ -- :} -- -- >>> :{--- cook @A forbidDepCycles (mempty :: Cauldron IO)+-- (mempty :: Cauldron IO)+--  & cook @A forbidDepCycles --  & \case Left (MissingResultBeanError _) -> "no recipe for requested bean"; _ -> "oops" -- :} -- "no recipe for requested bean"@@ -660,7 +750,8 @@ -- :} -- -- >>> :{--- cook @B forbidDepCycles ([recipe $ val $ wire B] :: Cauldron IO)+-- (singleton $ val $ wire B :: Cauldron IO)+--  & cook @B forbidDepCycles --  & \case Left (MissingDependenciesError _) -> "no recipe for A"; _ -> "oops" -- :} -- "no recipe for A"@@ -669,7 +760,7 @@   (Monad m, Typeable bean) =>   -- | The types of dependency cycles that are allowed between beans.   Fire m ->-  -- | A 'Cauldron' containing the necessary 'Recipe's.+  -- | 'Cauldron's containing the necessary 'Recipe's.   Cauldron m ->   Either CookingError (m bean) cook fire cauldron = do@@ -682,10 +773,9 @@     pure bean  -- |------ Takes a 'Cauldron' converts it into a 'Constructor' where any unfilled--- dependencies are taken as the arguments of the 'Constructor'.  The--- 'Constructor' can later be included in a bigger 'Cauldron', which will+-- Takes a 'Cauldron' and converts it into a 'Constructor' where+-- any unfilled dependencies are taken as the arguments of the 'Constructor'.+-- The 'Constructor' can later be included in a bigger 'Cauldron', which will -- provide the missing dependencies. -- -- This function never fails with 'MissingDependenciesError'.@@ -714,15 +804,15 @@ -- -- >>> :{ -- do---   nested :: Constructor IO C <- nest @C forbidDepCycles [+--   nested :: Constructor IO C <- nest @C forbidDepCycles (mconcat [ --       recipe @A $ val $ wire makeA2, -- this will be used by makeC --       recipe @C $ val $ wire makeC -- takes B from outside---       ] & either throwIO pure---   action <- cook @C forbidDepCycles [+--       ]) & either throwIO pure+--   action <- cook @C forbidDepCycles (mconcat [ --       recipe @A $ val $ wire makeA, --       recipe @B $ val $ wire makeB, --       recipe @C $ nested---       ] & either throwIO pure+--       ]) & either throwIO pure --   C c <- action --   c -- :}@@ -735,11 +825,11 @@ -- -- >>> :{ -- do---   action <- cook @C forbidDepCycles [+--   action <- cook @C forbidDepCycles (mconcat [ --       recipe @A $ val $ wire makeA, --       recipe @B $ val $ wire makeB, --       recipe @C $ val $ wire makeC---       ] & either throwIO pure+--       ]) & either throwIO pure --   C c <- action --   c -- :}@@ -752,7 +842,7 @@   (Monad m, Typeable bean, HasCallStack) =>   -- | The types of dependency cycles that are allowed between beans.   Fire m ->-  -- | A 'Cauldron', possibly with unfilled dependencies.+  -- | 'Cauldron's, possibly with unfilled dependencies.   Cauldron m ->   Either CookingError (Constructor m bean) nest fire cauldron = withFrozenCallStack do@@ -770,7 +860,7 @@   () <- first MissingResultBeanError do checkEntryPointPresent (typeRep (Proxy @bean)) (Map.keysSet accumMap) cauldron   plan <- first DependencyCycleError do buildPlan shouldEnforceDependency cauldron   let missingDeps = collectMissingDeps (Map.keysSet accumMap) (Cauldron.keysSet cauldron) cauldron-  Right $+  Right     ( missingDeps,       Constructor         { _constructorCallStack = callStack,@@ -795,7 +885,7 @@   deriving stock (Show)  -- | Get a graph of dependencies between 'BeanConstructionStep's. The graph can--- be obtained even if the 'Cauldron' can't be 'cook'ed successfully.+-- be obtained even if the 'mconcat'ted 'Cauldron's can't be 'cook'ed successfully. getDependencyGraph :: Cauldron m -> DependencyGraph getDependencyGraph cauldron =   let (_, deps) = buildDepsCauldron cauldron@@ -807,7 +897,7 @@ checkNoDoubleDutyBeans cauldron = do   let (accumMap, beanSet) = cauldronRegs cauldron   let common = do-        (tr, (cs1,cs2)) <- Map.toList $ Map.intersectionWith (,) (fst <$> accumMap) beanSet+        (tr, (cs1, cs2)) <- Map.toList $ Map.intersectionWith (,) (fst <$> accumMap) beanSet         [DoubleDutyBean tr cs1 cs2]   case common of     ddb : ddbs -> Left $ ddb Data.List.NonEmpty.:| ddbs@@ -816,21 +906,22 @@ cauldronRegs :: Cauldron m -> (Map TypeRep (CallStack, Dynamic), Map TypeRep CallStack) cauldronRegs Cauldron {recipeMap} =   Map.foldMapWithKey-    do \rep aRecipe -> (recipeRegs aRecipe, Map.singleton rep (getRecipeCallStack aRecipe))+    do \rep aRecipe -> (recipeRegs aRecipe, Map.singleton rep (Data.List.NonEmpty.head $ getRecipeCallStack aRecipe))     recipeMap  -- | Returns the accumulators, not the main bean recipeRegs :: SomeRecipe m -> Map TypeRep (CallStack, Dynamic)-recipeRegs (SomeRecipe _ (Recipe {bean, decos})) = do+recipeRegs (SomeRecipe _ (Recipe {bare, decos})) = do   let extractRegReps c = (getConstructorCallStack c,) <$> (\ConstructorReps {regReps} -> regReps) (constructorReps c)-  extractRegReps bean+  extractRegReps bare     <> foldMap extractRegReps decos  -- | Missing depencencies for a 'Constructor'. data MissingDependencies = MissingDependencies CallStack TypeRep (Set TypeRep)   deriving stock (Show) -missingDepsToArgReps :: (Functor f, Foldable f) => +missingDepsToArgReps ::+  (Functor f, Foldable f) =>   f MissingDependencies ->   Set TypeRep missingDepsToArgReps = Set.unions . fmap (\(MissingDependencies _ _ missing) -> missing)@@ -843,17 +934,16 @@   Cauldron m ->   [MissingDependencies] collectMissingDeps accums available cauldron =-  demandsByConstructorsInCauldron cauldron & Data.Foldable.foldMap \(stack, tr, demanded) ->+  demandsByConstructorsInCauldron cauldron & Data.Foldable.foldMap \(stack, tr, demanded) -> do     let missing = Set.filter (`Set.notMember` (available `Set.union` accums)) demanded-     in if Set.null missing-          then []-          else [MissingDependencies stack tr missing]+    guard $ not (Set.null missing)+    [MissingDependencies stack tr missing]  demandsByConstructorsInCauldron :: Cauldron m -> [(CallStack, TypeRep, Set TypeRep)] demandsByConstructorsInCauldron Cauldron {recipeMap} = do-  (tr, SomeRecipe _ (Recipe {bean, decos})) <- Map.toList recipeMap-  ( let ConstructorReps {argReps = beanArgReps} = constructorReps bean-     in [(getConstructorCallStack bean, tr, beanArgReps)]+  (tr, SomeRecipe _ (Recipe {bare, decos})) <- Map.toList recipeMap+  ( let ConstructorReps {argReps = beanArgReps} = constructorReps bare+     in [(getConstructorCallStack bare, tr, beanArgReps)]     )     ++ do       decoCon <- Data.Foldable.toList decos@@ -874,16 +964,16 @@     Right plan -> do       Right plan -buildDepsCauldron :: Cauldron m -> (Map BeanConstructionStep CallStack, [(BeanConstructionStep, BeanConstructionStep)])+buildDepsCauldron :: forall m. Cauldron m -> (Map BeanConstructionStep CallStack, [(BeanConstructionStep, BeanConstructionStep)]) buildDepsCauldron Cauldron {recipeMap} = do   recipeMap     & Map.foldMapWithKey       \beanRep        SomeRecipe-         { _recipeCallStack,+         { _recipeCallStacks,            _recipe =              Recipe-               { bean = bean :: Constructor m bean,+               { bare,                  decos                }          } ->@@ -894,7 +984,7 @@                   (decoIndex, decoCon) <- zip [0 :: Int ..] (Data.Foldable.toList decos)                   [(PrimaryBeanDeco beanRep decoIndex, decoCon)]                 beanDeps = do-                  constructorEdges bareBean (constructorReps bean)+                  constructorEdges bareBean (constructorReps bare)                 decoDeps = do                   (decoStep, decoCon) <- decoSteps                   -- We remove the bean because from the args becase, in the@@ -912,8 +1002,8 @@                     -- The dep chain of completed bean -> decorators -> bare bean.                     zip (Data.List.NonEmpty.tail innerSteps) (Data.List.NonEmpty.toList innerSteps)             ( Map.fromList $-                [ (bareBean, getConstructorCallStack bean),-                  (boiledBean, _recipeCallStack)+                [ (bareBean, getConstructorCallStack bare),+                  (boiledBean, Data.List.NonEmpty.head _recipeCallStacks)                 ]                   ++ do                     (decoStep, decoCon) <- decoSteps@@ -942,7 +1032,7 @@              ]        ) -data BeanGetter = BeanGetter {_run :: forall t. (Typeable t) => Maybe t}+newtype BeanGetter = BeanGetter {_run :: forall t. (Typeable t) => Maybe t}  instance Semigroup BeanGetter where   BeanGetter {_run = run1} <> BeanGetter {_run = run2} =@@ -980,9 +1070,9 @@ followPlanStep makeBareView makeDecoView Cauldron {recipeMap} super item =   case item of     BarePrimaryBean rep -> case fromJust do Map.lookup rep recipeMap of-      SomeRecipe {_recipe = Recipe {bean}} -> do-        let ConstructorReps {beanRep} = constructorReps bean-        inserter <- followConstructor bean (makeBareView beanRep super)+      SomeRecipe {_recipe = Recipe {bare}} -> do+        let ConstructorReps {beanRep} = constructorReps bare+        inserter <- followConstructor bare (makeBareView beanRep super)         pure do inserter super     PrimaryBeanDeco rep index -> case fromJust do Map.lookup rep recipeMap of       SomeRecipe {_recipe = Recipe {decos}} -> do@@ -1001,6 +1091,7 @@ -- This can only work without blowing up if there aren't dependecy cycles -- and the order of construction respects the depedencies! followConstructor ::+  forall m bean.   (Monad m, Typeable bean) =>   Constructor m bean ->   BeanGetter ->@@ -1093,7 +1184,7 @@ removeDecos DependencyGraph {graph} =   DependencyGraph {graph = Graph.induce (\case PrimaryBeanDeco {} -> False; _ -> True) graph} --- | Unifies 'PrimaryBean's with their respective 'BarePrimaryBean's and 'PrimaryBeanDeco's.+-- | Unifies 'FinishedBean's with their respective 'BarePrimaryBean's, 'PrimaryBeanDeco's and 'AggregateBean's. -- -- Also removes any self-loops. collapseBeans :: DependencyGraph -> DependencyGraph@@ -1140,31 +1231,29 @@           []         Just (MissingDependenciesError missingDeps) ->           let missing = missingDepsToArgReps missingDeps-           in-          case step of-            FinishedBean rep-              | Set.member rep missing ->-                  [ fromString "style" Dot.:= fromString "dashed",-                    fromString "color" Dot.:= fromString "red"-                  ]-            _ -> []+           in case step of+                FinishedBean rep+                  | Set.member rep missing ->+                      [ fromString "style" Dot.:= fromString "dashed",+                        fromString "color" Dot.:= fromString "red"+                      ]+                _ -> []         Just (DoubleDutyBeansError doubleDutyBeans) ->-          let bs =  Set.fromList $ do-                      DoubleDutyBean ddb _ _ <- Data.List.NonEmpty.toList doubleDutyBeans-                      [ddb]-          in-          case step of-            FinishedBean rep-              | Set.member rep bs ->-                  [ fromString "style" Dot.:= fromString "bold",-                    fromString "color" Dot.:= fromString "green"-                  ]-            AggregateBean rep-              | Set.member rep bs ->-                  [ fromString "style" Dot.:= fromString "bold",-                    fromString "color" Dot.:= fromString "green"-                  ]-            _ -> []+          let bs = Set.fromList $ do+                DoubleDutyBean ddb _ _ <- Data.List.NonEmpty.toList doubleDutyBeans+                [ddb]+           in case step of+                FinishedBean rep+                  | Set.member rep bs ->+                      [ fromString "style" Dot.:= fromString "bold",+                        fromString "color" Dot.:= fromString "green"+                      ]+                AggregateBean rep+                  | Set.member rep bs ->+                      [ fromString "style" Dot.:= fromString "bold",+                        fromString "color" Dot.:= fromString "green"+                      ]+                _ -> []         Just (DependencyCycleError (DependencyCycle (Set.fromList . Data.Foldable.toList . fmap fst -> cycleStepSet))) ->           if Set.member step cycleStepSet             then@@ -1202,7 +1291,7 @@ -- -- A typical initialization monad will be 'IO', used for example to create -- mutable references that the bean will use internally. Sometimes the--- constructor will allocate resources with bracket-like operations, and in that+-- constructor will acquire resources with bracket-like operations, and in that -- case a monad like 'Cauldron.Managed.Managed' might be needed instead. data Constructor m bean = Constructor   { _constructorCallStack :: CallStack,@@ -1307,6 +1396,7 @@ eff' = Constructor callStack  runConstructor ::+  forall m bean.   (Monad m) =>   BeanGetter ->   Constructor m bean ->@@ -1317,27 +1407,27 @@   pure (runRegs (getRegsReps _args) regs)  -- | Change the monad in which the 'Constructor'\'s effects take place.-hoistConstructor :: (forall x. m x -> n x) -> Constructor m bean -> Constructor n bean+hoistConstructor :: forall m n bean. (forall x. m x -> n x) -> Constructor m bean -> Constructor n bean hoistConstructor f c@Constructor {_args} = c {_args = fmap f _args}  -- | More general form of 'hoistConstructor' that enables precise control over the inner `Args`.-hoistConstructor' :: (Args (m (Regs bean)) -> Args (n (Regs bean))) -> Constructor m bean -> Constructor n bean+hoistConstructor' :: forall m n bean. (Args (m (Regs bean)) -> Args (n (Regs bean))) -> Constructor m bean -> Constructor n bean hoistConstructor' f c@Constructor {_args} = c {_args = f _args}  -- | Get the inner 'Args' value for the 'Constructor', typically for inspecting -- 'TypeRep's of its arguments/registrations.-getConstructorArgs :: Constructor m bean -> Args (m (Regs bean))+getConstructorArgs :: forall m bean. Constructor m bean -> Args (m (Regs bean)) getConstructorArgs (Constructor {_args}) = _args  -- | For debugging purposes, 'Constructor's remember the 'CallStack' -- of when they were created.-getConstructorCallStack :: Constructor m bean -> CallStack+getConstructorCallStack :: forall m bean. Constructor m bean -> CallStack getConstructorCallStack (Constructor {_constructorCallStack}) = _constructorCallStack  -- | For debugging purposes, 'SomeRecipe's remember the 'CallStack' -- of when they were created.-getRecipeCallStack :: SomeRecipe m -> CallStack-getRecipeCallStack (SomeRecipe {_recipeCallStack}) = _recipeCallStack+getRecipeCallStack :: SomeRecipe m -> NonEmpty CallStack+getRecipeCallStack (SomeRecipe {_recipeCallStacks}) = _recipeCallStacks  -- | The set of all 'TypeRep' keys of the map. keysSet :: Cauldron m -> Set TypeRep@@ -1411,12 +1501,12 @@ -- >>> :{ -- do --   let cauldron :: Cauldron Identity---       cauldron = [+--       cauldron = mconcat [ --           recipe @U $ val $ wire makeU, --           recipe @V $ val $ wire makeV, --           recipe @W $ val $ wire W --         ]---   Identity w <- cook @W forbidDepCycles cauldron & either throwIO pure+--   Identity w <- cauldron & cook @W forbidDepCycles & either throwIO pure --   pure w -- :} -- W (Sum {getSum = 8})@@ -1432,20 +1522,26 @@ -- :} -- -- >>> :{---   cook @X forbidDepCycles ([+--   (mconcat [ --       recipe @X $ val $ wire makeX,---       recipe @(Sum Int) $ val $ wire makeAgg---       ] :: Cauldron IO)---       & \case Left (DoubleDutyBeansError _) -> "Sum Int is aggregate and primary"; _ -> "oops"+--       recipe @(Sum Int) $ val $ wire makeAgg :: Cauldron IO+--   ])+--     & cook @X forbidDepCycles+--     & \case Left (DoubleDutyBeansError _) -> "Sum Int is aggregate and primary"; _ -> "oops" -- :} -- "Sum Int is aggregate and primary"  -- $setup -- >>> :set -XBlockArguments+-- >>> :set -XApplicativeDo -- >>> :set -XOverloadedLists+-- >>> :set -XRequiredTypeArguments+-- >>> :set -XExplicitNamespaces -- >>> :set -Wno-incomplete-uni-patterns -- >>> import Data.Functor.Identity -- >>> import Data.Function ((&)) -- >>> import Data.Monoid -- >>> import Data.Either (either, isLeft) -- >>> import Control.Exception (throwIO)+-- >>> import System.IO+-- >>> import Cauldron.Managed

@@ -212,9 +212,9 @@ -- \"from the future\". -- -- >>> :{--- runArgs (taste Cauldron.Beans.empty) (arg @Int)+-- try @LazilyReadBeanMissing $ evaluate $ runArgs (taste Cauldron.Beans.empty) (arg @Int) -- :}--- *** Exception: LazilyReadBeanMissing Int+-- Left (LazilyReadBeanMissing Int) -- -- If more safety is needed, one can perform additional preliminary checks with -- the help of 'getArgsReps'.@@ -407,3 +407,5 @@ -- >>> import Data.Function ((&)) -- >>> import Data.Monoid -- >>> import Cauldron.Beans (taste)+-- >>> import System.IO+-- >>> import Control.Exception

@@ -2,7 +2,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE NoFieldSelectors #-} @@ -39,9 +38,10 @@ import Data.Semigroup qualified import Data.Set (Set) import Data.Set qualified as Set+import Data.Type.Equality (TestEquality (testEquality)) import Data.Typeable import GHC.IsList-import Type.Reflection (SomeTypeRep (..), eqTypeRep)+import Type.Reflection (SomeTypeRep (..)) import Type.Reflection qualified  empty :: Beans@@ -67,7 +67,7 @@ taste Beans {beanMap} =   let tr = Type.Reflection.typeRep @bean    in case Map.lookup (SomeTypeRep tr) beanMap of-        Just (Dynamic tr' v) | Just HRefl <- tr `eqTypeRep` tr' -> Just v+        Just (Dynamic tr' v) | Just Refl <- tr `testEquality` tr' -> Just v         _ -> Nothing  -- | A map of 'Dynamic' values, indexed by the 'TypeRep' of each 'Dynamic'.@@ -116,11 +116,11 @@  instance Eq SomeMonoidTypeRep where   (SomeMonoidTypeRep tr1) == (SomeMonoidTypeRep tr2) =-    (SomeTypeRep tr1) == (SomeTypeRep tr2)+    SomeTypeRep tr1 == SomeTypeRep tr2  instance Ord SomeMonoidTypeRep where   (SomeMonoidTypeRep tr1) `compare` (SomeMonoidTypeRep tr2) =-    (SomeTypeRep tr1) `compare` (SomeTypeRep tr2)+    SomeTypeRep tr1 `compare` SomeTypeRep tr2  -- | The 'mempty' value corresponding to the inner 'Type.Reflection.TypeRep'. someMonoidTypeRepMempty :: SomeMonoidTypeRep -> Dynamic@@ -141,8 +141,8 @@       combine tr d1 d2 =         case (Map.lookup tr d, d1, d2) of           (Just (SomeMonoidTypeRep tr'), Dynamic tr1 v1, Dynamic tr2 v2)-            | Just HRefl <- tr' `eqTypeRep` tr1,-              Just HRefl <- tr' `eqTypeRep` tr2 ->+            | Just Refl <- tr' `testEquality` tr1,+              Just Refl <- tr' `testEquality` tr2 ->                 Type.Reflection.withTypeable tr' (toDyn (v1 <> v2))           _ -> d2    in Beans $ Map.unionWithKey combine beans1 beans2

@@ -1,6 +1,5 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}@@ -76,7 +75,6 @@ where  import Cauldron-import Cauldron.Args import Cauldron.Managed import Control.Exception (Exception (..)) import Control.Monad.Fix

@@ -1,10 +1,15 @@ {-# LANGUAGE BlockArguments #-} +-- | A datatype that encapsulates @with...@-style callback-taking functions that+-- acquire and release resources.+--+-- Here's [a video about how it works](https://youtu.be/2v7BAQh_dRs). module Cauldron.Managed   ( -- * The Managed monad for handling resources     Managed,     managed,     with,+    runManaged,   ) where @@ -50,10 +55,6 @@     where       unManage (Managed a) = a --- | Make use of the managed resource by supplying a callback.-with :: Managed a -> (a -> IO b) -> IO b-with (Managed r) = r- instance Functor Managed where   fmap f (Managed m) = Managed (\k -> m (\x -> k (f x)))   {-# INLINE fmap #-}@@ -77,6 +78,23 @@   {-# INLINE liftIO #-}  instance MonadFail Managed where-    fail s = Managed (\return_ -> do-        a <- fail @IO s-        return_ a )+  fail s =+    Managed+      ( \return_ -> do+          a <- fail @IO s+          return_ a+      )++instance (Semigroup a) => Semigroup (Managed a) where+  (<>) = liftA2 (<>)++instance (Monoid a) => Monoid (Managed a) where+  mempty = pure mempty++-- | Make use of the managed resource by supplying a callback.+with :: Managed a -> (a -> IO b) -> IO b+with (Managed r) = r++-- | Run a `Managed` computation, enforcing that no acquired resources leak+runManaged :: Managed () -> IO ()+runManaged (Managed r) = r pure

@@ -112,17 +112,17 @@  cauldron :: Cauldron IO cauldron :: Cauldron IO =-  fromRecipeList-    [ recipe $ val $ pure makeA,-      recipe $ val $ pure makeB,-      recipe $ val $ wire makeC,-      recipe $ val $ wire makeD,-      recipe $ val $ wire makeE,+  mconcat+    [ singleton $ val $ pure makeA,+      singleton $ val $ pure makeB,+      singleton $ val $ wire makeC,+      singleton $ val $ wire makeD,+      singleton $ val $ wire makeE,       -- The type app in val checks the specificity, see val definition.       recipe @F $ val @F $ wire makeF,       recipe @G         Recipe-          { bean = val $ wire makeG,+          { bare = val $ wire makeG,             decos =               fromDecoList                 [ val $ wire makeGDeco1@@ -131,7 +131,7 @@       recipe @H $ val $ wire makeH,       recipe @Z         Recipe-          { bean = val $ wire makeZ,+          { bare = val $ wire makeZ,             decos =               fromDecoList                 [ val $ wire makeZDeco1,

@@ -65,7 +65,7 @@  cauldron :: Cauldron Identity cauldron =-  fromRecipeList+  mconcat     [ recipe @(Serializer Foo) $ val $ wire makeFooSerializer,       recipe @(Serializer Bar) $ val $ wire makeBarSerializer,       recipe @(Serializer Baz) $ val $ wire makeBazSerializer@@ -113,7 +113,7 @@  cauldronAccums1 :: Cauldron Identity cauldronAccums1 =-  fromRecipeList+  mconcat     [ recipe @(Serializer Foo) $ val $ wire $ \sb -> (Acc 5, makeFooSerializer sb),       recipe @(Serializer Bar) $ val $ wire $ \sf sb -> (Acc 3, makeBarSerializer sf sb),       recipe @(Serializer Baz) $ val $ wire $ \sf -> (Acc 7, makeBazSerializer sf)@@ -121,7 +121,7 @@  cauldronAccums2 :: Cauldron Identity cauldronAccums2 =-  fromRecipeList+  mconcat     [ recipe @(Serializer Foo) $ val $ wire $ \(_ :: Acc) sb -> makeFooSerializer sb,       recipe @(Serializer Bar) $ val $ wire $ \sf sb -> (Acc 3, makeBarSerializer sf sb),       recipe @(Serializer Baz) $ val $ wire $ \sf -> (Acc 7, makeBazSerializer sf)@@ -129,7 +129,7 @@  cauldronAccumsOops1 :: Cauldron Identity cauldronAccumsOops1 =-  fromRecipeList+  mconcat     [ recipe @(Serializer Foo) $ val $ wire $ \(_ :: Acc) sb -> (Acc 5, makeFooSerializer sb),       recipe @(Serializer Bar) $ val $ wire $ \sf sb -> (Acc 3, makeBarSerializer sf sb),       recipe @(Serializer Baz) $ val $ wire $ \sf -> (Acc 7, makeBazSerializer sf)@@ -137,7 +137,7 @@  cauldronAccumsOops2 :: Cauldron Identity cauldronAccumsOops2 =-  fromRecipeList+  mconcat     [ recipe @(Serializer Foo) $ val $ wire $ \(_ :: Acc) sb -> (Bcc 5, makeFooSerializer sb),       recipe @(Serializer Bar) $ val $ wire $ \(_ :: Bcc) sf sb -> (Acc 5, makeBarSerializer sf sb),       recipe @(Serializer Baz) $ val $ wire $ \sf -> (Acc 7, makeBazSerializer sf)

@@ -72,11 +72,11 @@  managedCauldron :: IORef [Text] -> Cauldron Managed managedCauldron ref =-  fromRecipeList+  mconcat     [ recipe @(Logger IO) $ eff $ wire $ managed (makeLogger ref),       recipe @(Weird IO)         Recipe-          { bean = eff do+          { bare = eff do               wire \logger self -> managed (makeSelfInvokingWeird ref logger self),             decos =               fromDecoList

@@ -1,6 +1,5 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE BlockArguments #-}-{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}@@ -14,6 +13,7 @@ import Data.Foldable qualified import Data.Function ((&)) import Data.IORef+import Data.List (sort) import Data.Map (Map) import Data.Map qualified as Map import Data.Monoid@@ -22,7 +22,6 @@ import Data.Typeable (typeRep) import Test.Tasty import Test.Tasty.HUnit-import Data.List (sort)  type Text = String @@ -111,7 +110,6 @@  cauldron :: Cauldron M cauldron =-  fromRecipeList     [ recipe @(Logger M) $ eff $ pure makeLogger,       recipe @(Repository M) $ eff $ wire makeRepository,       recipe @(Initializer, Repository M) $ val_ $ wire (,)@@ -135,14 +133,12 @@  cauldronX1 :: Cauldron M cauldronX1 =-  fromRecipeList     [ recipe @(Logger M) $ eff $ pure makeLogger,       recipe @(Weird M) $ eff $ wire makeWeird -- overwritten     ]  cauldronX2 :: Cauldron M cauldronX2 =-  fromRecipeList     [ recipe @(Repository M) $ eff $ do         action <- wire makeRepository         pure do@@ -150,7 +146,7 @@           pure (initializer, repo),       recipe @(Weird M)         Recipe-          { bean = eff $ wire makeSelfInvokingWeird,+          { bare = eff $ wire makeSelfInvokingWeird,             decos =               fromDecoList                 [ val $ wire (weirdDeco "inner"),@@ -162,12 +158,8 @@  data Result = Result Initializer (Repository M) (Weird M) -cauldronX :: Cauldron M-cauldronX = cauldronX1 <> cauldronX2- cauldronLonely :: Cauldron M cauldronLonely =-  fromRecipeList     [ recipe @(Lonely M) $ val $ pure makeLonely     ] @@ -175,8 +167,12 @@ tests =   testGroup     "All"-    [ testCase "value" do-        (_, traces) <- case cook' cauldron of+    [ testCase "lookup" do+        case cauldron & Cauldron.lookup @(Logger M) (\_ _ -> ()) of+          Just () -> pure ()+          Nothing -> assertFailure "bean not found",+      testCase "value" do+        (_, traces) <- case cook' [cauldron] of           Left _ -> assertFailure "could not wire"           Right beansAction -> runWriterT do             boiledBeans <- beansAction@@ -195,7 +191,7 @@           ]           traces,       testCase "value sequential" do-        ((), traces) <- case cook @Result allowSelfDeps cauldronX of+        ((), traces) <- case cook @Result allowSelfDeps (mconcat [cauldronX1, cauldronX2]) of           Left _ -> assertFailure "could not wire"           Right beansAction -> do             runWriterT do@@ -208,23 +204,25 @@               pure ()         assertEqual           "traces"-          (sort [ -- "weird constructor", -- not happens, because overwritten-            -- the order of the traces here is a bit too overspecified. several orders could be valid.-            "logger constructor",-            "self-invoking weird constructor",-            "logger init",-            "repo init invoking logger",-            "store",-            "findById",-            -- the deco is applied! The outer the deco, the earliest is invoked.-            "deco for anotherWeirdOp outer",-            "deco for anotherWeirdOp inner",-            "another weirdOp 2",-            "deco for weirdOp outer",-            "deco for weirdOp inner",-            -- note that the self-invocation used the method from 'makeSelfInvokingWeird'-            "weirdOp 2"-          ])+          ( sort+              [ -- "weird constructor", -- not happens, because overwritten+                -- the order of the traces here is a bit too overspecified. several orders could be valid.+                "logger constructor",+                "self-invoking weird constructor",+                "logger init",+                "repo init invoking logger",+                "store",+                "findById",+                -- the deco is applied! The outer the deco, the earliest is invoked.+                "deco for anotherWeirdOp outer",+                "deco for anotherWeirdOp inner",+                "another weirdOp 2",+                "deco for weirdOp outer",+                "deco for weirdOp inner",+                -- note that the self-invocation used the method from 'makeSelfInvokingWeird'+                "weirdOp 2"+              ]+          )           (sort traces),       -- case getDependencyGraph cauldronNonEmpty of       --  dg2  -> do@@ -237,8 +235,12 @@        testCase "value nested" do         ((), traces) <- case ( do-                                 constructorX2 <- nest allowSelfDeps cauldronX2-                                 cook @Result allowSelfDeps (cauldronX1 & Cauldron.insert @Result constructorX2)+                                 constructorX2 <- nest allowSelfDeps [cauldronX2]+                                 cook @Result+                                   allowSelfDeps+                                   (mconcat [ cauldronX1,+                                     Cauldron.recipe @Result constructorX2+                                   ])                              ) of           Left _ -> assertFailure "could not wire"           Right beansAction -> do@@ -252,24 +254,26 @@               pure ()         assertEqual           "traces"-          (sort [ -- the order of the traces here is a bit too overspecified. several orders could be valid.-            "logger constructor",-            "self-invoking weird constructor",-            "weird constructor", -- note that this is present. Overwritten by nested, but still built-            -- The absence of the logger init is because we are only getting the aggregate beans from the nested.-            -- "logger init",-            "repo init invoking logger",-            "store",-            "findById",-            -- the deco is applied! The outer the deco, the earliest is invoked.-            "deco for anotherWeirdOp outer",-            "deco for anotherWeirdOp inner",-            "another weirdOp 2",-            "deco for weirdOp outer",-            "deco for weirdOp inner",-            -- note that the self-invocation used the method from 'makeSelfInvokingWeird'-            "weirdOp 2"-          ])+          ( sort+              [ -- the order of the traces here is a bit too overspecified. several orders could be valid.+                "logger constructor",+                "self-invoking weird constructor",+                "weird constructor", -- note that this is present. Overwritten by nested, but still built+                -- The absence of the logger init is because we are only getting the aggregate beans from the nested.+                -- "logger init",+                "repo init invoking logger",+                "store",+                "findById",+                -- the deco is applied! The outer the deco, the earliest is invoked.+                "deco for anotherWeirdOp outer",+                "deco for anotherWeirdOp inner",+                "another weirdOp 2",+                "deco for weirdOp outer",+                "deco for weirdOp inner",+                -- note that the self-invocation used the method from 'makeSelfInvokingWeird'+                "weirdOp 2"+              ]+          )           (sort traces),       -- case getDependencyGraph cauldronNonEmpty of       --  dg2  -> do@@ -290,19 +294,20 @@             pure ()         pure (),       testCase "cauldron missing dep" do-        case cook' cauldronMissingDep of-          Left (MissingDependenciesError missingDeps )-            | [MissingDependencies _ tr missingSet]  <- Data.Foldable.toList missingDeps,-              tr == typeRep (Proxy @(Repository M)) && missingSet == Data.Set.singleton (typeRep (Proxy @(Logger M))) -> pure ()+        case cook' [cauldronMissingDep] of+          Left (MissingDependenciesError missingDeps)+            | [MissingDependencies _ tr missingSet] <- Data.Foldable.toList missingDeps,+              tr == typeRep (Proxy @(Repository M)) && missingSet == Data.Set.singleton (typeRep (Proxy @(Logger M))) ->+                pure ()           _ -> assertFailure "missing dependency not detected"         pure (),       testCase "cauldron with double duty bean" do-        case cook' cauldronDoubleDutyBean of+        case cook' [cauldronDoubleDutyBean] of           Left (DoubleDutyBeansError _) -> pure ()           _ -> assertFailure "double duty beans not detected"         pure (),       testCase "cauldron with cycle" do-        case cook' cauldronWithCycle of+        case cook' [cauldronWithCycle] of           Left (DependencyCycleError (DependencyCycle vs)) ->             -- Why not a cycle of length 3? Because there also are bare versions for each bean.             assertEqual "cycle of the expected length" 4 (Data.Foldable.length vs)