registry 0.1.6.1 → 0.1.6.2

raw patch · 10 files changed

+97/−40 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• registry.cabal +2/−2
• src/Data/Registry/Internal/Make.hs +26/−10
• src/Data/Registry/Internal/Types.hs +24/−11
• src/Data/Registry/Make.hs +15/−7
• src/Data/Registry/Registry.hs +21/−5
• src/Data/Registry/Statistics.hs +1/−1
• test/Test/Data/Registry/Internal/GensRegistry.hs +3/−0
• test/Test/Data/Registry/Internal/MakeSpec.hs +3/−2
• test/Test/Data/Registry/Internal/RegistrySpec.hs +1/−1
• test/Test/Data/Registry/Internal/TypesSpec.hs +1/−1

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: b2a9bd3b890c2e666f472cab045fa0e78cb9e7663a6fbbac1a2417d264d3b534+-- hash: 27bccc93b2ea165fa0da09cc90d2c9392f38296f8240cebb4ac972dd05713611  name:           registry-version:        0.1.6.1+version:        0.1.6.2 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.

@@ -18,9 +18,10 @@ import           Data.List                       hiding (unlines) import           Data.Registry.Internal.Dynamic import           Data.Registry.Internal.Registry-import           Data.Registry.Internal.Types import           Data.Registry.Internal.Stack+import           Data.Registry.Internal.Types import           Data.Text                       as T (unlines)+import qualified Data.Text                       as T import           Protolude                       as P hiding (Constructor) import           Type.Reflection @@ -48,11 +49,14 @@     Nothing ->       -- if not, is there a way to build such value?       case findConstructor targetType functions of-        Nothing -> lift $ Left ("cannot find a constructor for " <> show targetType)+        Nothing -> lift $ Left $+             "When trying to create the following values\n\n          "+          <> T.intercalate "\nrequiring " (showContextTargets context)+          <> "\n\nNo constructor was found for " <> show targetType          Just function -> do           let inputTypes = collectInputTypes function-          inputs <- makeInputs inputTypes context functions specializations modifiers+          inputs <- makeInputs function inputTypes context functions specializations modifiers            if length inputs /= length inputTypes             then@@ -79,21 +83,33 @@       modified <- storeValue modifiers v       pure (Just modified) ++-- | Show the target type and possibly the constructor function requiring it+--   for every target type in the context+showContextTargets :: Context -> [Text]+showContextTargets (Context context) =+  fmap (\(t, f) ->+    case f of+       Nothing -> show t+       Just function -> show t <> "\t\t\t(required for the constructor " <> show function <> ")")+  (reverse context)+ -- | Make the input values of a given function --   When a value has been made it is placed on top of the --   existing registry so that it is memoized if needed in --   subsequent calls makeInputs ::-     [SomeTypeRep]   -- ^ input types to build+     Function+  -> [SomeTypeRep]   -- ^ input types to build   -> Context         -- ^ current context of types being built   -> Functions       -- ^ available functions to build values   -> Specializations -- ^ list of values to use when in a specific context   -> Modifiers       -- ^ modifiers to apply before storing made values   -> Stack [Value]   -- list of made values-makeInputs [] _ _ _ _ = pure []+makeInputs _ [] _ _ _ _ = pure [] -makeInputs (i : ins) (Context context) functions specializations modifiers =-  if i `elem` context+makeInputs function (i : ins) c@(Context context) functions specializations modifiers =+  if i `elem` (contextTypes c)     then       lift $ Left       $  toS@@ -102,12 +118,12 @@       <> (show <$> context)       <> ["But we are trying to build again " <> show i]     else do-      madeInput <- makeUntyped i (Context (i : context)) functions specializations modifiers+      madeInput <- makeUntyped i (Context ((i, Just (funDynTypeRep function)) : context)) functions 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 ins (Context context) functions specializations modifiers+          makeInputs function ins (Context context) functions specializations modifiers          Just v ->-          (v :) <$> makeInputs ins (Context context) functions specializations modifiers+          (v :) <$> makeInputs function ins (Context context) functions specializations modifiers

@@ -118,8 +118,8 @@ isInSpecializationContext :: SomeTypeRep -> Value -> Bool isInSpecializationContext target value =   case specializationContext value of-    Just (Context cs) -> target `elem` cs-    Nothing           -> False+    Just context -> target `elem` (contextTypes context)+    Nothing      -> False  -- | Return True if a value has transitives dependencies which are --   specialized values@@ -214,16 +214,29 @@  -- | 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+--   better error messages --   IMPORTANT: this is a *stack*, the deepest elements in the value --   graph are first in the list-newtype Context = Context {-  _contextStack :: [SomeTypeRep]-} deriving (Eq, Hashable, Show, Semigroup, Monoid)+data Context = Context {+  _contextStack :: [(SomeTypeRep, Maybe SomeTypeRep)]+} deriving (Eq, Show) +instance Semigroup Context where+  Context c1 <> Context c2 = Context (c1 <> c2)++instance Monoid Context where+  mempty = Context mempty+  mappend = (<>)++-- | Return the target types for a given context+contextTypes :: Context -> [SomeTypeRep]+contextTypes (Context cs) = fmap fst cs+ -- | The values that a value depends on newtype Dependencies = Dependencies {   unDependencies :: [Value]-} deriving (Show, Hashable, Semigroup, Monoid)+} deriving (Show, Semigroup, Monoid)  -- | The values types that a value depends on newtype DependenciesTypes = DependenciesTypes {@@ -284,8 +297,8 @@ -- | A specialization is applicable to a context if all its types --   are part of that context, in the right order isContextApplicable :: Context -> Specialization -> Bool-isContextApplicable (Context contextPath) (Specialization specializationPath _)  =-  P.all (`elem` contextPath) specializationPath+isContextApplicable context (Specialization specializationPath _)  =+  P.all (`elem` (contextTypes context)) specializationPath  -- | Return the specifications valid in a given context applicableTo :: Specializations -> Context -> Specializations@@ -299,10 +312,10 @@ --     the "deepest" in the current context --   If there is a tie we take the "highest" highest type of each specializedContext :: Context -> Specialization -> SpecializedContext-specializedContext (Context cs) specialization =+specializedContext context specialization =   SpecializedContext-    (specializationStart specialization `elemIndex` cs)-    (specializationEnd   specialization `elemIndex` cs)+    (specializationStart specialization `elemIndex` (contextTypes context))+    (specializationEnd   specialization `elemIndex` (contextTypes context))  -- | For a given context this represents the position of a specialization path --   in that context. startRange is the index of the start type of the specialization

@@ -59,7 +59,7 @@ -- | This version of make only execute checks at runtime --   this can speed-up compilation when writing tests or in ghci makeEither :: forall a ins out . (Typeable a) => Registry ins out -> Either Text a-makeEither = makeEitherWithContext (Context [someTypeRep (Proxy :: Proxy a)])+makeEither = makeEitherWithContext (Context [(someTypeRep (Proxy :: Proxy a), Nothing)])  -- | This version of `make` only execute checks at runtime --   this can speed-up compilation when writing tests or in ghci@@ -103,11 +103,11 @@  -- | makeEither for specialized values makeSpecializedEither :: forall a b ins out . (Typeable a, Typeable b) => Registry ins out -> Either Text b-makeSpecializedEither = makeEitherWithContext (Context [someTypeRep (Proxy :: Proxy a), someTypeRep (Proxy :: Proxy b)])+makeSpecializedEither = makeEitherWithContext (Context [(someTypeRep (Proxy :: Proxy a), Nothing), (someTypeRep (Proxy :: Proxy b), Nothing)])  -- | makeEither for specialized values makeSpecializedPathEither :: forall path b ins out . (PathToTypeReps path, Typeable b) => Registry ins out -> Either Text b-makeSpecializedPathEither = makeEitherWithContext (Context (toList $ someTypeReps (Proxy :: Proxy path)))+makeSpecializedPathEither = makeEitherWithContext (Context (fmap (\t -> (t, Nothing)) $ toList $ someTypeReps (Proxy :: Proxy path)))  -- | This version of make only execute checks at runtime --   this can speed-up compilation when writing tests or in ghci@@ -127,12 +127,20 @@        of         Left e ->-          Left $ "could not create a " <> show targetType <> " out of the registry because " <> e <> "\nThe registry is\n" <>-                 show registry+          Left $+             "\nThe registry is"+          <> "\n\n" <> show registry+          <> "=====================\n"+          <> "\nCould not create a " <> show targetType <> " out of the registry:"+          <> "\n\n" <> e+          <> "\n\nYou can check the registry displayed above the ===== line to verify the current values and constructors\n" +         Right Nothing ->-          Left $ "could not create a " <> show targetType <> " out of the registry." <> "\nThe registry is\n" <>-                 show registry+          Left $+          show registry+          <> "\n could not create a " <> show targetType <> " out of the registry"+          <> "\n\nYou can check the registry displayed above the ===== line to verify the current values and constructors\n"          Right (Just result) -> fromMaybe           (Left $ "could not cast the computed value to a " <> show targetType <> ". The value is of type: " <> show (valueDynTypeRep result))

@@ -63,13 +63,21 @@   }  instance Show (Registry inputs outputs) where-  show (Registry vs fs ss ms) =-    toS $ unlines [-        describeValues vs+  show (Registry vs fs ss@(Specializations ss') ms@(Modifiers ms')) =+    toS . unlines $ [+        "Values\n"+      , describeValues vs+      , "Constructors\n"       , describeFunctions fs-      , describeSpecializations ss-      , describeModifiers ms       ]+      <> (if not (null ss') then [+              "Specializations\n"+            , describeSpecializations ss]+          else [])+      <> (if not (null ms') then [+              "Modifiers\n"+            , describeModifiers ms]+          else [])  instance Semigroup (Registry inputs outputs) where   (<>) (Registry (Values vs1) (Functions fs1) (Specializations ss1) (Modifiers ms1))@@ -125,6 +133,14 @@ --   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++-- | 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++data ERASED_TYPES  -- | The empty Registry end :: Registry '[] '[]

@@ -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]) functions specializations modifiers)+          (makeUntyped targetType (Context [(targetType, Nothing)]) functions specializations modifiers)        of         Left e ->

@@ -36,9 +36,12 @@   +: fun   (genPair @(NonEmpty SomeTypeRep) @Value)   +: fun   (genList @Function)   +: fun   (genList @SomeTypeRep)+  +: fun   (genList @(SomeTypeRep, Maybe SomeTypeRep))   +: fun   (genList @Value)   +: fun   (genList @Function)   +: fun   (genMaybe @Text)+  +: fun   (genMaybe @SomeTypeRep)+  +: fun   (genPair @SomeTypeRep @(Maybe SomeTypeRep))   +: fun   (genList @Text)   +: fun   genInt   +: fun   genText

@@ -13,6 +13,7 @@ import           Type.Reflection  test_make_inputs_with_cycle = prop "making inputs when there's a cycle must be detected" $ do+  function        <- forall @Function   target          <- forall @SomeTypeRep   context'        <- forall @Context   functions       <- forall @Functions@@ -22,9 +23,9 @@    -- put one of the input types to build already in the list of   -- types being built-  let context = Context (target : _contextStack context')+  let context = Context ((target, Nothing) : _contextStack context') -  let result = runStackWithValues values (makeInputs [target] context  functions specializations modifiers)+  let result = runStackWithValues values (makeInputs function [target] context  functions specializations modifiers)   case result of     Left e  -> annotateShow e >> "cycle detected!" `T.isPrefixOf` e === True     Right _ -> failure

@@ -29,7 +29,7 @@   value <- forAll $ gen @Int   values <- forAll $ gen @Values   let listTypeRep = dynTypeRep . toDyn $ [value]-  let context = Context [listTypeRep] -- when trying to build a [Int]+  let context = Context [(listTypeRep, Nothing)] -- when trying to build a [Int]   let specializations = Specializations [Specialization (pure listTypeRep) (createValue value)]    (fromValueDyn <$> findValue (valueDynTypeRep (createValue value)) context specializations values) === Just (Just value)

@@ -9,7 +9,7 @@ import           Type.Reflection  test_specialized_context_order = prop "there are preferrable specializations than other in a given context" $ do-  let c1 = Context [f, e, d, c, b, a]+  let c1 = Context (fmap (\t -> (t, Nothing)) $ [f, e, d, c, b, a])   let s1 = specializedContext c1 (Specialization (a :| [c]) (createValue A))   let s2 = specializedContext c1 (Specialization (a :| [e]) (createValue A))   let s3 = specializedContext c1 (Specialization (c :| [f]) (createValue A))