diff --git a/registry.cabal b/registry.cabal --- a/registry.cabal +++ b/registry.cabal @@ -2,12 +2,13 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 574944d5ed00bd79d264d132cc871c91ff4f41bf0a44948fdaa8a7d0104d09d8 +-- hash: e874839524e4435322c3fb1ad902da3c64c103e774ee9abdc4ba082e60aa208d name: registry -version: 0.1.0.2 +version: 0.1.0.3 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. category: Control maintainer: etorreborre@yahoo.com license: MIT @@ -49,7 +50,6 @@ , protolude <0.3 , resourcet <1.3 , text <2 - , transformers <0.6 , transformers-base <0.5 default-language: Haskell2010 @@ -84,10 +84,8 @@ , registry , resourcet <1.3 , tasty <1.2 - , tasty-discover <4.3 , tasty-hedgehog <0.3 , tasty-th <0.2 , text <2 - , transformers <0.6 , transformers-base <0.5 default-language: Haskell2010 diff --git a/src/Data/Registry/Dot.hs b/src/Data/Registry/Dot.hs --- a/src/Data/Registry/Dot.hs +++ b/src/Data/Registry/Dot.hs @@ -4,7 +4,7 @@ {- | This modules 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 O @@ -26,7 +26,7 @@ import Protolude import Type.Reflection --- | Make a DOT graph for a specific value `a` built from the registry +-- | 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, Contains a out, Solvable ins out) @@ -41,12 +41,12 @@ -> Dot makeDotFast = makeDotUnsafe @a --- | Similar to `make` but does not check if `a` can be made out of the Regisry +-- | Similar to `make` but does not check if `a` can be made out of the 'Regisry' -- 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 <$> makeOperationsEither @a r --- | Similar to `make` but does not check if `a` can be made out of the Regisry +-- | Similar to `make` but does not check if `a` can be made out of the 'Regisry' -- and throws an exception if that's not the case makeDotUnsafe :: forall a ins out . (Typeable a) => Registry ins out -> Dot makeDotUnsafe = toDot . makeOperationsUnsafe @a diff --git a/src/Data/Registry/Internal/Dynamic.hs b/src/Data/Registry/Internal/Dynamic.hs --- a/src/Data/Registry/Internal/Dynamic.hs +++ b/src/Data/Registry/Internal/Dynamic.hs @@ -1,7 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {- | - Utility functions to work with Dynamic values + Utility functions to work with 'Dynamic' values -} module Data.Registry.Internal.Dynamic where @@ -11,20 +11,20 @@ import Protolude import Type.Reflection --- | Apply a function to a list of Dynamic values +-- | Apply a function to a list of 'Dynamic' values applyFunction :: - Function -- function - -> [Value] -- inputs - -> Either Text Value -- result + Function -- ^ function + -> [Value] -- ^ inputs + -> Either Text Value -- ^ result applyFunction function values = do created <- applyFunctionDyn (funDyn function) (valueDyn <$> values) pure $ CreatedValue created (ValueDescription (_outputType . funDescription $ function) Nothing) -- | Apply a Dynamic function to a list of Dynamic values applyFunctionDyn - :: Dynamic -- function - -> [Dynamic] -- inputs - -> Either Text Dynamic -- result + :: Dynamic -- ^ function + -> [Dynamic] -- ^ inputs + -> Either Text Dynamic -- ^ result applyFunctionDyn f [] = Left $ "the function " <> show (dynTypeRep f) diff --git a/src/Data/Registry/Internal/Make.hs b/src/Data/Registry/Internal/Make.hs --- a/src/Data/Registry/Internal/Make.hs +++ b/src/Data/Registry/Internal/Make.hs @@ -11,7 +11,7 @@ {- | Untyped implementation of the functionalities in - Data.Registry.Make + 'Data.Registry.Make' -} module Data.Registry.Internal.Make where @@ -28,8 +28,7 @@ -- | 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 --- We keep as a State value o +-- A 'Context' is passed in the form of a stack of the types we are trying to build so far makeUntyped :: SomeTypeRep -> Context diff --git a/src/Data/Registry/Internal/Reflection.hs b/src/Data/Registry/Internal/Reflection.hs --- a/src/Data/Registry/Internal/Reflection.hs +++ b/src/Data/Registry/Internal/Reflection.hs @@ -30,7 +30,7 @@ showFullFunctionType = showTheFullFunctionType . typeOf -- | Show the full type of a typeable value --- where nested types like IO[Int] or functions are represented and +-- where nested types like @IO[Int]@ or functions are represented and -- non GHC types are shown with their module names showTheFullValueType :: forall (r1 :: RuntimeRep) (arg :: TYPE r1) . (TypeRep arg -> Text) showTheFullValueType a = @@ -68,7 +68,7 @@ _ -> ([], showSingleType (SomeTypeRep a)) --- | Show a type like m a +-- | Show a type like @m a@ showNested :: SomeTypeRep -> SomeTypeRep -> Text showNested a b = parenthesizeNested $ tweakNested $ showSingleType a <> " " <> showSingleType b @@ -100,9 +100,9 @@ n -- | This is an attempt to better render "nested" types like IO (Maybe Text) --- The input value is "IO Maybe Text" and the output text will be "IO (Maybe Text)" +-- The input value is @"IO Maybe Text"@ and the output text will be @"IO (Maybe Text)"@ -- This will unfortunately not work with types having several type parameters --- like IO (Either Text Int) +-- like @IO (Either Text Int)@ parenthesizeNested :: Text -> Text parenthesizeNested t = case T.splitOn " " t of diff --git a/src/Data/Registry/Internal/Registry.hs b/src/Data/Registry/Internal/Registry.hs --- a/src/Data/Registry/Internal/Registry.hs +++ b/src/Data/Registry/Internal/Registry.hs @@ -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 diff --git a/src/Data/Registry/Internal/Stack.hs b/src/Data/Registry/Internal/Stack.hs --- a/src/Data/Registry/Internal/Stack.hs +++ b/src/Data/Registry/Internal/Stack.hs @@ -1,9 +1,9 @@ {- | Internal monad for the resolution algorithm - - we keep some state for the list of created values - - we collect the applied functions as "Operations" - - we might exit with a Left value if we can't build a value + - we keep some state for the list of created values + - we collect the applied functions as "Operations" + - we might exit with a Left value if we can't build a value -} module Data.Registry.Internal.Stack where diff --git a/src/Data/Registry/Internal/Types.hs b/src/Data/Registry/Internal/Types.hs --- a/src/Data/Registry/Internal/Types.hs +++ b/src/Data/Registry/Internal/Types.hs @@ -12,7 +12,7 @@ import Protolude hiding (show) import Type.Reflection --- | A Function is the Dynamic representation of a Haskell value + its description +-- | A 'Function' is the 'Dynamic' representation of a Haskell value + its description -- It is either provided by the user of the Registry or created as part of the -- resolution algorithm data Value = @@ -36,95 +36,95 @@ 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 --- | Create a Value from a Haskell value, with its Show description +-- | Create a Value from a Haskell value, with its 'Show' description createValue :: (Show a, Typeable a) => a -> Value createValue a = ProvidedValue (toDyn a) (describeValue a) --- | Create a Value from a Haskell value, with only its Typeable description +-- | Create a Value from a Haskell value, with only its 'Typeable' description createTypeableValue :: Typeable a => a -> Value createTypeableValue a = ProvidedValue (toDyn a) (describeTypeableValue a) --- | Create a Value from a Dynamic value and some description +-- | Create a Value from a 'Dynamic' value and some description createDynValue :: Dynamic -> Text -> Value createDynValue dyn desc = ProvidedValue dyn (ValueDescription desc Nothing) --- | Type representation of a Value +-- | Type representation of a 'Value' valueDynTypeRep :: Value -> SomeTypeRep valueDynTypeRep (CreatedValue d _) = dynTypeRep d valueDynTypeRep (ProvidedValue d _) = dynTypeRep d --- | Dynamic representation of a Value +-- | Dynamic representation of a 'Value' valueDyn :: Value -> Dynamic valueDyn (CreatedValue d _) = d valueDyn (ProvidedValue d _) = d --- | The description for a Value +-- | The description for a 'Value' valDescription :: Value -> ValueDescription valDescription (CreatedValue _ d) = d valDescription (ProvidedValue _ d) = d --- | A ValueDescription as Text. If the actual content of the Value +-- | A ValueDescription as 'Text'. If the actual content of the 'Value' -- is provided display the type first then the content valDescriptionToText :: ValueDescription -> Text valDescriptionToText (ValueDescription t Nothing) = t valDescriptionToText (ValueDescription t (Just v)) = t <> ": " <> v --- | A Function is the Dynamic representation of a Haskell function + its description +-- | A Function is the 'Dynamic' representation of a Haskell function + its description data Function = Function Dynamic FunctionDescription deriving (Show) --- | Create a Function value from a Haskell function +-- | Create a 'Function' value from a Haskell function createFunction :: (Typeable a) => a -> Function createFunction a = let dynType = toDyn a in Function dynType (describeFunction a) --- | Description of a function with input types and output type +-- | Description of a 'Function' with input types and output type data FunctionDescription = FunctionDescription { _inputTypes :: [Text] , _outputType :: Text } deriving (Eq, Show) --- | Describe a function (which doesn't have a Show instance) --- that can be put in the Registry +-- | Describe a 'Function' (which doesn't have a 'Show' instance) +-- that can be put in the 'Registry' describeFunction :: Typeable a => a -> FunctionDescription describeFunction = uncurry FunctionDescription . showFullFunctionType --- | Show a Function as Text using its Description +-- | Show a Function as 'Text' using its Description showFunction :: Function -> Text showFunction = funDescriptionToText . funDescription --- | The Description of a Function +-- | The Description of a 'Function' funDescription :: Function -> FunctionDescription funDescription (Function _ t) = t --- | Dynamic representation of a Function +-- | Dynamic representation of a 'Function' funDyn :: Function -> Dynamic funDyn (Function d _) = d --- | Type representation of a Function +-- | Type representation of a 'Function' funDynTypeRep :: Function -> SomeTypeRep funDynTypeRep = dynTypeRep . funDyn --- | A FunctionDescription as Text +-- | A 'FunctionDescription' as 'Text' funDescriptionToText :: FunctionDescription -> Text funDescriptionToText (FunctionDescription ins out) = T.intercalate " -> " (ins <> [out]) --- | Return True if a Function has some input values +-- | Return True if a 'Function' has some input values hasParameters :: Function -> Bool hasParameters = isFunction . funDynTypeRep --- | A Typed value can be added to a Registry --- It is either a value, having both Show and Typeable information --- or a function having just Typeable information +-- | A Typed value 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 = TypedValue Value | TypedFunction Function --- The list of functions available for constructing other values +-- | The list of functions available for constructing other values newtype Functions = Functions [Function] deriving (Show, Semigroup, Monoid) -- | Add one more Function to the list of Functions diff --git a/src/Data/Registry/Lift.hs b/src/Data/Registry/Lift.hs --- a/src/Data/Registry/Lift.hs +++ b/src/Data/Registry/Lift.hs @@ -5,14 +5,15 @@ {- | This code is taken from https://stackoverflow.com/questions/28003135/is-it-possible-to-encode-a-generic-lift-function-in-haskell - to allow a generic lift operation over an Applicative context - So if you have a function: Int -> Text -> IO Int, it can be lifted to have all of its parameters - in IO: - f :: Int -> Text -> IO Int + to allow a generic lift operation over an 'Applicative' context + So if you have a function: @Int -> Text -> IO Int@, it can be lifted to have all of its parameters + in 'IO': - lifted :: IO Int -> IO Text -> IO Int - lifted = to @IO f + > f :: Int -> Text -> IO Int + > + > lifted :: IO Int -> IO Text -> IO Int + > lifted = to @IO f -} module Data.Registry.Lift where diff --git a/src/Data/Registry/RIO.hs b/src/Data/Registry/RIO.hs --- a/src/Data/Registry/RIO.hs +++ b/src/Data/Registry/RIO.hs @@ -4,7 +4,7 @@ {-# LANGUAGE UndecidableInstances #-} {- | - RIO is equivalent to ResourceT (WriterT Warmup IO) + RIO is equivalent to @ResourceT (WriterT Warmup IO)@ It can be used to instantiate "modules as records of functions" where each module can allocate resources and have a "warmup phase" to preload data or asses if it is working properly @@ -86,7 +86,7 @@ lift $ f result a -- | 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) => Registry ins out -> ResourceT IO (a, Warmup) runRegistryT registry = withInternalState $ \is -> runRIO (make @(RIO a) registry) (Stop is) @@ -106,7 +106,7 @@ unsafeRun :: forall a ins out . (Typeable a, Contains (RIO a) out) => Registry ins out -> IO a unsafeRun registry = fst <$> unsafeRunWithStop registry --- | Same as unsafeRun but keep the Stop value to be able to clean resources later +-- | Same as 'unsafeRun' but keep the 'Stop' value to be able to clean resources later unsafeRunWithStop :: forall a ins out . (Typeable a, Contains (RIO a) out) => Registry ins out -> IO (a, Stop) unsafeRunWithStop registry = do is <- createInternalState @@ -115,7 +115,7 @@ -- * Module creation --- | Lift a warmup action into the RIO monad +-- | Lift a 'Warmup' action into the 'RIO' monad warmupWith :: Warmup -> RIO () warmupWith w = RIO (const $ pure ((), w)) diff --git a/src/Data/Registry/Registry.hs b/src/Data/Registry/Registry.hs --- a/src/Data/Registry/Registry.hs +++ b/src/Data/Registry/Registry.hs @@ -9,46 +9,47 @@ functions. It contains 4 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 - - 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 - A registry is created by using the +: operator, adding functions or values to the empty `end` registry: + * 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 + * 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 - registry = - val (Config 1) - +: val "hello" - +: fun add1 - +: fun show1 - +: end + A registry is created by using the `+:` operator, adding functions or values to the empty `end` registry: + > registry = + > val (Config 1) + > +: val "hello" + > +: fun add1 + > +: fun show1 + > +: end + At the type level a list of all the function inputs and all the outputs is being kept to allow some checks to be made when we want to build a value out of the registry. Registries have a `Monoid` instance so they can be created incrementally: - config = - val (Config 1) - +: val "hello" - +: end - - constructors = - +: fun add1 - +: fun show1 - +: end - - registry = - config <> constructors - - It is also possible to use the `<>` operator to "override" some configurations: + > config = + > val (Config 1) + > +: val "hello" + > +: end + > + > constructors = + > +: fun add1 + > +: fun show1 + > +: end + > + > registry = + > config <> constructors - mocks = - fun noLogging - +: fun inMemoryDb - +: end + It is also possible to use the `<+>` operator to "override" some configurations: - mocks <> registry + > mocks = + > fun noLogging + > +: fun inMemoryDb + > +: end + > + > mocks <+> registry -} module Data.Registry.Registry where @@ -66,7 +67,7 @@ import Type.Reflection -- | Container for a list of functions or values --- Internally all functions and values are stored as Dynamic values +-- Internally all functions and values are stored as 'Dynamic' values -- so that we can access their representation data Registry (inputs :: [*]) (outputs :: [*]) = Registry { @@ -98,7 +99,7 @@ Registry (Values (vs1 <> vs2)) (Functions (fs1 <> fs2)) (Specializations (ss1 <> ss2)) (Modifiers (ms1 <> ms2)) -- | Store an element in the registry --- Internally elements are stored as dynamic values +-- Internally elements are stored as 'Dynamic' values register :: (Typeable a) => Typed a -> Registry ins out @@ -121,11 +122,11 @@ end :: Registry '[] '[] end = Registry (Values []) (Functions []) (Specializations []) (Modifiers []) --- | 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) @@ -133,23 +134,22 @@ 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) --- | This is a shortcut to (fun . allTo) where `allTo` lifts all the inputs and output --- to an Applicative context +-- | This is a shortcut to @fun . allTo@ where @allTo@ lifts all the inputs and output +-- to an 'Applicative' context funTo :: forall m a b . (ApplyVariadic m a b, Typeable a, Typeable b) => a -> Typed b funTo a = fun (allTo @m a) --- | This is a shortcut to (fun . argsTo) where `allTo` lifts all the inputs +-- | This is a shortcut to @fun . argsTo@ where @allTo@ lifts all the inputs -- to an Applicative context 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 --- value +-- | 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, Contains a out, Typeable b) => b -> Registry ins out @@ -160,7 +160,7 @@ (Specializations ((someTypeRep (Proxy :: Proxy a), createTypeableValue b) : c)) modifiers --- | This is similar to specialize but additionally uses the Show instance of b +-- | This is similar to specialize but additionally uses the 'Show' instance of @b@ -- to display more information when printing the registry out specializeVal :: forall a b ins out . (Typeable a, Contains a out, Typeable b, Show b) => b @@ -172,9 +172,9 @@ (Specializations ((someTypeRep (Proxy :: Proxy a), createValue b) : c)) modifiers --- | This is similar to specialize but additionally uses the Show instance of b +-- | This is similar to specialize but additionally uses the 'Show' instance of @b@ -- to display more information when printing the registry out and --- it "lifts" the value to an applicative context +-- it "lifts" the value to an 'Applicative' context specializeValTo :: forall m a b ins out . (Applicative m, Typeable a, Contains a out, Typeable (m b), Typeable b, Show b) => b -> Registry ins out @@ -185,8 +185,7 @@ (Specializations ((someTypeRep (Proxy :: Proxy a), liftProvidedValue @m b) : c)) modifiers --- | Once a value has been computed allow to modify it before storing --- it +-- | Once a value has been computed allow to modify it before storing it tweak :: forall a ins out . (Typeable a, Contains a out) => (a -> a) -> Registry ins out @@ -195,7 +194,7 @@ (Modifiers ((someTypeRep (Proxy :: Proxy a), createFunction f) : mf)) -- | Return singleton values for a monadic type --- Note that the returned Registry is in IO because we are caching a value +-- Note that the returned Registry is in 'IO' because we are caching a value -- and this is a side-effect! singleton :: forall m a ins out . (MonadIO m, Typeable a, Typeable (m a), Contains (m a) out) => Registry ins out diff --git a/src/Data/Registry/Warmup.hs b/src/Data/Registry/Warmup.hs --- a/src/Data/Registry/Warmup.hs +++ b/src/Data/Registry/Warmup.hs @@ -6,7 +6,7 @@ are properly configured: - createWarmup creates a warmup from an action - returning a Result + returning a 'Result' - warmupOf takes a component name and unit action then just checks that the action executes without @@ -38,40 +38,40 @@ Left e -> failed $ "KO: " <> show (typeOf a) <> " -> " <> show e Right _ -> ok $ "OK: " <> show (typeOf a) --- | Create a Warmup from an IO action returning a Result +-- | Create a 'Warmup' from an 'IO' action returning a 'Result' createWarmup :: IO Result -> Warmup createWarmup t = Warmup [t] --- | The empty Warmup +-- | The empty 'Warmup' noWarmup :: Warmup noWarmup = Warmup [pure Empty] --- | Create a warmup with no action but just the type of a component +-- | Create a 'Warmup' with no action but just the type of a component declareWarmup :: Typeable a => a -> Warmup declareWarmup a = warmupOf a (pure ()) --- | Result of a warmup +-- | Result of a 'Warmup' data Result = Empty | Ok [Text] | Failed [Text] deriving (Eq, Show) --- | Return True if a Warmup was successful +-- | Return 'True' if a 'Warmup' was successful isSuccess :: Result -> Bool isSuccess Empty = True isSuccess (Ok _) = True isSuccess (Failed _) = False --- | Create a successful Result +-- | Create a successful 'Result' ok :: Text -> Result ok t = Ok [t] --- | Create a failed Result +-- | Create a failed 'Result' failed :: Text -> Result failed t = Failed [t] --- | Extract the list of all the messages from a Result +-- | Extract the list of all the messages from a 'Result' messages :: Result -> [Text] messages Empty = [] messages (Ok ms) = ms @@ -95,7 +95,7 @@ runWarmup :: Warmup -> IO Result runWarmup (Warmup as) = foldr' runBoth (pure Empty) as --- | runBoth runs both tasks and cumulate the results +-- | 'runBoth' runs both tasks and cumulate the results -- exceptions are being transformed into Failed results runBoth :: IO Result -> IO Result -> IO Result runBoth io1 io2 = do