On Wed, Jul 28, 2010 at 12:55 PM, Gábor Lehel <illiss...@gmail.com> wrote: > 2010/7/28 Serguey Zefirov <sergu...@gmail.com>: >> 2010/7/28 Jonas Almström Duregård <jonas.dureg...@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@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. _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe