module Data.Unfoldable
(
Unfoldable(..)
, unfold_
, unfoldBF
, unfoldBF_
, unfoldr
, fromList
, leftMost
, rightMost
, allDepthFirst
, 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
class Unfoldable t where
unfold :: Unfolder f => f a -> f (t a)
unfold_ :: (Unfoldable t, Unfolder f) => f (t ())
unfold_ = unfold (pure ())
unfoldBF :: (Unfoldable t, Unfolder f) => f a -> f (t a)
unfoldBF = runBFS . unfold . packBFS
unfoldBF_ :: (Unfoldable t, Unfolder f) => f (t ())
unfoldBF_ = unfoldBF (pure ())
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
fromList :: Unfoldable t => [a] -> Maybe (t a)
fromList = unfoldr uncons
where
uncons [] = Nothing
uncons (a:as) = Just (a, as)
leftMost :: Unfoldable t => Maybe (t ())
leftMost = unfold_
rightMost :: Unfoldable t => Maybe (t ())
rightMost = getDualA unfold_
allDepthFirst :: Unfoldable t => [t ()]
allDepthFirst = unfold_
allBreadthFirst :: Unfoldable t => [t ()]
allBreadthFirst = unfoldBF_
randomDefault :: (R.Random a, R.RandomGen g, Unfoldable t) => g -> (t a, g)
randomDefault = runState . getRandom . unfold . Random . state $ R.random
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 f = choose
[ pure []
, (:) <$> f <*> unfold f
]
instance Unfoldable Maybe where
unfold f = choose
[ pure Nothing
, Just <$> f
]
instance (Bounded a, Enum a) => Unfoldable (Either a) where
unfold f = choose
[ Left <$> boundedEnum
, Right <$> f
]
instance (Bounded a, Enum a) => Unfoldable ((,) a) where
unfold f = (,) <$> boundedEnum <*> f
instance Unfoldable Identity where
unfold = fmap Identity
instance (Bounded a, Enum a) => Unfoldable (Constant a) where
unfold = fmap Constant . const boundedEnum
instance (Unfoldable p, Unfoldable q) => Unfoldable (Product p q) where
unfold f = Pair <$> unfold f <*> unfold f
instance (Unfoldable p, Unfoldable q) => Unfoldable (Compose p q) where
unfold = fmap Compose . unfold . unfold
instance Unfoldable f => Unfoldable (Reverse f) where
unfold = fmap Reverse . getDualA . unfold . DualA