diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Athan Clark + +All rights reserved. + +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 name of Athan Clark nor the names of other + 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/quickcheck-combinators.cabal b/quickcheck-combinators.cabal new file mode 100644 --- /dev/null +++ b/quickcheck-combinators.cabal @@ -0,0 +1,42 @@ +Name: quickcheck-combinators +Version: 0.0.0 +Author: Athan Clark +Maintainer: Athan Clark +License: BSD3 +License-File: LICENSE +Synopsis: Simple type-level combinators for augmenting + QuickCheck instances. +Category: Testing +Description: + Simply wrap the type you want to generate (assuming it satisfies + all the necessary constraints) to refine the terms generated: + . + @ + {-# LANGUAGE DataKinds #-} + + import Data.Set (Set) + import Test.QuickCheck + import Test.QuickCheck.Instances + import GHC.TypeLits + + instance Arbitrary LinearEquation where + arbitrary = do + vars <- arbitrary :: Gen (AtLeast 3 Set String) + -- ... + @ + . +Cabal-Version: >= 1.10 +Build-Type: Simple + +Library + Default-Language: Haskell2010 + HS-Source-Dirs: src + GHC-Options: -Wall + Exposed-Modules: Test.QuickCheck.Combinators + Build-Depends: base >= 4.8 && < 5 + , QuickCheck + , unfoldable-restricted >= 0.0.1 + +Source-Repository head + Type: git + Location: git@github.com:athanclark/quickcheck-combinators.git diff --git a/src/Test/QuickCheck/Combinators.hs b/src/Test/QuickCheck/Combinators.hs new file mode 100644 --- /dev/null +++ b/src/Test/QuickCheck/Combinators.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE + DataKinds + , ScopedTypeVariables + , FlexibleContexts + , KindSignatures + , GeneralizedNewtypeDeriving + , ConstraintKinds + , UndecidableInstances + #-} + +module Test.QuickCheck.Combinators where + +import GHC.TypeLits +import Data.Proxy + +import Data.Maybe (fromMaybe) +import Data.Unfoldable.Restricted (UnfoldableR, fromList) +import Control.Monad (replicateM) + +import Test.QuickCheck + + + +-- | Generate with a minimum, inclusive size as @n :: Nat@ +newtype AtLeast (n :: Nat) t a = AtLeast (t a) + deriving (Show, Read, Eq, Ord, Enum) + +instance ( UnfoldableR p t + , Monoid (t a) + , Arbitrary a + , Arbitrary (t a) + , KnownNat n + , p a + ) => Arbitrary (AtLeast (n :: Nat) t a) where + arbitrary = sized $ \m' -> do + let n' = fromIntegral $ natVal (Proxy :: Proxy n) + k <- choose (n', m') + (ts :: t x) <- (fromMaybe mempty . fromList) <$> replicateM k arbitrary + return (AtLeast ts) + +-- | Generate with a maximum, inclusive size as @n :: Nat@ +newtype AtMost (n :: Nat) t a = AtMost (t a) + deriving (Show, Read, Eq, Ord, Enum) + +instance ( UnfoldableR p t + , Monoid (t a) + , Arbitrary a + , Arbitrary (t a) + , KnownNat m + , p a + ) => Arbitrary (AtMost (m :: Nat) t a) where + arbitrary = sized $ \m'' -> do + let m' = fromIntegral $ natVal (Proxy :: Proxy m) + k <- choose (0, min m' m'') + (ts :: t x) <- (fromMaybe mempty . fromList) <$> replicateM k arbitrary + return (AtMost ts) + +-- | Generate between the inclusive range of @n :: Nat@ and @m :: Nat@ +newtype Between (n :: Nat) (m :: Nat) t a = Between (t a) + deriving (Show, Read, Eq, Ord, Enum) + +instance ( UnfoldableR p t + , Monoid (t a) + , Arbitrary a + , Arbitrary (t a) + , KnownNat n + , KnownNat m + , p a + ) => Arbitrary (Between (n :: Nat) (m :: Nat) t a) where + arbitrary = sized $ \m'' -> do + let n' = fromIntegral $ natVal (Proxy :: Proxy n) + m' = fromIntegral $ natVal (Proxy :: Proxy m) + k <- choose (n', min m' m'') + (ts :: t x) <- (fromMaybe mempty . fromList) <$> replicateM k arbitrary + return (Between ts) + +-- | Convenience for @AtLeast 1@ +type NonMempty = AtLeast 1