[project @ 2003-11-23 22:19:35 by ralf]

[haskell-directory.git] / Data / Generics / Basics.hs

diff --git a/Data/Generics/Basics.hs b/Data/Generics/Basics.hs
index ad16067..16b6a32 100644 (file)
--- a/Data/Generics/Basics.hs
+++ b/Data/Generics/Basics.hs
@@ -8,8 +8,9 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- "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
+-- the Data class with its primitives for generic programming.
 --
 -----------------------------------------------------------------------------
 
@@ -53,9 +54,7 @@ module Data.Generics.Basics (
         gmapQr,
         gmapM,
         gmapMp,
-
-       -- * Generic unfolding defined in terms of gfoldl and fromConstr
-       gunfoldM        -- :: Monad m => ... -> m a
+        gmapMo,
 
   ) where
 
@@ -246,8 +245,32 @@ this end, we couple the monadic computation with a Boolean.
       k (Mp c) x
         = Mp ( c >>= \(h,b) -> 
                  (f x >>= \x' -> return (h x',True))
-                 `mplus` return (h x, b)
-               )
+                 `mplus` return (h x,b)
+             )
+
+  -- | Transformation of one immediate subterm with success
+  gmapMo :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
+
+{-
+
+We use the same pairing trick as for gmapMp, 
+i.e., we use an extra Bool component to keep track of the 
+fact whether an immediate subterm was processed successfully.
+However, we cut of mapping over subterms once a first subterm
+was transformed successfully.
+
+-}
+
+  gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
+                if b then return x' else mzero
+    where
+      z g = Mp (return (g,False))
+      k (Mp c) x
+        = Mp ( c >>= \(h,b) -> if b 
+                        then return (h x,b)
+                        else (f x >>= \x' -> return (h x',True))
+                             `mplus` return (h x,b)
+             )
 
 
 -- | The identity type constructor needed for the definition of gmapT
@@ -549,6 +572,26 @@ instance (Data a, Data b) => Data (a,b) where
                    1 -> (undefined,undefined)
   dataTypeOf _ = productDataType
 
+--
+-- Yet another polymorphic datatype constructor.
+-- No surprises.
+--
+
+
+leftConstr     = mkConstr 1 "Left"  Prefix
+rightConstr    = mkConstr 2 "Right" Prefix
+eitherDataType = mkDataType [leftConstr,rightConstr]
+
+instance (Data a, Data b) => Data (Either a b) where
+  gfoldl f z (Left a)   = z Left  `f` a
+  gfoldl f z (Right a)  = z Right `f` a
+  toConstr (Left _)  = leftConstr
+  toConstr (Right _) = rightConstr
+  fromConstr c = case conIndex c of
+                   1 -> Left undefined
+                   2 -> Right undefined
+  dataTypeOf _ = eitherDataType
+
 
 {-
 
@@ -575,19 +618,3 @@ instance (Typeable a, Typeable b) => Data (a -> b) where
   toConstr _   = FunConstr
   fromConstr _ = undefined
   dataTypeOf _ = FunType
-
-
-------------------------------------------------------------------------------
---
---     Generic unfolding
---
-------------------------------------------------------------------------------
-
--- | Construct an initial with undefined immediate subterms
---   and then map over the skeleton to fill in proper terms.
---
-gunfoldM :: (Monad m, Data a)
-         => Constr
-         -> (forall a. Data a => m a)
-         -> m a
-gunfoldM c f = gmapM (const f) $ fromConstr c