Broad search for arbitrary Foldables; a solution to: https://github.com/effectfully-ou/haskell-challenges/tree/master/h9-traversable-search

Search.hs

{-# LANGUAGE GHC2021, BlockArguments, LambdaCase #-}

module Search (search) where

search :: Foldable f => (a -> Bool) -> f a -> Maybe a
search p = try . foldMap \x -> if p x
  then Succeed x
  else Fail


data Try a = Fail | Succeed a | Postpone (Try a)

-- The root of the evil.
instance Monoid    (Try a) where mempty = Fail
instance Semigroup (Try a) where
  t <> u = Postpone case t of
    Fail       -> u
    Succeed _  -> t
    Postpone v -> case u of
      Fail       -> v
      Succeed _  -> u
      Postpone w -> v <> w

try :: Try a -> Maybe a
try = \case
  Fail        -> Nothing
  Succeed   x -> Just x
  Postpone tx -> try tx

Taint.hs

{-# LANGUAGE GHC2021, BlockArguments #-}

module Taint (searchIsTainted) where

import Search

-- Do not be deceived; the evil that lurks in Search has /not/ been encapsulated!
searchIsTainted :: Bool
searchIsTainted = search (0 <) assocl /= search (0 <) assocr
 where
  -- The righteous do not discriminate by association.
  assocl, assocr :: FreeMonoid Int
  assocl = (singleton 1 <>  singleton 2) <> singleton 3
  assocr =  singleton 1 <> (singleton 2  <> singleton 3)


newtype FreeMonoid a = FM{ runFM :: forall m. Monoid m => (a -> m) -> m }

instance Monoid    (FreeMonoid a) where mempty   = FM  mempty
instance Semigroup (FreeMonoid a) where xs <> ys = FM (runFM xs <> runFM ys)

instance Foldable FreeMonoid where foldMap f xs = runFM xs f

singleton :: a -> FreeMonoid a
singleton x = FM \f -> f x

test-output.txt

Test suite h9-traversable-search-test: RUNNING...
all
  finite Matrix:   OK (0.07s)
    +++ OK, passed 3000 tests.
  finite Rose:     OK (0.09s)
    +++ OK, passed 3000 tests.
  finite Tree:     OK (0.09s)
    +++ OK, passed 3000 tests.
  inf:             OK
  infinite Matrix: OK (0.07s)
    +++ OK, passed 3000 tests.
  infinite Rose:   OK (0.13s)
    +++ OK, passed 3000 tests.
  infinite Tree:   OK (0.16s)
    +++ OK, passed 3000 tests.

All 7 tests passed (0.60s)
Test suite h9-traversable-search-test: PASS