{-# LANGUAGE RankNTypes, CPP #-}
module Data.Generics.Aliases (
mkT, mkQ, mkM, mkMp, mkR,
ext0, extT, extQ, extM, extMp, extB, extR,
GenericT,
GenericQ,
GenericM,
GenericB,
GenericR,
Generic,
Generic'(..),
GenericT'(..),
GenericQ'(..),
GenericM'(..),
orElse,
recoverMp,
recoverQ,
choiceMp,
choiceQ,
ext1,
ext1T,
ext1M,
ext1Q,
ext1R,
ext1B,
ext2T,
ext2M,
ext2Q,
ext2R,
ext2B
) where
#ifdef __HADDOCK__
import Prelude
#endif
import Control.Monad
import Data.Data
mkT :: ( Typeable a
, Typeable b
)
=> (b -> b)
-> a
-> a
mkT = extT id
mkQ :: ( Typeable a
, Typeable b
)
=> r
-> (b -> r)
-> a
-> r
(r `mkQ` br) a = case cast a of
Just b -> br b
Nothing -> r
mkM :: ( Monad m
, Typeable a
, Typeable b
)
=> (b -> m b)
-> a
-> m a
mkM = extM return
mkMp :: ( MonadPlus m
, Typeable a
, Typeable b
)
=> (b -> m b)
-> a
-> m a
mkMp = extM (const mzero)
mkR :: ( MonadPlus m
, Typeable a
, Typeable b
)
=> m b -> m a
mkR f = mzero `extR` f
ext0 :: (Typeable a, Typeable b) => c a -> c b -> c a
ext0 def ext = maybe def id (gcast ext)
extT :: ( Typeable a
, Typeable b
)
=> (a -> a)
-> (b -> b)
-> a
-> a
extT def ext = unT ((T def) `ext0` (T ext))
extQ :: ( Typeable a
, Typeable b
)
=> (a -> q)
-> (b -> q)
-> a
-> q
extQ f g a = maybe (f a) g (cast a)
extM :: ( Monad m
, Typeable a
, Typeable b
)
=> (a -> m a) -> (b -> m b) -> a -> m a
extM def ext = unM ((M def) `ext0` (M ext))
extMp :: ( MonadPlus m
, Typeable a
, Typeable b
)
=> (a -> m a) -> (b -> m b) -> a -> m a
extMp = extM
extB :: ( Typeable a
, Typeable b
)
=> a -> b -> a
extB a = maybe a id . cast
extR :: ( Monad m
, Typeable a
, Typeable b
)
=> m a -> m b -> m a
extR def ext = unR ((R def) `ext0` (R ext))
type GenericT = forall a. Data a => a -> a
type GenericQ r = forall a. Data a => a -> r
type GenericM m = forall a. Data a => a -> m a
type GenericB = forall a. Data a => a
type GenericR m = forall a. Data a => m a
type Generic c = forall a. Data a => a -> c a
data Generic' c = Generic' { unGeneric' :: Generic c }
newtype GenericT' = GT { unGT :: forall a. Data a => a -> a }
newtype GenericQ' r = GQ { unGQ :: GenericQ r }
newtype GenericM' m = GM { unGM :: forall a. Data a => a -> m a }
orElse :: Maybe a -> Maybe a -> Maybe a
x `orElse` y = case x of
Just _ -> x
Nothing -> y
choiceMp :: MonadPlus m => GenericM m -> GenericM m -> GenericM m
choiceMp f g x = f x `mplus` g x
choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r)
choiceQ f g x = f x `mplus` g x
recoverMp :: MonadPlus m => GenericM m -> GenericM m
recoverMp f = f `choiceMp` return
recoverQ :: MonadPlus m => r -> GenericQ (m r) -> GenericQ (m r)
recoverQ r f = f `choiceQ` const (return r)
#if __GLASGOW_HASKELL__ >= 707
#define Typeable1 Typeable
#define Typeable2 Typeable
#endif
ext1 :: (Data a, Typeable1 t)
=> c a
-> (forall d. Data d => c (t d))
-> c a
ext1 def ext = maybe def id (dataCast1 ext)
ext1T :: (Data d, Typeable1 t)
=> (forall e. Data e => e -> e)
-> (forall f. Data f => t f -> t f)
-> d -> d
ext1T def ext = unT ((T def) `ext1` (T ext))
ext1M :: (Monad m, Data d, Typeable1 t)
=> (forall e. Data e => e -> m e)
-> (forall f. Data f => t f -> m (t f))
-> d -> m d
ext1M def ext = unM ((M def) `ext1` (M ext))
ext1Q :: (Data d, Typeable1 t)
=> (d -> q)
-> (forall e. Data e => t e -> q)
-> d -> q
ext1Q def ext = unQ ((Q def) `ext1` (Q ext))
ext1R :: (Monad m, Data d, Typeable1 t)
=> m d
-> (forall e. Data e => m (t e))
-> m d
ext1R def ext = unR ((R def) `ext1` (R ext))
ext1B :: (Data a, Typeable1 t)
=> a
-> (forall b. Data b => (t b))
-> a
ext1B def ext = unB ((B def) `ext1` (B ext))
ext2 :: (Data a, Typeable2 t)
=> c a
-> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))
-> c a
ext2 def ext = maybe def id (dataCast2 ext)
ext2T :: (Data d, Typeable2 t)
=> (forall e. Data e => e -> e)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> t d1 d2)
-> d -> d
ext2T def ext = unT ((T def) `ext2` (T ext))
ext2M :: (Monad m, Data d, Typeable2 t)
=> (forall e. Data e => e -> m e)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> m (t d1 d2))
-> d -> m d
ext2M def ext = unM ((M def) `ext2` (M ext))
ext2Q :: (Data d, Typeable2 t)
=> (d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)
-> d -> q
ext2Q def ext = unQ ((Q def) `ext2` (Q ext))
ext2R :: (Monad m, Data d, Typeable2 t)
=> m d
-> (forall d1 d2. (Data d1, Data d2) => m (t d1 d2))
-> m d
ext2R def ext = unR ((R def) `ext2` (R ext))
ext2B :: (Data a, Typeable2 t)
=> a
-> (forall d1 d2. (Data d1, Data d2) => (t d1 d2))
-> a
ext2B def ext = unB ((B def) `ext2` (B ext))
newtype T x = T { unT :: x -> x }
newtype M m x = M { unM :: x -> m x }
newtype Q q x = Q { unQ :: x -> q }
newtype R m x = R { unR :: m x }
newtype B x = B {unB :: x}