[Haskell-cafe] Template Haskell sees into abstract data types

Gábor Lehel illissius at gmail.com
Wed Jul 28 06:58:37 EDT 2010


On Wed, Jul 28, 2010 at 12:55 PM, Gábor Lehel <illissius at gmail.com> wrote:
> 2010/7/28 Serguey Zefirov <sergueyz at gmail.com>:
>> 2010/7/28 Jonas Almström Duregård <jonas.duregard at gmail.com>:
>>> Hi,
>>>
>>>> I cannot write classes that see into internal structure. For example,
>>>> I cannot write my own (de)serialization without using from/toAscList.
>>>
>>> Actually I don't believe you can do this with TH either. TH splices
>>> code into the module where you use it. The generated code is then type
>>> checked in this module. If constructors that are not exported are used
>>> in the generated code, I believe you will get an error.
>>>
>>> This could still be an issue because your TH code won't know if the
>>> constructors are exported or not, but i doubt you can actually do
>>> things with TH that you can't do with plain H.
>>
>> I doubt that doubt first. ;)
>>
>>>> At least, it looks like I can, I didn't tried, actually.
>>> Neither have I.
>>
>> So I did. And succeed: TH sees into data types.
>>
>> (ghc 6.12.1)
>>
>> Module A.hs, contains definition of abstract data type A, class Class
>> and some primitive instance generator for that Class. Instance
>> generator takes a data declaration name, takes first constructor
>> (which should be argumentless) and makes it a value for definition of
>> "c" function.
>> ----------------------------------------------------------
>> {-# LANGUAGE TemplateHaskell #-}
>>
>> module A(A,Class(..),mkSimpleClass) where
>>
>> import Language.Haskell.TH
>>
>> data A = A1 | A2
>>        deriving Show
>>
>> class Class a where
>>        c :: a
>>
>> mkSimpleClass :: Name -> Q [Dec]
>> mkSimpleClass name = do
>>        TyConI (DataD [] dname [] cs _) <- reify name
>>        ((NormalC conname []):_) <- return cs
>>        ClassI (ClassD [] cname [_] [] [SigD mname _]) <- reify ''Class
>>        return [InstanceD [] (AppT (ConT cname) (ConT dname)) [FunD mname
>> [Clause [] (NormalB (ConE conname)) []]]]
>> ----------------------------------------------------------
>>
>> Module B.hs, imports A.hs, uses mkSimpleClass on A.A name:
>> ----------------------------------------------------------
>> {-# LANGUAGE TemplateHaskell #-}
>>
>> module B where
>>
>> import A
>>
>> $(mkSimpleClass ''A)
>> ----------------------------------------------------------
>>
>> I successfully loaded B.hs into ghci, Expression "c :: A" successfully
>> evaluates to A1.
>>
>> My view on that problem is that we can add TyConIAbs for incompletely
>> exported and abstract data types.
>>
>> When someone get TyConIAbs after reification, he will know that he
>> doesn't know everything about that type.
>>
>> So, empty data declaration like "data Z" will return TyConI with empty
>> list of constructors, TyConIAbs will have empty list of constructors
>> for abstract data type.
>
> You can also export just *some* constructors, though. This would
> distinguish between  "module Foo (A(..)) where data A" and "module Foo
> (A) where data A = A", but what about "module Bar (B(..)) where data B
> = B" and "module Bar (B(B)) where data B = B | C | D"?

Never mind -- I see you mentioned "incompletely exported" already.

You could also just add a Bool parameter to TyConI signifying whether
some constructors are hidden. (Also, I imagine this doesn't just apply
to data types, but also say type classes.)


>
>
>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>
>
>
> --
> Work is punishment for failing to procrastinate effectively.
>



-- 
Work is punishment for failing to procrastinate effectively.


More information about the Haskell-Cafe mailing list