packages feed

QuickCheck-GenT (empty) → 0.1.0

raw patch · 5 files changed

+303/−0 lines, 5 filesdep +QuickCheckdep +basedep +mtlsetup-changed

Dependencies added: QuickCheck, base, mtl, random

Files

+ LICENSE view
@@ -0,0 +1,22 @@+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.
+ QuickCheck-GenT.cabal view
@@ -0,0 +1,81 @@+name:+  QuickCheck-GenT+version:+  0.1.0+synopsis:+  A GenT monad transformer for QuickCheck library.+description:+license:+  MIT+license-file:+  LICENSE+homepage:+  https://github.com/nikita-volkov/QuickCheck-GenT +bug-reports:+  https://github.com/nikita-volkov/QuickCheck-GenT/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2013, Nikita Volkov+category:+  Database+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/QuickCheck-GenT.git+++library+  hs-source-dirs:+    src+  exposed-modules:+    QuickCheck.GenT+  other-modules:+    QuickCheck.GenT.Prelude+  build-depends:+    QuickCheck,+    random,+    mtl,+    base >= 4.5 && < 5+  default-extensions:+    Arrows+    DeriveGeneric+    ImpredicativeTypes+    BangPatterns+    PatternGuards+    GADTs+    StandaloneDeriving+    MultiParamTypeClasses+    ScopedTypeVariables+    FlexibleInstances+    TypeFamilies+    TypeOperators+    FlexibleContexts+    NoImplicitPrelude+    EmptyDataDecls+    DataKinds+    NoMonomorphismRestriction+    RankNTypes+    ConstraintKinds+    DefaultSignatures+    TupleSections+    OverloadedStrings+    TemplateHaskell+    QuasiQuotes+    DeriveDataTypeable+    GeneralizedNewtypeDeriving+    RecordWildCards+    MultiWayIf+    LiberalTypeSynonyms+    LambdaCase+  default-language:+    Haskell2010
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/QuickCheck/GenT.hs view
@@ -0,0 +1,143 @@+-- |+-- Most of the code is borrowed from the following mailing list discussion:+-- http://haskell.1045720.n5.nabble.com/darcs-patch-GenT-monad-transformer-variant-of-Gen-QuickCheck-2-td3172136.html+-- Therefor, credits go to Paul Johnson and Felix Martini.+module QuickCheck.GenT where++import QuickCheck.GenT.Prelude+import qualified Test.QuickCheck.Gen as QC+import qualified System.Random as Random+++newtype GenT m a = GenT { unGenT :: Random.StdGen -> 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 -> Random.StdGen -> Random.StdGen +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)++-- | Randomly uses one of the given generators. The input list+-- must be non-empty.+oneof :: MonadGen m => [m a] -> m 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 :: MonadGen m => [(Int, m a)] -> m 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 :: MonadGen m => [a] -> m a+elements [] = error "QuickCheck.elements used with empty list"+elements xs = (xs !!) `fmap` choose (0, length xs - 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.+-- The input list must be non-empty.+growingElements :: MonadGen m => [a] -> m 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 . fromIntegral+   size n = (log' n + 1) * k `div` log' mx++-- | 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] ]+
+ src/QuickCheck/GenT/Prelude.hs view
@@ -0,0 +1,55 @@+module QuickCheck.GenT.Prelude +  ( +    module Exports,+    traceM,+  )+  where++-- base+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, FilePath, id, (.))+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Applicative as Exports+import Control.Arrow as Exports hiding (left, right)+import Control.Category as Exports+import Data.Monoid as Exports+import Data.Foldable as Exports+import Data.Traversable as Exports hiding (for)+import Data.Maybe as Exports+import Data.List as Exports hiding (concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Tuple as Exports+import Data.Ord as Exports (Down(..))+import Data.String as Exports+import Data.Int as Exports+import Data.Word as Exports+import Data.Ratio as Exports+import Data.Fixed as Exports+import Data.Ix as Exports+import Data.Data as Exports+import Text.Read as Exports (readMaybe, readEither)+import Control.Exception as Exports hiding (tryJust)+import Control.Concurrent as Exports hiding (yield)+import System.Mem.StableName as Exports+import System.Timeout as Exports+import System.Exit as Exports+import System.IO.Unsafe as Exports+import System.IO as Exports (Handle, hClose)+import System.IO.Error as Exports+import Unsafe.Coerce as Exports+import GHC.Exts as Exports (groupWith, sortWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Debug.Trace as Exports+import Data.IORef as Exports+import Data.STRef as Exports+import Control.Monad.ST as Exports++-- mtl+import Control.Monad.Identity as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.State as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.Reader as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.Writer as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.Trans as Exports+++traceM :: (Monad m) => String -> m ()+traceM s = trace s $ return ()