Alright... I *think* I'm nearly there, but I can't figure out how to derive a class instance using record accessors and updaters... Can anyone help? There are [| XXXf |] instances at the end of the module and they all need replaced, but I can't figure out what to replace them with. The basic idea of the module is that you define your record type, Q, and that record type contains all the state you're interested in. The Hieroglyph system has other basic state, and the idea is that you use $(additions "QWithState" ''Q) $(deriveUIState ''QWithState) to create your final UIState instance. -- - {-# LANGUAGE TemplateHaskell #-} module Graphics.Rendering.Hieroglyph.TH where import Language.Haskell.TH import Language.Haskell.TH.Syntax import Graphics.Rendering.Hieroglyph.UIState import Graphics.Rendering.Hieroglyph.Primitives import Graphics.UI.Gtk.Types (Widget) import Control.Monad {- output of $( fmap (LitE . StringL . show) [| reify ''BasicUIState |] ) TyConI (DataD [] Graphics.Rendering.Hieroglyph.BasicUIState.BasicUIState [] [RecC Graphics.Rendering.Hieroglyph.BasicUIState.BasicUIState [(Graphics.Rendering.Hieroglyph.BasicUIState.mousePosition,NotStrict,ConT Graphics.Rendering.Hieroglyph.Primitives.Point) ,(Graphics.Rendering.Hieroglyph.BasicUIState.mouseLeftButtonDown,NotStrict,ConT GHC.Base.Bool) ,(Graphics.Rendering.Hieroglyph.BasicUIState.mouseRightButtonDown,NotStrict,ConT GHC.Base.Bool) ,(Graphics.Rendering.Hieroglyph.BasicUIState.mouseMiddleButtonDown,NotStrict,ConT GHC.Base.Bool) ,(Graphics.Rendering.Hieroglyph.BasicUIState.mouseWheel,NotStrict,ConT GHC.Base.Int) ,(Graphics.Rendering.Hieroglyph.BasicUIState.keyCtrl,NotStrict,ConT GHC.Base.Bool) ,(Graphics.Rendering.Hieroglyph.BasicUIState.keyShift,NotStrict,ConT GHC.Base.Bool) ,(Graphics.Rendering.Hieroglyph.BasicUIState.keyAlt,NotStrict,ConT GHC.Base.Bool) ,(Graphics.Rendering.Hieroglyph.BasicUIState.key,NotStrict,ConT Graphics.Rendering.Hieroglyph.UIState.Key) ,(Graphics.Rendering.Hieroglyph.BasicUIState.drawing,NotStrict,AppT (ConT Data.Maybe.Maybe) (ConT Graphics.UI.Gtk.Types.Widget)) ,(Graphics.Rendering.Hieroglyph.BasicUIState.sizeX,NotStrict,ConT GHC.Float.Double) ,(Graphics.Rendering.Hieroglyph.BasicUIState.sizeY,NotStrict,ConT GHC.Float.Double) ,(Graphics.Rendering.Hieroglyph.BasicUIState.imageCache,NotStrict,AppT (ConT Data.Maybe.Maybe) (ConT Graphics.Rendering.Hieroglyph.UIState.ImageCache))]] []) -} -- usage: $(additions "MyTypeName" OldTypeName) {- - Add fields to a record type for handling basic UI state for Hieroglyph. Gives you mouse buttons, etcetera -} additions newtypenamestr nm = do TyConI (DataD _ _ _ [RecC _ fielddefs]) <- reify nm let newtypename = mkName newtypenamestr return $ (DataD [] newtypename [] [RecC newtypename [(mkName "mousePositionf",NotStrict,ConT ''Point) ,(mkName "mouseLeftButtonDownf",NotStrict,ConT ''Bool) ,(mkName "mouseRightButtonDownf",NotStrict,ConT ''Bool) ,(mkName "mouseMiddleButtonDownf",NotStrict,ConT ''Bool) ,(mkName "mouseWheelf",NotStrict,ConT ''Int) ,(mkName "keyCtrlf",NotStrict,ConT ''Bool) ,(mkName "keyShiftf",NotStrict,ConT ''Bool) ,(mkName "keyAltf",NotStrict,ConT ''Bool) ,(mkName "keyf",NotStrict,ConT ''Key) ,(mkName "drawingf",NotStrict,AppT (ConT ''Maybe) (ConT ''Widget)) ,(mkName "sizeXf",NotStrict,ConT ''Double) ,(mkName "sizeYf",NotStrict,ConT ''Double) ,(mkName "imageCachef",NotStrict,AppT (ConT ''Maybe) (ConT ''ImageCache))] ++ fielddefs] []) -- | Apply a Binary type constructor to given type: "t" -> "Binary t" appUIState :: Type -> Type appUIState t = AppT (ConT ''UIState) t -- | Generate from list of type names result of types application: -- appType T [a,b] -> "T a b" appType :: Name -> [Name] -> Type --appType t [] = ConT t -- T --appType t [t1] = AppT (ConT t) (VarT t1) -- T a --appType t [t1,t2] = AppT (AppT (ConT t) (VarT t1)) (VarT t2) -- T a b == (T a) b appType t ts = foldl (\a e -> AppT a (VarT e)) (ConT t) ts -- general definition -- | Generate `n` unique variables and return them in form of patterns and expressions genNames :: Int -> Q ([PatQ],[ExpQ]) genNames n = do ids <- replicateM n (newName "x") return (map varP ids, map varE ids) -- usage: $(deriveUIState ''MyTypeWithUIState) {- - Derive an instance of UIState from some type that has had UIState fields added to it. -} deriveUIState tp = do return [InstanceD [] (appUIState $ appType tp []) [FunD 'mousePosition [| mousePositionf |] ,FunD 'mouseLeftButtonDown [| mouseLeftButtonDownf |] ,FunD 'mouseRightButtonDown [| mouseRightButtonDownf |] ,FunD 'mouseMiddleButtonDown [| mouseMiddleButtonDownf |] ,FunD 'mouseWheel [| mouseWheelf |] ,FunD 'keyCtrl [| keyCtrlf |] ,FunD 'keyShift [| keyShiftf |] ,FunD 'keyAlt [| keyAltf |] ,FunD 'key [| keyf |] ,FunD 'drawing [| drawingf |] ,FunD 'sizeX [| sizeXf |] ,FunD 'sizeY [| sizeYf |] ,FunD 'imageCache [| imageCachef |] ,FunD 'setMousePosition [| \b a -> a{ mousePositionf=b } |] ,FunD 'setMouseLeftButtonDown [| \b a -> a{ mouseLeftButtonDownf=b } |] ,FunD 'setMouseRightButtonDown [| \b a -> a{ mouseRightButtonDownf=b } |] ,FunD 'setMouseMiddleButtonDown [| \b a -> a{ mouseMiddleButtonDownf=b } |] ,FunD 'setMouseWheel [| \b a -> a{ mouseWheelf=b } |] ,FunD 'setKeyCtrl [| \b a -> a{ keyCtrlf=b } |] ,FunD 'setKeyShift [| \b a -> a{ keyShiftf=b } |] ,FunD 'setKeyAlt [| \b a -> a{ keyAltf=b } |] ,FunD 'setKey [| \b a -> a{ keyf=b } |] ,FunD 'setDrawing [| \b a -> a{ drawingf=b } |] ,FunD 'setSizeX [| \b a -> a{ sizeXf=b } |] ,FunD 'setSizeY [| \b a -> a{ sizeYf=b } |] ,FunD 'setImageCache] [| \b a -> a{ imageCachef=b } |] ]
On 6 jan 2009, at 18:08, Jeff Heard wrote:
Alright... I *think* I'm nearly there, but I can't figure out how to derive a class instance using record accessors and updaters... Can anyone help? There are [| XXXf |] instances at the end of the module and they all need replaced, but I can't figure out what to replace them with.
...
-- usage: $(deriveUIState ''MyTypeWithUIState) {- - Derive an instance of UIState from some type that has had UIState fields added to it. -} deriveUIState tp = do return [InstanceD [] (appUIState $ appType tp []) [FunD 'mousePosition [| mousePositionf |] ... ,FunD 'setMousePosition [| \b a -> a{ mousePositionf=b } |] ...
Quick guess: this doesn't typecheck? FunD :: Name -> [Clause] -> Dec while [| ... |] will return something of type ExpQ (which is the same as Q Exp). You're indeed nearly there, but if you use the quotation brackets you need to write monadic code (for the Q monad) and use functions like clause and funD. The tutorials on the wiki (you've probably seen them, http://www.haskell.org/haskellwiki/Template_Haskell) or pretty good and you could also look at packages at hackage for inspiration/ examples, e.g. http://hackage.haskell.org/packages/archive/haxr-th/3000.0.0/doc/html/src/Ne... -- Regards, Eelco Lempsink
It doesn't typecheck, no, but it also doesn't check out in scope. It
complains in
[FunD 'mousePosition [| mousePositionf |] ...
that mousePositionf isn't in scope.
What I believe I need to do is use mkName "mousePositionf", but how do
I bind the record getter "mousePositionf" that is defined by the code
in the function named "additions" to mousePosition -- a.k.a. how do I
write that template? Is it a ConE? And how do I encode
a{ mousePositionf = b }
in template haskell without using the [| |] syntax, so that I can use mkName?
-- Jeff
On Tue, Jan 6, 2009 at 6:23 PM, Eelco Lempsink
On 6 jan 2009, at 18:08, Jeff Heard wrote:
Alright... I *think* I'm nearly there, but I can't figure out how to derive a class instance using record accessors and updaters... Can anyone help? There are [| XXXf |] instances at the end of the module and they all need replaced, but I can't figure out what to replace them with.
...
-- usage: $(deriveUIState ''MyTypeWithUIState) {- - Derive an instance of UIState from some type that has had UIState fields added to it. -} deriveUIState tp = do return [InstanceD [] (appUIState $ appType tp []) [FunD 'mousePosition [| mousePositionf |]
...
,FunD 'setMousePosition [| \b a -> a{ mousePositionf=b } |]
...
Quick guess: this doesn't typecheck?
FunD :: Name -> [Clause] -> Dec
while [| ... |] will return something of type ExpQ (which is the same as Q Exp).
You're indeed nearly there, but if you use the quotation brackets you need to write monadic code (for the Q monad) and use functions like clause and funD. The tutorials on the wiki (you've probably seen them, http://www.haskell.org/haskellwiki/Template_Haskell) or pretty good and you could also look at packages at hackage for inspiration/examples, e.g. http://hackage.haskell.org/packages/archive/haxr-th/3000.0.0/doc/html/src/Ne...
-- Regards,
Eelco Lempsink
On Wed, Jan 7, 2009 at 12:58 PM, Jeff Heard
And how do I encode
a{ mousePositionf = b }
in template haskell without using the [| |] syntax, so that I can use mkName?
Whenever I have a question like that, I just ask ghci: $ ghci -fth ghci> :m Control.Monad.Identity Language.Haskell.TH ghci> runQ [| 1 + 1 |] InfixE (Just (LitE (IntegerL 1))) (VarE GHC.Num.+) (Just (LitE (IntegerL 1))) ghci> runQ [| \x -> x { runIdentity = 1 } |] LamE [VarP x_1] (RecUpdE (VarE x_1) [(Control.Monad.Identity.runIdentity,LitE (I ntegerL 1))]) Note that GHCi shows TH names without "mkName" or quotes, so you need to add those. But it shows you the structure you want to generate. You can also use $() and [| |] inside [| |] to generate additional data in TH directly: ghci> runQ $ do { VarE n <- [| runIdentity |] ; [| \x -> $(recUpdE [| x |] [ fmap (\e -> (n,e)) [| 1 |] ]) |] } LamE [VarP x_2] (RecUpdE (VarE x_2) [(Control.Monad.Identity.runIdentity,LitE (I ntegerL 1))]) Note the "VarE n <- [| identifier |]" trick to extract the name from an identifier. -- ryan
On Wed, Jan 7, 2009 at 8:54 PM, Ryan Ingram
You can also use $() and [| |] inside [| |] to generate additional data in TH directly:
ghci> runQ $ do { VarE n <- [| runIdentity |] ; [| \x -> $(recUpdE [| x |] [ fmap (\e -> (n,e)) [| 1 |] ]) |] } LamE [VarP x_2] (RecUpdE (VarE x_2) [(Control.Monad.Identity.runIdentity,LitE (I ntegerL 1))])
Note the "VarE n <- [| identifier |]" trick to extract the name from an identifier.
You can use the single quote to get the name of a value.
ghci> runQ [| \x -> $(recUpdE [| x |] [ fmap (\e -> ('runIdentity, e))
[| 1 |] ]) |]
LamE [VarP x_1] (RecUpdE (VarE x_1)
[(Control.Monad.Identity.runIdentity,LitE (IntegerL 1))])
There's more in section 8.9.1 of the GHC manual.
--
Dave Menendez
Good tricks! Would one of you like to write them up on the Wiki? http://haskell.org/haskellwiki/Template_Haskell
Simon
| -----Original Message-----
| From: haskell-cafe-bounces@haskell.org [mailto:haskell-cafe-bounces@haskell.org] On Behalf Of
| Ryan Ingram
| Sent: 08 January 2009 01:55
| To: Jeff Heard
| Cc: haskell
| Subject: Re: [Haskell-cafe] Template Haskell question
|
| On Wed, Jan 7, 2009 at 12:58 PM, Jeff Heard
Jeff Heard schrieb:
Alright... I *think* I'm nearly there, but I can't figure out how to derive a class instance using record accessors and updaters...
Has this something to do with http://hackage.haskell.org/cgi-bin/hackage-scripts/package/data-accessor-tem... ?
participants (6)
-
David Menendez -
Eelco Lempsink -
Henning Thielemann -
Jeff Heard -
Ryan Ingram -
Simon Peyton-Jones