<div dir="ltr"><div><div><div><div><div><div><div><div><div><div>A year ago Edwardk Kmett pointed out some possible generalizations of functions [1], I made a ticket about them that led me here [2]. In addition to the functions mentioned<br><br></div>> maybeToList :: Foldable f => f a -> [a]<br></div>> maybeToList = toList<br><br></div>> catMaybes :: (Foldable f)             => f (Maybe a) -> [a]<br>> catMaybes :: (Foldable f, Foldable g) => f (g     a) -> [a]<br></div></div></div>> catMaybes = foldMap toList<br><br>> mapMaybes ::               (a -> Maybe b) -> (forall f. Foldable f => f a -> [b])<br>> mapMaybes :: Foldable m => (a -> m     b) -> (forall f. Foldable f => f a -> [b])<br>> mapMaybes f = foldMap (toList . f)<br><br></div>we also have *many* other functions (I do not propose generalising all these function ((especially when the name stops making sense)), but I will include them) that I will define in the vocabulary of ‘lens’. Some generalise to ‘Foldable’<br><br></div>> take :: Int -> (forall f a. Foldable f => f a -> [a])<br></div>> take n = toListOf (taking n folded)<br><br>> drop :: Int -> (forall f a. Foldable f => f a -> [a])<br>> drop n = toListOf (dropping n folded)<br><br>> takeWhile :: (a -> Bool) -> (forall f. Foldable f => f a -> [a])<br>> takeWhile p = toListOf (takingWhile p folded)<br><br>> dropWhile :: (a -> Bool) -> (forall f. Foldable f => f a -> [a])<br>> dropWhile p = toListOf (droppingWhile p folded)<br><br></div>> -- Same as ‘Control.Lens.Indexed.None’<br><div><div><div><div><div><div><div><div>> filter :: (a -> Bool) -> (forall f. Foldable f => f a -> [a])<br>> filter p = toListOf (folded.filtered p)<br><br>> cycle :: Foldable f => f a -> [a]<br>> cycle = toListOf (cycled folded)<br><br>> lookup :: Eq k => k -> (forall f. Foldable f => f (k, v) -> Maybe v)<br>> lookup = lookupOf folded<br><br></div><div>> listToMaybe :: Foldable f => f a -> Maybe a<br>> listToMaybe = firstOf folded<br></div><div><br></div><div>while others — to ‘Traversable’<br><br>> transpose :: Traversable f => f [b] -> [f b]<br>> transpose = transposeOf traverse<br><br>> scanl1 :: (a -> a -> a) -> (forall f. Traversable f => f a -> f a)<br>> scanl1 = scanl1Of traverse<br><br></div><div>> scanr1_ :: (a -> a -> a) -> (forall f. Traversable f => f a -> f a)<br>> scanr1_ = scanr1Of traverse<br><br></div><div>More radical suggestions (pay no heed to the hacky ‘partsOf’, assume better implementation [3]) would allow us to sort a ‘data V2 a = V2 a a deriving (…, Traversable)’ if it contains ordered values:<br></div><div><br>> sort :: (Traversable t, Ord a) => t a -> t a<br>> sort = over (partsOf traverse) Data.List.sort<br><br>> sortBy :: (a -> a -> Ordering) -> ([a] -> [a])<br>> sortBy = over (partsOf traverse) . Data.List.sortBy<br><br>> sortOn :: Ord b => (a -> b) -> ([a] -> [a])<br>> sortOn = over (partsOf traverse) . Data.List.sortOn<br><br>> reverse :: Traversable t => t a -> t a<br>> reverse = over (partsOf traverse) Data.List.reverse<br><br></div><div>> -- Based on ‘Control.Lens.??’<br></div><div>> flip :: Functor f => f (a -> b) -> a -> f b <br>> flip f x = fmap ($ x) f<br><br></div><div>or <br><br></div><div>> flip :: (Functor f, Distributive g) => f (g a) -> g (f a)<br>> flip = Data.Distributive.distribute</div><div><div><div><div><div><br></div><div>AMP happened some years ago, does this go too far or not far enough? ;) share your thoughts<br><br></div><div>P.s. I understand those skeptical of the ‘partsOf’ solutions but they do feel magical and uses crop up in odd places, especially in compound structures (I don't have better examples):<br><br></div><div>> ghci> peopleList = Pair ["Bob", "Eve"] (Just "Alice")</div><div>> ghci> data Product f g a = Pair (f a) (g a) deriving (Show, Functor, Foldable, Traversable)<br>> ghci> sort peopleList<br>> Pair ["Alice","Bob"] (Just "Eve")<br>> ghci> reverse peopleList<br>> Pair ["Alice","Eve"] (Just "Bob")<br><br>> ghci> peopleMap = fromList [(1,"Bob"),(2,"Eve"),(3,"Alice")] <br>> ghci> sort peopleMap<br>> fromList [(1,"Alice"),(2,"Bob"),(3,"Eve")]<br>> ghci> reverse peopleMap<br>> fromList [(1,"Alice"),(2,"Eve"),(3,"Bob")]<br></div><div><br>[1] <a href="https://www.reddit.com/r/haskell/comments/2y2pe5/shouldnt_ftp_propagate_changes_over_the_entire/cp6vpb4/">https://www.reddit.com/r/haskell/comments/2y2pe5/shouldnt_ftp_propagate_changes_over_the_entire/cp6vpb4/</a><br>[2] <a href="https://ghc.haskell.org/trac/ghc/ticket/12828">https://ghc.haskell.org/trac/ghc/ticket/12828</a><br>[3] <a href="http://stackoverflow.com/a/33320155/165806">http://stackoverflow.com/a/33320155/165806</a><br></div></div></div></div></div></div></div></div></div></div></div></div></div>