Can I reify types?
This doesn't work: -- packages: template-haskell {-# OPTIONS_GHC -XTemplateHaskell #-} module Main where import Language.Haskell.TH data A a = A a type C = A Int data ABC = ABC Int $(do a <- reify $ mkName "C" report False $ show a return [] ) main = print "" || [1 of 1] Compiling Main ( test.hs, test.o ) || test.hs|1| `C' is not in scope at a reify Using mkName "A" results in test.hs|1 error| || DataConI Main.A (ForallT [a_1627391370] [] (AppT (AppT ArrowT (VarT a_1627391370)) (AppT (ConT Main.A) (VarT a_1627391370)))) Main.A (Fixity 9 InfixL) as expected Why do I need it? I'd like to implement kind of very basic relational data representation the way IxSet is doing it but without dynamics.. It will look like this: type CDs = Table (Autoinc, Artist, Title, Year) -- col types (Artist, Title, Year) -- keys () -- is detail of type Tracks = Table (Autoinc, Title, RecordingDate) (Title, RecordingDate) (CDs) $(mkDB ["CDs","Tracks"]) To be able to automatically derive insert{CDs,Tracks} delete{CDs,Tracks} update{CDs,Tracks} functions I need to get information about those types.. Is this possible? Thanks Marc Weber
On Sun, May 25, 2008 at 5:19 PM, Marc Weber
This doesn't work:
$(do a <- reify $ mkName "C" report False $ show a return [] )
Whenever you can avoid using mkName and provide the Name directly using single quotes, in this case ... $(do a <- reify ''C report False $ show a return [] ) ... would do. Note that a preceeding souble single quote is ('') used for type constructors whereas a single quote (') is used for data constructors.
main = print ""
|| [1 of 1] Compiling Main ( test.hs, test.o ) || test.hs|1| `C' is not in scope at a reify
Using mkName "A" results in test.hs|1 error| || DataConI Main.A (ForallT [a_1627391370] [] (AppT (AppT ArrowT (VarT a_1627391370)) (AppT (ConT Main.A) (VarT a_1627391370)))) Main.A (Fixity 9 InfixL) as expected
Why do I need it? I'd like to implement kind of very basic relational data representation the way IxSet is doing it but without dynamics..
It will look like this:
type CDs = Table (Autoinc, Artist, Title, Year) -- col types (Artist, Title, Year) -- keys () -- is detail of type Tracks = Table (Autoinc, Title, RecordingDate) (Title, RecordingDate) (CDs) $(mkDB ["CDs","Tracks"])
To be able to automatically derive insert{CDs,Tracks} delete{CDs,Tracks} update{CDs,Tracks} functions I need to get information about those types.. Is this possible?
Thanks Marc Weber _______________________________________________ template-haskell mailing list template-haskell@haskell.org http://www.haskell.org/mailman/listinfo/template-haskell
See http://hackage.haskell.org/trac/ghc/ticket/2339 Simon | -----Original Message----- | From: template-haskell-bounces@haskell.org [mailto:template-haskell-bounces@haskell.org] On Behalf Of | Marc Weber | Sent: 25 May 2008 16:19 | To: template-haskell@haskell.org | Subject: [Template-haskell] Can I reify types? | | This doesn't work: | | -- packages: template-haskell | {-# OPTIONS_GHC -XTemplateHaskell #-} | module Main where | import Language.Haskell.TH | | data A a = A a | | type C = A Int | | data ABC = ABC Int | | $(do | a <- reify $ mkName "C" | report False $ show a | return [] | ) | main = print "" | | | || [1 of 1] Compiling Main ( test.hs, test.o ) | || | test.hs|1| `C' is not in scope at a reify | | Using mkName "A" results in | test.hs|1 error| | || DataConI Main.A (ForallT [a_1627391370] [] (AppT (AppT ArrowT (VarT a_1627391370)) (AppT (ConT | Main.A) (VarT a_1627391370)))) Main.A (Fixity 9 InfixL) | as expected | | Why do I need it? | I'd like to implement kind of very basic relational data representation | the way IxSet is doing it but without dynamics.. | | It will look like this: | | type CDs = Table (Autoinc, Artist, Title, Year) -- col types | (Artist, Title, Year) -- keys | () -- is detail of | type Tracks = Table (Autoinc, Title, RecordingDate) | (Title, RecordingDate) | (CDs) | $(mkDB ["CDs","Tracks"]) | | To be able to automatically derive | insert{CDs,Tracks} | delete{CDs,Tracks} | update{CDs,Tracks} | functions I need to get information about those types.. Is this | possible? | | Thanks | Marc Weber | _______________________________________________ | template-haskell mailing list | template-haskell@haskell.org | http://www.haskell.org/mailman/listinfo/template-haskell
participants (3)
-
Alfonso Acosta -
Marc Weber -
Simon Peyton-Jones