module Control.Monad.SearchTree ( SearchTree(..), Search, searchTree ) where
import Control.Monad
import Control.Applicative
data SearchTree a = None | One a | Choice (SearchTree a) (SearchTree a)
deriving Show
instance Functor SearchTree where
fmap _ None = None
fmap f (One x) = One (f x)
fmap f (Choice s t) = Choice (fmap f s) (fmap f t)
instance Applicative SearchTree where
pure = return
(<*>) = ap
instance Alternative SearchTree where
empty = mzero
(<|>) = mplus
instance Monad SearchTree where
return = One
None >>= _ = None
One x >>= f = f x
Choice s t >>= f = Choice (s >>= f) (t >>= f)
fail _ = None
instance MonadPlus SearchTree where
mzero = None
mplus = Choice
newtype Search a = Search {
search :: forall r . (a -> SearchTree r) -> SearchTree r
}
searchTree :: Search a -> SearchTree a
searchTree a = search a One
instance Functor Search where
fmap f a = Search (\k -> search a (k . f))
instance Applicative Search where
pure = return
(<*>) = ap
instance Alternative Search where
empty = mzero
(<|>) = mplus
instance Monad Search where
return x = Search ($x)
a >>= f = Search (\k -> search a (\x -> search (f x) k))
fail _ = mzero
instance MonadPlus Search where
mzero = Search (const mzero)
a `mplus` b = Search (\k -> search a k `mplus` search b k)