generic-random 0.4.1.0 → 0.5.0.0

raw patch · 4 files changed

+70/−31 lines, 4 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• generic-random.cabal +3/−3
• src/Generic/Random/Generic.hs +20/−21
• src/Generic/Random/Internal/Generic.hs +41/−7

@@ -1,3 +1,9 @@+# 0.5.0.0++- Turn off dependency on boltzmann-samplers by default+- Add genericArbitraryU, genericArbitraryU0 and genericArbitraryU1+- Compatible with GHC 7.8.4 and GHC 7.10.3+ # 0.4.1.0  - Move Boltzmann sampler modules to another package: boltzmann-samplers

@@ -1,5 +1,5 @@ name:                generic-random-version:             0.4.1.0+version:             0.5.0.0 synopsis:            Generic random generators description:         Please see the README. homepage:            http://github.com/lysxia/generic-random@@ -18,7 +18,7 @@   Description:     Dependency on boltzmann-samplers for backwards compatibility.   Manual:  False-  Default: True+  Default: False  library   hs-source-dirs:      src@@ -26,7 +26,7 @@     Generic.Random.Generic     Generic.Random.Internal.Generic   build-depends:-    base >= 4.9 && < 4.10,+    base >= 4.7 && < 4.10,     QuickCheck   if flag(boltzmann)     exposed-modules:

@@ -27,8 +27,10 @@ -- -- The list of weights is built up with the @('%')@ operator as a cons, and using -- the unit @()@ as the empty list, in the order corresponding to the data type--- definition.+-- definition. The uniform distribution can be obtained with 'uniform'. --+-- === Example+-- -- For @Tree@, 'genericArbitrary' produces code equivalent to the following: -- -- @@@ -40,6 +42,20 @@ --     ] -- @ --+-- === Uniform distribution+--+-- You can specify the uniform distribution (all weights equal) with 'uniform'.+-- 'genericArbitraryU' is available as a shorthand for+-- @'genericArbitrary' 'uniform'@.+--+-- Note that for many types, a uniform distribution tends to produce big+-- values. For instance for @Tree a@, generated values are finite but the+-- __average__ number of @Leaf@ and @Node@ constructors is __infinite__.+--+-- === Checked weights+--+-- /GHC 8.0.1 and above only./+-- -- The weights actually have type @'W' \"ConstructorName\"@ (just a newtype -- around 'Int'), so that you can annotate a weight with its corresponding -- constructor, and it will be checked that you got the order right.@@ -60,26 +76,6 @@ -- 'weighted' (x '%' y '%' z '%' ()) :: 'Weights' (Tree a) -- @ ----- === Uniform distribution------ You can specify the uniform distribution with 'uniform'.------ For @Tree@, @'genericArbitrary' 'uniform'@ produces code equivalent to the--- following:------ @--- 'genericArbitrary' 'uniform' :: Arbitrary a => Gen (Tree a)--- 'genericArbitrary' 'uniform' =---   oneof---     [ Leaf \<$\> arbitrary                -- Uses Arbitrary a---     , Node \<$\> arbitrary \<*\> arbitrary  -- Uses Arbitrary (Tree a)---     ]--- @------ Note that for many types, a uniform distribution tends to produce big--- values. For instance for @Tree a@, generated values are finite but the--- __average__ number of @Leaf@ and @Node@ constructors is __infinite__.--- -- == Ensuring termination -- -- As was just mentioned, one must be careful with recursive types@@ -191,7 +187,10 @@   (     -- * Arbitrary implementations     genericArbitrary+  , genericArbitraryU   , genericArbitrary'+  , genericArbitraryU0+  , genericArbitraryU1      -- * Specifying finite distributions   , Weights

@@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-}@@ -15,8 +16,8 @@  import Control.Applicative import Data.Coerce-import GHC.Exts (Proxy#, proxy#)-import GHC.Generics hiding ( S )+import Data.Proxy+import GHC.Generics hiding (S, Arity) import GHC.TypeLits import Test.QuickCheck @@ -27,12 +28,19 @@ genericArbitrary   :: forall a   .  (Generic a, GA Unsized (Rep a))-  => Weights a+  => Weights a  -- ^ List of weights for every constructor   -> Gen a genericArbitrary (Weights w n) = (unGen' . fmap to) (ga w n :: Gen' Unsized (Rep a p)) --- | Like 'genericArbitrary'', with bounded size to ensure termination for--- recursive types.+-- | Shorthand for @'genericArbitrary' 'uniform'@.+genericArbitraryU+  :: forall a+  .  (Generic a, GA Unsized (Rep a), UniformWeight (Weights_ (Rep a)))+  => Gen a+genericArbitraryU = genericArbitrary uniform++-- | Like 'genericArbitrary'', with decreasing size to ensure termination for+-- recursive types, looking for base cases once the size reaches 0. genericArbitrary'   :: forall n a   . (Generic a, GA (Sized n) (Rep a))@@ -42,13 +50,32 @@ genericArbitrary' _ (Weights w n) =   (unGen' . fmap to) (ga w n :: Gen' (Sized n) (Rep a p)) +-- | Shorthand for @'genericArbitrary'' 'Z' 'uniform'@, using nullary+-- constructors as the base cases.+genericArbitraryU0+  :: forall n a+  . (Generic a, GA (Sized Z) (Rep a), UniformWeight (Weights_ (Rep a)))+  => Gen a+genericArbitraryU0 = genericArbitrary' Z uniform +-- | Shorthand for @'genericArbitrary'' ('S' 'Z') 'uniform'@, using nullary+-- constructors and constructors whose fields are all nullary as base cases.+genericArbitraryU1+  :: forall n a+  . (Generic a, GA (Sized (S Z)) (Rep a), UniformWeight (Weights_ (Rep a)))+  => Gen a+genericArbitraryU1 = genericArbitrary' (S Z) uniform+ -- * Internal  type family Weights_ (f :: * -> *) :: * where   Weights_ (f :+: g) = Weights_ f :| Weights_ g   Weights_ (M1 D _c f) = Weights_ f+#if __GLASGOW_HASKELL__ >= 800   Weights_ (M1 C ('MetaCons c _i _j) _f) = L c+#else+  Weights_ (M1 C _c _f) = ()+#endif  data a :| b = N a Int b data L (c :: Symbol) = L@@ -110,6 +137,10 @@   type Prec (L c) r = r   W m % prec = (L, m, prec) +instance WeightBuilder () where+  type Prec () r = r+  W m % prec = ((), m, prec)+ class UniformWeight a where   uniformWeight :: (a, Int) @@ -124,6 +155,9 @@ instance UniformWeight (L c) where   uniformWeight = (L, 1) +instance UniformWeight () where+  uniformWeight = ((), 1)+ newtype Gen' sized a = Gen' { unGen' :: Gen a }   deriving (Functor, Applicative, Monad) @@ -144,9 +178,9 @@   ga _ _ = (Gen' . fmap M1) gaProduct  instance (GAProduct f, KnownNat (Arity f)) => GA (Sized n) (M1 C c f) where-  ga _ _ = Gen' (scale (`div` arity) gaProduct)+  ga _ _ = Gen' (sized $ \n -> resize (n `div` arity) gaProduct)     where-      arity = fromInteger (natVal' (proxy# :: Proxy# (Arity f)))+      arity = fromInteger (natVal (Proxy :: Proxy (Arity f)))  instance (GASum (Sized n) f, GASum (Sized n) g, BaseCases n f, BaseCases n g)   => GA (Sized n) (f :+: g) where