module Graphics.UI.Gtk.Glade.Accessor (
importGladeXml
) where
import Text.XML.HaXml.Wrappers
import Text.XML.HaXml.Parse
import Text.XML.HaXml.Combinators
import Text.XML.HaXml.XmlContent
import Text.XML.HaXml.OneOfN
import Language.Haskell.TH
import Graphics.UI.Gtk.Glade (xmlGetWidget)
import Graphics.UI.Gtk.Glade.Glade20DTD
importGladeXml :: FilePath -> Q [Dec]
importGladeXml fp = do wcs <- runIO widgetIdsAndClasses
mapM (uncurry mkAccessor) wcs
where
mkAccessor id ('G':'t':'k':clas)
= funD (mkName id)
[clause [varP (mkName "xml")]
(normalB $ [| xmlGetWidget $(varE $ mkName "xml")
$(varE $ mkName
$ "castTo" ++ clas) id |])
[]]
widgetIdsAndClasses = do cs <- readFile fp
case readXml cs of
Right d -> return $ widgetIdClass d
_ -> return []
widgetIdClass :: Glade_interface -> [(String, String)]
widgetIdClass (Glade_interface _ _ ws) = concat $ map goWidget ws
goWidget :: Widget -> [(String, String)]
goWidget (Widget (Widget_Attrs { widgetClass = wc, widgetId = wid }) _ _ _ _ ch)
= ((wid, wc):(concat $ map goChild ch))
goChild (Child _ (OneOf2 widget) _) = goWidget widget
goChild (Child _ _ _) = []