plugins 1.5.4.0 → 1.5.5.0
raw patch · 12 files changed
+173/−160 lines, 12 filesdep ~Cabaldep ~basedep ~ghc
Dependency ranges changed: Cabal, base, ghc
Files
- plugins.cabal +11/−2
- src/System/Eval.hs +6/−7
- src/System/Eval/Utils.hs +0/−1
- src/System/Plugins.hs +6/−7
- src/System/Plugins/Consts.hs +6/−6
- src/System/Plugins/Env.hs +60/−57
- src/System/Plugins/Load.hs +8/−2
- src/System/Plugins/LoadTypes.hs +5/−5
- src/System/Plugins/Make.hs +34/−35
- src/System/Plugins/Parser.hs +20/−20
- src/System/Plugins/Process.hs +3/−3
- src/System/Plugins/Utils.hs +14/−15
plugins.cabal view
@@ -1,5 +1,5 @@ name: plugins-version: 1.5.4.0+version: 1.5.5.0 homepage: http://hub.darcs.net/stepcut/plugins synopsis: Dynamic linking for Haskell and C objects description: Dynamic linking and runtime evaluation of Haskell,@@ -20,7 +20,12 @@ maintainer: Jeremy Shaw <jeremy@seereason.com> cabal-version: >= 1.6 build-type: Configure-Tested-with: GHC >= 6.12.1+Tested-with: GHC == 7.0.*+-- not working , GHC == 7.2.*+ , GHC == 7.4.*+ , GHC == 7.6.*+ , GHC == 7.8.*+ , GHC == 7.10.* extra-source-files: config.guess, config.h.in, config.mk.in, config.sub, configure, configure.ac, install.sh, Makefile, testsuite/makewith/io/TestIO.conf.in,@@ -59,3 +64,7 @@ if impl(ghc >= 7.2) build-depends: ghc-paths++source-repository head+ type: git+ location: https://github.com/stepcut/plugins
src/System/Eval.hs view
@@ -1,25 +1,24 @@--- +-- -- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons--- +-- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version.--- +-- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details.--- +-- -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -- USA--- +-- -module System.Eval ( +module System.Eval ( module System.Eval.Haskell, ) where import System.Eval.Haskell {-all-}-
src/System/Eval/Utils.hs view
@@ -93,4 +93,3 @@ -- cleanup :: String -> String -> IO () cleanup a b = mapM_ removeFile [a, b, replaceSuffix b ".hi"]-
src/System/Plugins.hs view
@@ -1,23 +1,23 @@--- +-- -- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons--- +-- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version.--- +-- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details.--- +-- -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -- USA--- +-- -module System.Plugins ( +module System.Plugins ( -- $Description @@ -34,4 +34,3 @@ -- -- [@NAME@] hs-plugins library : compile and load Haskell code at runtime ---
src/System/Plugins/Consts.hs view
@@ -1,22 +1,22 @@ {-# LANGUAGE CPP #-}--- +-- -- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons--- +-- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version.--- +-- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details.--- +-- -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -- USA--- +-- module System.Plugins.Consts where @@ -60,7 +60,7 @@ -- | '_' on a.out, and Darwin #if LEADING_UNDERSCORE == 1-prefixUnderscore = "_" +prefixUnderscore = "_" #else prefixUnderscore = "" #endif
src/System/Plugins/Env.hs view
@@ -1,22 +1,22 @@ {-# LANGUAGE CPP #-} -- -- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons--- +-- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version.--- +-- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details.--- +-- -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -- USA--- +-- module System.Plugins.Env ( env,@@ -69,11 +69,14 @@ import Control.Concurrent.MVar ( MVar(), newMVar, withMVar ) -import Distribution.Package hiding (depends, packageName, PackageName(..))+import Distribution.Package hiding (depends, packageName, PackageName(..)+#if MIN_VERSION_ghc(7,10,0)+ , installedPackageId+#endif+ ) import Distribution.Text import Distribution.InstalledPackageInfo--- import Distribution.Package hiding (packageName, PackageName(..)) import Distribution.Simple.Compiler import Distribution.Simple.GHC import Distribution.Simple.PackageIndex@@ -93,7 +96,7 @@ addToFM :: (Ord key) => FiniteMap key elt -> key -> elt -> FiniteMap key elt addToFM = \m k e -> M.insert k e m -addWithFM :: (Ord key) +addWithFM :: (Ord key) => (elt -> elt -> elt) -> FiniteMap key elt -> key -> elt -> FiniteMap key elt addWithFM = \comb m k e -> M.insertWith comb k e m @@ -147,9 +150,9 @@ -- multiple package.conf's kept in separate namespaces type PkgEnvs = [PkgEnv] -type Env = (MVar (), +type Env = (MVar (), IORef ModEnv,- IORef DepEnv, + IORef DepEnv, IORef PkgEnvs, IORef StaticPkgEnv, IORef MergeEnv)@@ -160,7 +163,7 @@ -- packages and their informations. Initially all we know is the default -- package.conf information. ---env = unsafePerformIO $ do +env = unsafePerformIO $ do mvar <- newMVar () ref1 <- newIORef emptyFM -- loaded objects ref2 <- newIORef emptyFM@@ -202,10 +205,10 @@ modifyStaticPkgEnv :: Env -> (StaticPkgEnv -> IO StaticPkgEnv) -> IO () modifyMerged :: Env -> (MergeEnv -> IO MergeEnv)-> IO () -modifyModEnv (mvar,ref,_,_,_,_) f = lockAndWrite mvar ref f -modifyDepEnv (mvar,_,ref,_,_,_) f = lockAndWrite mvar ref f -modifyPkgEnv (mvar,_,_,ref,_,_) f = lockAndWrite mvar ref f -modifyStaticPkgEnv (mvar,_,_,_,ref,_) f = lockAndWrite mvar ref f +modifyModEnv (mvar,ref,_,_,_,_) f = lockAndWrite mvar ref f+modifyDepEnv (mvar,_,ref,_,_,_) f = lockAndWrite mvar ref f+modifyPkgEnv (mvar,_,_,ref,_,_) f = lockAndWrite mvar ref f+modifyStaticPkgEnv (mvar,_,_,_,ref,_) f = lockAndWrite mvar ref f modifyMerged (mvar,_,_,_,_,ref) f = lockAndWrite mvar ref f -- private@@ -285,7 +288,7 @@ -- stored in the environment. -- addPkgConf :: FilePath -> IO ()-addPkgConf f = do +addPkgConf f = do ps <- readPackageConf f modifyPkgEnv env $ \ls -> return $ union ls ps @@ -295,22 +298,22 @@ -- GHC 6.12) -- union :: PkgEnvs -> [PackageConfig] -> PkgEnvs-union ls ps' = +union ls ps' = let fm = emptyFM -- new FM for this package.conf in foldr addOnePkg fm ps' : ls- where + where -- we add each package with and without it's version number and with the full installedPackageId addOnePkg p fm' = addToPkgEnvs (addToPkgEnvs (addToPkgEnvs fm' (display $ sourcePackageId p) p) (display $ installedPackageId p) p) (packageName p) p- + -- if no version number specified, pick the higher version addToPkgEnvs = addWithFM higherVersion - higherVersion pkgconf1 pkgconf2 + higherVersion pkgconf1 pkgconf2 | installedPackageId pkgconf1 >= installedPackageId pkgconf2 = pkgconf1 | otherwise = pkgconf2- --- ++-- -- | generate a PkgEnv from the system package.conf -- The path to the default package.conf was determined by /configure/ -- This imposes a constraint that you must build your plugins with the@@ -364,7 +367,7 @@ lookupPkg pn = go [] pn where go :: [PackageName] -> PackageName -> IO ([FilePath],[FilePath])- go seen p = do + go seen p = do (ps, (f, g)) <- lookupPkg' p static <- isStaticPkg p (f', g') <- liftM unzip $ mapM (go (nub $ seen ++ ps)) (ps \\ seen)@@ -426,37 +429,37 @@ #else libdirs = libraryDirs pkg ++ ldOptsPaths #endif- -- If we're loading dynamic libs we need the cbits to appear before the- -- real packages.+ -- If we're loading dynamic libs we need the cbits to appear before the+ -- real packages. libs <- mapM (findHSlib libdirs) (cbits ++ hslibs) #if defined(CYGWIN) || defined(__MINGW32__) windowsos <- catch (getEnv "OS")- (\e -> if isDoesNotExistError e then return "Windows_98" else ioError e)+ (\e -> if isDoesNotExistError e then return "Windows_98" else ioError e) windowsdir <- if windowsos == "Windows_9X" -- I don't know Windows 9X has OS system variable then return "C:/windows" else return "C:/winnt" sysroot <- catch (getEnv "SYSTEMROOT")- (\e -> if isDoesNotExistError e then return windowsdir else ioError e) -- guess at a reasonable default- let syslibdir = sysroot ++ (if windowsos == "Windows_9X" then "/SYSTEM" else "/SYSTEM32")- libs' <- mapM (findDLL $ syslibdir : libdirs) dlls+ (\e -> if isDoesNotExistError e then return windowsdir else ioError e) -- guess at a reasonable default+ let syslibdir = sysroot ++ (if windowsos == "Windows_9X" then "/SYSTEM" else "/SYSTEM32")+ libs' <- mapM (findDLL $ syslibdir : libdirs) dlls #else- libs' <- mapM (findDLL libdirs) dlls+ libs' <- mapM (findDLL libdirs) dlls #endif- let slibs = [ lib | Right (Static lib) <- libs ]- dlibs = [ lib | Right (Dynamic lib) <- libs ]+ let slibs = [ lib | Right (Static lib) <- libs ]+ dlibs = [ lib | Right (Dynamic lib) <- libs ] return (deppkgs, (slibs,map (either id id) libs' ++ dlibs) ) #if defined(CYGWIN) || defined(__MINGW32__) -- replace $topdir- fix_topdir [] = []- fix_topdir (x:xs) = replace_topdir x : fix_topdir xs+ fix_topdir [] = []+ fix_topdir (x:xs) = replace_topdir x : fix_topdir xs replace_topdir [] = []- replace_topdir ('$':xs) - | take 6 xs == "topdir" = ghcLibraryPath ++ (drop 6 xs)- | otherwise = '$' : replace_topdir xs- replace_topdir (x:xs) = x : replace_topdir xs+ replace_topdir ('$':xs)+ | take 6 xs == "topdir" = ghcLibraryPath ++ (drop 6 xs)+ | otherwise = '$' : replace_topdir xs+ replace_topdir (x:xs) = x : replace_topdir xs #endif -- a list elimination form for the Maybe type --filterRight :: [Either left right] -> [right]@@ -474,31 +477,31 @@ if b then return $ Just l -- found it! else findHSlib' dirs lib - findHSslib dirs lib = findHSlib' dirs $ lib ++ sysPkgSuffix- findHSdlib dirs lib = findHSlib' dirs $ mkDynPkgName lib+ findHSslib dirs lib = findHSlib' dirs $ lib ++ sysPkgSuffix+ findHSdlib dirs lib = findHSlib' dirs $ mkDynPkgName lib -- Problem: sysPkgSuffix is ".o", but extra libraries could be -- ".so" -- Solution: first look for static library, if we don't find it- -- look for a dynamic version.- findHSlib :: [FilePath] -> String -> IO (Either String HSLib)- findHSlib dirs lib = do- static <- findHSslib dirs lib- case static of- Just file -> return $ Right $ Static file- Nothing -> do- dynamic <- findHSdlib dirs lib- case dynamic of- Just file -> return $ Right $ Dynamic file- Nothing -> return $ Left lib+ -- look for a dynamic version.+ findHSlib :: [FilePath] -> String -> IO (Either String HSLib)+ findHSlib dirs lib = do+ static <- findHSslib dirs lib+ case static of+ Just file -> return $ Right $ Static file+ Nothing -> do+ dynamic <- findHSdlib dirs lib+ case dynamic of+ Just file -> return $ Right $ Dynamic file+ Nothing -> return $ Left lib findDLL :: [FilePath] -> String -> IO (Either String FilePath)- findDLL [] lib = return (Left lib)- findDLL (dir:dirs) lib = do- let l = dir </> lib- b <- doesFileExist l- if b then return $ Right l- else findDLL dirs lib+ findDLL [] lib = return (Left lib)+ findDLL (dir:dirs) lib = do+ let l = dir </> lib+ b <- doesFileExist l+ if b then return $ Right l+ else findDLL dirs lib ------------------------------------------------------------------------ -- do we have a Module name for this merge?@@ -533,7 +536,7 @@ -packageName :: PackageConfig -> PackageName +packageName :: PackageConfig -> PackageName packageDeps :: PackageConfig -> [PackageName] -- updImportDirs :: ([FilePath] -> [FilePath]) -> PackageConfig -> PackageConfig -- updLibraryDirs :: ([FilePath] -> [FilePath]) -> PackageConfig -> PackageConfig
src/System/Plugins/Load.hs view
@@ -72,7 +72,11 @@ -- import Language.Hi.Parser import BinIface import HscTypes+#if MIN_VERSION_ghc(7,10,0)+import Module (moduleName, moduleNameString, packageKeyString)+#else import Module (moduleName, moduleNameString, packageIdString)+#endif import HscMain (newHscEnv) import TcRnMonad (initTcRnIf) @@ -606,7 +610,7 @@ putStr (' ':show libs) >> hFlush stdout putStr (' ':show dlls) >> hFlush stdout #endif- mapM_ loadShared dlls+ mapM_ loadShared dlls @@ -701,7 +705,9 @@ -- and find some packages to load, as well. let ps = dep_pkgs ds-#if MIN_VERSION_ghc(7,2,0)+#if MIN_VERSION_ghc(7,10,0)+ ps' <- filterM loaded . map packageKeyString . nub $ map fst ps+#elif MIN_VERSION_ghc(7,2,0) ps' <- filterM loaded . map packageIdString . nub $ map fst ps #else ps' <- filterM loaded . map packageIdString . nub $ ps
src/System/Plugins/LoadTypes.hs view
@@ -1,22 +1,22 @@--- +-- -- Copyright (c) 2005 Lemmih <lemmih@gmail.com> -- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons--- +-- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as -- published by the Free Software Foundation; either version 2 of -- the License, or (at your option) any later version.--- +-- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- General Public License for more details.--- +-- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA.--- +-- module System.Plugins.LoadTypes ( Key (..)
src/System/Plugins/Make.hs view
@@ -1,27 +1,27 @@ {-# LANGUAGE CPP #-}--- +-- -- Copyright (C) 2004..2010 Don Stewart - http://www.cse.unsw.edu.au/~dons--- +-- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version.--- +-- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details.--- +-- -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -- USA--- +-- -- | An interface to a Haskell compiler, providing the facilities of a -- compilation manager. -module System.Plugins.Make ( +module System.Plugins.Make ( -- * The @MakeStatus@ type MakeStatus(..),@@ -30,9 +30,9 @@ MakeCode(..), -- * Compiling Haskell modules- make, + make, makeAll,- makeWith, + makeWith, -- * Handling reecompilation hasChanged,@@ -40,12 +40,12 @@ recompileAll, recompileAll', - -- * Merging together Haskell source files + -- * Merging together Haskell source files MergeStatus(..), MergeCode, Args, Errors,- merge, + merge, mergeTo, mergeToDir, @@ -88,16 +88,16 @@ -- messages produced by the compiler. @MakeSuccess@ returns a @MakeCode@ -- value, and the path to the object file produced. ---data MakeStatus +data MakeStatus = MakeSuccess MakeCode FilePath -- ^ compilation was successful | MakeFailure Errors -- ^ compilation failed deriving (Eq,Show) -- | The @MakeCode@ type is used when compilation is successful, to--- distinguish two cases: +-- distinguish two cases: -- * The source file needed recompiling, and this was done -- * The source file was already up to date, recompilation was skipped-data MakeCode +data MakeCode = ReComp -- ^ recompilation was performed | NotReq -- ^ recompilation was not required deriving (Eq,Show)@@ -105,12 +105,12 @@ -- -- | An equivalent status for the preprocessor phase ---data MergeStatus +data MergeStatus = MergeSuccess MergeCode Args FilePath -- ^ the merge was successful | MergeFailure Errors -- ^ failure, and any errors returned deriving (Eq,Show) --- +-- -- | Merging may be avoided if the source files are older than an -- existing merged result. The @MergeCode@ type indicates whether -- merging was performed, or whether it was unneccessary.@@ -131,7 +131,7 @@ -- in the 'args' parameter, they will be appended to the argument list. -- @make@ always recompiles its target, whether or not it is out of -- date.--- +-- -- A side-effect of calling 'make' is to have GHC produce a @.hi@ file -- containing a list of package and objects that the source depends on. -- Subsequent calls to 'load' will use this interface file to load@@ -147,7 +147,7 @@ -- the first argument. -- makeAll :: FilePath -> [Arg] -> IO MakeStatus-makeAll src args = +makeAll src args = rawMake src ( "--make":"-no-hs-main":"-c":"-v0":args ) False -- | This is a variety of 'make' that first calls 'merge' to@@ -163,7 +163,7 @@ -- > a = 1 -- -- and--- +-- -- > module B where -- > a :: Int --@@ -176,7 +176,7 @@ -- > a :: Int -- > {-# LINE 4 "A.hs" #-} -- > a = 1--- +-- makeWith :: FilePath -- ^ a src file -> FilePath -- ^ a syntax stub file -> [Arg] -- ^ any required args@@ -215,7 +215,7 @@ _ -> return True ----- | 'recompileAll' is like 'makeAll', but rather than relying on +-- | 'recompileAll' is like 'makeAll', but rather than relying on -- @ghc --make@, we explicitly check a module\'s dependencies using our -- internal map of module dependencies. Performance is thus better, and -- the result is more accurate.@@ -265,16 +265,16 @@ ; src_changed <- if docheck then src `newer` obj else return True ; if not src_changed then return $ MakeSuccess NotReq obj- else do -#if DEBUG + else do+#if DEBUG putStr "Compiling object ... " >> hFlush stdout #endif err <- build src obj args-#if DEBUG +#if DEBUG putStrLn "done" #endif- return $ if null err - then MakeSuccess ReComp obj + return $ if null err+ then MakeSuccess ReComp obj else MakeFailure err } @@ -296,7 +296,7 @@ -- won't handle hier names properly. let ghc_opts = [ "-O0" ]- output = [ "-o", obj, "-odir", odir, + output = [ "-o", obj, "-odir", odir, "-hidir", odir, "-i" ++ odir ] let flags = ghc_opts ++ output ++ extra_opts ++ [src]@@ -322,7 +322,7 @@ -- syntax. An EDSL user then need not worry about declaring module -- names, or having required imports. In this way, the stub file can -- also be used to provide syntax declarations that would be--- inconvenient to require of the plugin author. +-- inconvenient to require of the plugin author. -- -- 'merge' will include any import and export declarations written in -- the stub, as well as any module name, so that plugin author\'s need@@ -337,7 +337,7 @@ -- parse Haskell source files. -- merge :: FilePath -> FilePath -> IO MergeStatus-merge src stb = do +merge src stb = do m_mod <- lookupMerged src stb (out,domerge) <- case m_mod of Nothing -> do out <- mkUnique@@ -347,7 +347,7 @@ rawMerge src stb out domerge -- | 'mergeTo' behaves like 'merge', but we can specify the file in--- which to place output. +-- which to place output. mergeTo :: FilePath -> FilePath -> FilePath -> IO MergeStatus mergeTo src stb out = rawMerge src stb out False @@ -378,12 +378,12 @@ src_exists <- doesFileExist src stb_exists <- doesFileExist stb case () of {_- | not src_exists -> return $ + | not src_exists -> return $ MergeFailure ["Source file does not exist : "++src]- | not stb_exists -> return $ + | not stb_exists -> return $ MergeFailure ["Source file does not exist : "++stb] | otherwise -> do {- + ;do_merge <- do src_changed <- src `newer` out stb_changed <- stb `newer` out return $ src_changed || stb_changed@@ -400,7 +400,7 @@ let e_src_syn = parse src src_str e_stb_syn = parse stb stb_str- + -- check if there were parser errors case (e_src_syn,e_stb_syn) of (Left e, _) -> return $ MergeFailure [e]@@ -429,7 +429,7 @@ makeCleaner :: FilePath -> IO () makeCleaner f = makeClean f >> rm_f (dropSuffix f <> hsSuf)- + -- internal: -- try to remove a file, ignoring if it didn't exist in the first place -- Doesn't seem to be able to remove all files in all circumstances, why?@@ -446,4 +446,3 @@ length s `seq` return () hClose h return s-
src/System/Plugins/Parser.hs view
@@ -1,25 +1,25 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-}--- +-- -- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons--- +-- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as -- published by the Free Software Foundation; either version 2 of -- the License, or (at your option) any later version.--- +-- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- General Public License for more details.--- +-- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA.--- +-- -module System.Plugins.Parser ( +module System.Plugins.Parser ( parse, mergeModules, pretty, parsePragmas, HsModule(..) , replaceModName@@ -27,7 +27,7 @@ #include "../../../config.h" -import Data.List +import Data.List import Data.Char import Data.Either ( ) @@ -41,12 +41,12 @@ -- -- | parse a file (as a string) as Haskell src--- +-- parse :: FilePath -- ^ module name -> String -- ^ haskell src -> Either String HsModule -- ^ abstract syntax -parse f fsrc = +parse f fsrc = #if defined(WITH_HSX) case parseFileContentsWithMode (ParseMode f) fsrc of #else@@ -55,8 +55,8 @@ ParseOk src -> Right src ParseFailed loc _ -> Left $ srcmsg loc where- srcmsg loc = "parse error in " ++ f ++ "\n" ++ - "line: " ++ (show $ srcLine loc) ++ + srcmsg loc = "parse error in " ++ f ++ "\n" +++ "line: " ++ (show $ srcLine loc) ++ ", col: " ++ (show $ srcColumn loc)++ "\n" --@@ -88,23 +88,23 @@ mergeModules (HsModule l _ _ is ds ) (HsModule _ m' es' is' ds')- = (HsModule l m' es' - (mImps m' is is') + = (HsModule l m' es'+ (mImps m' is is') (mDecl ds ds') ) --- +-- -- | replace Module name with String. -- replaceModName :: HsModule -> String -> HsModule replaceModName (HsModule l _ es is ds) nm = (HsModule l (Module nm) es is ds) --- +-- -- | merge import declarations: -- -- * ensure that the config file doesn't import the stub name -- * merge import lists uniquely, and when they match, merge their decls ----- TODO * we don't merge imports of the same module from both files. +-- TODO * we don't merge imports of the same module from both files. -- We should, and then merge the decls in their import list -- * rename args, too confusing. --@@ -115,9 +115,9 @@ [HsImportDecl] -> -- stub file imports [HsImportDecl] -mImps plug_mod cimps timps = +mImps plug_mod cimps timps = case filter (!~ self) cimps of cimps' -> unionBy (=~) cimps' timps- where + where self = ( HsImportDecl undefined plug_mod undefined undefined undefined ) --@@ -152,7 +152,7 @@ (=~) :: a -> a -> Bool (!~) :: a -> a -> Bool n !~ m = not (n =~ m)- + instance SynEq HsDecl where (HsPatBind _ (HsPVar n) _ _) =~ (HsPatBind _ (HsPVar m) _ _) = n == m (HsTypeSig _ (n:_) _) =~ (HsTypeSig _ (m:_) _) = n == m@@ -170,7 +170,7 @@ -- handle -package options, and other /static/ flags. This is more than -- GHC. ----- GHC user's guide : +-- GHC user's guide : -- -- > OPTIONS pragmas are only looked for at the top of your source -- > files, up to the first (non-literate,non-empty) line not
src/System/Plugins/Process.hs view
@@ -79,11 +79,11 @@ -- generate 1000s of lines of output. -- popen :: FilePath -> [String] -> Maybe String -> IO (String,String,P.ProcessID)-popen f s m = +popen f s m = E.handle (\e -> return ([], show (e::IOException), error $ show e )) $ do- x@(_,_,pid) <- P.popen f s m + x@(_,_,pid) <- P.popen f s m b <- P.getProcessStatus True False pid -- wait- return $ case b of + return $ case b of Nothing -> ([], "process has disappeared", pid) _ -> x
src/System/Plugins/Utils.hs view
@@ -1,24 +1,24 @@ {-# LANGUAGE CPP, ScopedTypeVariables #-}--- +-- -- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons--- +-- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version.--- +-- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details.--- +-- -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -- USA--- +-- -module System.Plugins.Utils ( +module System.Plugins.Utils ( Arg, hWrite,@@ -104,7 +104,7 @@ {- -mkstemps path slen = do +mkstemps path slen = do withCString path $ \ ptr -> do let c_slen = fromIntegral $ slen+1 fd <- throwErrnoIfMinus1 "mkstemps" $ c_mkstemps ptr c_slen@@ -148,18 +148,18 @@ hMkUnique :: IO (FilePath,Handle) hMkUnique = do (t,h) <- mkTemp alreadyLoaded <- isLoaded t -- not unique!- if alreadyLoaded + if alreadyLoaded then hClose h >> removeFile t >> hMkUnique else return (t,h) mkUniqueIn :: FilePath -> IO FilePath mkUniqueIn dir = do (t,h) <- hMkUniqueIn dir- hClose h >> return t+ hClose h >> return t hMkUniqueIn :: FilePath -> IO (FilePath,Handle) hMkUniqueIn dir = do (t,h) <- mkTempIn dir alreadyLoaded <- isLoaded t -- not unique!- if alreadyLoaded + if alreadyLoaded then hClose h >> removeFile t >> hMkUniqueIn dir else return (t,h) @@ -307,7 +307,7 @@ -- replaceSuffix :: FilePath -> String -> FilePath replaceSuffix [] _ = [] -- ?-replaceSuffix f suf = +replaceSuffix f suf = case reverse $ dropWhile (/= '.') $ reverse f of [] -> f ++ suf -- no '.' in file name f' -> f' ++ tail suf@@ -316,7 +316,7 @@ -- Normally we create the .hi and .o files next to the .hs files. -- For some uses this is annoying (i.e. true EDSL users don't actually -- want to know that their code is compiled at all), and for hmake-like--- applications. +-- applications. -- -- This code checks if "-o foo" or "-odir foodir" are supplied as args -- to make(), and if so returns a modified file path, otherwise it@@ -337,7 +337,7 @@ | otherwise -> (mk_o src, mk_hi src) }- where + where outpath = "-o" outdir = "-odir" @@ -414,7 +414,7 @@ decode_upper 'C' = ':' decode_upper 'Z' = 'Z' decode_upper ch = error $ "decode_upper can't handle this char `"++[ch]++"'"- + decode_lower 'z' = 'z' decode_lower 'a' = '&' decode_lower 'b' = '|'@@ -505,4 +505,3 @@ isSublistOf x y@(_:ys) | isPrefixOf x y = True | otherwise = isSublistOf x ys-