foundation 0.0.5 → 0.0.6

raw patch · 8 files changed

+130/−23 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Foundation/Check.hs +7/−1
• Foundation/Check/Arbitrary.hs +101/−18
• Foundation/Check/Gen.hs +7/−1
• Foundation/Collection.hs +1/−0
• Foundation/Collection/Collection.hs +4/−0
• Foundation/Primitive/IntegralConv.hs +4/−0
• Foundation/System/Bindings/Linux.hsc +5/−2
• foundation.cabal +1/−1

@@ -6,6 +6,9 @@ module Foundation.Check     ( Gen     , Arbitrary(..)+    , oneof+    , elements+    , frequency     -- test     , Test(..)     , testName@@ -95,7 +98,10 @@     propertyToResult True  = PropertySuccess      !rngIt  = genRng (contextSeed ctx) (s : contextGroups ctx)-    !params = GenParams {}+    !params = GenParams { genMaxSizeIntegral = 32   -- 256 bits maximum numbers+                        , genMaxSizeArray    = 512  -- 512 elements+                        , genMaxSizeString   = 8192 -- 8K string+                        }  -- | Run tests defaultMain :: Test -> IO ()

@@ -1,48 +1,72 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE FlexibleInstances #-} module Foundation.Check.Arbitrary     ( Arbitrary(..)+    , frequency+    , oneof+    , elements+    , between     ) where  import           Foundation.Internal.Base import           Foundation.Internal.Natural+import           Foundation.Primitive+import           Foundation.Primitive.IntegralConv (wordToChar) import           Foundation.Check.Gen import           Foundation.Random+import           Foundation.Bits+import           Foundation.Collection+import           Foundation.Array+import           Foundation.Numerical+import           Foundation.String+import           Control.Monad (replicateM)  -- | How to generate an arbitrary value for 'a' class Arbitrary a where     arbitrary :: Gen a -arbitraryBounded :: Bounded b => Gen b-arbitraryBounded = undefined--instance Arbitrary Int where-    arbitrary = genWithRng getRandomPrimType instance Arbitrary Integer where-    arbitrary = undefined+    arbitrary = arbitraryInteger instance Arbitrary Natural where-    arbitrary = undefined+    arbitrary = arbitraryNatural++-- prim types+instance Arbitrary Int where+    arbitrary = arbitraryPrimtype+instance Arbitrary Word where+    arbitrary = arbitraryPrimtype instance Arbitrary Word64 where-    arbitrary = genWithRng getRandomPrimType+    arbitrary = arbitraryPrimtype instance Arbitrary Word32 where-    arbitrary = genWithRng getRandomPrimType+    arbitrary = arbitraryPrimtype instance Arbitrary Word16 where-    arbitrary = genWithRng getRandomPrimType+    arbitrary = arbitraryPrimtype instance Arbitrary Word8 where-    arbitrary = genWithRng getRandomPrimType+    arbitrary = arbitraryPrimtype instance Arbitrary Int64 where-    arbitrary = genWithRng getRandomPrimType+    arbitrary = arbitraryPrimtype instance Arbitrary Int32 where-    arbitrary = genWithRng getRandomPrimType+    arbitrary = arbitraryPrimtype instance Arbitrary Int16 where-    arbitrary = genWithRng getRandomPrimType+    arbitrary = arbitraryPrimtype instance Arbitrary Int8 where-    arbitrary = genWithRng getRandomPrimType+    arbitrary = arbitraryPrimtype instance Arbitrary Char where-    arbitrary = genWithRng getRandomPrimType+    arbitrary = arbitraryChar+ instance Arbitrary Bool where-    arbitrary = undefined -- arbitrary+    arbitrary = flip testBit 0 <$> (arbitraryPrimtype :: Gen Word) ---instance Arbitrary a => Arbitrary (Maybe a) where+instance Arbitrary String where+    arbitrary = genWithParams $ \params ->+        fromList <$> (genMax (genMaxSizeString params) >>= \i -> replicateM (integralCast i) arbitrary) +instance Arbitrary a => Arbitrary (Maybe a) where+    arbitrary = frequency $ nonEmpty_ [ (1, pure Nothing), (4, Just <$> arbitrary) ]++instance (Arbitrary l, Arbitrary r) => Arbitrary (Either l r) where+    arbitrary = oneof $ nonEmpty_ [ Left <$> arbitrary, Right <$> arbitrary ]+ instance (Arbitrary a, Arbitrary b)     => Arbitrary (a,b) where     arbitrary = (,) <$> arbitrary <*> arbitrary@@ -58,3 +82,62 @@ instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e, Arbitrary f)     => Arbitrary (a,b,c,d,e,f) where     arbitrary = (,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++arbitraryInteger :: Gen Integer+arbitraryInteger =+    -- TODO use the sized parameter+    frequency $ nonEmpty_+        [ (4, integerOfSize True 2)+        , (4, integerOfSize False 2)+        , (4, integerOfSize True 4)+        , (4, integerOfSize False 4)+        , (2, integerOfSize True 8)+        , (2, integerOfSize False 8)+        , (1, integerOfSize True 16)+        , (1, integerOfSize False 16)+        ]+  where+    integerOfSize :: Bool -> Word -> Gen Integer+    integerOfSize toSign n = ((if toSign then (\x -> 0 - x) else id) . foldl (\x y -> x + integralUpsize y) 0 . toList)+                         <$> (arbitraryUArrayOf n :: Gen (UArray Word8))++arbitraryNatural :: Gen Natural+arbitraryNatural = integralDownsize . abs <$> arbitraryInteger++arbitraryChar :: Gen Char+arbitraryChar = frequency $ nonEmpty_+    [ (6, wordToChar <$> genMax 128)+    , (1, wordToChar <$> genMax 0x10ffff)+    ]++arbitraryPrimtype :: PrimType ty => Gen ty+arbitraryPrimtype = genWithRng getRandomPrimType++arbitraryUArrayOf :: PrimType ty => Word -> Gen (UArray ty)+arbitraryUArrayOf size =+    between (0, size) >>= \sz -> (fromList <$> replicateM (integralCast sz) arbitraryPrimtype)++-- | Call one of the generator weighted+frequency :: NonEmpty [(Word, Gen a)] -> Gen a+frequency (getNonEmpty -> l) = between (0, sum) >>= pickOne l+  where+    sum :: Word+    !sum = foldl' (+) 0 $ fmap fst l++    pickOne ((k,x):xs) n+        | n <= k    = x+        | otherwise = pickOne xs (n-k)+    pickOne _ _ = internalError "frequency"++oneof :: NonEmpty [Gen a] -> Gen a+oneof ne = frequency (nonEmptyFmap (\x -> (1, x)) ne)++elements :: NonEmpty [a] -> Gen a+elements l = frequency (nonEmptyFmap (\x -> (1, pure x)) l)++between :: (Word, Word) -> Gen Word+between (x,y) = (+) x <$> genMax range+  where range = y - x++genMax :: Word -> Gen Word+genMax m = (flip mod m) <$> arbitraryPrimtype

@@ -8,6 +8,7 @@     , GenParams(..)     , genRng     , genWithRng+    , genWithParams     ) where  import           Foundation.Internal.Base@@ -20,7 +21,9 @@ import qualified Foundation.Array.Unboxed as A  data GenParams = GenParams-    {+    { genMaxSizeIntegral :: Word -- maximum number of bytes+    , genMaxSizeArray    :: Word -- number of elements, as placeholder+    , genMaxSizeString   :: Word -- maximum number of chars     }  newtype GenRng = GenRng RNGv1@@ -71,3 +74,6 @@ genWithRng :: forall a . (forall randomly . MonadRandom randomly => randomly a) -> Gen a genWithRng f = Gen $ \(GenRng rng) _ ->     let (a, _) = withRandomGenerator rng f in a++genWithParams :: (GenParams -> Gen a) -> Gen a+genWithParams f = Gen $ \rng params -> runGen (f params) rng params

@@ -25,6 +25,7 @@     , getNonEmpty     , nonEmpty     , nonEmpty_+    , nonEmptyFmap     , Sequential(..)     , MutableCollection(..)     , IndexedCollection(..)

@@ -25,6 +25,7 @@     , getNonEmpty     , nonEmpty     , nonEmpty_+    , nonEmptyFmap     ) where  import           Foundation.Internal.Base@@ -62,6 +63,9 @@     type Item (NonEmpty c) = Item c     toList   = toList . getNonEmpty     fromList = nonEmpty_ . fromList++nonEmptyFmap :: Functor f => (a -> b) -> NonEmpty (f a) -> NonEmpty (f b)+nonEmptyFmap f (NonEmpty l) = NonEmpty (fmap f l)  -- | A set of methods for ordered colection class (IsList c, Item c ~ Element c) => Collection c where

@@ -12,6 +12,7 @@     , wordToWord64     , word64ToWord32s     , word64ToWord+    , wordToChar     ) where  #include "MachDeps.h"@@ -258,3 +259,6 @@ word64ToWord32s :: Word64 -> (# Word32, Word32 #) word64ToWord32s (W64# w) = (# W32# (word64ToWord# (uncheckedShiftRL64# w 32#)), W32# (word64ToWord# w) #) #endif++wordToChar :: Word -> Char+wordToChar (W# w) = C# (chr# (word2Int# w))

@@ -69,16 +69,19 @@ -- extra mask at add_watch time sysLinux_IN_OPEN     , sysLinux_IN_DONT_FOLLOW-    , sysLinux_IN_EXCL_UNLINK     , sysLinux_IN_MASK_ADD     , sysLinux_IN_ONESHOT     , sysLinux_IN_ONLYDIR :: CInotifyMask sysLinux_IN_OPEN = (#const IN_OPEN) sysLinux_IN_DONT_FOLLOW = (#const IN_DONT_FOLLOW)-sysLinux_IN_EXCL_UNLINK = (#const IN_EXCL_UNLINK) sysLinux_IN_MASK_ADD = (#const IN_MASK_ADD) sysLinux_IN_ONESHOT = (#const IN_ONESHOT) sysLinux_IN_ONLYDIR = (#const IN_ONLYDIR)++#ifdef IN_EXCL_UNLINK+sysLinux_IN_EXCL_UNLINK :: CInotifyMask+sysLinux_IN_EXCL_UNLINK = (#const IN_EXCL_UNLINK)+#endif  -- only found in mask sysLinux_IN_IGNORED

@@ -1,5 +1,5 @@ Name:                foundation-Version:             0.0.5+Version:             0.0.6 Synopsis:            Alternative prelude with batteries and no dependencies Description:     A custom prelude with no dependencies apart from base.