diff --git a/Gtk2HsSetup.hs b/Gtk2HsSetup.hs --- a/Gtk2HsSetup.hs +++ b/Gtk2HsSetup.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, ViewPatterns #-} #ifndef CABAL_VERSION_CHECK #error This module has to be compiled via the Setup.hs program which generates the gtk2hs-macros.h file @@ -9,7 +9,10 @@ module Gtk2HsSetup ( gtk2hsUserHooks, getPkgConfigPackages, - checkGtk2hsBuildtools + checkGtk2hsBuildtools, + typeGenProgram, + signalGenProgram, + c2hsLocal ) where import Distribution.Simple @@ -26,7 +29,7 @@ emptyBuildInfo, allBuildInfo, Library(..), libModules, hasLibs) -import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), +import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(withPackageDB, buildDir, localPkgDescr, installedPkgs, withPrograms), InstallDirs(..), componentPackageDeps, absoluteInstallDirs) @@ -53,13 +56,26 @@ import Distribution.Verbosity import Control.Monad (when, unless, filterM, liftM, forM, forM_) import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList ) -import Data.List (isPrefixOf, isSuffixOf, nub) -import Data.Char (isAlpha) +import Data.List (isPrefixOf, isSuffixOf, stripPrefix, nub) +import Data.Char (isAlpha, isNumber) import qualified Data.Map as M import qualified Data.Set as S +import qualified Distribution.Simple.LocalBuildInfo as LBI +import Distribution.Simple.Compiler (compilerVersion) import Control.Applicative ((<$>)) +#if CABAL_VERSION_CHECK(1,17,0) +import Distribution.Simple.Program.Find ( defaultProgramSearchPath ) +onDefaultSearchPath f a b = f a b defaultProgramSearchPath +libraryConfig lbi = case [clbi | (LBI.CLibName, clbi, _) <- LBI.componentsConfigs lbi] of + [clbi] -> Just clbi + _ -> Nothing +#else +onDefaultSearchPath = id +libraryConfig = LBI.libraryConfig +#endif + -- the name of the c2hs pre-compiled header file precompFile = "precompchs.bin" @@ -96,10 +112,16 @@ fixLibs :: [FilePath] -> [String] -> [String] fixLibs dlls = concatMap $ \ lib -> - case filter (("lib" ++ lib) `isPrefixOf`) dlls of + case filter (isLib lib) dlls of dll:_ -> [dropExtension dll] _ -> if lib == "z" then [] else [lib] - + where + isLib lib dll = + case stripPrefix ("lib"++lib) dll of + Just ('.':_) -> True + Just ('-':n:_) | isNumber n -> True + _ -> False + -- 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. @@ -132,8 +154,8 @@ register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO () -register pkg@PackageDescription { library = Just lib } - lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags +register pkg@(library -> Just lib ) + lbi@(libraryConfig -> Just clbi) regFlags = do installedPkgInfoRaw <- generateRegistrationInfo @@ -225,6 +247,10 @@ = nub $ ["-I" ++ dir | dir <- PD.includeDirs bi] ++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"] + ++ ["-D__GLASGOW_HASKELL__="++show (ghcDefine . versionBranch . compilerVersion $ LBI.compiler lbi)] + where + ghcDefine (v1:v2:_) = v1 * 100 + v2 + ghcDefine _ = __GLASGOW_HASKELL__ installCHI :: PackageDescription -- ^information from the .cabal file -> LocalBuildInfo -- ^information from the configure step @@ -307,6 +333,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. @@ -411,11 +460,11 @@ (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md) -- Check user whether install gtk2hs-buildtools correctly. -checkGtk2hsBuildtools :: [String] -> IO () +checkGtk2hsBuildtools :: [Program] -> IO () checkGtk2hsBuildtools programs = do - programInfos <- mapM (\ name -> do - location <- programFindLocation (simpleProgram name) normal - return (name, location) + programInfos <- mapM (\ prog -> do + location <- onDefaultSearchPath programFindLocation prog normal + return (programName prog, location) ) programs let printError name = do putStrLn $ "Cannot find " ++ name ++ "\n" diff --git a/Media/Streaming/GStreamer/Core/Hierarchy.chs b/Media/Streaming/GStreamer/Core/Hierarchy.chs --- a/Media/Streaming/GStreamer/Core/Hierarchy.chs +++ b/Media/Streaming/GStreamer/Core/Hierarchy.chs @@ -1,5 +1,5 @@ -{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE CPP #-} +{-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell @@ -166,7 +166,12 @@ castToController, gTypeController ) where -import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr) +import Foreign.ForeignPtr (ForeignPtr, castForeignPtr) +#if __GLASGOW_HASKELL__ >= 707 +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) +#else +import Foreign.ForeignPtr (unsafeForeignPtrToPtr) +#endif import Foreign.C.Types (CULong(..), CUInt(..)) import System.Glib.GType (GType, typeInstanceIsA) {#import System.Glib.GObject#} diff --git a/Media/Streaming/GStreamer/Core/MiniHierarchy.chs b/Media/Streaming/GStreamer/Core/MiniHierarchy.chs --- a/Media/Streaming/GStreamer/Core/MiniHierarchy.chs +++ b/Media/Streaming/GStreamer/Core/MiniHierarchy.chs @@ -1,5 +1,5 @@ -{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE CPP #-} +{-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell @@ -54,7 +54,12 @@ castToQuery, gTypeQuery ) where -import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr) +import Foreign.ForeignPtr (ForeignPtr, castForeignPtr) +#if __GLASGOW_HASKELL__ >= 707 +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) +#else +import Foreign.ForeignPtr (unsafeForeignPtrToPtr) +#endif import Foreign.C.Types (CULong(..), CUInt(..)) import System.Glib.GType (GType, typeInstanceIsA) {#import Media.Streaming.GStreamer.Core.MiniHierarchyBase#} @@ -76,7 +81,7 @@ -- ********************************************************************* Buffer -{#pointer *Buffer foreign newtype #} deriving (Eq,Ord) +{#pointer *GstBuffer as Buffer foreign newtype #} deriving (Eq,Ord) mkBuffer = (Buffer, miniObjectUnref) unBuffer (Buffer o) = o @@ -99,7 +104,7 @@ -- ********************************************************************** Event -{#pointer *Event foreign newtype #} deriving (Eq,Ord) +{#pointer *GstEvent as Event foreign newtype #} deriving (Eq,Ord) mkEvent = (Event, miniObjectUnref) unEvent (Event o) = o @@ -122,7 +127,7 @@ -- ******************************************************************** Message -{#pointer *Message foreign newtype #} deriving (Eq,Ord) +{#pointer *GstMessage as Message foreign newtype #} deriving (Eq,Ord) mkMessage = (Message, miniObjectUnref) unMessage (Message o) = o @@ -145,7 +150,7 @@ -- ********************************************************************** Query -{#pointer *Query foreign newtype #} deriving (Eq,Ord) +{#pointer *GstQuery as Query foreign newtype #} deriving (Eq,Ord) mkQuery = (Query, miniObjectUnref) unQuery (Query o) = o diff --git a/Media/Streaming/GStreamer/Core/Parse.chs b/Media/Streaming/GStreamer/Core/Parse.chs --- a/Media/Streaming/GStreamer/Core/Parse.chs +++ b/Media/Streaming/GStreamer/Core/Parse.chs @@ -39,12 +39,20 @@ {# context lib = "gstreamer" prefix = "gst" #} +-- N.B. When passing a GError to a parse* function, it is important to set its +-- contents to NULL. GStreamer has assertions of the form +-- +-- g_return_val_if_fail (error == NULL || *error == NULL, NULL); +-- +-- Violating them may lead to a segfault when assertions are enabled. + parseLaunch :: String -> IO (Maybe Element, Maybe GError) parseLaunch pipelineDescription = withUTFString pipelineDescription $ \cPipelineDescription -> alloca $ \gErrorPtr -> - do element <- {# call parse_launch #} cPipelineDescription (castPtr gErrorPtr) >>= + do poke gErrorPtr nullPtr + element <- {# call parse_launch #} cPipelineDescription (castPtr gErrorPtr) >>= maybePeek takeObject gError <- peek gErrorPtr >>= maybePeek peek return (element, gError) @@ -54,7 +62,8 @@ parseLaunchFromArgs args = withUTFStringArray0 args $ \cArgs -> alloca $ \gErrorPtr -> - do element <- {# call parse_launchv #} (castPtr cArgs) (castPtr gErrorPtr) >>= + do poke gErrorPtr nullPtr + element <- {# call parse_launchv #} (castPtr cArgs) (castPtr gErrorPtr) >>= maybePeek takeObject gError <- peek gErrorPtr >>= maybePeek peek return (element, gError) @@ -65,7 +74,8 @@ parseBinFromDescription binDescription ghostUnconnectedPads = withUTFString binDescription $ \cBinDescription -> alloca $ \gErrorPtr -> - do element <- {# call parse_bin_from_description #} cBinDescription + do poke gErrorPtr nullPtr + element <- {# call parse_bin_from_description #} cBinDescription (fromBool ghostUnconnectedPads) (castPtr gErrorPtr) >>= maybePeek takeObject diff --git a/Media/Streaming/GStreamer/Core/TagList.chs b/Media/Streaming/GStreamer/Core/TagList.chs --- a/Media/Streaming/GStreamer/Core/TagList.chs +++ b/Media/Streaming/GStreamer/Core/TagList.chs @@ -28,7 +28,9 @@ -- Stability : alpha -- Portability : portable (depends on GHC) module Media.Streaming.GStreamer.Core.TagList ( - + + Tag, + TagList, StandardTag(..), standardTagToString, tagNick, diff --git a/Media/Streaming/GStreamer/Core/Types.chs b/Media/Streaming/GStreamer/Core/Types.chs --- a/Media/Streaming/GStreamer/Core/Types.chs +++ b/Media/Streaming/GStreamer/Core/Types.chs @@ -690,6 +690,7 @@ -------------------------------------------------------------------- +-- | You should treat this type alias as opaque. type TagList = Structure mkTagList = mkStructure unTagList = unStructure @@ -702,6 +703,7 @@ -> m a giveTagList = giveStructure +-- | You should treat this type alias as opaque -- no fair treating it like an actual 'String'! type Tag = String {# enum GstTagFlag as TagFlag {underscoreToCase} with prefix = "GST" deriving (Eq, Show) #} diff --git a/SetupMain.hs b/SetupMain.hs --- a/SetupMain.hs +++ b/SetupMain.hs @@ -1,10 +1,13 @@ --- 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 ) +-- 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, + typeGenProgram, signalGenProgram, c2hsLocal) import Distribution.Simple ( defaultMainWithHooks ) main = do - checkGtk2hsBuildtools ["gtk2hsC2hs", "gtk2hsTypeGen", "gtk2hsHookGenerator"] + checkGtk2hsBuildtools [typeGenProgram, signalGenProgram, c2hsLocal] defaultMainWithHooks gtk2hsUserHooks diff --git a/SetupWrapper.hs b/SetupWrapper.hs --- a/SetupWrapper.hs +++ b/SetupWrapper.hs @@ -29,6 +29,24 @@ import Control.Monad +-- moreRecentFile is implemented in Distribution.Simple.Utils, but only in +-- Cabal >= 1.18. For backwards-compatibility, we implement a copy with a new +-- name here. Some desirable alternate strategies don't work: +-- * We can't use CPP to check which version of Cabal we're up against because +-- this is the file that's generating the macros for doing that. +-- * We can't use the name moreRecentFiles and use +-- import D.S.U hiding (moreRecentFiles) +-- because on old GHC's (and according to the Report) hiding a name that +-- doesn't exist is an error. +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) + setupWrapper :: FilePath -> IO () setupWrapper setupHsFile = do args <- getArgs @@ -91,8 +109,8 @@ -- Currently this is GHC only. It should really be generalised. -- compileSetupExecutable = do - setupHsNewer <- setupHsFile `moreRecentFile` setupProgFile - cabalVersionNewer <- setupVersionFile `moreRecentFile` setupProgFile + setupHsNewer <- setupHsFile `moreRecentFile'` setupProgFile + cabalVersionNewer <- setupVersionFile `moreRecentFile'` setupProgFile let outOfDate = setupHsNewer || cabalVersionNewer when outOfDate $ do debug verbosity "Setup script is out of date, compiling..." @@ -144,12 +162,3 @@ 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) diff --git a/gstreamer.cabal b/gstreamer.cabal --- a/gstreamer.cabal +++ b/gstreamer.cabal @@ -1,5 +1,5 @@ Name: gstreamer -Version: 0.12.1.2 +Version: 0.12.5.0 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team @@ -48,15 +48,15 @@ Makefile Source-Repository head - type: darcs - location: http://code.haskell.org/gstreamer + type: git + location: https://github.com/gtk2hs/gstreamer Library build-depends: base >= 3 && < 5, directory, array, bytestring, mtl, - glib >= 0.12 && < 0.13 + glib >= 0.12.5.0 && < 0.13 - build-tools: gtk2hsC2hs >= 0.13.5, + build-tools: gtk2hsC2hs >= 0.13.9, gtk2hsTypeGen, gtk2hsHookGenerator exposed-modules: