[Haskell-cafe] reifying based-on type of a newtype or data
oleg at okmij.org
oleg at okmij.org
Tue Oct 29 06:54:47 UTC 2013
Anthony Clayden wrote:
> newtype Foo = Foo Int deriving (Read, Show, Typeable, Data, ...)
> someFoo = Foo 7
> ...
> What I want is to get the based-on type baked inside `someFoo`
> -- that is: `Int`
> (It would also be handy to get the name of the data constr, just in case
> it's different to the type.)
If we have a data type declaration
data C a b = D1 a Int b | D2 a | D3 [a]
we use methods of module Typeable to get information about the
left-hand-side of the equation (about the type expression C a b
and its structure, an application of a type constructor C to two
arguments). We use methods of module Data.Data to get information
about the right-hand-side of the equation (about _data_ constructors
D1, D2 and D3 and their arguments).
Here is an example:
> {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
>
> import Data.Data
>
> data C a b = D1 a Int b | D2 a | D3 [a] deriving (Data, Typeable)
A sample datum of type C
> someC = undefined :: C Int Char
*Main> typeOf someC
C Int Char
meaning someC has the type C Int Char.
*Main> dataTypeOf someC
DataType {tycon = "Main.C", datarep = AlgRep [D1,D2,D3]}
Now we see something about the right-hand-side of the equation
defining C: C a b is a data type and it has three data constructors, D1, D2
and D3.
How to get information about their arguments? First, we extract
constructors
> getCtor :: Data a => Int -> a -> Constr
> getCtor i x = case dataTypeRep $ dataTypeOf x of AlgRep cs -> cs !! i
*Main> getCtor 0 someC
D1
Now, we reify a data constructor by unfolding it in a particular way
> newtype DTInfo a = DTInfo [TypeRep]
> -- Get information about the given ctor of a given algebraic data type
> -- (the data type value may be undefined -- we only need its type)
> ctorInfo :: forall a. Data a => a -> Constr -> [TypeRep]
> ctorInfo _ ctor = case go ctor of DTInfo reps -> reverse reps
> where
> go :: Constr -> DTInfo a
> go = gunfold (\ (DTInfo infos :: DTInfo (b->r)) ->
> DTInfo (typeOf (undefined:: b) : infos))
> (\r -> DTInfo [])
*Main> ctorInfo someC $ getCtor 0 someC
[Int,Int,Char]
meaning that D1 of the type C Int Char has three arguments,
Int, Int, Char -- in that order.
*Main> ctorInfo someC $ getCtor 1 someC
[Int]
*Main> ctorInfo someC $ getCtor 2 someC
[[Int]]
It is easy to answer the original question about someFoo
*Main> getCtor 0 someFoo
Foo
*Main> ctorInfo someFoo $ getCtor 0 someFoo
[Int]
-- A faster way for a defined datum
*Main> ctorInfo someFoo $ toConstr someFoo
[Int]
So, someFoo is constructed by data constructor Foo and that data
constructor has one Int argument.
More information about the Haskell-Cafe
mailing list