packages feed

savage (empty) → 1.0.0

raw patch · 7 files changed

+408/−0 lines, 7 filesdep +basedep +randomdep +tf-randomsetup-changed

Dependencies added: base, random, tf-random

Files

+ LICENSE view
@@ -0,0 +1,29 @@+(The following is the 3-clause BSD license.)++Copyright (c) 2000-2017, Koen Claessen+Copyright (c) 2006-2008, Björn Bringert+Copyright (c) 2009-2017, Nick Smallbone++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.+- Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the+  documentation and/or other materials provided with the distribution.+- Neither the names of the copyright owners nor the names of the+  contributors may be used to endorse or promote products derived+  from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+AS IS AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,3 @@+# `savage`++`savage` is a re-export of the random generators from QuickCheck.
+ Setup.hs view
@@ -0,0 +1,3 @@+import           Distribution.Simple+main = defaultMain+
+ savage.cabal view
@@ -0,0 +1,40 @@+---------------------------------------------------------------------++name:                      savage+version:                   1.0.0+build-type:                Simple+cabal-version:             >= 1.10+category:                  Data+author:                    Daniel Cartwright+maintainer:                dcartwright@layer3com.com+license:                   BSD3+license-file:              LICENSE+homepage:                  https://github.com/chessai/savage+bug-reports:               https://github.com/chessai/savage/issues+synopsis:                  Re-exported random generators from QuickCheck.+description:               Re-exported random generators from QuickCheck.+extra-source-files:        README.md+tested-with:               GHC == 8.2.1++---------------------------------------------------------------------++source-repository head+    type:                git+    branch:              master+    location:            https://github.com/chessai/savage.git++---------------------------------------------------------------------++library+    hs-source-dirs:        src+    build-depends:         base       >= 4.8 && < 5.0+                         , random+                         , tf-random+    exposed-modules:       Savage+                         , Savage.Gen+                         , Savage.Randy+    default-language:      Haskell2010+    other-extensions:      CPP +                        +---------------------------------------------------------------------+
+ src/Savage.hs view
@@ -0,0 +1,8 @@+module Savage +  ( module Savage.Gen+  , module Savage.Randy+  ) where++import Savage.Gen+import Savage.Randy+
+ src/Savage/Gen.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE CPP #-}+#ifndef NO_ST_MONAD+{-# LANGUAGE Rank2Types #-}+#endif+-- | Test case generation.+module Savage.Gen where++--------------------------------------------------------------------------+-- imports++import System.Random+  ( Random+  , random+  , randomR+  , split+  )++import Control.Monad+  ( ap+  , replicateM+  , filterM+  )++import Control.Applicative+  ( Applicative(..) )++import Savage.Randy+import Data.List+import Data.Ord+import Data.Maybe++--------------------------------------------------------------------------+-- ** Generator type++-- | A generator for values of type @a@.+--+-- The third-party package+-- <http://hackage.haskell.org/package/QuickCheck-GenT QuickCheck-GenT>+-- provides a monad transformer version of @GenT@.+newtype Gen a = MkGen{+  unGen :: SVGen -> Int -> a -- ^ Run the generator on a particular seed.+                             -- If you just want to get a random value out, consider using 'generate'.+  }++instance Functor Gen where+  fmap f (MkGen h) =+    MkGen (\r n -> f (h r n))++instance Applicative Gen where+  pure  = return+  (<*>) = ap++instance Monad Gen where+  return x =+    MkGen (\_ _ -> x)++  MkGen m >>= k =+    MkGen (\r n ->+      case split r of+        (r1, r2) ->+          let MkGen m' = k (m r1 n)+          in m' r2 n+    )++--------------------------------------------------------------------------+-- ** Primitive generator combinators++-- | Modifies a generator using an integer seed.+variant :: Integral n => n -> Gen a -> Gen a+variant k (MkGen g) = MkGen (\r n -> g (variantSVGen k r) n)++-- | Used to construct generators that depend on the size parameter.+--+-- For example, 'listOf', which uses the size parameter as an upper bound on+-- length of lists it generates, can be defined like this:+--+-- > listOf :: Gen a -> Gen [a]+-- > listOf gen = sized $ \n ->+-- >   do k <- choose (0,n)+-- >      vectorOf k gen+--+-- You can also do this using 'getSize'.+sized :: (Int -> Gen a) -> Gen a+sized f = MkGen (\r n -> let MkGen m = f n in m r n)++-- | Generates the size parameter. Used to construct generators that depend on+-- the size parameter.+--+-- For example, 'listOf', which uses the size parameter as an upper bound on+-- length of lists it generates, can be defined like this:+--+-- > listOf :: Gen a -> Gen [a]+-- > listOf gen = do+-- >   n <- getSize+-- >   k <- choose (0,n)+-- >   vectorOf k gen+--+-- You can also do this using 'sized'.+getSize :: Gen Int+getSize = sized pure++-- | Overrides the size parameter. Returns a generator which uses+-- the given size instead of the runtime-size parameter.+resize :: Int -> Gen a -> Gen a+resize n _ | n < 0 = error "Test.QuickCheck.resize: negative size"+resize n (MkGen g) = MkGen (\r _ -> g r n)++-- | Adjust the size parameter, by transforming it with the given+-- function.+scale :: (Int -> Int) -> Gen a -> Gen a+scale f g = sized (\n -> resize (f n) g)++-- | Generates a random element in the given inclusive range.+choose :: Random a => (a,a) -> Gen a+choose rng = MkGen (\r _ -> let (x,_) = randomR rng r in x)++-- | Generates a random element over the natural range of `a`.+chooseAny :: Random a => Gen a+chooseAny = MkGen (\r _ -> let (x,_) = random r in x)++-- | Run a generator. The size passed to the generator is always 30;+-- if you want another size then you should explicitly use 'resize'.+generate :: Gen a -> IO a+generate (MkGen g) =+  do r <- newSVGen+     return (g r 30)++-- | Generates some example values.+sample' :: Gen a -> IO [a]+sample' g =+  generate (sequence [ resize n g | n <- [0,2..20] ])++-- | Generates some example values and prints them to 'stdout'.+sample :: Show a => Gen a -> IO ()+sample g =+  do cases <- sample' g+     mapM_ print cases++--------------------------------------------------------------------------+-- ** Common generator combinators++-- | Generates a value that satisfies a predicate.+suchThat :: Gen a -> (a -> Bool) -> Gen a+gen `suchThat` p =+  do mx <- gen `suchThatMaybe` p+     case mx of+       Just x  -> return x+       Nothing -> sized (\n -> resize (n+1) (gen `suchThat` p))++-- | Generates a value for which the given function returns a 'Just', and then+-- applies the function.+suchThatMap :: Gen a -> (a -> Maybe b) -> Gen b+gen `suchThatMap` f =+  fmap fromJust $ fmap f gen `suchThat` isJust++-- | Tries to generate a value that satisfies a predicate.+-- If it fails to do so after enough attempts, returns @Nothing@.+suchThatMaybe :: Gen a -> (a -> Bool) -> Gen (Maybe a)+gen `suchThatMaybe` p = sized (try 0 . max 1)+ where+  try _ 0 = return Nothing+  try k n = do x <- resize (2*k+n) gen+               if p x then return (Just x) else try (k+1) (n-1)++-- | Randomly uses one of the given generators. The input list+-- must be non-empty.+oneof :: [Gen a] -> Gen a+oneof [] = error "QuickCheck.oneof used with empty list"+oneof gs = choose (0,length gs - 1) >>= (gs !!)++-- | Chooses one of the given generators, with a weighted random distribution.+-- The input list must be non-empty.+frequency :: [(Int, Gen a)] -> Gen a+frequency [] = error "QuickCheck.frequency used with empty list"+frequency xs0 = choose (1, tot) >>= (`pick` xs0)+ where+  tot = sum (map fst xs0)++  pick n ((k,x):xs)+    | n <= k    = x+    | otherwise = pick (n-k) xs+  pick _ _  = error "QuickCheck.pick used with empty list"++-- | Generates one of the given values. The input list must be non-empty.+elements :: [a] -> Gen a+elements [] = error "QuickCheck.elements used with empty list"+elements xs = (xs !!) `fmap` choose (0, length xs - 1)++-- | Generates a random subsequence of the given list.+sublistOf :: [a] -> Gen [a]+sublistOf xs = filterM (\_ -> choose (False, True)) xs++-- | Generates a random permutation of the given list.+shuffle :: [a] -> Gen [a]+shuffle xs = do+  ns <- vectorOf (length xs) (choose (minBound :: Int, maxBound))+  return (map snd (sortBy (comparing fst) (zip ns xs)))++-- | Takes a list of elements of increasing size, and chooses+-- among an initial segment of the list. The size of this initial+-- segment increases with the size parameter.+-- The input list must be non-empty.+growingElements :: [a] -> Gen a+growingElements [] = error "QuickCheck.growingElements used with empty list"+growingElements xs = sized $ \n -> elements (take (1 `max` size n) xs)+  where+   k        = length xs+   mx       = 100+   log'     = round . log . toDouble+   size n   = (log' n + 1) * k `div` log' mx+   toDouble = fromIntegral :: Int -> Double++{- WAS:+growingElements xs = sized $ \n -> elements (take (1 `max` (n * k `div` 100)) xs)+ where+  k = length xs+-}++-- | Generates a list of random length. The maximum length depends on the+-- size parameter.+listOf :: Gen a -> Gen [a]+listOf gen = sized $ \n ->+  do k <- choose (0,n)+     vectorOf k gen++-- | Generates a non-empty list of random length. The maximum length+-- depends on the size parameter.+listOf1 :: Gen a -> Gen [a]+listOf1 gen = sized $ \n ->+  do k <- choose (1,1 `max` n)+     vectorOf k gen++-- | Generates a list of the given length.+vectorOf :: Int -> Gen a -> Gen [a]+vectorOf = replicateM++-- | Generates an infinite list.+infiniteListOf :: Gen a -> Gen [a]+infiniteListOf gen = sequence (repeat gen)++--------------------------------------------------------------------------+-- the end.
+ src/Savage/Randy.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE CPP #-}++module Savage.Randy where++import System.Random+import System.Random.TF+import System.Random.TF.Gen (splitn)+import Data.Word+import Data.Bits++#define TheGen TFGen++newTheGen :: IO TFGen+newTheGen = newTFGen++bits, mask, doneBit :: Integral a => a+bits = 14+mask = 0x3fff+doneBit = 0x4000++chip :: Bool -> Word32 -> TFGen -> TFGen+chip done n g = splitn g (bits+1) (if done then m .|. doneBit else m)+  where+    m = n .&. mask++chop :: Integer -> Integer+chop n = n `shiftR` bits++stop :: Integral a => a -> Bool+stop n = n <= mask++mkTheGen :: Int -> TFGen+mkTheGen = mkTFGen++-- | The "standard" QuickCheck random number generator.+-- A wrapper around either 'TFGen' on GHC, or 'StdGen'+-- on other Haskell systems.+newtype SVGen = SVGen TheGen++instance Show SVGen where+  showsPrec n (SVGen g) s = showsPrec n g "" ++ s+instance Read SVGen where+  readsPrec n xs = [(SVGen g, ys) | (g, ys) <- readsPrec n xs]++instance RandomGen SVGen where+  split (SVGen g) =+    case split g of+      (g1, g2) -> (SVGen g1, SVGen g2)+  genRange (SVGen g) = genRange g+  next (SVGen g) =+    case next g of+      (x, g') -> (x, SVGen g')++newSVGen :: IO SVGen+newSVGen = fmap SVGen newTheGen++mkSVGen :: Int -> SVGen+mkSVGen n = SVGen (mkTheGen n)++bigNatVariant :: Integer -> TheGen -> TheGen+bigNatVariant n g+  | g `seq` stop n = chip True (fromInteger n) g+  | otherwise      = (bigNatVariant $! chop n) $! chip False (fromInteger n) g++{-# INLINE natVariant #-}+natVariant :: Integral a => a -> TheGen -> TheGen+natVariant n g+  | g `seq` stop n = chip True (fromIntegral n) g+  | otherwise      = bigNatVariant (toInteger n) g++{-# INLINE variantTheGen #-}+variantTheGen :: Integral a => a -> TheGen -> TheGen+variantTheGen n g+  | n >= 1    = natVariant (n-1) (boolVariant False g)+  | n == 0   = natVariant (0 `asTypeOf` n) (boolVariant True g)+  | otherwise = bigNatVariant (negate (toInteger n)) (boolVariant True g)++boolVariant :: Bool -> TheGen -> TheGen+boolVariant False = fst . split+boolVariant True = snd . split++variantSVGen :: Integral a => a -> SVGen -> SVGen+variantSVGen n (SVGen g) = SVGen (variantTheGen n g)