Changing recursive guards into higher order functions

First, let's flip the argument order of your function. This will make a few steps easier, and we can flip it back when we're done. (I'll call the flipped version filterFirst'.)

filterFirst' :: [a] -> (a -> Bool) -> [a]
filterFirst' [] _ = []
filterFirst' (y:ys) x
    | x y       = y : filterFirst' ys x
    | otherwise = ys

Note that filterFirst' ys (const True) = ys for all ys. Let's substitute that in place:

filterFirst' :: [a] -> (a -> Bool) -> [a]
filterFirst' [] _ = []
filterFirst' (y:ys) x
    | x y       = y : filterFirst' ys x
    | otherwise = filterFirst' ys (const True)

Use if-else instead of a guard:

filterFirst' :: [a] -> (a -> Bool) -> [a]
filterFirst' [] _ = []
filterFirst' (y:ys) x = if x y then y : filterFirst' ys x else filterFirst' ys (const True)

Move the second argument to a lambda:

filterFirst' :: [a] -> (a -> Bool) -> [a]
filterFirst' [] = \_ -> []
filterFirst' (y:ys) = \x -> if x y then y : filterFirst' ys x else filterFirst' ys (const True)

And now this is something we can turn into a foldr. The pattern we were going for is that filterFirst' (y:ys) can be expressed in terms of filterFirst' ys, without using ys otherwise, and we're now there.

filterFirst' :: Foldable t => t a -> (a -> Bool) -> [a]
filterFirst' = foldr (\y f -> \x -> if x y then y : f x else f (const True)) (\_ -> [])

Now we just need to neaten it up a bit:

filterFirst' :: Foldable t => t a -> (a -> Bool) -> [a]
filterFirst' = foldr go (const [])
  where go y f x
          | x y       = y : f x
          | otherwise = f (const True)

And flip the arguments back:

filterFirst :: Foldable t => (a -> Bool) -> t a -> [a]
filterFirst = flip $ foldr go (const [])
  where go y f x
          | x y       = y : f x
          | otherwise = f (const True)

And we're done. filterFirst implemented in terms of foldr.


Addendum: Although filter isn't strong enough to build this, filterM is when used with the State monad:

{-# LANGUAGE FlexibleContexts #-}

import Control.Monad.State

filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst x ys = evalState (filterM go ys) False
  where go y = do
          alreadyDropped <- get
          if alreadyDropped || x y then
            return True
          else do
            put True
            return False

There is a higher-order function that's appropriate here, but it's not in the base library. What's the trouble with foldr? If you just fold over the list, you'll end up rebuilding the whole thing, including the part after the deletion.

A more appropriate function for the job is para from the recursion-schemes package (I've renamed one of the type variables):

para :: Recursive t => (Base t (t, r) -> r) -> t -> r

In the case of lists, this specializes to

para :: (ListF a ([a], r) -> r) -> [a] -> r

where

data ListF a b = Nil | Cons a b
  deriving (Functor, ....)

This is pretty similar to foldr. The recursion-schemes equivalent of foldr is

cata :: Recursive t => (Base t r -> r) -> t -> r

Which specializes to

cata :: (ListF a r -> r) -> [a] -> r

Take a break here and figure out why the type of cata is basically equivalent to that of foldr.


The difference between cata and para is that para passes the folding function not only the result of folding over the tail of the list, but also the tail of the list itself. That gives us an easy and efficient way to produce the rest of the list after we've found the first non-matching element:

filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst f = para go
  where
    --go :: ListF a ([a], [a]) -> [a]
    go (Cons a (tl, r))
      | f a = a : r
      | otherwise = tl
    go Nil = []

para is a bit awkward for lists, since it's designed to fit into a more general context. But just as cata and foldr are basically equivalent, we could write a slightly less awkward function specifically for lists.

foldrWithTails
  :: (a -> [a] -> b -> b)
  -> b -> [a] -> b
foldrWithTails f n = go
  where
    go (a : as) = f a as (go as)
    go [] = n

Then

filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst f = foldrWithTails go []
  where
    go a tl r
      | f a = a : r
      | otherwise = tl

If we really want, we can write filterFirst using foldr, since foldr is kind of "universal" -- it allows any list transformation we can perform using recursion. The main downside is that the resulting code is rather counter-intuitive. In my opinion, explicit recursion is far better in this case.

Anyway here's how it is done. This relies on what I consider to be an antipattern, namely "passing four arguments to foldr". I call this an antipattern since foldr is usually called with three arguments only, and the result is not a function taking a fourth argument.

filterFirst :: (a->Bool)->[a]->[a]
filterFirst p xs = foldr go (\_ -> []) xs True
   where
   go y ys True 
      | p y = y : ys True 
      | otherwise = ys False
   go y ys False = y : ys False

Clear? Not very much. The trick here is to exploit foldr to build a function Bool -> [a] which returns the original list if called with False, and the filtered-first list if called with True. If we craft that function using

foldr go baseCase xs

the result is then obviously

foldr go baseCase xs True

Now, the base case must handle the empty list, and in such case we must return a function returning the empty list, whatever the boolean argument is. Hence, we arrive at

foldr go (\_ -> []) xs True

Now, we need to define go. This takes as arguments:

  1. a list element y
  2. the result of the "recursion" ys (a function Bool->[a] for the rest of the list)

and must return a function Bool->[a] for the larger list. So let's also consider

  1. a boolean argument

and finally make go return a list. Well, if the boolean is False we must return the list unchanged, so

go y ys False = y : ys False

Note that ys False means "the tail unchanged", so we are really rebuilding the whole list unchanged.

If instead the boolean is true, we query the predicate as in p y. If that is false, we discard y, and return the list tail unchanged

   go y ys True 
      | p y = -- TODO
      | otherwise = ys False

If p y is true, we keep y and we return the list tail filtered.

   go y ys True 
      | p y = y : ys True
      | otherwise = ys False

As a final note, we cold have used a pair ([a], [a]) instead of a function Bool -> [a], but that approach does not generalize as well to more complex cases.

So, that's all. This technique is something nice to know, but I do not recommend it in real code which is meant to be understood by others.