-----------------------------------------------------------------------------
-- |
-- Module : Data.Generics.Basics
--- 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
--
--- "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.
--
-----------------------------------------------------------------------------
module Data.Generics.Basics (
- -- Module Data.Typeable re-exported for convenience
+ -- * Module Data.Typeable re-exported for convenience
module Data.Typeable,
-- * The Data class for processing constructor applications
gfoldl, -- :: ... -> a -> c a
toConstr, -- :: a -> Constr
fromConstr, -- :: Constr -> a
- dataTypeOf -- :: a -> DataType
-
+ dataTypeOf, -- :: a -> DataType
+ dataCast1, -- mediate types and unary type constructors
+ dataCast2 -- mediate types and binary type constructors
),
- -- * Constructor representations
+ -- * Datatype representations
+ DataType, -- abstract, instance of: Show
Constr, -- abstract, instance of: Eq, Show
+ DataRep(..), -- instance of: Eq, Show
+ ConstrRep(..), -- instance of: Eq, Show
ConIndex, -- alias for Int, start at 1
Fixity(..), -- instance of: Eq, Show
- DataType, -- abstract, instance of: Show
- -- * Constructing constructor representations
- mkConstr, -- :: ConIndex -> String -> Fixity -> Constr
- mkDataType, -- :: [Constr] -> DataType
-
- -- * Observing constructor representations
- conString, -- :: Constr -> String
- conFixity, -- :: Constr -> Fixity
- conIndex, -- :: Constr -> ConIndex
- stringCon, -- :: DataType -> String -> Maybe Constr
- indexCon, -- :: DataType -> ConIndex -> Constr
- maxConIndex, -- :: DataType -> ConIndex
- dataTypeCons, -- :: DataType -> [Constr]
+ -- * Observers for datatype representations
+ dataTypeName, -- :: DataType -> String
+ dataTypeRep, -- :: DataType -> DataRep
+ constrType, -- :: Constr -> DataType
+ constrRep, -- :: Constr -> ConstrRep
+ repConstr, -- :: DataType -> ConstrRep -> Constr
+
+ -- * Representations of algebraic data types
+ mkDataType, -- :: String -> [Constr] -> DataType
+ mkConstr, -- :: DataType -> String -> Fixity -> Constr
+ dataTypeConstrs,-- :: DataType -> [Constr]
+ constrFields, -- :: Constr -> [String]
+ constrFixity, -- :: Constr -> Fixity
+
+ -- * From strings to constr's and vice versa: all data types
+ showConstr, -- :: Constr -> String
+ readConstr, -- :: DataType -> String -> Maybe Constr
+
+ -- * Convenience funtions: algebraic data types
+ isAlgType, -- :: DataType -> Bool
+ indexConstr, -- :: DataType -> ConIndex -> Constr
+ constrIndex, -- :: Constr -> ConIndex
+ maxConstrIndex, -- :: DataType -> ConIndex
+
+ -- * Representation of primitive types
+ mkIntType, -- :: String -> DataType
+ mkFloatType, -- :: String -> DataType
+ mkStringType, -- :: String -> DataType
+ mkIntConstr, -- :: DataType -> Integer -> Constr
+ mkFloatConstr, -- :: DataType -> Double -> Constr
+ mkStringConstr, -- :: DataType -> String -> Constr
+
+ -- * Non-representations for non-presentable types
+ mkNorepType, -- :: String -> DataType
+ isNorepType, -- :: DataType -> Bool
+
+ -- * Convenience functions: take type constructors apart
+ tyconUQname, -- :: String -> String
+ tyconModule, -- :: String -> String
-- * Generic maps defined in terms of gfoldl
gmapT,
gmapQ,
gmapQl,
gmapQr,
+ gmapQi,
gmapM,
gmapMp,
-
- -- * Generic unfolding defined in terms of gfoldl and fromConstr
- gunfoldM -- :: Monad m => ... -> m a
+ gmapMo,
) where
------------------------------------------------------------------------------
+#ifdef __HADDOCK__
+import Prelude
+#endif
import Data.Typeable
import Data.Maybe
import Control.Monad
+
------------------------------------------------------------------------------
--
-- The Data class
--
gfoldl _ z = z
-
-- | Obtaining the constructor from a given datum.
-- For proper terms, this is meant to be the top-level constructor.
-- Primitive datatypes are here viewed as potentially infinite sets of
dataTypeOf :: a -> DataType
+
+------------------------------------------------------------------------------
+--
+-- Mediate types and type constructors
+--
+------------------------------------------------------------------------------
+
+ -- | Mediate types and unary type constructors
+ dataCast1 :: Typeable1 t
+ => (forall a. Data a => c (t a))
+ -> Maybe (c a)
+ dataCast1 _ = Nothing
+
+ -- | Mediate types and binary type constructors
+ dataCast2 :: Typeable2 t
+ => (forall a b. (Data a, Data b) => c (t a b))
+ -> Maybe (c a)
+ dataCast2 _ = Nothing
+
+
+
------------------------------------------------------------------------------
--
-- Typical generic maps defined in terms of gfoldl
where
k (Qr c) x = Qr (\r -> c (f x `o` r))
+
-- | A generic query that processes the immediate subterms and returns a list
gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
gmapQ f = gmapQr (:) [] f
+ -- | A generic query that processes one child by index (zero-based)
+ gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
+ gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
+ where
+ k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
+ z f = Qi 0 Nothing
+
+
-- | A generic monadic transformation that maps over the immediate subterms
gmapM :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
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
newtype CONST c a = CONST { unCONST :: c }
+-- | Type constructor for adding counters to queries
+data Qi q a = Qi Int (Maybe q)
+
+
-- | The type constructor used in definition of gmapQr
newtype Qr r a = Qr { unQr :: r -> r }
------------------------------------------------------------------------------
--
--- Constructor representations
+-- Datatype and constructor representations
--
------------------------------------------------------------------------------
--- | Representation of constructors
-data Constr =
- -- The prime case for proper datatype constructors
- DataConstr ConIndex String Fixity
+--
+-- | Representation of datatypes.
+-- | A package of constructor representations with names of type and module.
+-- | The list of constructors could be an array, a balanced tree, or others.
+--
+data DataType = DataType
+ { tycon :: String
+ , datarep :: DataRep
+ }
- -- Provision for built-in types
- | IntConstr Int
- | IntegerConstr Integer
- | FloatConstr Float
- | CharConstr Char
+ deriving Show
- -- Provision for any type that can be read/shown as string
- | StringConstr String
- -- Provision for function types
- | FunConstr
+-- | Representation of constructors
+data Constr = Constr
+ { conrep :: ConstrRep
+ , constring :: String
+ , confields :: [String] -- for AlgRep only
+ , confixity :: Fixity -- for AlgRep only
+ , datatype :: DataType
+ }
- deriving (Show, Typeable)
+instance Show Constr where
+ show = constring
---
--- Equality of datatype constructors via index.
--- Use designated equalities for primitive types.
---
+
+-- | Equality of constructors
instance Eq Constr where
- (DataConstr i1 _ _) == (DataConstr i2 _ _) = i1 == i2
- (IntConstr i1) == (IntConstr i2) = i1 == i2
- (IntegerConstr i1) == (IntegerConstr i2) = i1 == i2
- (FloatConstr i1) == (FloatConstr i2) = i1 == i2
- (CharConstr i1) == (CharConstr i2) = i1 == i2
- (StringConstr i1) == (StringConstr i2) = i1 == i2
- _ == _ = False
+ c == c' = constrRep c == constrRep c'
+
+
+-- | Public representation of datatypes
+data DataRep = AlgRep [Constr]
+ | IntRep
+ | FloatRep
+ | StringRep
+ | NoRep
+
+ deriving (Eq,Show)
+-- | Public representation of constructors
+data ConstrRep = AlgConstr ConIndex
+ | IntConstr Integer
+ | FloatConstr Double
+ | StringConstr String
+
+ deriving (Eq,Show)
+
+
+--
-- | Unique index for datatype constructors.
--- Textual order is respected. Starts at 1.
+-- | Textual order is respected. Starts at 1.
--
type ConIndex = Int
-- | Fixity of constructors
data Fixity = Prefix
| Infix -- Later: add associativity and precedence
+
deriving (Eq,Show)
--- | A package of constructor representations;
--- could be a list, an array, a balanced tree, or others.
+
+------------------------------------------------------------------------------
+--
+-- Observers for datatype representations
--
-data DataType =
- -- The prime case for algebraic datatypes
- DataType [Constr]
+------------------------------------------------------------------------------
- -- Provision for built-in types
- | IntType
- | IntegerType
- | FloatType
- | CharType
- -- Provision for any type that can be read/shown as string
- | StringType
+-- | Gets the type constructor including the module
+dataTypeName :: DataType -> String
+dataTypeName = tycon
- -- Provision for function types
- | FunType
- deriving Show
+
+-- | Gets the public presentation of datatypes
+dataTypeRep :: DataType -> DataRep
+dataTypeRep = datarep
+
+
+-- | Gets the datatype of a constructor
+constrType :: Constr -> DataType
+constrType = datatype
+
+
+-- | Gets the public presentation of constructors
+constrRep :: Constr -> ConstrRep
+constrRep = conrep
+
+
+-- | Look up a constructor by its representation
+repConstr :: DataType -> ConstrRep -> Constr
+repConstr dt cr =
+ case (dataTypeRep dt, cr) of
+ (AlgRep cs, AlgConstr i) -> cs !! (i-1)
+ (IntRep, IntConstr i) -> mkIntConstr dt i
+ (FloatRep, FloatConstr f) -> mkFloatConstr dt f
+ (StringRep, StringConstr str) -> mkStringConstr dt str
+ _ -> error "repConstr"
+
------------------------------------------------------------------------------
--
--- Constructing constructor representations
+-- Representations of algebraic data types
--
------------------------------------------------------------------------------
--- | Make a representation for a datatype constructor
-mkConstr :: ConIndex -> String -> Fixity -> Constr
--- ToDo: consider adding arity?
-mkConstr = DataConstr
+-- | Constructs an algebraic datatype
+mkDataType :: String -> [Constr] -> DataType
+mkDataType str cs = DataType
+ { tycon = str
+ , datarep = AlgRep cs
+ }
+
+
+-- | Constructs a constructor
+mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
+mkConstr dt str fields fix =
+ Constr
+ { conrep = AlgConstr idx
+ , constring = str
+ , confields = fields
+ , confixity = fix
+ , datatype = dt
+ }
+ where
+ idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
+ showConstr c == str ]
+
+
+-- | Gets the constructors
+dataTypeConstrs :: DataType -> [Constr]
+dataTypeConstrs dt = case datarep dt of
+ (AlgRep cons) -> cons
+ _ -> error "dataTypeConstrs"
+
+
+-- | Gets the field labels of a constructor
+constrFields :: Constr -> [String]
+constrFields = confields
+
+
+-- | Gets the fixity of a constructor
+constrFixity :: Constr -> Fixity
+constrFixity = confixity
--- | Make a package of constructor representations
-mkDataType :: [Constr] -> DataType
-mkDataType = DataType
------------------------------------------------------------------------------
--
--- Observing constructor representations
---
+-- From strings to constr's and vice versa: all data types
+--
------------------------------------------------------------------------------
--- | Turn a constructor into a string
-conString :: Constr -> String
-conString (DataConstr _ str _) = str
-conString (IntConstr int) = show int
-conString (IntegerConstr int) = show int
-conString (FloatConstr real) = show real
-conString (CharConstr char) = show char
-conString (StringConstr str) = show str
-conString FunConstr = "->"
+-- | Gets the string for a constructor
+showConstr :: Constr -> String
+showConstr = constring
--- | Determine fixity of a constructor;
--- undefined for primitive types.
-conFixity :: Constr -> Fixity
-conFixity (DataConstr _ _ fix) = fix
-conFixity _ = undefined
+-- | Lookup a constructor via a string
+readConstr :: DataType -> String -> Maybe Constr
+readConstr dt str =
+ case dataTypeRep dt of
+ AlgRep cons -> idx cons
+ IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
+ FloatRep -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
+ StringRep -> Just (mkStringConstr dt str)
+ NoRep -> Nothing
+ where
+ -- Read a value and build a constructor
+ mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
+ mkReadCon f = case (reads str) of
+ [(t,"")] -> Just (f t)
+ _ -> Nothing
--- | Determine index of a constructor.
--- Undefined for primitive types.
-conIndex :: Constr -> ConIndex
-conIndex (DataConstr idx _ _) = idx
-conIndex _ = undefined
+ -- Traverse list of algebraic datatype constructors
+ idx :: [Constr] -> Maybe Constr
+ idx cons = let fit = filter ((==) str . showConstr) cons
+ in if fit == []
+ then Nothing
+ else Just (head fit)
--- | Lookup a constructor via a string
-stringCon :: DataType -> String -> Maybe Constr
-stringCon (DataType cs) str = worker cs
- where
- worker [] = Nothing
- worker (c:cs) =
- case c of
- (DataConstr _ str' _) -> if str == str'
- then Just c
- else worker cs
- _ -> undefined -- other forms of Constr not valid here
+------------------------------------------------------------------------------
+--
+-- Convenience funtions: algebraic data types
+--
+------------------------------------------------------------------------------
+
-stringCon IntType str = Just . IntConstr $ read str
-stringCon IntegerType str = Just . IntegerConstr $ read str
-stringCon FloatType str = Just . FloatConstr $ read str
-stringCon CharType str = Just . CharConstr $ read str
-stringCon StringType str = Just . StringConstr $ read str
-stringCon FunType str = Just FunConstr
+-- | Test for an algebraic type
+isAlgType :: DataType -> Bool
+isAlgType dt = case datarep dt of
+ (AlgRep _) -> True
+ _ -> False
--- | Lookup a constructor by its index;
---- not defined for primitive types.
-indexCon :: DataType -> ConIndex -> Constr
-indexCon (DataType cs) idx = cs !! (idx-1)
-indexCon _ _ = undefined -- otherwise
+-- | Gets the constructor for an index
+indexConstr :: DataType -> ConIndex -> Constr
+indexConstr dt idx = case datarep dt of
+ (AlgRep cs) -> cs !! (idx-1)
+ _ -> error "indexConstr"
--- | Return maximum index;
--- 0 for primitive types
-maxConIndex :: DataType -> ConIndex
-maxConIndex (DataType cs) = length cs
-maxConIndex _ = 0 -- otherwise
+-- | Gets the index of a constructor
+constrIndex :: Constr -> ConIndex
+constrIndex con = case constrRep con of
+ (AlgConstr idx) -> idx
+ _ -> error "constrIndex"
--- | Return all constructors in increasing order of indicies;
--- empty list for primitive types
-dataTypeCons :: DataType -> [Constr]
-dataTypeCons (DataType cs) = cs
-dataTypeCons _ = [] -- otherwise
+-- | Gets the maximum constructor index
+maxConstrIndex :: DataType -> ConIndex
+maxConstrIndex dt = case dataTypeRep dt of
+ AlgRep cs -> length cs
+ _ -> error "maxConstrIndex"
+
------------------------------------------------------------------------------
--
--- Instances of the Data class for Prelude types
+-- Representation of primitive types
--
------------------------------------------------------------------------------
--- Basic datatype Int; folding and unfolding is trivial
-instance Data Int where
- toConstr x = IntConstr x
- fromConstr (IntConstr x) = x
- dataTypeOf _ = IntType
-
--- Another basic datatype instance
-instance Data Integer where
- toConstr x = IntegerConstr x
- fromConstr (IntegerConstr x) = x
- dataTypeOf _ = IntegerType
-
--- Another basic datatype instance
-instance Data Float where
- toConstr x = FloatConstr x
- fromConstr (FloatConstr x) = x
- dataTypeOf _ = FloatType
-
--- Another basic datatype instance
-instance Data Char where
- toConstr x = CharConstr x
- fromConstr (CharConstr x) = x
- dataTypeOf _ = CharType
-
--- A basic datatype without a specific branch in Constr
-instance Data Rational where
- toConstr x = StringConstr (show x)
- fromConstr (StringConstr x) = read x
- dataTypeOf _ = StringType
---
--- Bool as the most trivial algebraic datatype;
--- define top-level definitions for representations.
---
+-- | Constructs the Int type
+mkIntType :: String -> DataType
+mkIntType = mkPrimType IntRep
-falseConstr = mkConstr 1 "False" Prefix
-trueConstr = mkConstr 2 "True" Prefix
-boolDataType = mkDataType [falseConstr,trueConstr]
-instance Data Bool where
- toConstr False = falseConstr
- toConstr True = trueConstr
- fromConstr c = case conIndex c of
- 1 -> False
- 2 -> True
- dataTypeOf _ = boolDataType
+-- | Constructs the Float type
+mkFloatType :: String -> DataType
+mkFloatType = mkPrimType FloatRep
---
--- Lists as an example of a polymorphic algebraic datatype.
--- Cons-lists are terms with two immediate subterms.
---
+-- | Constructs the String type
+mkStringType :: String -> DataType
+mkStringType = mkPrimType StringRep
-nilConstr = mkConstr 1 "[]" Prefix
-consConstr = mkConstr 2 "(:)" Infix
-listDataType = mkDataType [nilConstr,consConstr]
-instance Data a => Data [a] where
- gfoldl f z [] = z []
- gfoldl f z (x:xs) = z (:) `f` x `f` xs
- toConstr [] = nilConstr
- toConstr (_:_) = consConstr
- fromConstr c = case conIndex c of
- 1 -> []
- 2 -> undefined:undefined
- dataTypeOf _ = listDataType
+-- | Helper for mkIntType, mkFloatType, mkStringType
+mkPrimType :: DataRep -> String -> DataType
+mkPrimType dr str = DataType
+ { tycon = str
+ , datarep = dr
+ }
---
--- The gmaps are given as an illustration.
--- This shows that the gmaps for lists are different from list maps.
---
- gmapT f [] = []
- gmapT f (x:xs) = (f x:f xs)
- gmapQ f [] = []
- gmapQ f (x:xs) = [f x,f xs]
- gmapM f [] = return []
- gmapM f (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
+-- Makes a constructor for primitive types
+mkPrimCon :: DataType -> String -> ConstrRep -> Constr
+mkPrimCon dt str cr = Constr
+ { datatype = dt
+ , conrep = cr
+ , constring = str
+ , confields = error "constrFields"
+ , confixity = error "constrFixity"
+ }
---
--- Yet another polymorphic datatype constructor
--- No surprises.
---
-nothingConstr = mkConstr 1 "Nothing" Prefix
-justConstr = mkConstr 2 "Just" Prefix
-maybeDataType = mkDataType [nothingConstr,justConstr]
+mkIntConstr :: DataType -> Integer -> Constr
+mkIntConstr dt i = case datarep dt of
+ IntRep -> mkPrimCon dt (show i) (IntConstr i)
+ _ -> error "mkIntConstr"
-instance Data a => Data (Maybe a) where
- gfoldl f z Nothing = z Nothing
- gfoldl f z (Just x) = z Just `f` x
- toConstr Nothing = nothingConstr
- toConstr (Just _) = justConstr
- fromConstr c = case conIndex c of
- 1 -> Nothing
- 2 -> Just undefined
- dataTypeOf _ = maybeDataType
---
--- Yet another polymorphic datatype constructor.
--- No surprises.
---
+mkFloatConstr :: DataType -> Double -> Constr
+mkFloatConstr dt f = case datarep dt of
+ FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
+ _ -> error "mkFloatConstr"
-pairConstr = mkConstr 1 "(,)" Infix
-productDataType = mkDataType [pairConstr]
-instance (Data a, Data b) => Data (a,b) where
- gfoldl f z (a,b) = z (,) `f` a `f` b
- toConstr _ = pairConstr
- fromConstr c = case conIndex c of
- 1 -> (undefined,undefined)
- dataTypeOf _ = productDataType
+mkStringConstr :: DataType -> String -> Constr
+mkStringConstr dt str = case datarep dt of
+ StringRep -> mkPrimCon dt str (StringConstr str)
+ _ -> error "mkStringConstr"
-{-
+------------------------------------------------------------------------------
+--
+-- Non-representations for non-presentable types
+--
+------------------------------------------------------------------------------
-We should better not FOLD over characters in a string for efficiency.
-However, the following instance would clearly overlap with the
-instance for polymorphic lists. Given the current scheme of allowing
-overlapping instances, this would imply that ANY module that imports
-Data.Generics would need to explicitly and generally allow overlapping
-instances. This is prohibitive and calls for a more constrained model
-of allowing overlapping instances. The present instance would be
-sensible even more for UNFOLDING. In the definition of "gread"
-(generic read --- based on unfolding), we succeed handling strings in a
-special way by using a type-specific case for String.
-
-instance Data String where
- toConstr x = StringConstr x
- fromConstr (StringConstr x) = x
- dataTypeOf _ = StringType
--}
+-- | Constructs a non-representation
+mkNorepType :: String -> DataType
+mkNorepType str = DataType
+ { tycon = str
+ , datarep = NoRep
+ }
+
+
+-- | Test for a non-representable type
+isNorepType :: DataType -> Bool
+isNorepType dt = case datarep dt of
+ NoRep -> True
+ _ -> False
--- A last resort for functions
-instance (Typeable a, Typeable b) => Data (a -> b) where
- toConstr _ = FunConstr
- fromConstr _ = undefined
- dataTypeOf _ = FunType
------------------------------------------------------------------------------
--
--- Generic unfolding
+-- Convenience for qualified type constructors
--
------------------------------------------------------------------------------
--- | Construct an initial with undefined immediate subterms
--- and then map over the skeleton to fill in proper terms.
+
+-- | Gets the unqualified type constructor
+-- Drop *.*.*... before name
--
-gunfoldM :: (Monad m, Data a)
- => Constr
- -> (forall a. Data a => m a)
- -> m a
-gunfoldM c f = gmapM (const f) $ fromConstr c
+tyconUQname :: String -> String
+tyconUQname x = let x' = dropWhile (not . (==) '.') x
+ in if x' == [] then x else tyconUQname (tail x')
+
+
+-- | Gets the module of a type constructor
+-- Take *.*.*... before name
+tyconModule :: String -> String
+tyconModule x = let (a,b) = break ((==) '.') x
+ in if b == ""
+ then b
+ else a ++ tyconModule' (tail b)
+ where
+ tyconModule' x = let x' = tyconModule x
+ in if x' == "" then "" else ('.':x')
projects / ghc-base.git / blobdiff