TH.hs

-- gtk2hs-cast-th -- A type class for cast functions of Gtk2hs: TH package
-- Copyright (c) 2009 Marco Túlio Gontijo e Silva <marcot@holoscopio.com>
-- CC0 Waiver 1.0 Universal [Beta 3]
-- See LICENSE

module System.Glib.Cast.TH (instance_) where

-- base
import Data.Maybe

-- hint
import Language.Haskell.Interpreter

-- template-haskell
import Language.Haskell.TH.Syntax

instance_ :: String -> Q [Dec]
instance_ module_
  = do
    (Right (elements :: [ModuleElem]))
      <- qRunIO $ runInterpreter $ getModuleExports module_
    return $ map makeInstance_ $ mapMaybe isCastTo elements

isCastTo :: ModuleElem -> Maybe String
isCastTo (Fun ('c' : 'a' : 's' : 't' : 'T' : 'o' : rest)) = Just rest
isCastTo _others = Nothing

makeInstance_ :: String -> Dec
makeInstance_ type_
  = InstanceD []
  (AppT (ConT $ mkName "Cast") $ ConT $ mkName type_)
  [ FunD (mkName "cast")
    [ Clause [] (NormalB $ VarE $ mkName $ "castTo" ++ type_) []]]