module Data.Unfoldable (
Unfoldable(..)
, unfold
, leftMost
, rightMost
, spread
, to
) where
import Control.Applicative
import Control.Monad.Trans.State
import Data.Splittable
import Data.Monoid (Dual(..))
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Identity
import Data.Functor.Product
import Data.Functor.Reverse
class Unfoldable f where
unfoldMap :: Splittable s => (s -> a) -> s -> f a
unfold :: (Unfoldable f, Splittable s) => s -> f s
unfold = unfoldMap id
leftMost :: Unfoldable f => f ()
leftMost = unfoldMap (const ()) L
rightMost :: Unfoldable f => f ()
rightMost = unfoldMap (const ()) R
spread :: Splittable s => State ([s], Int) a -> s -> a
spread f s = let (a, (_, i)) = runState f (split i s, 0) in a
to :: (s -> a) -> State ([s], Int) a
to f = state $ \(ss, i) -> (f (head ss), (tail ss, i + 1))
instance Unfoldable [] where
unfoldMap f = go
where
go = choose [const [], spread $ (:) <$> to f <*> to go]
instance Unfoldable Maybe where
unfoldMap f = choose [const Nothing, Just . f]
instance (Bounded a, Enum a) => Unfoldable (Either a) where
unfoldMap f = choose [Left . boundedEnum, Right . f]
instance (Bounded a, Enum a) => Unfoldable ((,) a) where
unfoldMap f = spread $ (,) <$> to boundedEnum <*> to f
instance Unfoldable Identity where
unfoldMap f = Identity . f
instance (Bounded a, Enum a) => Unfoldable (Constant a) where
unfoldMap _ = Constant . boundedEnum
instance (Unfoldable p, Unfoldable q) => Unfoldable (Product p q) where
unfoldMap f = spread $ Pair <$> to (unfoldMap f) <*> to (unfoldMap f)
instance (Unfoldable p, Unfoldable q) => Unfoldable (Compose p q) where
unfoldMap f = Compose . unfoldMap (unfoldMap f)
instance Unfoldable f => Unfoldable (Reverse f) where
unfoldMap f = Reverse . unfoldMap (f . getDual) . Dual