packages feed

cairo 0.12.0 → 0.12.1

raw patch · 15 files changed

+304/−139 lines, 15 filesdep −haskell98setup-changednew-uploader

Dependencies removed: haskell98

Files

Graphics/Rendering/Cairo.hs view
@@ -65,6 +65,9 @@   , restore   , status   , withTargetSurface+  , pushGroup+  , pushGroupWithContent+  , popGroupToSource   , setSourceRGB   , setSourceRGBA   , setSource@@ -123,6 +126,7 @@   , withRGBPattern   , withRGBAPattern   , withPatternForSurface+  , withGroupPattern   , withLinearPattern   , withRadialPattern   , patternAddColorStopRGB@@ -355,7 +359,44 @@   context <- ask   surface <- liftIO $ Internal.getTarget context   f surface-  ++-- | Like @pushGroupWithContent ContentColorAlpha@, but more convenient.+pushGroup :: Render ()+pushGroup = liftRender0 Internal.pushGroup++-- | Temporarily redirects drawing to an intermediate surface known as a group.+-- The redirection lasts until the group is completed by a call to+-- 'withGroupPattern' or 'popGroupToSource'. These calls provide the result of+-- any drawing to the group as a pattern (either as an explicit object, or set+-- as the source pattern).  This group functionality can be convenient for+-- performing intermediate compositing. One common use of a group is to render+-- objects as opaque within the group (so that they occlude each other), and+-- then blend the result with translucence onto the destination.+--+-- Groups can be nested arbitrarily deeply by making balanced calls to+-- 'pushGroupWithContent' and 'withGroupPattern'. As a side effect,+-- 'pushGroupWithContent' calls 'save' and 'withGroupPattern' calls 'restore',+-- so that any changes to the graphics state will not be visible outside the+-- group.+--+-- As an example, here is how one might fill and stroke a path with+-- translucence, but without any portion of the fill being visible under the+-- stroke:+--+-- > pushGroup+-- > setSource fillPattern+-- > fillPreserve+-- > setSource strokePattern+-- > stroke+-- > popGroupToSource+-- > paintWithAlpha alpha+pushGroupWithContent :: Content -> Render ()+pushGroupWithContent = liftRender1 Internal.pushGroupWithContent++-- | Like @withGroupPattern setSource@, but more convenient.+popGroupToSource :: Render ()+popGroupToSource = liftRender0 Internal.popGroupToSource+ -- | Sets the source pattern within the context to an opaque color. This opaque -- color will then be used for any subsequent drawing operation until a new source -- pattern is set.@@ -764,7 +805,7 @@ -- path to connect the current point to the beginning of the arc. -- -- Angles are measured in radians. An angle of 0 is in the direction of the--- positive X axis (in user-space). An angle of @pi@ radians (90 degrees) is in+-- positive X axis (in user-space). An angle of @pi/2@ radians (90 degrees) is in -- the direction of the positive Y axis (in user-space). Angles increase in the -- direction from the positive X axis toward the positive Y axis. So with the -- default transformation matrix, angles increase in a clockwise direction.@@ -971,6 +1012,21 @@                              fail =<< Internal.statusToString status)            (\pattern -> f pattern) +-- | Pop the current group from the group stack and use it as a pattern. The+-- group should be populated first by calling 'pushGroup' or+-- 'pushGroupWithContent' and doing some drawing operations. This also calls+-- 'restore' to balance the 'save' called in 'pushGroup'.+withGroupPattern :: (Pattern -> Render a) -- ^ a nested render action using the pattern+  -> Render a+withGroupPattern f = do+  context <- ask+  bracketR (Internal.popGroup context)+           (\pattern -> do status <- Internal.patternStatus pattern+                           liftIO $ Internal.patternDestroy pattern+                           unless (status == StatusSuccess) $+                             fail =<< Internal.statusToString status)+           f+ -- | Create a new linear gradient 'Pattern' along the line defined by @(x0, y0)@ -- and @(x1, y1)@. Before using the gradient pattern, a number of color stops -- should be defined using 'patternAddColorStopRGB' and 'patternAddColorStopRGBA'.@@ -1728,7 +1784,7 @@  -- | An array that stores the raw pixel data of an image 'Surface'. ---data Ix i => SurfaceData i e = SurfaceData !Surface+data SurfaceData i e = SurfaceData !Surface                           {-# UNPACK #-} !(Ptr e)                                          !(i,i)                           {-# UNPACK #-} !Int
Graphics/Rendering/Cairo/Internal/Drawing/Cairo.chs view
@@ -27,6 +27,10 @@ {#fun restore                                { unCairo `Cairo' } -> `()' #} {#fun status             as status           { unCairo `Cairo' } -> `Status' cToEnum#} {#fun get_target         as getTarget        { unCairo `Cairo' } -> `Surface' mkSurface*#}+{#fun push_group              as ^           { unCairo `Cairo' } -> `()' #}+{#fun push_group_with_content as ^           { unCairo `Cairo', cFromEnum `Content' } -> `()' #}+{#fun pop_group               as ^           { unCairo `Cairo' } -> `Pattern' Pattern #}+{#fun pop_group_to_source     as ^           { unCairo `Cairo' } -> `()' #} {#fun set_source_rgb     as setSourceRGB     { unCairo `Cairo', `Double', `Double', `Double' } -> `()'#} {#fun set_source_rgba    as setSourceRGBA    { unCairo `Cairo', `Double', `Double', `Double', `Double' } -> `()'#} {#fun set_source         as setSource        { unCairo `Cairo', unPattern `Pattern' } -> `()'#}
Graphics/Rendering/Cairo/Internal/Drawing/Paths.chs view
@@ -18,6 +18,8 @@ import Foreign import Foreign.C +import Graphics.Rendering.Cairo.Internal.Utilities (withUTFString)+ {#context lib="cairo" prefix="cairo"#}  {#fun get_current_point as getCurrentPoint { unCairo `Cairo', alloca- `Double' peekFloatConv*, alloca- `Double' peekFloatConv* } -> `()'#}@@ -29,7 +31,7 @@ {#fun line_to           as lineTo          { unCairo `Cairo', `Double', `Double' } -> `()'#} {#fun move_to           as moveTo          { unCairo `Cairo', `Double', `Double' } -> `()'#} {#fun rectangle         as rectangle       { unCairo `Cairo', `Double', `Double', `Double', `Double' } -> `()'#}-{#fun text_path         as textPath        { unCairo `Cairo', withCString* `String' } -> `()'#}+{#fun text_path         as textPath        { unCairo `Cairo', withUTFString* `String' } -> `()'#} {#fun rel_curve_to      as relCurveTo      { unCairo `Cairo', `Double', `Double', `Double', `Double', `Double', `Double' } -> `()'#} {#fun rel_line_to       as relLineTo       { unCairo `Cairo', `Double', `Double' } -> `()'#} {#fun rel_move_to       as relMoveTo       { unCairo `Cairo', `Double', `Double' } -> `()'#}
Graphics/Rendering/Cairo/Internal/Drawing/Text.chs view
@@ -15,6 +15,7 @@  {#import Graphics.Rendering.Cairo.Types#} +import Graphics.Rendering.Cairo.Internal.Utilities (withUTFString)  import Foreign import Foreign.C@@ -26,6 +27,6 @@ {#fun set_font_matrix  as setFontMatrix  { unCairo `Cairo', `Matrix' } -> `()'#} {#fun get_font_matrix  as getFontMatrix  { unCairo `Cairo', alloca- `Matrix' peek*} -> `()'#} {#fun set_font_options as setFontOptions { unCairo `Cairo',  withFontOptions* `FontOptions' } -> `()'#}-{#fun show_text        as showText       { unCairo `Cairo', withCString* `String' } -> `()'#}+{#fun show_text        as showText       { unCairo `Cairo', withUTFString* `String' } -> `()'#} {#fun font_extents     as fontExtents    { unCairo `Cairo', alloca- `FontExtents' peek* } -> `()'#}-{#fun text_extents     as textExtents    { unCairo `Cairo', withCString* `String', alloca- `TextExtents' peek* } -> `()'#}+{#fun text_extents     as textExtents    { unCairo `Cairo', withUTFString* `String', alloca- `TextExtents' peek* } -> `()'#}
Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs view
@@ -23,7 +23,7 @@  #ifdef CAIRO_HAS_PDF_SURFACE -{#fun pdf_surface_create  as pdfSurfaceCreate { withCString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#}+{#fun pdf_surface_create  as pdfSurfaceCreate { withCAString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#}  #if CAIRO_CHECK_VERSION(1,2,0) {#fun pdf_surface_set_size as pdfSurfaceSetSize { withSurface* `Surface', `Double', `Double' } -> `()'#}
Graphics/Rendering/Cairo/Internal/Surfaces/PNG.chs view
@@ -25,10 +25,10 @@  imageSurfaceCreateFromPNG :: FilePath -> IO Surface imageSurfaceCreateFromPNG filename =-  withCString filename $ \filenamePtr ->+  withCAString filename $ \filenamePtr ->   {#call unsafe image_surface_create_from_png#} filenamePtr   >>= mkSurface -{#fun surface_write_to_png as surfaceWriteToPNG { withSurface* `Surface', withCString* `FilePath' } -> `Status' cToEnum#}+{#fun surface_write_to_png as surfaceWriteToPNG { withSurface* `Surface', withCAString* `FilePath' } -> `Status' cToEnum#}  #endif
Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs view
@@ -23,7 +23,7 @@  #ifdef CAIRO_HAS_PS_SURFACE -{#fun ps_surface_create  as psSurfaceCreate { withCString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#}+{#fun ps_surface_create  as psSurfaceCreate { withCAString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#}  #if CAIRO_CHECK_VERSION(1,2,0) {#fun cairo_ps_surface_set_size as psSurfaceSetSize { withSurface* `Surface', `Double', `Double' } -> `()'#}
Graphics/Rendering/Cairo/Internal/Surfaces/SVG.chs view
@@ -23,6 +23,6 @@  #ifdef CAIRO_HAS_SVG_SURFACE -{#fun svg_surface_create  as svgSurfaceCreate { withCString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#}+{#fun svg_surface_create  as svgSurfaceCreate { withCAString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#}  #endif
Graphics/Rendering/Cairo/Internal/Utilities.chs view
@@ -18,8 +18,31 @@ import Foreign import Foreign.C +import Data.Char (ord, chr)+ {#context lib="cairo" prefix="cairo"#}  {#fun status_to_string    as statusToString { cFromEnum `Status' } -> `String'#} {#fun pure version        as version        {} -> `Int'#} {#fun pure version_string as versionString  {} -> `String'#}++-- These functions taken from System/Glib/UTFString.hs+-- Copyright (c) 1999..2002 Axel Simon++-- Define withUTFString to emit UTF-8.+--+withUTFString :: String -> (CString -> IO a) -> IO a+withUTFString hsStr = withCAString (toUTF hsStr)+ where+    -- Convert Unicode characters to UTF-8.+    --+    toUTF :: String -> String+    toUTF [] = []+    toUTF (x:xs) | ord x<=0x007F = x:toUTF xs+                 | ord x<=0x07FF = chr (0xC0 .|. ((ord x `shift` (-6)) .&. 0x1F)):+                                   chr (0x80 .|. (ord x .&. 0x3F)):+                                   toUTF xs+                 | otherwise     = chr (0xE0 .|. ((ord x `shift` (-12)) .&. 0x0F)):+                                   chr (0x80 .|. ((ord x `shift` (-6)) .&. 0x3F)):+                                   chr (0x80 .|. (ord x .&. 0x3F)):+                                   toUTF xs
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,10 +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,12 @@+-- 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)
cairo.cabal view
@@ -1,23 +1,23 @@ Name:           cairo-Version:        0.12.0+Version:        0.12.1 License:        BSD3 License-file:   COPYRIGHT Copyright:      (c) 2001-2010 The Gtk2Hs Team, (c) Paolo Martini 2005, (c) Abraham Egnor 2003, 2004, (c) Aetion Technologies LLC 2004 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 Cairo library. Description:    Cairo is a library to render high quality vector graphics. There                 exist various backends that allows rendering to Gtk windows, PDF,                 PS, PNG and SVG documents, amongst others. Category:       Graphics-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: cairo-gtk2hs.h-                    Gtk2HsSetup.hs+                    SetupWrapper.hs SetupMain.hs Gtk2HsSetup.hs  Data-Dir:		demo Data-Files:		cairo-clock-icon.png@@ -46,8 +46,8 @@    Library         build-depends:  base >= 4 && < 5,-                        bytestring, mtl, haskell98, array-        build-tools:    gtk2hsC2hs+                        bytestring, mtl, array+        build-tools:    gtk2hsC2hs >= 0.13.5         exposed-modules:  Graphics.Rendering.Cairo                           Graphics.Rendering.Cairo.Matrix                           Graphics.Rendering.Cairo.Types
demo/Clock.hs view
@@ -13,7 +13,6 @@ import Graphics.Rendering.Cairo import Graphics.UI.Gtk import Graphics.UI.Gtk.Gdk.EventM-import System.Glib (handleGError, GError(..)) import System.Time import Control.Monad (when) import Data.Maybe (isJust)@@ -283,8 +282,7 @@   windowSetPosition window WinPosCenterAlways    widgetSetAppPaintable window True-  handleGError (\_ -> return ()) $-    windowSetIconFromFile window "cairo-clock-icon.png"+  windowSetIconFromFile window "cairo-clock-icon.png"   windowSetTitle window "Gtk2Hs Cairo Clock"   windowSetDefaultSize window initialSize initialSize   windowSetGeometryHints window (Just window)