registry 0.1.0.2 → 0.1.0.3

raw patch · 12 files changed

+116/−119 lines, 12 filesdep −tasty-discoverdep −transformers

Dependencies removed: tasty-discover, transformers

Files

• registry.cabal +3/−5
• src/Data/Registry/Dot.hs +4/−4
• src/Data/Registry/Internal/Dynamic.hs +8/−8
• src/Data/Registry/Internal/Make.hs +2/−3
• src/Data/Registry/Internal/Reflection.hs +4/−4
• src/Data/Registry/Internal/Registry.hs +1/−1
• src/Data/Registry/Internal/Stack.hs +3/−3
• src/Data/Registry/Internal/Types.hs +24/−24
• src/Data/Registry/Lift.hs +7/−6
• src/Data/Registry/RIO.hs +4/−4
• src/Data/Registry/Registry.hs +46/−47
• src/Data/Registry/Warmup.hs +10/−10

@@ -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

@@ -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

@@ -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)

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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)) 

@@ -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

@@ -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