Generic Filter

Filter.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}

module Filter where

import Data.Profunctor
import Data.Profunctor.Product
import Prelude hiding (filter)
import Control.Applicative

filter :: (Strong p, Choice p, ProductProfunctor p) => p a Bool -> p [a] [a]
filter = dimap \case [] -> Left ()
                     (x:xs) -> Right ((x,x), xs)
               \case Left () -> []
                     Right ((c, x), xs) | c         -> x : xs
                                        | otherwise ->     xs
               . right' . liftA2 (***!) first' filter

example1 :: [Int]
example1 = filter even [1..10]

example2 :: IO [Int]
example2 = (runStar . filter . Star) f [1,2,3]
  where f :: Int -> IO Bool
        f x = do
          putStr $ "line " <> show x <> ": "
          (>= 4) . length <$> getLine

filterA :: Applicative f => (a -> f Bool) -> [a] -> f [a]
filterA = runStar . filter . Star

alternative type signature: filter' :: (Strong p, Choice p, Applicative (p ((a, a), [a]))) => p a Bool -> p [a] [a]