registry 0.4.0.0 → 0.5.0.0

raw patch · 12 files changed

+195/−145 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• registry.cabal +2/−2
• src/Data/Registry/Internal/Make.hs +16/−15
• src/Data/Registry/Internal/Statistics.hs +4/−4
• src/Data/Registry/Internal/Types.hs +100/−58
• src/Data/Registry/Make.hs +5/−5
• src/Data/Registry/Registry.hs +29/−39
• src/Data/Registry/State.hs +6/−10
• src/Data/Registry/Statistics.hs +3/−3
• test/Test/Data/Registry/Internal/GensRegistry.hs +4/−5
• test/Test/Data/Registry/Internal/MakeSpec.hs +1/−1
• test/Test/Data/Registry/Internal/RegistrySpec.hs +3/−3
• test/Test/Data/Registry/Make/SpecializationFunctionsSpec.hs +22/−0

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d44a2153bfc290f93fe7c376691bb652a7638881f01e9c65797b4610dd06da67+-- hash: f5f64917e56100dee68b1a07abc7a53b5e323440dfeb36623410f015fb2129c5  name:           registry-version:        0.4.0.0+version:        0.5.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.

@@ -27,11 +27,11 @@ -- | Make a value from a desired output type represented by SomeTypeRep --   and a list of possible constructors --   A 'Context' is passed in the form of a stack of the types we are trying to build so far---  Functions is the list of all the constructors in the Registry+--  Entries 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 targetType context functions specializations modifiers = do+makeUntyped :: SomeTypeRep -> Context -> Entries -> Specializations -> Modifiers -> Stack (Maybe Value)+makeUntyped targetType context entries specializations modifiers = do   values <- getValues   -- is there already a value with the desired type? Or a specialization   let foundValue = findValueOrSpecialization targetType context specializations values@@ -47,9 +47,8 @@     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)+        UntypedValue v ->+          Just <$> storeValue modifiers v         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@@ -61,7 +60,7 @@     makeWithConstructor :: Stack (Maybe Value)     makeWithConstructor = do       -- if not, is there a way to build such value?-      case findFunction targetType functions of+      case findUntyped targetType entries of         Nothing ->           lift $             Left $@@ -69,13 +68,15 @@                 <> T.intercalate "\nrequiring " (showContextTargets context)                 <> "\n\nNo constructor was found for "                 <> showSingleType targetType-        Just f ->+        Just (UntypedFunction f) ->           makeWithFunction f Nothing+        Just (UntypedValue v) ->+          Just <$> storeValue modifiers v      makeWithFunction :: Function -> Maybe Specialization -> Stack (Maybe Value)     makeWithFunction f mSpecialization = do       let inputTypes = collectInputTypes f-      inputs <- makeInputs f inputTypes context functions specializations modifiers+      inputs <- makeInputs f inputTypes context entries specializations modifiers        if length inputs /= length inputTypes         then do@@ -124,15 +125,15 @@   [SomeTypeRep] ->   -- | current context of types being built   Context ->-  -- | available functions to build values-  Functions ->+  -- | available entries to build values+  Entries ->   -- | list of values to use when in a specific context   Specializations ->   -- | modifiers to apply before storing made values   Modifiers ->   Stack [Value] -- list of made values makeInputs _ [] _ _ _ _ = pure []-makeInputs function (i : ins) c@(Context context) functions specializations modifiers =+makeInputs function (i : ins) c@(Context context) entries specializations modifiers =   if i `elem` contextTypes c     then       lift $@@ -143,11 +144,11 @@                 <> (show <$> context)                 <> ["But we are trying to build again " <> show i]     else do-      madeInput <- makeUntyped i (Context ((i, Just (funDynTypeRep function)) : context)) functions specializations modifiers+      madeInput <- makeUntyped i (Context ((i, Just (funDynTypeRep function)) : context)) entries specializations modifiers       case madeInput of         Nothing ->           -- if one input cannot be made, iterate with the rest for better reporting           -- of what could be eventually made-          makeInputs function ins (Context context) functions specializations modifiers+          makeInputs function ins (Context context) entries specializations modifiers         Just v ->-          (v :) <$> makeInputs function ins (Context context) functions specializations modifiers+          (v :) <$> makeInputs function ins (Context context) entries specializations modifiers

@@ -50,7 +50,7 @@ -- | Return the specializations used during the creation of values valuesSpecializations :: Statistics -> [Specialization] valuesSpecializations stats =-  case toValues (values stats) of+  case listValues (values stats) of     [] -> []     v : vs ->       case valueSpecialization v of@@ -63,7 +63,7 @@ --   specialization allValuesPaths :: Statistics -> Paths allValuesPaths stats = do-  v <- toValues $ values stats+  v <- listValues $ values stats   valuePaths v  -- | Return all the paths from a given value to all its dependencies@@ -75,8 +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)) $ toValues (values stats)+findMostRecentValue stats = findValue (someTypeRep (Proxy :: Proxy a)) (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)+findCreatedValues stats = findValues(someTypeRep (Proxy :: Proxy a)) (values stats)

@@ -208,7 +208,7 @@   | TypedFunction Function  -- | A Untyped is used for storing either a value or a function---   in a specialization+--   in the registry data Untyped   = UntypedValue Value   | UntypedFunction Function@@ -219,78 +219,85 @@ untype (TypedValue v) = UntypedValue v untype (TypedFunction f) = UntypedFunction f --- | This is a list of functions (or "constructors") available for constructing values---   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+-- | Return the output type of an untyped entry+outTypeRep :: Untyped -> SomeTypeRep+outTypeRep (UntypedValue v) = valueDynTypeRep v+outTypeRep (UntypedFunction f) = funDynOutTypeRep f++-- | Dynamic representation of a 'Function'+untypedDyn :: Untyped -> Dynamic+untypedDyn (UntypedFunction f) = funDyn f+untypedDyn (UntypedValue v) = valueDyn v+++-- | This is a list of entries in the registry available for constructing values+--   They are sorted by output type and if there are several available functions or values+--   for a given type the first one in the list has the highest priority+newtype Entries = Entries+  { unFunctions :: MultiMap SomeTypeRep Untyped   }   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 Entries data structure from a list of untyped entries+fromUntyped :: [Untyped] -> Entries+fromUntyped us = Entries (MM.fromList $ (\u -> (outTypeRep u, u)) <$> us) --- | Create a list of functions from the Functions data structure-toFunctions :: Functions -> [Function]-toFunctions (Functions fs) = snd <$> MM.toList fs+-- | Create a list of functions from the Entries data structure+toFunctions :: Entries -> [Function]+toFunctions (Entries es) = mapMaybe (getFunction . snd) (MM.toList es)+  where+    getFunction = \case+      UntypedFunction f -> Just f+      _ -> Nothing +-- | Create a list of values from the Entries data structure+toValues :: Entries -> [Value]+toValues (Entries es) = mapMaybe (getValue . snd) (MM.toList es)+  where+    getValue = \case+      UntypedValue v -> Just v+      _ -> Nothing+ -- | Display a list of constructors-describeFunctions :: Functions -> Text-describeFunctions functions@(Functions fs) =-  if MM.null fs+describeFunctions :: Entries -> Text+describeFunctions entries@(Entries es) =+  if MM.null es     then ""-    else unlines (funDescriptionToText . funDescription <$> toFunctions functions)+    else unlines (funDescriptionToText . funDescription <$> toFunctions entries) --- | Add one more Function to the list of Functions.+-- | Display a list of values+describeValues :: Entries -> Text+describeValues entries@(Entries es) =+  if MM.null es+    then ""+    else unlines (valDescriptionToText . valDescription <$> toValues entries)++-- | Add one more Function to the list of Entries. --   It gets the highest priority for functions with the same output type-addFunction :: Function -> Functions -> Functions-addFunction f (Functions fs) = Functions (MM.insert (funDynOutTypeRep f) f fs)+addUntyped :: Untyped -> Entries -> Entries+addUntyped e (Entries es) = Entries (MM.insert (outTypeRep e) e es) --- | Add one more Function to the list of Functions+-- | Add an entry to the list of Entries.+--   It gets the highest priority for functions with the same output type+addEntry :: Typed a -> Entries -> Entries+addEntry e = addUntyped (untype e)++-- | Add one more untyped entry to the list of Entries --   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 :: 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@(Values vs) =-  if MM.null vs-    then ""-    else unlines (valDescriptionToText . valDescription <$> toValues values)---- | Add one more Value to the list of Values-addValue :: Value -> Values -> Values-addValue v (Values vs) = Values (MM.insert (valueDynTypeRep v) v vs)+appendUntyped :: Untyped -> Entries -> Entries+appendUntyped u (Entries es) = Entries (MM.fromList $ MM.toList es <> [(outTypeRep u, u)]) --- | Add one more Value to the list of Values---   It gets the lowest priority for values with the same type+-- | Add one more untyped entry to the list of Entries+--   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-appendValue :: Value -> Values -> Values-appendValue v (Values vs) = Values (MM.fromList $ MM.toList vs <> [(valueDynTypeRep v, v)])+appendEntry :: Typed a -> Entries -> Entries+appendEntry e = appendUntyped (untype e) --- | 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+-- | Find a function or value returning a target type+--   from a list of entries+findUntyped :: SomeTypeRep -> Entries -> Maybe Untyped+findUntyped target (Entries es) = P.head $ MM.lookup target es  -- | The types of values that we are trying to build at a given moment --   of the resolution algorithm.@@ -486,3 +493,38 @@   if P.null ms     then ""     else "modifiers for types\n" <> unlines (P.show . fst <$> ms)+++-- * VALUES++-- | List of values available which can be used as parameters to+--   constructors for building other values+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)++-- | Return values as a list+listValues :: Values -> [Value]+listValues (Values vs) = snd <$> MM.toList vs++-- | Add one more Value to the list of Values+addValue :: Value -> Values -> Values+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 values+findValues :: SomeTypeRep -> Values -> [Value]+findValues target (Values vs) = MM.lookup target vs++-- | Find the first value with a specific type+--   from a list of values+findValue :: SomeTypeRep -> Values -> Maybe Value+findValue target = P.head . findValues target

@@ -83,8 +83,8 @@ --   this can speed-up compilation when writing tests or in ghci makeEitherWithContext :: forall a ins out. (Typeable a) => Context -> Registry ins out -> Either Text a makeEitherWithContext context registry = do-  let values = _values registry-  let functions = _functions registry+  let values = mempty+  let entries = _entries registry   let specializations = _specializations registry   let modifiers = _modifiers registry   let targetType = someTypeRep (Proxy :: Proxy a)@@ -92,7 +92,7 @@   --  the list of values is kept as some State so that newly created values can be added to the current state   case runStackWithValues     values-    (makeUntyped targetType context functions specializations modifiers) of+    (makeUntyped targetType context entries specializations modifiers) of     Left e ->       Left . showRegistry $         "\nCould not create a "@@ -112,7 +112,7 @@   where     showRegistry message = do       let r = show registry-      -- this allows the display of registries of no more than ~ 30 functions+      -- this allows the display of registries of no more than ~ 30 entries       -- which should fit on a laptop screen       if (length . T.lines $ r) <= 35         then@@ -121,7 +121,7 @@             <> r             <> "=====================\n"             <> message-            <> "\n\nYou can check the registry displayed above the ===== line to verify the current values and functions\n"+            <> "\n\nYou can check the registry displayed above the ===== line to verify the current values and entries\n"         else           message             <> "\n\n (the registry is not displayed because it is too large)"

@@ -7,10 +7,9 @@ -- | --  A registry supports the creation of values out of existing values and functions. -----  It contains 4 parts:+--  It contains 3 parts: -----  * values: they are available for building anything else and have their exact value can be shown---  * functions: they are used to build other values. Only their type can be shown+--  * entries: they can be either values or functions used to create values --  * specializations: description of specific values to use while trying to build another value of a given type --  * modifiers: function to apply to a newly built value before storing it for future use --@@ -50,19 +49,18 @@ --   Internally all functions and values are stored as 'Dynamic' values --   so that we can access their representation data Registry (inputs :: [Type]) (outputs :: [Type]) = Registry-  { _values :: Values,-    _functions :: Functions,+  { _entries :: Entries,     _specializations :: Specializations,     _modifiers :: Modifiers   }  instance Show (Registry inputs outputs) where-  show (Registry vs fs ss@(Specializations ss') ms@(Modifiers ms')) =+  show (Registry es ss@(Specializations ss') ms@(Modifiers ms')) =     toS . unlines $       [ "Values\n",-        describeValues vs,+        describeValues es,         "Constructors\n",-        describeFunctions fs+        describeFunctions es       ]         <> ( if not (null ss')                then@@ -80,19 +78,19 @@            )  instance Semigroup (Registry inputs outputs) where-  (<>) (Registry vs1 fs1 ss1 ms1) (Registry vs2 fs2 ss2 ms2) =-      Registry (vs1 <> vs2) (fs1 <> fs2) (ss1 <> ss2) (ms1 <> ms2)+  (<>) (Registry fs1 ss1 ms1) (Registry fs2 ss2 ms2) =+      Registry (fs1 <> fs2) (ss1 <> ss2) (ms1 <> ms2)  instance Semigroup (Registry inputs outputs) => Monoid (Registry inputs outputs) where-  mempty = Registry mempty mempty mempty mempty+  mempty = Registry mempty mempty mempty   mappend = (<>)  -- | Append 2 registries together infixr 4 <+>  (<+>) :: Registry is1 os1 -> Registry is2 os2 -> Registry (is1 :++ is2) (os1 :++ os2)-(<+>)(Registry vs1 fs1 ss1 ms1) (Registry vs2 fs2 ss2 ms2) =-      Registry (vs1 <> vs2) (fs1 <> fs2) (ss1 <> ss2) (ms1 <> ms2)+(<+>)(Registry fs1 ss1 ms1) (Registry fs2 ss2 ms2) =+      Registry (fs1 <> fs2) (ss1 <> ss2) (ms1 <> ms2)  -- | Store an element in the registry --   Internally elements are stored as 'Dynamic' values@@ -104,25 +102,18 @@ -- | 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 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+registerUnchecked t (Registry entries specializations modifiers) =+  Registry (addEntry t entries) 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 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+appendUnchecked (Registry entries specializations modifiers) t =+  Registry (appendEntry t entries) 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 (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+addTypedUnchecked t1 t2 = Registry (fromUntyped [untype t1, untype t2]) mempty mempty  -- | Add an element to the Registry but do not check that the inputs of a --   can already be produced by the registry@@ -191,13 +182,13 @@ -- | Make the lists of types in the Registry unique, either for better display --   or for faster compile-time resolution with the make function normalize :: Registry ins out -> Registry (Normalized ins) (Normalized out)-normalize (Registry vs fs ss ms) = Registry vs fs ss ms+normalize (Registry es ss ms) = Registry es ss ms  -- | Remove the parameters list of the registry and replace it with an empty type --   This makes it easier to read compilation errors where less types are being displayed --   On the other hand the resulting registry cannot be type-checked anymore when trying to get values out of it eraseTypes :: Registry ins out -> Registry '[ERASED_TYPES] '[ERASED_TYPES]-eraseTypes (Registry values functions specializations modifiers) = Registry values functions specializations modifiers+eraseTypes (Registry entries specializations modifiers) = Registry entries specializations modifiers  -- | Singleton type representing erased types data ERASED_TYPES@@ -206,15 +197,15 @@ --   for example with conditional like --     if True then fun myFunctionWithKnownOutputs <: r else r safeCoerce :: (IsSameSet out out1) => Registry ins out -> Registry ins1 out1-safeCoerce (Registry a b c d) = Registry a b c d+safeCoerce (Registry a b c) = Registry a b c  -- | And for extreme cases where you know you're doing the right thing but can't prove it unsafeCoerce :: Registry ins out -> Registry ins1 out1-unsafeCoerce (Registry a b c d) = Registry a b c d+unsafeCoerce (Registry a b c) = Registry a b c  -- | The empty Registry end :: Registry '[] '[]-end = Registry mempty mempty mempty mempty+end = Registry mempty mempty mempty  -- | Create a value which can be added to the Registry val :: (Typeable a, Show a) => a -> Typed a@@ -247,15 +238,15 @@ -- | 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) => Typed b -> Registry ins out -> Registry ins out-specialize b (Registry values functions (Specializations c) modifiers) = do+specialize b (Registry entries (Specializations c) modifiers) = do   let ss = Specializations (Specialization (pure $ someTypeRep (Proxy :: Proxy a)) (untype b) : c)-  Registry values functions ss modifiers+  Registry entries ss modifiers  -- | Specialize a function for a specific path of types 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+specializePath b (Registry entries (Specializations c) modifiers) = do   let ss = Specializations (Specialization (someTypeReps (Proxy :: Proxy path)) (untype b) : c)-  Registry values functions ss modifiers+  Registry entries ss modifiers  -- | Typeclass for extracting type representations out of a list of types class PathToTypeReps (path :: [Type]) where@@ -270,10 +261,9 @@ -- | Once a value has been computed allow to modify it before storing it --   This keeps the same registry type tweak :: forall a ins out. (Typeable a) => (a -> a) -> Registry ins out -> Registry ins out-tweak f (Registry values functions specializations (Modifiers mf)) =+tweak f (Registry entries specializations (Modifiers mf)) =   Registry-    values-    functions+    entries     specializations     (Modifiers ((someTypeRep (Proxy :: Proxy a), createConstModifierFunction f) : mf)) @@ -288,10 +278,10 @@ --   Note that the returned Registry is in 'IO' because we are caching a value --   and this is a side-effect! memoize :: forall m a ins out. (MonadIO m, Typeable a, Typeable (m a)) => Registry ins out -> IO (Registry ins out)-memoize (Registry values functions specializations (Modifiers mf)) = do+memoize (Registry entries specializations (Modifiers mf)) = do   cache <- newCache @a   let modifiers = Modifiers ((someTypeRep (Proxy :: Proxy (m a)), createFunction . fetch @a @m cache) : mf)-  pure $ Registry values functions specializations modifiers+  pure $ Registry entries specializations modifiers  -- | Memoize *all* the output actions of a Registry when they are creating effectful components --   This relies on a helper data structure `MemoizeRegistry` tracking the types already

@@ -53,10 +53,8 @@  -- | 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 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+addToRegistry t (Registry entries specializations modifiers) =+  Registry (addEntry t entries) 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,13 +62,11 @@  -- | 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 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+addToRegistryUnsafe t (Registry entries specializations modifiers) =+  Registry (addEntry t entries) specializations modifiers  -- | Concatenate 2 registries concatRegistryUnsafe :: Registry ins out -> Registry ins' out' -> Registry ins' out' concatRegistryUnsafe-  (Registry vs1 fs1 ss1 ms1)-  (Registry vs2 fs2 ss2 ms2) = Registry (vs1 <> vs2) (fs1 <> fs2) (ss1 <> ss2) (ms1 <> ms2)+  (Registry fs1 ss1 ms1)+  (Registry fs2 ss2 ms2) = Registry (fs1 <> fs2) (ss1 <> ss2) (ms1 <> ms2)

@@ -30,8 +30,8 @@ --   of a given type makeStatisticsEither :: forall a ins out. (Typeable a) => Registry ins out -> Either Text Statistics makeStatisticsEither registry =-  let values = _values registry-      functions = _functions registry+  let values = mempty+      entries = _entries registry       specializations = _specializations registry       modifiers = _modifiers registry       targetType = someTypeRep (Proxy :: Proxy a)@@ -39,7 +39,7 @@       -- the list of values is kept as some State so that newly created values can be added to the current state       case evalStackWithValues         values-        (makeUntyped targetType (Context [(targetType, Nothing)]) functions specializations modifiers) of+        (makeUntyped targetType (Context [(targetType, Nothing)]) entries specializations modifiers) of         Left e ->           Left $             "could not create a " <> show targetType <> " out of the registry because " <> e <> "\nThe registry is\n"

@@ -29,10 +29,10 @@     <: fun (genList @Specialization)     <: funTo @Gen Specialization     -- functions-    <: funTo @Gen Functions+    <: funTo @Gen Entries     <: fun (genList @Function)-    <: fun (genMultiMap @SomeTypeRep @Function)-    <: fun (genPair @SomeTypeRep @Function)+    <: fun (genMultiMap @SomeTypeRep @Untyped)+    <: fun (genPair @SomeTypeRep @Untyped)     <: funTo @Gen Function     <: funTo @Gen FunctionDescription     -- values@@ -72,8 +72,7 @@ genTextToInt = pure (TextToInt T.length)  data UntypedRegistry = UntypedRegistry-  { _uvalues :: Values,-    _ufunctions :: Functions,+  { _ufunctions :: Entries,     _uspecializations :: Specializations,     _umodifiers :: Modifiers   }

@@ -16,7 +16,7 @@   function <- forall @Function   target <- forall @SomeTypeRep   context' <- forall @Context-  functions <- forall @Functions+  functions <- forall @Entries   specializations <- forall @Specializations   modifiers <- forall @Modifiers   values <- forall @Values

@@ -37,15 +37,15 @@ test_find_no_constructor = prop "no constructor can be found if nothing is stored in the registry" $ do   value <- forAll $ gen @Int -  (fromDynamic . funDyn <$> findFunction (valueDynTypeRep (createValue value)) mempty) === (Nothing :: Maybe (Maybe Int))+  (fromDynamic . untypedDyn <$> findUntyped (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-  functions <- forAll $ (createFunction function `addFunction`) <$> gen @Functions+  functions <- forAll $ addEntry (TypedFunction $ createFunction function)  <$> gen @Entries    let outputType = dynTypeRep (toDyn (1 :: Int)) -  (fmap TextToInt <$> (fromDynamic . funDyn <$> findFunction outputType functions))+  (fmap TextToInt <$> (fromDynamic . untypedDyn <$> findUntyped outputType functions))     === Just (Just (TextToInt function))  test_store_value_no_modifiers = prop "a value can be stored in the list of values" $ do

@@ -56,6 +56,28 @@   annotate "if inputs are missing for a specialization, we use the default value"   c2 === Config 3 +test_override_bug = test "we can override an IO value with an IO function" $ do+  let r = funTo @IO (Config 2)+            <: valTo @IO (Config 1)++  c1 <- liftIO $ make @(IO Config) r++  c1 === Config 2++test_override_specialized_bug = test "we can specialize an IO value with an IO function" $ do+  let r = specialize @(IO UseConfig2) (funTo @IO $ \(n::Int) -> Config n) $+         funTo @IO UseConfig2+        <: funTo @IO UseConfig1+        <: funTo @IO (Config 2)+            <: valTo @IO (Config 1)+            <: valTo @IO (5 :: Int)++  uc1 <- liftIO $ make @(IO UseConfig1) r+  uc2 <- liftIO $ make @(IO UseConfig2) r+  printConfig1 uc1 === Config 2+  printConfig2 uc2 === Config 5++ -- we want the following graph {-             +----------  Base  ------------+