diff --git a/Graphics/UI/Gtk/Poppler/Enums.chs b/Graphics/UI/Gtk/Poppler/Enums.chs --- a/Graphics/UI/Gtk/Poppler/Enums.chs +++ b/Graphics/UI/Gtk/Poppler/Enums.chs @@ -30,7 +30,6 @@ module Graphics.UI.Gtk.Poppler.Enums ( -- * Enums Error(..), - Orientation(..), SelectionStyle(..), PageTransitionType(..), PageTransitionAlignment(..), @@ -60,7 +59,6 @@ {# context lib="poppler" prefix="poppler" #} {# enum PopplerError as Error {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #} -{# enum PopplerOrientation as Orientation {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #} {# enum PopplerSelectionStyle as SelectionStyle {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #} {# enum PopplerPageTransitionType as PageTransitionType {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #} {# enum PopplerPageTransitionAlignment as PageTransitionAlignment {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #} diff --git a/Graphics/UI/Gtk/Poppler/Structs.hsc b/Graphics/UI/Gtk/Poppler/Structs.hsc --- a/Graphics/UI/Gtk/Poppler/Structs.hsc +++ b/Graphics/UI/Gtk/Poppler/Structs.hsc @@ -21,8 +21,9 @@ -- -- #hide -#include -#include +-- #include +#include "poppler.h" +#include #include "template-hsc-gtk2hs.h" -- | @@ -37,7 +38,7 @@ peekPopplerColor, ) where -import Control.Monad (liftM) +import Control.Monad (liftM) import Data.IORef import Control.Exception @@ -51,7 +52,7 @@ -- * Specifies x, y, width and height -- data PopplerRectangle = PopplerRectangle Double Double Double Double - deriving Show + deriving Show instance Storable PopplerRectangle where sizeOf _ = #{const sizeof(PopplerRectangle)} @@ -68,10 +69,10 @@ peekPopplerRectangle :: Ptr PopplerRectangle -> IO PopplerRectangle peekPopplerRectangle ptr = do - (x1_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, x1} ptr - (y1_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, y1} ptr - (x2_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, x2} ptr - (y2_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, y2} ptr + (x1_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, x1} ptr + (y1_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, y1} ptr + (x2_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, x2} ptr + (y2_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, y2} ptr return (PopplerRectangle (realToFrac x1_) (realToFrac y1_) (realToFrac x2_) (realToFrac y2_)) @@ -89,7 +90,8 @@ peekPopplerColor :: Ptr PopplerColor -> IO PopplerColor peekPopplerColor ptr = do - red <- #{peek PopplerColor, red} ptr + red <- #{peek PopplerColor, red} ptr green <- #{peek PopplerColor, green} ptr blue <- #{peek PopplerColor, blue} ptr return $ PopplerColor red green blue + diff --git a/Graphics/UI/Gtk/Poppler/Types.chs b/Graphics/UI/Gtk/Poppler/Types.chs --- a/Graphics/UI/Gtk/Poppler/Types.chs +++ b/Graphics/UI/Gtk/Poppler/Types.chs @@ -1,5 +1,6 @@ -{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE CPP #-} +{-# OPTIONS_HADDOCK hide #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell @@ -35,6 +36,7 @@ -- module Graphics.UI.Gtk.Poppler.Types ( + module System.Glib.GObject, Document(Document), DocumentClass, toDocument, mkDocument, unDocument, @@ -69,15 +71,18 @@ castToLayer, gTypeLayer ) where -import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr) -#if __GLASGOW_HASKELL__>=704 -import Foreign.C.Types (CULong(..), CUInt(..)) +import Foreign.ForeignPtr (ForeignPtr, castForeignPtr) +-- TODO work around cpphs https://ghc.haskell.org/trac/ghc/ticket/13553 +#if __GLASGOW_HASKELL__ >= 707 || __GLASGOW_HASKELL__ == 0 +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) #else -import Foreign.C.Types (CULong, CUInt) +import Foreign.ForeignPtr (unsafeForeignPtrToPtr) #endif -import System.Glib.GType (GType, typeInstanceIsA) -import System.Glib.GObject +import Foreign.C.Types (CULong(..), CUInt(..), CULLong(..)) +import System.Glib.GType (GType, typeInstanceIsA) +{#import System.Glib.GObject#} + {# context lib="poppler" prefix="poppler" #} -- The usage of foreignPtrToPtr should be safe as the evaluation will only be @@ -95,7 +100,7 @@ -- ******************************************************************* Document -{#pointer *Document foreign newtype #} deriving (Eq,Ord) +{#pointer *PopplerDocument as Document foreign newtype #} deriving (Eq,Ord) mkDocument = (Document, objectUnref) unDocument (Document o) = o @@ -118,7 +123,7 @@ -- ****************************************************************** FontsIter -{#pointer *FontsIter foreign newtype #} deriving (Eq,Ord) +{#pointer *PopplerFontsIter as FontsIter foreign newtype #} deriving (Eq,Ord) mkFontsIter = (FontsIter, objectUnref) unFontsIter (FontsIter o) = o @@ -141,7 +146,7 @@ -- *********************************************************************** Page -{#pointer *Page foreign newtype #} deriving (Eq,Ord) +{#pointer *PopplerPage as Page foreign newtype #} deriving (Eq,Ord) mkPage = (Page, objectUnref) unPage (Page o) = o @@ -164,7 +169,7 @@ -- ****************************************************************** FormField -{#pointer *FormField foreign newtype #} deriving (Eq,Ord) +{#pointer *PopplerFormField as FormField foreign newtype #} deriving (Eq,Ord) mkFormField = (FormField, objectUnref) unFormField (FormField o) = o @@ -187,7 +192,7 @@ -- ********************************************************************* PSFile -{#pointer *PSFile foreign newtype #} deriving (Eq,Ord) +{#pointer *PopplerPSFile as PSFile foreign newtype #} deriving (Eq,Ord) mkPSFile = (PSFile, objectUnref) unPSFile (PSFile o) = o @@ -210,7 +215,7 @@ -- ******************************************************************* FontInfo -{#pointer *FontInfo foreign newtype #} deriving (Eq,Ord) +{#pointer *PopplerFontInfo as FontInfo foreign newtype #} deriving (Eq,Ord) mkFontInfo = (FontInfo, objectUnref) unFontInfo (FontInfo o) = o @@ -233,7 +238,7 @@ -- ***************************************************************** Attachment -{#pointer *Attachment foreign newtype #} deriving (Eq,Ord) +{#pointer *PopplerAttachment as Attachment foreign newtype #} deriving (Eq,Ord) mkAttachment = (Attachment, objectUnref) unAttachment (Attachment o) = o @@ -256,7 +261,7 @@ -- ********************************************************************** Layer -{#pointer *Layer foreign newtype #} deriving (Eq,Ord) +{#pointer *PopplerLayer as Layer foreign newtype #} deriving (Eq,Ord) mkLayer = (Layer, objectUnref) unLayer (Layer o) = o diff --git a/Gtk2HsSetup.hs b/Gtk2HsSetup.hs deleted file mode 100644 --- a/Gtk2HsSetup.hs +++ /dev/null @@ -1,511 +0,0 @@ -{-# 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 -#endif - --- | Build a Gtk2hs package. --- -module Gtk2HsSetup ( - gtk2hsUserHooks, - getPkgConfigPackages, - checkGtk2hsBuildtools - ) where - -import Distribution.Simple -import Distribution.Simple.PreProcess -import Distribution.InstalledPackageInfo ( importDirs, - showInstalledPackageInfo, - libraryDirs, - extraLibraries, - extraGHCiLibraries ) -import Distribution.Simple.PackageIndex ( -#if CABAL_VERSION_CHECK(1,8,0) - lookupInstalledPackageId -#else - lookupPackageId -#endif - ) -import Distribution.PackageDescription as PD ( PackageDescription(..), - updatePackageDescription, - BuildInfo(..), - emptyBuildInfo, allBuildInfo, - Library(..), - 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, - simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg) -import Distribution.ModuleName ( ModuleName, components, toFilePath ) -import Distribution.Simple.Utils -import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..), - defaultCopyFlags, ConfigFlags(configVerbosity), - fromFlag, toFlag, RegisterFlags(..), flagToMaybe, - 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) -import System.Directory ( doesFileExist, getDirectoryContents, doesDirectoryExist ) -import Distribution.Version (Version(..)) -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 qualified Data.Map as M -import qualified Data.Set as S - -import Control.Applicative ((<$>)) - --- the name of the c2hs pre-compiled header file -precompFile = "precompchs.bin" - -gtk2hsUserHooks = simpleUserHooks { - hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal], - hookedPreProcessors = [("chs", ourC2hs)], - confHook = \pd cf -> - (fmap adjustLocalBuildInfo (confHook simpleUserHooks pd cf)), - postConf = \args cf pd lbi -> do - genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi - postConf simpleUserHooks args cf pd lbi, - buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd -> - buildHook simpleUserHooks pd lbi uh bf, - copyHook = \pd lbi uh flags -> copyHook simpleUserHooks pd lbi uh flags >> - installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)), - instHook = \pd lbi uh flags -> -#if defined(mingw32_HOST_OS) || defined(__MINGW32__) - installHook pd lbi uh flags >> - installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest, - regHook = registerHook -#else - instHook simpleUserHooks pd lbi uh flags >> - installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest -#endif - } - ------------------------------------------------------------------------------- --- Lots of stuff for windows ghci support ------------------------------------------------------------------------------- - -getDlls :: [FilePath] -> IO [FilePath] -getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$> - mapM getDirectoryContents dirs - -fixLibs :: [FilePath] -> [String] -> [String] -fixLibs dlls = concatMap $ \ lib -> - case filter (("lib" ++ lib) `isPrefixOf`) dlls of - dll:_ -> [dropExtension dll] - _ -> if lib == "z" then [] else [lib] - --- 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 - let copyFlags = defaultCopyFlags { - copyDistPref = installDistPref 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@PackageDescription { library = Just lib } - lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags - = do - - installedPkgInfoRaw <- generateRegistrationInfo - verbosity pkg lib lbi clbi inplace distPref - - dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls - let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw) - installedPkgInfo = installedPkgInfoRaw { - extraGHCiLibraries = libs } - - -- Three different modes: - case () of - _ | modeGenerateRegFile -> die "Generate Reg File not supported" - | modeGenerateRegScript -> die "Generate Reg Script not supported" - | otherwise -> registerPackage verbosity -#if CABAL_VERSION_CHECK(1,10,0) - installedPkgInfo pkg lbi inplace [packageDb] -#else - installedPkgInfo pkg lbi inplace 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) - distPref = fromFlag (regDistPref regFlags) - verbosity = fromFlag (regVerbosity regFlags) - -register _ _ regFlags = notice verbosity "No package to register" - 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 ------------------------------------------------------------------------------- - -adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo -adjustLocalBuildInfo lbi = - let extra = (Just libBi, []) - libBi = emptyBuildInfo { includeDirs = [ autogenModulesDir lbi - , buildDir lbi ] } - in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) } - ------------------------------------------------------------------------------- --- Processing .chs files with our local c2hs. ------------------------------------------------------------------------------- - -ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor -ourC2hs bi lbi = PreProcessor { - platformIndependent = False, - runPreProcessor = runC2HS bi lbi -} - -runC2HS :: BuildInfo -> LocalBuildInfo -> - (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO () -runC2HS bi lbi (inDir, inFile) (outDir, outFile) verbosity = do - -- have the header file name if we don't have the precompiled header yet - header <- case lookup "x-c2hs-header" (customFieldsBI bi) of - Just h -> return h - Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "++ - "that sets the C header file to process .chs.pp files.") - - -- c2hs will output files in out dir, removing any leading path of the input file. - -- Thus, append the dir of the input file to the output dir. - let (outFileDir, newOutFile) = splitFileName outFile - let newOutDir = outDir outFileDir - -- 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 - rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $ - map ("--include=" ++) (outDir:chiDirs) - ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi] - ++ ["--output-dir=" ++ newOutDir, - "--output=" ++ newOutFile, - "--precomp=" ++ buildDir lbi precompFile, - header, inDir inFile] - -getCppOptions :: BuildInfo -> LocalBuildInfo -> [String] -getCppOptions bi lbi - = nub $ - ["-I" ++ dir | dir <- PD.includeDirs bi] - ++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"] - -installCHI :: PackageDescription -- ^information from the .cabal file - -> LocalBuildInfo -- ^information from the configure step - -> Verbosity -> CopyDest -- ^flags sent to copy or install - -> IO () -installCHI pkg@PD.PackageDescription { library = Just lib } lbi verbosity copydest = do - let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest - -- 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 () - ------------------------------------------------------------------------------- --- Generating the type hierarchy and signal callback .hs files. ------------------------------------------------------------------------------- - -typeGenProgram :: Program -typeGenProgram = simpleProgram "gtk2hsTypeGen" - -signalGenProgram :: Program -signalGenProgram = simpleProgram "gtk2hsHookGenerator" - -c2hsLocal :: Program -c2hsLocal = simpleProgram "gtk2hsC2hs" - -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) - | (field,content) <- xList, - tag `isPrefixOf` field, - field /= (tag++"file")] - ++ [ "--tag=" ++ tag - | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs - , let name' = filter isAlpha (display name) - , tag <- name' - : [ name' ++ "-" ++ show major ++ "." ++ show digit - | digit <- [0,2..minor] ] - ] - - signalsOpts :: [ProgArg] - signalsOpts = concat [ map (\val -> '-':'-':drop 10 field++'=':val) (words content) - | (field,content) <- xList, - "x-signals-" `isPrefixOf` field, - field /= "x-signals-file"] - - genFile :: Program -> [ProgArg] -> FilePath -> IO () - genFile prog args outFile = do - res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args - rewriteFile outFile res - - forM_ (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $ - \(fileTag, f) -> do - let tag = reverse (drop 4 (reverse fileTag)) - info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.") - genFile typeGenProgram (typeOpts tag) f - - case lookup "x-signals-file" xList of - Nothing -> return () - Just f -> do - info verb ("Ensuring that callback hooks in "++f++" are up-to-date.") - genFile signalGenProgram signalsOpts f - ---FIXME: Cabal should tell us the selected pkg-config package versions in the --- LocalBuildInfo or equivalent. --- In the mean time, ask pkg-config again. - -getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId] -getPkgConfigPackages verbosity lbi pkg = - sequence - [ do version <- pkgconfig ["--modversion", display pkgname] - case simpleParse version of - Nothing -> die "parsing output of pkg-config --modversion failed" - Just v -> return (PackageIdentifier pkgname v) - | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ] - where - pkgconfig = rawSystemProgramStdoutConf verbosity - pkgConfigProgram (withPrograms lbi) - ------------------------------------------------------------------------------- --- Dependency calculation amongst .chs files. ------------------------------------------------------------------------------- - --- Given all files of the package, find those that end in .chs and extract the --- .chs files they depend upon. Then return the PackageDescription with these --- files rearranged so that they are built in a sequence that files that are --- needed by other files are built first. -fixDeps :: PackageDescription -> IO PackageDescription -fixDeps pd@PD.PackageDescription { - PD.library = Just lib@PD.Library { - PD.exposedModules = expMods, - PD.libBuildInfo = bi@PD.BuildInfo { - PD.hsSourceDirs = srcDirs, - PD.otherModules = othMods - }}} = do - let findModule m = findFileWithExtension [".chs.pp",".chs"] srcDirs - (joinPath (components m)) - mExpFiles <- mapM findModule expMods - mOthFiles <- mapM findModule othMods - - -- tag all exposed files with True so we throw an error if we need to build - -- an exposed module before an internal modules (we cannot express this) - let modDeps = zipWith (ModDep True []) expMods mExpFiles++ - zipWith (ModDep False []) othMods mOthFiles - modDeps <- mapM extractDeps modDeps - let (expMods, othMods) = span mdExposed $ sortTopological modDeps - badOther = map (fromMaybe "" . mdLocation) $ - filter (not . mdExposed) expMods - unless (null badOther) $ - die ("internal chs modules "++intercalate "," badOther++ - " depend on exposed chs modules; cabal needs to build internal modules first") - return pd { PD.library = Just lib { - PD.exposedModules = map mdOriginal expMods, - PD.libBuildInfo = bi { PD.otherModules = map mdOriginal othMods } - }} - -data ModDep = ModDep { - mdExposed :: Bool, - mdRequires :: [ModuleName], - mdOriginal :: ModuleName, - mdLocation :: Maybe FilePath -} - -instance Show ModDep where - show x = show (mdLocation x) - -instance Eq ModDep where - ModDep { mdOriginal = m1 } == ModDep { mdOriginal = m2 } = m1==m2 -instance Ord ModDep where - compare ModDep { mdOriginal = m1 } ModDep { mdOriginal = m2 } = compare m1 m2 - --- 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. -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 - Nothing -> die ("cannot parse chs import in "++f++":\n"++ - "offending line is {#"++xs) - -- no more imports after the first non-import hook - _ -> return acc - findImports acc (_:xxs) = findImports acc xxs - findImports acc [] = return acc - mods <- findImports [] (lines con) - return md { mdRequires = mods } - --- Find a total order of the set of modules that are partially sorted by their --- dependencies on each other. The function returns the sorted list of modules --- together with a list of modules that are required but not supplied by this --- in the input set of modules. -sortTopological :: [ModDep] -> [ModDep] -sortTopological ms = reverse $ fst $ foldl visit ([], S.empty) (map mdOriginal ms) - where - set = M.fromList (map (\m -> (mdOriginal m, m)) ms) - visit (out,visited) m - | m `S.member` visited = (out,visited) - | otherwise = case m `M.lookup` set of - Nothing -> (out, m `S.insert` visited) - Just md -> (md:out', visited') - where - (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md) - --- Check user whether install gtk2hs-buildtools correctly. -checkGtk2hsBuildtools :: [String] -> IO () -checkGtk2hsBuildtools programs = do - programInfos <- mapM (\ name -> do - location <- programFindLocation (simpleProgram name) normal - return (name, location) - ) programs - let printError name = do - 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) diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,10 +1,12 @@ --- 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 ) +-- Adjustments specific to this package, +-- all Gtk2Hs-specific boilerplate is kept in +-- gtk2hs-buildtools:Gtk2HsSetup +-- +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 new file mode 100644 --- /dev/null +++ b/SetupWrapper.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE CPP #-} + +-- 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 as B (exeExtension) +import Distribution.Simple.Configure (configCompilerEx) +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 (ExitCode(..), exitWith) +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 + + +-- 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 + createDirectoryIfMissingVerbose verbosity True setupDir + compileSetupExecutable + invokeSetupScript args + + where + setupDir = "dist/setup-wrapper" + setupVersionFile = setupDir "setup" <.> "version" + setupProgFile = setupDir "setup" <.> B.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 + (compiler,_,_) <- configCompilerEx defaultCompilerFlavor Nothing Nothing conf verbosity + index <- getInstalledPackages verbosity compiler 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) <- configCompilerEx (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 diff --git a/hspoppler.h b/hspoppler.h new file mode 100644 --- /dev/null +++ b/hspoppler.h @@ -0,0 +1,1 @@ +#include diff --git a/poppler.cabal b/poppler.cabal --- a/poppler.cabal +++ b/poppler.cabal @@ -1,50 +1,72 @@ +-- Note that poppler is packaged after pango. if we have any issue in build (gtk2hs packages are +-- pretty entangled), please refer to pango and adjust this following the change made in pango. Name: poppler -Version: 0.12.2.2 +Version: 0.14.2 License: GPL-2 License-file: COPYING -Copyright: (c) 2001-2010 The Gtk2Hs Team +Copyright: (c) 2001-2012, 2014-2016 The Gtk2Hs Team Author: Andy Stewart Maintainer: Ian-Woo Kim Build-Type: Custom -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.24 Stability: stable -homepage: http://www.haskell.org/gtk2hs/ -bug-reports: http://hackage.haskell.org/trac/gtk2hs/ +homepage: http://projects.haskell.org/gtk2hs +bug-reports: http://github.com/wavewave/poppler/issues Synopsis: Binding to the Poppler. Description: Poppler is a fork of the xpdf PDF viewer, to provide PDF rendering functionality as a shared library, to centralize the maintenance effort. - And move to forward in a number of areas that don't fit within the goals of xpdf. + And move to forward in a number of areas that don't fit within the goals of xpdf. Category: Graphics -Tested-With: GHC == 7.4 -Extra-Source-Files: Gtk2HsSetup.hs - hierarchy.list - template-hsc-gtk2hs.h +Tested-With: GHC == 7.10, GHC == 8.0 +Extra-Source-Files: SetupWrapper.hs + -- SetupMain.hs + -- Gtk2HsSetup.hs + hierarchy.list + template-hsc-gtk2hs.h + hspoppler.h x-Types-File: Graphics/UI/Gtk/Poppler/Types.chs x-Types-ModName: Graphics.UI.Gtk.Poppler.Types -x-Types-Import: System.Glib.GObject +x-Types-Forward: *System.Glib.GObject x-Types-Lib: poppler x-Types-Prefix: poppler x-Types-Tag: poppler x-Types-Hierarchy: hierarchy.list -Data-Dir: demo -Data-Files: PdfViewer.hs - Makefile +Data-Dir: demo +Data-Files: PdfViewer.hs + Makefile Source-Repository head - type: darcs - location: http://patch-tag.com/r/AndyStewart/poppler + type: git + location: git://github.com/wavewave/poppler.git +flag gtk3 + description: compile with gtk3 + default: False + +custom-setup + setup-depends: base >= 4.6, + Cabal >= 1.24 && < 2.1, + gtk2hs-buildtools >= 0.13.1.0 && < 0.14 + Library - build-depends: base >= 4 && < 5, array, containers, + build-depends: base >= 4 && < 5, array, containers, mtl, bytestring, - glib >= 0.12 && < 0.13, - cairo >= 0.12 && < 0.13, - gtk >= 0.12 && < 0.13 --- haskell98, + glib >= 0.13 && < 0.15, + cairo >= 0.13 && < 0.15 + if flag(gtk3) + build-depends: gtk3 >= 0.14.3 && < 0.15 + else + build-depends: gtk >= 0.14.3 && < 0.15 build-tools: gtk2hsC2hs, gtk2hsHookGenerator, gtk2hsTypeGen - + + cpp-options: -U__BLOCKS__ + if os(darwin) || os(freebsd) + cpp-options: -D__attribute__(A)= -D_Nullable= -D_Nonnull= + if os(windows) + cpp-options: -D__USE_MINGW_ANSI_STDIO=1 + exposed-modules: Graphics.UI.Gtk.Poppler.Action Graphics.UI.Gtk.Poppler.Attachment @@ -58,8 +80,12 @@ Graphics.UI.Gtk.Poppler.Structs Graphics.UI.Gtk.Poppler.Types - extensions: ForeignFunctionInterface - + default-language: Haskell98 + default-extensions: ForeignFunctionInterface + x-c2hs-Header: hspoppler.h include-dirs: . - x-c2hs-Header: glib/poppler.h - pkgconfig-depends: poppler-glib >= 0.12.4, gobject-2.0, glib-2.0, cairo >= 1.2.0, gdk-2.0, gdk-pixbuf-2.0, pango + includes: hspoppler.h + if flag(gtk3) + pkgconfig-depends: poppler-glib >= 0.12.4, cairo >= 1.2.0, gdk-3.0, pango + else + pkgconfig-depends: poppler-glib >= 0.12.4, gobject-2.0, glib-2.0, cairo >= 1.2.0, gdk-2.0, gdk-pixbuf-2.0, pango diff --git a/template-hsc-gtk2hs.h b/template-hsc-gtk2hs.h --- a/template-hsc-gtk2hs.h +++ b/template-hsc-gtk2hs.h @@ -1,6 +1,7 @@ #ifndef _TEMPLATE_HSC_GTK2HS_H_ #define _TEMPLATE_HSC_GTK2HS_H_ +#include #include #define hsc_gtk2hs_type(t) \