{-# LANGUAGE Rank2Types #-}
module Control.Monad.SearchTree ( SearchTree(..), Search, searchTree ) where
import Control.Applicative
import Control.Monad
data SearchTree a = None | One a | Choice (SearchTree a) (SearchTree a)
deriving Int -> SearchTree a -> ShowS
[SearchTree a] -> ShowS
SearchTree a -> String
(Int -> SearchTree a -> ShowS)
-> (SearchTree a -> String)
-> ([SearchTree a] -> ShowS)
-> Show (SearchTree a)
forall a. Show a => Int -> SearchTree a -> ShowS
forall a. Show a => [SearchTree a] -> ShowS
forall a. Show a => SearchTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchTree a] -> ShowS
$cshowList :: forall a. Show a => [SearchTree a] -> ShowS
show :: SearchTree a -> String
$cshow :: forall a. Show a => SearchTree a -> String
showsPrec :: Int -> SearchTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SearchTree a -> ShowS
Show
instance Functor SearchTree where
fmap :: (a -> b) -> SearchTree a -> SearchTree b
fmap _ None = SearchTree b
forall a. SearchTree a
None
fmap f :: a -> b
f (One x :: a
x) = b -> SearchTree b
forall a. a -> SearchTree a
One (a -> b
f a
x)
fmap f :: a -> b
f (Choice s :: SearchTree a
s t :: SearchTree a
t) = SearchTree b -> SearchTree b -> SearchTree b
forall a. SearchTree a -> SearchTree a -> SearchTree a
Choice ((a -> b) -> SearchTree a -> SearchTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f SearchTree a
s) ((a -> b) -> SearchTree a -> SearchTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f SearchTree a
t)
instance Applicative SearchTree where
pure :: a -> SearchTree a
pure = a -> SearchTree a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: SearchTree (a -> b) -> SearchTree a -> SearchTree b
(<*>) = SearchTree (a -> b) -> SearchTree a -> SearchTree b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Alternative SearchTree where
empty :: SearchTree a
empty = SearchTree a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: SearchTree a -> SearchTree a -> SearchTree a
(<|>) = SearchTree a -> SearchTree a -> SearchTree a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance Monad SearchTree where
return :: a -> SearchTree a
return = a -> SearchTree a
forall a. a -> SearchTree a
One
None >>= :: SearchTree a -> (a -> SearchTree b) -> SearchTree b
>>= _ = SearchTree b
forall a. SearchTree a
None
One x :: a
x >>= f :: a -> SearchTree b
f = a -> SearchTree b
f a
x
Choice s :: SearchTree a
s t :: SearchTree a
t >>= f :: a -> SearchTree b
f = SearchTree b -> SearchTree b -> SearchTree b
forall a. SearchTree a -> SearchTree a -> SearchTree a
Choice (SearchTree a
s SearchTree a -> (a -> SearchTree b) -> SearchTree b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> SearchTree b
f) (SearchTree a
t SearchTree a -> (a -> SearchTree b) -> SearchTree b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> SearchTree b
f)
instance MonadFail SearchTree where
fail :: String -> SearchTree a
fail _ = SearchTree a
forall a. SearchTree a
None
instance MonadPlus SearchTree where
mzero :: SearchTree a
mzero = SearchTree a
forall a. SearchTree a
None
mplus :: SearchTree a -> SearchTree a -> SearchTree a
mplus = SearchTree a -> SearchTree a -> SearchTree a
forall a. SearchTree a -> SearchTree a -> SearchTree a
Choice
newtype Search a = Search
{
Search a -> forall r. (a -> SearchTree r) -> SearchTree r
search :: forall r. (a -> SearchTree r) -> SearchTree r
}
searchTree :: Search a -> SearchTree a
searchTree :: Search a -> SearchTree a
searchTree a :: Search a
a = Search a -> (a -> SearchTree a) -> SearchTree a
forall a. Search a -> forall r. (a -> SearchTree r) -> SearchTree r
search Search a
a a -> SearchTree a
forall a. a -> SearchTree a
One
instance Functor Search where
fmap :: (a -> b) -> Search a -> Search b
fmap f :: a -> b
f a :: Search a
a = (forall r. (b -> SearchTree r) -> SearchTree r) -> Search b
forall a.
(forall r. (a -> SearchTree r) -> SearchTree r) -> Search a
Search (\k :: b -> SearchTree r
k -> Search a -> (a -> SearchTree r) -> SearchTree r
forall a. Search a -> forall r. (a -> SearchTree r) -> SearchTree r
search Search a
a (b -> SearchTree r
k (b -> SearchTree r) -> (a -> b) -> a -> SearchTree r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
instance Applicative Search where
pure :: a -> Search a
pure = a -> Search a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: Search (a -> b) -> Search a -> Search b
(<*>) = Search (a -> b) -> Search a -> Search b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Alternative Search where
empty :: Search a
empty = Search a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: Search a -> Search a -> Search a
(<|>) = Search a -> Search a -> Search a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance Monad Search where
return :: a -> Search a
return x :: a
x = (forall r. (a -> SearchTree r) -> SearchTree r) -> Search a
forall a.
(forall r. (a -> SearchTree r) -> SearchTree r) -> Search a
Search ((a -> SearchTree r) -> a -> SearchTree r
forall a b. (a -> b) -> a -> b
$ a
x)
a :: Search a
a >>= :: Search a -> (a -> Search b) -> Search b
>>= f :: a -> Search b
f = (forall r. (b -> SearchTree r) -> SearchTree r) -> Search b
forall a.
(forall r. (a -> SearchTree r) -> SearchTree r) -> Search a
Search (\k :: b -> SearchTree r
k -> Search a -> (a -> SearchTree r) -> SearchTree r
forall a. Search a -> forall r. (a -> SearchTree r) -> SearchTree r
search Search a
a (\x :: a
x -> Search b -> (b -> SearchTree r) -> SearchTree r
forall a. Search a -> forall r. (a -> SearchTree r) -> SearchTree r
search (a -> Search b
f a
x) b -> SearchTree r
k))
instance MonadFail Search where
fail :: String -> Search a
fail _ = Search a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance MonadPlus Search where
mzero :: Search a
mzero = (forall r. (a -> SearchTree r) -> SearchTree r) -> Search a
forall a.
(forall r. (a -> SearchTree r) -> SearchTree r) -> Search a
Search (SearchTree r -> (a -> SearchTree r) -> SearchTree r
forall a b. a -> b -> a
const SearchTree r
forall (m :: * -> *) a. MonadPlus m => m a
mzero)
a :: Search a
a mplus :: Search a -> Search a -> Search a
`mplus` b :: Search a
b = (forall r. (a -> SearchTree r) -> SearchTree r) -> Search a
forall a.
(forall r. (a -> SearchTree r) -> SearchTree r) -> Search a
Search (\k :: a -> SearchTree r
k -> Search a -> (a -> SearchTree r) -> SearchTree r
forall a. Search a -> forall r. (a -> SearchTree r) -> SearchTree r
search Search a
a a -> SearchTree r
k SearchTree r -> SearchTree r -> SearchTree r
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Search a -> (a -> SearchTree r) -> SearchTree r
forall a. Search a -> forall r. (a -> SearchTree r) -> SearchTree r
search Search a
b a -> SearchTree r
k)