glib 0.12.5.4 → 0.13.0.0
raw patch · 13 files changed
+357/−128 lines, 13 filesdep +bytestringdep +text
Dependencies added: bytestring, text
Files
- Gtk2HsSetup.hs +56/−19
- SetupWrapper.hs +3/−3
- System/Glib/GDateTime.chs +8/−5
- System/Glib/GError.chs +5/−3
- System/Glib/GObject.chs +8/−7
- System/Glib/GString.chs +14/−2
- System/Glib/GValueTypes.chs +34/−4
- System/Glib/Properties.chs +60/−13
- System/Glib/StoreValue.hsc +2/−1
- System/Glib/UTFString.hs +153/−60
- System/Glib/Utils.chs +4/−4
- System/Glib/hsgclosure.c +3/−3
- glib.cabal +7/−4
Gtk2HsSetup.hs view
@@ -6,9 +6,9 @@ -- | Build a Gtk2hs package. ---module Gtk2HsSetup ( - gtk2hsUserHooks, - getPkgConfigPackages, +module Gtk2HsSetup (+ gtk2hsUserHooks,+ getPkgConfigPackages, checkGtk2hsBuildtools, typeGenProgram, signalGenProgram,@@ -56,7 +56,8 @@ import Distribution.Verbosity import Control.Monad (when, unless, filterM, liftM, forM, forM_) import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList, catMaybes )-import Data.List (isPrefixOf, isSuffixOf, stripPrefix, nub, tails )+import Data.List (isPrefixOf, isSuffixOf, nub, minimumBy, stripPrefix, tails )+import Data.Ord as Ord (comparing) import Data.Char (isAlpha, isNumber) import qualified Data.Map as M import qualified Data.Set as S@@ -113,9 +114,16 @@ fixLibs :: [FilePath] -> [String] -> [String] fixLibs dlls = concatMap $ \ lib -> case filter (isLib lib) dlls of- dll:_ -> [dropExtension dll]- _ -> if lib == "z" then [] else [lib]+ dlls@(_:_) -> [dropExtension (pickDll dlls)]+ _ -> if lib == "z" then [] else [lib] where+ -- If there are several .dll files matching the one we're after then we+ -- just have to guess. For example for recent Windows cairo builds we get+ -- libcairo-2.dll libcairo-gobject-2.dll libcairo-script-interpreter-2.dll+ -- Our heuristic is to pick the one with the shortest name.+ -- Yes this is a hack but the proper solution is hard: we would need to+ -- parse the .a file and see which .dll file(s) it needed to link to.+ pickDll = minimumBy (Ord.comparing length) isLib lib dll = case stripPrefix ("lib"++lib) dll of Just ('.':_) -> True@@ -154,9 +162,9 @@ register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO ()-register pkg@(library -> Just lib )- lbi@(libraryConfig -> Just clbi) regFlags+register pkg@PackageDescription { library = Just lib } lbi regFlags = do+ let clbi = LBI.getComponentLocalBuildInfo lbi LBI.CLibName installedPkgInfoRaw <- generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref@@ -168,7 +176,7 @@ -- Three different modes: case () of- _ | modeGenerateRegFile -> die "Generate Reg File not supported"+ _ | modeGenerateRegFile -> writeRegistrationFile installedPkgInfo | modeGenerateRegScript -> die "Generate Reg Script not supported" | otherwise -> registerPackage verbosity installedPkgInfo pkg lbi inplace@@ -180,6 +188,8 @@ where modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))+ regFile = fromMaybe (display (packageId pkg) <.> "conf")+ (fromFlag (regGenPkgConf regFlags)) modeGenerateRegScript = fromFlag (regGenScript regFlags) inplace = fromFlag (regInPlace regFlags) packageDbs = nub $ withPackageDB lbi@@ -188,6 +198,10 @@ distPref = fromFlag (regDistPref regFlags) verbosity = fromFlag (regVerbosity regFlags) + writeRegistrationFile installedPkgInfo = do+ notice verbosity ("Creating package registration file: " ++ regFile)+ writeUTF8File regFile (showInstalledPackageInfo installedPkgInfo)+ register _ _ regFlags = notice verbosity "No package to register" where verbosity = fromFlag (regVerbosity regFlags)@@ -275,11 +289,11 @@ -- a modules that does not have a .chi file mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi] . toFilePath) (PD.libModules lib)- + let files = [ f | Just f <- mFiles ] installOrdinaryFiles verbosity libPref files - + installCHI _ _ _ _ = return () ------------------------------------------------------------------------------@@ -305,13 +319,12 @@ genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () genSynthezisedFiles verb pd lbi = do- cPkgs <- getPkgConfigPackages verb lbi pd let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd) ++customFieldsPD pd typeOpts :: String -> [ProgArg]- typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field++'=':val) (words content)+ typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field ++ '=':val) (words content) | (field,content) <- xList, tag `isPrefixOf` field, field /= (tag++"file")]@@ -319,8 +332,9 @@ | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs , let name' = filter isAlpha (display name) , tag <- name'- : [ name' ++ "-" ++ show major ++ "." ++ show digit- | digit <- [0,2..minor] ]+ :[ name' ++ "-" ++ show maj ++ "." ++ show d2+ | (maj, d2) <- [(maj, d2) | maj <- [0..(major-1)], d2 <- [0,2..20]]+ ++ [(major, d2) | d2 <- [0,2..minor]] ] ] signalsOpts :: [ProgArg]@@ -346,6 +360,29 @@ info verb ("Ensuring that callback hooks in "++f++" are up-to-date.") genFile signalGenProgram signalsOpts f + writeFile "gtk2hs_macros.h" $ generateMacros cPkgs++-- Based on Cabal/Distribution/Simple/Build/Macros.hs+generateMacros :: [PackageId] -> String+generateMacros cPkgs = concat $+ "/* DO NOT EDIT: This file is automatically generated by Gtk2HsSetup.hs */\n\n" :+ [ concat+ ["/* package ",display pkgid," */\n"+ ,"#define VERSION_",pkgname," ",show (display version),"\n"+ ,"#define MIN_VERSION_",pkgname,"(major1,major2,minor) (\\\n"+ ," (major1) < ",major1," || \\\n"+ ," (major1) == ",major1," && (major2) < ",major2," || \\\n"+ ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"+ ,"\n\n"+ ]+ | pkgid@(PackageIdentifier name version) <- cPkgs+ , let (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)+ pkgname = map fixchar (display name)+ ]+ where fixchar '-' = '_'+ fixchar '.' = '_'+ fixchar c = c+ --FIXME: Cabal should tell us the selected pkg-config package versions in the -- LocalBuildInfo or equivalent. -- In the mean time, ask pkg-config again.@@ -416,14 +453,14 @@ -- Extract the dependencies of this file. This is intentionally rather naive as it -- ignores CPP conditionals. We just require everything which means that the--- existance of a .chs module may not depend on some CPP condition. +-- existance of a .chs module may not depend on some CPP condition. extractDeps :: ModDep -> IO ModDep extractDeps md@ModDep { mdLocation = Nothing } = return md extractDeps md@ModDep { mdLocation = Just f } = withUTF8FileContents f $ \con -> do let findImports acc (('{':'#':xs):xxs) = case (dropWhile (' ' ==) xs) of ('i':'m':'p':'o':'r':'t':' ':ys) -> case simpleParse (takeWhile ('#' /=) ys) of- Just m -> findImports (m:acc) xxs + Just m -> findImports (m:acc) xxs Nothing -> die ("cannot parse chs import in "++f++":\n"++ "offending line is {#"++xs) -- no more imports after the first non-import hook@@ -457,8 +494,8 @@ return (programName prog, location) ) programs let printError name = do- putStrLn $ "Cannot find " ++ name ++ "\n" + putStrLn $ "Cannot find " ++ name ++ "\n" ++ "Please install `gtk2hs-buildtools` first and check that the install directory is in your PATH (e.g. HOME/.cabal/bin)." exitFailure forM_ programInfos $ \ (name, location) ->- when (isNothing location) (printError name) + when (isNothing location) (printError name)
SetupWrapper.hs view
@@ -9,7 +9,7 @@ import Distribution.Simple.Program import Distribution.Simple.Compiler import Distribution.Simple.BuildPaths (exeExtension)-import Distribution.Simple.Configure (configCompiler)+import Distribution.Simple.Configure (configCompilerEx) import Distribution.Simple.GHC (getInstalledPackages) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Version@@ -115,9 +115,9 @@ when outOfDate $ do debug verbosity "Setup script is out of date, compiling..." - (comp, conf) <- configCompiler (Just GHC) Nothing Nothing+ (comp, _, conf) <- configCompilerEx (Just GHC) Nothing Nothing defaultProgramConfiguration verbosity- cabalLibVersion <- cabalLibVersionToUse comp conf+ cabalLibVersion <- cabalLibVersionToUse comp conf let cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion debug verbosity $ "Using Cabal library version " ++ display cabalLibVersion
System/Glib/GDateTime.chs view
@@ -6,7 +6,7 @@ -- -- Created: July 2007 ----- Copyright (C) 2007 Peter Gavin +-- Copyright (C) 2007 Peter Gavin -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public@@ -104,7 +104,8 @@ peek ptr #if GLIB_CHECK_VERSION(2,12,0)-gTimeValFromISO8601 :: String+gTimeValFromISO8601 :: GlibString string+ => string -> Maybe GTimeVal gTimeValFromISO8601 isoDate = unsafePerformIO $ withUTFString isoDate $ \cISODate ->@@ -114,8 +115,9 @@ then liftM Just $ peek ptr else return Nothing -gTimeValToISO8601 :: GTimeVal- -> String+gTimeValToISO8601 :: GlibString string+ => GTimeVal+ -> string gTimeValToISO8601 time = unsafePerformIO $ with time $ \ptr -> {# call g_time_val_to_iso8601 #} (castPtr ptr) >>= readUTFString@@ -234,7 +236,8 @@ peek ptr #endif -gDateParse :: String+gDateParse :: GlibString string+ => string -> IO (Maybe GDate) gDateParse str = alloca $ \ptr ->
System/Glib/GError.chs view
@@ -92,6 +92,8 @@ import System.Glib.UTFString import Control.Exception import Data.Typeable+import Data.Text (Text)+import qualified Data.Text as T (unpack) import Prelude hiding (catch) -- | A GError consists of a domain, code and a human readable message.@@ -99,7 +101,7 @@ deriving Typeable instance Show GError where- show (GError _ _ msg) = msg+ show (GError _ _ msg) = T.unpack msg instance Exception GError @@ -121,7 +123,7 @@ type GErrorCode = Int -- | A human readable error message.-type GErrorMessage = String+type GErrorMessage = Text instance Storable GError where sizeOf _ = {#sizeof GError #}@@ -265,4 +267,4 @@ -- | Catch all GError exceptions and convert them into a general failure. failOnGError :: IO a -> IO a-failOnGError action = catchGError action (\(GError dom code msg) -> fail msg)+failOnGError action = catchGError action (\(GError dom code msg) -> fail (T.unpack msg))
System/Glib/GObject.chs view
@@ -41,7 +41,7 @@ makeNewGObject, constructNewGObject, wrapNewGObject,- + -- ** GType queries gTypeGObject, isA,@@ -61,6 +61,7 @@ import Control.Monad (liftM, when) import Data.IORef (newIORef, readIORef, writeIORef)+import qualified Data.Text as T (pack) import System.Glib.FFI import System.Glib.UTFString@@ -133,7 +134,7 @@ -- versions >= 2.10). On non-floating objects, this function behaves -- exactly the same as "makeNewGObject". ---constructNewGObject :: GObjectClass obj => +constructNewGObject :: GObjectClass obj => (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj constructNewGObject (constr, objectUnref) generator = do objPtr <- generator@@ -150,7 +151,7 @@ -- reference). Since newly created 'GObject's have a reference count of -- one, they don't need ref'ing. ---wrapNewGObject :: GObjectClass obj => +wrapNewGObject :: GObjectClass obj => (ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj wrapNewGObject (constr, objectUnref) generator = do objPtr <- generator@@ -172,7 +173,7 @@ uniqueCnt = unsafePerformIO $ newMVar 0 -- | Create a unique id based on the given string.-quarkFromString :: String -> IO Quark+quarkFromString :: GlibString string => string -> IO Quark quarkFromString name = withUTFString name {#call unsafe quark_from_string#} -- | Add an attribute to this object.@@ -185,9 +186,9 @@ objectCreateAttribute = do cnt <- modifyMVar uniqueCnt (\cnt -> return (cnt+1, cnt)) let propName = "Gtk2HsAttr"++show cnt- attr <- quarkFromString propName+ attr <- quarkFromString $ T.pack propName return (newNamedAttr propName (objectGetAttributeUnsafe attr)- (objectSetAttribute attr)) + (objectSetAttribute attr)) -- | The address of a function freeing a 'StablePtr'. See 'destroyFunPtr'. foreign import ccall unsafe "&hs_free_stable_ptr" destroyStablePtr :: DestroyNotify@@ -217,7 +218,7 @@ -- | Determine if this is an instance of a particular GTK type -- isA :: GObjectClass o => o -> GType -> Bool-isA obj gType = +isA obj gType = typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr.unGObject.toGObject) obj) gType -- at this point we would normally implement the notify signal handler;
System/Glib/GString.chs view
@@ -27,12 +27,14 @@ module System.Glib.GString ( GString, readGString,+ readGStringByteString, fromGString, ) where import Foreign-import Control.Exception (bracket)-import Control.Monad (foldM)+import Control.Exception (bracket)+import Control.Monad (foldM)+import Data.ByteString (ByteString, packCStringLen) import System.Glib.FFI @@ -51,6 +53,16 @@ gstr <- {#get GString->str#} gstring len <- {#get GString->len#} gstring fmap Just $ peekCStringLen (gstr, fromIntegral len)++-- Turn a GString into a ByteString but don't destroy it.+--+readGStringByteString :: GString -> IO (Maybe ByteString)+readGStringByteString gstring+ | gstring == nullPtr = return Nothing+ | otherwise = do+ gstr <- {#get GString->str#} gstring+ len <- {#get GString->len#} gstring+ fmap Just $ packCStringLen (gstr, fromIntegral len) -- Turn a GList into a list of pointers (freeing the GList in the process). --
System/Glib/GValueTypes.chs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) GValueTypes --@@ -51,6 +52,10 @@ valueGetString, valueSetMaybeString, valueGetMaybeString,+ valueSetFilePath,+ valueGetFilePath,+ valueSetMaybeFilePath,+ valueGetMaybeFilePath, valueSetBoxed, valueGetBoxed, valueSetGObject,@@ -160,19 +165,19 @@ liftM (toFlags . fromIntegral) $ {# call unsafe value_get_flags #} gvalue -valueSetString :: GValue -> String -> IO ()+valueSetString :: GlibString string => GValue -> string -> IO () valueSetString gvalue str = withUTFString str $ \strPtr -> {# call unsafe value_set_string #} gvalue strPtr -valueGetString :: GValue -> IO String+valueGetString :: GlibString string => GValue -> IO string valueGetString gvalue = do strPtr <- {# call unsafe value_get_string #} gvalue if strPtr == nullPtr then return "" else peekUTFString strPtr -valueSetMaybeString :: GValue -> Maybe String -> IO ()+valueSetMaybeString :: GlibString string => GValue -> Maybe string -> IO () valueSetMaybeString gvalue (Just str) = withUTFString str $ \strPtr -> {# call unsafe value_set_string #} gvalue strPtr@@ -180,10 +185,35 @@ valueSetMaybeString gvalue Nothing = {# call unsafe value_set_static_string #} gvalue nullPtr -valueGetMaybeString :: GValue -> IO (Maybe String)+valueGetMaybeString :: GlibString string => GValue -> IO (Maybe string) valueGetMaybeString gvalue = {# call unsafe value_get_string #} gvalue >>= maybePeek peekUTFString++valueSetFilePath :: GlibFilePath string => GValue -> string -> IO ()+valueSetFilePath gvalue str =+ withUTFFilePath str $ \strPtr ->+ {# call unsafe value_set_string #} gvalue strPtr++valueGetFilePath :: GlibFilePath string => GValue -> IO string+valueGetFilePath gvalue = do+ strPtr <- {# call unsafe value_get_string #} gvalue+ if strPtr == nullPtr+ then return ""+ else peekUTFFilePath strPtr++valueSetMaybeFilePath :: GlibFilePath string => GValue -> Maybe string -> IO ()+valueSetMaybeFilePath gvalue (Just str) =+ withUTFFilePath str $ \strPtr ->+ {# call unsafe value_set_string #} gvalue strPtr++valueSetMaybeFilePath gvalue Nothing =+ {# call unsafe value_set_static_string #} gvalue nullPtr++valueGetMaybeFilePath :: GlibFilePath string => GValue -> IO (Maybe string)+valueGetMaybeFilePath gvalue =+ {# call unsafe value_get_string #} gvalue+ >>= maybePeek peekUTFFilePath valueSetBoxed :: (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> GValue -> boxed -> IO () valueSetBoxed with gvalue boxed =
System/Glib/Properties.chs view
@@ -49,7 +49,11 @@ objectSetPropertyString, objectGetPropertyString, objectSetPropertyMaybeString,- objectGetPropertyMaybeString, + objectGetPropertyMaybeString,+ objectSetPropertyFilePath,+ objectGetPropertyFilePath,+ objectSetPropertyMaybeFilePath,+ objectGetPropertyMaybeFilePath, objectSetPropertyBoxedOpaque, objectGetPropertyBoxedOpaque, objectSetPropertyBoxedStorable,@@ -77,6 +81,12 @@ newAttrFromMaybeStringProperty, readAttrFromMaybeStringProperty, writeAttrFromMaybeStringProperty,+ newAttrFromFilePathProperty,+ readAttrFromFilePathProperty,+ writeAttrFromFilePathProperty,+ newAttrFromMaybeFilePathProperty,+ readAttrFromMaybeFilePathProperty,+ writeAttrFromMaybeFilePathProperty, newAttrFromBoxedOpaqueProperty, readAttrFromBoxedOpaqueProperty, writeAttrFromBoxedOpaqueProperty,@@ -87,7 +97,7 @@ newAttrFromMaybeObjectProperty, writeAttrFromMaybeObjectProperty, readAttrFromMaybeObjectProperty,- + -- TODO: do not export these once we dump the old TreeList API: objectGetPropertyInternal, objectSetPropertyInternal,@@ -96,6 +106,7 @@ import Control.Monad (liftM) import System.Glib.FFI+import System.Glib.UTFString import System.Glib.Flags (Flags) {#import System.Glib.Types#} {#import System.Glib.GValue#} (GValue(GValue), valueInit, allocaGValue)@@ -189,18 +200,30 @@ objectGetPropertyDouble :: GObjectClass gobj => String -> gobj -> IO Double objectGetPropertyDouble = objectGetPropertyInternal GType.double valueGetDouble -objectSetPropertyString :: GObjectClass gobj => String -> gobj -> String -> IO ()+objectSetPropertyString :: (GObjectClass gobj, GlibString string) => String -> gobj -> string -> IO () objectSetPropertyString = objectSetPropertyInternal GType.string valueSetString -objectGetPropertyString :: GObjectClass gobj => String -> gobj -> IO String+objectGetPropertyString :: (GObjectClass gobj, GlibString string) => String -> gobj -> IO string objectGetPropertyString = objectGetPropertyInternal GType.string valueGetString -objectSetPropertyMaybeString :: GObjectClass gobj => String -> gobj -> Maybe String -> IO ()+objectSetPropertyMaybeString :: (GObjectClass gobj, GlibString string) => String -> gobj -> Maybe string -> IO () objectSetPropertyMaybeString = objectSetPropertyInternal GType.string valueSetMaybeString -objectGetPropertyMaybeString :: GObjectClass gobj => String -> gobj -> IO (Maybe String)+objectGetPropertyMaybeString :: (GObjectClass gobj, GlibString string) => String -> gobj -> IO (Maybe string) objectGetPropertyMaybeString = objectGetPropertyInternal GType.string valueGetMaybeString +objectSetPropertyFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> string -> IO ()+objectSetPropertyFilePath = objectSetPropertyInternal GType.string valueSetFilePath++objectGetPropertyFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> IO string+objectGetPropertyFilePath = objectGetPropertyInternal GType.string valueGetFilePath++objectSetPropertyMaybeFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> Maybe string -> IO ()+objectSetPropertyMaybeFilePath = objectSetPropertyInternal GType.string valueSetMaybeFilePath++objectGetPropertyMaybeFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> IO (Maybe string)+objectGetPropertyMaybeFilePath = objectGetPropertyInternal GType.string valueGetMaybeFilePath+ objectSetPropertyBoxedOpaque :: GObjectClass gobj => (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> GType -> String -> gobj -> boxed -> IO () objectSetPropertyBoxedOpaque with gtype = objectSetPropertyInternal gtype (valueSetBoxed with) @@ -282,30 +305,54 @@ newAttrFromFlagsProperty propName gtype = newNamedAttr propName (objectGetPropertyFlags gtype propName) (objectSetPropertyFlags gtype propName) -newAttrFromStringProperty :: GObjectClass gobj => String -> Attr gobj String+newAttrFromStringProperty :: (GObjectClass gobj, GlibString string) => String -> Attr gobj string newAttrFromStringProperty propName = newNamedAttr propName (objectGetPropertyString propName) (objectSetPropertyString propName) -readAttrFromStringProperty :: GObjectClass gobj => String -> ReadAttr gobj String+readAttrFromStringProperty :: (GObjectClass gobj, GlibString string) => String -> ReadAttr gobj string readAttrFromStringProperty propName = readNamedAttr propName (objectGetPropertyString propName) -writeAttrFromStringProperty :: GObjectClass gobj => String -> WriteAttr gobj String+writeAttrFromStringProperty :: (GObjectClass gobj, GlibString string) => String -> WriteAttr gobj string writeAttrFromStringProperty propName = writeNamedAttr propName (objectSetPropertyString propName) -newAttrFromMaybeStringProperty :: GObjectClass gobj => String -> Attr gobj (Maybe String)+newAttrFromMaybeStringProperty :: (GObjectClass gobj, GlibString string) => String -> Attr gobj (Maybe string) newAttrFromMaybeStringProperty propName = newNamedAttr propName (objectGetPropertyMaybeString propName) (objectSetPropertyMaybeString propName) -readAttrFromMaybeStringProperty :: GObjectClass gobj => String -> ReadAttr gobj (Maybe String)+readAttrFromMaybeStringProperty :: (GObjectClass gobj, GlibString string) => String -> ReadAttr gobj (Maybe string) readAttrFromMaybeStringProperty propName = readNamedAttr propName (objectGetPropertyMaybeString propName) -writeAttrFromMaybeStringProperty :: GObjectClass gobj => String -> WriteAttr gobj (Maybe String)+writeAttrFromMaybeStringProperty :: (GObjectClass gobj, GlibString string) => String -> WriteAttr gobj (Maybe string) writeAttrFromMaybeStringProperty propName = writeNamedAttr propName (objectSetPropertyMaybeString propName) +newAttrFromFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> Attr gobj string+newAttrFromFilePathProperty propName =+ newNamedAttr propName (objectGetPropertyFilePath propName) (objectSetPropertyFilePath propName)++readAttrFromFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> ReadAttr gobj string+readAttrFromFilePathProperty propName =+ readNamedAttr propName (objectGetPropertyFilePath propName)++writeAttrFromFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> WriteAttr gobj string+writeAttrFromFilePathProperty propName =+ writeNamedAttr propName (objectSetPropertyFilePath propName)++newAttrFromMaybeFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> Attr gobj (Maybe string)+newAttrFromMaybeFilePathProperty propName =+ newNamedAttr propName (objectGetPropertyMaybeFilePath propName) (objectSetPropertyMaybeFilePath propName)++readAttrFromMaybeFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> ReadAttr gobj (Maybe string)+readAttrFromMaybeFilePathProperty propName =+ readNamedAttr propName (objectGetPropertyMaybeFilePath propName)++writeAttrFromMaybeFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> WriteAttr gobj (Maybe string)+writeAttrFromMaybeFilePathProperty propName =+ writeNamedAttr propName (objectSetPropertyMaybeFilePath propName)+ newAttrFromBoxedOpaqueProperty :: GObjectClass gobj => (Ptr boxed -> IO boxed) -> (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> String -> GType -> Attr gobj boxed newAttrFromBoxedOpaqueProperty peek with propName gtype = newNamedAttr propName (objectGetPropertyBoxedOpaque peek gtype propName) (objectSetPropertyBoxedOpaque with gtype propName)@@ -337,7 +384,7 @@ newAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') => String -> GType -> ReadWriteAttr gobj (Maybe gobj') (Maybe gobj'') newAttrFromMaybeObjectProperty propName gtype = newNamedAttr propName (objectGetPropertyMaybeGObject gtype propName) (objectSetPropertyMaybeGObject gtype propName)- + writeAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> WriteAttr gobj (Maybe gobj') writeAttrFromMaybeObjectProperty propName gtype = writeNamedAttr propName (objectSetPropertyMaybeGObject gtype propName)
System/Glib/StoreValue.hsc view
@@ -33,6 +33,7 @@ ) where import Control.Monad (liftM)+import Data.Text (Text) import Control.Exception (throw, AssertionFailed(..)) @@ -58,7 +59,7 @@ -- | GVpointer (Ptr ()) | GVfloat Float | GVdouble Double- | GVstring (Maybe String)+ | GVstring (Maybe Text) | GVobject GObject -- | GVboxed (Ptr ())
System/Glib/UTFString.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} -- GIMP Toolkit (GTK) UTF aware string marshalling -- -- Author : Axel Simon@@ -25,13 +28,7 @@ -- module System.Glib.UTFString (- withUTFString,- withUTFStringLen,- newUTFString,- newUTFStringLen,- peekUTFString,- peekUTFStringLen,- maybePeekUTFString,+ GlibString(..), readUTFString, readCString, withUTFStrings,@@ -41,57 +38,124 @@ peekUTFStringArray0, readUTFStringArray0, UTFCorrection,- genUTFOfs, ofsToUTF,- ofsFromUTF+ ofsFromUTF,++ glibToString,+ stringToGlib,++ DefaultGlibString,++ GlibFilePath(..),+ withUTFFilePaths,+ withUTFFilePathArray,+ withUTFFilePathArray0,+ peekUTFFilePathArray0,+ readUTFFilePathArray0 ) where import Codec.Binary.UTF8.String+import Control.Applicative ((<$>)) import Control.Monad (liftM) import Data.Char (ord, chr) import Data.Maybe (maybe)-+import Data.String (IsString)+import Data.Monoid (Monoid) import System.Glib.FFI+import qualified Data.Text as T (replace, length, pack, unpack, Text)+import qualified Data.Text.Foreign as T+ (withCStringLen, peekCStringLen)+import Data.ByteString (useAsCString)+import Data.Text.Encoding (encodeUtf8) --- | Like 'withCString' but using the UTF-8 encoding.----withUTFString :: String -> (CString -> IO a) -> IO a-withUTFString = withCAString . encodeString+class (IsString s, Monoid s, Show s) => GlibString s where+ -- | Like 'withCString' but using the UTF-8 encoding.+ --+ withUTFString :: s -> (CString -> IO a) -> IO a --- | Like 'withCStringLen' but using the UTF-8 encoding.----withUTFStringLen :: String -> (CStringLen -> IO a) -> IO a-withUTFStringLen = withCAStringLen . encodeString+ -- | Like 'withCStringLen' but using the UTF-8 encoding.+ --+ withUTFStringLen :: s -> (CStringLen -> IO a) -> IO a --- | Like 'newCString' but using the UTF-8 encoding.----newUTFString :: String -> IO CString-newUTFString = newCAString . encodeString+ -- | Like 'peekCString' but using the UTF-8 encoding.+ --+ peekUTFString :: CString -> IO s --- | Like Define newUTFStringLen to emit UTF-8.----newUTFStringLen :: String -> IO CStringLen-newUTFStringLen = newCAStringLen . encodeString+ -- | 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 s) --- | Like 'peekCString' but using the UTF-8 encoding.----peekUTFString :: CString -> IO String-peekUTFString = liftM decodeString . peekCAString+ -- | Like 'peekCStringLen' but using the UTF-8 encoding.+ --+ peekUTFStringLen :: CStringLen -> IO s --- | 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 = liftM (maybe Nothing (Just . decodeString)) . maybePeek peekCAString+ -- | Like 'newCString' but using the UTF-8 encoding.+ --+ newUTFString :: s -> IO CString --- | Like 'peekCStringLen' but using the UTF-8 encoding.----peekUTFStringLen :: CStringLen -> IO String-peekUTFStringLen = liftM decodeString . peekCAStringLen+ -- | Like Define newUTFStringLen to emit UTF-8.+ --+ newUTFStringLen :: s -> IO CStringLen + -- | Create a list of offset corrections.+ --+ genUTFOfs :: s -> UTFCorrection++ -- | Length of the string in characters+ --+ stringLength :: s -> Int++ -- Escape percent signs (used in MessageDialog)+ unPrintf :: s -> s++instance GlibString [Char] where+ withUTFString = withCAString . encodeString+ withUTFStringLen = withCAStringLen . encodeString+ peekUTFString = liftM decodeString . peekCAString+ maybePeekUTFString = liftM (maybe Nothing (Just . decodeString)) . maybePeek peekCAString+ peekUTFStringLen = liftM decodeString . peekCAStringLen+ newUTFString = newCAString . encodeString+ newUTFStringLen = newCAStringLen . encodeString+ genUTFOfs str = UTFCorrection (gUO 0 str)+ where+ gUO n [] = []+ gUO n (x:xs) | ord x<=0x007F = gUO (n+1) xs+ | ord x<=0x07FF = n:gUO (n+1) xs+ | ord x<=0xFFFF = n:n:gUO (n+1) xs+ | otherwise = n:n:n:gUO (n+1) xs+ stringLength = length+ unPrintf s = s >>= replace+ where+ replace '%' = "%%"+ replace c = return c++foreign import ccall unsafe "string.h strlen" c_strlen+ :: CString -> IO CSize++instance GlibString T.Text where+ withUTFString = useAsCString . encodeUtf8+ withUTFStringLen = T.withCStringLen+ peekUTFString s = do+ len <- c_strlen s+ T.peekCStringLen (s, fromIntegral len)+ maybePeekUTFString = maybePeek peekUTFString+ peekUTFStringLen = T.peekCStringLen+ newUTFString = newUTFString . T.unpack -- TODO optimize+ newUTFStringLen = newUTFStringLen . T.unpack -- TODO optimize+ genUTFOfs = genUTFOfs . T.unpack -- TODO optimize+ stringLength = T.length+ unPrintf = T.replace "%" "%%"++glibToString :: T.Text -> String+glibToString = T.unpack++stringToGlib :: String -> T.Text+stringToGlib = T.pack+ -- | Like like 'peekUTFString' but then frees the string using g_free ---readUTFString :: CString -> IO String+readUTFString :: GlibString s => CString -> IO s readUTFString strPtr = do str <- peekUTFString strPtr g_free strPtr@@ -110,23 +174,23 @@ -- | Temporarily allocate a list of UTF-8 'CString's. ---withUTFStrings :: [String] -> ([CString] -> IO a) -> IO a+withUTFStrings :: GlibString s => [s] -> ([CString] -> IO a) -> IO a withUTFStrings hsStrs = withUTFStrings' hsStrs []- where withUTFStrings' :: [String] -> [CString] -> ([CString] -> IO a) -> IO a+ where withUTFStrings' :: GlibString s => [s] -> [CString] -> ([CString] -> IO a) -> IO a withUTFStrings' [] cs body = body (reverse cs) withUTFStrings' (s:ss) cs body = withUTFString s $ \c -> withUTFStrings' ss (c:cs) body -- | Temporarily allocate an array of UTF-8 encoded 'CString's. ---withUTFStringArray :: [String] -> (Ptr CString -> IO a) -> IO a+withUTFStringArray :: GlibString s => [s] -> (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 encoded 'CString's. ---withUTFStringArray0 :: [String] -> (Ptr CString -> IO a) -> IO a+withUTFStringArray0 :: GlibString s => [s] -> (Ptr CString -> IO a) -> IO a withUTFStringArray0 hsStr body = withUTFStrings hsStr $ \cStrs -> do withArray0 nullPtr cStrs body@@ -134,7 +198,7 @@ -- | 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 :: GlibString s => Int -> Ptr CString -> IO [s] peekUTFStringArray len cStrArr = do cStrs <- peekArray len cStrArr mapM peekUTFString cStrs@@ -142,7 +206,7 @@ -- | Convert a null-terminated array of UTF-8 encoded 'CString's to a list of -- Haskell 'String's. ---peekUTFStringArray0 :: Ptr CString -> IO [String]+peekUTFStringArray0 :: GlibString s => Ptr CString -> IO [s] peekUTFStringArray0 cStrArr = do cStrs <- peekArray0 nullPtr cStrArr mapM peekUTFString cStrs@@ -153,7 +217,7 @@ -- To be used when functions indicate that their return value should be freed -- with @g_strfreev@. ---readUTFStringArray0 :: Ptr CString -> IO [String]+readUTFStringArray0 :: GlibString s => Ptr CString -> IO [s] readUTFStringArray0 cStrArr | cStrArr == nullPtr = return [] | otherwise = do cStrs <- peekArray0 nullPtr cStrArr@@ -168,27 +232,56 @@ -- newtype UTFCorrection = UTFCorrection [Int] deriving Show --- | Create a list of offset corrections.----genUTFOfs :: String -> UTFCorrection-genUTFOfs str = UTFCorrection (gUO 0 str)- where- gUO n [] = []- gUO n (x:xs) | ord x<=0x007F = gUO (n+1) xs- | ord x<=0x07FF = n:gUO (n+1) xs- | ord x<=0xFFFF = n:n:gUO (n+1) xs- | otherwise = n:n:n:gUO (n+1) xs- ofsToUTF :: Int -> UTFCorrection -> Int ofsToUTF n (UTFCorrection oc) = oTU oc where oTU [] = n oTU (x:xs) | n<=x = n- | otherwise = 1+oTU xs+ | otherwise = 1+oTU xs ofsFromUTF :: Int -> UTFCorrection -> Int ofsFromUTF n (UTFCorrection oc) = oFU n oc where oFU n [] = n oFU n (x:xs) | n<=x = n- | otherwise = oFU (n-1) xs + | otherwise = oFU (n-1) xs++type DefaultGlibString = T.Text++class fp ~ FilePath => GlibFilePath fp where+ withUTFFilePath :: fp -> (CString -> IO a) -> IO a+ peekUTFFilePath :: CString -> IO fp++instance GlibFilePath FilePath where+ withUTFFilePath = withUTFString . T.pack+ peekUTFFilePath f = T.unpack <$> peekUTFString f++withUTFFilePaths :: GlibFilePath fp => [fp] -> ([CString] -> IO a) -> IO a+withUTFFilePaths hsStrs = withUTFFilePath' hsStrs []+ where withUTFFilePath' :: GlibFilePath fp => [fp] -> [CString] -> ([CString] -> IO a) -> IO a+ withUTFFilePath' [] cs body = body (reverse cs)+ withUTFFilePath' (fp:fps) cs body = withUTFFilePath fp $ \c ->+ withUTFFilePath' fps (c:cs) body++withUTFFilePathArray :: GlibFilePath fp => [fp] -> (Ptr CString -> IO a) -> IO a+withUTFFilePathArray hsFP body =+ withUTFFilePaths hsFP $ \cStrs -> do+ withArray cStrs body++withUTFFilePathArray0 :: GlibFilePath fp => [fp] -> (Ptr CString -> IO a) -> IO a+withUTFFilePathArray0 hsFP body =+ withUTFFilePaths hsFP $ \cStrs -> do+ withArray0 nullPtr cStrs body++peekUTFFilePathArray0 :: GlibFilePath fp => Ptr CString -> IO [fp]+peekUTFFilePathArray0 cStrArr = do+ cStrs <- peekArray0 nullPtr cStrArr+ mapM peekUTFFilePath cStrs++readUTFFilePathArray0 :: GlibFilePath fp => Ptr CString -> IO [fp]+readUTFFilePathArray0 cStrArr | cStrArr == nullPtr = return []+ | otherwise = do+ cStrs <- peekArray0 nullPtr cStrArr+ fps <- mapM peekUTFFilePath cStrs+ g_strfreev cStrArr+ return fps
System/Glib/Utils.chs view
@@ -44,7 +44,7 @@ -- returns the result of 'getProgramName' (which may be 'Nothing' if -- 'setProgramName' has also not been performed). ---getApplicationName :: IO (Maybe String)+getApplicationName :: GlibString string => IO (Maybe string) getApplicationName = {#call unsafe get_application_name #} >>= maybePeek peekUTFString -- |@@ -60,7 +60,7 @@ -- The application name will be used in contexts such as error messages, or -- when displaying an application's name in the task list. ---setApplicationName :: String -> IO ()+setApplicationName :: GlibString string => string -> IO () setApplicationName = flip withUTFString {#call unsafe set_application_name #} -- |@@ -68,7 +68,7 @@ -- with 'getApplicationName'. If you are using GDK or GTK+, the program name -- is set in 'initGUI' to the last component of argv[0]. ---getProgramName :: IO (Maybe String)+getProgramName :: GlibString string => IO (Maybe string) getProgramName = {#call unsafe get_prgname #} >>= maybePeek peekUTFString -- |@@ -76,5 +76,5 @@ -- with 'setApplicationName'. Note that for thread-safety reasons this -- computation can only be performed once. ---setProgramName :: String -> IO ()+setProgramName :: GlibString string => string -> IO () setProgramName = flip withUTFString {#call unsafe set_prgname #}
System/Glib/hsgclosure.c view
@@ -172,7 +172,7 @@ else break; case G_TYPE_CHAR:- return rts_mkChar(CAP g_value_get_char(value));+ return rts_mkChar(CAP g_value_get_schar(value)); case G_TYPE_UCHAR: return rts_mkChar(CAP g_value_get_uchar(value)); case G_TYPE_BOOLEAN:@@ -229,10 +229,10 @@ } return; case G_TYPE_CHAR:- g_value_set_char(value, rts_getChar(obj));+ g_value_set_schar(value, rts_getChar(obj)); return; case G_TYPE_UCHAR:- g_value_set_char(value, rts_getChar(obj));+ g_value_set_schar(value, rts_getChar(obj)); return; case G_TYPE_BOOLEAN: g_value_set_boolean(value, rts_getBool(obj));
glib.cabal view
@@ -1,5 +1,5 @@ Name: glib-Version: 0.12.5.4+Version: 0.13.0.0 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team@@ -9,7 +9,7 @@ Cabal-Version: >= 1.8 Stability: stable homepage: http://projects.haskell.org/gtk2hs/-bug-reports: http://hackage.haskell.org/trac/gtk2hs/+bug-reports: https://github.com/gtk2hs/gtk2hs/issues Synopsis: Binding to the GLIB library for Gtk2Hs. Description: The GNU Library is a collection of C data structures and utility function for dealing with Unicode. This package only binds as@@ -34,14 +34,17 @@ Library build-depends: base >= 4 && < 5, utf8-string >= 0.2 && < 0.4,+ bytestring >= 0.10 && < 0.11,+ text >= 0.11.0.6 && < 1.2, containers- build-tools: gtk2hsC2hs >= 0.13.8+ build-tools: gtk2hsC2hs >= 0.13.11+ cpp-options: -U__BLOCKS__ if flag(closure_signals) cpp-options: -DUSE_GCLOSURE_SIGNALS_IMPL c-sources: System/Glib/hsgclosure.c include-dirs: System/Glib - exposed-modules: + exposed-modules: System.Glib System.Glib.GError System.Glib.Properties