Filter tree using a predicate, like the widgets to help finding file in directories.

FilterAndRemoveEmpty.hs

module FilterTree where
 
import Data.Maybe (mapMaybe)

data Tree a b = Leaf a
            | Node a [Tree a b]
            deriving Show

filterTree :: (a -> Bool) -> Tree a b -> Maybe (Tree a b)
filterTree p tree = 
  prune =<< filterChildren p tree

prune :: Tree a b -> Maybe (Tree a b)
prune (Leaf l) = Just $ Leaf l
prune (Node n children)
  | null children = Nothing
  | otherwise = Just $ Node n (mapMaybe prune children)

filterChildren :: (a -> Bool) -> Tree a b -> Maybe (Tree a b)
filterChildren p (Leaf l)
  | p l = Just $ Leaf l
  | otherwise = Nothing
filterChildren p node@(Node n children)
  | any p (leaves node) = Just $ Node n (mapMaybe (filterChildren p) children)
  | otherwise = Nothing

leaves :: Tree a b -> [a]
leaves (Leaf x) = [x]
leaves (Node _ children) = concatMap leaves children
 
main :: IO ()
main = do
  let tree =
          Node "hello" [
            Node "coucou" [Leaf "foo",
                           Node "bar" [Leaf "qux", Leaf "quox"] ],
            Node "yo" [Leaf "tt", Leaf "uu", Leaf "qux"]
            ]

  mapM_ print [filterTree p tree | p <- [(== "coucou"),
                                         (== "foo"),
                                         (=="qux"),
                                         (== "bar"),
                                         (== "other")]]

FilterTree.hs

module FilterTree where

import Data.Maybe (mapMaybe)

data Tree a = Leaf a
            | Node a [Tree a]
            deriving Show

filterTree :: (a -> Bool) -> Tree a -> Maybe (Tree a)
filterTree p (Leaf x)
  | p x = Just $ Leaf x
  | otherwise = Nothing
filterTree p n@(Node x children)
  | p x = Just $ Node x (mapMaybe (filterTree (const True)) children)
  | any p (deep n) = Just $ Node x (mapMaybe (filterTree p) children)
  | otherwise = Nothing
                  
deep :: Tree a -> [a]
deep (Leaf x) = [x]
deep (Node x children) = x:concatMap deep children

main :: IO ()
main = do
  let tree =
        Node "hello" [
            Node "coucou" [Leaf "foo",
                           Node "bar" [Leaf "qux", Leaf "quox"] ],
            Node "coucou" [Leaf "tt", Leaf "uu"]
            ]

  mapM_ print [filterTree p tree | p <- [(== "coucou"),
                                         (== "foo"),
                                         (=="qux"),
                                         (== "bar"),
                                         (== "other")]]