compactable-0.1.0.0: A generalization for containers that can be stripped of Nothings.

Safe HaskellNone
LanguageHaskell2010

Control.Compactable

Synopsis

Documentation

class Compactable f where Source #

This is a generalization of catMaybes as a new function compact. Compact has relations with Functor, Applicative, Monad, Alternative, and Traversable. In that we can use these class to provide the ability to operate on a data type by throwing away intermediate Nothings. This is useful for representing striping out values or failure.

To be compactable alone, no laws must be satisfied other than the type signature.

If the data type is also a Functor the following should hold:

Kleisli composition
fmapMaybe (l <=< r) = fmapMaybe l . fmapMaybe r
Functor identity 1
compact . fmap Just = id
Functor identity 2
fmapMaybe Just = id
Functor relation
compact = fmapMaybe id

According to Kmett, (Compactable f, Functor f) is a functor from the kleisli category of Maybe to the category of haskell data types. Kleisli Maybe -> Hask.

If the data type is also Applicative the following should hold:

Applicative left identity
compact . (pure Just *) = id
Applicative right identity
applyMaybe (pure Just) = id
Applicative relation
compact = applyMaybe (pure id)

If the data type is also a Monad the following should hold:

Monad left identity
flip bindMaybe (return . Just) = id
Monad right identity
compact . (return . Just =<<) = id
Monad relation
compact = flip bindMaybe return

If the data type is also Alternative the following should hold:

Alternative identity
compact empty = empty
Alternative annihilation
compact (const Nothing <$> xs) = empty

If the data type is also Traversable the following should hold:

Traversable Applicative relation
traverseMaybe (pure . Just) = pure
Traversable composition
Compose . fmap (traverseMaybe f) . traverseMaybe g = traverseMaybe (Compose . fmap (traverseMaybe f) . g)
Traversable Functor relation
traverse f = traverseMaybe (fmap Just . f)
Traversable naturality
t . traverseMaybe f = traverseMaybe (t . f)

If you know of more useful laws, or have better names for the ones above (especially those marked "name me"). Please let me know.

Methods

compact :: f (Maybe a) -> f a Source #

compact :: (Monad f, Alternative f) => f (Maybe a) -> f a Source #

fmapMaybe :: Functor f => (a -> Maybe b) -> f a -> f b Source #

applyMaybe :: Applicative f => f (a -> Maybe b) -> f a -> f b Source #

bindMaybe :: Monad f => f a -> (a -> f (Maybe b)) -> f b Source #

traverseMaybe :: (Applicative g, Traversable f) => (a -> g (Maybe b)) -> f a -> g (f b) Source #

Instances

Compactable [] Source # 

Methods

compact :: [Maybe a] -> [a] Source #

fmapMaybe :: Functor [] => (a -> Maybe b) -> [a] -> [b] Source #

applyMaybe :: Applicative [] => [a -> Maybe b] -> [a] -> [b] Source #

bindMaybe :: Monad [] => [a] -> (a -> [Maybe b]) -> [b] Source #

traverseMaybe :: (Applicative g, Traversable []) => (a -> g (Maybe b)) -> [a] -> g [b] Source #

Compactable Maybe Source # 

Methods

compact :: Maybe (Maybe a) -> Maybe a Source #

fmapMaybe :: Functor Maybe => (a -> Maybe b) -> Maybe a -> Maybe b Source #

applyMaybe :: Applicative Maybe => Maybe (a -> Maybe b) -> Maybe a -> Maybe b Source #

bindMaybe :: Monad Maybe => Maybe a -> (a -> Maybe (Maybe b)) -> Maybe b Source #

traverseMaybe :: (Applicative g, Traversable Maybe) => (a -> g (Maybe b)) -> Maybe a -> g (Maybe b) Source #

Compactable IO Source # 

Methods

compact :: IO (Maybe a) -> IO a Source #

fmapMaybe :: Functor IO => (a -> Maybe b) -> IO a -> IO b Source #

applyMaybe :: Applicative IO => IO (a -> Maybe b) -> IO a -> IO b Source #

bindMaybe :: Monad IO => IO a -> (a -> IO (Maybe b)) -> IO b Source #

traverseMaybe :: (Applicative g, Traversable IO) => (a -> g (Maybe b)) -> IO a -> g (IO b) Source #

Compactable Option Source # 

Methods

compact :: Option (Maybe a) -> Option a Source #

fmapMaybe :: Functor Option => (a -> Maybe b) -> Option a -> Option b Source #

applyMaybe :: Applicative Option => Option (a -> Maybe b) -> Option a -> Option b Source #

bindMaybe :: Monad Option => Option a -> (a -> Option (Maybe b)) -> Option b Source #

traverseMaybe :: (Applicative g, Traversable Option) => (a -> g (Maybe b)) -> Option a -> g (Option b) Source #

Compactable STM Source # 

Methods

compact :: STM (Maybe a) -> STM a Source #

fmapMaybe :: Functor STM => (a -> Maybe b) -> STM a -> STM b Source #

applyMaybe :: Applicative STM => STM (a -> Maybe b) -> STM a -> STM b Source #

bindMaybe :: Monad STM => STM a -> (a -> STM (Maybe b)) -> STM b Source #

traverseMaybe :: (Applicative g, Traversable STM) => (a -> g (Maybe b)) -> STM a -> g (STM b) Source #

Compactable ReadPrec Source # 
Compactable ReadP Source # 

Methods

compact :: ReadP (Maybe a) -> ReadP a Source #

fmapMaybe :: Functor ReadP => (a -> Maybe b) -> ReadP a -> ReadP b Source #

applyMaybe :: Applicative ReadP => ReadP (a -> Maybe b) -> ReadP a -> ReadP b Source #

bindMaybe :: Monad ReadP => ReadP a -> (a -> ReadP (Maybe b)) -> ReadP b Source #

traverseMaybe :: (Applicative g, Traversable ReadP) => (a -> g (Maybe b)) -> ReadP a -> g (ReadP b) Source #

Compactable IntMap Source # 

Methods

compact :: IntMap (Maybe a) -> IntMap a Source #

fmapMaybe :: Functor IntMap => (a -> Maybe b) -> IntMap a -> IntMap b Source #

applyMaybe :: Applicative IntMap => IntMap (a -> Maybe b) -> IntMap a -> IntMap b Source #

bindMaybe :: Monad IntMap => IntMap a -> (a -> IntMap (Maybe b)) -> IntMap b Source #

traverseMaybe :: (Applicative g, Traversable IntMap) => (a -> g (Maybe b)) -> IntMap a -> g (IntMap b) Source #

Compactable Seq Source # 

Methods

compact :: Seq (Maybe a) -> Seq a Source #

fmapMaybe :: Functor Seq => (a -> Maybe b) -> Seq a -> Seq b Source #

applyMaybe :: Applicative Seq => Seq (a -> Maybe b) -> Seq a -> Seq b Source #

bindMaybe :: Monad Seq => Seq a -> (a -> Seq (Maybe b)) -> Seq b Source #

traverseMaybe :: (Applicative g, Traversable Seq) => (a -> g (Maybe b)) -> Seq a -> g (Seq b) Source #

Compactable Vector Source # 

Methods

compact :: Vector (Maybe a) -> Vector a Source #

fmapMaybe :: Functor Vector => (a -> Maybe b) -> Vector a -> Vector b Source #

applyMaybe :: Applicative Vector => Vector (a -> Maybe b) -> Vector a -> Vector b Source #

bindMaybe :: Monad Vector => Vector a -> (a -> Vector (Maybe b)) -> Vector b Source #

traverseMaybe :: (Applicative g, Traversable Vector) => (a -> g (Maybe b)) -> Vector a -> g (Vector b) Source #

Monoid m => Compactable (Either m) Source # 

Methods

compact :: Either m (Maybe a) -> Either m a Source #

fmapMaybe :: Functor (Either m) => (a -> Maybe b) -> Either m a -> Either m b Source #

applyMaybe :: Applicative (Either m) => Either m (a -> Maybe b) -> Either m a -> Either m b Source #

bindMaybe :: Monad (Either m) => Either m a -> (a -> Either m (Maybe b)) -> Either m b Source #

traverseMaybe :: (Applicative g, Traversable (Either m)) => (a -> g (Maybe b)) -> Either m a -> g (Either m b) Source #

Compactable (Proxy *) Source # 

Methods

compact :: Proxy * (Maybe a) -> Proxy * a Source #

fmapMaybe :: Functor (Proxy *) => (a -> Maybe b) -> Proxy * a -> Proxy * b Source #

applyMaybe :: Applicative (Proxy *) => Proxy * (a -> Maybe b) -> Proxy * a -> Proxy * b Source #

bindMaybe :: Monad (Proxy *) => Proxy * a -> (a -> Proxy * (Maybe b)) -> Proxy * b Source #

traverseMaybe :: (Applicative g, Traversable (Proxy *)) => (a -> g (Maybe b)) -> Proxy * a -> g (Proxy * b) Source #

Compactable (Map k) Source # 

Methods

compact :: Map k (Maybe a) -> Map k a Source #

fmapMaybe :: Functor (Map k) => (a -> Maybe b) -> Map k a -> Map k b Source #

applyMaybe :: Applicative (Map k) => Map k (a -> Maybe b) -> Map k a -> Map k b Source #

bindMaybe :: Monad (Map k) => Map k a -> (a -> Map k (Maybe b)) -> Map k b Source #

traverseMaybe :: (Applicative g, Traversable (Map k)) => (a -> g (Maybe b)) -> Map k a -> g (Map k b) Source #

Compactable (Const * r) Source # 

Methods

compact :: Const * r (Maybe a) -> Const * r a Source #

fmapMaybe :: Functor (Const * r) => (a -> Maybe b) -> Const * r a -> Const * r b Source #

applyMaybe :: Applicative (Const * r) => Const * r (a -> Maybe b) -> Const * r a -> Const * r b Source #

bindMaybe :: Monad (Const * r) => Const * r a -> (a -> Const * r (Maybe b)) -> Const * r b Source #

traverseMaybe :: (Applicative g, Traversable (Const * r)) => (a -> g (Maybe b)) -> Const * r a -> g (Const * r b) Source #

(Compactable f, Compactable g) => Compactable (Product * f g) Source # 

Methods

compact :: Product * f g (Maybe a) -> Product * f g a Source #

fmapMaybe :: Functor (Product * f g) => (a -> Maybe b) -> Product * f g a -> Product * f g b Source #

applyMaybe :: Applicative (Product * f g) => Product * f g (a -> Maybe b) -> Product * f g a -> Product * f g b Source #

bindMaybe :: Monad (Product * f g) => Product * f g a -> (a -> Product * f g (Maybe b)) -> Product * f g b Source #

traverseMaybe :: (Applicative g, Traversable (Product * f g)) => (a -> g (Maybe b)) -> Product * f g a -> g (Product * f g b) Source #

(Functor f, Functor g, Compactable g) => Compactable (Compose * * f g) Source # 

Methods

compact :: Compose * * f g (Maybe a) -> Compose * * f g a Source #

fmapMaybe :: Functor (Compose * * f g) => (a -> Maybe b) -> Compose * * f g a -> Compose * * f g b Source #

applyMaybe :: Applicative (Compose * * f g) => Compose * * f g (a -> Maybe b) -> Compose * * f g a -> Compose * * f g b Source #

bindMaybe :: Monad (Compose * * f g) => Compose * * f g a -> (a -> Compose * * f g (Maybe b)) -> Compose * * f g b Source #

traverseMaybe :: (Applicative g, Traversable (Compose * * f g)) => (a -> g (Maybe b)) -> Compose * * f g a -> g (Compose * * f g b) Source #

fforMaybe :: (Compactable f, Functor f) => f a -> (a -> Maybe b) -> f b Source #

filter :: (Compactable f, Functor f) => (a -> Bool) -> f a -> f a Source #

fmapMaybeM :: (Compactable f, Monad f) => (a -> MaybeT f b) -> f a -> f b Source #

fforMaybeM :: (Compactable f, Monad f) => f a -> (a -> MaybeT f b) -> f b Source #

applyMaybeM :: (Compactable f, Monad f) => f (a -> MaybeT f b) -> f a -> f b Source #

bindMaybeM :: (Compactable f, Monad f) => f a -> (a -> f (MaybeT f b)) -> f b Source #

traverseMaybeM :: (Monad m, Compactable t, Traversable t) => (a -> MaybeT m b) -> t a -> m (t b) Source #