diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2012, Antoine Latter + +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 Antoine Latter 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-instances.cabal b/quickcheck-instances.cabal new file mode 100644 --- /dev/null +++ b/quickcheck-instances.cabal @@ -0,0 +1,51 @@ +Name: quickcheck-instances +Version: 0.1.0 +Synopsis: Common quickcheck instances +Description: QuickCheck instances. + . + The goal is to supply QuickCheck instances for + types provided by the Haskell Platform. + . + Since all of these instances are provided as + orphans, I recommend that you do not use this library + within another library module, so that you don't + impose these instances on down-stream consumers of + your code. + . + For information on writing a test-suite with Cabal + see + +License: BSD3 +License-file: LICENSE +Author: Antoine Latter +Maintainer: aslatter@gmail.com +Homepage: https://github.com/aslatter/qc-instances +Bug-reports: https://github.com/aslatter/qc-instances/issues +Copyright: Copyright Antoine Latter, 2012 +Category: Testing +Build-type: Simple +-- Extra-source-files: +Cabal-version: >=1.6 + +Source-repository head + type: git + location: https://github.com/aslatter/qc-instances.git + +Library + -- Modules exported by the library. + Exposed-modules: Test.QuickCheck.Instances + Hs-Source-Dirs: src + Build-depends: base < 5, + + array >= 0.3 && < 0.5, + bytestring == 0.9.*, + containers >= 0.3 && < 0.5, + old-time >= 1.0 && < 1.2, + QuickCheck >= 2.1 && < 2.5, + text >= 0.7 && < 0.12, + time >= 1.1 && < 1.5 + + Ghc-options: -Wall + -- Other-modules: + -- Build-tools: + diff --git a/src/Test/QuickCheck/Instances.hs b/src/Test/QuickCheck/Instances.hs new file mode 100644 --- /dev/null +++ b/src/Test/QuickCheck/Instances.hs @@ -0,0 +1,217 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Instances are provided for the types in the packages: + + * array - We only provide instances for arrays inexed by + Integral types. + + * bytestring + + * text + + * containers + + * old-time + + * time + +Since all of these instances are provided as orphans, I recommend that +you do not use this library within another library module, so that you +don't impose these instances on down-stream consumers of your code. + +For information on writing a test-suite with Cabal see + +-} +module Test.QuickCheck.Instances () where + +import Control.Applicative +import Data.Foldable (toList) +import Data.Int (Int32) +import Test.QuickCheck + +import qualified Data.Array.IArray as Array +import qualified Data.Array.Unboxed as Array +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Fixed as Fixed +import qualified Data.IntMap as IntMap +import qualified Data.IntSet as IntSet +import qualified Data.Map as Map +import qualified Data.Sequence as Seq +import qualified Data.Set as Set +import qualified Data.Text as TS +import qualified Data.Text.Lazy as TL +import qualified Data.Time as Time +import qualified Data.Time.Clock.TAI as Time +import qualified Data.Tree as Tree +import qualified System.Time as OldTime + +-- Array + +instance (Array.Ix i, Integral i, Arbitrary e) => Arbitrary (Array.Array i e) where + arbitrary = arbitraryArray + +instance (Array.IArray Array.UArray e, Array.Ix i, Integral i, Arbitrary e) + => Arbitrary (Array.UArray i e) where + arbitrary = arbitraryArray + +arbitraryArray :: (Array.IArray a e, Array.Ix i, Integral i, Arbitrary e) => Gen (a i e) +arbitraryArray = do + b1 <- arbitrarySizedIntegral + b2 <- arbitrarySizedIntegral + let bounds = + if b1 < b2 then (b1,b2) else (b2,b1) + elms <- vector (Array.rangeSize bounds) + return $ Array.listArray bounds elms + +-- ByteString +instance Arbitrary BS.ByteString where + arbitrary = BS.pack <$> arbitrary + shrink xs = BS.pack <$> shrink (BS.unpack xs) + +instance Arbitrary BL.ByteString where + arbitrary = BL.pack <$> arbitrary + shrink xs = BL.pack <$> shrink (BL.unpack xs) + +-- Text +instance Arbitrary TS.Text where + arbitrary = TS.pack <$> arbitrary + shrink xs = TS.pack <$> shrink (TS.unpack xs) + +instance Arbitrary TL.Text where + arbitrary = TL.pack <$> arbitrary + shrink xs = TL.pack <$> shrink (TL.unpack xs) + +-- Containers + +instance Arbitrary a => Arbitrary (IntMap.IntMap a) where + arbitrary = IntMap.fromList <$> arbitrary + shrink m = IntMap.fromList <$> shrink (IntMap.toList m) + +instance Arbitrary IntSet.IntSet where + arbitrary = IntSet.fromList <$> arbitrary + shrink set = IntSet.fromList <$> shrink (IntSet.toList set) + +instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where + arbitrary = Map.fromList <$> arbitrary + shrink m = Map.fromList <$> shrink (Map.toList m) + +instance Arbitrary a => Arbitrary (Seq.Seq a) where + arbitrary = Seq.fromList <$> arbitrary + shrink xs = Seq.fromList <$> shrink (toList xs) + +instance (Ord a, Arbitrary a) => Arbitrary (Set.Set a) where + arbitrary = Set.fromList <$> arbitrary + shrink set = Set.fromList <$> shrink (Set.toList set) + +instance Arbitrary a => Arbitrary (Tree.Tree a) where + arbitrary = sized $ \n -> + do val <- arbitrary + let n' = n `div` 2 + nodes <- + if n' > 0 + then do + k <- choose (0,n') + resize n' $ sequence [ arbitrary | _ <- [1..k] ] + else return [] + return $ Tree.Node val nodes + shrink (Tree.Node val forest) = + Tree.Node <$> shrink val <*> shrink forest + +-- old-time + +instance Arbitrary OldTime.Month where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary OldTime.Day where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary OldTime.ClockTime where + arbitrary = + OldTime.TOD <$> choose (0, fromIntegral (maxBound :: Int32)) + <*> choose (0, 1000000000000 - 1) + +instance Arbitrary OldTime.TimeDiff where + -- a bit of a cheat ... + arbitrary = + OldTime.normalizeTimeDiff <$> + (OldTime.diffClockTimes <$> arbitrary <*> arbitrary) + +-- UTC only +instance Arbitrary OldTime.CalendarTime where + arbitrary = OldTime.toUTCTime <$> arbitrary + +-- time + +instance Arbitrary Time.Day where + arbitrary = + Time.ModifiedJulianDay + <$> choose (gregToNum 1200 1 1, gregToNum 2999 1 1) + +instance Arbitrary Time.UniversalTime where + arbitrary = + Time.ModJulianDate + <$> toRational `fmap` choose (gregToNum 1200 1 1 :: Double, gregToNum 2999 1 1) + +instance Arbitrary Time.DiffTime where + arbitrary = arbitrarySizedFractional + +instance Arbitrary Time.UTCTime where + arbitrary = Time.UTCTime <$> arbitrary <*> (fromRational . toRational <$> choose (0::Double, 86400)) + +instance Arbitrary Time.NominalDiffTime where + arbitrary = arbitrarySizedFractional + +instance Arbitrary Time.TimeZone where + arbitrary = + Time.TimeZone + <$> choose (-12*60*60,12*60*60) -- utc offset (s) + <*> arbitrary -- is summer time + <*> (sequence . replicate 4 $ choose ('A','Z')) + +instance Arbitrary Time.TimeOfDay where + arbitrary = + Time.TimeOfDay + <$> choose (0, 23) -- hour + <*> choose (0, 59) -- minute + <*> (fromRational . toRational <$> choose (0::Double, 60)) -- picoseconds, via double + +instance Arbitrary Time.LocalTime where + arbitrary = + Time.LocalTime + <$> arbitrary + <*> arbitrary + +instance Arbitrary Time.ZonedTime where + arbitrary = + Time.ZonedTime + <$> arbitrary + <*> arbitrary + +instance Arbitrary Time.AbsoluteTime where + arbitrary = + Time.addAbsoluteTime + <$> arbitrary + <*> return Time.taiEpoch + +-- | Given a year, month, and day return a number suitable for +-- use as a Day or UniversalTime +gregToNum :: Num a => Integer -> Int -> Int -> a +gregToNum year month day = + fromInteger . Time.toModifiedJulianDay $ Time.fromGregorian year month day + +-- WARNING: from base, should be moved to QC library +instance Arbitrary Ordering where + arbitrary = arbitraryBoundedEnum + +instance Fixed.HasResolution a => Arbitrary (Fixed.Fixed a) where + arbitrary = arbitrarySizedFractional + +-- WARNING: should be moved to QC library +arbitraryBoundedEnum :: (Bounded a, Enum a) => Gen a +arbitraryBoundedEnum = + do let mn = minBound + mx = maxBound `asTypeOf` mn + n <- choose (fromEnum mn, fromEnum mx) + return (toEnum n `asTypeOf` mn)