[project @ 2005-10-13 11:09:50 by ross]
[haskell-directory.git] / Data / Generics / Aliases.hs
index c3badad..c37a98b 100644 (file)
@@ -1,12 +1,12 @@
 -----------------------------------------------------------------------------
 -- |
 -- 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/>. The present module provides
@@ -19,7 +19,7 @@ module Data.Generics.Aliases (
 
        -- * Combinators to \"make\" generic functions via cast
        mkT, mkQ, mkM, mkMp, mkR,
-       extT, extQ, extM, extMp, extB, extR,
+       ext0, extT, extQ, extM, extMp, extB, extR,
 
        -- * Type synonyms for generic function types
        GenericT, 
@@ -29,6 +29,9 @@ module Data.Generics.Aliases (
        GenericR,
         Generic,
         Generic'(..),
+        GenericT'(..),
+        GenericQ'(..),
+        GenericM'(..),
 
        -- * Inredients of generic functions
        orElse,
@@ -39,18 +42,20 @@ module Data.Generics.Aliases (
        choiceMp,
        choiceQ,
 
-        -- * Operators for (over-appreciated) unfolding
-        gunfoldB,
-        gunfoldR
+       -- * 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
@@ -68,9 +73,7 @@ mkT :: ( Typeable a
     => (b -> b)
     -> a 
     -> a
-mkT f = case cast f of
-               Just g -> g
-               Nothing -> id
+mkT = extT id
 
 
 -- | Make a generic query;
@@ -100,9 +103,7 @@ mkM :: ( Monad m
     => (b -> m b)
     -> a 
     -> m a
-mkM f = case castarr f of
-              Just g  -> g
-              Nothing -> return
+mkM = extM return
 
 
 {-
@@ -124,7 +125,7 @@ mkMp :: ( MonadPlus m
      => (b -> m b)
      -> a
      -> m a
-mkMp = maybe (const mzero) id . castarr
+mkMp = extM (const mzero)
 
 
 -- | Make a generic builder;
@@ -136,18 +137,23 @@ mkR :: ( MonadPlus m
        , Typeable b
        )
     => m b -> m a
-mkR = 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 
+        , Typeable b
         )
      => (a -> a)
      -> (b -> b)
      -> a
      -> a
-extT f = maybe f id . cast
+extT def ext = unT ((T def) `ext0` (T ext))
 
 
 -- | Extend a generic query by a type-specific case
@@ -167,7 +173,7 @@ extM :: ( Monad m
         , 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
@@ -193,7 +199,8 @@ extR :: ( Monad m
         , Typeable b
         )
      => m a -> m b -> m a
-extR f = maybe f id . castss
+extR def ext = unR ((R def) `ext0` (R ext))
+
 
 
 ------------------------------------------------------------------------------
@@ -235,7 +242,7 @@ 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
 
@@ -246,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
@@ -289,22 +301,68 @@ recoverQ r f = f `choiceQ` const (return r)
 
 ------------------------------------------------------------------------------
 --
---     Generic unfolding
+--     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
 --
 ------------------------------------------------------------------------------
 
--- | Construct an initial term with undefined immediate subterms
---   and then map over the skeleton to fill in proper terms.
-gunfoldB :: Data a
-         => Constr
-         -> (forall a. Data a => a)
-         -> a
-gunfoldB c f = gmapT (const f) (fromConstr c)
-
-
--- | Monadic variation on \"gunfoldB\"
-gunfoldR :: (Monad m, Data a)
-         => Constr
-         -> (forall a. Data a => m a)
-         -> m a
-gunfoldR c f = gmapM (const f) $ fromConstr c
+
+-- | 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 }