quickcheck-transformer (empty) → 0.3

raw patch · 4 files changed

+249/−0 lines, 4 filesdep +QuickCheckdep +basedep +randomsetup-changed

Dependencies added: QuickCheck, base, random, transformers

Files

• LICENSE +23/−0
• Setup.lhs +3/−0
• quickcheck-transformer.cabal +39/−0
• src/Test/QuickCheck/GenT.hs +184/−0

@@ -0,0 +1,23 @@+Copyright (c) 2019, Henning Thielemann+Copyright (c) 2013, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,39 @@+Name:          quickcheck-transformer+Version:       0.3+Synopsis:      A GenT monad transformer for QuickCheck library.+Description:+  A fork of QuickCheck-GenT that works for older GHC versions+  and uses the Test module folder like QuickCheck.+License:       MIT+License-File:  LICENSE+Homepage:      http://hub.darcs.net/thielema/quickcheck-transformer/+Author:        Nikita Volkov <nikita.y.volkov@mail.ru>+Maintainer:    Henning Thielemann <haskell@henning-thielemann.de>+Copyright:+  (c) 2019, Henning Thielemann+  (c) 2013, Nikita Volkov+Category:      Testing+Build-Type:    Simple+Cabal-Version: >=1.10+++Source-Repository this+  Tag:         0.3+  Type:        darcs+  Location:    http://hub.darcs.net/thielema/quickcheck-transformer/++Source-Repository head+  Type:        darcs+  Location:    http://hub.darcs.net/thielema/quickcheck-transformer/+++Library+  Hs-Source-Dirs: src+  Exposed-Modules:+    Test.QuickCheck.GenT+  Build-Depends:+    QuickCheck >=2.7 && <3,+    random >=1.0 && <1.2,+    transformers >=0.5 && <0.6,+    base >=4.3 && <5+  Default-Language: Haskell2010

@@ -0,0 +1,184 @@+-- |+-- Most of the code is borrowed from+-- <http://haskell.1045720.n5.nabble.com/darcs-patch-GenT-monad-transformer-variant-of-Gen-QuickCheck-2-td3172136.html a mailing list discussion>.+-- Therefor, credits go to Paul Johnson and Felix Martini.+module Test.QuickCheck.GenT where++import qualified Test.QuickCheck.Gen as QC+import qualified Test.QuickCheck.Random as QC+import qualified System.Random as Random++import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad (ap)+import Control.Applicative (Applicative, pure, (<*>), (<$>))++import Data.Maybe (fromMaybe)+++newtype GenT m a = GenT { unGenT :: QC.QCGen -> Int -> m a }++instance (Functor m) => Functor (GenT m) where+  fmap f m = GenT $ \r n -> fmap f $ unGenT m r n++instance (Monad m) => Monad (GenT m) where+  return a = GenT (\_ _ -> return a)+  m >>= k = GenT $ \r n -> do+    let (r1, r2) = Random.split r+    a <- unGenT m r1 n+    unGenT (k a) r2 n+  fail msg = GenT (\_ _ -> fail msg)++instance (Functor m, Monad m) => Applicative (GenT m) where+  pure = return+  (<*>) = ap++instance MonadTrans GenT where+  lift m = GenT (\_ _ -> m)++instance (MonadIO m) => MonadIO (GenT m) where+  liftIO = lift . liftIO++runGenT :: GenT m a -> QC.Gen (m a)+runGenT (GenT run) = QC.MkGen run++class (Applicative g, Monad g) => MonadGen g where+  liftGen :: QC.Gen a -> g a+  variant :: Integral n => n -> g a -> g a+  sized :: (Int -> g a) -> g a+  resize :: Int -> g a -> g a+  choose :: Random.Random a => (a, a) -> g a++instance (Applicative m, Monad m) => MonadGen (GenT m) where+  liftGen gen = GenT $ \r n -> return $ QC.unGen gen r n+  choose rng = GenT $ \r _ -> return $ fst $ Random.randomR rng r+  variant k (GenT g) = GenT $ \r n -> g (var k r) n+  sized f = GenT $ \r n -> let GenT g = f n in g r n+  resize n (GenT g) = GenT $ \r _ -> g r n++instance MonadGen QC.Gen where+  liftGen = id+  variant k (QC.MkGen g) = QC.MkGen $ \r n -> g (var k r) n+  sized f = QC.MkGen $ \r n -> let QC.MkGen g = f n in g r n+  resize n (QC.MkGen g) = QC.MkGen $ \r _ -> g r n+  choose range = QC.MkGen $ \r _ -> fst $ Random.randomR range r++-- |+-- Private variant-generating function.  Converts an integer into a chain+-- of (fst . split) and (snd . split) applications.  Every integer (including+-- negative ones) will give rise to a different random number generator in+-- log2 n steps.+var :: Integral n => n -> QC.QCGen -> QC.QCGen+var k =+  (if k == k' then id else var k') . (if even k then fst else snd) . Random.split+  where k' = k `div` 2+++--------------------------------------------------------------------------+-- ** Common generator combinators++-- | Generates a value that satisfies a predicate.+suchThat :: MonadGen m => m a -> (a -> Bool) -> m 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))++-- | Tries to generate a value that satisfies a predicate.+suchThatMaybe :: MonadGen m => m a -> (a -> Bool) -> m (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)++-- | Generates a list of random length. The maximum length depends on the+-- size parameter.+listOf :: MonadGen m => m a -> m [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 :: MonadGen m => m a -> m [a]+listOf1 gen = sized $ \n ->+  do k <- choose (1,1 `max` n)+     vectorOf k gen++-- | Generates a list of the given length.+vectorOf :: MonadGen m => Int -> m a -> m [a]+vectorOf k gen = sequence [ gen | _ <- [1..k] ]+++-- * Partial functions+-------------------------++-- | Randomly uses one of the given generators. The input list+-- must be non-empty.+oneof :: MonadGen m => [m a] -> m a+oneof =+  fmap (fromMaybe (error "QuickCheck.GenT.oneof used with empty list")) .+  oneofMay++-- | Chooses one of the given generators, with a weighted random distribution.+-- The input list must be non-empty.+frequency :: MonadGen m => [(Int, m a)] -> m a+frequency [] = error "QuickCheck.GenT.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.GenT.pick used with empty list"++-- | Generates one of the given values. The input list must be non-empty.+elements :: MonadGen m => [a] -> m a+elements =+  fmap (fromMaybe (error "QuickCheck.GenT.elements used with empty list")) .+  elementsMay++-- | 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 :: MonadGen m => [a] -> m a+growingElements =+  fmap (fromMaybe (error "QuickCheck.GenT.growingElements used with empty list")) .+  growingElementsMay+++-- * Non-partial functions resulting in Maybe+-------------------------++-- |+-- Randomly uses one of the given generators.+oneofMay :: MonadGen m => [m a] -> m (Maybe a)+oneofMay as =+ case as of+  [] -> return Nothing+  l -> fmap Just $ choose (0, length l - 1) >>= (l !!)++-- | Generates one of the given values.+elementsMay :: MonadGen m => [a] -> m (Maybe a)+elementsMay as =+ case as of+  [] -> return Nothing+  l -> Just . (l !!) <$> choose (0, length l - 1)++-- | 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.+growingElementsMay :: MonadGen m => [a] -> m (Maybe a)+growingElementsMay as =+ case as of+  [] -> return Nothing+  xs -> fmap Just $ sized $ \n -> elements (take (1 `max` size n) xs)+    where+      k = length xs+      mx = 100+      log' = round . log . fromIntegral+      size n = (log' n + 1) * k `div` log' mx