unfoldable 0.6.0.1 → 0.6.0.2

raw patch · 10 files changed

+967/−967 lines, 10 filessetup-changed

Files

LICENSE +30/−30
Setup.hs +2/−2
examples/btree.hs +24/−24
examples/redblack.hs +106/−106
examples/tree.hs +25/−25
src/Data/Biunfoldable.hs +112/−112
src/Data/Triunfoldable.hs +110/−110
src/Data/Unfoldable.hs +168/−168
src/Data/Unfolder.hs +345/−345
unfoldable.cabal +45/−45

LICENSE view

@@ -1,30 +1,30 @@-Copyright (c)2012, Sjoerd Visscher
-
-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 Sjoerd Visscher 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.
+Copyright (c)2012, Sjoerd Visscher++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 Sjoerd Visscher 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

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

examples/btree.hs view

@@ -1,24 +1,24 @@-import Control.Applicative
-import Data.Unfoldable
-import Data.Unfolder
-
-import Data.Maybe
-import System.Random
-
-
-data TB a = LB a | BB (TB (a, a)) deriving Show
-
-instance Unfoldable TB where
-  unfold fa = choose
-    [ LB <$> fa
-    , BB <$> unfold ((,) <$> fa <*> fa)
-    ]
-
-btree8 :: TB Int
-btree8 = fromJust $ fromList [0..7]
-
-btreeShapes :: [TB ()]
-btreeShapes = take 5 unfold_
-
-randomBTree :: IO (TB Bool)
-randomBTree = getStdRandom randomDefault
+import Control.Applicative+import Data.Unfoldable+import Data.Unfolder++import Data.Maybe+import System.Random+++data TB a = LB a | BB (TB (a, a)) deriving Show++instance Unfoldable TB where+  unfold fa = choose+    [ LB <$> fa+    , BB <$> unfold ((,) <$> fa <*> fa)+    ]++btree8 :: TB Int+btree8 = fromJust $ fromList [0..7]++btreeShapes :: [TB ()]+btreeShapes = take 5 unfold_++randomBTree :: IO (TB Bool)+randomBTree = getStdRandom randomDefault

examples/redblack.hs view

@@ -1,107 +1,107 @@-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-import Control.Applicative
-import Data.Unfoldable
-import Data.Unfolder
-
-import Data.Maybe
-import System.Random
-import Data.List (intercalate)
-
--- red-black tree implementation adapted from https://gist.github.com/2660297
-data Nat = Zero | Succ Nat deriving (Eq, Ord, Show)
-data NatW :: Nat -> * where
-  ZeroW :: NatW Zero
-  SuccW :: NatW n -> NatW (Succ n)
-
-data RedBlack = Black | Red deriving (Eq, Ord, Show)
-
-data RedBlackTree a where 
-  T :: Node Black n a -> RedBlackTree a
-deriving instance Show a => Show (RedBlackTree a)
-
-data Node :: RedBlack -> Nat -> * -> * where
-  Leaf :: Node Black Zero a
-  B :: Node cL    n a -> a -> Node cR    n a -> Node Black (Succ n) a
-  R :: Node Black n a -> a -> Node Black n a -> Node Red    n       a
-deriving instance Show a => Show (Node c n a)
-
-instance Unfoldable RedBlackTree where
-  unfold = u ZeroW
-    where
-      u :: forall n f a. (Unfoldable (Node Black n), Unfolder f) 
-        => NatW n -> f a -> f (RedBlackTree a)
-      u n fa = choose 
-        [ T <$> (unfold :: Unfolder f => f a -> f (Node Black n a)) fa
-        , u (SuccW n) fa
-        ]
-  
-instance Unfoldable (Node Black Zero) where
-  unfold _ = choose [ pure Leaf ]
-
-instance Unfoldable (Node Black n) => Unfoldable (Node Black (Succ n)) where
-  unfold = u
-    where
-      u :: forall f a. Unfolder f => f a -> f (Node Black (Succ n) a)
-      u fa = choose 
-        [ B <$> b <*> fa <*> b
-        , B <$> b <*> fa <*> r
-        , B <$> r <*> fa <*> b
-        , B <$> r <*> fa <*> r
-        ]
-        where
-          r :: Unfolder f => f (Node Red n a)
-          r = unfold fa
-          b :: Unfolder f => f (Node Black n a)
-          b = unfold fa
-
-instance Unfoldable (Node Black n) => Unfoldable (Node Red n) where
-  unfold fa = choose [ R <$> unfold fa <*> fa <*> unfold fa ]
-
-rbtree :: Int -> RedBlackTree Int
-rbtree l = fromJust $ fromList [0..l]
-
-rbtreeShapes :: Int -> [RedBlackTree ()]
-rbtreeShapes d = limitDepth d unfold_
-
-randomRBTree :: IO (RedBlackTree Bool)
-randomRBTree = getStdRandom randomDefault
-
-newtype Formula = Formula [Integer]
-instance Show Formula where
-  show (Formula xs) 
-    | all (== 0) xs = "0"
-    | otherwise = intercalate " + " $ map showOne $ filter ((/=0) . fst) $ zip xs [0..]
-        where
-          showOne (x, 0) = show x
-          showOne (1, 1) = "x"
-          showOne (x, 1) = show x ++ "x"
-          showOne (1, n) = "x^" ++ show n
-          showOne (x, n) = show x ++ "x^" ++ show n
-
-add, mul :: [Integer] -> [Integer] -> [Integer]
-add xs [] = xs
-add [] ys = ys
-add (x:xs) (y:ys) = (x + y) : add xs ys
-mul _ [] = []
-mul [] _ = []
-mul (x:xs) (y:ys) = (x * y) : add (map (x*) ys) (add (map (y*) xs) (0 : mul xs ys))
-
-instance Num Formula where
-  fromInteger x = Formula [x]
-  Formula xs + Formula ys = Formula (add xs ys)
-  Formula xs * Formula ys = Formula (mul xs ys)
-
-x :: Formula
-x = Formula [0, 1]
-
--- See http://oeis.org/A001137
-rbFormula :: Int -> NumConst Formula (RedBlackTree a)
+{-# LANGUAGE GADTs #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}++import Control.Applicative+import Data.Unfoldable+import Data.Unfolder++import Data.Maybe+import System.Random+import Data.List (intercalate)++-- red-black tree implementation adapted from https://gist.github.com/2660297+data Nat = Zero | Succ Nat deriving (Eq, Ord, Show)+data NatW :: Nat -> * where+  ZeroW :: NatW Zero+  SuccW :: NatW n -> NatW (Succ n)++data RedBlack = Black | Red deriving (Eq, Ord, Show)++data RedBlackTree a where +  T :: Node Black n a -> RedBlackTree a+deriving instance Show a => Show (RedBlackTree a)++data Node :: RedBlack -> Nat -> * -> * where+  Leaf :: Node Black Zero a+  B :: Node cL    n a -> a -> Node cR    n a -> Node Black (Succ n) a+  R :: Node Black n a -> a -> Node Black n a -> Node Red    n       a+deriving instance Show a => Show (Node c n a)++instance Unfoldable RedBlackTree where+  unfold = u ZeroW+    where+      u :: forall n f a. (Unfoldable (Node Black n), Unfolder f) +        => NatW n -> f a -> f (RedBlackTree a)+      u n fa = choose +        [ T <$> (unfold :: Unfolder f => f a -> f (Node Black n a)) fa+        , u (SuccW n) fa+        ]+  +instance Unfoldable (Node Black Zero) where+  unfold _ = choose [ pure Leaf ]++instance Unfoldable (Node Black n) => Unfoldable (Node Black (Succ n)) where+  unfold = u+    where+      u :: forall f a. Unfolder f => f a -> f (Node Black (Succ n) a)+      u fa = choose +        [ B <$> b <*> fa <*> b+        , B <$> b <*> fa <*> r+        , B <$> r <*> fa <*> b+        , B <$> r <*> fa <*> r+        ]+        where+          r :: Unfolder f => f (Node Red n a)+          r = unfold fa+          b :: Unfolder f => f (Node Black n a)+          b = unfold fa++instance Unfoldable (Node Black n) => Unfoldable (Node Red n) where+  unfold fa = choose [ R <$> unfold fa <*> fa <*> unfold fa ]++rbtree :: Int -> RedBlackTree Int+rbtree l = fromJust $ fromList [0..l]++rbtreeShapes :: Int -> [RedBlackTree ()]+rbtreeShapes d = limitDepth d unfold_++randomRBTree :: IO (RedBlackTree Bool)+randomRBTree = getStdRandom randomDefault++newtype Formula = Formula [Integer]+instance Show Formula where+  show (Formula xs) +    | all (== 0) xs = "0"+    | otherwise = intercalate " + " $ map showOne $ filter ((/=0) . fst) $ zip xs [0..]+        where+          showOne (x, 0) = show x+          showOne (1, 1) = "x"+          showOne (x, 1) = show x ++ "x"+          showOne (1, n) = "x^" ++ show n+          showOne (x, n) = show x ++ "x^" ++ show n++add, mul :: [Integer] -> [Integer] -> [Integer]+add xs [] = xs+add [] ys = ys+add (x:xs) (y:ys) = (x + y) : add xs ys+mul _ [] = []+mul [] _ = []+mul (x:xs) (y:ys) = (x * y) : add (map (x*) ys) (add (map (y*) xs) (0 : mul xs ys))++instance Num Formula where+  fromInteger x = Formula [x]+  Formula xs + Formula ys = Formula (add xs ys)+  Formula xs * Formula ys = Formula (mul xs ys)++x :: Formula+x = Formula [0, 1]++-- See http://oeis.org/A001137+rbFormula :: Int -> NumConst Formula (RedBlackTree a) rbFormula d = ala (limitDepth d) unfold (NumConst x)

examples/tree.hs view

@@ -1,25 +1,25 @@-import Control.Applicative
-import Data.Unfoldable
-import Data.Unfolder
-
-import Data.Maybe
-import System.Random
-
-
-data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) deriving Show
-
-instance Unfoldable Tree where
-  unfold fa = choose
-    [ pure Empty
-    , Leaf <$> fa
-    , Node <$> unfold fa <*> fa <*> unfold fa
-    ]
-    
-tree7 :: Tree Int
-tree7 = fromJust $ fromList [0..6]
-
-treeShapes :: [Tree ()]
-treeShapes = take 10 unfoldBF_
-
-randomTree :: IO (Tree Bool)
-randomTree = getStdRandom randomDefault
+import Control.Applicative+import Data.Unfoldable+import Data.Unfolder++import Data.Maybe+import System.Random+++data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) deriving Show++instance Unfoldable Tree where+  unfold fa = choose+    [ pure Empty+    , Leaf <$> fa+    , Node <$> unfold fa <*> fa <*> unfold fa+    ]+    +tree7 :: Tree Int+tree7 = fromJust $ fromList [0..6]++treeShapes :: [Tree ()]+treeShapes = take 10 unfoldBF_++randomTree :: IO (Tree Bool)+randomTree = getStdRandom randomDefault

src/Data/Biunfoldable.hs view

@@ -1,112 +1,112 @@------------------------------------------------------------------------------
--- |
--- Module      :  Data.Biunfoldable
--- Copyright   :  (c) Sjoerd Visscher 2012
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  sjoerd@w3future.com
--- Stability   :  experimental
--- Portability :  non-portable
---
--- Class of data structures with 2 type arguments that can be unfolded.
------------------------------------------------------------------------------
-module Data.Biunfoldable 
-  (
-
-  -- * Biunfoldable
-    Biunfoldable(..)
-  , biunfold_
-  , biunfoldBF
-  , biunfoldBF_
-
-  -- ** Specific unfolds
-  , biunfoldr
-  , fromLists
-  , randomDefault
-  , arbitraryDefault
-
-  ) 
-  where
-
-import Control.Applicative
-import Data.Unfolder
-import Data.Functor.Constant
-import Control.Monad.Trans.State
-import qualified System.Random as R
-import Test.QuickCheck.Arbitrary (Arbitrary(..))
-import Test.QuickCheck.Gen (Gen(..))
-import Data.Maybe
-
--- | Data structures with 2 type arguments (kind @* -> * -> *@) that can be unfolded.
---
--- For example, given a data type
---
--- > data Tree a b = Empty | Leaf a | Node (Tree a b) b (Tree a b)
---
--- a suitable instance would be
---
--- > instance Biunfoldable Tree where
--- >   biunfold fa fb = choose
--- >     [ pure Empty
--- >     , Leaf <$> fa
--- >     , Node <$> biunfold fa fb <*> fb <*> biunfold fa fb
--- >     ]
---
--- i.e. it follows closely the instance for 'Bitraversable', but instead of matching on an input value,
--- we 'choose' from a list of all cases.
-class Biunfoldable t where
-  -- | Given a way to generate elements, return a way to generate structures containing those elements.
-  biunfold :: Unfolder f => f a -> f b -> f (t a b)
-
--- | Unfold the structure, always using @()@ as elements.
-biunfold_ :: (Biunfoldable t, Unfolder f) => f (t () ())
-biunfold_ = biunfold (pure ()) (pure ())
-
--- | Breadth-first unfold, which orders the result by the number of 'choose' calls.
-biunfoldBF :: (Biunfoldable t, Unfolder f) => f a -> f b -> f (t a b)
-biunfoldBF = ala2 bfs biunfold
-
--- | Unfold the structure breadth-first, always using @()@ as elements.
-biunfoldBF_ :: (Biunfoldable t, Unfolder f) => f (t () ())
-biunfoldBF_ = bfs biunfold_
-
--- | @biunfoldr@ builds a data structure from a seed value.
-biunfoldr :: Biunfoldable t => (c -> Maybe (a, c)) -> (c -> Maybe (b, c)) -> c -> Maybe (t a b)
-biunfoldr fa fb z = terminate . flip runStateT z $ biunfoldBF (StateT $ maybeToList . fa) (StateT $ maybeToList . fb)
-  where
-    terminate [] = Nothing
-    terminate ((t, c):ts) = if isNothing (fa c) && isNothing (fb c) then Just t else terminate ts
-
--- | Create a data structure using the lists as input.
--- This can fail because there might not be a data structure with the same number
--- of element positions as the number of elements in the lists.
-fromLists :: Biunfoldable t => [a] -> [b] -> Maybe (t a b)
-fromLists = curry $ biunfoldr unconsA unconsB
-  where
-    unconsA ([], _) = Nothing
-    unconsA (a:as, bs) = Just (a, (as, bs))
-    unconsB (_, []) = Nothing
-    unconsB (as, b:bs) = Just (b, (as, bs))
-
--- | Generate a random value, can be used as default instance for 'R.Random'.
-randomDefault :: (R.Random a, R.Random b, R.RandomGen g, Biunfoldable t) => g -> (t a b, g)
-randomDefault = runState . getRandom $ biunfold (Random . state $ R.random) (Random . state $ R.random)
-
--- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'.
-arbitraryDefault :: (Arbitrary a, Arbitrary b, Biunfoldable t) => Gen (t a b)
-arbitraryDefault = MkGen $ \r n -> let Arb _ f = biunfold arbUnit arbUnit in 
-  fromMaybe (error "Failed to generate a value.") (f r (n + 1))
-
-instance Biunfoldable Either where
-  biunfold fa fb = choose 
-    [ Left <$> fa
-    , Right <$> fb
-    ]
-
-instance Biunfoldable (,) where
-  biunfold fa fb = choose 
-    [ (,) <$> fa <*> fb ]
-
-instance Biunfoldable Constant where
-  biunfold fa _ = choose 
-    [ Constant <$> fa ]
+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Biunfoldable+-- Copyright   :  (c) Sjoerd Visscher 2012+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  sjoerd@w3future.com+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Class of data structures with 2 type arguments that can be unfolded.+-----------------------------------------------------------------------------+module Data.Biunfoldable +  (++  -- * Biunfoldable+    Biunfoldable(..)+  , biunfold_+  , biunfoldBF+  , biunfoldBF_++  -- ** Specific unfolds+  , biunfoldr+  , fromLists+  , randomDefault+  , arbitraryDefault++  ) +  where++import Control.Applicative+import Data.Unfolder+import Data.Functor.Constant+import Control.Monad.Trans.State+import qualified System.Random as R+import Test.QuickCheck.Arbitrary (Arbitrary(..))+import Test.QuickCheck.Gen (Gen(..))+import Data.Maybe++-- | Data structures with 2 type arguments (kind @* -> * -> *@) that can be unfolded.+--+-- For example, given a data type+--+-- > data Tree a b = Empty | Leaf a | Node (Tree a b) b (Tree a b)+--+-- a suitable instance would be+--+-- > instance Biunfoldable Tree where+-- >   biunfold fa fb = choose+-- >     [ pure Empty+-- >     , Leaf <$> fa+-- >     , Node <$> biunfold fa fb <*> fb <*> biunfold fa fb+-- >     ]+--+-- i.e. it follows closely the instance for 'Bitraversable', but instead of matching on an input value,+-- we 'choose' from a list of all cases.+class Biunfoldable t where+  -- | Given a way to generate elements, return a way to generate structures containing those elements.+  biunfold :: Unfolder f => f a -> f b -> f (t a b)++-- | Unfold the structure, always using @()@ as elements.+biunfold_ :: (Biunfoldable t, Unfolder f) => f (t () ())+biunfold_ = biunfold (pure ()) (pure ())++-- | Breadth-first unfold, which orders the result by the number of 'choose' calls.+biunfoldBF :: (Biunfoldable t, Unfolder f) => f a -> f b -> f (t a b)+biunfoldBF = ala2 bfs biunfold++-- | Unfold the structure breadth-first, always using @()@ as elements.+biunfoldBF_ :: (Biunfoldable t, Unfolder f) => f (t () ())+biunfoldBF_ = bfs biunfold_++-- | @biunfoldr@ builds a data structure from a seed value.+biunfoldr :: Biunfoldable t => (c -> Maybe (a, c)) -> (c -> Maybe (b, c)) -> c -> Maybe (t a b)+biunfoldr fa fb z = terminate . flip runStateT z $ biunfoldBF (StateT $ maybeToList . fa) (StateT $ maybeToList . fb)+  where+    terminate [] = Nothing+    terminate ((t, c):ts) = if isNothing (fa c) && isNothing (fb c) then Just t else terminate ts++-- | Create a data structure using the lists as input.+-- This can fail because there might not be a data structure with the same number+-- of element positions as the number of elements in the lists.+fromLists :: Biunfoldable t => [a] -> [b] -> Maybe (t a b)+fromLists = curry $ biunfoldr unconsA unconsB+  where+    unconsA ([], _) = Nothing+    unconsA (a:as, bs) = Just (a, (as, bs))+    unconsB (_, []) = Nothing+    unconsB (as, b:bs) = Just (b, (as, bs))++-- | Generate a random value, can be used as default instance for 'R.Random'.+randomDefault :: (R.Random a, R.Random b, R.RandomGen g, Biunfoldable t) => g -> (t a b, g)+randomDefault = runState . getRandom $ biunfold (Random . state $ R.random) (Random . state $ R.random)++-- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'.+arbitraryDefault :: (Arbitrary a, Arbitrary b, Biunfoldable t) => Gen (t a b)+arbitraryDefault = MkGen $ \r n -> let Arb _ f = biunfold arbUnit arbUnit in +  fromMaybe (error "Failed to generate a value.") (f r (n + 1))++instance Biunfoldable Either where+  biunfold fa fb = choose +    [ Left <$> fa+    , Right <$> fb+    ]++instance Biunfoldable (,) where+  biunfold fa fb = choose +    [ (,) <$> fa <*> fb ]++instance Biunfoldable Constant where+  biunfold fa _ = choose +    [ Constant <$> fa ]

src/Data/Triunfoldable.hs view

@@ -1,110 +1,110 @@------------------------------------------------------------------------------
--- |
--- Module      :  Data.Triunfoldable
--- Copyright   :  (c) Sjoerd Visscher 2012
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  sjoerd@w3future.com
--- Stability   :  experimental
--- Portability :  non-portable
---
--- Class of data structures with 3 type arguments that can be unfolded.
------------------------------------------------------------------------------
-module Data.Triunfoldable 
-  (
-
-  -- * Triunfoldable
-    Triunfoldable(..)
-  , triunfold_
-  , triunfoldBF
-  , triunfoldBF_
-
-  -- ** Specific unfolds
-  , triunfoldr
-  , fromLists
-  , randomDefault
-  , arbitraryDefault
-
-  ) 
-  where
-
-import Control.Applicative
-import Data.Unfolder
-import Data.Functor.Constant
-import Control.Monad.Trans.State
-import qualified System.Random as R
-import Test.QuickCheck.Arbitrary (Arbitrary(..))
-import Test.QuickCheck.Gen (Gen(..))
-import Data.Maybe
-
--- | Data structures with 3 type arguments (kind @* -> * -> * -> *@) that can be unfolded.
---
--- For example, given a data type
---
--- > data Tree a b c = Empty | Leaf a | Node (Tree a b c) b (Tree a b c)
---
--- a suitable instance would be
---
--- > instance Triunfoldable Tree where
--- >   triunfold fa fb fc = choose
--- >     [ pure Empty
--- >     , Leaf <$> fa
--- >     , Node <$> triunfold fa fb fc <*> fb <*> triunfold fa fb fc
--- >     ]
---
--- i.e. it follows closely the instance for 'Biunfoldable', but for 3 type arguments instead of 2.
-
-class Triunfoldable t where
-  -- | Given a way to generate elements, return a way to generate structures containing those elements.
-  triunfold :: Unfolder f => f a -> f b -> f c -> f (t a b c)
-
--- | Unfold the structure, always using @()@ as elements.
-triunfold_ :: (Triunfoldable t, Unfolder f) => f (t () () ())
-triunfold_ = triunfold (pure ()) (pure ()) (pure ())
-
--- | Breadth-first unfold, which orders the result by the number of 'choose' calls.
-triunfoldBF :: (Triunfoldable t, Unfolder f) => f a -> f b -> f c -> f (t a b c)
-triunfoldBF = ala3 bfs triunfold
-
--- | Unfold the structure breadth-first, always using @()@ as elements.
-triunfoldBF_ :: (Triunfoldable t, Unfolder f) => f (t () () ())
-triunfoldBF_ = bfs triunfold_
-
--- | @triunfoldr@ builds a data structure from a seed value.
-triunfoldr :: Triunfoldable t => (d -> Maybe (a, d)) -> (d -> Maybe (b, d)) -> (d -> Maybe (c, d)) -> d -> Maybe (t a b c)
-triunfoldr fa fb fc z = terminate . flip runStateT z $ triunfoldBF (StateT $ maybeToList . fa) (StateT $ maybeToList . fb) (StateT $ maybeToList . fc)
-  where
-    terminate [] = Nothing
-    terminate ((t, d):ts) = if (isNothing (fa d) && isNothing (fb d) && isNothing (fc d)) then Just t else terminate ts
-
-
--- | Create a data structure using the lists as input.
--- This can fail because there might not be a data structure with the same number
--- of element positions as the number of elements in the lists.
-fromLists :: Triunfoldable t => [a] -> [b] -> [c] -> Maybe (t a b c)
-fromLists = curry3 $ triunfoldr unconsA unconsB unconsC
-  where
-    unconsA ([], _, _) = Nothing
-    unconsA (a:as, bs, cs) = Just (a, (as, bs, cs))
-    unconsB (_, [], _) = Nothing
-    unconsB (as, b:bs, cs) = Just (b, (as, bs, cs))
-    unconsC (_, _, []) = Nothing
-    unconsC (as, bs, c:cs) = Just (c, (as, bs, cs))
-
--- | Generate a random value, can be used as default instance for 'R.Random'.
-randomDefault :: (R.Random a, R.Random b, R.Random c, R.RandomGen g, Triunfoldable t) => g -> (t a b c, g)
-randomDefault = runState . getRandom $ triunfold (Random . state $ R.random) (Random . state $ R.random) (Random . state $ R.random)
-
--- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'.
-arbitraryDefault :: (Arbitrary a, Arbitrary b, Arbitrary c, Triunfoldable t) => Gen (t a b c)
-arbitraryDefault = MkGen $ \r n -> let Arb _ f = triunfold arbUnit arbUnit arbUnit in 
-  fromMaybe (error "Failed to generate a value.") (f r (n + 1))
-
-
-curry3 :: ((a,b,c) -> d) -> a -> b -> c -> d
-curry3 f a b c = f (a,b,c)
-
-instance Triunfoldable (,,) where
-  triunfold fa fb fc = choose 
-    [ (,,) <$> fa <*> fb <*> fc ]
-
+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Triunfoldable+-- Copyright   :  (c) Sjoerd Visscher 2012+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  sjoerd@w3future.com+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Class of data structures with 3 type arguments that can be unfolded.+-----------------------------------------------------------------------------+module Data.Triunfoldable +  (++  -- * Triunfoldable+    Triunfoldable(..)+  , triunfold_+  , triunfoldBF+  , triunfoldBF_++  -- ** Specific unfolds+  , triunfoldr+  , fromLists+  , randomDefault+  , arbitraryDefault++  ) +  where++import Control.Applicative+import Data.Unfolder+import Data.Functor.Constant+import Control.Monad.Trans.State+import qualified System.Random as R+import Test.QuickCheck.Arbitrary (Arbitrary(..))+import Test.QuickCheck.Gen (Gen(..))+import Data.Maybe++-- | Data structures with 3 type arguments (kind @* -> * -> * -> *@) that can be unfolded.+--+-- For example, given a data type+--+-- > data Tree a b c = Empty | Leaf a | Node (Tree a b c) b (Tree a b c)+--+-- a suitable instance would be+--+-- > instance Triunfoldable Tree where+-- >   triunfold fa fb fc = choose+-- >     [ pure Empty+-- >     , Leaf <$> fa+-- >     , Node <$> triunfold fa fb fc <*> fb <*> triunfold fa fb fc+-- >     ]+--+-- i.e. it follows closely the instance for 'Biunfoldable', but for 3 type arguments instead of 2.++class Triunfoldable t where+  -- | Given a way to generate elements, return a way to generate structures containing those elements.+  triunfold :: Unfolder f => f a -> f b -> f c -> f (t a b c)++-- | Unfold the structure, always using @()@ as elements.+triunfold_ :: (Triunfoldable t, Unfolder f) => f (t () () ())+triunfold_ = triunfold (pure ()) (pure ()) (pure ())++-- | Breadth-first unfold, which orders the result by the number of 'choose' calls.+triunfoldBF :: (Triunfoldable t, Unfolder f) => f a -> f b -> f c -> f (t a b c)+triunfoldBF = ala3 bfs triunfold++-- | Unfold the structure breadth-first, always using @()@ as elements.+triunfoldBF_ :: (Triunfoldable t, Unfolder f) => f (t () () ())+triunfoldBF_ = bfs triunfold_++-- | @triunfoldr@ builds a data structure from a seed value.+triunfoldr :: Triunfoldable t => (d -> Maybe (a, d)) -> (d -> Maybe (b, d)) -> (d -> Maybe (c, d)) -> d -> Maybe (t a b c)+triunfoldr fa fb fc z = terminate . flip runStateT z $ triunfoldBF (StateT $ maybeToList . fa) (StateT $ maybeToList . fb) (StateT $ maybeToList . fc)+  where+    terminate [] = Nothing+    terminate ((t, d):ts) = if (isNothing (fa d) && isNothing (fb d) && isNothing (fc d)) then Just t else terminate ts+++-- | Create a data structure using the lists as input.+-- This can fail because there might not be a data structure with the same number+-- of element positions as the number of elements in the lists.+fromLists :: Triunfoldable t => [a] -> [b] -> [c] -> Maybe (t a b c)+fromLists = curry3 $ triunfoldr unconsA unconsB unconsC+  where+    unconsA ([], _, _) = Nothing+    unconsA (a:as, bs, cs) = Just (a, (as, bs, cs))+    unconsB (_, [], _) = Nothing+    unconsB (as, b:bs, cs) = Just (b, (as, bs, cs))+    unconsC (_, _, []) = Nothing+    unconsC (as, bs, c:cs) = Just (c, (as, bs, cs))++-- | Generate a random value, can be used as default instance for 'R.Random'.+randomDefault :: (R.Random a, R.Random b, R.Random c, R.RandomGen g, Triunfoldable t) => g -> (t a b c, g)+randomDefault = runState . getRandom $ triunfold (Random . state $ R.random) (Random . state $ R.random) (Random . state $ R.random)++-- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'.+arbitraryDefault :: (Arbitrary a, Arbitrary b, Arbitrary c, Triunfoldable t) => Gen (t a b c)+arbitraryDefault = MkGen $ \r n -> let Arb _ f = triunfold arbUnit arbUnit arbUnit in +  fromMaybe (error "Failed to generate a value.") (f r (n + 1))+++curry3 :: ((a,b,c) -> d) -> a -> b -> c -> d+curry3 f a b c = f (a,b,c)++instance Triunfoldable (,,) where+  triunfold fa fb fc = choose +    [ (,,) <$> fa <*> fb <*> fc ]+

src/Data/Unfoldable.hs view

@@ -1,169 +1,169 @@------------------------------------------------------------------------------
--- |
--- Module      :  Data.Unfoldable
--- Copyright   :  (c) Sjoerd Visscher 2012
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  sjoerd@w3future.com
--- Stability   :  experimental
--- Portability :  non-portable
---
--- Class of data structures that can be unfolded.
------------------------------------------------------------------------------
-module Data.Unfoldable 
-  (
-  
-  -- * Unfoldable
-    Unfoldable(..)
-  , unfold_
-  , unfoldBF
-  , unfoldBF_
-  
-  -- ** Specific unfolds
-  , unfoldr
-  , fromList
-  , leftMost
-  , rightMost
-  , allDepthFirst
-  , allToDepth
-  , allBreadthFirst
-  , randomDefault
-  , arbitraryDefault
-  
-  ) 
-  where
-    
-import Control.Applicative
-import Data.Unfolder
-import Data.Functor.Compose
-import Data.Functor.Constant
-import Data.Functor.Identity
-import Data.Functor.Product
-import Data.Functor.Reverse
-import Control.Monad.Trans.State
-import qualified System.Random as R
-import Test.QuickCheck.Arbitrary (Arbitrary(..))
-import Test.QuickCheck.Gen (Gen(..))
-import Data.Maybe
-
--- | Data structures that can be unfolded.
---
--- For example, given a data type
---
--- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
---
--- a suitable instance would be
---
--- > instance Unfoldable Tree where
--- >   unfold fa = choose
--- >     [ pure Empty
--- >     , Leaf <$> fa
--- >     , Node <$> unfold fa <*> fa <*> unfold fa
--- >     ]
---
--- i.e. it follows closely the instance for 'Traversable', but instead of matching on an input value,
--- we 'choose' from a list of all cases.
-class Unfoldable t where
-  -- | Given a way to generate elements, return a way to generate structures containing those elements.
-  unfold :: Unfolder f => f a -> f (t a)
-
--- | Unfold the structure, always using @()@ as elements.
-unfold_ :: (Unfoldable t, Unfolder f) => f (t ())
-unfold_ = unfold (pure ())
-
--- | Breadth-first unfold, which orders the result by the number of 'choose' calls.
-unfoldBF :: (Unfoldable t, Unfolder f) => f a -> f (t a)
-unfoldBF = ala bfs unfold
-
--- | Unfold the structure breadth-first, always using @()@ as elements.
-unfoldBF_ :: (Unfoldable t, Unfolder f) => f (t ())
-unfoldBF_ = bfs unfold_
-
--- | @unfoldr@ builds a data structure from a seed value. It can be specified as:
--- 
--- > unfoldr f z == fromList (Data.List.unfoldr f z)
-unfoldr :: Unfoldable t => (b -> Maybe (a, b)) -> b -> Maybe (t a)
-unfoldr f z = terminate . flip runStateT z . unfoldBF . StateT $ maybeToList . f
-  where
-    terminate [] = Nothing
-    terminate ((t, b):ts) = if isNothing (f b) then Just t else terminate ts
-
--- | Create a data structure using the list as input.
--- This can fail because there might not be a data structure with the same number
--- of element positions as the number of elements in the list.
-fromList :: Unfoldable t => [a] -> Maybe (t a)
-fromList = unfoldr uncons
-  where
-    uncons [] = Nothing
-    uncons (a:as) = Just (a, as)
-
--- | Always choose the first constructor.
-leftMost :: Unfoldable t => Maybe (t ())
-leftMost = unfold_
-
--- | Always choose the last constructor.
-rightMost :: Unfoldable t => Maybe (t ())
-rightMost = getDualA unfold_
-
--- | Generate all the values depth-first.
-allDepthFirst :: Unfoldable t => [t ()]
-allDepthFirst = unfold_
-
--- | Generate all the values upto a given depth, depth-first.
-allToDepth :: Unfoldable t => Int -> [t ()]
-allToDepth d = limitDepth d unfold_
-
--- | Generate all the values breadth-first.
-allBreadthFirst :: Unfoldable t => [t ()]
-allBreadthFirst = unfoldBF_
-
--- | Generate a random value, can be used as default instance for 'R.Random'.
-randomDefault :: (R.Random a, R.RandomGen g, Unfoldable t) => g -> (t a, g)
-randomDefault = runState . getRandom . unfold . Random . state $ R.random
-
--- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'.
-arbitraryDefault :: (Arbitrary a, Unfoldable t) => Gen (t a)
-arbitraryDefault = MkGen $ \r n -> let Arb _ f = unfold arbUnit in 
-  fromMaybe (error "Failed to generate a value.") (f r (n + 1))
-
-instance Unfoldable [] where
-  unfold fa = choose 
-    [ pure []
-    , (:) <$> fa <*> unfold fa
-    ]
-
-instance Unfoldable Maybe where
-  unfold fa = choose 
-    [ pure Nothing
-    , Just <$> fa
-    ]
-
-instance (Bounded a, Enum a) => Unfoldable (Either a) where
-  unfold fa = choose 
-    [ Left <$> boundedEnum
-    , Right <$> fa
-    ]
-
-instance (Bounded a, Enum a) => Unfoldable ((,) a) where
-  unfold fa = choose 
-    [ (,) <$> boundedEnum <*> fa ]
-
-instance Unfoldable Identity where
-  unfold fa = choose 
-    [ Identity <$> fa ]
-
-instance (Bounded a, Enum a) => Unfoldable (Constant a) where
-  unfold _ = choose 
-    [ Constant <$> boundedEnum ]
-  
-instance (Unfoldable p, Unfoldable q) => Unfoldable (Product p q) where
-  unfold fa = choose
-    [ Pair <$> unfold fa <*> unfold fa ]
-
-instance (Unfoldable p, Unfoldable q) => Unfoldable (Compose p q) where
-  unfold fa = choose
-    [ Compose <$> unfold (unfold fa) ]
-
-instance Unfoldable f => Unfoldable (Reverse f) where
-  unfold fa = choose
+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Unfoldable+-- Copyright   :  (c) Sjoerd Visscher 2012+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  sjoerd@w3future.com+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Class of data structures that can be unfolded.+-----------------------------------------------------------------------------+module Data.Unfoldable +  (+  +  -- * Unfoldable+    Unfoldable(..)+  , unfold_+  , unfoldBF+  , unfoldBF_+  +  -- ** Specific unfolds+  , unfoldr+  , fromList+  , leftMost+  , rightMost+  , allDepthFirst+  , allToDepth+  , allBreadthFirst+  , randomDefault+  , arbitraryDefault+  +  ) +  where+    +import Control.Applicative+import Data.Unfolder+import Data.Functor.Compose+import Data.Functor.Constant+import Data.Functor.Identity+import Data.Functor.Product+import Data.Functor.Reverse+import Control.Monad.Trans.State+import qualified System.Random as R+import Test.QuickCheck.Arbitrary (Arbitrary(..))+import Test.QuickCheck.Gen (Gen(..))+import Data.Maybe++-- | Data structures that can be unfolded.+--+-- For example, given a data type+--+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)+--+-- a suitable instance would be+--+-- > instance Unfoldable Tree where+-- >   unfold fa = choose+-- >     [ pure Empty+-- >     , Leaf <$> fa+-- >     , Node <$> unfold fa <*> fa <*> unfold fa+-- >     ]+--+-- i.e. it follows closely the instance for 'Traversable', but instead of matching on an input value,+-- we 'choose' from a list of all cases.+class Unfoldable t where+  -- | Given a way to generate elements, return a way to generate structures containing those elements.+  unfold :: Unfolder f => f a -> f (t a)++-- | Unfold the structure, always using @()@ as elements.+unfold_ :: (Unfoldable t, Unfolder f) => f (t ())+unfold_ = unfold (pure ())++-- | Breadth-first unfold, which orders the result by the number of 'choose' calls.+unfoldBF :: (Unfoldable t, Unfolder f) => f a -> f (t a)+unfoldBF = ala bfs unfold++-- | Unfold the structure breadth-first, always using @()@ as elements.+unfoldBF_ :: (Unfoldable t, Unfolder f) => f (t ())+unfoldBF_ = bfs unfold_++-- | @unfoldr@ builds a data structure from a seed value. It can be specified as:+-- +-- > unfoldr f z == fromList (Data.List.unfoldr f z)+unfoldr :: Unfoldable t => (b -> Maybe (a, b)) -> b -> Maybe (t a)+unfoldr f z = terminate . flip runStateT z . unfoldBF . StateT $ maybeToList . f+  where+    terminate [] = Nothing+    terminate ((t, b):ts) = if isNothing (f b) then Just t else terminate ts++-- | Create a data structure using the list as input.+-- This can fail because there might not be a data structure with the same number+-- of element positions as the number of elements in the list.+fromList :: Unfoldable t => [a] -> Maybe (t a)+fromList = unfoldr uncons+  where+    uncons [] = Nothing+    uncons (a:as) = Just (a, as)++-- | Always choose the first constructor.+leftMost :: Unfoldable t => Maybe (t ())+leftMost = unfold_++-- | Always choose the last constructor.+rightMost :: Unfoldable t => Maybe (t ())+rightMost = getDualA unfold_++-- | Generate all the values depth-first.+allDepthFirst :: Unfoldable t => [t ()]+allDepthFirst = unfold_++-- | Generate all the values upto a given depth, depth-first.+allToDepth :: Unfoldable t => Int -> [t ()]+allToDepth d = limitDepth d unfold_++-- | Generate all the values breadth-first.+allBreadthFirst :: Unfoldable t => [t ()]+allBreadthFirst = unfoldBF_++-- | Generate a random value, can be used as default instance for 'R.Random'.+randomDefault :: (R.Random a, R.RandomGen g, Unfoldable t) => g -> (t a, g)+randomDefault = runState . getRandom . unfold . Random . state $ R.random++-- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'.+arbitraryDefault :: (Arbitrary a, Unfoldable t) => Gen (t a)+arbitraryDefault = MkGen $ \r n -> let Arb _ f = unfold arbUnit in +  fromMaybe (error "Failed to generate a value.") (f r (n + 1))++instance Unfoldable [] where+  unfold fa = choose +    [ pure []+    , (:) <$> fa <*> unfold fa+    ]++instance Unfoldable Maybe where+  unfold fa = choose +    [ pure Nothing+    , Just <$> fa+    ]++instance (Bounded a, Enum a) => Unfoldable (Either a) where+  unfold fa = choose +    [ Left <$> boundedEnum+    , Right <$> fa+    ]++instance (Bounded a, Enum a) => Unfoldable ((,) a) where+  unfold fa = choose +    [ (,) <$> boundedEnum <*> fa ]++instance Unfoldable Identity where+  unfold fa = choose +    [ Identity <$> fa ]++instance (Bounded a, Enum a) => Unfoldable (Constant a) where+  unfold _ = choose +    [ Constant <$> boundedEnum ]+  +instance (Unfoldable p, Unfoldable q) => Unfoldable (Product p q) where+  unfold fa = choose+    [ Pair <$> unfold fa <*> unfold fa ]++instance (Unfoldable p, Unfoldable q) => Unfoldable (Compose p q) where+  unfold fa = choose+    [ Compose <$> unfold (unfold fa) ]++instance Unfoldable f => Unfoldable (Reverse f) where+  unfold fa = choose     [ Reverse <$> getDualA (unfold (DualA fa)) ]

src/Data/Unfolder.hs view

@@ -1,345 +1,345 @@------------------------------------------------------------------------------
--- |
--- Module      :  Data.Unfolder
--- Copyright   :  (c) Sjoerd Visscher 2012
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  sjoerd@w3future.com
--- Stability   :  experimental
--- Portability :  non-portable
---
--- Unfolders provide a way to unfold data structures.
--- They are basically 'Alternative' instances, but the 'choose' method
--- allows the unfolder to do something special for the recursive positions
--- of the data structure.
------------------------------------------------------------------------------
-{-# LANGUAGE 
-    ScopedTypeVariables
-  , GeneralizedNewtypeDeriving
-  , RankNTypes
-  #-}
-module Data.Unfolder 
-  (
-  
-  -- * Unfolder
-    Unfolder(..)
-  , chooseMonadDefault
-  
-  , boundedEnum
-  
-  -- ** Unfolder instances
-  , Random(..)
-
-  , Arb(..)
-  , arbUnit
-  
-  , NumConst(..)
-  
-  -- * UnfolderTransformer
-  , UnfolderTransformer(..)
-  , ala
-  , ala2
-  , ala3
-  
-  -- ** UnfolderTransformer instances
-  , DualA(..)
-
-  , NT(..)
-  , WithRec(..)
-  , withRec
-  , limitDepth
-  
-  , BFS(..)
-  , bfs
-  ) 
-  where 
-
-import Control.Applicative
-import Control.Monad
-import Control.Arrow (ArrowZero, ArrowPlus)
-
-import Data.Functor.Product
-import Data.Functor.Compose
-import Data.Functor.Reverse
-import Control.Applicative.Backwards
-import Control.Applicative.Lift
-import Control.Monad.Trans.Error
-import Control.Monad.Trans.List
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.RWS
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans.State
-import Control.Monad.Trans.Writer
-
-import qualified System.Random as R
-import Test.QuickCheck.Arbitrary (Arbitrary(..))
-import Test.QuickCheck.Gen (Gen(..))
-
-import Data.Monoid (Monoid(..))
-import Data.Maybe (catMaybes, listToMaybe)
-import Data.Foldable (asum)
-import Data.Traversable (traverse)
-
--- | Unfolders provide a way to unfold data structures.
--- The methods have default implementations in terms of 'Alternative',
--- but you can implement 'choose' to act on recursive positions of the
--- data structure, or simply to provide a faster implementation than 'asum'.
-class Alternative f => Unfolder f where
-  -- | Choose one of the values from the list.
-  choose :: [f x] -> f x
-  choose = asum
-  -- | Given a number 'n', return a number between '0' and 'n - 1'.
-  chooseInt :: Int -> f Int
-  chooseInt n = choose $ map pure [0 .. n - 1]
-
--- | If an unfolder is monadic, 'choose' can be implemented in terms of 'chooseInt'.
-chooseMonadDefault :: (Monad m, Unfolder m) => [m x] -> m x
-chooseMonadDefault ms = chooseInt (length ms) >>= (ms !!)
-
--- | If a datatype is bounded and enumerable, we can use 'chooseInt' to generate a value.
--- This is the function to use if you want to unfold a datatype that has no type arguments (has kind *).
-boundedEnum :: forall f a. (Unfolder f, Bounded a, Enum a) => f a
-boundedEnum = (\x -> toEnum (x + lb)) <$> chooseInt (1 + ub - lb)
-  where
-    lb = fromEnum (minBound :: a)
-    ub = fromEnum (maxBound :: a)
-
--- | Derived instance.
-instance MonadPlus m => Unfolder (WrappedMonad m)
-
--- | Derived instance.
-instance (ArrowZero a, ArrowPlus a) => Unfolder (WrappedArrow a b)
-
--- | Don't choose but return all items.
-instance Unfolder [] where
-  choose = concat
-  chooseInt n = [0 .. n - 1]
-
--- | Always choose the first item.
-instance Unfolder Maybe where
-  choose [] = Nothing
-  choose ms = head ms
-  chooseInt 0 = Nothing
-  chooseInt _ = Just 0
-
--- | Derived instance.
-instance (Unfolder p, Unfolder q) => Unfolder (Product p q) where
-  choose ps = Pair (choose $ map fstP ps) (choose $ map sndP ps)
-    where
-      fstP (Pair p _) = p
-      sndP (Pair _ q) = q
-  chooseInt n = Pair (chooseInt n) (chooseInt n)
-
--- | Derived instance.
-instance (Unfolder p, Applicative q) => Unfolder (Compose p q) where
-  choose = Compose . choose . map getCompose
-  chooseInt n = Compose $ pure <$> chooseInt n
-
--- | Derived instance.
-instance Unfolder f => Unfolder (Reverse f) where
-  choose = Reverse . choose . map getReverse
-  chooseInt n = Reverse $ chooseInt n
-
--- | Derived instance.
-instance Unfolder f => Unfolder (Backwards f) where
-  choose = Backwards . choose . map forwards
-  chooseInt n = Backwards $ chooseInt n
-
--- | Derived instance.
-instance Unfolder f => Unfolder (Lift f)
-
--- | Derived instance.
-instance (Functor m, Monad m, Error e) => Unfolder (ErrorT e m)
-
--- | Derived instance.
-instance Applicative f => Unfolder (ListT f) where
-  choose ms = ListT $ concat <$> traverse runListT ms
-  chooseInt n = ListT $ pure [0 .. n - 1]
-
--- | Derived instance.
-instance (Functor m, Monad m) => Unfolder (MaybeT m) where
-  choose ms = MaybeT $ listToMaybe . catMaybes <$> mapM runMaybeT ms
-  chooseInt 0 = MaybeT $ return Nothing
-  chooseInt _ = MaybeT $ return (Just 0)
-  
--- | Derived instance.
-instance (Monoid w, MonadPlus m, Unfolder m) => Unfolder (RWST r w s m) where
-  choose ms = RWST $ \r s -> choose $ map (\m -> runRWST m r s) ms
-
--- | Derived instance.
-instance (MonadPlus m, Unfolder m) => Unfolder (StateT s m) where
-  choose ms = StateT $ \s -> choose $ map (`runStateT` s) ms
-
--- | Derived instance.
-instance Unfolder m => Unfolder (ReaderT r m) where
-  choose ms = ReaderT $ \r -> choose $ map (`runReaderT` r) ms
-  
--- | Derived instance.
-instance (Monoid w, Unfolder m) => Unfolder (WriterT w m) where
-  choose = WriterT . choose . map runWriterT
-
-
-
-newtype Random g m a = Random { getRandom :: StateT g m a } 
-  deriving (Functor, Applicative, Monad)
-instance (Functor m, Monad m, R.RandomGen g) => Alternative (Random g m) where
-  empty = choose []
-  a <|> b = choose [a, b]
-instance (Functor m, Monad m, R.RandomGen g) => MonadPlus (Random g m) where
-  mzero = choose []
-  mplus a b = choose [a, b]
--- | Choose randomly.
-instance (Functor m, Monad m, R.RandomGen g) => Unfolder (Random g m) where
-  choose = chooseMonadDefault
-  chooseInt 0 = Random . StateT $ const (fail "Random chooseInt 0")
-  chooseInt n = Random . StateT $ return . R.randomR (0, n - 1)
-
-
--- | An 'UnfolderTransformer' changes the way an 'Unfolder' unfolds. 
-class UnfolderTransformer t where
-  -- | Lift a computation from the argument unfolder to the constructed unfolder.
-  lift :: Unfolder f => f a -> t f a
-
--- | Run an unfolding function with one argument using an 'UnfolderTransformer', given a way to run the transformer.
-ala :: (UnfolderTransformer t, Unfolder f) => (t f b -> f b) -> (t f a -> t f b) -> f a -> f b
-ala lower f = lower . f . lift
-
--- | Run an unfolding function with two arguments using an 'UnfolderTransformer', given a way to run the transformer.
-ala2 :: (UnfolderTransformer t, Unfolder f) => (t f c -> f c) -> (t f a -> t f b -> t f c) -> f a -> f b -> f c
-ala2 lower f = ala lower . f . lift
-
--- | Run an unfolding function with three arguments using an 'UnfolderTransformer', given a way to run the transformer.
-ala3 :: (UnfolderTransformer t, Unfolder f) => (t f d -> f d) -> (t f a -> t f b -> t f c -> t f d) -> f a -> f b -> f c -> f d
-ala3 lower f = ala2 lower . f . lift
-
-
--- | 'DualA' flips the @\<|>@ operator from `Alternative`.
-newtype DualA f a = DualA { getDualA :: f a }
-  deriving (Eq, Show, Functor, Applicative)
-
-instance Alternative f => Alternative (DualA f) where
-  empty = DualA empty
-  DualA a <|> DualA b = DualA (b <|> a)
-
--- | Reverse the list passed to choose.
-instance Unfolder f => Unfolder (DualA f) where
-  choose = DualA . choose . reverse . map getDualA
-  chooseInt n = DualA $ (\x -> n - 1 - x) <$> chooseInt n
-
-instance UnfolderTransformer DualA where
-  lift = DualA
-
-
--- | Natural transformations
-data NT f g = NT { getNT :: forall a. f a -> g a }
-
-newtype WithRec f a = WithRec { getWithRec :: ReaderT (Int -> NT f f) f a }
-  deriving (Functor, Applicative, Alternative)
-
--- | Applies a certain function depending on the depth at every recursive position.
-instance Unfolder f => Unfolder (WithRec f) where
-  choose ms = WithRec . ReaderT $ \f -> 
-    getNT (f 0) $ choose (map (\(WithRec (ReaderT m)) -> m (f . succ)) ms)
-
-instance UnfolderTransformer WithRec where
-  lift = WithRec . ReaderT . const
-
--- | Apply a certain function of type @f a -> f a@ to the result of a 'choose'.
--- The depth is passed as 'Int', so you can apply a different function at each depth.
--- Because of a @forall@, the function needs to be wrapped in a 'NT' constructor.
--- See 'limitDepth' for an example how to use this function.
-withRec :: (Int -> NT f f) -> WithRec f a -> f a
-withRec f = (`runReaderT` f) . getWithRec
-
--- | Limit the depth of an unfolding.
-limitDepth :: Unfolder f => Int -> WithRec f a -> f a
-limitDepth m = withRec (\d -> NT $ if d == m then const empty else id)
-
-
-
--- | Return a generator of values of a given depth.
--- Returns 'Nothing' if there are no values of that depth or deeper.
--- The depth is the number of 'choose' calls.
-newtype BFS f x = BFS { getBFS :: Int -> Maybe [f x] }
-
-instance Functor f => Functor (BFS f) where 
-  fmap f = BFS . (fmap (map (fmap f)) .) . getBFS
-
-instance Applicative f => Applicative (BFS f) where
-  pure = packBFS . pure
-  BFS ff <*> BFS fx = BFS $ \d -> flattenBFS $
-    [ liftA2 (liftA2 (<*>)) (ff i) (fx d) | i <- [0 .. d - 1] ] ++
-    [ liftA2 (liftA2 (<*>)) (ff d) (fx i) | i <- [0 .. d] ]
-
-instance Applicative f => Alternative (BFS f) where
-  empty = BFS $ \d -> if d == 0 then Just [] else Nothing
-  BFS fa <|> BFS fb = BFS $ \d -> flattenBFS [fa d, fb d]
-  
--- | Choose between values of a given depth only.
-instance Applicative f => Unfolder (BFS f) where
-  choose ms = BFS $ \d -> if d == 0 then Just [] else flattenBFS (map (`getBFS` (d - 1)) ms)
-
-instance UnfolderTransformer BFS where
-  lift = packBFS
-
--- | Change the order of unfolding to be breadth-first.
-bfs :: Unfolder f => BFS f x -> f x
-bfs (BFS f) = choose (loop 0) where loop d = maybe [] (++ loop (d + 1)) (f d)
-
-packBFS :: f x -> BFS f x
-packBFS r = BFS $ \d -> if d == 0 then Just [r] else Nothing
-
-flattenBFS :: [Maybe [a]] -> Maybe [a]
-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 (R.StdGen -> Int -> Maybe a)
-
-instance Functor Arb where
-  fmap f (Arb i g) = Arb i $ fmap (fmap (fmap f)) g
-
-instance Applicative Arb where
-  pure = Arb 0 . pure . pure . pure
-  Arb i1 ff <*> Arb i2 fx = Arb (i1 + i2) $
-    \r -> let (r1, r2) = R.split r in liftA2 (<*>) (ff r1) (fx r2)
-
-instance Alternative Arb where
-  empty = Arb 0 (\_ _ -> Nothing)
-  Arb ia fa <|> Arb ib fb = Arb ((ia + ib + 1) `div` 2) $
-    \r n -> let (r1, r2) = R.split r in flattenArb r1 [fa r2 n, fb r2 n]
-
--- | Limit the depth of the generated data structure by 
--- dividing the given size by the number of recursive positions.
-instance Unfolder Arb where
-  choose ms = Arb 1 g
-    where
-      g _ 0 = Nothing
-      g r n = let (r1, r2) = R.split r in 
-        flattenArb r1 $ map (\(Arb i f) -> f r2 (n `div` max i 1)) ms
-
-flattenArb :: R.StdGen -> [Maybe a] -> Maybe a
-flattenArb r ms = case catMaybes ms of
-  [] -> Nothing
-  ms' -> Just $ ms' !! fst (R.randomR (0, length ms' - 1) r)
-
-arbUnit :: Arbitrary a => Arb a
-arbUnit = Arb 0 (\r n -> Just $ unGen arbitrary r n)
-
--- | 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) where
-  choose [] = empty
-  choose as = foldr1 (<|>) as
+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Unfolder+-- Copyright   :  (c) Sjoerd Visscher 2012+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  sjoerd@w3future.com+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Unfolders provide a way to unfold data structures.+-- They are basically 'Alternative' instances, but the 'choose' method+-- allows the unfolder to do something special for the recursive positions+-- of the data structure.+-----------------------------------------------------------------------------+{-# LANGUAGE +    ScopedTypeVariables+  , GeneralizedNewtypeDeriving+  , RankNTypes+  #-}+module Data.Unfolder +  (+  +  -- * Unfolder+    Unfolder(..)+  , chooseMonadDefault+  +  , boundedEnum+  +  -- ** Unfolder instances+  , Random(..)++  , Arb(..)+  , arbUnit+  +  , NumConst(..)+  +  -- * UnfolderTransformer+  , UnfolderTransformer(..)+  , ala+  , ala2+  , ala3+  +  -- ** UnfolderTransformer instances+  , DualA(..)++  , NT(..)+  , WithRec(..)+  , withRec+  , limitDepth+  +  , BFS(..)+  , bfs+  ) +  where ++import Control.Applicative+import Control.Monad+import Control.Arrow (ArrowZero, ArrowPlus)++import Data.Functor.Product+import Data.Functor.Compose+import Data.Functor.Reverse+import Control.Applicative.Backwards+import Control.Applicative.Lift+import Control.Monad.Trans.Error+import Control.Monad.Trans.List+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.RWS+import Control.Monad.Trans.Reader+import Control.Monad.Trans.State+import Control.Monad.Trans.Writer++import qualified System.Random as R+import Test.QuickCheck.Arbitrary (Arbitrary(..))+import Test.QuickCheck.Gen (Gen(..))++import Data.Monoid (Monoid(..))+import Data.Maybe (catMaybes, listToMaybe)+import Data.Foldable (asum)+import Data.Traversable (traverse)++-- | Unfolders provide a way to unfold data structures.+-- The methods have default implementations in terms of 'Alternative',+-- but you can implement 'choose' to act on recursive positions of the+-- data structure, or simply to provide a faster implementation than 'asum'.+class Alternative f => Unfolder f where+  -- | Choose one of the values from the list.+  choose :: [f x] -> f x+  choose = asum+  -- | Given a number 'n', return a number between '0' and 'n - 1'.+  chooseInt :: Int -> f Int+  chooseInt n = choose $ map pure [0 .. n - 1]++-- | If an unfolder is monadic, 'choose' can be implemented in terms of 'chooseInt'.+chooseMonadDefault :: (Monad m, Unfolder m) => [m x] -> m x+chooseMonadDefault ms = chooseInt (length ms) >>= (ms !!)++-- | If a datatype is bounded and enumerable, we can use 'chooseInt' to generate a value.+-- This is the function to use if you want to unfold a datatype that has no type arguments (has kind *).+boundedEnum :: forall f a. (Unfolder f, Bounded a, Enum a) => f a+boundedEnum = (\x -> toEnum (x + lb)) <$> chooseInt (1 + ub - lb)+  where+    lb = fromEnum (minBound :: a)+    ub = fromEnum (maxBound :: a)++-- | Derived instance.+instance MonadPlus m => Unfolder (WrappedMonad m)++-- | Derived instance.+instance (ArrowZero a, ArrowPlus a) => Unfolder (WrappedArrow a b)++-- | Don't choose but return all items.+instance Unfolder [] where+  choose = concat+  chooseInt n = [0 .. n - 1]++-- | Always choose the first item.+instance Unfolder Maybe where+  choose [] = Nothing+  choose ms = head ms+  chooseInt 0 = Nothing+  chooseInt _ = Just 0++-- | Derived instance.+instance (Unfolder p, Unfolder q) => Unfolder (Product p q) where+  choose ps = Pair (choose $ map fstP ps) (choose $ map sndP ps)+    where+      fstP (Pair p _) = p+      sndP (Pair _ q) = q+  chooseInt n = Pair (chooseInt n) (chooseInt n)++-- | Derived instance.+instance (Unfolder p, Applicative q) => Unfolder (Compose p q) where+  choose = Compose . choose . map getCompose+  chooseInt n = Compose $ pure <$> chooseInt n++-- | Derived instance.+instance Unfolder f => Unfolder (Reverse f) where+  choose = Reverse . choose . map getReverse+  chooseInt n = Reverse $ chooseInt n++-- | Derived instance.+instance Unfolder f => Unfolder (Backwards f) where+  choose = Backwards . choose . map forwards+  chooseInt n = Backwards $ chooseInt n++-- | Derived instance.+instance Unfolder f => Unfolder (Lift f)++-- | Derived instance.+instance (Functor m, Monad m, Error e) => Unfolder (ErrorT e m)++-- | Derived instance.+instance Applicative f => Unfolder (ListT f) where+  choose ms = ListT $ concat <$> traverse runListT ms+  chooseInt n = ListT $ pure [0 .. n - 1]++-- | Derived instance.+instance (Functor m, Monad m) => Unfolder (MaybeT m) where+  choose ms = MaybeT $ listToMaybe . catMaybes <$> mapM runMaybeT ms+  chooseInt 0 = MaybeT $ return Nothing+  chooseInt _ = MaybeT $ return (Just 0)+  +-- | Derived instance.+instance (Monoid w, MonadPlus m, Unfolder m) => Unfolder (RWST r w s m) where+  choose ms = RWST $ \r s -> choose $ map (\m -> runRWST m r s) ms++-- | Derived instance.+instance (MonadPlus m, Unfolder m) => Unfolder (StateT s m) where+  choose ms = StateT $ \s -> choose $ map (`runStateT` s) ms++-- | Derived instance.+instance Unfolder m => Unfolder (ReaderT r m) where+  choose ms = ReaderT $ \r -> choose $ map (`runReaderT` r) ms+  +-- | Derived instance.+instance (Monoid w, Unfolder m) => Unfolder (WriterT w m) where+  choose = WriterT . choose . map runWriterT++++newtype Random g m a = Random { getRandom :: StateT g m a } +  deriving (Functor, Applicative, Monad)+instance (Functor m, Monad m, R.RandomGen g) => Alternative (Random g m) where+  empty = choose []+  a <|> b = choose [a, b]+instance (Functor m, Monad m, R.RandomGen g) => MonadPlus (Random g m) where+  mzero = choose []+  mplus a b = choose [a, b]+-- | Choose randomly.+instance (Functor m, Monad m, R.RandomGen g) => Unfolder (Random g m) where+  choose = chooseMonadDefault+  chooseInt 0 = Random . StateT $ const (fail "Random chooseInt 0")+  chooseInt n = Random . StateT $ return . R.randomR (0, n - 1)+++-- | An 'UnfolderTransformer' changes the way an 'Unfolder' unfolds. +class UnfolderTransformer t where+  -- | Lift a computation from the argument unfolder to the constructed unfolder.+  lift :: Unfolder f => f a -> t f a++-- | Run an unfolding function with one argument using an 'UnfolderTransformer', given a way to run the transformer.+ala :: (UnfolderTransformer t, Unfolder f) => (t f b -> f b) -> (t f a -> t f b) -> f a -> f b+ala lower f = lower . f . lift++-- | Run an unfolding function with two arguments using an 'UnfolderTransformer', given a way to run the transformer.+ala2 :: (UnfolderTransformer t, Unfolder f) => (t f c -> f c) -> (t f a -> t f b -> t f c) -> f a -> f b -> f c+ala2 lower f = ala lower . f . lift++-- | Run an unfolding function with three arguments using an 'UnfolderTransformer', given a way to run the transformer.+ala3 :: (UnfolderTransformer t, Unfolder f) => (t f d -> f d) -> (t f a -> t f b -> t f c -> t f d) -> f a -> f b -> f c -> f d+ala3 lower f = ala2 lower . f . lift+++-- | 'DualA' flips the @\<|>@ operator from `Alternative`.+newtype DualA f a = DualA { getDualA :: f a }+  deriving (Eq, Show, Functor, Applicative)++instance Alternative f => Alternative (DualA f) where+  empty = DualA empty+  DualA a <|> DualA b = DualA (b <|> a)++-- | Reverse the list passed to choose.+instance Unfolder f => Unfolder (DualA f) where+  choose = DualA . choose . reverse . map getDualA+  chooseInt n = DualA $ (\x -> n - 1 - x) <$> chooseInt n++instance UnfolderTransformer DualA where+  lift = DualA+++-- | Natural transformations+data NT f g = NT { getNT :: forall a. f a -> g a }++newtype WithRec f a = WithRec { getWithRec :: ReaderT (Int -> NT f f) f a }+  deriving (Functor, Applicative, Alternative)++-- | Applies a certain function depending on the depth at every recursive position.+instance Unfolder f => Unfolder (WithRec f) where+  choose ms = WithRec . ReaderT $ \f -> +    getNT (f 0) $ choose (map (\(WithRec (ReaderT m)) -> m (f . succ)) ms)++instance UnfolderTransformer WithRec where+  lift = WithRec . ReaderT . const++-- | Apply a certain function of type @f a -> f a@ to the result of a 'choose'.+-- The depth is passed as 'Int', so you can apply a different function at each depth.+-- Because of a @forall@, the function needs to be wrapped in a 'NT' constructor.+-- See 'limitDepth' for an example how to use this function.+withRec :: (Int -> NT f f) -> WithRec f a -> f a+withRec f = (`runReaderT` f) . getWithRec++-- | Limit the depth of an unfolding.+limitDepth :: Unfolder f => Int -> WithRec f a -> f a+limitDepth m = withRec (\d -> NT $ if d == m then const empty else id)++++-- | Return a generator of values of a given depth.+-- Returns 'Nothing' if there are no values of that depth or deeper.+-- The depth is the number of 'choose' calls.+newtype BFS f x = BFS { getBFS :: Int -> Maybe [f x] }++instance Functor f => Functor (BFS f) where +  fmap f = BFS . (fmap (map (fmap f)) .) . getBFS++instance Applicative f => Applicative (BFS f) where+  pure = packBFS . pure+  BFS ff <*> BFS fx = BFS $ \d -> flattenBFS $+    [ liftA2 (liftA2 (<*>)) (ff i) (fx d) | i <- [0 .. d - 1] ] +++    [ liftA2 (liftA2 (<*>)) (ff d) (fx i) | i <- [0 .. d] ]++instance Applicative f => Alternative (BFS f) where+  empty = BFS $ \d -> if d == 0 then Just [] else Nothing+  BFS fa <|> BFS fb = BFS $ \d -> flattenBFS [fa d, fb d]+  +-- | Choose between values of a given depth only.+instance Applicative f => Unfolder (BFS f) where+  choose ms = BFS $ \d -> if d == 0 then Just [] else flattenBFS (map (`getBFS` (d - 1)) ms)++instance UnfolderTransformer BFS where+  lift = packBFS++-- | Change the order of unfolding to be breadth-first.+bfs :: Unfolder f => BFS f x -> f x+bfs (BFS f) = choose (loop 0) where loop d = maybe [] (++ loop (d + 1)) (f d)++packBFS :: f x -> BFS f x+packBFS r = BFS $ \d -> if d == 0 then Just [r] else Nothing++flattenBFS :: [Maybe [a]] -> Maybe [a]+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 (R.StdGen -> Int -> Maybe a)++instance Functor Arb where+  fmap f (Arb i g) = Arb i $ fmap (fmap (fmap f)) g++instance Applicative Arb where+  pure = Arb 0 . pure . pure . pure+  Arb i1 ff <*> Arb i2 fx = Arb (i1 + i2) $+    \r -> let (r1, r2) = R.split r in liftA2 (<*>) (ff r1) (fx r2)++instance Alternative Arb where+  empty = Arb 0 (\_ _ -> Nothing)+  Arb ia fa <|> Arb ib fb = Arb ((ia + ib + 1) `div` 2) $+    \r n -> let (r1, r2) = R.split r in flattenArb r1 [fa r2 n, fb r2 n]++-- | Limit the depth of the generated data structure by +-- dividing the given size by the number of recursive positions.+instance Unfolder Arb where+  choose ms = Arb 1 g+    where+      g _ 0 = Nothing+      g r n = let (r1, r2) = R.split r in +        flattenArb r1 $ map (\(Arb i f) -> f r2 (n `div` max i 1)) ms++flattenArb :: R.StdGen -> [Maybe a] -> Maybe a+flattenArb r ms = case catMaybes ms of+  [] -> Nothing+  ms' -> Just $ ms' !! fst (R.randomR (0, length ms' - 1) r)++arbUnit :: Arbitrary a => Arb a+arbUnit = Arb 0 (\r n -> Just $ unGen arbitrary r n)++-- | 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) where+  choose [] = empty+  choose as = foldr1 (<|>) as

unfoldable.cabal view

@@ -1,45 +1,45 @@-Name:                 unfoldable
-Version:              0.6.0.1
-Synopsis:             Class of data structures that can be unfolded.
-Description:          Just as there's a Foldable class, there should also be an Unfoldable class. 
-                      .
-                      This package provides one. Example unfolds are:
-                      .
-                      * Random values
-                      .
-                      * Enumeration of all values (depth-first or breadth-first)
-                      .
-                      * Convert from a list
-                      .
-                      Some examples can be found in the examples directory.
-Homepage:             https://github.com/sjoerdvisscher/unfoldable
-Bug-reports:          https://github.com/sjoerdvisscher/unfoldable/issues
-License:              BSD3
-License-file:         LICENSE
-Author:               Sjoerd Visscher
-Maintainer:           sjoerd@w3future.com
-Category:             Generics
-Build-type:           Simple
-Cabal-version:        >= 1.6
-
-Extra-Source-Files:
-  examples/*.hs
-
-Library
-  HS-Source-Dirs:  src
-  
-  Exposed-modules:
-    Data.Unfolder
-    Data.Unfoldable
-    Data.Biunfoldable
-    Data.Triunfoldable
-  
-  Build-depends:
-      base         >= 4   && < 5 
-    , transformers >= 0.3 && < 0.4
-    , random       >= 1.0 && < 1.1
-    , QuickCheck   >= 2.4 && < 2.6
-
-source-repository head
-  type:     git
-  location: git://github.com/sjoerdvisscher/unfoldable.git
+Name:                 unfoldable+Version:              0.6.0.2+Synopsis:             Class of data structures that can be unfolded.+Description:          Just as there's a Foldable class, there should also be an Unfoldable class. +                      .+                      This package provides one. Example unfolds are:+                      .+                      * Random values+                      .+                      * Enumeration of all values (depth-first or breadth-first)+                      .+                      * Convert from a list+                      .+                      Some examples can be found in the examples directory.+Homepage:             https://github.com/sjoerdvisscher/unfoldable+Bug-reports:          https://github.com/sjoerdvisscher/unfoldable/issues+License:              BSD3+License-file:         LICENSE+Author:               Sjoerd Visscher+Maintainer:           sjoerd@w3future.com+Category:             Generics+Build-type:           Simple+Cabal-version:        >= 1.6++Extra-Source-Files:+  examples/*.hs+  src/Data/Triunfoldable.hs++Library+  HS-Source-Dirs:  src+  +  Exposed-modules:+    Data.Unfolder+    Data.Unfoldable+    Data.Biunfoldable+  +  Build-depends:+      base         >= 4   && < 5 +    , transformers >= 0.3 && < 0.4+    , random       >= 1.0 && < 1.1+    , QuickCheck   >= 2.4 && < 2.6++source-repository head+  type:     git+  location: git://github.com/sjoerdvisscher/unfoldable.git