packages feed

webkit-javascriptcore 0.12.5.1 → 0.14.2.1

raw patch · 9 files changed

Files

− Gtk2HsSetup.hs
@@ -1,487 +0,0 @@-{-# 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-#endif---- | Build a Gtk2hs package.----module Gtk2HsSetup (-  gtk2hsUserHooks,-  getPkgConfigPackages,-  checkGtk2hsBuildtools,-  typeGenProgram,-  signalGenProgram,-  c2hsLocal-  ) where--import Distribution.Simple-import Distribution.Simple.PreProcess-import Distribution.InstalledPackageInfo ( importDirs,-                                           showInstalledPackageInfo,-                                           libraryDirs,-                                           extraLibraries,-                                           extraGHCiLibraries )-import Distribution.Simple.PackageIndex ( lookupInstalledPackageId )-import Distribution.PackageDescription as PD ( PackageDescription(..),-                                               updatePackageDescription,-                                               BuildInfo(..),-                                               emptyBuildInfo, allBuildInfo,-                                               Library(..),-                                               libModules, hasLibs)-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(withPackageDB, buildDir, localPkgDescr, installedPkgs, withPrograms),-                                           InstallDirs(..),-                                           componentPackageDeps,-                                           absoluteInstallDirs)-import Distribution.Simple.Compiler  ( Compiler(..) )-import Distribution.Simple.Program (-  Program(..), ConfiguredProgram(..),-  rawSystemProgramConf, rawSystemProgramStdoutConf, programName, programPath,-  c2hsProgram, pkgConfigProgram, gccProgram, 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 )-import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage )-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, catMaybes )-import Data.List (isPrefixOf, isSuffixOf, stripPrefix, nub, tails )-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"--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 (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.--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@(library       -> Just lib )-         lbi@(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-                                    installedPkgInfo pkg lbi inplace-#if CABAL_VERSION_CHECK(1,10,0)-                                    packageDbs-#else-                                    packageDb-#endif--  where-    modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))-    modeGenerateRegScript = fromFlag (regGenScript regFlags)-    inplace   = fromFlag (regInPlace regFlags)-    packageDbs = nub $ withPackageDB lbi-                    ++ maybeToList (flagToMaybe  (regPackageDB regFlags))-    packageDb = registrationPackageDB packageDbs-    distPref  = fromFlag (regDistPref regFlags)-    verbosity = fromFlag (regVerbosity regFlags)--register _ _ regFlags = notice verbosity "No package to register"-  where-    verbosity = fromFlag (regVerbosity regFlags)------------------------------------------------------------------------------------ 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 |-                  ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi),-                  dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ]-  (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,-        "--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"]-   ++ ["-D__GLASGOW_HASKELL__="++show (ghcDefine . ghcVersion . compilerId $ LBI.compiler lbi)]- where-  ghcDefine (v1:v2:_) = v1 * 100 + v2-  ghcDefine _ = __GLASGOW_HASKELL__--  ghcVersion :: CompilerId -> [Int]--- This version is nicer, but we need to know the Cabal version that includes the new CompilerId--- #if CABAL_VERSION_CHECK(1,19,2)---   ghcVersion (CompilerId GHC v _) = versionBranch v---   ghcVersion (CompilerId _ _ (Just c)) = ghcVersion c--- #else---   ghcVersion (CompilerId GHC v) = versionBranch v--- #endif---   ghcVersion _ = []--- This version should work fine for now-  ghcVersion = concat . take 1 . map (read . (++"]") . takeWhile (/=']')) . catMaybes-               . map (stripPrefix "CompilerId GHC (Version {versionBranch = ") . tails . show--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)-                   (PD.libModules lib)--  let files = [ f | Just f <- mFiles ]-  installOrdinaryFiles verbosity libPref files---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") {-    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-  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 maj ++ "." ++ show d2-                          | (maj, d2) <- [(maj,   d2) | maj <- [0..(major-1)], d2 <- [0,2..20]]-                                      ++ [(major, d2) | d2 <- [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--  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.--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 "<no file>" . 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 :: [Program] -> IO ()-checkGtk2hsBuildtools programs = do-  programInfos <- mapM (\ prog -> do-                         location <- onDefaultSearchPath programFindLocation prog normal-                         return (programName prog, 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)
Setup.hs view
@@ -1,10 +1,8 @@--- Standard setup file for a Gtk2Hs module.+-- Adjustments specific to this package,+-- all Gtk2Hs-specific boilerplate is kept in+-- gtk2hs-buildtools:Gtk2HsSetup ----- 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--import SetupWrapper ( setupWrapper )+import Gtk2HsSetup ( gtk2hsUserHooks )+import Distribution.Simple ( defaultMainWithHooks ) -main = setupWrapper "SetupMain.hs"+main = defaultMainWithHooks gtk2hsUserHooks
− SetupMain.hs
@@ -1,13 +0,0 @@--- 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 [typeGenProgram, signalGenProgram, c2hsLocal]-  defaultMainWithHooks gtk2hsUserHooks-  
− SetupWrapper.hs
@@ -1,164 +0,0 @@--- 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----- 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" <.> 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
hsjscore.h view
@@ -17,6 +17,9 @@  * Boston, MA 02110-1301, USA.  */ +#ifdef __BLOCKS__+#undef __BLOCKS__+#endif #ifndef HS_WEBKITJAVASCRIPTCORE_H #define HS_WEBKITJAVASCRIPTCORE_H /* to avoid stdbool.h error in JavaScriptCore/JSBase.h*/@@ -35,7 +38,7 @@  typedef JSStaticValue* JSStaticValueRef; -typedef JSStaticFunction* JSStaticFunctionRef; +typedef JSStaticFunction* JSStaticFunctionRef; -typedef JSClassDefinition* JSClassDefinitionRef; +typedef JSClassDefinition* JSClassDefinitionRef; #endif
marshal.list view
@@ -14,8 +14,8 @@ #   FLAGS       for flag enumeration types (guint) #   FLOAT       for single-precision float types (gfloat) #   DOUBLE      for double-precision float types (gdouble)-#   STRING      for string types (gchar*)-#   MSTRING     for string types (gchar*) that could be NUL+#   GLIBSTRING  for string types (gchar*)+#   MGLIBSTRING for string types (gchar*) that could be NUL #   BOXED       for boxed (anonymous but reference counted) types (GBoxed*) #   POINTER     for anonymous pointer types (gpointer) #   NONE        deprecated alias for VOID@@ -43,25 +43,3 @@ # If you add a new signal type, please check that it actually works! # If it is a Boxed type check that the reference counting is right. -VOID:POINTER,POINTER-BOOLEAN:TOBJECT-BOOLEAN:TOBJECT,STRING,BOXED-POINTER:TOBJECT-BOOLEAN:INT,INT,STRING-BOOLEAN:STRING,STRING,INT,STRING-BOOLEAN:TOBJECT,STRING-BOOLEAN:TOBJECT,STRING,STRING-BOOLEAN:TOBJECT,TOBJECT,TOBJECT,TOBJECT-BOOLEAN:TOBJECT,TOBJECT,STRING,TOBJECT-NONE:TOBJECT,TOBJECT,TOBJECT,TOBJECT-NONE:TOBJECT,TOBJECT,MTOBJECT,MTOBJECT-BOOLEAN:ENUM,INT-BOOLEAN:NONE-NONE:NONE-NONE:MSTRING,MSTRING-NONE:TOBJECT,STRING-NONE:TOBJECT,TOBJECT-NONE:STRING,STRING-NONE:TOBJECT-NONE:INT-NONE:STRING
src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSObjectRef.chs view
@@ -3,8 +3,8 @@ module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef where  import Foreign.C.String-import Foreign.C.Types -import Foreign.Ptr +import Foreign.C.Types+import Foreign.Ptr import Foreign.Storable import Data.Word (Word) @@ -57,70 +57,73 @@  type JSObjectConvertToTypeCallback = {#type JSObjectConvertToTypeCallback #} +foreign import ccall "wrapper"+  mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback+ type JSStaticValueRef = {#type JSStaticValueRef #}  -value_get_name :: JSStaticValueRef -> IO String -value_get_name t = {#get JSStaticValue -> name #} t >>= peekCString +value_get_name :: JSStaticValueRef -> IO String+value_get_name t = {#get JSStaticValue -> name #} t >>= peekCString  value_set_name :: JSStaticValueRef -> String -> IO ()-value_set_name t str = {#set JSStaticFunction -> name #} t =<< newCString str +value_set_name t str = {#set JSStaticFunction -> name #} t =<< newCString str  -value_get_getProperty :: JSStaticValueRef -> IO JSObjectGetPropertyCallback +value_get_getProperty :: JSStaticValueRef -> IO JSObjectGetPropertyCallback value_get_getProperty t = {#get JSStaticValue -> getProperty #} t   value_set_getProperty :: JSStaticValueRef -> JSObjectGetPropertyCallback -> IO ()-value_set_getProperty t cbk = {#set JSStaticValue -> getProperty #} t cbk +value_set_getProperty t cbk = {#set JSStaticValue -> getProperty #} t cbk  -value_get_setProperty :: JSStaticValueRef -> IO JSObjectSetPropertyCallback +value_get_setProperty :: JSStaticValueRef -> IO JSObjectSetPropertyCallback value_get_setProperty t = {#get JSStaticValue -> setProperty #} t  value_set_setProperty :: JSStaticValueRef -> JSObjectSetPropertyCallback -> IO ()-value_set_setProperty t cbk = {#set JSStaticValue -> setProperty #} t cbk +value_set_setProperty t cbk = {#set JSStaticValue -> setProperty #} t cbk -value_get_attributes :: JSStaticValueRef -> IO JSPropertyAttributes +value_get_attributes :: JSStaticValueRef -> IO JSPropertyAttributes value_get_attributes t = {#get JSStaticValue -> attributes #} t  value_set_attributes :: JSStaticValueRef -> JSPropertyAttributes -> IO ()-value_set_attributes t attr = {#set JSStaticValue -> attributes #} t attr +value_set_attributes t attr = {#set JSStaticValue -> attributes #} t attr   type JSStaticFunctionRef = {#type JSStaticFunctionRef #}  func_get_name :: JSStaticFunctionRef -> IO String-func_get_name t = {#get JSStaticFunction -> name #} t >>= peekCString +func_get_name t = {#get JSStaticFunction -> name #} t >>= peekCString  func_set_name :: JSStaticFunctionRef -> String -> IO () func_set_name t str = {#set JSStaticFunction -> name #} t =<< newCString str  func_get_callAsFunction :: JSStaticFunctionRef -> IO JSObjectCallAsFunctionCallback-func_get_callAsFunction t = {#get JSStaticFunction -> callAsFunction #} t +func_get_callAsFunction t = {#get JSStaticFunction -> callAsFunction #} t  func_set_callAsFunction :: JSStaticFunctionRef -> JSObjectCallAsFunctionCallback -> IO ()-func_set_callAsFunction t cbk = {#set JSStaticFunction -> callAsFunction #} t cbk +func_set_callAsFunction t cbk = {#set JSStaticFunction -> callAsFunction #} t cbk -func_get_attributes :: JSStaticFunctionRef -> IO JSPropertyAttributes +func_get_attributes :: JSStaticFunctionRef -> IO JSPropertyAttributes func_get_attributes t = {#get JSStaticFunction -> attributes #} t -func_set_attributes :: JSStaticFunctionRef -> JSPropertyAttributes -> IO () -func_set_attributes t attr = {#set JSStaticFunction -> attributes #} t attr +func_set_attributes :: JSStaticFunctionRef -> JSPropertyAttributes -> IO ()+func_set_attributes t attr = {#set JSStaticFunction -> attributes #} t attr -type JSClassDefinitionRef = {#type JSClassDefinitionRef #} +type JSClassDefinitionRef = {#type JSClassDefinitionRef #} -class_get_version :: JSClassDefinitionRef -> IO Int +class_get_version :: JSClassDefinitionRef -> IO Int class_get_version t = {#get JSClassDefinition -> version #} t >>= return . fromIntegral  class_set_version :: JSClassDefinitionRef -> Int -> IO ()-class_set_version t n = {#set JSClassDefinition -> version #} t (fromIntegral n) +class_set_version t n = {#set JSClassDefinition -> version #} t (fromIntegral n)  class_get_attributes :: JSClassDefinitionRef -> IO JSClassAttributes class_get_attributes t = {#get JSClassDefinition -> attributes #} t  class_set_attributes :: JSClassDefinitionRef -> JSClassAttributes -> IO ()-class_set_attributes t attr = {#set JSClassDefinition -> attributes #} t attr +class_set_attributes t attr = {#set JSClassDefinition -> attributes #} t attr  class_get_className :: JSClassDefinitionRef -> IO String class_get_className t = {#get JSClassDefinition -> className #} t >>= peekCString@@ -142,63 +145,63 @@ class_set_staticValues t v = {#set JSClassDefinition -> staticValues #} t v  -class_get_staticFunctions :: JSClassDefinitionRef -> IO JSStaticFunctionRef -class_get_staticFunctions t = {#get JSClassDefinition -> staticFunctions #} t +class_get_staticFunctions :: JSClassDefinitionRef -> IO JSStaticFunctionRef+class_get_staticFunctions t = {#get JSClassDefinition -> staticFunctions #} t   class_set_staticFunctions :: JSClassDefinitionRef -> JSStaticFunctionRef -> IO () class_set_staticFunctions t f = {#set JSClassDefinition -> staticFunctions #} t f -class_get_initialize :: JSClassDefinitionRef -> IO JSObjectInitializeCallback +class_get_initialize :: JSClassDefinitionRef -> IO JSObjectInitializeCallback class_get_initialize t = {#get JSClassDefinition -> initialize #} t  class_set_initialize :: JSClassDefinitionRef -> JSObjectInitializeCallback -> IO ()-class_set_initialize t cbk = {#set JSClassDefinition -> initialize #} t cbk  +class_set_initialize t cbk = {#set JSClassDefinition -> initialize #} t cbk   -class_get_finalize :: JSClassDefinitionRef -> IO JSObjectFinalizeCallback +class_get_finalize :: JSClassDefinitionRef -> IO JSObjectFinalizeCallback class_get_finalize t = {#get JSClassDefinition -> finalize #} t  class_set_finalize :: JSClassDefinitionRef -> JSObjectFinalizeCallback -> IO () class_set_finalize t f = {#set JSClassDefinition -> finalize #} t f  -class_get_hasProperty :: JSClassDefinitionRef -> IO JSObjectHasPropertyCallback +class_get_hasProperty :: JSClassDefinitionRef -> IO JSObjectHasPropertyCallback class_get_hasProperty t = {#get JSClassDefinition -> hasProperty #} t  class_set_hasProperty :: JSClassDefinitionRef -> JSObjectHasPropertyCallback -> IO () class_set_hasProperty t f = {#set JSClassDefinition -> hasProperty #} t f -class_get_getProperty :: JSClassDefinitionRef -> IO JSObjectGetPropertyCallback +class_get_getProperty :: JSClassDefinitionRef -> IO JSObjectGetPropertyCallback class_get_getProperty t = {#get JSClassDefinition -> getProperty #} t  class_set_getProperty :: JSClassDefinitionRef -> JSObjectGetPropertyCallback -> IO () class_set_getProperty t f = {#set JSClassDefinition -> getProperty #} t f -class_get_setProperty :: JSClassDefinitionRef -> IO JSObjectSetPropertyCallback +class_get_setProperty :: JSClassDefinitionRef -> IO JSObjectSetPropertyCallback class_get_setProperty t = {#get JSClassDefinition -> setProperty #} t  class_set_setProperty :: JSClassDefinitionRef -> JSObjectSetPropertyCallback -> IO () class_set_setProperty t f = {#set JSClassDefinition -> setProperty #} t f -class_get_deleteProperty :: JSClassDefinitionRef -> IO JSObjectDeletePropertyCallback +class_get_deleteProperty :: JSClassDefinitionRef -> IO JSObjectDeletePropertyCallback class_get_deleteProperty t = {#get JSClassDefinition -> deleteProperty #} t  class_set_deleteProperty :: JSClassDefinitionRef -> JSObjectDeletePropertyCallback -> IO ()-class_set_deleteProperty t f = {#set JSClassDefinition -> deleteProperty #} t f +class_set_deleteProperty t f = {#set JSClassDefinition -> deleteProperty #} t f  class_get_getPropertyNames :: JSClassDefinitionRef -> IO JSObjectGetPropertyNamesCallback class_get_getPropertyNames t = {#get JSClassDefinition -> getPropertyNames #} t  class_set_getPropertyNames :: JSClassDefinitionRef -> JSObjectGetPropertyNamesCallback -> IO ()-class_set_getPropertyNames t f = {#set JSClassDefinition -> getPropertyNames #} t f +class_set_getPropertyNames t f = {#set JSClassDefinition -> getPropertyNames #} t f  class_get_callAsFunction  :: JSClassDefinitionRef -> IO JSObjectCallAsFunctionCallback class_get_callAsFunction t = {#get JSClassDefinition -> callAsFunction #} t  class_set_callAsFunction :: JSClassDefinitionRef -> JSObjectCallAsFunctionCallback -> IO ()-class_set_callAsFunction t f = {#set JSClassDefinition -> callAsFunction #} t f +class_set_callAsFunction t f = {#set JSClassDefinition -> callAsFunction #} t f   class_get_callAsConstructor :: JSClassDefinitionRef -> IO JSObjectCallAsConstructorCallback@@ -208,14 +211,14 @@ class_set_callAsConstructor t f = {#set JSClassDefinition -> callAsConstructor #} t f  -class_get_hasInstance :: JSClassDefinitionRef -> IO JSObjectHasInstanceCallback +class_get_hasInstance :: JSClassDefinitionRef -> IO JSObjectHasInstanceCallback class_get_hasInstance t = {#get JSClassDefinition -> hasInstance #} t  class_set_hasInstance :: JSClassDefinitionRef -> JSObjectHasInstanceCallback -> IO ()-class_set_hasInstance t f = {#set JSClassDefinition -> hasInstance #} t f +class_set_hasInstance t f = {#set JSClassDefinition -> hasInstance #} t f  -class_get_convertToType :: JSClassDefinitionRef -> IO JSObjectConvertToTypeCallback +class_get_convertToType :: JSClassDefinitionRef -> IO JSObjectConvertToTypeCallback class_get_convertToType t = {#get JSClassDefinition -> convertToType #} t  class_set_convertToType :: JSClassDefinitionRef -> JSObjectConvertToTypeCallback -> IO ()@@ -272,7 +275,7 @@ {#fun JSObjectCallAsFunction as ^ {id `JSContextRef', id `JSObjectRef', id `JSObjectRef', fromIntegral `CSize', id `JSValueRefRef', id `JSValueRefRef'} -> `JSValueRef' id #}  {#fun JSObjectCallAsConstructor as ^ {id `JSContextRef', id `JSObjectRef', fromIntegral `CSize', id `JSValueRefRef', id `JSValueRefRef'} -> `JSObjectRef' id #}- + {#fun JSObjectCopyPropertyNames as ^ {id `JSContextRef', id `JSObjectRef'} -> `JSPropertyNameArrayRef' id #}  {#fun JSPropertyNameArrayRetain as ^ {id `JSPropertyNameArrayRef'} -> `JSPropertyNameArrayRef' id #}
− src/Graphics/UI/Gtk/WebKit/JavaScriptCore/WebFrame.chs
@@ -1,23 +0,0 @@-{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-}--module Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame where--#if __GLASGOW_HASKELL__ >= 704-import Foreign.ForeignPtr.Unsafe-#else-import Foreign.ForeignPtr-#endif-import Foreign.Ptr -import Foreign.C.Types --import Graphics.UI.Gtk.WebKit.Types -import Graphics.UI.Gtk.WebKit.WebFrame--- {#import Graphics.UI.Gtk.WebKit.JavaScriptCore.Types #}-{#import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase #}--#include <webkit/webkitwebframe.h>--webFrameGetGlobalContext :: WebFrameClass self => self -> IO JSGlobalContextRef-webFrameGetGlobalContext webframe = {#call webkit_web_frame_get_global_context#} ((castPtr.unsafeForeignPtrToPtr.unWebFrame.toWebFrame) webframe) --
webkit-javascriptcore.cabal view
@@ -1,5 +1,5 @@ Name:		webkit-javascriptcore-Version:	0.12.5.1+Version:	0.14.2.1 Synopsis:       JavaScriptCore FFI from webkitgtk Description: 	FFI for JavaScriptCore module from webkitgtk License: 	BSD3@@ -7,11 +7,10 @@ Author:		Ian-Woo Kim Maintainer: 	Ian-Woo Kim <ianwookim@gmail.com> Build-Type:     Custom-Cabal-Version:  >= 1.8+Cabal-Version:  >= 1.24 Extra-Source-Files: hsjscore.h-                    SetupWrapper.hs SetupMain.hs Gtk2HsSetup.hs                     marshal.list-		    hierarchy.list+		            hierarchy.list  x-Types-File:       src/Graphics/UI/Gtk/WebKit/JavaScriptCore/Types.chs x-Types-Tag:        webkit webkit-dom@@ -24,13 +23,14 @@   type:         git   location:     https://github.com/gtk2hs/webkit-javascriptcore +custom-setup+  setup-depends: base >= 4.6,+                 Cabal >= 1.24 && < 1.25,+                 gtk2hs-buildtools >= 0.13.2.0 && < 0.14+ Library         hs-source-dirs: src-        build-depends:  base >= 4 && < 5,-                        glib-						-        build-tools:    gtk2hsC2hs >= 0.13.8,-                        gtk2hsHookGenerator, gtk2hsTypeGen+        build-depends:  base >= 4 && < 5 						         exposed-modules:                    Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase@@ -38,13 +38,11 @@                    Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef                    Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef                    Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef-                   ---                   -- Graphics.UI.Gtk.WebKit.JavaScriptCore.Types-                   Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame         other-modules:  		-        extensions:     ForeignFunctionInterface+        default-language:   Haskell98+        default-extensions: ForeignFunctionInterface          x-Signals-File:  src/Graphics/UI/Gtk/WebKit/JavaScriptCore/Signals.chs         x-Signals-Modname: src/Graphics.UI.Gtk.WebKit.JavaScriptCore.Signals@@ -52,10 +50,6 @@         x-Signals-Import: Graphics.UI.GtkInternals 		         include-dirs: .-                      include-                      -- /usr/include/webkitgtk-1.0-                      -- /usr/include/glib-2.0-                      -- /usr/lib/x86_64-linux-gnu/glib-2.0/include+        cpp-options: -DDISABLE_DEPRECATED -U__BLOCKS__ -D__attribute__(A)= -D_Nullable= -D_Nonnull=         x-c2hs-Header:  hsjscore.h         pkgconfig-depends: webkit-1.0 >=1.1.15-        build-depends:     gtk >=0.12.5.4 && <0.13, webkit >= 0.12.5