reifying based-on type of a newtype or data

[reposted from Beginners, where it met stoney silence.] So I have (or rather the user of my package has):
{-# LANGUAGE DeriveDataTypeable #-}
newtype Foo = Foo Int deriving (Read, Show, Typeable, Data, ...) someFoo = Foo 7
Note: * the `newtype` could be `data` -- if that would help. * this is _not_ a parameterised type, but a 'baked in' `Int`. * the data constr is named same as the type -- if that would help. I can ask for `typeOf someFoo` and get `Foo` OK. I can ask for `typeOf Foo` and get `Int -> Foo` OK. If I ask for `typeOf (typeOf someFoo)` I get `TypeRep`. `typeOf (show $ typeOf someFoo`) gets me `[Char]` (aka `String`) So far very logical, but not very helpful. 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.) Do I need to get into `deriving (..., Generic)` ? That looks like serious machinery! Thanks AntC

What about Data.Typeable.typeRepArgs ?
typeRepArgs :: TypeRep -> [TypeRep]
Prelude Data.Data> typeRepArgs (typeOf Foo)
[Int,Foo]
For any function type, the head of typeRepArgs should be the type of the
first parameter. For non-function types, it looks like typeRepArgs returns
an empty list.
For anything more complicated, I suspect you'll need Data/Generic/Template
Haskell.
John L.
On Mon, Oct 28, 2013 at 7:15 PM, AntC
[reposted from Beginners, where it met stoney silence.]
So I have (or rather the user of my package has):
{-# LANGUAGE DeriveDataTypeable #-}
newtype Foo = Foo Int deriving (Read, Show, Typeable, Data, ...) someFoo = Foo 7
Note: * the `newtype` could be `data` -- if that would help. * this is _not_ a parameterised type, but a 'baked in' `Int`. * the data constr is named same as the type -- if that would help.
I can ask for `typeOf someFoo` and get `Foo` OK. I can ask for `typeOf Foo` and get `Int -> Foo` OK.
If I ask for `typeOf (typeOf someFoo)` I get `TypeRep`. `typeOf (show $ typeOf someFoo`) gets me `[Char]` (aka `String`)
So far very logical, but not very helpful.
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.)
Do I need to get into `deriving (..., Generic)` ?
That looks like serious machinery!
Thanks AntC
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (2)
-
AntC
-
John Lato