diff --git a/Data/Generics.hs b/Data/Generics.hs new file mode 100644 --- /dev/null +++ b/Data/Generics.hs @@ -0,0 +1,55 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Generics +-- Copyright : (c) The University of Glasgow, CWI 2001--2004 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable (uses Data.Generics.Basics) +-- +-- \"Scrap your boilerplate\" --- Generic programming in Haskell +-- See . To scrap your boilerplate it +-- is sufficient to import the present module, which simply re-exports all +-- themes of the Data.Generics library. +-- +-- For more information, please visit the new +-- SYB wiki: . +-- +----------------------------------------------------------------------------- + +module Data.Generics ( + + -- * All Data.Generics modules + module Data.Data, -- primitives and instances of the Data class + module Data.Generics.Aliases, -- aliases for type case, generic types + module Data.Generics.Schemes, -- traversal schemes (everywhere etc.) + module Data.Generics.Text, -- generic read and show + module Data.Generics.Twins, -- twin traversal, e.g., generic eq + +#ifndef __HADDOCK__ + -- Data types for the sum-of-products type encoding; + -- included for backwards compatibility; maybe obsolete. + (:*:)(..), (:+:)(..), Unit(..) +#endif + + ) where + +------------------------------------------------------------------------------ + +import Prelude -- So that 'make depend' works + +#ifdef __GLASGOW_HASKELL__ +#ifndef __HADDOCK__ + -- Data types for the sum-of-products type encoding; + -- included for backwards compatibility; maybe obsolete. +import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) ) +#endif +#endif + +import Data.Data +import Data.Generics.Instances () +import Data.Generics.Aliases +import Data.Generics.Schemes +import Data.Generics.Text +import Data.Generics.Twins diff --git a/Data/Generics/Aliases.hs b/Data/Generics/Aliases.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Aliases.hs @@ -0,0 +1,368 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Generics.Aliases +-- Copyright : (c) The University of Glasgow, CWI 2001--2004 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable (local universal quantification) +-- +-- \"Scrap your boilerplate\" --- Generic programming in Haskell +-- See . 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, 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, + + -- * Function combinators on generic functions + recoverMp, + recoverQ, + choiceMp, + choiceQ, + + -- * Type extension for unary type constructors + ext1T, + ext1M, + ext1Q, + ext1R + + ) where + +#ifdef __HADDOCK__ +import Prelude +#endif +import Control.Monad +import Data.Data + +------------------------------------------------------------------------------ +-- +-- Combinators to "make" generic functions +-- We use type-safe cast in a number of ways to make generic functions. +-- +------------------------------------------------------------------------------ + +-- | Make a generic transformation; +-- start from a type-specific case; +-- preserve the term otherwise +-- +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 +(r `mkQ` br) a = case cast a of + Just b -> br b + Nothing -> r + + +-- | Make a generic monadic transformation; +-- start from a type-specific case; +-- resort to return otherwise +-- +mkM :: ( Monad m + , Typeable a + , Typeable b + ) + => (b -> m b) + -> a + -> m a +mkM = extM return + + +{- + +For the remaining definitions, we stick to a more concise style, i.e., +we fold maybies with "maybe" instead of case ... of ..., and we also +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 + ) + => (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 +-- +mkR :: ( MonadPlus m + , Typeable a + , Typeable b + ) + => m b -> m a +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 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 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 + ) + => (a -> m a) -> (b -> m b) -> a -> m a +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 + ) + => (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 reader +extR :: ( Monad m + , Typeable a + , Typeable b + ) + => m a -> m b -> m a +extR def ext = unR ((R def) `ext0` (R ext)) + + + +------------------------------------------------------------------------------ +-- +-- Type synonyms for generic function types +-- +------------------------------------------------------------------------------ + + +-- | Generic transformations, +-- i.e., take an \"a\" and return an \"a\" +-- +type GenericT = forall a. Data a => a -> a + + +-- | Generic queries of type \"r\", +-- i.e., take any \"a\" and return an \"r\" +-- +type GenericQ r = forall a. Data a => a -> r + + +-- | Generic monadic transformations, +-- i.e., take an \"a\" and compute an \"a\" +-- +type GenericM m = forall a. Data a => a -> m a + + +-- | 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 GenericR m = forall a. Data a => m a + + +-- | The general scheme underlying generic functions +-- assumed by gfoldl; there are isomorphisms such as +-- GenericT = Generic T. +-- +type Generic c = forall a. Data a => a -> c a + + +-- | Wrapped generic functions; +-- recall: [Generic c] would be legal but [Generic' c] not. +-- +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 +x `orElse` y = case x of + Just _ -> x + Nothing -> y + + +{- + +The following variations take "orElse" to the function +level. Furthermore, we generalise from "Maybe" to any +"MonadPlus". This makes sense for monadic transformations and +queries. We say that the resulting combinators modell choice. We also +provide a prime example of choice, that is, recovery from failure. In +the case of transformations, we recover via return whereas for +queries a given constant is returned. + +-} + +-- | Choice for monadic transformations +choiceMp :: MonadPlus m => GenericM m -> GenericM m -> GenericM m +choiceMp f g x = f x `mplus` g x + + +-- | Choice for monadic queries +choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r) +choiceQ f g x = f x `mplus` g x + + +-- | Recover from the failure of monadic transformation by identity +recoverMp :: MonadPlus m => GenericM m -> GenericM m +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 d. Data d => c (t d)) + -> c a +ext1 def ext = maybe def id (dataCast1 ext) + + +-- | Type extension of transformations for unary type constructors +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)) + + +-- | Type extension of monadic transformations for type constructors +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)) + + +-- | Type extension of queries for type constructors +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)) + + +-- | Type extension of readers for type constructors +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)) + + + +------------------------------------------------------------------------------ +-- +-- 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 } diff --git a/Data/Generics/Basics.hs b/Data/Generics/Basics.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Basics.hs @@ -0,0 +1,26 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Generics.Basics +-- Copyright : (c) The University of Glasgow, CWI 2001--2004 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable (local universal quantification) +-- +-- \"Scrap your boilerplate\" --- Generic programming in Haskell. +-- See . This module provides +-- the 'Data' class with its primitives for generic programming, +-- which is now defined in @Data.Data@. Therefore this module simply +-- re-exports @Data.Data@. +-- +-- For more information, please visit the new +-- SYB wiki: . +-- +----------------------------------------------------------------------------- + +module Data.Generics.Basics ( + module Data.Data + ) where + +import Data.Data diff --git a/Data/Generics/Instances.hs b/Data/Generics/Instances.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Instances.hs @@ -0,0 +1,184 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Generics.Instances +-- Copyright : (c) The University of Glasgow, CWI 2001--2004 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable (uses Data.Data) +-- +-- \"Scrap your boilerplate\" --- Generic programming in Haskell +-- See . The present module +-- contains thirteen 'Data' instances which are considered dubious (either +-- because the types are abstract or just not meant to be traversed). +-- Instances in this module might change or disappear in future releases +-- of this package. +-- +-- For more information, please visit the new +-- SYB wiki: . +-- +-- (This module does not export anything. It really just defines instances.) +-- +----------------------------------------------------------------------------- + +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Data.Generics.Instances () where + +------------------------------------------------------------------------------ + +#ifdef __HADDOCK__ +import Prelude +#endif + +import Data.Data +import Data.Typeable + +#ifdef __GLASGOW_HASKELL__ +import GHC.IOBase -- So we can give Data instance for IO, Handle +import GHC.Stable -- So we can give Data instance for StablePtr +import GHC.ST -- So we can give Data instance for ST +import GHC.Conc -- So we can give Data instance for MVar & Co. +#else +# ifdef __HUGS__ +import Hugs.Prelude( Ratio(..) ) +# endif +import System.IO +import Foreign.Ptr +import Foreign.ForeignPtr +import Foreign.StablePtr +import Control.Monad.ST +import Control.Concurrent +import Data.IORef +#endif + +#include "Typeable.h" + + +------------------------------------------------------------------------------ +-- +-- Instances of the Data class for Prelude-like types. +-- We define top-level definitions for representations. +-- +------------------------------------------------------------------------------ + + +------------------------------------------------------------------------------ +-- Instances of abstract datatypes (6) +------------------------------------------------------------------------------ + +instance Data TypeRep where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep" + + +------------------------------------------------------------------------------ + +instance Data TyCon where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "Data.Typeable.TyCon" + + +------------------------------------------------------------------------------ + +INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType") + +instance Data DataType where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType" + + +------------------------------------------------------------------------------ + +instance Data Handle where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "GHC.IOBase.Handle" + + +------------------------------------------------------------------------------ + +instance Typeable a => Data (StablePtr a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr" + + +------------------------------------------------------------------------------ + +#ifdef __GLASGOW_HASKELL__ +instance Data ThreadId where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "GHC.Conc.ThreadId" +#endif + + +------------------------------------------------------------------------------ +-- Dubious instances (7) +------------------------------------------------------------------------------ + +#ifdef __GLASGOW_HASKELL__ +instance Typeable a => Data (TVar a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "GHC.Conc.TVar" +#endif + + +------------------------------------------------------------------------------ + +instance Typeable a => Data (MVar a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "GHC.Conc.MVar" + + +------------------------------------------------------------------------------ + +#ifdef __GLASGOW_HASKELL__ +instance Typeable a => Data (STM a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "GHC.Conc.STM" +#endif + + +------------------------------------------------------------------------------ + +instance (Typeable s, Typeable a) => Data (ST s a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "GHC.ST.ST" + + +------------------------------------------------------------------------------ + +instance Typeable a => Data (IORef a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "GHC.IOBase.IORef" + + +------------------------------------------------------------------------------ + +instance Typeable a => Data (IO a) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "GHC.IOBase.IO" + +------------------------------------------------------------------------------ + +-- +-- A last resort for functions +-- + +instance (Data a, Data b) => Data (a -> b) where + toConstr _ = error "toConstr" + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNorepType "Prelude.(->)" + dataCast2 f = gcast2 f + diff --git a/Data/Generics/Schemes.hs b/Data/Generics/Schemes.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Schemes.hs @@ -0,0 +1,168 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Generics.Schemes +-- Copyright : (c) The University of Glasgow, CWI 2001--2003 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable (local universal quantification) +-- +-- \"Scrap your boilerplate\" --- Generic programming in Haskell +-- See . The present module provides +-- frequently used generic traversal schemes. +-- +----------------------------------------------------------------------------- + +module Data.Generics.Schemes ( + + everywhere, + everywhere', + everywhereBut, + everywhereM, + somewhere, + everything, + listify, + something, + synthesize, + gsize, + glength, + gdepth, + gcount, + gnodecount, + gtypecount, + gfindtype + + ) where + +------------------------------------------------------------------------------ + +#ifdef __HADDOCK__ +import Prelude +#endif +import Data.Data +import Data.Generics.Aliases +import Control.Monad + + +-- | Apply a transformation everywhere in bottom-up manner +everywhere :: (forall a. Data a => a -> a) + -> (forall a. Data a => a -> a) + +-- Use gmapT to recurse into immediate subterms; +-- recall: gmapT preserves the outermost constructor; +-- post-process recursively transformed result via f +-- +everywhere f = f . gmapT (everywhere f) + + +-- | Apply a transformation everywhere in top-down manner +everywhere' :: (forall a. Data a => a -> a) + -> (forall a. Data a => a -> a) + +-- Arguments of (.) are flipped compared to everywhere +everywhere' f = gmapT (everywhere' f) . f + + +-- | Variation on everywhere with an extra stop condition +everywhereBut :: GenericQ Bool -> GenericT -> GenericT + +-- Guarded to let traversal cease if predicate q holds for x +everywhereBut q f x + | q x = x + | otherwise = f (gmapT (everywhereBut q f) x) + + +-- | Monadic variation on everywhere +everywhereM :: Monad m => GenericM m -> GenericM m + +-- Bottom-up order is also reflected in order of do-actions +everywhereM f x = do x' <- gmapM (everywhereM f) x + f x' + + +-- | Apply a monadic transformation at least somewhere +somewhere :: MonadPlus m => GenericM m -> GenericM m + +-- We try "f" in top-down manner, but descent into "x" when we fail +-- at the root of the term. The transformation fails if "f" fails +-- everywhere, say succeeds nowhere. +-- +somewhere f x = f x `mplus` gmapMp (somewhere f) x + + +-- | Summarise all nodes in top-down, left-to-right order +everything :: (r -> r -> r) -> GenericQ r -> GenericQ r + +-- Apply f to x to summarise top-level node; +-- use gmapQ to recurse into immediate subterms; +-- use ordinary foldl to reduce list of intermediate results +-- +everything k f x + = foldl k (f x) (gmapQ (everything k f) x) + + +-- | Get a list of all entities that meet a predicate +listify :: Typeable r => (r -> Bool) -> GenericQ [r] +listify p + = everything (++) ([] `mkQ` (\x -> if p x then [x] else [])) + + +-- | Look up a subterm by means of a maybe-typed filter +something :: GenericQ (Maybe u) -> GenericQ (Maybe u) + +-- "something" can be defined in terms of "everything" +-- when a suitable "choice" operator is used for reduction +-- +something = everything orElse + + +-- | Bottom-up synthesis of a data structure; +-- 1st argument z is the initial element for the synthesis; +-- 2nd argument o is for reduction of results from subterms; +-- 3rd argument f updates the synthesised data according to the given term +-- +synthesize :: s -> (t -> s -> s) -> GenericQ (s -> t) -> GenericQ t +synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x)) + + +-- | Compute size of an arbitrary data structure +gsize :: Data a => a -> Int +gsize t = 1 + sum (gmapQ gsize t) + + +-- | Count the number of immediate subterms of the given term +glength :: GenericQ Int +glength = length . gmapQ (const ()) + + +-- | Determine depth of the given term +gdepth :: GenericQ Int +gdepth = (+) 1 . foldr max 0 . gmapQ gdepth + + +-- | Determine the number of all suitable nodes in a given term +gcount :: GenericQ Bool -> GenericQ Int +gcount p = everything (+) (\x -> if p x then 1 else 0) + + +-- | Determine the number of all nodes in a given term +gnodecount :: GenericQ Int +gnodecount = gcount (const True) + + +-- | Determine the number of nodes of a given type in a given term +gtypecount :: Typeable a => a -> GenericQ Int +gtypecount (_::a) = gcount (False `mkQ` (\(_::a) -> True)) + + +-- | Find (unambiguously) an immediate subterm of a given type +gfindtype :: (Data x, Typeable y) => x -> Maybe y +gfindtype = singleton + . foldl unJust [] + . gmapQ (Nothing `mkQ` Just) + where + unJust l (Just x) = x:l + unJust l Nothing = l + singleton [s] = Just s + singleton _ = Nothing diff --git a/Data/Generics/Text.hs b/Data/Generics/Text.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Text.hs @@ -0,0 +1,124 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Generics.Text +-- Copyright : (c) The University of Glasgow, CWI 2001--2003 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable (uses Data.Generics.Basics) +-- +-- \"Scrap your boilerplate\" --- Generic programming in Haskell +-- See . The present module provides +-- generic operations for text serialisation of terms. +-- +----------------------------------------------------------------------------- + +module Data.Generics.Text ( + + gshow, + gread + + ) where + +------------------------------------------------------------------------------ + +#ifdef __HADDOCK__ +import Prelude +#endif +import Control.Monad +import Data.Maybe +import Data.Data +import Data.Generics.Aliases +import Text.ParserCombinators.ReadP + +------------------------------------------------------------------------------ + + +-- | Generic show: an alternative to \"deriving Show\" +gshow :: Data a => a -> String + +-- This is a prefix-show using surrounding "(" and ")", +-- where we recurse into subterms with gmapQ. +-- +gshow = ( \t -> + "(" + ++ showConstr (toConstr t) + ++ concat (gmapQ ((++) " " . gshow) t) + ++ ")" + ) `extQ` (show :: String -> String) + + + +-- | Generic read: an alternative to \"deriving Read\" +gread :: Data a => ReadS a + +{- + +This is a read operation which insists on prefix notation. (The +Haskell 98 read deals with infix operators subject to associativity +and precedence as well.) We use fromConstrM to "parse" the input. To be +precise, fromConstrM is used for all types except String. The +type-specific case for String uses basic String read. + +-} + +gread = readP_to_S gread' + + where + + -- Helper for recursive read + gread' :: Data a' => ReadP a' + gread' = allButString `extR` stringCase + + where + + -- A specific case for strings + stringCase :: ReadP String + stringCase = readS_to_P reads + + -- Determine result type + myDataType = dataTypeOf (getArg allButString) + where + getArg :: ReadP a'' -> a'' + getArg = undefined + + -- The generic default for gread + allButString = + do + -- Drop " ( " + skipSpaces -- Discard leading space + char '(' -- Parse '(' + skipSpaces -- Discard following space + + -- Do the real work + str <- parseConstr -- Get a lexeme for the constructor + con <- str2con str -- Convert it to a Constr (may fail) + x <- fromConstrM gread' con -- Read the children + + -- Drop " ) " + skipSpaces -- Discard leading space + char ')' -- Parse ')' + skipSpaces -- Discard following space + + return x + + -- Turn string into constructor driven by the requested result type, + -- failing in the monad if it isn't a constructor of this data type + str2con :: String -> ReadP Constr + str2con = maybe mzero return + . readConstr myDataType + + -- Get a Constr's string at the front of an input string + parseConstr :: ReadP String + parseConstr = + string "[]" -- Compound lexeme "[]" + <++ infixOp -- Infix operator in parantheses + <++ readS_to_P lex -- Ordinary constructors and literals + + -- Handle infix operators such as (:) + infixOp :: ReadP String + infixOp = do c1 <- char '(' + str <- munch1 (not . (==) ')') + c2 <- char ')' + return $ [c1] ++ str ++ [c2] diff --git a/Data/Generics/Twins.hs b/Data/Generics/Twins.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Twins.hs @@ -0,0 +1,250 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Generics.Twins +-- Copyright : (c) The University of Glasgow, CWI 2001--2004 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable (local universal quantification) +-- +-- \"Scrap your boilerplate\" --- Generic programming in Haskell +-- See . The present module +-- provides support for multi-parameter traversal, which is also +-- demonstrated with generic operations like equality. +-- +----------------------------------------------------------------------------- + +module Data.Generics.Twins ( + + -- * Generic folds and maps that also accumulate + gfoldlAccum, + gmapAccumT, + gmapAccumM, + gmapAccumQl, + gmapAccumQr, + gmapAccumQ, + + -- * Mapping combinators for twin traversal + gzipWithT, + gzipWithM, + gzipWithQ, + + -- * Typical twin traversals + geq, + gzip + + ) where + + +------------------------------------------------------------------------------ + +#ifdef __HADDOCK__ +import Prelude +#endif +import Data.Data +import Data.Generics.Aliases + +#ifdef __GLASGOW_HASKELL__ +import Prelude hiding ( GT ) +#endif + +------------------------------------------------------------------------------ + + +------------------------------------------------------------------------------ +-- +-- Generic folds and maps that also accumulate +-- +------------------------------------------------------------------------------ + +{-------------------------------------------------------------- + +A list map can be elaborated to perform accumulation. +In the same sense, we can elaborate generic maps over terms. + +We recall the type of map: +map :: (a -> b) -> [a] -> [b] + +We recall the type of an accumulating map (see Data.List): +mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c]) + +Applying the same scheme we obtain an accumulating gfoldl. + +--------------------------------------------------------------} + +-- | gfoldl with accumulation + +gfoldlAccum :: Data d + => (forall e r. Data e => a -> c (e -> r) -> e -> (a, c r)) + -> (forall g. a -> g -> (a, c g)) + -> a -> d -> (a, c d) + +gfoldlAccum k z a0 d = unA (gfoldl k' z' d) a0 + where + k' c y = A (\a -> let (a', c') = unA c a in k a' c' y) + z' f = A (\a -> z a f) + + +-- | A type constructor for accumulation +newtype A a c d = A { unA :: a -> (a, c d) } + + +-- | gmapT with accumulation +gmapAccumT :: Data d + => (forall e. Data e => a -> e -> (a,e)) + -> a -> d -> (a, d) +gmapAccumT f a0 d0 = let (a1, d1) = gfoldlAccum k z a0 d0 + in (a1, unID d1) + where + k a (ID c) d = let (a',d') = f a d + in (a', ID (c d')) + z a x = (a, ID x) + + +-- | gmapM with accumulation +gmapAccumM :: (Data d, Monad m) + => (forall e. Data e => a -> e -> (a, m e)) + -> a -> d -> (a, m d) +gmapAccumM f = gfoldlAccum k z + where + k a c d = let (a',d') = f a d + in (a', d' >>= \d'' -> c >>= \c' -> return (c' d'')) + z a x = (a, return x) + + +-- | gmapQl with accumulation +gmapAccumQl :: Data d + => (r -> r' -> r) + -> r + -> (forall e. Data e => a -> e -> (a,r')) + -> a -> d -> (a, r) +gmapAccumQl o r0 f a0 d0 = let (a1, r1) = gfoldlAccum k z a0 d0 + in (a1, unCONST r1) + where + k a (CONST c) d = let (a', r) = f a d + in (a', CONST (c `o` r)) + z a _ = (a, CONST r0) + + +-- | gmapQr with accumulation +gmapAccumQr :: Data d + => (r' -> r -> r) + -> r + -> (forall e. Data e => a -> e -> (a,r')) + -> a -> d -> (a, r) +gmapAccumQr o r0 f a0 d0 = let (a1, l) = gfoldlAccum k z a0 d0 + in (a1, unQr l r0) + where + k a (Qr c) d = let (a',r') = f a d + in (a', Qr (\r -> c (r' `o` r))) + z a _ = (a, Qr id) + + +-- | gmapQ with accumulation +gmapAccumQ :: Data d + => (forall e. Data e => a -> e -> (a,q)) + -> a -> d -> (a, [q]) +gmapAccumQ f = gmapAccumQr (:) [] f + + + +------------------------------------------------------------------------------ +-- +-- Helper type constructors +-- +------------------------------------------------------------------------------ + + +-- | The identity type constructor needed for the definition of gmapAccumT +newtype ID x = ID { unID :: x } + + +-- | The constant type constructor needed for the definition of gmapAccumQl +newtype CONST c a = CONST { unCONST :: c } + + +-- | The type constructor needed for the definition of gmapAccumQr +newtype Qr r a = Qr { unQr :: r -> r } + + + +------------------------------------------------------------------------------ +-- +-- Mapping combinators for twin traversal +-- +------------------------------------------------------------------------------ + + +-- | Twin map for transformation +gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT) +gzipWithT f x y = case gmapAccumT perkid funs y of + ([], c) -> c + _ -> error "gzipWithT" + where + perkid a d = (tail a, unGT (head a) d) + funs = gmapQ (\k -> GT (f k)) x + + + +-- | Twin map for monadic transformation +gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m) +gzipWithM f x y = case gmapAccumM perkid funs y of + ([], c) -> c + _ -> error "gzipWithM" + where + perkid a d = (tail a, unGM (head a) d) + funs = gmapQ (\k -> GM (f k)) x + + +-- | Twin map for queries +gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r]) +gzipWithQ f x y = case gmapAccumQ perkid funs y of + ([], r) -> r + _ -> error "gzipWithQ" + where + perkid a d = (tail a, unGQ (head a) d) + funs = gmapQ (\k -> GQ (f k)) x + + + +------------------------------------------------------------------------------ +-- +-- Typical twin traversals +-- +------------------------------------------------------------------------------ + +-- | Generic equality: an alternative to \"deriving Eq\" +geq :: Data a => a -> a -> Bool + +{- + +Testing for equality of two terms goes like this. Firstly, we +establish the equality of the two top-level datatype +constructors. Secondly, we use a twin gmap combinator, namely tgmapQ, +to compare the two lists of immediate subterms. + +(Note for the experts: the type of the worker geq' is rather general +but precision is recovered via the restrictive type of the top-level +operation geq. The imprecision of geq' is caused by the type system's +unability to express the type equivalence for the corresponding +couples of immediate subterms from the two given input terms.) + +-} + +geq x0 y0 = geq' x0 y0 + where + geq' :: GenericQ (GenericQ Bool) + geq' x y = (toConstr x == toConstr y) + && and (gzipWithQ geq' x y) + + +-- | Generic zip controlled by a function with type-specific branches +gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe) +-- See testsuite/.../Generics/gzip.hs for an illustration +gzip f x y = + f x y + `orElse` + if toConstr x == toConstr y + then gzipWithM (gzip f) x y + else Nothing diff --git a/src/Data/Generics.hs b/src/Data/Generics.hs deleted file mode 100644 --- a/src/Data/Generics.hs +++ /dev/null @@ -1,55 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Generics --- Copyright : (c) The University of Glasgow, CWI 2001--2004 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : generics@haskell.org --- Stability : experimental --- Portability : non-portable (uses Data.Generics.Basics) --- --- \"Scrap your boilerplate\" --- Generic programming in Haskell --- See . To scrap your boilerplate it --- is sufficient to import the present module, which simply re-exports all --- themes of the Data.Generics library. --- --- For more information, please visit the new --- SYB wiki: . --- ------------------------------------------------------------------------------ - -module Data.Generics ( - - -- * All Data.Generics modules - module Data.Data, -- primitives and instances of the Data class - module Data.Generics.Aliases, -- aliases for type case, generic types - module Data.Generics.Schemes, -- traversal schemes (everywhere etc.) - module Data.Generics.Text, -- generic read and show - module Data.Generics.Twins, -- twin traversal, e.g., generic eq - -#ifndef __HADDOCK__ - -- Data types for the sum-of-products type encoding; - -- included for backwards compatibility; maybe obsolete. - (:*:)(..), (:+:)(..), Unit(..) -#endif - - ) where - ------------------------------------------------------------------------------- - -import Prelude -- So that 'make depend' works - -#ifdef __GLASGOW_HASKELL__ -#ifndef __HADDOCK__ - -- Data types for the sum-of-products type encoding; - -- included for backwards compatibility; maybe obsolete. -import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) ) -#endif -#endif - -import Data.Data -import Data.Generics.Instances () -import Data.Generics.Aliases -import Data.Generics.Schemes -import Data.Generics.Text -import Data.Generics.Twins diff --git a/src/Data/Generics/Aliases.hs b/src/Data/Generics/Aliases.hs deleted file mode 100644 --- a/src/Data/Generics/Aliases.hs +++ /dev/null @@ -1,368 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Generics.Aliases --- Copyright : (c) The University of Glasgow, CWI 2001--2004 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : generics@haskell.org --- Stability : experimental --- Portability : non-portable (local universal quantification) --- --- \"Scrap your boilerplate\" --- Generic programming in Haskell --- See . 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, 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, - - -- * Function combinators on generic functions - recoverMp, - recoverQ, - choiceMp, - choiceQ, - - -- * Type extension for unary type constructors - ext1T, - ext1M, - ext1Q, - ext1R - - ) where - -#ifdef __HADDOCK__ -import Prelude -#endif -import Control.Monad -import Data.Data - ------------------------------------------------------------------------------- --- --- Combinators to "make" generic functions --- We use type-safe cast in a number of ways to make generic functions. --- ------------------------------------------------------------------------------- - --- | Make a generic transformation; --- start from a type-specific case; --- preserve the term otherwise --- -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 -(r `mkQ` br) a = case cast a of - Just b -> br b - Nothing -> r - - --- | Make a generic monadic transformation; --- start from a type-specific case; --- resort to return otherwise --- -mkM :: ( Monad m - , Typeable a - , Typeable b - ) - => (b -> m b) - -> a - -> m a -mkM = extM return - - -{- - -For the remaining definitions, we stick to a more concise style, i.e., -we fold maybies with "maybe" instead of case ... of ..., and we also -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 - ) - => (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 --- -mkR :: ( MonadPlus m - , Typeable a - , Typeable b - ) - => m b -> m a -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 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 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 - ) - => (a -> m a) -> (b -> m b) -> a -> m a -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 - ) - => (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 reader -extR :: ( Monad m - , Typeable a - , Typeable b - ) - => m a -> m b -> m a -extR def ext = unR ((R def) `ext0` (R ext)) - - - ------------------------------------------------------------------------------- --- --- Type synonyms for generic function types --- ------------------------------------------------------------------------------- - - --- | Generic transformations, --- i.e., take an \"a\" and return an \"a\" --- -type GenericT = forall a. Data a => a -> a - - --- | Generic queries of type \"r\", --- i.e., take any \"a\" and return an \"r\" --- -type GenericQ r = forall a. Data a => a -> r - - --- | Generic monadic transformations, --- i.e., take an \"a\" and compute an \"a\" --- -type GenericM m = forall a. Data a => a -> m a - - --- | 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 GenericR m = forall a. Data a => m a - - --- | The general scheme underlying generic functions --- assumed by gfoldl; there are isomorphisms such as --- GenericT = Generic T. --- -type Generic c = forall a. Data a => a -> c a - - --- | Wrapped generic functions; --- recall: [Generic c] would be legal but [Generic' c] not. --- -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 -x `orElse` y = case x of - Just _ -> x - Nothing -> y - - -{- - -The following variations take "orElse" to the function -level. Furthermore, we generalise from "Maybe" to any -"MonadPlus". This makes sense for monadic transformations and -queries. We say that the resulting combinators modell choice. We also -provide a prime example of choice, that is, recovery from failure. In -the case of transformations, we recover via return whereas for -queries a given constant is returned. - --} - --- | Choice for monadic transformations -choiceMp :: MonadPlus m => GenericM m -> GenericM m -> GenericM m -choiceMp f g x = f x `mplus` g x - - --- | Choice for monadic queries -choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r) -choiceQ f g x = f x `mplus` g x - - --- | Recover from the failure of monadic transformation by identity -recoverMp :: MonadPlus m => GenericM m -> GenericM m -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 d. Data d => c (t d)) - -> c a -ext1 def ext = maybe def id (dataCast1 ext) - - --- | Type extension of transformations for unary type constructors -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)) - - --- | Type extension of monadic transformations for type constructors -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)) - - --- | Type extension of queries for type constructors -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)) - - --- | Type extension of readers for type constructors -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)) - - - ------------------------------------------------------------------------------- --- --- 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 } diff --git a/src/Data/Generics/Basics.hs b/src/Data/Generics/Basics.hs deleted file mode 100644 --- a/src/Data/Generics/Basics.hs +++ /dev/null @@ -1,26 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Generics.Basics --- Copyright : (c) The University of Glasgow, CWI 2001--2004 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : generics@haskell.org --- Stability : experimental --- Portability : non-portable (local universal quantification) --- --- \"Scrap your boilerplate\" --- Generic programming in Haskell. --- See . This module provides --- the 'Data' class with its primitives for generic programming, --- which is now defined in @Data.Data@. Therefore this module simply --- re-exports @Data.Data@. --- --- For more information, please visit the new --- SYB wiki: . --- ------------------------------------------------------------------------------ - -module Data.Generics.Basics ( - module Data.Data - ) where - -import Data.Data diff --git a/src/Data/Generics/Instances.hs b/src/Data/Generics/Instances.hs deleted file mode 100644 --- a/src/Data/Generics/Instances.hs +++ /dev/null @@ -1,184 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Generics.Instances --- Copyright : (c) The University of Glasgow, CWI 2001--2004 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : generics@haskell.org --- Stability : experimental --- Portability : non-portable (uses Data.Data) --- --- \"Scrap your boilerplate\" --- Generic programming in Haskell --- See . The present module --- contains thirteen 'Data' instances which are considered dubious (either --- because the types are abstract or just not meant to be traversed). --- Instances in this module might change or disappear in future releases --- of this package. --- --- For more information, please visit the new --- SYB wiki: . --- --- (This module does not export anything. It really just defines instances.) --- ------------------------------------------------------------------------------ - -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Data.Generics.Instances () where - ------------------------------------------------------------------------------- - -#ifdef __HADDOCK__ -import Prelude -#endif - -import Data.Data -import Data.Typeable - -#ifdef __GLASGOW_HASKELL__ -import GHC.IOBase -- So we can give Data instance for IO, Handle -import GHC.Stable -- So we can give Data instance for StablePtr -import GHC.ST -- So we can give Data instance for ST -import GHC.Conc -- So we can give Data instance for MVar & Co. -#else -# ifdef __HUGS__ -import Hugs.Prelude( Ratio(..) ) -# endif -import System.IO -import Foreign.Ptr -import Foreign.ForeignPtr -import Foreign.StablePtr -import Control.Monad.ST -import Control.Concurrent -import Data.IORef -#endif - -#include "Typeable.h" - - ------------------------------------------------------------------------------- --- --- Instances of the Data class for Prelude-like types. --- We define top-level definitions for representations. --- ------------------------------------------------------------------------------- - - ------------------------------------------------------------------------------- --- Instances of abstract datatypes (6) ------------------------------------------------------------------------------- - -instance Data TypeRep where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Typeable.TypeRep" - - ------------------------------------------------------------------------------- - -instance Data TyCon where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Typeable.TyCon" - - ------------------------------------------------------------------------------- - -INSTANCE_TYPEABLE0(DataType,dataTypeTc,"DataType") - -instance Data DataType where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Generics.Basics.DataType" - - ------------------------------------------------------------------------------- - -instance Data Handle where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.IOBase.Handle" - - ------------------------------------------------------------------------------- - -instance Typeable a => Data (StablePtr a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.Stable.StablePtr" - - ------------------------------------------------------------------------------- - -#ifdef __GLASGOW_HASKELL__ -instance Data ThreadId where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.Conc.ThreadId" -#endif - - ------------------------------------------------------------------------------- --- Dubious instances (7) ------------------------------------------------------------------------------- - -#ifdef __GLASGOW_HASKELL__ -instance Typeable a => Data (TVar a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.Conc.TVar" -#endif - - ------------------------------------------------------------------------------- - -instance Typeable a => Data (MVar a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.Conc.MVar" - - ------------------------------------------------------------------------------- - -#ifdef __GLASGOW_HASKELL__ -instance Typeable a => Data (STM a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.Conc.STM" -#endif - - ------------------------------------------------------------------------------- - -instance (Typeable s, Typeable a) => Data (ST s a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.ST.ST" - - ------------------------------------------------------------------------------- - -instance Typeable a => Data (IORef a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.IOBase.IORef" - - ------------------------------------------------------------------------------- - -instance Typeable a => Data (IO a) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "GHC.IOBase.IO" - ------------------------------------------------------------------------------- - --- --- A last resort for functions --- - -instance (Data a, Data b) => Data (a -> b) where - toConstr _ = error "toConstr" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Prelude.(->)" - dataCast2 f = gcast2 f - diff --git a/src/Data/Generics/Schemes.hs b/src/Data/Generics/Schemes.hs deleted file mode 100644 --- a/src/Data/Generics/Schemes.hs +++ /dev/null @@ -1,168 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Generics.Schemes --- Copyright : (c) The University of Glasgow, CWI 2001--2003 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : generics@haskell.org --- Stability : experimental --- Portability : non-portable (local universal quantification) --- --- \"Scrap your boilerplate\" --- Generic programming in Haskell --- See . The present module provides --- frequently used generic traversal schemes. --- ------------------------------------------------------------------------------ - -module Data.Generics.Schemes ( - - everywhere, - everywhere', - everywhereBut, - everywhereM, - somewhere, - everything, - listify, - something, - synthesize, - gsize, - glength, - gdepth, - gcount, - gnodecount, - gtypecount, - gfindtype - - ) where - ------------------------------------------------------------------------------- - -#ifdef __HADDOCK__ -import Prelude -#endif -import Data.Data -import Data.Generics.Aliases -import Control.Monad - - --- | Apply a transformation everywhere in bottom-up manner -everywhere :: (forall a. Data a => a -> a) - -> (forall a. Data a => a -> a) - --- Use gmapT to recurse into immediate subterms; --- recall: gmapT preserves the outermost constructor; --- post-process recursively transformed result via f --- -everywhere f = f . gmapT (everywhere f) - - --- | Apply a transformation everywhere in top-down manner -everywhere' :: (forall a. Data a => a -> a) - -> (forall a. Data a => a -> a) - --- Arguments of (.) are flipped compared to everywhere -everywhere' f = gmapT (everywhere' f) . f - - --- | Variation on everywhere with an extra stop condition -everywhereBut :: GenericQ Bool -> GenericT -> GenericT - --- Guarded to let traversal cease if predicate q holds for x -everywhereBut q f x - | q x = x - | otherwise = f (gmapT (everywhereBut q f) x) - - --- | Monadic variation on everywhere -everywhereM :: Monad m => GenericM m -> GenericM m - --- Bottom-up order is also reflected in order of do-actions -everywhereM f x = do x' <- gmapM (everywhereM f) x - f x' - - --- | Apply a monadic transformation at least somewhere -somewhere :: MonadPlus m => GenericM m -> GenericM m - --- We try "f" in top-down manner, but descent into "x" when we fail --- at the root of the term. The transformation fails if "f" fails --- everywhere, say succeeds nowhere. --- -somewhere f x = f x `mplus` gmapMp (somewhere f) x - - --- | Summarise all nodes in top-down, left-to-right order -everything :: (r -> r -> r) -> GenericQ r -> GenericQ r - --- Apply f to x to summarise top-level node; --- use gmapQ to recurse into immediate subterms; --- use ordinary foldl to reduce list of intermediate results --- -everything k f x - = foldl k (f x) (gmapQ (everything k f) x) - - --- | Get a list of all entities that meet a predicate -listify :: Typeable r => (r -> Bool) -> GenericQ [r] -listify p - = everything (++) ([] `mkQ` (\x -> if p x then [x] else [])) - - --- | Look up a subterm by means of a maybe-typed filter -something :: GenericQ (Maybe u) -> GenericQ (Maybe u) - --- "something" can be defined in terms of "everything" --- when a suitable "choice" operator is used for reduction --- -something = everything orElse - - --- | Bottom-up synthesis of a data structure; --- 1st argument z is the initial element for the synthesis; --- 2nd argument o is for reduction of results from subterms; --- 3rd argument f updates the synthesised data according to the given term --- -synthesize :: s -> (t -> s -> s) -> GenericQ (s -> t) -> GenericQ t -synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x)) - - --- | Compute size of an arbitrary data structure -gsize :: Data a => a -> Int -gsize t = 1 + sum (gmapQ gsize t) - - --- | Count the number of immediate subterms of the given term -glength :: GenericQ Int -glength = length . gmapQ (const ()) - - --- | Determine depth of the given term -gdepth :: GenericQ Int -gdepth = (+) 1 . foldr max 0 . gmapQ gdepth - - --- | Determine the number of all suitable nodes in a given term -gcount :: GenericQ Bool -> GenericQ Int -gcount p = everything (+) (\x -> if p x then 1 else 0) - - --- | Determine the number of all nodes in a given term -gnodecount :: GenericQ Int -gnodecount = gcount (const True) - - --- | Determine the number of nodes of a given type in a given term -gtypecount :: Typeable a => a -> GenericQ Int -gtypecount (_::a) = gcount (False `mkQ` (\(_::a) -> True)) - - --- | Find (unambiguously) an immediate subterm of a given type -gfindtype :: (Data x, Typeable y) => x -> Maybe y -gfindtype = singleton - . foldl unJust [] - . gmapQ (Nothing `mkQ` Just) - where - unJust l (Just x) = x:l - unJust l Nothing = l - singleton [s] = Just s - singleton _ = Nothing diff --git a/src/Data/Generics/Text.hs b/src/Data/Generics/Text.hs deleted file mode 100644 --- a/src/Data/Generics/Text.hs +++ /dev/null @@ -1,124 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Generics.Text --- Copyright : (c) The University of Glasgow, CWI 2001--2003 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : generics@haskell.org --- Stability : experimental --- Portability : non-portable (uses Data.Generics.Basics) --- --- \"Scrap your boilerplate\" --- Generic programming in Haskell --- See . The present module provides --- generic operations for text serialisation of terms. --- ------------------------------------------------------------------------------ - -module Data.Generics.Text ( - - gshow, - gread - - ) where - ------------------------------------------------------------------------------- - -#ifdef __HADDOCK__ -import Prelude -#endif -import Control.Monad -import Data.Maybe -import Data.Data -import Data.Generics.Aliases -import Text.ParserCombinators.ReadP - ------------------------------------------------------------------------------- - - --- | Generic show: an alternative to \"deriving Show\" -gshow :: Data a => a -> String - --- This is a prefix-show using surrounding "(" and ")", --- where we recurse into subterms with gmapQ. --- -gshow = ( \t -> - "(" - ++ showConstr (toConstr t) - ++ concat (gmapQ ((++) " " . gshow) t) - ++ ")" - ) `extQ` (show :: String -> String) - - - --- | Generic read: an alternative to \"deriving Read\" -gread :: Data a => ReadS a - -{- - -This is a read operation which insists on prefix notation. (The -Haskell 98 read deals with infix operators subject to associativity -and precedence as well.) We use fromConstrM to "parse" the input. To be -precise, fromConstrM is used for all types except String. The -type-specific case for String uses basic String read. - --} - -gread = readP_to_S gread' - - where - - -- Helper for recursive read - gread' :: Data a' => ReadP a' - gread' = allButString `extR` stringCase - - where - - -- A specific case for strings - stringCase :: ReadP String - stringCase = readS_to_P reads - - -- Determine result type - myDataType = dataTypeOf (getArg allButString) - where - getArg :: ReadP a'' -> a'' - getArg = undefined - - -- The generic default for gread - allButString = - do - -- Drop " ( " - skipSpaces -- Discard leading space - char '(' -- Parse '(' - skipSpaces -- Discard following space - - -- Do the real work - str <- parseConstr -- Get a lexeme for the constructor - con <- str2con str -- Convert it to a Constr (may fail) - x <- fromConstrM gread' con -- Read the children - - -- Drop " ) " - skipSpaces -- Discard leading space - char ')' -- Parse ')' - skipSpaces -- Discard following space - - return x - - -- Turn string into constructor driven by the requested result type, - -- failing in the monad if it isn't a constructor of this data type - str2con :: String -> ReadP Constr - str2con = maybe mzero return - . readConstr myDataType - - -- Get a Constr's string at the front of an input string - parseConstr :: ReadP String - parseConstr = - string "[]" -- Compound lexeme "[]" - <++ infixOp -- Infix operator in parantheses - <++ readS_to_P lex -- Ordinary constructors and literals - - -- Handle infix operators such as (:) - infixOp :: ReadP String - infixOp = do c1 <- char '(' - str <- munch1 (not . (==) ')') - c2 <- char ')' - return $ [c1] ++ str ++ [c2] diff --git a/src/Data/Generics/Twins.hs b/src/Data/Generics/Twins.hs deleted file mode 100644 --- a/src/Data/Generics/Twins.hs +++ /dev/null @@ -1,250 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.Generics.Twins --- Copyright : (c) The University of Glasgow, CWI 2001--2004 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : generics@haskell.org --- Stability : experimental --- Portability : non-portable (local universal quantification) --- --- \"Scrap your boilerplate\" --- Generic programming in Haskell --- See . The present module --- provides support for multi-parameter traversal, which is also --- demonstrated with generic operations like equality. --- ------------------------------------------------------------------------------ - -module Data.Generics.Twins ( - - -- * Generic folds and maps that also accumulate - gfoldlAccum, - gmapAccumT, - gmapAccumM, - gmapAccumQl, - gmapAccumQr, - gmapAccumQ, - - -- * Mapping combinators for twin traversal - gzipWithT, - gzipWithM, - gzipWithQ, - - -- * Typical twin traversals - geq, - gzip - - ) where - - ------------------------------------------------------------------------------- - -#ifdef __HADDOCK__ -import Prelude -#endif -import Data.Data -import Data.Generics.Aliases - -#ifdef __GLASGOW_HASKELL__ -import Prelude hiding ( GT ) -#endif - ------------------------------------------------------------------------------- - - ------------------------------------------------------------------------------- --- --- Generic folds and maps that also accumulate --- ------------------------------------------------------------------------------- - -{-------------------------------------------------------------- - -A list map can be elaborated to perform accumulation. -In the same sense, we can elaborate generic maps over terms. - -We recall the type of map: -map :: (a -> b) -> [a] -> [b] - -We recall the type of an accumulating map (see Data.List): -mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c]) - -Applying the same scheme we obtain an accumulating gfoldl. - ---------------------------------------------------------------} - --- | gfoldl with accumulation - -gfoldlAccum :: Data d - => (forall e r. Data e => a -> c (e -> r) -> e -> (a, c r)) - -> (forall g. a -> g -> (a, c g)) - -> a -> d -> (a, c d) - -gfoldlAccum k z a0 d = unA (gfoldl k' z' d) a0 - where - k' c y = A (\a -> let (a', c') = unA c a in k a' c' y) - z' f = A (\a -> z a f) - - --- | A type constructor for accumulation -newtype A a c d = A { unA :: a -> (a, c d) } - - --- | gmapT with accumulation -gmapAccumT :: Data d - => (forall e. Data e => a -> e -> (a,e)) - -> a -> d -> (a, d) -gmapAccumT f a0 d0 = let (a1, d1) = gfoldlAccum k z a0 d0 - in (a1, unID d1) - where - k a (ID c) d = let (a',d') = f a d - in (a', ID (c d')) - z a x = (a, ID x) - - --- | gmapM with accumulation -gmapAccumM :: (Data d, Monad m) - => (forall e. Data e => a -> e -> (a, m e)) - -> a -> d -> (a, m d) -gmapAccumM f = gfoldlAccum k z - where - k a c d = let (a',d') = f a d - in (a', d' >>= \d'' -> c >>= \c' -> return (c' d'')) - z a x = (a, return x) - - --- | gmapQl with accumulation -gmapAccumQl :: Data d - => (r -> r' -> r) - -> r - -> (forall e. Data e => a -> e -> (a,r')) - -> a -> d -> (a, r) -gmapAccumQl o r0 f a0 d0 = let (a1, r1) = gfoldlAccum k z a0 d0 - in (a1, unCONST r1) - where - k a (CONST c) d = let (a', r) = f a d - in (a', CONST (c `o` r)) - z a _ = (a, CONST r0) - - --- | gmapQr with accumulation -gmapAccumQr :: Data d - => (r' -> r -> r) - -> r - -> (forall e. Data e => a -> e -> (a,r')) - -> a -> d -> (a, r) -gmapAccumQr o r0 f a0 d0 = let (a1, l) = gfoldlAccum k z a0 d0 - in (a1, unQr l r0) - where - k a (Qr c) d = let (a',r') = f a d - in (a', Qr (\r -> c (r' `o` r))) - z a _ = (a, Qr id) - - --- | gmapQ with accumulation -gmapAccumQ :: Data d - => (forall e. Data e => a -> e -> (a,q)) - -> a -> d -> (a, [q]) -gmapAccumQ f = gmapAccumQr (:) [] f - - - ------------------------------------------------------------------------------- --- --- Helper type constructors --- ------------------------------------------------------------------------------- - - --- | The identity type constructor needed for the definition of gmapAccumT -newtype ID x = ID { unID :: x } - - --- | The constant type constructor needed for the definition of gmapAccumQl -newtype CONST c a = CONST { unCONST :: c } - - --- | The type constructor needed for the definition of gmapAccumQr -newtype Qr r a = Qr { unQr :: r -> r } - - - ------------------------------------------------------------------------------- --- --- Mapping combinators for twin traversal --- ------------------------------------------------------------------------------- - - --- | Twin map for transformation -gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT) -gzipWithT f x y = case gmapAccumT perkid funs y of - ([], c) -> c - _ -> error "gzipWithT" - where - perkid a d = (tail a, unGT (head a) d) - funs = gmapQ (\k -> GT (f k)) x - - - --- | Twin map for monadic transformation -gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m) -gzipWithM f x y = case gmapAccumM perkid funs y of - ([], c) -> c - _ -> error "gzipWithM" - where - perkid a d = (tail a, unGM (head a) d) - funs = gmapQ (\k -> GM (f k)) x - - --- | Twin map for queries -gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r]) -gzipWithQ f x y = case gmapAccumQ perkid funs y of - ([], r) -> r - _ -> error "gzipWithQ" - where - perkid a d = (tail a, unGQ (head a) d) - funs = gmapQ (\k -> GQ (f k)) x - - - ------------------------------------------------------------------------------- --- --- Typical twin traversals --- ------------------------------------------------------------------------------- - --- | Generic equality: an alternative to \"deriving Eq\" -geq :: Data a => a -> a -> Bool - -{- - -Testing for equality of two terms goes like this. Firstly, we -establish the equality of the two top-level datatype -constructors. Secondly, we use a twin gmap combinator, namely tgmapQ, -to compare the two lists of immediate subterms. - -(Note for the experts: the type of the worker geq' is rather general -but precision is recovered via the restrictive type of the top-level -operation geq. The imprecision of geq' is caused by the type system's -unability to express the type equivalence for the corresponding -couples of immediate subterms from the two given input terms.) - --} - -geq x0 y0 = geq' x0 y0 - where - geq' :: GenericQ (GenericQ Bool) - geq' x y = (toConstr x == toConstr y) - && and (gzipWithQ geq' x y) - - --- | Generic zip controlled by a function with type-specific branches -gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe) --- See testsuite/.../Generics/gzip.hs for an illustration -gzip f x y = - f x y - `orElse` - if toConstr x == toConstr y - then gzipWithM (gzip f) x y - else Nothing diff --git a/syb.cabal b/syb.cabal --- a/syb.cabal +++ b/syb.cabal @@ -1,36 +1,34 @@ -name: syb -version: 0.1.0.0 -license: BSD3 -license-file: LICENSE -author: Ralf Lämmel, Simon Peyton Jones -maintainer: generics@haskell.org -homepage: http://www.cs.uu.nl/wiki/GenericProgramming/SYB -synopsis: Scrap Your Boilerplate +name: syb +version: 0.1.0.1 +license: BSD3 +license-file: LICENSE +maintainer: libraries@haskell.org +synopsis: Scrap Your Boilerplate description: This package contains the generics system described in the /Scrap Your Boilerplate/ papers (see ). It defines the @Data@ class of types permitting folding and unfolding of constructor applications, instances of this class for primitive types, and a variety of traversals. - -category: Generics -stability: provisional -build-type: Simple -cabal-version: >= 1.2.1 -tested-with: GHC == 6.10.1 +cabal-version: >=1.2 +build-type: Simple Library { - hs-source-dirs: src - - exposed-modules: Data.Generics, - Data.Generics.Basics, - Data.Generics.Instances, - Data.Generics.Aliases, - Data.Generics.Schemes, - Data.Generics.Text, - Data.Generics.Twins + build-depends: base + Extensions: CPP, Rank2Types, ScopedTypeVariables + exposed-modules: + Data.Generics + Data.Generics.Aliases + Data.Generics.Basics + Data.Generics.Instances + Data.Generics.Schemes + Data.Generics.Text + Data.Generics.Twins + -- We need to set the package name to syb (without a version number) + -- as it's magic. + ghc-options: -package-name syb - build-depends: base >= 4.0 - extensions: CPP, Rank2Types, ScopedTypeVariables - ghc-options: -Wall + if impl(ghc < 6.10) + -- PatternSignatures was deprecated in 6.10 + extensions: PatternSignatures }