module Control.Compactable where
import Control.Applicative
import Control.Monad (join)
import Control.Monad.Trans.Maybe
import Data.Functor.Compose
import qualified Data.Functor.Product as FP
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import Data.Maybe
import Data.Proxy
import Data.Semigroup
import qualified Data.Sequence as Seq
import Data.Vector (Vector)
import GHC.Conc
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec
class Compactable (f :: * -> *) where
compact :: f (Maybe a) -> f a
default compact :: (Monad f, Alternative f) => f (Maybe a) -> f a
compact = (>>= maybe empty return)
fmapMaybe :: Functor f => (a -> Maybe b) -> f a -> f b
fmapMaybe f = compact . fmap f
applyMaybe :: Applicative f => f (a -> Maybe b) -> f a -> f b
applyMaybe fa = compact . (fa <*>)
bindMaybe :: Monad f => f a -> (a -> f (Maybe b)) -> f b
bindMaybe x = compact . (x >>=)
traverseMaybe :: (Applicative g, Traversable f)
=> (a -> g (Maybe b)) -> f a -> g (f b)
traverseMaybe f = fmap compact . traverse f
instance Compactable Maybe where
compact = join
fmapMaybe f (Just x) = f x
fmapMaybe _ _ = Nothing
instance Compactable [] where
compact = catMaybes
fmapMaybe _ [] = []
fmapMaybe f (h:t) =
maybe (fmapMaybe f t) (: fmapMaybe f t) (f h)
instance Compactable IO
instance Compactable STM
instance Compactable Proxy
instance Compactable Option where
compact (Option x) = Option (join x)
fmapMaybe f (Option (Just x)) = Option (f x)
fmapMaybe _ _ = Option Nothing
instance Compactable ReadP
instance Compactable ReadPrec
instance ( Compactable f, Compactable g )
=> Compactable (FP.Product f g) where
compact (FP.Pair x y) = FP.Pair (compact x) (compact y)
instance ( Functor f, Functor g, Compactable g )
=> Compactable (Compose f g) where
compact = fmapMaybe id
fmapMaybe f (Compose fg) = Compose $ fmap (fmapMaybe f) fg
instance Compactable IntMap.IntMap where
compact = IntMap.mapMaybe id
fmapMaybe = IntMap.mapMaybe
instance Compactable (Map.Map k) where
compact = Map.mapMaybe id
fmapMaybe = Map.mapMaybe
instance Compactable Seq.Seq where
compact = fmap fromJust . Seq.filter isJust
instance Compactable Vector
fforMaybe :: (Compactable f, Functor f) => f a -> (a -> Maybe b) -> f b
fforMaybe = flip fmapMaybe
filter :: (Compactable f, Functor f) => (a -> Bool) -> f a -> f a
filter f = fmapMaybe $ \a -> if f a then Just a else Nothing
fmapMaybeM :: (Compactable f, Monad f) => (a -> MaybeT f b) -> f a -> f b
fmapMaybeM f = (>>= compact . runMaybeT . f)
fforMaybeM :: (Compactable f, Monad f) => f a -> (a -> MaybeT f b) -> f b
fforMaybeM = flip fmapMaybeM
applyMaybeM :: (Compactable f, Monad f) => f (a -> MaybeT f b) -> f a -> f b
applyMaybeM fa x = compact . join $ runMaybeT <$> (fa <*> x)
bindMaybeM :: (Compactable f, Monad f) => f a -> (a -> f (MaybeT f b)) -> f b
bindMaybeM x f = compact . join . fmap runMaybeT $ x >>= f
traverseMaybeM :: (Monad m, Compactable t, Traversable t) => (a -> MaybeT m b) -> t a -> m (t b)
traverseMaybeM f = unwrapMonad . traverseMaybe (WrapMonad . runMaybeT . f)