registry 0.3.3.4 → 0.4.0.0

raw patch · 17 files changed

+428/−257 lines, 17 filesdep ~multimapPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: multimap

API changes (from Hackage documentation)

Files

• registry.cabal +6/−3
• src/Data/Registry/Internal/Make.hs +57/−35
• src/Data/Registry/Internal/MultiMap.hs +18/−0
• src/Data/Registry/Internal/Registry.hs +23/−54
• src/Data/Registry/Internal/Statistics.hs +11/−7
• src/Data/Registry/Internal/Types.hs +94/−25
• src/Data/Registry/Registry.hs +26/−73
• src/Data/Registry/State.hs +10/−11
• test/Test/Data/Registry/Internal/GensRegistry.hs +14/−3
• test/Test/Data/Registry/Internal/RegistrySpec.hs +15/−13
• test/Test/Data/Registry/Internal/TypesSpec.hs +6/−6
• test/Test/Data/Registry/Make/MemoizeSpec.hs +24/−3
• test/Test/Data/Registry/Make/SpecializationFunctionsSpec.hs +98/−0
• test/Test/Data/Registry/Make/SpecializationSpec.hs +14/−14
• test/Test/Data/Registry/Make/TweakingSpec.hs +10/−8
• test/Test/Tutorial/Exercise3.hs +1/−1
• test/Test/Tutorial/Exercise4.hs +1/−1

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ef9d8cc091c21d8e88e3d25be49e4cf852ebae600dd6a6ce1f0076bed35820de+-- hash: d44a2153bfc290f93fe7c376691bb652a7638881f01e9c65797b4610dd06da67  name:           registry-version:        0.3.3.4+version:        0.4.0.0 synopsis:       data structure for assembling components description:    This library provides a "Registry" which is a data structure containing a list of functions and values representing dependencies in a directed acyclic graph. A `make` function can then be used to create a value of a specific type out of the registry.                 You can start with the [README](https://github.com/etorreborre/registry/blob/master/README.md) for a full description of the library.@@ -31,6 +31,7 @@       Data.Registry.Internal.Dot       Data.Registry.Internal.Dynamic       Data.Registry.Internal.Make+      Data.Registry.Internal.MultiMap       Data.Registry.Internal.Reflection       Data.Registry.Internal.Registry       Data.Registry.Internal.Stack@@ -68,6 +69,7 @@     , hashable >=1.2 && <1.5     , mmorph >=1.0 && <2     , mtl >=2.0 && <3+    , multimap >=1.0 && <2     , protolude >=0.2 && <0.4     , resourcet >=1.1 && <1.3     , semigroupoids >=5.0 && <5.4@@ -94,6 +96,7 @@       Test.Data.Registry.Internal.TypesSpec       Test.Data.Registry.Make.MakeSpec       Test.Data.Registry.Make.MemoizeSpec+      Test.Data.Registry.Make.SpecializationFunctionsSpec       Test.Data.Registry.Make.SpecializationSpec       Test.Data.Registry.Make.TweakingSpec       Test.Data.Registry.MonadRandomSpec@@ -141,7 +144,7 @@     , io-memoize <1.2     , mmorph >=1.0 && <2     , mtl >=2.0 && <3-    , multimap <1.3+    , multimap <2     , protolude >=0.2 && <0.4     , random <2.0     , registry

@@ -12,13 +12,13 @@ --    'Data.Registry.Make' module Data.Registry.Internal.Make where -import qualified Data.List as L hiding (unlines)+import Data.List qualified as L hiding (unlines) import Data.Registry.Internal.Dynamic import Data.Registry.Internal.Reflection (showSingleType) import Data.Registry.Internal.Registry import Data.Registry.Internal.Stack import Data.Registry.Internal.Types-import qualified Data.Text as T+import Data.Text qualified as T import Protolude as P hiding (Constructor) import Type.Reflection @@ -30,22 +30,38 @@ --  Functions is the list of all the constructors in the Registry --  Specializations is a list of specific values to use in a given context, overriding the normal search --  Modifiers is a list of functions to apply right before a value is stored in the Registry-makeUntyped ::-  SomeTypeRep ->-  Context ->-  Functions ->-  Specializations ->-  Modifiers ->-  Stack (Maybe Value)+makeUntyped :: SomeTypeRep -> Context -> Functions -> Specializations -> Modifiers -> Stack (Maybe Value) makeUntyped targetType context functions specializations modifiers = do   values <- getValues-  -- is there already a value with the desired type?-  let foundValue = findValue targetType context specializations values+  -- is there already a value with the desired type? Or a specialization+  let foundValue = findValueOrSpecialization targetType context specializations values    case foundValue of     Nothing ->+      makeWithConstructor+    -- existing value+    Just (Right v) -> do+      modified <- storeValue modifiers v+      pure (Just modified)+    -- specialization+    Just (Left specialization) -> do+      -- if the specialization is just a value, return it+      case createValueFromSpecialization context specialization of+        UntypedValue v -> do+          modified <- storeValue modifiers v+          pure (Just modified)+        UntypedFunction f -> do+          -- we don't fail the building if a specialization cannot be applied+          -- we try to use an already created value or build one from scratch+          catchError (makeWithFunction f $ Just specialization) $ \_ ->+            case findCompatibleCreatedValue targetType specializations values of+              Just v -> pure (Just v)+              Nothing -> makeWithConstructor+  where+    makeWithConstructor :: Stack (Maybe Value)+    makeWithConstructor = do       -- if not, is there a way to build such value?-      case findConstructor targetType functions of+      case findFunction targetType functions of         Nothing ->           lift $             Left $@@ -53,32 +69,38 @@                 <> T.intercalate "\nrequiring " (showContextTargets context)                 <> "\n\nNo constructor was found for "                 <> showSingleType targetType-        Just function -> do-          let inputTypes = collectInputTypes function-          inputs <- makeInputs function inputTypes context functions specializations modifiers+        Just f ->+          makeWithFunction f Nothing -          if length inputs /= length inputTypes-            then -- report an error if we cannot make enough input parameters to apply the function+    makeWithFunction :: Function -> Maybe Specialization -> Stack (Maybe Value)+    makeWithFunction f mSpecialization = do+      let inputTypes = collectInputTypes f+      inputs <- makeInputs f inputTypes context functions specializations modifiers -              let madeInputTypes = fmap valueDynTypeRep inputs-                  missingInputTypes = inputTypes L.\\ madeInputTypes-               in lift $-                    Left $-                      T.unlines $-                        ["could not make all the inputs for ", show (funDescription function), ". Only "]-                          <> (show <$> inputs)-                          <> ["could be made. Missing"]-                          <> fmap show missingInputTypes-            else do-              -- else apply the function and store the output value in the registry-              value <- lift $ applyFunction function inputs-              modified <- storeValue modifiers value+      if length inputs /= length inputTypes+        then do+          -- report an error if we cannot make enough input parameters to apply the function -              functionApplied modified inputs-              pure (Just modified)-    Just v -> do-      modified <- storeValue modifiers v-      pure (Just modified)+          let madeInputTypes = fmap valueDynTypeRep inputs+          let missingInputTypes = inputTypes L.\\ madeInputTypes+          lift . Left . T.unlines $+            ["could not make all the inputs for ", show (funDescription f), ". Only "]+              <> (show <$> inputs)+              <> ["could be made. Missing"]+              <> fmap show missingInputTypes+        else do+          -- else apply the function and store the output value in the registry+          value <- lift $ applyFunction f inputs+          let valueWithContext =+                case (mSpecialization, value) of+                  (Just s, CreatedValue d desc Nothing deps) ->+                    CreatedValue d desc (Just (SpecializationContext context s)) deps+                  _ ->+                    value+          modified <- storeValue modifiers valueWithContext++          functionApplied modified inputs+          pure (Just modified)  -- | Show the target type and possibly the constructor function requiring it --   for every target type in the context

@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.Registry.Internal.MultiMap () where++import Data.MultiMap (MultiMap)+import Data.MultiMap qualified as MM+import Protolude as P hiding (show)+import Prelude (show)++instance (Show k, Show v) => Show (MultiMap k v) where+  show = show . MM.assocs++instance (Ord k) => Semigroup (MultiMap k v) where+  (<>) m1 m2 = MM.fromList (MM.toList m1 <> MM.toList m2)++instance (Ord k) => Monoid (MultiMap k v) where+  mempty = MM.empty+  mappend = (<>)

@@ -33,64 +33,37 @@ --    3. if an already created value has the right type and is not specialized --       but if there is an incompatible specialization for one of its dependencies --       then it cannot be used-findValue ::-  SomeTypeRep ->-  Context ->-  Specializations ->-  Values ->-  Maybe Value-findValue target context specializations values =-  let -- 1. first try to find the target value in the list of specializations-      -- those all are all the specializations which make sense in this context-      applicableSpecializations = (specializations `applicableTo` context)-      bestSpecializedValue = findBestSpecializedValue target context applicableSpecializations+findValueOrSpecialization :: SomeTypeRep -> Context -> Specializations -> Values -> Maybe (Either Specialization Value)+findValueOrSpecialization target context specializations values = do+  -- 1. first try to find the target value in the list of specializations+  -- those all are all the specializations which make sense in this context+  let applicableSpecializations = specializations `applicableTo` context+  let bestSpecialization = findBestSpecializationFromApplicable target context applicableSpecializations -      compatibleValue = findCompatibleCreatedValue target specializations values-   in bestSpecializedValue <|> compatibleValue+  let compatibleValue = findCompatibleCreatedValue target specializations values+  fmap Left bestSpecialization <|> fmap Right compatibleValue  -- | Among all the applicable specializations take the most specific one --   if there exists any-findBestSpecializedValue :: SomeTypeRep -> Context -> Specializations -> Maybe Value-findBestSpecializedValue target context (Specializations sp) =-  let -- the candidates must have the required type-      specializationCandidates = filter (\s -> target == specializationTargetType s) sp-      -- the best specialization is the one having its last context type the deepest in the current context-      bestSpecializations = sortOn (specializationRange context) specializationCandidates-      bestSpecializedValue = head bestSpecializations-   in createValueFromSpecialization context <$> bestSpecializedValue+findBestSpecializationFromApplicable :: SomeTypeRep -> Context -> Specializations -> Maybe Specialization+findBestSpecializationFromApplicable target context (Specializations sp) = do+  -- the candidates must have the required type+  let specializationCandidates = filter (\s -> target == specializationTargetType s) sp+  -- the best specialization is the one having its last context type the deepest in the current context+  let bestSpecializations = sortOn (specializationRange context) specializationCandidates+  head bestSpecializations  -- | Among all the created values, take a compatible one -- --    - 2. and 3. if that value is a specialized value or has specialized --      dependencies it must be compatible with the current context findCompatibleCreatedValue :: SomeTypeRep -> Specializations -> Values -> Maybe Value-findCompatibleCreatedValue target specializations (Values vs) =-  let isApplicableValue value = valueDynTypeRep value == target-      isNotSpecializedForAnotherContext value =+findCompatibleCreatedValue target specializations values = do+  let isNotSpecializedForAnotherContext value =         not (hasSpecializedDependencies specializations value)           && not (isInSpecializationContext target value) -      applicableValues = filter ((&&) <$> isApplicableValue <*> isNotSpecializedForAnotherContext) vs-   in head applicableValues---- | Find a constructor function returning a target type---   from a list of constructors-findConstructor ::-  SomeTypeRep ->-  Functions ->-  Maybe Function-findConstructor _ (Functions []) = Nothing-findConstructor target (Functions (f : rest)) =-  case funDynTypeRep f of-    SomeTypeRep (Fun _ out) ->-      if outputType (SomeTypeRep out) == target-        then Just f-        else findConstructor target (Functions rest)-    -- a "function" with no arguments-    SomeTypeRep out ->-      if outputType (SomeTypeRep out) == target-        then Just f-        else findConstructor target (Functions rest)+  head $ filter isNotSpecializedForAnotherContext (findValues target values)  -- | Given a newly built value, check if there are modifiers for that --   value and apply them before "storing" the value which means@@ -99,16 +72,12 @@ --   We use a StateT Either because applying modifiers could fail and we want --   to catch and report the error. Note that this error would be an implementation --   error (and not a user error) since at the type-level everything should be correct-storeValue ::-  Modifiers ->-  Value ->-  Stack Value-storeValue (Modifiers ms) value =+storeValue :: Modifiers -> Value -> Stack Value+storeValue (Modifiers ms) value = do   let modifiers = findModifiers ms-   in do-        valueToStore <- modifyValue value modifiers-        modifyValues (addValue valueToStore)-        pure valueToStore+  valueToStore <- modifyValue value modifiers+  modifyValues (addValue valueToStore)+  pure valueToStore   where     -- find the applicable modifiers     findModifiers = filter (\(m, _) -> valueDynTypeRep value == m)

@@ -50,12 +50,12 @@ -- | Return the specializations used during the creation of values valuesSpecializations :: Statistics -> [Specialization] valuesSpecializations stats =-  case values stats of-    Values [] -> []-    Values (v : vs) ->+  case toValues (values stats) of+    [] -> []+    v : vs ->       case valueSpecialization v of-        Just s -> s : valuesSpecializations stats {values = Values vs}-        Nothing -> valuesSpecializations stats {values = Values vs}+        Just s -> s : valuesSpecializations stats {values = fromValues vs}+        Nothing -> valuesSpecializations stats {values = fromValues vs}  -- | Return the list of distinct paths from the root of a value graph to leaves --   of that graph.@@ -63,7 +63,7 @@ --   specialization allValuesPaths :: Statistics -> Paths allValuesPaths stats = do-  v <- unValues $ values stats+  v <- toValues $ values stats   valuePaths v  -- | Return all the paths from a given value to all its dependencies@@ -75,4 +75,8 @@  -- | Find the most recently created value of a given type findMostRecentValue :: forall a. (Typeable a) => Statistics -> Maybe Value-findMostRecentValue stats = find (\v -> valueDynTypeRep v == someTypeRep (Proxy :: Proxy a)) $ unValues (values stats)+findMostRecentValue stats = find (\v -> valueDynTypeRep v == someTypeRep (Proxy :: Proxy a)) $ toValues (values stats)++-- | Find the created values of a given type+findCreatedValues :: forall a. (Typeable a) => Statistics -> [Value]+findCreatedValues stats = filter (\v -> valueDynTypeRep v == someTypeRep (Proxy :: Proxy a)) $ toValues (values stats)

@@ -9,10 +9,13 @@ import Data.List (elemIndex, intersect) import Data.List.NonEmpty import Data.List.NonEmpty as NonEmpty (head, last)+import Data.MultiMap (MultiMap)+import Data.MultiMap qualified as MM+import Data.Registry.Internal.MultiMap () import Data.Registry.Internal.Reflection-import qualified Data.Text as T hiding (last)+import Data.Text qualified as T hiding (last) import Protolude as P hiding (show)-import qualified Protolude as P+import Protolude qualified as P import Type.Reflection import Prelude (show) @@ -34,8 +37,8 @@   deriving (Show)  instance Eq Value where-  CreatedValue _ vd1 sc1 ds1 == CreatedValue _ vd2 sc2 ds2 =-    (vd1, sc1, ds1) == (vd2, sc2, ds2)+  CreatedValue _ vd1 _sc1 ds1 == CreatedValue _ vd2 _sc2 ds2 =+    (vd1, ds1) == (vd2, ds2)   ProvidedValue _ vd1 == ProvidedValue _ vd2 =     vd1 == vd2   _ == _ = False@@ -181,6 +184,14 @@ funDynTypeRep :: Function -> SomeTypeRep funDynTypeRep = dynTypeRep . funDyn +-- | Type representation of the output of a  'Function'+funDynOutTypeRep :: Function -> SomeTypeRep+funDynOutTypeRep f =+  go (funDynTypeRep f)+  where+    go (SomeTypeRep (Fun _ out)) = go (SomeTypeRep out)+    go (SomeTypeRep out) = SomeTypeRep out+ -- | A 'FunctionDescription' as 'Text' funDescriptionToText :: FunctionDescription -> Text funDescriptionToText (FunctionDescription ins out) = T.intercalate " -> " (ins <> [out])@@ -196,35 +207,91 @@   = TypedValue Value   | TypedFunction Function +-- | A Untyped is used for storing either a value or a function+--   in a specialization+data Untyped+  = UntypedValue Value+  | UntypedFunction Function+  deriving (Show)++-- | Drop the type variable+untype :: Typed a -> Untyped+untype (TypedValue v) = UntypedValue v+untype (TypedFunction f) = UntypedFunction f+ -- | This is a list of functions (or "constructors") available for constructing values-newtype Functions = Functions [Function] deriving (Show, Semigroup, Monoid)+--   They are sorted by output type and if there are several available functions+--   for a given type the first function in the list has the highest priority+newtype Functions = Functions+  { unFunctions :: MultiMap SomeTypeRep Function+  }+  deriving (Show, Semigroup, Monoid) +-- | Create a Functions data structure from a list of functions+fromFunctions :: [Function] -> Functions+fromFunctions fs = Functions (MM.fromList $ (\f -> (funDynOutTypeRep f, f)) <$> fs)++-- | Create a list of functions from the Functions data structure+toFunctions :: Functions -> [Function]+toFunctions (Functions fs) = snd <$> MM.toList fs+ -- | Display a list of constructors describeFunctions :: Functions -> Text-describeFunctions (Functions fs) =-  if P.null fs+describeFunctions functions@(Functions fs) =+  if MM.null fs     then ""-    else unlines (funDescriptionToText . funDescription <$> fs)+    else unlines (funDescriptionToText . funDescription <$> toFunctions functions) --- | Add one more Function to the list of Functions+-- | Add one more Function to the list of Functions.+--   It gets the highest priority for functions with the same output type addFunction :: Function -> Functions -> Functions-addFunction f (Functions fs) = Functions (f : fs)+addFunction f (Functions fs) = Functions (MM.insert (funDynOutTypeRep f) f fs) +-- | Add one more Function to the list of Functions+--   It gets the lowest priority for functions with the same output type+--   This is not a very efficient because it requires a full recreation of the map+appendFunction :: Function -> Functions -> Functions+appendFunction f (Functions fs) = Functions (MM.fromList $ MM.toList fs <> [(funDynOutTypeRep f, f)])++-- | Find a constructor function returning a target type+--   from a list of constructors+findFunction :: SomeTypeRep -> Functions -> Maybe Function+findFunction target (Functions fs) = P.head $ MM.lookup target fs+ -- | List of values available which can be used as parameters to --   constructors for building other values-newtype Values = Values {unValues :: [Value]} deriving (Show, Semigroup, Monoid)+newtype Values = Values {unValues :: MultiMap SomeTypeRep Value} deriving (Show, Semigroup, Monoid) +-- | Create a Values data structure from a list of values+fromValues :: [Value] -> Values+fromValues vs = Values (MM.fromList $ (\v -> (valueDynTypeRep v, v)) <$> vs)++-- | Create a list of values from the Values data structure+toValues :: Values -> [Value]+toValues (Values vs) = snd <$> MM.toList vs+ -- | Display a list of values describeValues :: Values -> Text-describeValues (Values vs) =-  if P.null vs+describeValues values@(Values vs) =+  if MM.null vs     then ""-    else unlines (valDescriptionToText . valDescription <$> vs)+    else unlines (valDescriptionToText . valDescription <$> toValues values)  -- | Add one more Value to the list of Values addValue :: Value -> Values -> Values-addValue v (Values vs) = Values (v : vs)+addValue v (Values vs) = Values (MM.insert (valueDynTypeRep v) v vs) +-- | Add one more Value to the list of Values+--   It gets the lowest priority for values with the same type+--   This is not a very efficient because it requires a full recreation of the map+appendValue :: Value -> Values -> Values+appendValue v (Values vs) = Values (MM.fromList $ MM.toList vs <> [(valueDynTypeRep v, v)])++-- | Find all the values with a specific type+--   from a list of constructors+findValues :: SomeTypeRep -> Values -> [Value]+findValues target (Values vs) = MM.lookup target vs+ -- | The types of values that we are trying to build at a given moment --   of the resolution algorithm. --   We also store the function requiring a given value type to provide@@ -288,9 +355,9 @@ --   involved in the creation of the App data Specialization = Specialization   { _specializationPath :: SpecializationPath,-    _specializationValue :: Value+    _specializationValue :: Untyped   }-  deriving (Eq, Show)+  deriving (Show)  -- | List of consecutive types used when making a specific values --   See the comments on 'Specialization'@@ -314,7 +381,10 @@  -- | Return the type of the replaced value in a specialization specializationTargetType :: Specialization -> SomeTypeRep-specializationTargetType = valueDynTypeRep . _specializationValue+specializationTargetType s =+  case _specializationValue s of+    UntypedValue v -> valueDynTypeRep v+    UntypedFunction f -> funDynOutTypeRep f  -- | This represents the full context in which a value has been specialized --   Context is the full list of types leading to the creation of that value@@ -322,7 +392,7 @@ --   For example, when creating a FilePath used by a Logger the context could be: App -> Database -> Sql -> Logger --   and the Specialization just Database -> Logger --   to specify that the file path must have a specific value in that case-data SpecializationContext = SpecializationContext { scContext :: Context, scSpecialization :: Specialization } deriving (Eq, Show)+data SpecializationContext = SpecializationContext {scContext :: Context, scSpecialization :: Specialization} deriving (Show)  -- | A specialization is applicable to a context if all its types --   are part of that context, in the right order@@ -373,13 +443,12 @@ --   only a subpath of a given creation context --   Note: there are no dependencies for this value since it has been directly --   provided by a Specialization-createValueFromSpecialization :: Context -> Specialization -> Value-createValueFromSpecialization context specialization@(Specialization _ (ProvidedValue d desc)) =+createValueFromSpecialization :: Context -> Specialization -> Untyped+createValueFromSpecialization context specialization@(Specialization _ (UntypedValue (ProvidedValue d desc))) =   -- the creation context for that value-  CreatedValue d desc (Just (SpecializationContext context specialization)) mempty--- this is not supposed to happen since specialization are always--- using ProvidedValues-createValueFromSpecialization _ v = _specializationValue v+  UntypedValue $ CreatedValue d desc (Just (SpecializationContext context specialization)) mempty+-- the other case is when we have a specialization function+createValueFromSpecialization _ s = _specializationValue s  -- | Display a list of specializations for the Registry, just showing the --   context (a type) in which a value must be selected

@@ -80,23 +80,19 @@            )  instance Semigroup (Registry inputs outputs) where-  (<>)-    (Registry (Values vs1) (Functions fs1) (Specializations ss1) (Modifiers ms1))-    (Registry (Values vs2) (Functions fs2) (Specializations ss2) (Modifiers ms2)) =-      Registry (Values (vs1 <> vs2)) (Functions (fs1 <> fs2)) (Specializations (ss1 <> ss2)) (Modifiers (ms1 <> ms2))+  (<>) (Registry vs1 fs1 ss1 ms1) (Registry vs2 fs2 ss2 ms2) =+      Registry (vs1 <> vs2) (fs1 <> fs2) (ss1 <> ss2) (ms1 <> ms2)  instance Semigroup (Registry inputs outputs) => Monoid (Registry inputs outputs) where-  mempty = Registry (Values []) (Functions []) (Specializations []) (Modifiers [])+  mempty = Registry mempty mempty mempty mempty   mappend = (<>)  -- | Append 2 registries together infixr 4 <+>  (<+>) :: Registry is1 os1 -> Registry is2 os2 -> Registry (is1 :++ is2) (os1 :++ os2)-(<+>)-  (Registry (Values vs1) (Functions fs1) (Specializations ss1) (Modifiers ms1))-  (Registry (Values vs2) (Functions fs2) (Specializations ss2) (Modifiers ms2)) =-    Registry (Values (vs1 <> vs2)) (Functions (fs1 <> fs2)) (Specializations (ss1 <> ss2)) (Modifiers (ms1 <> ms2))+(<+>)(Registry vs1 fs1 ss1 ms1) (Registry vs2 fs2 ss2 ms2) =+      Registry (vs1 <> vs2) (fs1 <> fs2) (ss1 <> ss2) (ms1 <> ms2)  -- | Store an element in the registry --   Internally elements are stored as 'Dynamic' values@@ -108,25 +104,25 @@ -- | Store an element in the registry --   Internally elements are stored as 'Dynamic' values registerUnchecked :: (Typeable a) => Typed a -> Registry ins out -> Registry (Inputs a :++ ins) (Output a ': out)-registerUnchecked (TypedValue v) (Registry (Values vs) functions specializations modifiers) =-  Registry (Values (v : vs)) functions specializations modifiers-registerUnchecked (TypedFunction f) (Registry (Values vs) (Functions fs) specializations modifiers) =-  Registry (Values vs) (Functions (f : fs)) specializations modifiers+registerUnchecked (TypedValue v) (Registry values functions specializations modifiers) =+  Registry (addValue v values) functions specializations modifiers+registerUnchecked (TypedFunction f) (Registry values functions specializations modifiers) =+  Registry values (addFunction f functions) specializations modifiers  -- | Store an element in the registry, at the end of the registry --   Internally elements are stored as 'Dynamic' values appendUnchecked :: (Typeable a) => Registry ins out -> Typed a -> Registry (ins :++ Inputs a) (out :++ '[Output a])-appendUnchecked (Registry (Values vs) functions specializations modifiers) (TypedValue v) =-  Registry (Values (vs <> [v])) functions specializations modifiers-appendUnchecked (Registry (Values vs) (Functions fs) specializations modifiers) (TypedFunction f) =-  Registry (Values vs) (Functions (fs <> [f])) specializations modifiers+appendUnchecked (Registry values functions specializations modifiers) (TypedValue v) =+  Registry (appendValue v values) functions specializations modifiers+appendUnchecked (Registry values functions specializations modifiers) (TypedFunction f) =+  Registry values (appendFunction f functions) specializations modifiers  -- | Add 2 typed values together to form an initial registry addTypedUnchecked :: (Typeable a, Typeable b, ins ~ (Inputs a :++ Inputs b), out ~ '[Output a, Output b]) => Typed a -> Typed b -> Registry ins out-addTypedUnchecked (TypedValue v1) (TypedValue v2) = Registry (Values [v1, v2]) mempty mempty mempty-addTypedUnchecked (TypedValue v1) (TypedFunction f2) = Registry (Values [v1]) (Functions [f2]) mempty mempty-addTypedUnchecked (TypedFunction f1) (TypedValue v2) = Registry (Values [v2]) (Functions [f1]) mempty mempty-addTypedUnchecked (TypedFunction f1) (TypedFunction f2) = Registry mempty (Functions [f1, f2]) mempty mempty+addTypedUnchecked (TypedValue v1) (TypedValue v2) = Registry (fromValues [v1, v2]) mempty mempty mempty+addTypedUnchecked (TypedValue v1) (TypedFunction f2) = Registry (fromValues [v1]) (fromFunctions [f2]) mempty mempty+addTypedUnchecked (TypedFunction f1) (TypedValue v2) = Registry (fromValues [v2]) (fromFunctions [f1]) mempty mempty+addTypedUnchecked (TypedFunction f1) (TypedFunction f2) = Registry mempty (fromFunctions [f1, f2]) mempty mempty  -- | Add an element to the Registry but do not check that the inputs of a --   can already be produced by the registry@@ -249,60 +245,17 @@ funAs a = fun (argsTo @m a)  -- | For a given type a being currently built---   when a value of type b is required pass a specific---   value-specialize :: forall a b ins out. (Typeable a, Typeable b) => b -> Registry ins out -> Registry ins out-specialize b (Registry values functions (Specializations c) modifiers) =-  Registry-    values-    functions-    (Specializations (Specialization (pure $ someTypeRep (Proxy :: Proxy a)) (createTypeableValue b) : c))-    modifiers+--   when a value of type b is required pass a specific value+specialize :: forall a b ins out. (Typeable a) => Typed b -> Registry ins out -> Registry ins out+specialize b (Registry values functions (Specializations c) modifiers) = do+  let ss = Specializations (Specialization (pure $ someTypeRep (Proxy :: Proxy a)) (untype b) : c)+  Registry values functions ss modifiers  -- | Specialize a function for a specific path of types-specializePath :: forall path b ins out. (PathToTypeReps path, Typeable b) => b -> Registry ins out -> Registry ins out-specializePath b (Registry values functions (Specializations c) modifiers) =-  Registry-    values-    functions-    (Specializations (Specialization (someTypeReps (Proxy :: Proxy path)) (createTypeableValue b) : c))-    modifiers---- | Specialize a value of type b when building a value of type a-specializeVal :: forall a b ins out. (Typeable a, Contains a out, Typeable b, Show b) => b -> Registry ins out -> Registry ins out-specializeVal b (Registry values functions (Specializations c) modifiers) =-  Registry-    values-    functions-    (Specializations (Specialization (pure $ someTypeRep (Proxy :: Proxy a)) (createValue b) : c))-    modifiers---- | Specialize a value of type b when building a value of type a, but only when building a specific list of value types-specializePathVal :: forall path b ins out. (PathToTypeReps path, Typeable b, Show b) => b -> Registry ins out -> Registry ins out-specializePathVal b (Registry values functions (Specializations c) modifiers) =-  Registry-    values-    functions-    (Specializations (Specialization (someTypeReps (Proxy :: Proxy path)) (createValue b) : c))-    modifiers---- | Specialize a value of type b when building a value of type a, in the context m-specializeValTo :: forall m a b ins out. (Applicative m, Typeable a, Typeable (m b), Typeable b, Show b) => b -> Registry ins out -> Registry ins out-specializeValTo b (Registry values functions (Specializations c) modifiers) =-  Registry-    values-    functions-    (Specializations (Specialization (pure $ someTypeRep (Proxy :: Proxy a)) (liftProvidedValue @m b) : c))-    modifiers---- | Specialize a value of type b when building a value of type a, in the context m, but only when building a specific list of value types-specializePathValTo :: forall m path b ins out. (Applicative m, PathToTypeReps path, Typeable (m b), Typeable b, Show b) => b -> Registry ins out -> Registry ins out-specializePathValTo b (Registry values functions (Specializations c) modifiers) =-  Registry-    values-    functions-    (Specializations (Specialization (someTypeReps (Proxy :: Proxy path)) (liftProvidedValue @m b) : c))-    modifiers+specializePath :: forall path b ins out. (PathToTypeReps path) => Typed b -> Registry ins out -> Registry ins out+specializePath b (Registry values functions (Specializations c) modifiers) = do+  let ss = Specializations (Specialization (someTypeReps (Proxy :: Proxy path)) (untype b) : c)+  Registry values functions ss modifiers  -- | Typeclass for extracting type representations out of a list of types class PathToTypeReps (path :: [Type]) where

@@ -53,10 +53,10 @@  -- | Register modifications of elements which types are already in the registry addToRegistry :: (Typeable a, IsSubset (Inputs a) out a) => Typed a -> Registry ins out -> Registry ins out-addToRegistry (TypedValue v) (Registry (Values vs) functions specializations modifiers) =-  Registry (Values (v : vs)) functions specializations modifiers-addToRegistry (TypedFunction f) (Registry (Values vs) (Functions fs) specializations modifiers) =-  Registry (Values vs) (Functions (f : fs)) specializations modifiers+addToRegistry (TypedValue v) (Registry values functions specializations modifiers) =+  Registry (addValue v values) functions specializations modifiers+addToRegistry (TypedFunction f) (Registry values functions specializations modifiers) =+  Registry values (addFunction f functions) specializations modifiers  -- | Concatenate a registry to another statefully (to be used with $(makeGenerators ''MyType)) concatUnsafeS :: (MonadState (Registry ins out) m) => Registry ins' out' -> m ()@@ -64,14 +64,13 @@  -- | Register modifications of the registry without changing its type addToRegistryUnsafe :: (Typeable a) => Typed a -> Registry ins out -> Registry ins out-addToRegistryUnsafe (TypedValue v) (Registry (Values vs) functions specializations modifiers) =-  Registry (Values (v : vs)) functions specializations modifiers-addToRegistryUnsafe (TypedFunction f) (Registry (Values vs) (Functions fs) specializations modifiers) =-  Registry (Values vs) (Functions (f : fs)) specializations modifiers+addToRegistryUnsafe (TypedValue v) (Registry values functions specializations modifiers) =+  Registry (addValue v values) functions specializations modifiers+addToRegistryUnsafe (TypedFunction f) (Registry values functions specializations modifiers) =+  Registry values (addFunction f functions) specializations modifiers  -- | Concatenate 2 registries concatRegistryUnsafe :: Registry ins out -> Registry ins' out' -> Registry ins' out' concatRegistryUnsafe-  (Registry (Values vs1) (Functions fs1) (Specializations ss1) (Modifiers ms1))-  (Registry (Values vs2) (Functions fs2) (Specializations ss2) (Modifiers ms2)) =-    Registry (Values (vs1 <> vs2)) (Functions (fs1 <> fs2)) (Specializations (ss1 <> ss2)) (Modifiers (ms1 <> ms2))+  (Registry vs1 fs1 ss1 ms1)+  (Registry vs2 fs2 ss2 ms2) = Registry (vs1 <> vs2) (fs1 <> fs2) (ss1 <> ss2) (ms1 <> ms2)

@@ -4,6 +4,8 @@  import Data.Dynamic import Data.List.NonEmpty+import Data.MultiMap (MultiMap)+import Data.MultiMap qualified as MM import Data.Registry import Data.Registry.Internal.Types import Data.Text as T@@ -29,8 +31,15 @@     -- functions     <: funTo @Gen Functions     <: fun (genList @Function)+    <: fun (genMultiMap @SomeTypeRep @Function)+    <: fun (genPair @SomeTypeRep @Function)     <: funTo @Gen Function     <: funTo @Gen FunctionDescription+    -- values+    <: funTo @Gen Values+    <: fun (genMultiMap @SomeTypeRep @Value)+    <: fun (genPair @SomeTypeRep @Value)+    <: fun (genList @Value)     -- type reps     <: fun (genList @(SomeTypeRep, Maybe SomeTypeRep))     <: fun (genList @SomeTypeRep)@@ -39,9 +48,8 @@     <: fun (genMaybe @SomeTypeRep)     <: fun (genNonEmpty @SomeTypeRep)     <: fun genSomeTypeRep-    -- values-    <: funTo @Gen Values-    <: fun (genList @Value)+    -- value+    <: funTo @Gen UntypedValue     <: funTo @Gen ProvidedValue     <: funTo @Gen ValueDescription     -- base@@ -85,6 +93,9 @@  genList :: forall a. Gen a -> Gen [a] genList = Gen.list (Range.linear 1 3)++genMultiMap :: forall k v. (Ord k) => Gen (k, v) -> Gen (MultiMap k v)+genMultiMap genAssocs = MM.fromList <$> Gen.list (Range.linear 1 5) genAssocs  genNonEmpty :: forall a. Gen a -> Gen (NonEmpty a) genNonEmpty genA = do

@@ -18,26 +18,26 @@ test_find_no_value = prop "no value can be found if nothing is stored in the registry" $ do   value <- forAll $ gen @Int -  (fromValueDyn <$> findValue (valueDynTypeRep (createValue value)) mempty mempty mempty) === (Nothing :: Maybe (Maybe Int))+  (fromValueDyn <$> findValueOrSpecialization (valueDynTypeRep (createValue value)) mempty mempty mempty) === (Nothing :: Maybe (Maybe Int))  test_find_value = prop "find a value in a list of values when there are no specializations" $ do   (value, values) <- forAll genValues -  (fromValueDyn <$> findValue (valueDynTypeRep (createValue value)) mempty mempty values) === Just (Just value)+  (fromValueDyn <$> findValueOrSpecialization (valueDynTypeRep (createValue value)) mempty mempty values) === Just (Just value)  test_find_specialized_value = prop "find a value in a list of values when there is a specialization for a given context" $ do   value <- forAll $ gen @Int   values <- forAll $ gen @Values   let listTypeRep = dynTypeRep . toDyn $ [value]   let context = Context [(listTypeRep, Nothing)] -- when trying to build a [Int]-  let specializations = Specializations [Specialization (pure listTypeRep) (createValue value)]+  let specializations = Specializations [Specialization (pure listTypeRep) (UntypedValue $ createValue value)] -  (fromValueDyn <$> findValue (valueDynTypeRep (createValue value)) context specializations values) === Just (Just value)+  (fromValueDyn <$> findValueOrSpecialization (valueDynTypeRep (createValue value)) context specializations values) === Just (Just value)  test_find_no_constructor = prop "no constructor can be found if nothing is stored in the registry" $ do   value <- forAll $ gen @Int -  (fromDynamic . funDyn <$> findConstructor (valueDynTypeRep (createValue value)) mempty) === (Nothing :: Maybe (Maybe Int))+  (fromDynamic . funDyn <$> findFunction (valueDynTypeRep (createValue value)) mempty) === (Nothing :: Maybe (Maybe Int))  test_find_contructor = prop "find a constructor in a list of constructors" $ do   (TextToInt function) <- forAll $ gen @TextToInt@@ -45,7 +45,7 @@    let outputType = dynTypeRep (toDyn (1 :: Int)) -  (fmap TextToInt <$> (fromDynamic . funDyn <$> findConstructor outputType functions))+  (fmap TextToInt <$> (fromDynamic . funDyn <$> findFunction outputType functions))     === Just (Just (TextToInt function))  test_store_value_no_modifiers = prop "a value can be stored in the list of values" $ do@@ -54,9 +54,9 @@   let createdValue = createValue value   let (Right stored) = execStackWithValues values (storeValue mempty createdValue) -  let found = findValue (dynTypeRep . toDyn $ value) mempty mempty stored-  (fromValueDyn <$> found) === Just (Just value)+  (fromValueDyn <$> findValueOrSpecialization (dynTypeRep . toDyn $ value) mempty mempty stored) === Just (Just value) + test_store_value_with_modifiers = prop "a value can be stored in the list of values but modified beforehand" $ do   (value, values) <- forAll genValues @@ -65,8 +65,7 @@   let createdValue = createValue value   let (Right stored) = execStackWithValues values (storeValue modifiers createdValue) -  let found = findValue valueType mempty mempty stored-  (fromValueDyn <$> found) === Just (Just (value + 1))+  (fromValueDyn <$> findValueOrSpecialization valueType mempty mempty stored) === Just (Just (value + 1))  test_store_value_ordered_modifiers = prop "modifiers are applied in a LIFO order" $ do   (value, values) <- forAll genValues@@ -80,9 +79,12 @@   let createdValue = createValue value   let (Right stored) = execStackWithValues values (storeValue modifiers createdValue) -  let found = findValue valueType mempty mempty stored-  (fromValueDyn <$> found) === Just (Just ((value * 2) + 1))+  (fromValueDyn <$> findValueOrSpecialization valueType mempty mempty stored) === Just (Just ((value * 2) + 1))  -- * -fromValueDyn = fromDynamic . valueDyn+fromValueDyn (Right value) = fromDynamic . valueDyn $ value+fromValueDyn (Left specialization) =+  case createValueFromSpecialization mempty specialization of+    UntypedValue v -> fromDynamic . valueDyn $ v+    UntypedFunction _ -> panic "expected to find a specialized value"

@@ -11,12 +11,12 @@  test_specialized_context_order = prop "there are preferrable specializations than other in a given context" $ do   let c1 = Context (fmap (\t -> (t, Nothing)) $ [f, e, d, c, b, a])-  let s1 = specializationRange c1 (Specialization (a :| [c]) (createValue A))-  let s2 = specializationRange c1 (Specialization (a :| [e]) (createValue A))-  let s3 = specializationRange c1 (Specialization (c :| [f]) (createValue A))-  let s4 = specializationRange c1 (Specialization (b :| [f]) (createValue A))-  let s5 = specializationRange c1 (Specialization (pure c) (createValue A))-  let s6 = specializationRange c1 (Specialization (pure f) (createValue A))+  let s1 = specializationRange c1 (Specialization (a :| [c]) (UntypedValue $ createValue A))+  let s2 = specializationRange c1 (Specialization (a :| [e]) (UntypedValue $ createValue A))+  let s3 = specializationRange c1 (Specialization (c :| [f]) (UntypedValue $ createValue A))+  let s4 = specializationRange c1 (Specialization (b :| [f]) (UntypedValue $ createValue A))+  let s5 = specializationRange c1 (Specialization (pure c) (UntypedValue $ createValue A))+  let s6 = specializationRange c1 (Specialization (pure f) (UntypedValue $ createValue A))    (s2 < s1) === True   (s3 < s1) === True

@@ -67,8 +67,8 @@     counter <- newIORef 0      let r =-          specialize @(IO D2) @(IO Specialized) (pure Specialized2) $-              funTo @IO D3+          specialize @(IO D2) @(IO Specialized) (valTo @IO Specialized2) $+            funTo @IO D3               <: funTo @IO D1               <: funTo @IO D2               <: funTo @IO (newCounter counter)@@ -80,6 +80,26 @@   d1 === D1 (Counter 1 Specialized1)   d2 === D2 (Counter 2 Specialized2) +test_memoize_with_specialized_functions = test "all the values created from functions on a specialization path are memoized independently" $ do+  D3 d1 d2 <- liftIO $ do+    -- create a counter for the number of instantiations+    counter <- newIORef 0++    let r =+          specialize @(IO D2) (funTo @IO (\(_ :: Text) -> Specialized2)) $+            funTo @IO D3+              <: funTo @IO D1+              <: funTo @IO D2+              <: funTo @IO (newCounter counter)+              <: valTo @IO Specialized1+              <: valTo @IO ("text" :: Text)++    r' <- memoizeAll @IO r+    make @(IO D3) r'++  d1 === D1 (Counter 1 Specialized1)+  d2 === D2 (Counter 2 Specialized2)+ -- * HELPERS  newtype C1 = C1 Sing deriving (Eq, Show)@@ -122,9 +142,10 @@  data App = App {a :: A, b :: B} - newtype D1 = D1 Counter deriving (Eq, Show)+ newtype D2 = D2 Counter deriving (Eq, Show)+ data Counter = Counter Int Specialized deriving (Eq, Show)  data Specialized = Specialized1 | Specialized2 deriving (Eq, Show)

@@ -0,0 +1,98 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE IncoherentInstances #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}++module Test.Data.Registry.Make.SpecializationFunctionsSpec where++import Data.Registry+import Protolude hiding (C1)+import Test.Tasty.Extensions++-- | Case 1: contextual setting of different values for a given type+test_specialization_1 = test "values can be built from specialized functions depending on some context" $ do+  -- this function uses the default Int (and has unused parameters)+  let useDefaultInt (_t :: Text) = Config+  -- this function doubles the default Int (and has unused parameters)+  let useTwiceDefaultInt i (_t :: Text) (_b :: Bool) = Config $ i * 2++  (c1, c2) <- liftIO $ do+    let r =+          specialize @UseConfig1 (fun useDefaultInt)+            . specialize @UseConfig2 (fun useTwiceDefaultInt)+            $ fun newUseConfig2+              <: fun newUseConfig1+              <: val (Config 3)+              <: val (1 :: Int)+              <: val True+              <: val ("text" :: Text)++    pure (printConfig1 (make @UseConfig1 r), printConfig2 (make @UseConfig2 r))++  c1 === Config 1+  c2 === Config 2++test_missing_inputs = test "values can be built from specialized functions depending on some context" $ do+  -- this function uses the default Int (and has unused parameters)+  let useDefaultInt (_t :: Text) = Config+  -- this function doubles the default Int (it has unused parameters, but will be missing the Bool parameter which is not in the registry)+  let useTwiceDefaultInt i (_t :: Text) (_b :: Bool) = Config $ i * 2++  (c1, c2) <- liftIO $ do+    let r =+          specialize @UseConfig1 (fun useDefaultInt)+            . specialize @UseConfig2 (fun useTwiceDefaultInt)+            $ fun newUseConfig2+              <: fun newUseConfig1+              <: val (Config 3)+              <: val (1 :: Int)+              <: val ("text" :: Text)++    pure (printConfig1 (make @UseConfig1 r), printConfig2 (make @UseConfig2 r))++  c1 === Config 1++  annotate "if inputs are missing for a specialization, we use the default value"+  c2 === Config 3++-- we want the following graph+{-+            +----------  Base  ------------++            |                              |+            v                              v+   (client1 :: Client1)          (client2 :: Client2)+            |                              |+            v                              v+   (useConfig1 :: UseConfig) (useConfig2 :: UseConfig)+            |                              |+            v                              v+   (config1 :: Config)           (config2 :: Config)++-}++newtype Config = Config {configInt :: Int} deriving (Eq, Show)++newtype UseConfig1 = UseConfig1 {printConfig1 :: Config}++newUseConfig1 config = UseConfig1 {printConfig1 = config}++newtype UseConfig2 = UseConfig2 {printConfig2 :: Config}++newUseConfig2 config = UseConfig2 {printConfig2 = config}++newtype UseConfig = UseConfig {printConfig :: Config}++newUseConfig config = UseConfig {printConfig = config}++newtype Client1 = Client1 {printClientConfig1 :: Config}++newClient1 useConfig = Client1 {printClientConfig1 = printConfig useConfig}++newtype Client2 = Client2 {printClientConfig2 :: Config}++newClient2 useConfig = Client2 {printClientConfig2 = printConfig useConfig}++newtype Base = Base {printBase :: (Config, Config)}++newBase client1 client2 = Base {printBase = (printClientConfig1 client1, printClientConfig2 client2)}

@@ -21,8 +21,8 @@               <: fun newUseConfig1               <: val (Config 3)       let r' =-            specialize @UseConfig1 (Config 1) $-              specialize @UseConfig2 (Config 2) r+            specialize @UseConfig1 (val $ Config 1) $+              specialize @UseConfig2 (val $ Config 2) r       pure (printConfig1 (make @UseConfig1 r'), printConfig2 (make @UseConfig2 r'))    c1 === Config 1@@ -38,8 +38,8 @@               <: fun newUseConfig               <: val (Config 3)       let r' =-            specialize @Client1 (Config 1) $-              specialize @UseConfig (Config 2) r+            specialize @Client1 (val $ Config 1) $+              specialize @UseConfig (val $ Config 2) r       pure $ printClientConfig1 (make @Client1 r')    annotate "this is the more specialized context"@@ -58,8 +58,8 @@               <: fun newUseConfig               <: val (Config 3)       let r' =-            specialize @Client1 (Config 1) $-              specialize @Client2 (Config 2) r+            specialize @Client1 (val $ Config 1) $+              specialize @Client2 (val $ Config 2) r       pure $ printBase (make @Base r')    c1 === Config 1@@ -118,8 +118,8 @@               <: valTo @RIO (Config 3)        let r' =-            specializePathValTo @RIO @[RIO Base2, RIO Client1, RIO UseConfig] (Config 1)-              . specializeValTo @RIO @(RIO UseConfig) (Config 2)+            specializePath @[RIO Base2, RIO Client1, RIO UseConfig] (valTo @RIO $ Config 1)+              . specialize @(RIO UseConfig) (valTo @RIO $ Config 2)               $ r        printBase2 <$> runResourceT (make @(RIO Base2) r')@@ -173,9 +173,9 @@  appRegistry :: Registry _ _ appRegistry =-  specializeVal @Sql (SupervisorConfig "for sql in general")-    . specializePathVal @[StatsStore, Sql] (SupervisorConfig "for sql under the stats store")-    . specializeVal @TwitterClient (SupervisorConfig "for the twitter client")+  specialize @Sql (val $ SupervisorConfig "for sql in general")+    . specializePath @[StatsStore, Sql] (val $ SupervisorConfig "for sql under the stats store")+    . specialize @TwitterClient (val $ SupervisorConfig "for the twitter client")     $ fun App       <: fun newStatsStore       <: fun newTwitterClient@@ -247,7 +247,7 @@ aRegistryIO :: IO (Registry _ _) aRegistryIO =   memoizeAll @IO $-    specializePathValTo @IO @[IO ToOverride, IO InCommon] (SomeConfig "specialized config") $+    specializePath @[IO ToOverride, IO InCommon] (valTo @IO $ SomeConfig "specialized config") $       funTo @IO SomeData         <: funTo @IO newToKeepDefault         <: funTo @IO newToOverride@@ -264,8 +264,8 @@           <: val (Config 3)    let r' =-        specializePathVal @[Base2, Client1, UseConfig] (Config 1)-          . specializeVal @UseConfig (Config 2)+        specializePath @[Base2, Client1, UseConfig] (val $ Config 1)+          . specialize @UseConfig (val $ Config 2)           $ r    makeSpecialized @UseConfig r' === Config 2

@@ -35,22 +35,24 @@ -- * =========  test_tweak_non_lossy = test "a modified value must not lose its context, specialization or dependencies" $ do-  (a, stats) <- liftIO $-    do-      let r =-            fun A+  (a, stats) <- liftIO $ do+    let r =+          tweak (\(B (C _)) -> B (C 3))+            . specialize @A @C (val $ C 2)+            $ fun A               <: fun B               <: val (C 1)--      let r' = specialize @A @C (C 2) r-      let r'' = tweak (\(B (C _)) -> B (C 3)) r'-      pure (make @A r'', makeStatistics @A r'')+    pure (make @A r, makeStatistics @A r)    -- The specialized value was 2 but after tweaking it is 3   a === A (B (C 3))    -- Get the value for the type C   let cValue = findMostRecentValue @C stats++  annotateShow stats+  annotateShow cValue+  annotateShow (findCreatedValues @C stats)   isJust (valueContext =<< cValue) === True   isJust (valueSpecialization =<< cValue) === True 

@@ -26,5 +26,5 @@ newMisconfiguredRngSilentApp :: App newMisconfiguredRngSilentApp =   make @App $-    specialize @(Rng IO) silentLogger $+    specialize @(Rng IO) (fun silentLogger) $       val (SecretReaderConfig "missing") <: registry

@@ -15,5 +15,5 @@   putStrLn $     unDot $       makeDot @App $-        specialize @(Rng IO) silentLogger $+        specialize @(Rng IO) (fun silentLogger) $           val (SecretReaderConfig "missing") <: registry