module Graphics.UI.Gtk.Extra.BuilderTH
( gtkBuilderAccessor
, gtkViewAccessor
, fromBuilder
)
where
import Graphics.UI.Gtk.Extra.Builder (fromBuilder)
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Lib
gtkBuilderAccessor :: String -> String -> Q [Dec]
gtkBuilderAccessor name kind = sequenceQ
[ sigD funcName
(appT (appT arrowT (conT (mkName "Builder")))
(appT (conT (mkName "IO")) (conT (mkName kind))))
, funD funcName
[clause [] (normalB (appE castedAccess
(litE (stringL name)))) []]
]
where castedAccess = appE (varE (mkName "fromBuilder")) casting
casting = varE (mkName ("castTo" ++ kind))
funcName = mkName name
gtkViewAccessor :: String -> String -> String -> String -> Q [Dec]
gtkViewAccessor builderModule uiAccessor name kind = sequenceQ
[ sigD funcName
(appT (appT arrowT (conT (mkName "View")))
(appT (conT (mkName "IO")) (conT (mkName kind))))
, funD funcName
[clause [varP builderName]
(normalB (appE (varE funcNameInBuilder)
(appE (varE (mkName uiAccessor))
(varE builderName)
)
)) []]
]
where castedAccess = appE (varE (mkName "fromBuilder")) casting
casting = varE (mkName ("castTo" ++ kind))
funcName = mkName name
funcNameInBuilder = mkName $ builderModule ++ ('.' : name)
builderName = mkName "b"