registry 0.1.1.0 → 0.1.1.1

raw patch · 9 files changed

+175/−29 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• registry.cabal +6/−4
• src/Data/Registry/Internal/Reflection.hs +2/−1
• src/Data/Registry/Internal/Registry.hs +6/−6
• src/Data/Registry/Internal/Types.hs +42/−2
• src/Data/Registry/Registry.hs +7/−9
• test/Test/Data/Registry/GenSpec.hs +106/−0
• test/Test/Data/Registry/Internal/Gens.hs +1/−3
• test/Test/Data/Registry/Internal/RegistrySpec.hs +4/−3
• test/Test/Data/Registry/RegistrySpec.hs +1/−1

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack ----- hash: a6b0a84be53407fd0d0dfd4cd14b966f573fc2925fdd6fb561542e4e93f26676+-- hash: e2e1d6fc54b123bc23add64e260b71809555917b9df05c2f2a1d3478cc89242c  name:           registry-version:        0.1.1.0+version:        0.1.1.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.@@ -14,7 +16,6 @@ license:        MIT license-file:   LICENSE.txt build-type:     Simple-cabal-version:  >= 1.10  source-repository head   type: git@@ -58,6 +59,7 @@   main-is: test.hs   other-modules:       Test.Data.Registry.DotSpec+      Test.Data.Registry.GenSpec       Test.Data.Registry.Internal.CacheSpec       Test.Data.Registry.Internal.DynamicSpec       Test.Data.Registry.Internal.Gens

@@ -86,7 +86,8 @@ mustShowModuleName name = not $ P.any identity $   fmap (`isPrefixOf` name) [       "GHC.Types."    -- for Int, Double,..-    , "GHC.Base."     -- for Maybe+    , "GHC.Base."     -- for other Base types+    , "GHC.Maybe."    -- for Maybe     , "Data.Either."  -- for Either     , "Data.Text.Internal"] 

@@ -20,8 +20,8 @@ --   where some of them are not functions --   There is also a list of specializations when we can specialize the values to use --   if a given type is part of the context-findValue-  :: SomeTypeRep+findValue ::+     SomeTypeRep   -> Context   -> Specializations   -> Values@@ -48,8 +48,8 @@  -- | Find a constructor function returning a target type --   from a list of constructors-findConstructor-  :: SomeTypeRep+findConstructor ::+     SomeTypeRep   -> Functions   -> Maybe Function findConstructor _      (Functions []        ) = Nothing@@ -76,8 +76,8 @@ --   to catch and report the error. Note that this error would be an implementation --   error (and not a user error) since at the type-level everything should be correct ---storeValue-  :: Modifiers+storeValue ::+     Modifiers   -> Value   -> Stack Value storeValue (Modifiers ms) value =

@@ -9,7 +9,8 @@ import           Data.Registry.Internal.Reflection import           Data.Text                         as T import           Prelude                           (show)-import           Protolude                         hiding (show)+import           Protolude                         as P hiding (show)+import qualified Protolude                         as P import           Type.Reflection  -- | A 'Function' is the 'Dynamic' representation of a Haskell value + its description@@ -20,6 +21,11 @@   | ProvidedValue Dynamic ValueDescription   deriving (Show) +-- | Return the dynamic part of a value+getValueDynamic :: Value -> Dynamic+getValueDynamic (CreatedValue d _)  = d+getValueDynamic (ProvidedValue d _) = d+ -- | Description of a value. It might just have --   a description for its type when it is a value --   created by the resolution algorithm@@ -70,7 +76,7 @@ -- | 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 Nothing)  = t valDescriptionToText (ValueDescription t (Just v)) = t <> ": " <> v  -- | A Function is the 'Dynamic' representation of a Haskell function + its description@@ -127,6 +133,14 @@ -- | The list of functions available for constructing other values newtype Functions = Functions [Function] deriving (Show, Semigroup, Monoid) +-- | Display a list of constructors+describeFunctions :: Functions -> Text+describeFunctions (Functions fs) =+  if P.null fs then+    ""+  else+    unlines (funDescriptionToText . funDescription <$> fs)+ -- | Add one more Function to the list of Functions addFunction :: Function -> Functions -> Functions addFunction f (Functions fs) = Functions (f : fs)@@ -134,6 +148,14 @@ -- | List of values available for constructing other values newtype Values = Values [Value] deriving (Show, Semigroup, Monoid) +-- | Display a list of values+describeValues :: Values -> Text+describeValues (Values vs) =+  if P.null vs then+    ""+  else+    unlines (valDescriptionToText . valDescription <$> vs)+ -- | Add one more Value to the list of Values addValue :: Value -> Values -> Values addValue v (Values vs) = Values (v : vs)@@ -145,7 +167,25 @@ --   construction when a corresponding type comes in context newtype Specializations = Specializations [(SomeTypeRep, Value)] deriving (Show, Semigroup, Monoid) +-- | Display a list of specializations for the Registry, just showing the+--   context (a type) in which a value must be selected+describeSpecializations :: Specializations -> Text+describeSpecializations (Specializations ss) =+  if P.null ss then+    ""+  else+    "specializations\n" <> unlines (P.show <$> ss)+ -- | 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 newtype Modifiers = Modifiers [(SomeTypeRep, Function)] deriving (Show, Semigroup, Monoid)++-- | Display a list of modifiers for the Registry, just showing the+--   type of the modified value+describeModifiers :: Modifiers -> Text+describeModifiers (Modifiers ms) =+  if P.null ms then+    ""+  else+    "modifiers for types\n" <> unlines (P.show . fst <$> ms)

@@ -78,15 +78,13 @@   }  instance Show (Registry inputs outputs) where-  show (Registry (Values vs) (Functions fs) _ _) =-    let describeValues =-          if null vs then ""-          else            unlines (valDescriptionToText . valDescription <$> vs)-        describeFunctions =-            if null fs then ""-            else            unlines (funDescriptionToText . funDescription <$> fs)-    in-        toS $ unlines [describeValues, describeFunctions]+  show (Registry vs fs ss ms) =+    toS $ unlines [+        describeValues vs+      , describeFunctions fs+      , describeSpecializations ss+      , describeModifiers ms+      ]  instance Semigroup (Registry inputs outputs) where   (<>) (Registry (Values vs1) (Functions fs1) (Specializations ss1) (Modifiers ms1))

@@ -0,0 +1,106 @@+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++{-+  This module shows how to use the registry with hedgehog generators+-}+module Test.Data.Registry.GenSpec where++import           Data.Registry+import           Hedgehog.Gen          as Gen+import           Hedgehog.Range        as Range+import           Protolude             as P+import           Test.Tasty.Extensions++-- * DATA MODEL++newtype Company =+  Company { departments :: [Department] }+  deriving (Eq, Show)++newtype Department =+  Department { employees :: [Employee] }+  deriving (Eq, Show)++data Employee = Employee {+    name   :: Name+  , age    :: Age+  , salary :: Salary+} deriving (Eq, Show)++newtype Name = Name Text deriving (Eq, Show)+newtype Age  = Age Int deriving (Eq, Show, Ord, Num)++data Salary =+    Fixed Int+  | Variable Int Double+  deriving (Eq, Show)++-- * GENERATORS++genText :: Gen Text+genText = Gen.text (Range.linear 2 10) Gen.ascii++genList :: forall a . (Typeable a) => Gen a -> Gen [a]+genList = Gen.list (Range.linear 0 3)++genInt :: Gen Int+genInt = Gen.int (Range.linear 1 100)++genDouble :: Gen Double+genDouble = Gen.double (Range.linearFrac 1 100)++setDepartmentWithOneEmployee :: Monad m => RegistryProperty m ()+setDepartmentWithOneEmployee = do+  e <- forall @Employee+  tweakGen @[Employee] (const $ pure [e])++setCompanyWithOneDepartment :: Monad m => RegistryProperty m ()+setCompanyWithOneDepartment = do+  d <- forall @Department+  tweakGen @[Department] (const (pure [d]))++setMinimalCompany :: Monad m => RegistryProperty m ()+setMinimalCompany =+  -- be careful, this is NOT commutative!+  -- if you set a company with one department first you may end up+  -- with a department with no employees, generated once and forall+  setDepartmentWithOneEmployee >>+  setCompanyWithOneDepartment++-- | Create a registry for all generators+registry =+     funTo @Gen Company+  +: funTo @Gen Department+  +: funTo @Gen Employee+  +: funTo @Gen Fixed+  +: funTo @Gen Name+  +: funTo @Gen Age+  +: fun (genList @Department)+  +: fun (genList @Employee)+  +: fun genInt+  +: fun genText+  +: fun genDouble+  +: end++test_company_with_one_employee = noShrink $ prop "generate just one employee" $ run $ do+  setMinimalCompany+  company <- forall @Company+  let allEmployees = company & departments >>= (& employees)+  length allEmployees === 1++-- * HELPERS++type RegistryProperty m a = forall ins out . StateT (Registry ins out) (PropertyT m) a++forall :: forall a m . (HasCallStack, Typeable a, Show a, Monad m) => RegistryProperty m a+forall = withFrozenCallStack $ get >>= P.lift . forAll . makeUnsafe @(Gen a)++tweakGen :: forall a m . (Typeable a, Monad m) => (Gen a -> Gen a) -> RegistryProperty m ()+tweakGen f = modify $ tweakUnsafe @(Gen a) f++run :: Monad m => RegistryProperty m a -> PropertyT m a+run = flip evalStateT registry+----+tests = $(testGroupGenerator)

@@ -64,9 +64,7 @@   pure (value, values)  genSomeTypeRep :: Gen Value -> Gen SomeTypeRep-genSomeTypeRep genValue = do-  ProvidedValue a _ <- genValue-  pure $ dynTypeRep a+genSomeTypeRep = fmap (dynTypeRep . getValueDynamic)  genDynamic :: Gen Dynamic genDynamic = Gen.element [toDyn (1 :: Int), toDyn (2 :: Int), toDyn ("1" :: Text)]

@@ -1,15 +1,16 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell     #-} {-# LANGUAGE TypeApplications    #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}  module Test.Data.Registry.Internal.RegistrySpec where  import           Data.Dynamic-import           Data.Registry.Internal.Types-import           Data.Registry.Internal.Stack import           Data.Registry.Internal.Registry+import           Data.Registry.Internal.Stack+import           Data.Registry.Internal.Types import           Protolude                        as P hiding (show) import           Test.Data.Registry.Internal.Gens import           Test.Tasty.Extensions

@@ -30,7 +30,7 @@ newLogger = pure (Logger print)  refLogger :: IORef Text -> Logger-refLogger ref = Logger (\t -> writeIORef ref t)+refLogger ref = Logger (writeIORef ref)  registry =      fun newLogger