<div dir="ltr">+1<div><br></div><div>I feel the awkwardness of the current combinators at times.</div></div><div class="gmail_extra"><br><div class="gmail_quote">2015-03-17 4:07 GMT+09:00 M Farkas-Dyck <span dir="ltr"><<a href="mailto:strake888@gmail.com" target="_blank">strake888@gmail.com</a>></span>:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Analogs of monadic functions, which likely ought to be in base as part of AMP.<br>
<br>
I send no patch yet, for I not know which way to do the Data.Traversable <-> Control.Applicative cyclic import.<br>
<br>
-- | 'filterA' generalizes the list-based 'filter' function.<br>
{-# INLINE filterA #-}<br>
filterA :: (Applicative p) => (a -> p Bool) -> [a] -> p [a]<br>
filterA p = foldr (\ x -> liftA2 (\ flg -> bool flg (x:) id) (p x)) (pure [])<br>
  where<br>
    bool True  x = const x<br>
    bool False _ = id<br>
<br>
-- | 'mapAndUnzipA' maps its first argument over a list, returning the result as a pair of lists.<br>
{-# INLINE mapAndUnzipA #-}<br>
mapAndUnzipA :: (Applicative p) => (a -> p (b, c)) -> [a] -> p ([b], [c])<br>
mapAndUnzipA f xs = unzip <$> traverse f xs<br>
<br>
-- | 'zipWithA' generalizes 'zipWith' to arbitrary applicative functors.<br>
{-# INLINE zipWithA #-}<br>
zipWithA :: (Applicative p) => (a -> b -> p c) -> [a] -> [b] -> p [c]<br>
zipWithA f x y = sequenceA (zipWith f x y)<br>
<br>
-- | 'zipWithA_' is the extension of 'zipWithA' which ignores the final result.<br>
{-# INLINE zipWithA_ #-}<br>
zipWithA_ :: (Applicative p) => (a -> b -> p c) -> [a] -> [b] -> p ()<br>
zipWithA_ f x y = sequenceA_ (zipWith f x y)<br>
<br>
-- | @'replicateA' n x@ does @x@ @n@ times, gathering the results.<br>
{-# INLINEABLE replicateA #-}<br>
{-# SPECIALIZE replicateA :: Int -> IO a -> IO [a] #-}<br>
{-# SPECIALIZE replicateA :: Int -> Maybe a -> Maybe [a] #-}<br>
replicateA :: (Applicative p) => Int -> p a -> p [a]<br>
replicateA n x = sequenceA (replicate n x)<br>
<br>
-- | 'replicateA_' is like 'replicateA', but discards the result.<br>
{-# INLINEABLE replicateA_ #-}<br>
{-# SPECIALIZE replicateA_ :: Int -> IO a -> IO () #-}<br>
{-# SPECIALIZE replicateA_ :: Int -> Maybe a -> Maybe () #-}<br>
replicateA_ :: (Applicative p) => Int -> p a -> p ()<br>
replicateA_ n x = sequenceA_ (replicate n x)<br>
_______________________________________________<br>
Libraries mailing list<br>
<a href="mailto:Libraries@haskell.org">Libraries@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries</a><br>
</blockquote></div><br></div>