[Haskell-cafe] Figuring out if an algebraic type is enumerated
through Data.Generics?
Edward Kmett
ekmett at gmail.com
Tue May 6 13:42:33 EDT 2008
On Tue, May 6, 2008 at 12:34 PM, Alfonso Acosta
<alfonso.acosta at gmail.com> wrote:
| So, the question is. Is there a way to figure out the arity of data
| constructors using Data.Generics ?
| I'm totally new to generics, but (tell me if I'm wrong) it seems that
| Constr doesn't hold any information about the data-constructor
| arguments. Why is it so?
Hmrmm,
Playing around with it, I was able to abuse gunfold and the reader
comonad to answer the problem :
fst $ (gunfold (\(i,_) -> (i+1,undefined)) (\r -> (0,r)) (toConstr
"Hello") :: (Int,String))
returns 2, the arity of (:), the outermost constructor in "Hello"
A longer version which does not depend on undefined would be to take
and define a functor that discarded its contents like:
> module Args where
> import Data.Generics
> newtype Args a = Args { runArgs :: Int } deriving (Read,Show)
> tick :: Args (b -> r) -> Args r
> tick (Args i) = Args (i + 1)
> tock = const (Args 0)
> argsInCons = runArgs $ (gunfold tick tock (toConstr "Hello") :: (Args String)
Basically all I do is rely on the fact that gunfold takes the 'tick'
argument and calls it repeatedly for each argument after a 'tock' base
case.
The use of the reader comonad or functor is to give gunfold a
'functor-like' argument to meet its type signature.
-Edward Kmett
More information about the Haskell-Cafe
mailing list