compactable 0.1.0.3 → 0.1.0.4
raw patch · 2 files changed
+190/−29 lines, 2 filesdep ~base
Dependency ranges changed: base
Files
- compactable.cabal +4/−5
- src/Control/Compactable.hs +186/−24
compactable.cabal view
@@ -1,8 +1,7 @@ name: compactable-version: 0.1.0.3-synopsis: A generalization for containers that can be stripped of Nothings.-description: Sometimes you have a collection of Maybes,- and you want to extract the values. Actually that happens a whole lot.+version: 0.1.0.4+synopsis: A typeclass for structures which can be catMaybed, filtered, and partitioned.+description: This provides polymorphic implimentations for filter, compact (catMaybes), and separate. It allows for higher performance implimentations to be used in place of defaults for all data structures, and endeavors to centerally document those implimentations. Compactable aims to be as general and unconstrained as possible, providing instances for non-Functors like Set, as well as some Contravariants (though not published here). Compactable fully subsumes Data.Witherable, offers more laws, and is more general. license: BSD3 license-file: LICENSE author: Isaac Shapira@@ -22,7 +21,7 @@ -- other-modules: -- other-extensions: ghc-options: -Wall- build-depends: base >= 4.9 && < 4.10+ build-depends: base >= 4.9 && < 4.10.2 , containers >= 0.5.7 && < 0.6 , transformers >= 0.5.2 && < 0.6 , vector >= 0.11 && < 0.13
src/Control/Compactable.hs view
@@ -1,12 +1,29 @@ {-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-} -module Control.Compactable where+module Control.Compactable+ ( Compactable (..)+ , fforMaybe+ , fforEither+ , fmapMaybeM+ , fmapEitherM+ , fforMaybeM+ , fforEitherM+ , applyMaybeM+ , bindMaybeM+ , traverseMaybeM+ , altDefaultCompact+ , altDefaultSeparate ) where import Control.Applicative import Control.Monad (join)+import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe+import Data.Bifunctor (bimap)+import Data.Either (partitionEithers)+import Data.Foldable (foldl') import Data.Functor.Compose import qualified Data.Functor.Product as FP import qualified Data.IntMap as IntMap@@ -16,13 +33,16 @@ import Data.Semigroup import qualified Data.Sequence as Seq import qualified Data.Set as Set-import Data.Vector (Vector)+import qualified Data.Vector as V import GHC.Conc import Text.ParserCombinators.ReadP import Text.ParserCombinators.ReadPrec {-|-This is a generalization of catMaybes as a new function compact. Compact+Class 'Compactable' provides two methods which can be writen in terms of each other, compact and separate.++=Compact+is generalization of catMaybes as a new function. 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@@ -108,44 +128,116 @@ @t . traverseMaybe f = traverseMaybe (t . f)@ += Separate and filter+have recently elevated roles in this typeclass, and is not as well explored as compact. Here are the laws known today:++[/Functor identity 3/]++ @fst . separate . fmap Right = id@++[/Functor identity 4/]++ @snd . separate . fmap Left = id@++[/Applicative left identity 2/]++ @snd . separate . (pure Right \<*\>) = id@++[/Applicative right identity 2/]++ @fst . separate . (pure Left \<*\>) = id@++[/Alternative annihilation left/]++ @snd . separate . fmap (const Left) = empty@++[/Alternative annihilation right/]++ @fst , separate . fmap (const Right) = empty@++Docs for relationships between these functions and, a cleanup of laws will happen at some point.+ If you know of more useful laws, or have better names for the ones above (especially those marked "name me"). Please let me know. -} 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)+ default compact :: Functor f => f (Maybe a) -> f a+ compact = snd . separate . fmap (\case Just x -> Right x; _ -> Left ()) {-# INLINABLE compact #-} + separate :: f (Either l r) -> (f l, f r)+ default separate :: Functor f => f (Either l r) -> (f l, f r)+ separate xs = (compact $ hush . flipEither <$> xs, compact $ hush <$> xs)+ {-# INLINABLE separate #-}++ filter :: (a -> Bool) -> f a -> f a+ default filter :: Functor f => (a -> Bool) -> f a -> f a+ filter f = fmapMaybe $ \a -> if f a then Just a else Nothing+ {-# INLINABLE filter #-}+ fmapMaybe :: Functor f => (a -> Maybe b) -> f a -> f b fmapMaybe f = compact . fmap f {-# INLINABLE fmapMaybe #-} + fmapEither :: Functor f => (a -> Either l r) -> f a -> (f l, f r)+ fmapEither f = separate . fmap f+ {-# INLINABLE fmapEither #-}+ applyMaybe :: Applicative f => f (a -> Maybe b) -> f a -> f b applyMaybe fa = compact . (fa <*>) {-# INLINABLE applyMaybe #-} + applyEither :: Applicative f => f (a -> Either l r) -> f a -> (f l, f r)+ applyEither fa = separate . (fa <*>)+ {-# INLINABLE applyEither #-}+ bindMaybe :: Monad f => f a -> (a -> f (Maybe b)) -> f b bindMaybe x = compact . (x >>=) {-# INLINABLE bindMaybe #-} + bindEither :: Monad f => f a -> (a -> f (Either l r)) -> (f l, f r)+ bindEither x = separate . (x >>=)+ {-# INLINABLE bindEither #-}+ traverseMaybe :: (Applicative g, Traversable f) => (a -> g (Maybe b)) -> f a -> g (f b) traverseMaybe f = fmap compact . traverse f {-# INLINABLE traverseMaybe #-} - filter :: (a -> Bool) -> f a -> f a- default filter :: Functor f => (a -> Bool) -> f a -> f a- filter f = fmapMaybe $ \a -> if f a then Just a else Nothing- {-# INLINABLE filter #-}+ traverseEither :: (Applicative g, Traversable f)+ => (a -> g (Either l r)) -> f a -> g (f l, f r)+ traverseEither f = fmap separate . traverse f+ {-# INLINABLE traverseEither #-} + instance Compactable Maybe where compact = join {-# INLINABLE compact #-} fmapMaybe = (=<<) {-# INLINABLE fmapMaybe #-}+ separate = \case+ Just x -> case x of+ Left l -> (Just l, Nothing)+ Right r -> (Nothing, Just r)+ _ -> (Nothing, Nothing)+ {-# INLINABLE separate #-} +instance Monoid m => Compactable (Either m) where+ compact (Right (Just x)) = Right x+ compact (Right _) = Left mempty+ compact (Left x) = Left x+ {-# INLINABLE compact #-}+ fmapMaybe f (Right x) = maybe (Left mempty) Right (f x)+ fmapMaybe _ (Left x) = Left x+ {-# INLINABLE fmapMaybe #-}+ separate = \case+ Right (Left l) -> (Right l, Left mempty)+ Right (Right r) -> (Left mempty, Right r)+ Left x -> (Left x, Left x)+ {-# INLINABLE separate #-}+ instance Compactable [] where compact = catMaybes {-# INLINABLE compact #-}@@ -154,12 +246,39 @@ {-# INLINABLE fmapMaybe #-} filter = Prelude.filter {-# INLINABLE filter #-}+ separate = partitionEithers+ {-# INLINABLE separate #-}+ fmapEither f = foldl' (deal f) ([],[])+ where deal g ~(bs, cs) a = case g a of+ Left b -> (b:bs, cs)+ Right c -> (bs, c:cs)+ {-# INLINABLE fmapEither #-}+ traverseMaybe f = go where+ go (x:xs) = maybe id (:) <$> f x <*> go xs+ go [] = pure []+ {-# INLINE traverseMaybe #-} -instance Compactable IO+instance Compactable IO where+ compact = altDefaultCompact+ {-# INLINABLE compact #-} -instance Compactable STM+instance Compactable STM where+ compact = altDefaultCompact+ {-# INLINABLE compact #-} -instance Compactable Proxy+instance Compactable Proxy where+ compact _ = Proxy+ {-# INLINABLE compact #-}+ separate _ = (Proxy, Proxy)+ {-# INLINABLE separate #-}+ filter _ _ = Proxy+ {-# INLINABLE filter #-}+ fmapMaybe _ _ = Proxy+ {-# INLINABLE fmapMaybe #-}+ applyMaybe _ _ = Proxy+ {-# INLINABLE applyMaybe #-}+ bindMaybe _ _ = Proxy+ {-# INLINABLE bindMaybe #-} instance Compactable Option where compact (Option x) = Option (join x)@@ -167,6 +286,8 @@ fmapMaybe f (Option (Just x)) = Option (f x) fmapMaybe _ _ = Option Nothing {-# INLINABLE fmapMaybe #-}+ separate = altDefaultSeparate+ {-# INLINABLE separate #-} instance Compactable ReadP @@ -181,7 +302,7 @@ => Compactable (Compose f g) where compact = fmapMaybe id {-# INLINABLE compact #-}- fmapMaybe f (Compose fg) = Compose $ fmap (fmapMaybe f) fg+ fmapMaybe f (Compose fg) = Compose $ fmapMaybe f <$> fg {-# INLINABLE fmapMaybe #-} instance Compactable IntMap.IntMap where@@ -191,6 +312,10 @@ {-# INLINABLE fmapMaybe #-} filter = IntMap.filter {-# INLINABLE filter #-}+ separate = IntMap.mapEither id+ {-# INLINABLE separate #-}+ fmapEither = IntMap.mapEither+ {-# INLINABLE fmapEither #-} instance Compactable (Map.Map k) where compact = Map.mapMaybe id@@ -199,14 +324,26 @@ {-# INLINABLE fmapMaybe #-} filter = Map.filter {-# INLINABLE filter #-}+ separate = Map.mapEither id+ {-# INLINABLE separate #-}+ fmapEither = Map.mapEither+ {-# INLINABLE fmapEither #-} instance Compactable Seq.Seq where compact = fmap fromJust . Seq.filter isJust {-# INLINABLE compact #-}+ separate = altDefaultSeparate+ {-# INLINABLE separate #-} filter = Seq.filter {-# INLINABLE filter #-} -instance Compactable Vector+instance Compactable V.Vector where+ compact = altDefaultCompact+ {-# INLINABLE compact #-}+ separate = altDefaultSeparate+ {-# INLINABLE separate #-}+ filter = V.filter+ {-# INLINABLE filter #-} instance Compactable (Const r) where compact (Const r) = Const r@@ -218,19 +355,12 @@ filter _ (Const r) = Const r {-# INLINABLE filter #-} -instance Monoid m => Compactable (Either m) where- compact (Right (Just x)) = Right x- compact (Right _) = Left mempty- compact (Left x) = Left x- {-# INLINABLE compact #-}- fmapMaybe f (Right x) = maybe (Left mempty) Right (f x)- fmapMaybe _ (Left x) = Left x- {-# INLINABLE fmapMaybe #-}- instance Compactable Set.Set where compact = Set.fromDistinctAscList . compact . Set.toAscList {-# INLINABLE compact #-}- filter f = Set.fromDistinctAscList . Control.Compactable.filter f . Set.toAscList+ separate = bimap Set.fromDistinctAscList Set.fromDistinctAscList . separate . Set.toAscList+ {-# INLINABLE separate #-}+ filter = Set.filter {-# INLINABLE filter #-} @@ -238,6 +368,10 @@ fforMaybe = flip fmapMaybe +fforEither :: (Compactable f, Functor f) => f a -> (a -> Either l r) -> (f l, f r)+fforEither = flip fmapEither++ fmapMaybeM :: (Compactable f, Monad f) => (a -> MaybeT f b) -> f a -> f b fmapMaybeM f = (>>= compact . runMaybeT . f) @@ -246,6 +380,14 @@ fforMaybeM = flip fmapMaybeM +fmapEitherM :: (Compactable f, Monad f) => (a -> ExceptT l f r) -> f a -> (f l, f r)+fmapEitherM f x = separate $ runExceptT . f =<< x+++fforEitherM :: (Compactable f, Monad f) => f a -> (a -> ExceptT l f r) -> (f l, f r)+fforEitherM = flip fmapEitherM++ applyMaybeM :: (Compactable f, Monad f) => f (a -> MaybeT f b) -> f a -> f b applyMaybeM fa = compact . join . fmap runMaybeT . (fa <*>) @@ -256,3 +398,23 @@ traverseMaybeM :: (Monad m, Compactable t, Traversable t) => (a -> MaybeT m b) -> t a -> m (t b) traverseMaybeM f = unwrapMonad . traverseMaybe (WrapMonad . runMaybeT . f)++-- | While more constrained, when available, this default is going to be faster than the one provided in the typeclass+altDefaultCompact :: (Alternative f, Monad f) => f (Maybe a) -> f a+altDefaultCompact = (>>= maybe empty return)+{-# INLINABLE altDefaultCompact #-}++-- | While more constrained, when available, this default is going to be faster than the one provided in the typeclass+altDefaultSeparate :: (Alternative f, Foldable f) => f (Either l r) -> (f l, f r)+altDefaultSeparate = foldl' (\(l', r') -> \case+ Left l -> (l' <|> pure l ,r')+ Right r -> (l', r' <|> pure r)) (empty, empty)+{-# INLINABLE altDefaultSeparate #-}+++hush :: Either l r -> Maybe r+hush = \case (Right x) -> Just x; _ -> Nothing+++flipEither :: Either a b -> Either b a+flipEither = \case (Right x) -> Left x; (Left x) -> Right x