packages feed

registry 0.3.2.0 → 0.3.2.1

raw patch · 17 files changed

+156/−136 lines, 17 files

Files

README.md view
@@ -3,42 +3,65 @@  [![Join the chat at https://gitter.im/etorreborre/registry](https://badges.gitter.im/etorreborre/registry.svg)](https://gitter.im/etorreborre/registry?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) -##### *It's functions all the way down* <img src="doc/images/unboxed-bottomup.jpg" border="0"/>+##### *It's functions all the way down* <img src="https://raw.githubusercontent.com/etorreborre/registry/main/doc/images/unboxed-bottomup.jpg" border="0"/>  #### Presentation -This library provides a data structure, a `Registry`, to control the creation of functions from other functions. You can use this technique to:+This library provides a data structure, a "Registry", to control the creation of functions from other functions. You can use this technique to:   - create applications out of software components ("dependency injection")- - fine tune encoders/decoders (see the [`registry-aeson`](http://github.com/etorreborre/registry-aeson) and the [`registry-messagepack`](http://github.com/etorreborre/registry-messagepack) projects)- - create composable data generators for nested datatypes (see the [`registry-hedgehog`](http://github.com/etorreborre/registry-hedgehog) and the [`registry-hedgehog-aeson`](http://github.com/etorreborre/registry-hedgehog-aeson) projects)+ - fine tune encoders/decoders (see the [`registry-aeson`][registry-aeson] and the [`registry-messagepack`][registry-messagepack] projects)+ - create composable data generators for nested datatypes (see the [`registry-hedgehog`][registry-hedgehog] and the [`registry-hedgehog-aeson`][registry-hedgehog-aeson] projects)  You can watch a video presenting the main ideas behind the library [here](https://skillsmatter.com/skillscasts/12299-wire-once-rewire-twice).  The following sections introduce in more details the problem that this library is addressing, the concepts behind the solution and various use-cases which can arise on real projects: - 1. [what is the problem?](doc/motivation.md)- 1. the concept of a [Registry](doc/registry.md) and the resolution algorithm+ 1. [what is the problem?][motivation]+ 1. the concept of a [Registry][registry] and the resolution algorithm  1. how does this [compare to monad transformers and effects](https://github.com/etorreborre/effects)?  #### Tutorials - 1. tutorial: use a `Registry` to create [applications](doc/tutorial.md) and define components- 1. use a `Registry` to compose [Hedgehog generators](https://github.com/etorreborre/registry-hedgehog/doc/generators.md)+ 1. tutorial: use a `Registry` to create [applications][tutorial] and define components+ 1. use a `Registry` to compose [Hedgehog generators][generators]+ 1. [workshop][workshop]: implement your own simplified registry and understand the basic concepts behind it  #### How-tos - 1. how to [install this library](doc/install.md)?- 1. how to do [mocking](doc/applications.md#integration)?- 1. how to [specialize some values in some contexts](doc/applications.md#context-dependent-configurations)?- 1. how to [control effects](doc/applications.md#memoization) occurring when creating a component (like a connection pool)?- 1. how to [allocate resources](doc/applications.md#resources) which must be finalized?- 1. how to [extract a dot graph from the registry](doc/dot.md) in an application?+ 1. how to [install this library][install]?+ 1. how to do [mocking][mocking]?+ 1. how to [specialize some values in some contexts][specialize]?+ 1. how to [control effects][memoization] occurring when creating a component (like a connection pool)?+ 1. how to [allocate resources][resources] which must be finalized?+ 1. how to [extract a dot graph from the registry][dot] in an application?  1. how to [interact with a library using monad transformers](https://github.com/etorreborre/registry/blob/master/test/Test/Data/Registry/MonadRandomSpec.hs)?- 1. how to [remove boilerplate](doc/boilerplate.md) due to parameter passing?- 1. how to [create a typeclass from a record of functions](doc/typeclass.md)?+ 1. how to [remove boilerplate][boilerplate] due to parameter passing?+ 1. how to [create a typeclass from a record of functions][typeclass]?  #### Reference guides - 1. [main operators and functions](doc/reference.md)- 1. [implementation notes](doc/implementation.md)+ 1. [main operators and functions][reference]+ 1. [implementation notes][implementation]+++[motivation]: http://github.com/etorreborre/registry/blob/main/doc/motivation.md+[registry]: http://github.com/etorreborre/registry/blob/main/doc/registry.md+[tutorial]: http://github.com/etorreborre/registry/blob/main/doc/tutorial.md+[applications]: http://github.com/etorreborre/registry/blob/main/doc/applications.md+[mocking]: http://github.com/etorreborre/registry/blob/main/doc/applications.md#integration+[install]: http://github.com/etorreborre/registry/blob/main/doc/install.md+[specialize]: http://github.com/etorreborre/registry/blob/main/doc/applications.md#context-dependent-configurations+[memoization]: http://github.com/etorreborre/registry/blob/main/doc/applications.md#memoization+[resources]: http://github.com/etorreborre/registry/blob/main/doc/applications.md#resources+[dot]: http://github.com/etorreborre/registry/blob/main/doc/dot.md+[boilerplate]: http://github.com/etorreborre/registry/blob/main/doc/boilerplate.md+[typeclass]: http://github.com/etorreborre/registry/blob/main/doc/typeclass.md+[generators]: http://github.com/etorreborre/registry-hedgehog/blob/main/doc/tutorial.md+[registry-hedgehog]: http://github.com/etorreborre/registry-hedgehog+[registry-messagepack]: http://github.com/etorreborre/registry-messagepack+[registry-aeson]: http://github.com/etorreborre/registry-aeson+[registry-hedgehog-aeson]: http://github.com/etorreborre/registry-hedgehog-aeson+[reference]: http://github.com/etorreborre/registry/blob/main/doc/reference.md+[implementation]: http://github.com/etorreborre/registry/blob/main/doc/implementation.md+[workshop]: https://github.com/etorreborre/registry-workshop
registry.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 63f09863d931c472e14fddae51fd7cf72418e1f06b45ee3f1e8602188d2e680a+-- hash: 5fda8684fe77f8d86c3731ff82397a6c871ebc5b3cc09d525176e0ae7d6f7e24  name:           registry-version:        0.3.2.0+version:        0.3.2.1 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.
src/Data/Registry/Dot.hs view
@@ -4,7 +4,7 @@ -- | --  This module provides functions to extract --  a DOT graph (https://en.wikipedia.org/wiki/DOT_(graph_description_language)---  out of a 'Registry'.+--  out of a Registry module Data.Registry.Dot   ( module D,     makeDot,@@ -17,13 +17,13 @@ import Data.Registry.Statistics import Protolude --- | Make a DOT graph for a specific value `a` built from the 'Registry'---   `a` is at the root of the graph and its children are values---   needed to build `a`+-- | Make a DOT graph for a specific value a built from the Registry+--   a is at the root of the graph and its children are values+--   needed to build a makeDot :: forall a ins out. (Typeable a) => Registry ins out -> Dot makeDot = toDot . operations . makeStatistics @a --- | Similar to `make` but does not check if `a` can be made out of the 'Registry'+-- | Similar to make but does not check if a can be made out of the Registry --   It returns a Left value if that's not the case makeDotEither :: forall a ins out. (Typeable a) => Registry ins out -> Either Text Dot makeDotEither r = toDot . operations <$> makeStatisticsEither @a r
src/Data/Registry/Internal/Dot.hs view
@@ -2,7 +2,7 @@ --  Nested datatype to track the resolution algorithm -- --  From this data type we can draw a graph of the full---  instantation of a value+--  instantiation of a value module Data.Registry.Internal.Dot where  import Data.Hashable@@ -27,30 +27,37 @@   }   deriving (Eq, Show) --- Use a State type to get the current index of a value+-- | Use a State type to get the current index of a value -- when there are values of the same type and different -- hash values type DotState = State ValuesByType +-- | List of value hashes by value type type ValuesByType = Map SomeTypeRep ValueHashes +-- | Type alias for a Hash type Hash = Int +-- | Type alias for a ValueId type ValueId = Int +-- | Type alias for a list of hashes type ValueHashes = [Hash] +-- | Type alias for a list of an edge in the graph type Edge = (Value, Value) +-- | Type alias for a list of edges type Edges = [Edge] +-- | Type alias for associating a number to a value type ValueCounter = Maybe Int  -- | Make a DOT graph out of all the function applications toDot :: Operations -> Dot toDot op =   let edges = makeEdges op-      allValues = join $ (\(v1, v2) -> [v1, v2]) <$> edges+      allValues = edges >>= (\(v1, v2) -> [v1, v2])       valueTypes = execState (traverse countValueTypes allValues) mempty    in Dot $         T.unlines $
src/Data/Registry/Internal/Dynamic.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} --- |---  Utility functions to work with 'Dynamic' values+-- | Utility functions to work with 'Dynamic' values module Data.Registry.Internal.Dynamic where  import Data.Dynamic
src/Data/Registry/Internal/Registry.hs view
@@ -4,7 +4,7 @@ {-# LANGUAGE UndecidableInstances #-}  -- |---  Internal structure of a 'Registry' and+--  Internal structure of a Registry and --  associated functions module Data.Registry.Internal.Registry where
src/Data/Registry/Internal/Stack.hs view
@@ -1,5 +1,4 @@--- |---  Internal monad for the resolution algorithm+-- | Internal monad for the resolution algorithm -- --  - we keep some state for the list of created values --  - we collect the applied functions as "Operations"@@ -21,6 +20,7 @@ runStackWithValues :: Values -> Stack a -> Either Text a runStackWithValues vs sa = evalStateT sa (initStatistics vs) +-- | Run the stack to get a list of created values execStack :: Stack a -> Either Text Values execStack = execStackWithValues mempty @@ -33,6 +33,7 @@ evalStack :: Stack a -> Either Text Statistics evalStack = evalStackWithValues mempty +-- | Run the stack to get a the statistics, starting with some initially created values evalStackWithValues :: Values -> Stack a -> Either Text Statistics evalStackWithValues vs sa = execStateT sa (initStatistics vs) @@ -48,9 +49,11 @@ modifyValues :: (Values -> Values) -> Stack () modifyValues f = modifyStatistics (\s -> s {values = f (values s)}) +-- | Modify the current operations modifyOperations :: (Operations -> Operations) -> Stack () modifyOperations f = modifyStatistics (\s -> s {operations = f (operations s)}) +-- | Modify the current statistics modifyStatistics :: (Statistics -> Statistics) -> Stack () modifyStatistics = modify
src/Data/Registry/Internal/Statistics.hs view
@@ -1,10 +1,8 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{--  This module provides a set of statistics over the execution-  of the registry. This allows to get better insights over the execution-  or test that the registry is well configured--}+-- | This module provides a set of statistics over the execution+--  of the registry. This allows to get better insights over the execution+--  or test that the registry is well configured module Data.Registry.Internal.Statistics where  import Data.Registry.Internal.Types@@ -45,6 +43,7 @@   }   deriving (Show) +-- | Create Statistics from a list of values initStatistics :: Values -> Statistics initStatistics vs = mempty {values = vs}
src/Data/Registry/Internal/Types.hs view
@@ -61,7 +61,7 @@ describeTypeableValue :: (Typeable a) => a -> ValueDescription describeTypeableValue a = ValueDescription (showFullValueType a) Nothing --- | Show a Value from the 'Registry'+-- | Show a Value from the Registry showValue :: Value -> Text showValue = valDescriptionToText . valDescription @@ -153,7 +153,7 @@   deriving (Eq, Show)  -- | Describe a 'Function' (which doesn't have a 'Show' instance)---   that can be put in the 'Registry'+--   that can be put in the Registry describeFunction :: Typeable a => a -> FunctionDescription describeFunction = uncurry FunctionDescription . showFullFunctionType @@ -181,7 +181,7 @@ hasParameters :: Function -> Bool hasParameters = isFunction . funDynTypeRep --- | A Typed value or function can be added to a 'Registry'+-- | A Typed value or function can be added to a Registry --   It is either a value, having both 'Show' and 'Typeable' information --   or a function having just 'Typeable' information data Typed a@@ -251,6 +251,7 @@   }   deriving (Eq, Show, Semigroup, Monoid) +-- | Return the types of all the dependencies dependenciesTypes :: Dependencies -> DependenciesTypes dependenciesTypes (Dependencies ds) = DependenciesTypes (valueDynTypeRep <$> ds) @@ -275,7 +276,7 @@ --   For example: --      specializationPath = [App, PaymentEngine, TransactionRepository] --      specializationValue = DatabaseConfig "localhost" 5432---   This means that need to use this `DatabaseConfig` whenever+--   This means that need to use this DatabaseConfig whenever --   trying to find inputs needed to create a TransactionRepository --   if that repository is necessary to create a PaymentEngine, itself --   involved in the creation of the App@@ -285,8 +286,12 @@   }   deriving (Eq, Show) +-- | List of consecutive types used when making a specific values+--   See the comments on 'Specialization' type SpecializationPath = NonEmpty SomeTypeRep +-- | Return the various specialization paths which have possibly led to the+--   creation of that value specializationPaths :: Value -> Maybe [SpecializationPath] specializationPaths v =   case catMaybes $ usedSpecialization <$> (v : (unDependencies . valDependencies $ v)) of@@ -309,7 +314,7 @@ --   are part of that context, in the right order isContextApplicable :: Context -> Specialization -> Bool isContextApplicable context (Specialization specializationPath _) =-  P.all (`elem` (contextTypes context)) specializationPath+  P.all (`elem` contextTypes context) specializationPath  -- | Return the specifications valid in a given context applicableTo :: Specializations -> Context -> Specializations@@ -317,7 +322,7 @@   Specializations (P.filter (isContextApplicable context) ss)  -- | The depth of a specialization in a context is the---   the index of the 'deepest' type of that specialization+--   the index of the "deepest" type of that specialization --   in the stack of types of that context --   is the one having its "deepest" type (in the value graph) --     the "deepest" in the current context@@ -375,9 +380,10 @@  -- | List of functions modifying some values right after they have been --   built. This enables "tweaking" the creation process with slightly---   different results. Here SomeTypeRep is the target value type 'a' and+--   different results. Here SomeTypeRep is the target value type a and newtype Modifiers = Modifiers [(SomeTypeRep, ModifierFunction)] deriving (Semigroup, Monoid) +-- | Specify a Function to use to modify a value specify by some types paths type ModifierFunction = Maybe [SpecializationPath] -> Function  -- | Create a 'Function' value from a Haskell function
src/Data/Registry/Lift.hs view
@@ -90,30 +90,37 @@ --   It uses an auxiliary typeclass to count the arguments of a function data Nat = Z | S Nat +-- | Number of arguments for a given function type data NumArgs :: Nat -> Type -> Type where   NAZ :: NumArgs Z a   NAS :: NumArgs n b -> NumArgs (S n) (a -> b) +-- | Count the number of arguments for a function type type family CountArgs (f :: Type) :: Nat where   CountArgs (a -> b) = S (CountArgs b)   CountArgs result = Z +-- | Typeclass for counting the number of arguments of a function type class CNumArgs (numArgs :: Nat) (arrows :: Type) where   getNA :: NumArgs numArgs arrows +-- | Instance for zero arguments instance CNumArgs Z a where   getNA = NAZ +-- | Instance for n arguments instance CNumArgs n b => CNumArgs (S n) (a -> b) where   getNA = NAS getNA +-- | Type family for applying a function to the last type of a function type type family Apply (f :: Type -> Type) (n :: Nat) (arrows :: Type) :: Type where   Apply f (S n) (a -> b) = a -> Apply f n b   Apply f Z a = f a +-- | Apply a function to the last return value of a function applyLast :: forall f fun. (Applicative f, CNumArgs (CountArgs fun) fun) => fun -> Apply f (CountArgs fun) fun applyLast = applyLast' @f (getNA :: NumArgs (CountArgs fun) fun)--applyLast' :: forall f n fun. Applicative f => NumArgs n fun -> fun -> Apply f n fun-applyLast' NAZ x = pure x-applyLast' (NAS n) f = applyLast' @f n . f+  where+    applyLast' :: forall f' n fun'. Applicative f' => NumArgs n fun' -> fun' -> Apply f' n fun'+    applyLast' NAZ x = pure x+    applyLast' (NAS n) f = applyLast' @f' n . f
src/Data/Registry/Make.hs view
@@ -36,7 +36,7 @@ import Type.Reflection import qualified Prelude (error) --- | Make an element of type 'a' out of the registry+-- | Make an element of type a out of the registry make :: forall a ins out. (Typeable a) => Registry ins out -> a make registry =   -- if the registry is an unchecked one, built with +:@@ -45,12 +45,12 @@     Right a -> a     Left e -> Prelude.error (toS e) --- | Make an element of type 'a' out of the registry+-- | Make an element of type a out of the registry --   and check statically that the element can be built makeSafe :: forall a ins out. (Typeable a, Solvable ins out) => Registry ins out -> a makeSafe = make --- | Make an element of type 'a' out of the registry, for a registry+-- | Make an element of type a out of the registry, for a registry --   which was possibly created with +: makeEither :: forall a ins out. (Typeable a) => Registry ins out -> Either Text a makeEither = makeEitherWithContext (Context [(someTypeRep (Proxy :: Proxy a), Nothing)])
src/Data/Registry/RIO.hs view
@@ -1,3 +1,4 @@+-- | Utilities for working with ResourceT IO module Data.Registry.RIO where  import Control.Monad.Trans.Resource@@ -6,6 +7,7 @@ import Data.Registry.Solver import Protolude +-- | Type alias for ResourceT IO type RIO = ResourceT IO  -- | This function must be used to run services involving a top component@@ -22,7 +24,7 @@   runResourceT (runRegistryT @a registry >>= liftIO . f)  -- | This can be used if you want to insert the component creation inside---   another action managed with 'ResourceT'. Or if you want to call 'runResourceT' yourself later+--   another action managed with ResourceT. Or if you want to call runResourceT yourself later runRegistryT ::   forall a ins out .   (Typeable a, Contains (RIO a) out, Solvable ins out, MemoizedActions out) =>
src/Data/Registry/Registry.hs view
@@ -100,7 +100,7 @@  -- | Store an element in the registry --   Internally elements are stored as 'Dynamic' values---   The signature checks that a constructor of type 'a' can be fully+--   The signature checks that a constructor of type a can be fully --   constructed from elements of the registry before adding it register :: (Typeable a, IsSubset (Inputs a) out a) => Typed a -> Registry ins out -> Registry (Inputs a :++ ins) (Output a ': out) register = registerUnchecked@@ -122,22 +122,24 @@   Registry (Values vs) (Functions (fs <> [f])) 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 :: (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 --- | Add an element to the Registry but do not check that the inputs of 'a'+-- | Add an element to the Registry but do not check that the inputs of a --   can already be produced by the registry infixr 5 +: +-- | Prepend an element to the registry with no checks at all (+:) :: (Typeable a) => Typed a -> Registry ins out -> Registry (Inputs a :++ ins) (Output a ': out) (+:) = registerUnchecked  -- Unification of +: and <+> infixr 5 <: +-- | Typeclass for appending values and or registries together, with static checks class AddRegistryLike a b c | a b -> c where   (<:) :: a -> b -> c @@ -165,6 +167,7 @@ -- Unchecked unification of +: and <+> infixr 5 <+ +-- | Typeclass for appending values and or registries together, without static checks class AddRegistryUncheckedLike a b c | a b -> c where   (<+) :: a -> b -> c @@ -200,6 +203,7 @@ eraseTypes :: Registry ins out -> Registry '[ERASED_TYPES] '[ERASED_TYPES] eraseTypes (Registry values functions specializations modifiers) = Registry values functions specializations modifiers +-- | Singleton type representing erased types data ERASED_TYPES  -- | In case it is hard to show that the types of 2 registries align@@ -216,11 +220,11 @@ end :: Registry '[] '[] end = Registry mempty mempty mempty mempty --- | Create a value which can be added to the 'Registry'+-- | Create a value which can be added to the Registry val :: (Typeable a, Show a) => a -> Typed a val a = TypedValue (ProvidedValue (toDyn a) (describeValue a)) --- | Create a value which can be added to the 'Registry' and "lift" it to an 'Applicative' context+-- | Create a value which can be added to the Registry and "lift" it to an 'Applicative' context valTo :: forall m a. (Applicative m, Typeable a, Typeable (m a), Show a) => a -> Typed (m a) valTo a = TypedValue (liftProvidedValue @m a) @@ -228,7 +232,7 @@ liftProvidedValue :: forall m a. (Applicative m, Typeable a, Typeable (m a), Show a) => a -> Value liftProvidedValue a = ProvidedValue (toDyn (pure a :: m a)) (describeValue a) --- | Create a function which can be added to the 'Registry'+-- | Create a function which can be added to the Registry fun :: (Typeable a) => a -> Typed a fun a = TypedFunction (createFunction a) @@ -244,15 +248,10 @@ funAs :: forall m a b. (ApplyVariadic1 m a b, Typeable a, Typeable b) => a -> Typed b 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+-- | 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 :: 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@@ -260,12 +259,8 @@     (Specializations (Specialization (pure $ someTypeRep (Proxy :: Proxy a)) (createTypeableValue b) : c))     modifiers -specializePath ::-  forall path b ins out.-  (PathToTypeReps path, Typeable b) =>-  b ->-  Registry ins out ->-  Registry ins out+-- | 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@@ -273,12 +268,8 @@     (Specializations (Specialization (someTypeReps (Proxy :: Proxy path)) (createTypeableValue b) : c))     modifiers -specializeVal ::-  forall a b ins out.-  (Typeable a, Contains a out, Typeable b, Show b) =>-  b ->-  Registry ins out ->-  Registry ins out+-- | 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@@ -286,12 +277,8 @@     (Specializations (Specialization (pure $ someTypeRep (Proxy :: Proxy a)) (createValue b) : c))     modifiers -specializePathVal ::-  forall path b ins out.-  (PathToTypeReps path, Typeable b, Show b) =>-  b ->-  Registry ins out ->-  Registry ins out+-- | 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@@ -299,12 +286,8 @@     (Specializations (Specialization (someTypeReps (Proxy :: Proxy path)) (createValue b) : c))     modifiers -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+-- | 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@@ -312,12 +295,8 @@     (Specializations (Specialization (pure $ someTypeRep (Proxy :: Proxy a)) (liftProvidedValue @m b) : c))     modifiers -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+-- | 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@@ -337,12 +316,7 @@  -- | 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 :: forall a ins out. (Typeable a) => (a -> a) -> Registry ins out -> Registry ins out tweak f (Registry values functions specializations (Modifiers mf)) =   Registry     values@@ -360,11 +334,7 @@ -- | Return memoized values for a monadic type --   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 :: 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   cache <- newCache @a   let modifiers = Modifiers ((someTypeRep (Proxy :: Proxy (m a)), createFunction . fetch @a @m cache) : mf)@@ -372,32 +342,39 @@  -- | 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---   memoized and a typeclass MemoizedActions going through the list of `out` types to process them---   one by one. Note that a type of the form `a` will not be memoized (only `m a`)+--   memoized and a typeclass MemoizedActions going through the list of out types to process them+--   one by one. Note that a type of the form a will not be memoized (only `m a`) memoizeAll :: forall m ins out. (MonadIO m, MemoizedActions out) => Registry ins out -> IO (Registry ins out) memoizeAll r =   _unMemoizeRegistry     <$> memoizeActions (startMemoizeRegistry r) +-- | Registry where all output values are memoized newtype MemoizeRegistry (todo :: [Type]) (ins :: [Type]) (out :: [Type]) = MemoizeRegistry {_unMemoizeRegistry :: Registry ins out} +-- | Prepare a Registry for memoization startMemoizeRegistry :: Registry ins out -> MemoizeRegistry out ins out startMemoizeRegistry = MemoizeRegistry +-- | Prepare a Registry for memoization for a specific list of types makeMemoizeRegistry :: forall todo ins out. Registry ins out -> MemoizeRegistry todo ins out makeMemoizeRegistry = MemoizeRegistry @todo +-- | This typeclass take an existing registry and memoize values created for the ls types class MemoizedActions ls where   memoizeActions :: MemoizeRegistry ls ins out -> IO (MemoizeRegistry '[] ins out) +-- | If the list of types is empty there is nothing to memoize instance MemoizedActions '[] where   memoizeActions = pure +-- | If the type represents an effectful value, memoize it and recurse with the rest instance {-# OVERLAPPING #-} (MonadIO m, Typeable a, Typeable (m a), MemoizedActions rest) => MemoizedActions (m a : rest) where   memoizeActions (MemoizeRegistry r) = do     r' <- memoize @m @a r     memoizeActions (makeMemoizeRegistry @rest r') +-- | If the type represents a pure value, memoize the rest instance (MemoizedActions rest) => MemoizedActions (a : rest) where   memoizeActions (MemoizeRegistry r) =     memoizeActions (makeMemoizeRegistry @rest r)
src/Data/Registry/Solver.hs view
@@ -95,6 +95,7 @@   FindUnique a (a ': _rest) = '[]   FindUnique a (_b ': rest) = FindUnique a rest +-- | Type family to remove some redundant types in a list of types type family Normalized (as :: [Type]) :: [Type] where   Normalized '[] = '[]   Normalized '[a] = '[a]
src/Data/Registry/State.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +-- | This module is experimental and is not added to the top level module Data.Registry.+--   It is not quite sure if we can / should support a useful state monad for passing a registry around module Data.Registry.State where  import Control.Monad.Morph@@ -8,11 +10,6 @@ import Data.Registry.Registry import Data.Registry.Solver import Protolude--{--  This module is experimental and is not added to the top level module Data.Registry.-  It is not quite sure if we can / should support a useful state monad for passing a registry around.--}  -- | Run some registry modifications in the StateT monad runS :: (MFunctor m, Monad n) => Registry ins out -> m (StateT (Registry ins out) n) a -> m n a
src/Data/Registry/Statistics.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE MonoLocalBinds #-} +-- | This module returns creation data about the values created when created a value of a given type module Data.Registry.Statistics   ( module S,     makeStatistics,
src/Data/Registry/TH.hs view
@@ -1,4 +1,23 @@ {-# LANGUAGE CPP #-}++-- | This module generates a typeclass for a given "record of functions". For this component:+--   @+--   data Logger m = Logger {+--     _info :: Text -> m ()+--   , _error :: Text -> m ()+--   }+--+--   -- makeTypeClass ''Logger generates+--+--   class WithLogger m where+--     info :: Text -> m ()+--     error :: Text -> m ()+--+--   -- This requires the import of `Data.Generics.Product.Typed` from `generic-lens`+--   instance HasType (Logger m) s => WithLogger (ReaderT s m) where+--     info t = ReaderT (\l -> _info (getTyped l) t)+--     error t = ReaderT (\l -> _error (getType l) t)+--   @ module Data.Registry.TH   ( TypeclassOptions,     makeTypeclass,@@ -10,27 +29,6 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax import Protolude hiding (Type)--{--  This module generates a typeclass for a given "record of functions". For this component:--data Logger m = Logger {-  _info :: Text -> m ()-, _error :: Text -> m ()-}---- `makeTypeClass ''Logger` generates--class WithLogger m where-  info :: Text -> m ()-  error :: Text -> m ()---- This requires the import of `Data.Generics.Product.Typed` from `generic-lens`-instance HasType (Logger m) s => WithLogger (ReaderT s m) where-  info t = ReaderT (\l -> _info (getTyped l) t)-  error t = ReaderT (\l -> _error (getType l) t)---}  -- | Create the haskell code presented in the module description makeTypeclass :: Name -> DecsQ