Skip to content

Instantly share code, notes, and snippets.

@Centril
Created January 13, 2017 21:35
Show Gist options
  • Star 3 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save Centril/4b8fa94514971a101caf59fc02f90cd1 to your computer and use it in GitHub Desktop.
Save Centril/4b8fa94514971a101caf59fc02f90cd1 to your computer and use it in GitHub Desktop.
useful higher order combinators in haskell
(.$) :: (t -> b -> c) -> (a -> b) -> t -> a -> c
(.$) f g a = f a . g
infixr 8 .$
-- | '.|': Compose an unary function with a binary function.
-- from: http://hackage.haskell.org/package/pointless-fun-1.1.0.5/docs/Data-Function-Pointless.html
(.|) :: (b -> c) -> (t -> a -> b) -> t -> a -> c
(.|) f g a = f . g a
infixr 7 .|
-- | '|.': Compose a binary function with an unary function for both arguments.
(|.) :: (a1 -> a2 -> c) -> (a1 -> a2) -> (b1 -> b2) -> a1 -> b1 -> c
(|.) f g h = f . g .$ h
infixr 8 |.
-- | '<$<': Left-to-right "Kleisli" composition of 'Functor's.
(>$>) :: Functor f => (a -> f b) -> (b -> c) -> a -> f c
(>$>) = flip (<$<)
infixr 3 >$>
-- | '<$<': Right-to-left "Kleisli" composition of 'Functor's.
(<$<) :: Functor f => (b -> c) -> (a -> f b) -> a -> f c
(<$<) = (.) . (<$>)
infixr 3 <$<
-- | '<$<': Right-to-left "Kleisli" composition of 'Functor's.
(<$<) :: Functor f => (b -> c) -> (a -> f b) -> a -> f c
(<$<) = (.) . (<$>)
infixr 3 <$<
-- | '>?=>': Same as '>=>', i.e: Left-to-right Kleisli composition of monads.
-- BUT: first it applies something to the left hand side.
(>?=>) :: Monad m => (t -> a -> m b) -> (b -> m c) -> t -> a -> m c
(>?=>) m1 m2 x = m1 x >=> m2
infixr 1 >?=>
-- | '>=?>': Same as '>=>', i.e: Left-to-right Kleisli composition of monads.
-- BUT: first it applies something to the right hand side.
(>=?>) :: Monad m => (a -> m b) -> (t -> b -> m c) -> t -> a -> m c
(>=?>) m1 m2 x = m1 >=> m2 x
infixr 1 >=?>
-- | '.>>': blinding Left to right Kleisli post-composition of applicatives.
-- Is to '>=>' what '>>' is to '>>='.
(.>>) :: Applicative m => (a -> m b) -> m c -> a -> m c
(.>>) fb c a = fb a *> c
infixl 3 .>>
-- | '>>.': blinding Left to right Kleisli pre-composition of applicatives.
-- Is to '>=>' what '>>' is to '>>='.
(>>.) :: Applicative m => m a -> (b -> m c) -> b -> m c
(>>.) ma fc b = ma *> fc b
infixl 2 >>.
-- | '.<*': blinding Kleisli Left-to-right post-composition of yielding
-- the result of the first computation.
(.<*) :: Applicative m => (a -> m b) -> m c -> a -> m b
(.<*) fb c a = fb a <* c
infixl 4 .<*
-- | '<<=': sequentially compose two actions, passing value produced by first as
-- an argument to the second, but returning the value of produced by first.
(<<=) :: Monad m => m a -> (a -> m b) -> m a
(<<=) m f = m >>= \x -> f x >> return x
infixl 5 <<=
-- | '<<=>': "Kleisli" version of '<<='.
--(<!<=>) :: Monad m => (a -> m b) -> (a -> m c) -> a -> m c
(<<=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m b
(<<=>) f g a = f a >>= \x -> g x >> return x
infixl 5 <<=>
-- | '<=>': Blinding "Kleisli" operator taking two actions, giving them the
-- same value, performing the first, ignoring result of that, then running the
-- second monadic action and yielding the result of that one.
(<=>) :: Applicative m => (a -> m b) -> (a -> m c) -> a -> m c
(<=>) f g a = f a *> g a
infixl 5 <=>
-- | '<!>': sequential application of a non-applicative value
-- lifted into the same 'Applicative' of as the function applied.
(<!>) :: Applicative f => f (a -> b) -> a -> f b
(<!>) f = (<*>) f . pure
infixr 7 <!>
-- | '<!>': version of 'fmap' where non-applicative value is first lifted
-- purely into the 'Applicative'.
(<:>) :: Applicative f => (a -> b) -> a -> f b
(<:>) f = fmap f . pure
infixr 8 <:>
-- | '<<$>': binary operator that performs 'fmap' for a 'Functor' f where the
-- given value is a pair. This version of 'fmap' extracts 'fst' part of tuple.
(<<$>) :: Functor f => (a -> c) -> f (a, b) -> f c
f <<$> y = f . fst <$> y
-- | '<>$>': binary operator that performs 'fmap' for a 'Functor' f where the
-- given value is a pair. This version of 'fmap' extracts 'snd' part of tuple.
(<>$>) :: Functor f => (a -> c) -> f (a, b) -> f c
f <>$> y = f . fst <$> y
-- | '<$$>': alias for composition of fmap with itself.
(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
(<$$>) = (<$>) . (<$>)
-- | 'maybeErr': if the given 'Maybe' is 'Nothing' the monadic action
-- whenNothing is run, otherwise the value in 'Just' is 'return':ed.
maybeErr :: Monad m => m a -> Maybe a -> m a
maybeErr whenNothing = maybe whenNothing return
-- | 'unless'': sequentially composes first argument with a check where the
-- value is given to a predicate (in second argument). If the predicate holds,
-- then its given value is returned, else the function in the third argument is
-- given the value and is the result of the computation.
unless' :: Monad m => m a -> (a -> Bool) -> (a -> m a) -> m a
unless' m p e = m >>= \x -> if p x then return x else e x
-- | 'fkeep': given a function that produces f b given an a. And given an a in
-- the second argument, a functor with both values as a pair is produced.
fkeep :: Functor f => (a -> f b) -> a -> f (a, b)
fkeep f a = (\b -> (a, b)) <$> f a
-- | '<++>': 'mappend' a monoidal value inside an applicative to another.
(<++>) :: (Applicative f, Monoid b) => f b -> f b -> f b
(<++>) l r = mappend <$> l <*> r
-- | 'foldl1M': variant of 'foldlM' without base case, so non-empty structure.
foldl1M :: (Foldable t, Monad m) => (a -> a -> m a) -> t a -> m a
foldl1M f t = let (z:xs) = toList t in foldlM f z xs
-- | 'foldr1M': variant of 'foldrM' without base case, so non-empty structure.
foldr1M :: (Foldable t, Monad m) => (a -> a -> m a) -> t a -> m a
foldr1M f t = let (z:xs) = toList t in foldrM f z xs
-- | 'untilEqM': same as 'untilEq' but in a monadic context.
untilEqM :: (Eq a, Monad m) => (a -> m a) -> m a -> m a
untilEqM = untilMatchM (==)
-- | 'untilMatchM': same as 'untilMatch' but in a monadic context.
untilMatchM :: Monad m => (a -> a -> Bool) -> (a -> m a) -> m a -> m a
untilMatchM p f = (>>= \x -> unless' (f x) (p x) (untilMatchM p f . return))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment