X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FGenerics%2FAliases.hs;h=c37a98bbdf9d694761cf8b962e66484ebd91daf6;hb=6b1a36a595eddf1e124529646afdb75c76a9966d;hp=72574bf5cda27149e41c4588b36eb31e3079c46d;hpb=a1f5912fe0c0c73e87e1c7e254e4ea9a6060effd;p=haskell-directory.git

diff --git a/Data/Generics/Aliases.hs b/Data/Generics/Aliases.hs
index 72574bf..c37a98b 100644
--- a/Data/Generics/Aliases.hs
+++ b/Data/Generics/Aliases.hs
@@ -1,31 +1,37 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Generics.Aliases
--- Copyright   :  (c) The University of Glasgow, CWI 2001--2003
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
--- Portability :  non-portable
+-- Portability :  non-portable (local universal quantification)
 --
--- "Scrap your boilerplate" --- Generic programming in Haskell 
--- See <http://www.cs.vu.nl/boilerplate/>.
+-- \"Scrap your boilerplate\" --- Generic programming in Haskell 
+-- See <http://www.cs.vu.nl/boilerplate/>. The present module provides
+-- a number of declarations for typical generic function types,
+-- corresponding type case, and others.
 --
 -----------------------------------------------------------------------------
 
 module Data.Generics.Aliases ( 
 
 	-- * Combinators to \"make\" generic functions via cast
-	mkT, mkQ, mkM, mkMp, mkB,
-	extT, extQ, extM, extMp, extB,
+	mkT, mkQ, mkM, mkMp, mkR,
+	ext0, extT, extQ, extM, extMp, extB, extR,
 
 	-- * Type synonyms for generic function types
 	GenericT, 
 	GenericQ,
 	GenericM,
 	GenericB,
+	GenericR,
         Generic,
         Generic'(..),
+        GenericT'(..),
+        GenericQ'(..),
+        GenericM'(..),
 
 	-- * Inredients of generic functions
 	orElse,
@@ -34,16 +40,22 @@ module Data.Generics.Aliases (
 	recoverMp,
 	recoverQ,
 	choiceMp,
-	choiceQ
+	choiceQ,
 
-  ) where
+	-- * Type extension for unary type constructors
+	ext1T, 
+	ext1M,
+	ext1Q,
+	ext1R
 
+  ) where
 
+#ifdef __HADDOCK__
+import Prelude
+#endif
 import Control.Monad
 import Data.Generics.Basics
 
-
-
 ------------------------------------------------------------------------------
 --
 --	Combinators to "make" generic functions
@@ -55,17 +67,26 @@ import Data.Generics.Basics
 --   start from a type-specific case;
 --   preserve the term otherwise
 --
-mkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a
-mkT f = case cast f of
-               Just g -> g
-               Nothing -> id
+mkT :: ( Typeable a
+       , Typeable b
+       )
+    => (b -> b)
+    -> a 
+    -> a
+mkT = extT id
 
 
 -- | Make a generic query;
 --   start from a type-specific case;
 --   return a constant otherwise
 --
-mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
+mkQ :: ( Typeable a
+       , Typeable b
+       )
+    => r
+    -> (b -> r)
+    -> a 
+    -> r
 (r `mkQ` br) a = case cast a of
                         Just b  -> br b
                         Nothing -> r
@@ -75,14 +96,14 @@ mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
 --   start from a type-specific case;
 --   resort to return otherwise
 --
-mkM :: ( Monad m,
-         Typeable a,
-         Typeable b
+mkM :: ( Monad m
+       , Typeable a
+       , Typeable b
        )
-    => (b -> m b) -> a -> m a
-mkM f = case castarr f of
-              Just g  -> g
-              Nothing -> return
+    => (b -> m b)
+    -> a 
+    -> m a
+mkM = extM return
 
 
 {-
@@ -97,62 +118,89 @@ use a point-free style whenever possible.
 -- | Make a generic monadic transformation for MonadPlus;
 --   use \"const mzero\" (i.e., failure) instead of return as default.
 --
-mkMp :: ( MonadPlus m,
-          Typeable a,
-          Typeable b
+mkMp :: ( MonadPlus m
+        , Typeable a
+        , Typeable b
         )
-     => (b -> m b) -> a -> m a
-mkMp = maybe (const mzero) id . castarr
+     => (b -> m b)
+     -> a
+     -> m a
+mkMp = extM (const mzero)
 
 
 -- | Make a generic builder;
 --   start from a type-specific ase;
 --   resort to no build (i.e., mzero) otherwise
 --
-mkB :: ( MonadPlus m,
-         Typeable a,
-         Typeable b
+mkR :: ( MonadPlus m
+       , Typeable a
+       , Typeable b
        )
     => m b -> m a
-mkB = maybe mzero id . castss
+mkR f = mzero `extR` f
+
+
+-- | Flexible type extension
+ext0 :: (Typeable a, Typeable b) => c a -> c b -> c a
+ext0 def ext = maybe def id (gcast ext)
 
 
 -- | Extend a generic transformation by a type-specific case
-extT :: (Typeable a, Typeable b) => (a -> a) -> (b -> b) -> a -> a
-extT f = maybe f id . cast
+extT :: ( Typeable a
+        , Typeable b
+        )
+     => (a -> a)
+     -> (b -> b)
+     -> a
+     -> a
+extT def ext = unT ((T def) `ext0` (T ext))
 
 
 -- | Extend a generic query by a type-specific case
-extQ :: (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q
+extQ :: ( Typeable a
+        , Typeable b
+        )
+     => (a -> q)
+     -> (b -> q)
+     -> a
+     -> q
 extQ f g a = maybe (f a) g (cast a)
 
 
 -- | Extend a generic monadic transformation by a type-specific case
-extM :: ( Monad m,
-          Typeable a,
-          Typeable b
+extM :: ( Monad m
+        , Typeable a
+        , Typeable b
         )
      => (a -> m a) -> (b -> m b) -> a -> m a
-extM f = maybe f id . castarr
+extM def ext = unM ((M def) `ext0` (M ext))
 
 
 -- | Extend a generic MonadPlus transformation by a type-specific case
-extMp :: ( MonadPlus m,
-           Typeable a,
-           Typeable b
+extMp :: ( MonadPlus m
+         , Typeable a
+         , Typeable b
          )
       => (a -> m a) -> (b -> m b) -> a -> m a
 extMp = extM
 
 
+-- | Extend a generic builder
+extB :: ( Typeable a
+        , Typeable b
+        )
+     => a -> b -> a
+extB a = maybe a id . cast
+
 
--- | Extend a generic builder by a type-specific case
-extB :: (Monad m,
-         Typeable a,
-         Typeable b
+-- | Extend a generic reader
+extR :: ( Monad m
+        , Typeable a
+        , Typeable b
         )
      => m a -> m b -> m a
-extB f = maybe f id . castss
+extR def ext = unR ((R def) `ext0` (R ext))
+
 
 
 ------------------------------------------------------------------------------
@@ -180,15 +228,21 @@ type GenericQ r = forall a. Data a => a -> r
 type GenericM m = forall a. Data a => a -> m a
 
 
--- | Generic monadic builders with input i,
+-- | Generic builders
+--   i.e., produce an \"a\".
+--
+type GenericB = forall a. Data a => a
+
+
+-- | Generic readers, say monadic builders,
 --   i.e., produce an \"a\" with the help of a monad \"m\".
 --
-type GenericB m = forall a. Data a => m a
+type GenericR m = forall a. Data a => m a
 
 
 -- | The general scheme underlying generic functions
 --   assumed by gfoldl; there are isomorphisms such as
---   GenericT = Generic ID.
+--   GenericT = Generic T.
 --
 type Generic c = forall a. Data a => a -> c a
 
@@ -199,6 +253,11 @@ type Generic c = forall a. Data a => a -> c a
 data Generic' c = Generic' { unGeneric' :: Generic c }
 
 
+-- | Other first-class polymorphic wrappers
+newtype GenericT'   = GT { unGT :: Data a => a -> a }
+newtype GenericQ' r = GQ { unGQ :: GenericQ r }
+newtype GenericM' m = GM { unGM :: Data a => a -> m a }
+
 
 -- | Left-biased choice on maybies
 orElse :: Maybe a -> Maybe a -> Maybe a
@@ -237,3 +296,73 @@ recoverMp f = f `choiceMp` return
 -- | Recover from the failure of monadic query by a constant
 recoverQ :: MonadPlus m => r -> GenericQ (m r) -> GenericQ (m r)
 recoverQ r f = f `choiceQ` const (return r)
+
+
+
+------------------------------------------------------------------------------
+--
+--	Type extension for unary type constructors
+--
+------------------------------------------------------------------------------
+
+
+
+-- | Flexible type extension
+ext1 :: (Data a, Typeable1 t)
+     => c a
+     -> (forall a. Data a => c (t a))
+     -> c a
+ext1 def ext = maybe def id (dataCast1 ext)
+
+
+-- | Type extension of transformations for unary type constructors
+ext1T :: (Data d, Typeable1 t)
+      => (forall d. Data d => d -> d)
+      -> (forall d. Data d => t d -> t d)
+      -> d -> d
+ext1T def ext = unT ((T def) `ext1` (T ext))
+
+
+-- | Type extension of monadic transformations for type constructors
+ext1M :: (Monad m, Data d, Typeable1 t)
+      => (forall d. Data d => d -> m d)
+      -> (forall d. Data d => t d -> m (t d))
+      -> d -> m d
+ext1M def ext = unM ((M def) `ext1` (M ext))
+
+
+-- | Type extension of queries for type constructors
+ext1Q :: (Data d, Typeable1 t)
+      => (d -> q)
+      -> (forall d. Data d => t d -> q)
+      -> d -> q
+ext1Q def ext = unQ ((Q def) `ext1` (Q ext))
+
+
+-- | Type extension of readers for type constructors
+ext1R :: (Monad m, Data d, Typeable1 t)
+      => m d
+      -> (forall d. Data d => m (t d))
+      -> m d
+ext1R def ext = unR ((R def) `ext1` (R ext))
+
+
+
+------------------------------------------------------------------------------
+--
+--	Type constructors for type-level lambdas
+--
+------------------------------------------------------------------------------
+
+
+-- | The type constructor for transformations
+newtype T x = T { unT :: x -> x }
+
+-- | The type constructor for transformations
+newtype M m x = M { unM :: x -> m x }
+
+-- | The type constructor for queries
+newtype Q q x = Q { unQ :: x -> q }
+
+-- | The type constructor for readers
+newtype R m x = R { unR :: m x }