Foldable search

FoldableSearch.hs

{-# language DeriveFunctor, DeriveFoldable, RankNTypes, LambdaCase #-}

-- -- Breadth first

-- import Control.Applicative
-- import Control.Monad

-- data Tree a = Zero | One a | Node (Tree a) (Tree a)

-- bfs :: (a -> Bool) -> Tree a -> Maybe a
-- bfs f t = go [t] [] where
--   go []            []   = Nothing
--   go []            next = go next []
--   go (Zero:ts)     next = go ts next
--   go (One a:ts)    next = (a <$ guard (f a)) <|> go ts next
--   go (Node l r:ts) next = go ts (l:r:next)

-- instance Semigroup (Tree a) where
--   (<>) = Node

-- instance Monoid (Tree a) where
--   mempty = Zero

-- search :: Foldable t => (a -> Bool) -> t a -> Maybe a
-- search f = bfs f . foldMap One


-- -- iterative deepening

newtype Search a = Search {runSearch :: Int -> Either a Bool}

instance Monoid (Search a) where
  mempty = Search $ \_ -> pure True

instance Semigroup (Search a) where
  Search f <> Search g = Search $ \case
    0 -> pure False
    n -> (&&) <$> f (n - 1) <*> g (n - 1)

search :: Foldable t => (a -> Bool) -> t a -> Maybe a
search p t = go 1 where
  go n     = case runSearch (foldMap single t) n of
               Left  a -> Just a
               Right b -> if b then Nothing else go (2*n)
  single a = Search $ \_ -> if p a then Left a else pure True