GOps.hs

module Happstack.Data.GOps where
import Data.Generics hiding (GT)
import Control.Monad.Reader
import Control.Monad.State
import Data.Maybe

-- useful generic functions with better names

-- | @gSet x y@ will traveral @x@ and replace 
-- any instances of the type @a@ in its structure 
-- with @y@.
gSet :: (Data b, Typeable a) => a -> b -> b
gSet = gReplace . const

-- | @gReplace f b@ will traverse @x@ and will act on
-- any instance of the type @a@ in its structure with
-- the function @f@.
gReplace :: (Typeable a, Data b) => (a -> a) -> b -> b
gReplace f x = everywhere (mkT f) x

-- | @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 = msum . map return . listify (const True)

-- | Acts as gFind but will throw an exception if
-- nothing is found.
gFind' :: (Data a, Typeable b) => a -> b
gFind' = fromJust . gFind
--Monad versions

-- | A generalized modify that will apply the modification
-- function to the structure of the state.
gModify :: (MonadState s m,Typeable a,Data s) => (a->a) -> m ()
gModify = modify . gReplace

-- | A generalized ask that will traverse the
-- stored type of the MonadReader in an attempt to find
-- an @a@ and will then apply the provided function if
-- found.
gAsk :: (Data r, Typeable a, MonadReader r m, MonadPlus n) =>
        (a -> n b) -> m (n b)
gAsk f = do st <- ask
            let y = gFind st 
            return $ maybe mzero f y

-- | The equivalent of 'gAsk' for MonadState
gGet :: (Data s, Typeable a, MonadState s m, MonadPlus n) =>
        (a -> n b) -> c -> m (n b)
gGet f _ = do st <- get
              let y = gFind st 
              return $ maybe mzero f y