{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Data.Set.ExtraG 
    ( gFind
    ) where

import Data.Generics hiding (GT)
import Control.Monad (MonadPlus, msum)
import Data.Set (Set, fromList)

gFind :: forall a b. (Data a, Typeable b, Ord b) => a -> Set b
gFind :: forall a b. (Data a, Typeable b, Ord b) => a -> Set b
gFind a
x = [b] -> Set b
forall a. Ord a => [a] -> Set a
fromList (a -> [b]
forall (m :: * -> *) a b.
(MonadPlus m, Data a, Typeable b) =>
a -> m b
gFind' a
x :: [b])

-- | @gFind a@ will extract any elements of type @b@ from
-- @a@'s structure in accordance with the MonadPlus
-- instance, e.g. Maybe Foo will return the first Foo
-- found while [Foo] will return the list of Foos found.
gFind' :: (MonadPlus m, Data a, Typeable b) => a -> m b
gFind' :: forall (m :: * -> *) a b.
(MonadPlus m, Data a, Typeable b) =>
a -> m b
gFind' = [m b] -> m b
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([m b] -> m b) -> (a -> [m b]) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> m b) -> [b] -> [m b]
forall a b. (a -> b) -> [a] -> [b]
map b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([b] -> [m b]) -> (a -> [b]) -> a -> [m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Bool) -> GenericQ [b]
forall r. Typeable r => (r -> Bool) -> GenericQ [r]
listify (Bool -> b -> Bool
forall a b. a -> b -> a
const Bool
True)