Renamed Data/Generics/Strings to .../Text.
Implemented generic read by using Text/ParserCombinators/ReadP.
This is now how it really should look like.
Did some more refactoring in the modules of Data/Generics.
I consider the library relatively stable by now.
Very experimental stuff is only in Data/Generics/Reify.hs
(
I was a bit too optimistic yesterday regarding the
commitibility of Data/Generics. SPJ wanted me to use
Text/ParserCombinators/ReadP for generic read what I
did, which revealed a funny compiler bug. SPJ will
probably report on this very soon.
The compiler does not panic if I turn
ReadP from a newtype into a datatype, what I have temporarily
done. I hope this is Ok for the moment.
)
module Data.Generics (
- -- * Re-export all relevant modules
- module Data.Generics.Basics,
- module Data.Generics.Aliases,
- module Data.Generics.Schemes,
- module Data.Generics.Twins,
- module Data.Generics.Strings,
- module Data.Generics.Counts,
- module Data.Generics.Types
+ -- * To scrap your boilerplate it is sufficient to import this module.
+ -- This module does nothing more than import all themes of the
+ -- Data.Generics library.
+ --
+ module Data.Generics.Basics, -- primitives
+ 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
+ module Data.Generics.Reify -- experimental reification stuff
#ifndef __HADDOCK__
,
-- Data types for the sum-of-products type encoding;
- -- included for backwards compatibility; maybe obsolete
+ -- included for backwards compatibility; maybe obsolete.
(:*:)(..), (:+:)(..), Unit(..)
#endif
#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.Generics.Basics
import Data.Generics.Aliases
import Data.Generics.Schemes
+import Data.Generics.Text
import Data.Generics.Twins
-import Data.Generics.Strings
-import Data.Generics.Counts
-import Data.Generics.Types
+import Data.Generics.Reify
-- resort to return otherwise
--
mkM :: ( Monad m,
- Typeable a,
- Typeable b,
- Typeable (m a),
- Typeable (m b)
+ Typeable a,
+ Typeable b
)
=> (b -> m b) -> a -> m a
-mkM f = case cast f of
+mkM f = case castarr f of
Just g -> g
Nothing -> return
--
mkMp :: ( MonadPlus m,
Typeable a,
- Typeable b,
- Typeable (m a),
- Typeable (m b)
+ Typeable b
)
- => (b -> m b) -> a -> m a
-mkMp = maybe (const mzero) id . cast
+ => (b -> m b) -> a -> m a
+mkMp = maybe (const mzero) id . castarr
-- | Make a generic builder;
--
mkB :: ( MonadPlus m,
Typeable a,
- Typeable b,
- Typeable (m a),
- Typeable (m b)
+ Typeable b
)
=> m b -> m a
-mkB = maybe mzero id . cast
+mkB = maybe mzero id . castss
-- | Extend a generic transformation by a type-specific case
-- | Extend a generic monadic transformation by a type-specific case
-extM :: (Typeable a, Typeable b,
- Typeable (m a), Typeable (m b),
- Monad m)
+extM :: ( Monad m,
+ Typeable a,
+ Typeable b
+ )
=> (a -> m a) -> (b -> m b) -> a -> m a
-extM f = maybe f id . cast
+extM f = maybe f id . castarr
-- | Extend a generic MonadPlus transformation by a type-specific case
extMp :: ( MonadPlus m,
Typeable a,
- Typeable b,
- Typeable (m a),
- Typeable (m b)
+ Typeable b
)
- => (a -> m a) -> (b -> m b) -> a -> m a
+ => (a -> m a) -> (b -> m b) -> a -> m a
extMp = extM
-- | Extend a generic builder by a type-specific case
-extB :: ( Monad m,
- Typeable a,
- Typeable b,
- Typeable (m a),
- Typeable (m b)
+extB :: (Monad m,
+ Typeable a,
+ Typeable b
)
=> m a -> m b -> m a
-extB f = maybe f id . cast
+extB f = maybe f id . castss
------------------------------------------------------------------------------
--
gmapT f [] = []
gmapT f (x:xs) = (f x:f xs)
--- gmapL f [] = []
--- gmapL 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')
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Counts
--- Copyright : (c) The University of Glasgow, CWI 2001--2003
--- 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/>.
---
------------------------------------------------------------------------------
-
-module Data.Generics.Counts (
-
- -- * Generic operations for counting terms
- glength,
- gcount,
- gnodecount,
- gtypecount
-
- ) where
-
-------------------------------------------------------------------------------
-
-
-import Data.Generics.Basics
-import Data.Generics.Aliases
-import Data.Generics.Schemes
-
-
-------------------------------------------------------------------------------
---
--- Generic operations for counting terms
---
-------------------------------------------------------------------------------
-
-
--- | Count the number of immediate subterms of the given term
-glength :: GenericQ Int
-glength = length . gmapQ (const ())
-
-
--- | 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 f = gcount (False `mkQ` (const True . f))
--- /dev/null
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Generics.Reify
+-- Copyright : (c) The University of Glasgow, CWI 2001--2003
+-- 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/>.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Reify (
+
+ -- * Types as values
+ TypeVal, -- view type "a" as "a -> ()"
+ typeVal, -- :: TypeVal a
+ sameType, -- two type values are the same
+ typeValOf, -- :: a -> TypeVal a
+ undefinedType, -- :: TypeVal a -> a
+ withType, -- :: a -> TypeVal a -> a
+ argType, -- :: (a -> b) -> TypeVal a
+ resType, -- :: (a -> b) -> TypeVal b
+ paraType, -- :: t a -> TypeVal a
+ TypeFun, -- functions on types
+
+ -- * Generic operations to reify terms
+ glength,
+ gcount,
+ gnodecount,
+ gtypecount,
+
+ -- * Generic operations to reify types
+ constrArity,
+ typeReachableFrom
+
+ ) where
+
+
+------------------------------------------------------------------------------
+
+
+import Data.Generics.Basics
+import Data.Generics.Aliases
+import Data.Generics.Schemes
+
+
+
+-------------------------------------------------------------
+--
+-- Types as values
+--
+-------------------------------------------------------------
+
+{-
+
+This group provides a style of encoding types as values and using
+them. This style is seen as an alternative to the pragmatic style used
+in Data.Typeable.typeOf and elsewhere, i.e., simply use an "undefined"
+to denote a type argument. This pragmatic style suffers from lack
+of robustness: one feels tempted to pattern match on undefineds.
+Maybe Data.Typeable.typeOf etc. should be rewritten accordingly.
+
+-}
+
+
+-- | Type as values to stipulate use of undefineds
+type TypeVal a = a -> ()
+
+
+-- | The value that denotes a type
+typeVal :: TypeVal a
+typeVal = const ()
+
+
+-- | Test for type equivalence
+sameType :: (Typeable a, Typeable b) => TypeVal a -> TypeVal b -> Bool
+sameType tva tvb = typeOf (undefinedType tva) ==
+ typeOf (undefinedType tvb)
+
+
+-- | Map a value to its type
+typeValOf :: a -> TypeVal a
+typeValOf _ = typeVal
+
+
+-- | Stipulate this idiom!
+undefinedType :: TypeVal a -> a
+undefinedType _ = undefined
+
+
+-- | Constrain a type
+withType :: a -> TypeVal a -> a
+withType x _ = x
+
+
+-- | The argument type of a function
+argType :: (a -> b) -> TypeVal a
+argType _ = typeVal
+
+
+-- | The result type of a function
+resType :: (a -> b) -> TypeVal b
+resType _ = typeVal
+
+
+-- | The parameter type of type constructor
+paraType :: t a -> TypeVal a
+paraType _ = typeVal
+
+
+-- Type functions,
+-- i.e., functions mapping types to values
+--
+type TypeFun a r = TypeVal a -> r
+
+
+
+-- Generic type functions,
+-- i.e., functions mapping types to values
+--
+type GTypeFun r = forall a. Typeable a => TypeFun a r
+
+
+
+------------------------------------------------------------------------------
+--
+-- Generic operations to reify terms
+--
+------------------------------------------------------------------------------
+
+
+-- | Count the number of immediate subterms of the given term
+glength :: GenericQ Int
+glength = length . gmapQ (const ())
+
+
+-- | 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 f = gcount (False `mkQ` (const True . f))
+
+
+
+------------------------------------------------------------------------------
+--
+-- Generic operations to reify types
+--
+------------------------------------------------------------------------------
+
+-- | Compute arity of a constructor against a type argument
+constrArity :: Data a => (a -> ()) -> Constr -> Int
+constrArity ta c = glength $ withType (fromConstr c) ta
+
+
+--
+-- Reachability relation on types:
+-- Test if nodes of type "a" are reachable from nodes of type "b".
+-- This is a naive, inefficient encoding.
+-- As of writing, it does not even cope with recursive types.
+--
+typeReachableFrom :: (Data a, Data b) => TypeVal a -> TypeVal b -> Bool
+typeReachableFrom (a::TypeVal a) (b::TypeVal b) =
+ or ( sameType a b
+ : map (recurse . fromConstr) (dataTypeCons $ dataTypeOf b)
+ )
+ where
+
+ -- See if a is reachable from immediate subterms of a kind of b
+ recurse :: b -> Bool
+ recurse = or
+ . gmapQ ( typeReachableFrom a
+ . typeValOf
+ )
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Shortcuts
--- Copyright : (c) The University of Glasgow, CWI 2001--2003
--- 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/>.
---
------------------------------------------------------------------------------
-
-module Data.Generics.Shortcuts (
-
- -- * Cut-off traversal
- everywhere1RT'
-
- ) where
-
------------------------------------------------------------------------------
-
-
-import Data.Generics.Basics
-import Data.Generics.Aliases
-import Data.Generics.Types
-
-
------------------------------------------------------------------------------
-
-
--- Run-time cut-off for top-down traversal with one specific type case.
--- This is only for illustrative purposes.
--- The naive approach here is prohibitively inefficient.
---
-everywhere1RT' :: (Data a, Data b) => (a -> a) -> b -> b
-everywhere1RT' f t =
- if not $ typeReachableFrom (argType f) (typeValOf t)
- then t
- else gmapT (everywhere1RT' f) (mkT f t)
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Strings
--- Copyright : (c) The University of Glasgow, CWI 2001--2003
--- 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/>.
---
------------------------------------------------------------------------------
-
-module Data.Generics.Strings (
-
- -- * Generic operations for string representations of terms
- gshow,
- gread
-
- ) where
-
-------------------------------------------------------------------------------
-
-import Control.Monad
-import Data.Maybe
-import Data.Typeable
-import Data.Generics.Basics
-import Data.Generics.Aliases
-
-
-
--- | 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 ->
- "("
- ++ conString (toConstr t)
- ++ concat (gmapQ ((++) " " . gshow) t)
- ++ ")"
- ) `extQ` (show :: String -> String)
-
-
--- | The type constructor for gunfold a la ReadS from the Prelude;
--- we don't use lists here for simplicity but only maybes.
---
-newtype GRead a = GRead (String -> Maybe (a, String)) deriving Typeable
-unGRead (GRead x) = x
-
-
--- | Turn GRead into a monad.
-instance Monad GRead where
- return x = GRead (\s -> Just (x, s))
- (GRead f) >>= g = GRead (\s ->
- maybe Nothing
- (\(a,s') -> unGRead (g a) s')
- (f s)
- )
-
-instance MonadPlus GRead where
- mzero = GRead (\_ -> Nothing)
- mplus = undefined
-
-
--- | Special parsing operators
-trafo f = GRead (\s -> Just ((), f s))
-query f = GRead (\s -> if f s then Just ((), s) else Nothing)
-
-
--- | Generic read: an alternative to \"deriving Read\"
-gread :: Data a => String -> Maybe (a, String)
-
-{-
-
-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 gunfoldM to "parse" the input. To be
-precise, gunfoldM is used for all types except String. The
-type-specific case for String uses basic String read.
-
--}
-
-
-gread = unGRead gread'
-
- where
-
- gread' :: Data a => GRead a
- gread' = gdefault `extB` scase
-
- where
-
- -- a specific case for strings
- scase :: GRead String
- scase = GRead ( \s -> case reads s of
- [x::(String,String)] -> Just x
- _ -> Nothing
- )
-
- -- the generic default for gread
- gdefault :: Data a => GRead a
- gdefault =
- do
- -- Drop " ( "
- trafo $ dropWhile ((==) ' ') -- Discard leading space
- query $ not . (==) "" -- Check result is not empty
- query $ (==) '(' . head -- ...and that it begins with (
- trafo $ tail -- Discard the '('
- trafo $ dropWhile ((==) ' ') -- ...and following white space
-
- -- Do the real work
- str <- parseConstr -- Get a lexeme for the constructor
- con <- str2con str -- Convert it to a Constr (may fail)
- x <- gunfoldM con gread' -- Read the children
-
- -- Drop " )"
- trafo $ dropWhile ((==) ' ')
- query $ not . (==) ""
- query $ (==) ')' . head
- trafo $ tail
- return x
-
- where
- get_data_type :: GRead a -> DataType
- get_data_type (thing :: GRead a) = dataTypeOf (typeVal::a)
-
- str2con :: String -> GRead Constr
- -- Turn string into constructor driven by gdefault's type,
- -- failing in the monad if it isn't a constructor of this data type
- str2con = maybe mzero return . stringCon (get_data_type gdefault)
-
-{-
- foo =
- do s' <- return $ dropWhile ((==) ' ') s
- guard (not (s' == ""))
- guard (head s' == '(')
- (c,s'') <- parseConstr (dropWhile ((==) ' ') (tail s'))
- u <- return undefined
- dt <- return $ dataTypeOf u
- case stringCon dt c of
- Nothing -> error "Data.Generics.String: gread failed"
- Just c' ->
- gunfoldm c' gread
-
- guard ( or [ maxConIndex (dataTypeOf u) == 0
- , c `elem` constrsOf u
- ]
- )
- (a,s''') <- unGRead (gunfold f z c) s''
- _ <- return $ constrainTypes a u
- guard (not (s''' == ""))
- guard (head s''' == ')')
- return (a, tail s''')
--}
-
- -- Get a Constr's string at the front of an input string
- parseConstr :: GRead String
-
- parseConstr = GRead ( \s -> case s of
-
- -- Infix operators are prefixed in parantheses
- ('(':s) -> case break ((==) ')') s of
- (s'@(_:_),(')':s'')) -> Just ("(" ++ s' ++ ")", s'')
- _ -> Nothing
-
- -- Special treatment of multiple token constructors
- ('[':']':s) -> Just ("[]",s)
-
- -- Try lex for ordinary constructor and basic datatypes
- s -> case lex s of
- [(s'@(_:_),s'')] -> Just (s',s'')
- _ -> Nothing
-
- )
-
--- /dev/null
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Generics.Text
+-- Copyright : (c) The University of Glasgow, CWI 2001--2003
+-- 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/>.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Text (
+
+ -- * Generic operations for string representations of terms
+ gshow,
+ gread
+
+ ) where
+
+------------------------------------------------------------------------------
+
+
+import Control.Monad
+import Data.Maybe
+import Data.Typeable
+import Data.Generics.Basics
+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 ->
+ "("
+ ++ conString (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 gunfoldM to "parse" the input. To be
+precise, gunfoldM is used for all types except String. The
+type-specific case for String uses basic String read.
+
+-}
+
+gread = readP_to_S gread'
+
+ where
+
+ gread' :: Data a => ReadP a
+ gread' = gdefault `extB` scase
+
+
+ where
+
+ -- A specific case for strings
+ scase :: ReadP String
+ scase = readS_to_P reads
+
+
+ -- The generic default for gread
+ -- gdefault :: Data a => ReadP a
+ gdefault =
+ 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 <- gunfoldM con gread' -- Read the children
+
+ -- Drop " ) "
+ skipSpaces -- Discard leading space
+ char ')' -- Parse ')'
+ skipSpaces -- Discard following space
+
+ return x
+
+ where
+
+ -- Get the datatype for the type at hand;
+ -- use gdefault to provide the type at hand.
+ myDataTypeOf :: Data a => ReadP a -> DataType
+ myDataTypeOf (_::ReadP a) = dataTypeOf (undefined::a)
+
+ -- Turn string into constructor driven by gdefault's type,
+ -- failing in the monad if it isn't a constructor of this data type
+ str2con :: String -> ReadP Constr
+ str2con = maybe mzero return
+ . stringCon (myDataTypeOf gdefault)
+
+ -- 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]
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : Data.Generics.Types
--- Copyright : (c) The University of Glasgow, CWI 2001--2003
--- 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/>.
---
------------------------------------------------------------------------------
-
-module Data.Generics.Types (
-
- -- * Generic operations to reify types
- constrArity,
- typeReachableFrom,
-
- ) where
-
-
-------------------------------------------------------------------------------
-
-
-import Data.Generics.Basics
-import Data.Generics.Aliases
-import Data.Generics.Counts
-
-
-
--- Generic type functions,
--- i.e., functions mapping types to values
---
-type GTypeFun r = forall a. Typeable a => TypeFun a r
-
-
-
-------------------------------------------------------------------------------
---
--- Compute arity of a constructor against a type argument
---
-------------------------------------------------------------------------------
-
-
-constrArity :: Data a => (a -> ()) -> Constr -> Int
-constrArity ta c = glength $ withType (fromConstr c) ta
-
-
-------------------------------------------------------------------------------
---
--- Reachability relation on types
---
-------------------------------------------------------------------------------
-
---
--- Test if nodes of type "a" are reachable from nodes of type "b".
--- This is a naive, inefficient encoding.
--- As of writing, it does not even cope with recursive types.
---
-typeReachableFrom :: (Data a, Data b) => TypeVal a -> TypeVal b -> Bool
-typeReachableFrom (a::TypeVal a) (b::TypeVal b) =
- or ( sameType a b
- : map (recurse . fromConstr) (dataTypeCons $ dataTypeOf b)
- )
- where
-
- -- See if a is reachable from immediate subterms of a kind of b
- recurse :: b -> Bool
- recurse = or
- . gmapQ ( typeReachableFrom a
- . typeValOf
- )
-- * The Typeable class
Typeable( typeOf ), -- :: a -> TypeRep
- -- * Type-safe cast and other clients
+ -- * Type-safe cast
cast, -- :: (Typeable a, Typeable b) => a -> Maybe b
- sameType, -- two type values are the same
+ castss, -- a cast for kind "* -> *"
+ castarr, -- another convenient variation
-- * Type representations
TypeRep, -- abstract, instance of: Eq, Show, Typeable
mkTyCon, -- :: String -> TyCon
mkAppTy, -- :: TyCon -> [TypeRep] -> TypeRep
mkFunTy, -- :: TypeRep -> TypeRep -> TypeRep
- applyTy, -- :: TypeRep -> TypeRep -> Maybe TypeRep
-
- -- * Types as values
- TypeVal, -- view type "a" as "a -> ()"
- typeVal, -- :: TypeVal a
- typeValOf, -- :: a -> TypeVal a
- undefinedType, -- :: TypeVal a -> a
- withType, -- :: a -> TypeVal a -> a
- argType, -- :: (a -> b) -> TypeVal a
- resType, -- :: (a -> b) -> TypeVal b
- paraType, -- :: t a -> TypeVal a
- TypeFun -- functions on types
+ applyTy -- :: TypeRep -> TypeRep -> Maybe TypeRep
) where
-------------------------------------------------------------
--
--- Type-safe cast and other clients
+-- Type-safe cast
--
-------------------------------------------------------------
cast :: (Typeable a, Typeable b) => a -> Maybe b
cast x = r
where
- r = if typeOf x == typeOf (fromJust r) then
- Just (unsafeCoerce x)
- else
- Nothing
+ r = if typeOf x == typeOf (fromJust r)
+ then Just $ unsafeCoerce x
+ else Nothing
--- | Test for type equivalence
-sameType :: (Typeable a, Typeable b) => TypeVal a -> TypeVal b -> Bool
-sameType tva tvb = typeOf (undefinedType tva) ==
- typeOf (undefinedType tvb)
+-- | A convenient variation for kind "* -> *"
+castss :: (Typeable a, Typeable b) => t a -> Maybe (t b)
+castss x = r
+ where
+ r = if typeOf (get x) == typeOf (get (fromJust r))
+ then Just $ unsafeCoerce x
+ else Nothing
+ get :: t c -> c
+ get = undefined
+
+
+-- | Another variation
+castarr :: (Typeable a, Typeable b, Typeable c, Typeable d)
+ => (a -> t b) -> Maybe (c -> t d)
+castarr x = r
+ where
+ r = if typeOf (get x) == typeOf (get (fromJust r))
+ then Just $ unsafeCoerce x
+ else Nothing
+ get :: (e -> t f) -> (e, f)
+ get = undefined
+
+{-
+
+The variations castss and castarr are arguably not really needed.
+Let's discuss castss in some detail. To get rid of castss, we can
+require "Typeable (t a)" and "Typeable (t b)" rather than just
+"Typeable a" and "Typeable b". In that case, the ordinary cast would
+work. Eventually, all kinds of library instances should become
+Typeable. (There is another potential use of variations as those given
+above. It allows quantification on type constructors.
+
+-}
-------------------------------------------------------------
(typeOf ((undefined :: (a -> b) -> b) f))
--------------------------------------------------------------
---
--- Types as values
---
--------------------------------------------------------------
-
-{-
-
-This group provides a style of encoding types as values and using
-them. This style is seen as an alternative to the pragmatic style used
-in Data.Typeable.typeOf and elsewhere, i.e., simply use an "undefined"
-to denote a type argument. This pragmatic style suffers from lack
-of robustness: one feels tempted to pattern match on undefineds.
-Maybe Data.Typeable.typeOf etc. should be rewritten accordingly.
-
--}
-
-
--- | Type as values to stipulate use of undefineds
-type TypeVal a = a -> ()
-
-
--- | The value that denotes a type
-typeVal :: TypeVal a
-typeVal = const ()
-
-
--- | Map a value to its type
-typeValOf :: a -> TypeVal a
-typeValOf _ = typeVal
-
-
--- | Stipulate this idiom!
-undefinedType :: TypeVal a -> a
-undefinedType _ = undefined
-
-
--- | Constrain a type
-withType :: a -> TypeVal a -> a
-withType x _ = x
-
-
--- | The argument type of a function
-argType :: (a -> b) -> TypeVal a
-argType _ = typeVal
-
-
--- | The result type of a function
-resType :: (a -> b) -> TypeVal b
-resType _ = typeVal
-
-
--- | The parameter type of type constructor
-paraType :: t a -> TypeVal a
-paraType _ = typeVal
-
-
--- Type functions,
--- i.e., functions mapping types to values
---
-type TypeFun a r = TypeVal a -> r
-
-
-------------------------------------------------------
--
#endif
+
---------------------------------------------
--
-- Internals
-- ---------------------------------------------------------------------------
-- The ReadP type
-newtype ReadP a = R (forall b . (a -> P b) -> P b)
+-- newtype temporarily turned into data
+-- until compiler bug as found on 26 July 2003 is fixed;
+-- contact SPJ or ralf@cwi.nl
+--
+data ReadP a = R (forall b . (a -> P b) -> P b)
+-- newtype ReadP a = R (forall b . (a -> P b) -> P b)
-- Functor, Monad, MonadPlus
projects / ghc-base.git / commitdiff