packages feed

glib 0.12.0 → 0.12.1

raw patch · 13 files changed

+366/−206 lines, 13 filesdep −haskell98setup-changednew-uploader

Dependencies removed: haskell98

Files

Gtk2HsSetup.hs view
@@ -1,37 +1,7 @@ {-# LANGUAGE CPP #-} -#define CABAL_VERSION_ENCODE(major, minor, micro) (     \-          ((major) * 10000)                             \-        + ((minor) *   100)                             \-        + ((micro) *     1))--#define CABAL_VERSION_CHECK(major,minor,micro)    \-        (CABAL_VERSION >= CABAL_VERSION_ENCODE(major,minor,micro))---- now, this is bad, but Cabal doesn't seem to actually pass any information about--- its version to CPP, so guess the version depending on the version of GHC-#ifdef CABAL_VERSION_MINOR-#ifndef CABAL_VERSION_MAJOR-#define CABAL_VERSION_MAJOR 1-#endif-#ifndef CABAL_VERSION_MICRO-#define CABAL_VERSION_MICRO 0-#endif-#define CABAL_VERSION CABAL_VERSION_ENCODE(     \-        CABAL_VERSION_MAJOR,                    \-        CABAL_VERSION_MINOR,                    \-        CABAL_VERSION_MICRO)-#else-#warning Setup.hs is guessing the version of Cabal. If compilation of Setup.hs fails use -DCABAL_VERSION_MINOR=x for Cabal version 1.x.0 when building (prefixed by --ghc-option= when using the 'cabal' command)-#if (__GLASGOW_HASKELL__ >= 700)-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,10,0)-#else-#if (__GLASGOW_HASKELL__ >= 612)-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,8,0)-#else-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,6,0)-#endif-#endif+#ifndef CABAL_VERSION_CHECK+#error This module has to be compiled via the Setup.hs program which generates the gtk2hs-macros.h file #endif  -- | Build a Gtk2hs package.@@ -49,13 +19,7 @@                                            libraryDirs,                                            extraLibraries,                                            extraGHCiLibraries )-import Distribution.Simple.PackageIndex (-#if CABAL_VERSION_CHECK(1,8,0)-  lookupInstalledPackageId-#else-  lookupPackageId-#endif-  )+import Distribution.Simple.PackageIndex ( lookupInstalledPackageId ) import Distribution.PackageDescription as PD ( PackageDescription(..),                                                updatePackageDescription,                                                BuildInfo(..),@@ -64,17 +28,13 @@                                                libModules, hasLibs) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),                                            InstallDirs(..),-#if CABAL_VERSION_CHECK(1,8,0)                                            componentPackageDeps,-#else-                                           packageDeps,-#endif                                            absoluteInstallDirs) import Distribution.Simple.Compiler  ( Compiler(..) ) import Distribution.Simple.Program (   Program(..), ConfiguredProgram(..),-  rawSystemProgramConf, rawSystemProgramStdoutConf, programName,-  c2hsProgram, pkgConfigProgram, requireProgram, ghcPkgProgram,+  rawSystemProgramConf, rawSystemProgramStdoutConf, programName, programPath,+  c2hsProgram, pkgConfigProgram, gccProgram, requireProgram, ghcPkgProgram,   simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg) import Distribution.ModuleName ( ModuleName, components, toFilePath ) import Distribution.Simple.Utils@@ -84,11 +44,7 @@                                   fromFlagOrDefault, defaultRegisterFlags) import Distribution.Simple.BuildPaths ( autogenModulesDir ) import Distribution.Simple.Install ( install )-#if CABAL_VERSION_CHECK(1,8,0) import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage )-#else-import qualified Distribution.Simple.Register as Register ( register )-#endif import Distribution.Text ( simpleParse, display ) import System.FilePath import System.Exit (exitFailure)@@ -147,8 +103,6 @@ -- The following code is a big copy-and-paste job from the sources of -- Cabal 1.8 just to be able to fix a field in the package file. Yuck. -#if CABAL_VERSION_CHECK(1,8,0)-         installHook :: PackageDescription -> LocalBuildInfo                    -> UserHooks -> InstallFlags -> IO () installHook pkg_descr localbuildinfo _ flags = do@@ -195,19 +149,20 @@      _ | modeGenerateRegFile   -> die "Generate Reg File not supported"        | modeGenerateRegScript -> die "Generate Reg Script not supported"        | otherwise             -> registerPackage verbosity+                                    installedPkgInfo pkg lbi inplace #if CABAL_VERSION_CHECK(1,10,0)-                                    installedPkgInfo pkg lbi inplace [packageDb]+                                    packageDbs #else-                                    installedPkgInfo pkg lbi inplace packageDb+                                    packageDb #endif    where     modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))     modeGenerateRegScript = fromFlag (regGenScript regFlags)     inplace   = fromFlag (regInPlace regFlags)-    packageDb = case flagToMaybe (regPackageDB regFlags) of-                    Just db -> db-                    Nothing -> registrationPackageDB (withPackageDB lbi)+    packageDbs = nub $ withPackageDB lbi+                    ++ maybeToList (flagToMaybe  (regPackageDB regFlags))+    packageDb = registrationPackageDB packageDbs     distPref  = fromFlag (regDistPref regFlags)     verbosity = fromFlag (regVerbosity regFlags) @@ -215,45 +170,7 @@   where     verbosity = fromFlag (regVerbosity regFlags) -#else-installHook :: PackageDescription -> LocalBuildInfo-                   -> UserHooks -> InstallFlags -> IO ()-installHook pkg_descr localbuildinfo _ flags = do-  let copyFlags = defaultCopyFlags {-                      copyDistPref   = installDistPref flags,-                      copyInPlace    = installInPlace flags,-                      copyUseWrapper = installUseWrapper flags,-                      copyDest       = toFlag NoCopyDest,-                      copyVerbosity  = installVerbosity flags-                  }-  install pkg_descr localbuildinfo copyFlags-  let registerFlags = defaultRegisterFlags {-                          regDistPref  = installDistPref flags,-                          regInPlace   = installInPlace flags,-                          regPackageDB = installPackageDB flags,-                          regVerbosity = installVerbosity flags-                      }-  when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags -registerHook :: PackageDescription -> LocalBuildInfo-        -> UserHooks -> RegisterFlags -> IO ()-registerHook pkg_descr localbuildinfo _ flags =-    if hasLibs pkg_descr-    then register pkg_descr localbuildinfo flags-    else setupMessage verbosity-           "Package contains no library to register:" (packageId pkg_descr)-  where verbosity = fromFlag (regVerbosity flags)--register :: PackageDescription -> LocalBuildInfo-         -> RegisterFlags -- ^Install in the user's database?; verbose-         -> IO ()-register pkg_descr lbi regFlags = do-  let verbosity = fromFlag (regVerbosity regFlags)-  warn verbosity "Cannot register ghci libraries with Cabal 1.6 (need 1.8)."-  Register.register pkg_descr lbi regFlags-  -#endif- ------------------------------------------------------------------------------ -- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later ------------------------------------------------------------------------------@@ -291,15 +208,12 @@   -- additional .chi files might be needed that other packages have installed;   -- we assume that these are installed in the same place as .hi files   let chiDirs = [ dir |-#if CABAL_VERSION_CHECK(1,8,0)                   ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi),                   dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ]-#else-                  ipi <- packageDeps lbi,-                  dir <- maybe [] importDirs (lookupPackageId (installedPkgs lbi) ipi) ]-#endif+  (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi)   rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $        map ("--include=" ++) (outDir:chiDirs)+    ++ [ "--cpp=" ++ programPath gccProg, "--cppopts=-E" ]     ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi]     ++ ["--output-dir=" ++ newOutDir,         "--output=" ++ newOutFile,@@ -321,18 +235,10 @@   -- cannot use the recommended 'findModuleFiles' since it fails if there exists   -- a modules that does not have a .chi file   mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi] . toFilePath)-#if CABAL_VERSION_CHECK(1,8,0)                    (PD.libModules lib)-#else-                   (PD.libModules pkg)-#endif                     let files = [ f | Just f <- mFiles ]-#if CABAL_VERSION_CHECK(1,8,0)   installOrdinaryFiles verbosity libPref files-#else-  copyFiles verbosity libPref files-#endif     installCHI _ _ _ _ = return ()@@ -348,7 +254,15 @@ signalGenProgram = simpleProgram "gtk2hsHookGenerator"  c2hsLocal :: Program-c2hsLocal = simpleProgram "gtk2hsC2hs"+c2hsLocal = (simpleProgram "gtk2hsC2hs") {+    programFindVersion = findProgramVersion "--version" $ \str ->+      -- Invoking "gtk2hsC2hs --version" gives a string like:+      -- C->Haskell Compiler, version 0.13.4 (gtk2hs branch) "Bin IO", 13 Nov 2004+      case words str of+        (_:_:_:ver:_) -> ver+        _             -> ""+  }+  genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () genSynthezisedFiles verb pd lbi = do
Setup.hs view
@@ -1,9 +1,10 @@--- Setup file for a Gtk2Hs module. Contains only adjustments specific to this module,--- all Gtk2Hs-specific boilerplate is stored in Gtk2HsSetup.hs which should be kept--- identical across all modules.-import Gtk2HsSetup ( gtk2hsUserHooks, checkGtk2hsBuildtools )-import Distribution.Simple ( defaultMainWithHooks )+-- Standard setup file for a Gtk2Hs module.+--+-- See also:+--  * SetupMain.hs    : the real Setup script for this package+--  * Gtk2HsSetup.hs  : Gtk2Hs-specific boilerplate+--  * SetupWrapper.hs : wrapper for compat with various ghc/cabal versions -main = do-  checkGtk2hsBuildtools ["gtk2hsC2hs"]-  defaultMainWithHooks gtk2hsUserHooks+import SetupWrapper ( setupWrapper )++main = setupWrapper "SetupMain.hs"
+ SetupMain.hs view
@@ -0,0 +1,11 @@+-- The real Setup file for a Gtk2Hs package (invoked via the SetupWrapper).+-- It contains only adjustments specific to this package,+-- all Gtk2Hs-specific boilerplate is kept in Gtk2HsSetup.hs+-- which should be kept identical across all packages.+--+import Gtk2HsSetup ( gtk2hsUserHooks, checkGtk2hsBuildtools )+import Distribution.Simple ( defaultMainWithHooks )++main = do+  checkGtk2hsBuildtools ["gtk2hsC2hs"]+  defaultMainWithHooks gtk2hsUserHooks
+ SetupWrapper.hs view
@@ -0,0 +1,155 @@+-- A wrapper script for Cabal Setup.hs scripts. Allows compiling the real Setup+-- conditionally depending on the Cabal version.++module SetupWrapper (setupWrapper) where++import Distribution.Package+import Distribution.Compiler+import Distribution.Simple.Utils+import Distribution.Simple.Program+import Distribution.Simple.Compiler+import Distribution.Simple.BuildPaths (exeExtension)+import Distribution.Simple.Configure (configCompiler)+import Distribution.Simple.GHC (getInstalledPackages)+import qualified Distribution.Simple.PackageIndex as PackageIndex+import Distribution.Version+import Distribution.Verbosity+import Distribution.Text++import System.Environment+import System.Process+import System.Exit+import System.FilePath+import System.Directory+import qualified Control.Exception as Exception+import System.IO.Error (isDoesNotExistError)++import Data.List+import Data.Char+import Control.Monad+++setupWrapper :: FilePath -> IO ()+setupWrapper setupHsFile = do+  args <- getArgs+  createDirectoryIfMissingVerbose verbosity True setupDir+  compileSetupExecutable+  invokeSetupScript args++  where+    setupDir         = "dist/setup-wrapper"+    setupVersionFile = setupDir </> "setup" <.> "version"+    setupProgFile    = setupDir </> "setup" <.> exeExtension+    setupMacroFile   = setupDir </> "wrapper-macros.h"++    useCabalVersion  = Version [1,8] []+    usePackageDB     = [GlobalPackageDB, UserPackageDB]+    verbosity        = normal++    cabalLibVersionToUse comp conf = do+      savedVersion <- savedCabalVersion+      case savedVersion of+        Just version+          -> return version+        _ -> do version <- installedCabalVersion comp conf+                writeFile setupVersionFile (show version ++ "\n")+                return version++    savedCabalVersion = do+      versionString <- readFile setupVersionFile+                         `Exception.catch` \e -> if isDoesNotExistError e+                                                   then return ""+                                                   else Exception.throwIO e+      case reads versionString of+        [(version,s)] | all isSpace s -> return (Just version)+        _                             -> return Nothing++    installedCabalVersion comp conf = do+      index <- getInstalledPackages verbosity usePackageDB conf++      let cabalDep = Dependency (PackageName "Cabal")+                                (orLaterVersion useCabalVersion)+      case PackageIndex.lookupDependency index cabalDep of+        []   -> die $ "The package requires Cabal library version "+                   ++ display useCabalVersion+                   ++ " but no suitable version is installed."+        pkgs -> return $ bestVersion (map fst pkgs)+      where+        bestVersion          = maximumBy (comparing preference)+        preference version   = (sameVersion, sameMajorVersion+                               ,stableVersion, latestVersion)+          where+            sameVersion      = version == cabalVersion+            sameMajorVersion = majorVersion version == majorVersion cabalVersion+            majorVersion     = take 2 . versionBranch+            stableVersion    = case versionBranch version of+                                 (_:x:_) -> even x+                                 _       -> False+            latestVersion    = version++    -- | If the Setup.hs is out of date wrt the executable then recompile it.+    -- Currently this is GHC only. It should really be generalised.+    --+    compileSetupExecutable = do+      setupHsNewer      <- setupHsFile      `moreRecentFile` setupProgFile+      cabalVersionNewer <- setupVersionFile `moreRecentFile` setupProgFile+      let outOfDate = setupHsNewer || cabalVersionNewer+      when outOfDate $ do+        debug verbosity "Setup script is out of date, compiling..."++        (comp, conf)    <- configCompiler (Just GHC) Nothing Nothing+                             defaultProgramConfiguration verbosity+        cabalLibVersion <- cabalLibVersionToUse comp conf+        let cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion+        debug verbosity $ "Using Cabal library version " ++ display cabalLibVersion++        writeFile setupMacroFile (generateVersionMacro cabalLibVersion)++        rawSystemProgramConf verbosity ghcProgram conf $+            ["--make", setupHsFile, "-o", setupProgFile]+         ++ ghcPackageDbOptions usePackageDB+         ++ ["-package", display cabalPkgid+            ,"-cpp", "-optP-include", "-optP" ++ setupMacroFile+            ,"-odir", setupDir, "-hidir", setupDir]+      where++        ghcPackageDbOptions dbstack = case dbstack of+          (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs+          (GlobalPackageDB:dbs)               -> "-no-user-package-conf"+                                               : concatMap specific dbs+          _                                   -> ierror+          where+            specific (SpecificPackageDB db) = [ "-package-conf", db ]+            specific _ = ierror+            ierror     = error "internal error: unexpected package db stack"++        generateVersionMacro :: Version -> String+        generateVersionMacro version =+          concat+            ["/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n"+            ,"#define CABAL_VERSION_CHECK(major1,major2,minor) (\\\n"+            ,"  (major1) <  ",major1," || \\\n"+            ,"  (major1) == ",major1," && (major2) <  ",major2," || \\\n"+            ,"  (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"+            ,"\n\n"+            ]+          where+            (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)++    invokeSetupScript :: [String] -> IO ()+    invokeSetupScript args = do+      info verbosity $ unwords (setupProgFile : args)+      process <- runProcess (currentDir </> setupProgFile) args+                   Nothing Nothing+                   Nothing Nothing Nothing+      exitCode <- waitForProcess process+      unless (exitCode == ExitSuccess) $ exitWith exitCode++moreRecentFile :: FilePath -> FilePath -> IO Bool+moreRecentFile a b = do+  exists <- doesFileExist b+  if not exists+    then return True+    else do tb <- getModificationTime b+            ta <- getModificationTime a+            return (ta > tb)
System/Glib/FFI.hs view
@@ -27,45 +27,40 @@ --  module System.Glib.FFI (-  with,   nullForeignPtr,   maybeNull,   newForeignPtr,   withForeignPtrs,+#if MIN_VERSION_base(4,4,0)+  unsafePerformIO,+  unsafeForeignPtrToPtr,+#endif   module Foreign,   module Foreign.C   ) where -import System.IO.Unsafe (unsafePerformIO)- -- We should almost certainly not be using the standard free function anywhere -- in the glib or gtk bindings, so we do not re-export it from this module.  import Foreign.C-import qualified Foreign hiding (free)-import Foreign  hiding	(with, newForeignPtr, free-#if (__GLASGOW_HASKELL__<606)-    , withObject-#endif-  )-#if (__GLASGOW_HASKELL__>=610)-import qualified Foreign.Concurrent++#if MIN_VERSION_base(4,4,0)+import Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr, newForeignPtr, free)+import System.IO.Unsafe (unsafePerformIO)++import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+#else+import Foreign hiding (newForeignPtr, free) #endif -with :: (Storable a) => a -> (Ptr a -> IO b) -> IO b-with = Foreign.with+import qualified Foreign.Concurrent -#if (__GLASGOW_HASKELL__>=610) newForeignPtr :: Ptr a -> FinalizerPtr a -> IO (ForeignPtr a) newForeignPtr p finalizer    = Foreign.Concurrent.newForeignPtr p (mkFinalizer finalizer p)  foreign import ccall "dynamic"    mkFinalizer :: FinalizerPtr a -> Ptr a -> IO ()-#else-newForeignPtr :: Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)-newForeignPtr = flip Foreign.newForeignPtr-#endif  nullForeignPtr :: ForeignPtr a nullForeignPtr = unsafePerformIO $ newForeignPtr_ nullPtr
System/Glib/GError.chs view
@@ -58,14 +58,15 @@   -- particular error domain use 'catchGErrorJustDomain' \/   -- 'handleGErrorJustDomain'   ---  catchGError,   catchGErrorJust,   catchGErrorJustDomain,   -  handleGError,   handleGErrorJust,   handleGErrorJustDomain,   +  -- ** Deprecated+  catchGError,+  handleGError,   failOnGError,   throwGError, @@ -89,20 +90,20 @@ import Foreign import Foreign.C import System.Glib.UTFString-#if HAVE_NEW_CONTROL_EXCEPTION-import Control.OldException-#else import Control.Exception-#endif--import Data.Dynamic--{# context lib="gtk" prefix ="gtk" #}+import Data.Typeable+import Prelude hiding (catch)  -- | A GError consists of a domain, code and a human readable message. data GError = GError !GErrorDomain !GErrorCode !GErrorMessage   deriving Typeable +instance Show GError where+  show (GError _ _ msg) = msg++instance Exception GError++ type GQuark = {#type GQuark #}  -- | A code used to identify the \'namespace\' of the error. Within each error@@ -184,7 +185,8 @@ -- | Use this if you need to explicitly throw a GError or re-throw an existing --   GError that you do not wish to handle. throwGError :: GError -> IO a-throwGError gerror = evaluate (throwDyn gerror)+throwGError = throw+{-# DEPRECATED throwGError "Use ordinary Control.Exception.throw" #-}  -- | This will catch any GError exception. The handler function will receive the --   raw GError. This is probably only useful when you want to take some action@@ -200,7 +202,8 @@ catchGError :: IO a            -- ^ The computation to run             -> (GError -> IO a) -- ^ Handler to invoke if an exception is raised             -> IO a-catchGError action handler = catchDyn action handler+catchGError = catch+{-# DEPRECATED catchGError "Use ordinary Control.Exception.catch" #-}  -- | This will catch just a specific GError exception. If you need to catch a --   range of related errors, 'catchGErrorJustDomain' is probably more@@ -215,11 +218,11 @@                 -> IO a                    -- ^ The computation to run                 -> (GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised                 -> IO a-catchGErrorJust code action handler = catchGError action handler'+catchGErrorJust code action handler = catch action handler'   where handler' gerror@(GError domain code' msg)           | fromIntegral domain == gerrorDomain code            && code' == fromEnum code   = handler msg-          | otherwise                  = throwGError gerror+          | otherwise                  = throw gerror  -- | Catch all GErrors from a particular error domain. The handler function --   should just deal with one error enumeration type. If you need to catch@@ -238,7 +241,7 @@                       -> (err -> GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised                       -> IO a catchGErrorJustDomain action (handler :: err -> GErrorMessage -> IO a) =-    catchGError action handler'+    catch action handler'   where handler' gerror@(GError domain code msg)           | fromIntegral domain == gerrorDomain (undefined::err) = handler (toEnum code) msg           | otherwise                                            = throwGError gerror@@ -249,13 +252,14 @@ -- >   ... --    handleGError :: (GError -> IO a) -> IO a -> IO a-handleGError = flip catchGError+handleGError = handle+{-# DEPRECATED handleGError "Use ordinary Control.Exception.handle" #-}  -- | A verson of 'handleGErrorJust' with the arguments swapped around. handleGErrorJust :: GErrorClass err => err -> (GErrorMessage -> IO a) -> IO a -> IO a handleGErrorJust code = flip (catchGErrorJust code) --- | A verson of 'handleGErrorJustDomain' with the arguments swapped around.+-- | A verson of 'catchGErrorJustDomain' with the arguments swapped around. handleGErrorJustDomain :: GErrorClass err => (err -> GErrorMessage -> IO a) -> IO a -> IO a handleGErrorJustDomain = flip catchGErrorJustDomain
+ System/Glib/GString.chs view
@@ -0,0 +1,64 @@+-- -*-haskell-*-+--  GIMP Toolkit (GTK)+--+--  Author : Andreas Baldeau+--+--  Created: 14 November 2010+--+--  Copyright (C) 2010 Andreas Baldeau+--+--  This library is free software; you can redistribute it and/or+--  modify it under the terms of the GNU Lesser General Public+--  License as published by the Free Software Foundation; either+--  version 2.1 of the License, or (at your option) any later version.+--+--  This library is distributed in the hope that it will be useful,+--  but WITHOUT ANY WARRANTY; without even the implied warranty of+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU+--  Lesser General Public License for more details.+--+-- |+-- Maintainer  : gtk2hs-users@lists.sourceforge.net+-- Stability   : provisional+-- Portability : portable (depends on GHC)+--+-- Defines functions to extract data from a GString.+--+module System.Glib.GString (+  GString,+  readGString,+  fromGString,+  ) where++import Foreign+import Control.Exception	(bracket)+import Control.Monad		(foldM)++import System.Glib.FFI++{# context lib="glib" prefix="g" #}++{#pointer * GString#}++-- methods++-- Turn a GString into a String but don't destroy it.+--+readGString :: GString -> IO (Maybe String)+readGString gstring+  | gstring == nullPtr = return Nothing+  | otherwise	       = do+    gstr <- {#get GString->str#} gstring+    maybePeek peekCString gstr++-- Turn a GList into a list of pointers (freeing the GList in the process).+--+fromGString :: GString -> IO (Maybe String)+fromGString gstring+  | gstring == nullPtr = return Nothing+  | otherwise	       = do+    gstr <- {#get GString->str#} gstring+    str  <- maybePeek peekCString gstr+    _ <- {#call unsafe string_free#} gstring $ fromBool True+    return str+
System/Glib/GType.chs view
@@ -28,7 +28,8 @@ -- module System.Glib.GType (   GType,-  typeInstanceIsA+  typeInstanceIsA,+  glibTypeInit,   ) where  import System.Glib.FFI@@ -45,3 +46,13 @@ typeInstanceIsA obj p = toBool $   unsafePerformIO ({#call unsafe g_type_check_instance_is_a#} obj p) ++-- | Prior to any use of the glib type/object system, @glibTypeInit@ has to+-- be called to initialise the system.+--+-- Note that this is not needed for gtk applications using @initGUI@ since+-- that initialises everything itself. It is only needed for applications+-- using glib directly, without also using gtk.+--+glibTypeInit :: IO ()+glibTypeInit = {# call g_type_init #}
System/Glib/StoreValue.hsc view
@@ -34,12 +34,7 @@  import Control.Monad	(liftM) -#if HAVE_NEW_CONTROL_EXCEPTION-import Control.OldException-#else-import Control.Exception-                          (throw, Exception(AssertionFailed))-#endif+import Control.Exception  (throw, AssertionFailed(..))  #include<glib-object.h>
System/Glib/Types.chs view
@@ -52,8 +52,6 @@   toGObject         :: o -> GObject   -- | Unchecked downcast.   unsafeCastGObject :: GObject -> o-  {-# INLINE toGObject #-}-  {-# INLINE unsafeCastGObject #-}  instance GObjectClass GObject where   toGObject = id
System/Glib/UTFString.hs view
@@ -52,42 +52,43 @@  import System.Glib.FFI --- Define withUTFString to emit UTF-8.+-- | Like 'withCString' but using the UTF-8 encoding. -- withUTFString :: String -> (CString -> IO a) -> IO a-withUTFString hsStr = withCString (toUTF hsStr)+withUTFString hsStr = withCAString (toUTF hsStr) --- Define withUTFStringLen to emit UTF-8.+-- | Like 'withCStringLen' but using the UTF-8 encoding. -- withUTFStringLen :: String -> (CStringLen -> IO a) -> IO a-withUTFStringLen hsStr = withCStringLen (toUTF hsStr)+withUTFStringLen hsStr = withCAStringLen (toUTF hsStr) --- Define newUTFString to emit UTF-8.+-- | Like 'newCString' but using the UTF-8 encoding. -- newUTFString :: String -> IO CString-newUTFString = newCString . toUTF+newUTFString = newCAString . toUTF --- Define newUTFStringLen to emit UTF-8.+-- | Like  Define newUTFStringLen to emit UTF-8. -- newUTFStringLen :: String -> IO CStringLen-newUTFStringLen = newCStringLen . toUTF+newUTFStringLen = newCAStringLen . toUTF --- Define peekUTFString to retrieve UTF-8.+-- | Like 'peekCString' but using the UTF-8 encoding. -- peekUTFString :: CString -> IO String-peekUTFString strPtr = liftM fromUTF $ peekCString strPtr+peekUTFString strPtr = liftM fromUTF $ peekCAString strPtr --- Define maybePeekUTFString to retrieve UTF-8 from a ptr which is maybe null.+-- | Like 'maybePeek' 'peekCString' but using the UTF-8 encoding to retrieve+-- UTF-8 from a 'CString' which may be the 'nullPtr'. -- maybePeekUTFString :: CString -> IO (Maybe String)-maybePeekUTFString strPtr = liftM (maybe Nothing (Just . fromUTF)) $ maybePeek peekCString strPtr+maybePeekUTFString strPtr = liftM (maybe Nothing (Just . fromUTF)) $ maybePeek peekCAString strPtr --- Define peekUTFStringLen to retrieve UTF-8.+-- | Like 'peekCStringLen' but using the UTF-8 encoding. -- peekUTFStringLen :: CStringLen -> IO String-peekUTFStringLen strPtr = liftM fromUTF $ peekCStringLen strPtr+peekUTFStringLen strPtr = liftM fromUTF $ peekCAStringLen strPtr --- like peekUTFString but then frees the string using g_free+-- | Like like 'peekUTFString' but then frees the string using g_free -- readUTFString :: CString -> IO String readUTFString strPtr = do@@ -95,18 +96,18 @@   g_free strPtr   return str --- like peekCString but then frees the string using g_free+-- | Like 'peekCString' but then frees the string using @g_free@. -- readCString :: CString -> IO String readCString strPtr = do-  str <- peekCString strPtr+  str <- peekCAString strPtr   g_free strPtr   return str  foreign import ccall unsafe "g_free"   g_free :: Ptr a -> IO () --- Temporarily allocate a list of UTF-8 Strings.+-- | Temporarily allocate a list of UTF-8 'CString's. -- withUTFStrings :: [String] -> ([CString] -> IO a) -> IO a withUTFStrings hsStrs = withUTFStrings' hsStrs []@@ -115,40 +116,41 @@         withUTFStrings' (s:ss) cs body = withUTFString s $ \c ->                                          withUTFStrings' ss (c:cs) body --- Temporarily allocate an array of UTF-8 Strings.+-- | Temporarily allocate an array of UTF-8 encoded 'CString's. -- withUTFStringArray :: [String] -> (Ptr CString -> IO a) -> IO a withUTFStringArray hsStr body =   withUTFStrings hsStr $ \cStrs -> do   withArray cStrs body --- Temporarily allocate a null-terminated array of UTF-8 Strings.+-- | Temporarily allocate a null-terminated array of UTF-8 encoded 'CString's. -- withUTFStringArray0 :: [String] -> (Ptr CString -> IO a) -> IO a withUTFStringArray0 hsStr body =   withUTFStrings hsStr $ \cStrs -> do   withArray0 nullPtr cStrs body --- Convert an array of UTF-8 strings of the given length to a list of Haskell--- strings.+-- | Convert an array (of the given length) of UTF-8 encoded 'CString's to a+--   list of Haskell 'String's. -- peekUTFStringArray :: Int -> Ptr CString -> IO [String] peekUTFStringArray len cStrArr = do   cStrs <- peekArray len cStrArr   mapM peekUTFString cStrs --- Convert a null-terminated array of UTF-8 strings to a list of Haskell--- strings.+-- | Convert a null-terminated array of UTF-8 encoded 'CString's to a list of+--   Haskell 'String's. -- peekUTFStringArray0 :: Ptr CString -> IO [String] peekUTFStringArray0 cStrArr = do   cStrs <- peekArray0 nullPtr cStrArr   mapM peekUTFString cStrs --- Like 'peekUTFStringArray0' but then free the string array including all strings.+-- | Like 'peekUTFStringArray0' but then free the string array including all+-- strings. -- -- To be used when functions indicate that their return value should be freed--- with \"g_strfreev\".+-- with @g_strfreev@. -- readUTFStringArray0 :: Ptr CString -> IO [String] readUTFStringArray0 cStrArr | cStrArr == nullPtr = return []@@ -161,8 +163,10 @@ foreign import ccall unsafe "g_strfreev"   g_strfreev :: Ptr a -> IO () --- Convert Unicode characters to UTF-8.+-- | Encode a Haskell Unicode String as UTF-8 --+-- You should think of this as it it had type @String -> [Word8]@+-- toUTF :: String -> String toUTF [] = [] toUTF (x:xs) | ord x<=0x007F = x:toUTF xs@@ -174,8 +178,10 @@ 			       chr (0x80 .|. (ord x .&. 0x3F)): 			       toUTF xs --- Convert UTF-8 to Unicode.+-- | Decode a UTF-8 string into a Haskell Unicode String. --+-- You should think of this as it it had type @[Word8] -> String@+-- fromUTF :: String -> String fromUTF [] = [] fromUTF (all@(x:xs)) | ord x<=0x7F = x:fromUTF xs@@ -195,11 +201,12 @@          err = error "fromUTF: illegal UTF-8 character" --- Offset correction for String to UTF8 mapping.+-- | Offset correction for String to UTF8 mapping. -- newtype UTFCorrection = UTFCorrection [Int] deriving Show --- Create a list of offset corrections.+-- | Create a list of offset corrections.+-- genUTFOfs :: String -> UTFCorrection genUTFOfs str = UTFCorrection (gUO 0 str)   where
System/Glib/hsgclosure.c view
@@ -85,7 +85,7 @@ #endif     guint i;     -    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: about to run callback=%p, n_param_values=%d", hc->callback, n_param_values));+    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to run callback, n_param_values=%d", hc->callback, n_param_values)); #ifdef GHC_RTS_USES_CAPABILITY     cap = rts_lock(); #else@@ -96,29 +96,34 @@         /* construct the function call */     for (i = 0; i < n_param_values; i++) {-        WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: param_values[%d]=%s :: %s",+        WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): param_values[%d]=%s :: %s",+	                   hc->callback,                            i,                            g_strdup_value_contents(&param_values[i]),                            g_type_name(G_VALUE_TYPE(&param_values[i]))));         call = rts_apply(CAP call, gtk2hs_value_as_haskellobj(CAP &param_values[i]));     }     -    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: about to rts_evalIO"));+    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to rts_evalIO", hc->callback));          /* perform the call */     cap=rts_evalIO(CAP rts_apply(CAP (HaskellObj)runIO_closure, call),&ret);     -    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: about to rts_checkSchedStatus"));+    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to rts_checkSchedStatus", hc->callback));          /* barf if anything went wrong */     /* TODO: pass a sensible value for call site so we get better error messages */     /* or perhaps we can propogate any error? */     rts_checkSchedStatus("gtk2hs_closure_marshal", cap);+    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): ret=%p", hc->callback, ret));          if (return_value) {-        WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: return_value :: %s",+        WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): return_value :: %s, ret=%p, UNTAG_CLOSURE(ret)=%p",+	                   hc->callback, /*                           g_strdup_value_contents(return_value), */-                           g_type_name(G_VALUE_TYPE(return_value))));+                           g_type_name(G_VALUE_TYPE(return_value)),+			   ret,+			   UNTAG_CLOSURE(ret)));         gtk2hs_value_from_haskellobj(return_value, ret);     }     @@ -127,7 +132,7 @@ #else     rts_unlock(); #endif-    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal: done running callback"));+    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): done running callback", hc->callback)); }  GClosure *
glib.cabal view
@@ -1,14 +1,14 @@ Name:           glib-Version:        0.12.0+Version:        0.12.1 License:        LGPL-2.1 License-file:   COPYING Copyright:      (c) 2001-2010 The Gtk2Hs Team Author:         Axel Simon, Duncan Coutts-Maintainer:     gtk2hs-users@sourceforge.net+Maintainer:     gtk2hs-users@lists.sourceforge.net Build-Type:     Custom-Cabal-Version:  >= 1.6.0+Cabal-Version:  >= 1.8 Stability:      stable-homepage:       http://www.haskell.org/gtk2hs/+homepage:       http://projects.haskell.org/gtk2hs/ bug-reports:    http://hackage.haskell.org/trac/gtk2hs/ Synopsis:       Binding to the GLIB library for Gtk2Hs. Description:    The GNU Library is a collection of C data structures and utility@@ -16,9 +16,9 @@                 much functionality as required to support the packages that                 wrap libraries that are themselves based on GLib. Category:       System-Tested-With:    GHC == 6.10.4+Tested-With:    GHC == 6.10.4, GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.1 Extra-Source-Files:-                Gtk2HsSetup.hs+                SetupWrapper.hs SetupMain.hs Gtk2HsSetup.hs                 System/Glib/hsgclosure.c                 System/Glib/hsgclosure.h @@ -33,9 +33,8 @@  Library         build-depends:  base >= 4 && < 5,-                        containers, haskell98-        build-tools:    gtk2hsC2hs-        cpp-options:     -DHAVE_NEW_CONTROL_EXCEPTION+                        containers+        build-tools:    gtk2hsC2hs >= 0.13.5         if flag(closure_signals)           cpp-options:  -DUSE_GCLOSURE_SIGNALS_IMPL           c-sources: System/Glib/hsgclosure.c@@ -57,6 +56,7 @@                           System.Glib.UTFString                           System.Glib.Types                           System.Glib.GList+                          System.Glib.GString                           System.Glib.GType                           System.Glib.GTypeConstants                           System.Glib.GValue