plugins 1.3.1 → 1.4.0
raw patch · 7 files changed
+56/−74 lines, 7 filesdep +ghc-primdep ~Cabaldep ~basedep ~ghc
Dependencies added: ghc-prim
Dependency ranges changed: Cabal, base, ghc
Files
- plugins.cabal +6/−6
- src/System/MkTemp.hs +7/−11
- src/System/Plugins/Env.hs +29/−41
- src/System/Plugins/Load.hs +2/−3
- src/System/Plugins/Make.hs +3/−5
- src/System/Plugins/PackageAPI.hs +4/−3
- src/System/Plugins/Process.hs +5/−5
plugins.cabal view
@@ -1,5 +1,5 @@ name: plugins-version: 1.3.1+version: 1.4.0 homepage: http://code.haskell.org/~dons/code/hs-plugins synopsis: Dynamic linking for Haskell and C objects description: Dynamic linking and runtime evaluation of Haskell,@@ -12,7 +12,7 @@ License-file: LICENSE author: Don Stewart 2004-2008 maintainer: Don Stewart <dons@galois.com>-cabal-version: >= 1.2+cabal-version: >= 1.6 build-type: Configure extra-source-files: config.guess, config.h.in, config.mk.in, config.sub, configure, configure.ac, install.sh, Makefile,@@ -33,7 +33,6 @@ System.Plugins.Make, System.Plugins.Package, System.Plugins.PackageAPI,- System.Plugins.ParsePkgConfCabal, System.Plugins.Parser, System.Plugins.Process, System.Plugins.Utils@@ -41,13 +40,14 @@ extensions: CPP, ForeignFunctionInterface ghc-options: -Wall -funbox-strict-fields -fno-warn-missing-signatures hs-source-dirs: src- build-depends: base >= 3 && < 4,- Cabal >= 1.4 && < 1.5,+ build-depends: base >= 4,+ Cabal >= 1.6, haskell-src, containers, array, directory, random, process,- ghc >= 6.8+ ghc >= 6.10,+ ghc-prim
src/System/MkTemp.hs view
@@ -48,9 +48,7 @@ import System.IO.Error ( isAlreadyExistsError, isAlreadyInUseError, isPermissionError ) #endif -import GHC.IOBase ( IOException(IOError), - Exception(IOException), - IOErrorType(AlreadyExists) )+import GHC.IOBase (IOException(..), IOErrorType(AlreadyExists) ) #ifndef __MINGW32__ import qualified System.Posix.Internals ( c_getpid )@@ -185,20 +183,18 @@ -- --------------------------------------------------------------------- -alreadyExists :: Exception -> Maybe Exception-alreadyExists e@(IOException ioe) - | isAlreadyExistsError ioe = Just e+alreadyExists :: IOError -> Maybe IOError+alreadyExists ioe+ | isAlreadyExistsError ioe = Just ioe | otherwise = Nothing-alreadyExists _ = Nothing -isInUse :: Exception -> Maybe ()+isInUse :: IOError -> Maybe () #ifndef __MINGW32__-isInUse (IOException ioe) +isInUse ioe | isAlreadyExistsError ioe = Just () | otherwise = Nothing-isInUse _ = Nothing #else-isInUse (IOException ioe) +isInUse ioe | isAlreadyInUseError ioe = Just () | isPermissionError ioe = Just () | isAlreadyExistsError ioe = Just () -- we throw this
src/System/Plugins/Env.hs view
@@ -52,16 +52,11 @@ import System.Plugins.LoadTypes (Module) import System.Plugins.PackageAPI {- everything -}-#if CABAL == 1 || __GLASGOW_HASKELL__ >= 604-import System.Plugins.ParsePkgConfCabal( parsePkgConf )-#else-import System.Plugins.ParsePkgConfLite ( parsePkgConf )-#endif-import System.Plugins.Consts ( ghcLibraryPath, sysPkgConf, sysPkgSuffix )+import System.Plugins.Consts ( sysPkgConf, sysPkgSuffix ) import Data.IORef ( writeIORef, readIORef, newIORef, IORef() ) import Data.Maybe ( isJust, isNothing, fromMaybe )-import Data.List ( isPrefixOf, isInfixOf, nub )+import Data.List ( isInfixOf, nub ) import System.IO.Unsafe ( unsafePerformIO ) import System.IO ( hGetContents )@@ -74,8 +69,14 @@ import Control.Concurrent.MVar ( MVar(), newMVar, withMVar ) -import Distribution.Package hiding (packageName)-import Text.ParserCombinators.ReadP+import Distribution.InstalledPackageInfo+-- import Distribution.Package hiding (packageName, PackageName(..))+import Distribution.Simple.Compiler+import Distribution.Simple.GHC+import Distribution.Simple.PackageIndex+import Distribution.Simple.Program+import Distribution.Text+import Distribution.Verbosity import qualified Data.Map as M import qualified Data.Set as S@@ -147,6 +148,7 @@ IORef StaticPkgEnv, IORef MergeEnv) + -- -- our environment, contains a set of loaded objects, and a map of known -- packages and their informations. Initially all we know is the default@@ -285,9 +287,9 @@ union :: PkgEnvs -> [PackageConfig] -> PkgEnvs union ls ps' = let fm = emptyFM -- new FM for this package.conf- in foldr (\p fm' -> if packageName_ p == "base" -- ghc doesn't supply a version with 'base'- -- for some reason.- then addToFM (addToFM fm' (packageName_ p) p) (packageName p) p+ in foldr (\p fm' -> if (display $ package p) == "base" -- ghc doesn't supply a version with 'base'+ -- for some reason.+ then addToFM (addToFM fm' (display $ package p) p) (packageName p) p else addToFM fm' (packageName p) p) fm ps' : ls -- @@ -309,20 +311,9 @@ -- readPackageConf :: FilePath -> IO [PackageConfig] readPackageConf f = do- s <- readFile f- let p = parsePkgConf s- return $! map expand_libdir p-- where- expand_libdir :: PackageConfig -> PackageConfig- expand_libdir pk =- let pk' = updImportDirs (\idirs -> map expand idirs) pk- pk'' = updLibraryDirs (\ldirs -> map expand ldirs) pk'- in pk''-- expand :: FilePath -> FilePath- expand s | "$libdir" `isPrefixOf` s = ghcLibraryPath ++ drop 7 s- expand s = s+ pc <- configureAllKnownPrograms silent defaultProgramConfiguration+ pkgIndex <- getInstalledPackages silent (SpecificPackageDB f) pc+ return $ allPackages pkgIndex -- ----------------------------------------------------------- -- Static package management stuff. A static package is linked with the base@@ -332,10 +323,7 @@ addStaticPkg pkg = modifyStaticPkgEnv env $ \set -> return $ S.insert pkg set isStaticPkg :: PackageName -> IO Bool-isStaticPkg pkg- = case readP_to_S parsePackageName pkg of- ((pkgName,_):_) -> withStaticPkgEnv env $ \set -> return $ S.member pkgName set- [] -> return False+isStaticPkg pkg = withStaticPkgEnv env $ \set -> return $ S.member pkg set -- -- Package path, given a package name, look it up in the environment and@@ -405,21 +393,21 @@ go (fm:fms) q = case lookupFM fm q of Nothing -> go fms q -- look in other pkgs - Just package -> do- let hslibs = hsLibraries package- extras' = extraLibraries package+ Just pkg -> do+ let hslibs = hsLibraries pkg+ extras' = extraLibraries pkg cbits = filter (\e -> reverse (take (length "_cbits") (reverse e)) == "_cbits") extras' extras = filter (flip notElem cbits) extras'- ldopts = ldOptions package- deppkgs = packageDeps package+ ldopts = ldOptions pkg+ deppkgs = packageDeps pkg ldInput <- mapM classifyLdInput ldopts let ldOptsLibs = [ path | Just (DLL path) <- ldInput ] ldOptsPaths = [ path | Just (DLLPath path) <- ldInput ] dlls = map mkSOName (extras ++ ldOptsLibs) #if defined(CYGWIN) || defined(__MINGW32__)- libdirs = fix_topdir (libraryDirs package) ++ ldOptsPaths+ libdirs = fix_topdir (libraryDirs pkg) ++ ldOptsPaths #else- libdirs = libraryDirs package ++ ldOptsPaths+ libdirs = libraryDirs pkg ++ ldOptsPaths #endif -- If we're loading dynamic libs we need the cbits to appear before the -- real packages.@@ -454,10 +442,10 @@ replace_topdir (x:xs) = x : replace_topdir xs #endif -- a list elimination form for the Maybe type- filterRight :: [Either left right] -> [right]- filterRight [] = []- filterRight (Right x:xs) = x:filterRight xs- filterRight (Left _:xs) = filterRight xs+ --filterRight :: [Either left right] -> [right]+ --filterRight [] = []+ --filterRight (Right x:xs) = x:filterRight xs+ --filterRight (Left _:xs) = filterRight xs -- -- Check that a path to a library actually reaches a library
src/System/Plugins/Load.hs view
@@ -69,8 +69,7 @@ -- import Language.Hi.Parser import BinIface import HscTypes-import Module (moduleName, moduleNameString)-import PackageConfig (packageIdString)+import Module (moduleName, moduleNameString, packageIdString) import HscMain (newHscEnv) import TcRnMonad (initTcRnIf) @@ -97,7 +96,7 @@ readBinIface' hi_path = do -- kludgy as hell e <- newHscEnv undefined- initTcRnIf 'r' e undefined undefined (readBinIface hi_path)+ initTcRnIf 'r' e undefined undefined (readBinIface IgnoreHiWay QuietBinIFaceReading hi_path) -- TODO need a loadPackage p package.conf :: IO () primitive
src/System/Plugins/Make.hs view
@@ -75,7 +75,6 @@ , getModificationTime ) import Control.Exception ( handleJust )-import GHC.IOBase ( Exception(IOException) ) #if __GLASGOW_HASKELL__ >= 604 import System.IO.Error ( isDoesNotExistError )@@ -148,7 +147,7 @@ -- makeAll :: FilePath -> [Arg] -> IO MakeStatus makeAll src args = - rawMake src ( "--make":"-no-hs-main":"-no-link":"-v0":args ) False+ rawMake src ( "--make":"-no-hs-main":"-c":"-v0":args ) False -- | This is a variety of 'make' that first calls 'merge' to -- combine the plugin source with a syntax stub. The result is then@@ -295,7 +294,7 @@ -- does this work in the presence of hier plugins? -- won't handle hier names properly. - let ghc_opts = [ "-Onot" ]+ let ghc_opts = [ "-O0" ] output = [ "-o", obj, "-odir", odir, "-hidir", odir, "-i" ++ odir ] @@ -436,10 +435,9 @@ -- rm_f f = handleJust doesntExist (\_->return ()) (removeFile f) where- doesntExist (IOException ioe)+ doesntExist ioe | isDoesNotExistError ioe = Just () | otherwise = Nothing- doesntExist _ = Nothing readFile' f = do h <- openFile f ReadMode
src/System/Plugins/PackageAPI.hs view
@@ -40,7 +40,8 @@ #if CABAL == 1 || __GLASGOW_HASKELL__ >= 604 import Distribution.InstalledPackageInfo-import Distribution.Package hiding (depends, packageName)+import Distribution.Package hiding (depends, packageName, PackageName(..))+import Distribution.Text #else import System.Plugins.Package #endif@@ -57,9 +58,9 @@ type PackageConfig = InstalledPackageInfo -packageName = showPackageId . package+packageName = display . package packageName_ = pkgName . package-packageDeps = (map showPackageId) . depends+packageDeps = (map display) . depends updImportDirs f pk@(InstalledPackageInfo { importDirs = idirs }) = pk { importDirs = f idirs }
src/System/Plugins/Process.hs view
@@ -14,7 +14,7 @@ import qualified Posix as P #endif -import qualified Control.Exception+import qualified Control.OldException as E -- -- slight wrapper over popen for calls that don't care about stdin to the program@@ -38,7 +38,7 @@ -- popen :: FilePath -> [String] -> Maybe String -> IO (String,String,ProcessID) popen file args minput =- Control.Exception.handle (\e -> return ([],show e,error (show e))) $ do+ E.handle (\e -> return ([],show e, error (show e))) $ do (inp,out,err,pid) <- runInteractiveProcess file args Nothing Nothing @@ -55,8 +55,8 @@ -- data gets pulled as it becomes available. you have to force the -- output strings before waiting for the process to terminate. --- forkIO (Control.Exception.evaluate (length output) >> return ())- forkIO (Control.Exception.evaluate (length errput) >> return ())+ forkIO (E.evaluate (length output) >> return ())+ forkIO (E.evaluate (length errput) >> return ()) -- And now we wait. We must wait after we read, unsurprisingly. exitCode <- waitForProcess pid -- blocks without -threaded, you're warned.@@ -79,7 +79,7 @@ -- popen :: FilePath -> [String] -> Maybe String -> IO (String,String,P.ProcessID) popen f s m = - Control.Exception.handle (\e -> return ([], show e, error $ show e )) $ do+ E.handle (\e -> return ([], show e, error $ show e )) $ do x@(_,_,pid) <- P.popen f s m b <- P.getProcessStatus True False pid -- wait return $ case b of