quickcheck-instances (empty) → 0.1.0

raw patch · 4 files changed

+300/−0 lines, 4 filesdep +QuickCheckdep +arraydep +basesetup-changed

Dependencies added: QuickCheck, array, base, bytestring, containers, old-time, text, time

Files

LICENSE +30/−0
Setup.hs +2/−0
quickcheck-instances.cabal +51/−0
src/Test/QuickCheck/Instances.hs +217/−0

+ LICENSE view

@@ -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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ quickcheck-instances.cabal view

@@ -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 <http://www.haskell.org/cabal/users-guide/#test-suites>++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:         +

+ src/Test/QuickCheck/Instances.hs view

@@ -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+<http://www.haskell.org/cabal/users-guide/#test-suites>+-}+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)