packages feed

unfoldable 0.9.6 → 1.0

raw patch · 7 files changed

+83/−67 lines, 7 filesdep ~QuickCheckdep ~basedep ~random

Dependency ranges changed: QuickCheck, base, random

Files

CHANGELOG.md view
@@ -1,3 +1,10 @@+1.0+---+* improved generic implementation of `unfold`+* improved implementation of `arbitraryDefault`+* lifted `QuickCheck` upper bound to 3.0+* updated to `containers` 0.6+ 0.9.6 ----- * updated to `one-liner` 1.0
examples/btree.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveFoldable #-} import Data.Unfoldable import Data.Unfolder @@ -5,7 +6,7 @@ import System.Random  -data TB a = LB a | BB (TB (a, a)) deriving Show+data TB a = LB a | BB (TB (a, a)) deriving (Show, Foldable)  instance Unfoldable TB where   unfold fa = choose
examples/tree.hs view
@@ -1,14 +1,14 @@-{-# LANGUAGE DeriveFunctor, DeriveGeneric, DeriveAnyClass #-}+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveGeneric, DeriveAnyClass #-}  import GHC.Generics import Data.Unfoldable import Data.Unfolder  import Data.Maybe-import System.Random+import Test.QuickCheck.Gen (sample, resize, Gen)  -data Tree a = Empty | Node (Tree a) a (Tree a) deriving (Show, Generic1, Unfoldable)+data Tree a = Empty | Node (Tree a) a (Tree a) deriving (Show, Generic1, Foldable, Unfoldable)  tree7 :: Tree Int tree7 = fromJust $ fromList [0..6]@@ -19,10 +19,13 @@ treeShapes' :: [Tree ()] treeShapes' = take 20 $ bfsBySum unfold_ +arbitraryTrees :: Int -> IO ()+arbitraryTrees size = sample (resize size arbitraryDefault :: Gen (Tree ()))+ data Pair a = Pair a a-  deriving (Show, Functor, Generic1, Unfoldable)+  deriving (Show, Functor, Foldable, Generic1, Unfoldable) data PerfectTree a = Leaf a | Branch (PerfectTree (Pair a))-  deriving (Show, Functor, Generic1, Unfoldable)+  deriving (Show, Functor, Foldable, Generic1, Unfoldable)  ptreeShapes :: [PerfectTree ()] ptreeShapes = take 5 unfoldBF_
src/Data/Biunfoldable.hs view
@@ -11,7 +11,7 @@ -- Class of data structures with 2 type arguments that can be unfolded. ----------------------------------------------------------------------------- {-# LANGUAGE Safe #-}-module Data.Biunfoldable +module Data.Biunfoldable   (    -- * Biunfoldable@@ -26,7 +26,7 @@   , randomDefault   , arbitraryDefault -  ) +  )   where  import Control.Applicative@@ -94,19 +94,19 @@  -- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'. arbitraryDefault :: (Arbitrary a, Arbitrary b, Biunfoldable t) => Gen (t a b)-arbitraryDefault = let Arb _ gen = biunfold arbUnit arbUnit in -  fromMaybe (error "Failed to generate a value.") <$> sized (\n -> resize (n + 1) gen)+arbitraryDefault = let Arb _ _ gen = biunfold arbUnit arbUnit in+  fromMaybe (error "Failed to generate a value.") <$> gen  instance Biunfoldable Either where-  biunfold fa fb = choose +  biunfold fa fb = choose     [ Left <$> fa     , Right <$> fb     ]  instance Biunfoldable (,) where-  biunfold fa fb = choose +  biunfold fa fb = choose     [ (,) <$> fa <*> fb ]  instance Biunfoldable Constant where-  biunfold fa _ = choose +  biunfold fa _ = choose     [ Constant <$> fa ]
src/Data/Unfoldable.hs view
@@ -93,7 +93,11 @@  #ifdef GENERICS   default unfold :: (ADT1 t, Constraints1 t Unfoldable, Unfolder f) => f a -> f (t a)-  unfold = choose . getCompose . createA1 @Unfoldable (Compose . return . unfold . foldr (<|>) empty . getCompose) . Compose . return+  unfold = choose . getCompose . createA1 @Unfoldable (Compose . pure . unfold . asum' . getCompose) . Compose . pure+    where+      asum' [] = empty+      asum' [a] = a+      asum' (a:as) = a <|> asum' as   {-# INLINE unfold #-} #endif @@ -153,8 +157,8 @@  -- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'. arbitraryDefault :: (Arbitrary a, Unfoldable t) => Gen (t a)-arbitraryDefault = let Arb _ gen = unfold arbUnit in-  fromMaybe (error "Failed to generate a value.") <$> sized (\n -> resize (n + 1) gen)+arbitraryDefault = let Arb _ _ gen = unfold arbUnit in+  fromMaybe (error "Failed to generate a value.") <$> gen  instance Unfoldable [] where   unfold fa = go where
src/Data/Unfolder.hs view
@@ -85,12 +85,13 @@ import Control.Monad.Trans.Writer  import qualified System.Random as R-import Test.QuickCheck (Arbitrary(..), Gen, oneof, elements, sized, resize)+import Test.QuickCheck (Arbitrary(..), Gen, oneof, elements, frequency, sized, resize)  import Data.Monoid (Monoid(..)) import Data.Maybe (catMaybes) import qualified Data.Sequence as S + -- | Unfolders provide a way to unfold data structures. -- The methods have default implementations in terms of 'Alternative', -- but you can implement 'chooseMap' to act on recursive positions of the@@ -243,10 +244,55 @@ instance (Functor m, Monad m, R.RandomGen g) => Unfolder (Random g m) where   choose = chooseMonadDefault   chooseMap = chooseMapMonadDefault-  chooseInt 0 = Random . StateT $ const (fail "Random chooseInt 0")   chooseInt n = Random . StateT $ return . R.randomR (0, n - 1)  +-- | A variant of Test.QuickCheck.Gen, with failure+-- and a count of the number of recursive positions and parameter positions.+data Arb a = Arb Int Int (Gen (Maybe a))++instance Functor Arb where+  fmap f (Arb r p g) = Arb r p $ fmap (fmap f) g++instance Applicative Arb where+  pure = Arb 0 0 . pure . pure+  Arb r1 p1 ff <*> Arb r2 p2 fx = Arb (r1 + r2) (p1 + p2) $ liftA2 (<*>) ff fx++instance Alternative Arb where+  empty = Arb 0 0 (pure Nothing)+  Arb r1 p1 g1 <|> Arb r2 p2 g2 = Arb (r1 + r2) (p1 + p2) $ g1 >>= \a -> g2 >>= \b -> Just <$> elements (catMaybes [a, b])++-- | Limit the depth of the generated data structure by+-- dividing the given size by the number of recursive positions.+instance Unfolder Arb where+  choose as = Arb 1 0 $ sized g+    where+      g n = freq $ foldMap f as+        where+          (recPosCount, parPosCount) = foldr (\(Arb r p _) (rc, pc) -> (r + rc, p + pc)) (0, 0) as+          recSize = (n - parPosCount) `div` max 1 recPosCount+          f (Arb r p gen) = if (r > 0 && recSize < 0) || (n == 0 && r + p > 0) then [] else [(3 + r * recSize, resize (max 0 recSize) gen)]+          freq [] = pure Nothing+          freq as = frequency as++arbUnit :: Arbitrary a => Arb a+arbUnit = Arb 0 1 (Just <$> arbitrary)+++-- | Variant of 'Data.Functor.Constant' that does multiplication of the constants for @\<*>@ and addition for @\<|>@.+newtype NumConst a x = NumConst { getNumConst :: a } deriving (Eq, Show)+instance Functor (NumConst a) where+  fmap _ (NumConst a) = NumConst a+instance Num a => Applicative (NumConst a) where+  pure _ = NumConst 1+  NumConst a <*> NumConst b = NumConst $ a * b+instance Num a => Alternative (NumConst a) where+  empty = NumConst 0+  NumConst a <|> NumConst b = NumConst $ a + b+-- | Unfolds to a constant numeric value. Useful for counting shapes.+instance Num a => Unfolder (NumConst a)++ data Nth a = Nth   { size :: Integer   , getNth :: Integer -> a@@ -261,6 +307,7 @@   empty = Nth 0 (const undefined)   Nth sizeA as <|> Nth sizeB bs = Nth (sizeA + sizeB) $ \n ->     if n < sizeA then as n else bs (n - sizeA)+-- | Get the nth value from the sequence of all possible values. instance Unfolder Nth where   chooseInt n = Nth (toInteger n) fromInteger @@ -377,49 +424,3 @@ flattenBFS ms = case catMaybes ms of   [] -> Nothing   ms' -> Just (concat ms')----- | A variant of Test.QuickCheck.Gen, with failure--- and a count of the number of recursive positions.-data Arb a = Arb Int (Gen (Maybe a))--instance Functor Arb where-  fmap f (Arb i g) = Arb i $ fmap (fmap f) g--instance Applicative Arb where-  pure = Arb 0 . pure . pure-  Arb i1 ff <*> Arb i2 fx = Arb (i1 + i2) $ liftA2 (<*>) ff fx--instance Alternative Arb where-  empty = Arb 0 (pure Nothing)-  Arb ia fa <|> Arb ib fb = Arb ((ia + ib + 1) `div` 2) $ oneof [fa, fb]---- | Limit the depth of the generated data structure by--- dividing the given size by the number of recursive positions.-instance Unfolder Arb where-  chooseMap f as = Arb 1 $ sized g-    where-      g 0 = pure Nothing-      g n = flatMapArb ((\(Arb i gen) -> resize (n `div` max i 1) gen) . f) as--flatMapArb :: (a -> Gen (Maybe b)) -> [a] -> Gen (Maybe b)-flatMapArb f = go [] where-  go [] [] = pure Nothing-  go as [] = Just <$> elements as-  go as (g:gs) = f g >>= \ma -> go (maybe as (:as) ma) gs--arbUnit :: Arbitrary a => Arb a-arbUnit = Arb 0 (Just <$> arbitrary)---- | Variant of 'Data.Functor.Constant' that does multiplication of the constants for @\<*>@ and addition for @\<|>@.-newtype NumConst a x = NumConst { getNumConst :: a } deriving (Eq, Show)-instance Functor (NumConst a) where-  fmap _ (NumConst a) = NumConst a-instance Num a => Applicative (NumConst a) where-  pure _ = NumConst 1-  NumConst a <*> NumConst b = NumConst $ a * b-instance Num a => Alternative (NumConst a) where-  empty = NumConst 0-  NumConst a <|> NumConst b = NumConst $ a + b--- | Unfolds to a constant numeric value. Useful for counting shapes.-instance Num a => Unfolder (NumConst a)
unfoldable.cabal view
@@ -1,5 +1,5 @@ Name:                 unfoldable-Version:              0.9.6+Version:              1.0 Synopsis:             Class of data structures that can be unfolded. Description:          Just as there's a Foldable class, there should also be an Unfoldable class.                       .@@ -37,10 +37,10 @@    Build-depends:       base         >= 4   && < 5-    , containers   >= 0.5 && < 0.6+    , containers   >= 0.5 && < 0.7     , transformers >= 0.4 && < 0.6     , random       >= 1.0 && < 1.2-    , QuickCheck   >= 2.7.3 && < 2.12+    , QuickCheck   >= 2.7.3 && < 3.0    if impl(ghc >= 7.6)     cpp-options:   -DGENERICS