summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorWill Thompson <will.thompson@collabora.co.uk>2010-11-08 22:11:02 (GMT)
committerWill Thompson <will.thompson@collabora.co.uk>2010-11-08 22:11:02 (GMT)
commit874900f90f7bf9810bd477cbd490d12e6115fd20 (patch)
treee73bff82d6ce105b07869eeeb84b34a70dfecc75
parentc231b96596b9f81adb10967354278c39cd896c5d (diff)
downloadhaskell-gi-master.tar.gz
haskell-gi-master.tar.xz
improve loading/listing api, bind base_info_get_typeHEADmaster
-rw-r--r--GI/BaseInfo.chs40
-rw-r--r--GI/Typelib.chs70
-rw-r--r--GI/Util.hs10
-rw-r--r--GObject-Introspection.cabal2
-rw-r--r--Main.hs9
5 files changed, 93 insertions, 38 deletions
diff --git a/GI/BaseInfo.chs b/GI/BaseInfo.chs
index baecbba..a2ce17f 100644
--- a/GI/BaseInfo.chs
+++ b/GI/BaseInfo.chs
@@ -1,16 +1,48 @@
module GI.BaseInfo
- ( baseInfoGetName
+ ( baseInfoName
+ , baseInfoNamespace
+ , baseInfoType
)
where
import Foreign
import Foreign.C
import Foreign.C.String
+
+import Control.Applicative ((<$>))
+
{# import GI.Types #}
#include <girepository.h>
-baseInfoGetName :: BaseInfo -> IO String
-baseInfoGetName (BaseInfo p) = do
- ret <- {# call g_base_info_get_name #} $ TypeInfo $ castPtr p
+{# context prefix="g_base_info" #}
+
+{# enum GIInfoType as InfoType {underscoreToCase} with prefix="GI" deriving (Show, Eq) #}
+
+-- Because all the C types are synonyms, c2hs picks the last one...
+stupidCast :: BaseInfoClass base
+ => base
+ -> TypeInfo
+stupidCast base = TypeInfo (castPtr p)
+ where
+ (BaseInfo p) = baseInfo base
+
+baseInfoName :: BaseInfoClass base
+ => base
+ -> String
+baseInfoName bi = unsafePerformIO $ do
+ ret <- {# call g_base_info_get_name #} (stupidCast bi)
+ peekCString ret
+
+baseInfoNamespace :: BaseInfoClass base
+ => base
+ -> String
+baseInfoNamespace bi = unsafePerformIO $ do
+ ret <- {# call g_base_info_get_namespace #} (stupidCast bi)
peekCString ret
+
+baseInfoType :: BaseInfoClass base
+ => base
+ -> InfoType
+baseInfoType bi = unsafePerformIO $ do
+ toEnum . fromIntegral <$> {# call get_type #} (stupidCast bi)
diff --git a/GI/Typelib.chs b/GI/Typelib.chs
index b9ac524..506fa0a 100644
--- a/GI/Typelib.chs
+++ b/GI/Typelib.chs
@@ -1,45 +1,61 @@
module GI.Typelib
- ( repositoryGetNInfos
- , repositoryGetInfo
- , repositoryRequire
- , repositoryLoad
+ ( getSearchPath
+
+ , load
+ , getInfos
)
where
import Foreign
import Foreign.C
+import Control.Applicative ((<$>))
+import Control.Monad (when, forM)
+
import System.Glib.GError
+import System.Glib.GList
import GI.Types
+import GI.Util
+import GI.BaseInfo
#include <girepository.h>
+{#context prefix="g_irepository"#}
+
{# pointer *GITypelib as Typelib newtype #}
-{# pointer *GIRepository as Repository newtype #}
+unTypelib :: Typelib -> Ptr Typelib
+unTypelib (Typelib p) = p
-getDefaultRepository :: IO Repository
-getDefaultRepository = {# call g_irepository_get_default #}
+{# pointer *GIRepository as Repository newtype #}
nullRepository = Repository nullPtr
-repositoryGetNInfos :: String -> IO CInt
-repositoryGetNInfos ns = withCString ns $ \nsPtr ->
- {# call unsafe g_irepository_get_n_infos #} nullRepository nsPtr
-
-repositoryGetInfo :: String -> CInt -> IO BaseInfo
-repositoryGetInfo ns i = withCString ns $ \nsPtr -> do
- ret <- {# call unsafe g_irepository_get_info #} nullRepository nsPtr (fromIntegral i)
- return $ BaseInfo $ castPtr ret
-
-repositoryRequire :: String -> IO Typelib
-repositoryRequire ns = --version =
- withCString ns $ \nsPtr ->
--- withCString version $ \versionPtr ->
- propagateGError $ {# call unsafe g_irepository_require #} nullRepository nsPtr nullPtr 0
-
-repositoryLoad :: Typelib -> IO String
-repositoryLoad typelib = do
- ret <- propagateGError $ {# call unsafe g_irepository_load_typelib #} nullRepository typelib 0
- peekCString ret
-
+getSearchPath :: IO [FilePath]
+getSearchPath = do
+ paths <- {# call unsafe get_search_path #}
+ pathPtrs <- readGSList paths
+ mapM peekCString pathPtrs
+
+getInfos :: Typelib -> IO [BaseInfo]
+getInfos typelib = do
+ nsPtr <- {# call unsafe g_typelib_get_namespace #} typelib
+ n <- {# call unsafe get_n_infos #} nullRepository nsPtr
+ forM [0..n-1] $ \i -> do
+ ret <- {# call unsafe get_info #} nullRepository nsPtr (fromIntegral i)
+ return $ BaseInfo $ castPtr ret
+
+load :: String -> Maybe String -> IO Typelib
+load namespace version =
+ withCString namespace $ \nsPtr ->
+ maybeWithCString version $ \versionPtr ->
+ propagateGError $ \gError -> do
+ -- _require()'s return is annotated as 'transfer none'. I'm assuming
+ -- that we don't need to ref this because it's never going to be freed,
+ -- though, so we're fine.
+ typelib <- {# call unsafe require #} nullRepository nsPtr versionPtr 0
+ gError
+ when (unTypelib typelib /= nullPtr) $ do
+ _ <- {# call unsafe load_typelib #} nullRepository typelib 0 gError
+ return ()
+ return typelib
diff --git a/GI/Util.hs b/GI/Util.hs
new file mode 100644
index 0000000..0a97de8
--- /dev/null
+++ b/GI/Util.hs
@@ -0,0 +1,10 @@
+module GI.Util
+ ( maybeWithCString
+ )
+where
+
+import Foreign
+import Foreign.C
+
+maybeWithCString :: Maybe String -> (CString -> IO a) -> IO a
+maybeWithCString = maybe ($ nullPtr) withCString
diff --git a/GObject-Introspection.cabal b/GObject-Introspection.cabal
index 20260a3..9881b62 100644
--- a/GObject-Introspection.cabal
+++ b/GObject-Introspection.cabal
@@ -50,7 +50,7 @@ Cabal-version: >=1.2
Executable lol
main-is: Main.hs
- other-modules: GI.Types, GI.Typelib, GI.BaseInfo
+ other-modules: GI.Types, GI.Typelib, GI.BaseInfo, GI.Util
pkgconfig-depends: gobject-introspection-1.0
extensions: ForeignFunctionInterface
build-depends: base >= 4, gtk, glib
diff --git a/Main.hs b/Main.hs
index a433da0..862830a 100644
--- a/Main.hs
+++ b/Main.hs
@@ -9,10 +9,7 @@ import System.Glib.GError
main = handleGError (\(GError dom code msg) -> print (dom, code, msg)) $ do
initGUI
- tp <- repositoryRequire "TelepathyGLib"
- repositoryLoad tp
- n <- repositoryGetNInfos "TelepathyGLib"
- forM_ [0..n-1] $ \i -> do
- putStrLn =<< baseInfoGetName =<< repositoryGetInfo "TelepathyGLib" i
-
+ tp <- load "TelepathyGLib" Nothing
+ infos <- getInfos tp
+ forM_ infos $ \info -> print (baseInfoName info, baseInfoType info)