Copyright | (c) Sjoerd Visscher 2014 |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | sjoerd@w3future.com |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Class of data structures that can be unfolded.
Synopsis
- class Unfoldable t where
- unfold_ :: (Unfoldable t, Unfolder f) => f (t ())
- unfoldBF :: (Unfoldable t, Unfolder f) => f a -> f (t a)
- unfoldBF_ :: (Unfoldable t, Unfolder f) => f (t ())
- unfoldr :: Unfoldable t => (b -> Maybe (a, b)) -> b -> Maybe (t a)
- fromList :: Unfoldable t => [a] -> Maybe (t a)
- leftMost :: Unfoldable t => Maybe (t ())
- rightMost :: Unfoldable t => Maybe (t ())
- allDepthFirst :: Unfoldable t => [t ()]
- allToDepth :: Unfoldable t => Int -> [t ()]
- allBreadthFirst :: Unfoldable t => [t ()]
- randomDefault :: (Random a, RandomGen g, Unfoldable t) => g -> (t a, g)
- arbitraryDefault :: (Arbitrary a, Unfoldable t) => Gen (t a)
Unfoldable
class Unfoldable t where Source #
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.
Instead of manually writing the Unfoldable
instance, you can add a deriving
Generic1
to your datatype and declare an Unfoldable
instance without giving a definition for unfold
.
For example the previous example can be simplified to just:
{-# LANGUAGE DeriveGeneric #-} import GHC.Generics data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) deriving Generic1 instance Unfoldable Tree
Nothing
unfold :: Unfolder f => f a -> f (t a) Source #
Given a way to generate elements, return a way to generate structures containing those elements.
default unfold :: (ADT1 t, Constraints1 t Unfoldable, Unfolder f) => f a -> f (t a) Source #
Instances
Unfoldable [] Source # | |
Defined in Data.Unfoldable | |
Unfoldable Maybe Source # | |
Unfoldable Identity Source # | |
Unfoldable Tree Source # | |
Unfoldable Seq Source # | |
(Bounded a, Enum a) => Unfoldable (Either a) Source # | |
(Bounded a, Enum a) => Unfoldable ((,) a) Source # | |
Defined in Data.Unfoldable | |
Unfoldable f => Unfoldable (Reverse f) Source # | |
(Bounded a, Enum a) => Unfoldable (Constant a :: Type -> Type) Source # | |
(Unfoldable p, Unfoldable q) => Unfoldable (Product p q) Source # | |
(Unfoldable p, Unfoldable q) => Unfoldable (Sum p q) Source # | |
(Unfoldable p, Unfoldable q) => Unfoldable (Compose p q) Source # | |
unfold_ :: (Unfoldable t, Unfolder f) => f (t ()) Source #
Unfold the structure, always using ()
as elements.
unfoldBF :: (Unfoldable t, Unfolder f) => f a -> f (t a) Source #
Breadth-first unfold, which orders the result by the number of choose
calls.
unfoldBF_ :: (Unfoldable t, Unfolder f) => f (t ()) Source #
Unfold the structure breadth-first, always using ()
as elements.
Specific unfolds
unfoldr :: Unfoldable t => (b -> Maybe (a, b)) -> b -> Maybe (t a) Source #
unfoldr
builds a data structure from a seed value. It can be specified as:
unfoldr f z == fromList (Data.List.unfoldr f z)
fromList :: Unfoldable t => [a] -> Maybe (t a) Source #
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.
leftMost :: Unfoldable t => Maybe (t ()) Source #
Always choose the first constructor.
rightMost :: Unfoldable t => Maybe (t ()) Source #
Always choose the last constructor.
allDepthFirst :: Unfoldable t => [t ()] Source #
Generate all the values depth-first.
allToDepth :: Unfoldable t => Int -> [t ()] Source #
Generate all the values upto a given depth, depth-first.
allBreadthFirst :: Unfoldable t => [t ()] Source #
Generate all the values breadth-first.
randomDefault :: (Random a, RandomGen g, Unfoldable t) => g -> (t a, g) Source #
Generate a random value, can be used as default instance for Random
.
arbitraryDefault :: (Arbitrary a, Unfoldable t) => Gen (t a) Source #
Provides a QuickCheck generator, can be used as default instance for Arbitrary
.