{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module RIO.Prelude.Extra
( mapLeft
, fromFirst
, mapMaybeA
, mapMaybeM
, forMaybeA
, forMaybeM
, foldMapM
, nubOrd
, whenM
, unlessM
, (<&>)
, asIO
) where
import Prelude
import qualified Data.Set as Set
import Data.Monoid (First (..))
import Data.Foldable (foldlM)
import Data.Functor
import Data.Maybe
import Control.Monad
mapLeft :: (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft :: forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft a1 -> a2
f (Left a1
a1) = forall a b. a -> Either a b
Left (a1 -> a2
f a1
a1)
mapLeft a1 -> a2
_ (Right b
b) = forall a b. b -> Either a b
Right b
b
fromFirst :: a -> First a -> a
fromFirst :: forall a. a -> First a -> a
fromFirst a
x = forall a. a -> Maybe a -> a
fromMaybe a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. First a -> Maybe a
getFirst
mapMaybeA :: Applicative f => (a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeA :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeA a -> f (Maybe b)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f (Maybe b)
f
forMaybeA :: Applicative f => [a] -> (a -> f (Maybe b)) -> f [b]
forMaybeA :: forall (f :: * -> *) a b.
Applicative f =>
[a] -> (a -> f (Maybe b)) -> f [b]
forMaybeA = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeA
mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m (Maybe b)
f
forMaybeM :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM :: forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM
foldMapM
:: (Monad m, Monoid w, Foldable t)
=> (a -> m w)
-> t a
-> m w
foldMapM :: forall (m :: * -> *) w (t :: * -> *) a.
(Monad m, Monoid w, Foldable t) =>
(a -> m w) -> t a -> m w
foldMapM a -> m w
f = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
(\w
acc a
a -> do
w
w <- a -> m w
f a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => a -> a -> a
mappend w
acc w
w)
forall a. Monoid a => a
mempty
nubOrd :: Ord a => [a] -> [a]
nubOrd :: forall a. Ord a => [a] -> [a]
nubOrd =
forall {a}. Ord a => Set a -> [a] -> [a]
loop forall a. Monoid a => a
mempty
where
loop :: Set a -> [a] -> [a]
loop Set a
_ [] = []
loop !Set a
s (a
a:[a]
as)
| a
a forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
s = Set a -> [a] -> [a]
loop Set a
s [a]
as
| Bool
otherwise = a
a forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
loop (forall a. Ord a => a -> Set a -> Set a
Set.insert a
a Set a
s) [a]
as
whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
boolM m ()
action = m Bool
boolM forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
action)
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM m Bool
boolM m ()
action = m Bool
boolM forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` m ()
action)
#if !MIN_VERSION_base(4, 11, 0)
(<&>) :: Functor f => f a -> (a -> b) -> f b
as <&> f = f <$> as
infixl 1 <&>
#endif
asIO :: IO a -> IO a
asIO :: forall a. IO a -> IO a
asIO = forall a. a -> a
id