From 7c50a8cb6cd8525d2184270151d44ed488bf19c4 Mon Sep 17 00:00:00 2001 From: Jeremy Shaw Date: Fri, 9 Oct 2015 19:35:06 -0500 Subject: [PATCH] convert tabs to spaces. strip trailing whitespace. --- src/System/Eval.hs | 13 +++---- src/System/Eval/Utils.hs | 1 - src/System/Plugins.hs | 13 +++---- src/System/Plugins/Consts.hs | 12 +++--- src/System/Plugins/Env.hs | 68 ++++++++++++++++---------------- src/System/Plugins/Load.hs | 2 +- src/System/Plugins/LoadTypes.hs | 10 ++--- src/System/Plugins/Make.hs | 69 ++++++++++++++++----------------- src/System/Plugins/Parser.hs | 40 +++++++++---------- src/System/Plugins/Process.hs | 6 +-- src/System/Plugins/Utils.hs | 29 +++++++------- 11 files changed, 129 insertions(+), 134 deletions(-) diff --git a/src/System/Eval.hs b/src/System/Eval.hs index 2c5d6a3..9580478 100644 --- a/src/System/Eval.hs +++ b/src/System/Eval.hs @@ -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-} - diff --git a/src/System/Eval/Utils.hs b/src/System/Eval/Utils.hs index 3294505..a27064b 100644 --- a/src/System/Eval/Utils.hs +++ b/src/System/Eval/Utils.hs @@ -93,4 +93,3 @@ mkUniqueWith wrapper src mods = do -- cleanup :: String -> String -> IO () cleanup a b = mapM_ removeFile [a, b, replaceSuffix b ".hi"] - diff --git a/src/System/Plugins.hs b/src/System/Plugins.hs index 2f4e603..737c402 100644 --- a/src/System/Plugins.hs +++ b/src/System/Plugins.hs @@ -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 @@ import System.Plugins.Load {-all-} -- -- [@NAME@] hs-plugins library : compile and load Haskell code at runtime -- - diff --git a/src/System/Plugins/Consts.hs b/src/System/Plugins/Consts.hs index 978d189..26a9b4b 100644 --- a/src/System/Plugins/Consts.hs +++ b/src/System/Plugins/Consts.hs @@ -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 @@ sysPkgPrefix = "HS" -- | '_' on a.out, and Darwin #if LEADING_UNDERSCORE == 1 -prefixUnderscore = "_" +prefixUnderscore = "_" #else prefixUnderscore = "" #endif diff --git a/src/System/Plugins/Env.hs b/src/System/Plugins/Env.hs index 415f525..70b09b0 100644 --- a/src/System/Plugins/Env.hs +++ b/src/System/Plugins/Env.hs @@ -429,37 +429,37 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p #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] @@ -477,31 +477,31 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p 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? diff --git a/src/System/Plugins/Load.hs b/src/System/Plugins/Load.hs index 3702271..aa56801 100644 --- a/src/System/Plugins/Load.hs +++ b/src/System/Plugins/Load.hs @@ -610,7 +610,7 @@ loadPackage p = do putStr (' ':show libs) >> hFlush stdout putStr (' ':show dlls) >> hFlush stdout #endif - mapM_ loadShared dlls + mapM_ loadShared dlls diff --git a/src/System/Plugins/LoadTypes.hs b/src/System/Plugins/LoadTypes.hs index 06fcd99..da96199 100644 --- a/src/System/Plugins/LoadTypes.hs +++ b/src/System/Plugins/LoadTypes.hs @@ -1,22 +1,22 @@ --- +-- -- Copyright (c) 2005 Lemmih -- 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 (..) diff --git a/src/System/Plugins/Make.hs b/src/System/Plugins/Make.hs index 4940db1..0017844 100644 --- a/src/System/Plugins/Make.hs +++ b/src/System/Plugins/Make.hs @@ -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 @@ module System.Plugins.Make ( MakeCode(..), -- * Compiling Haskell modules - make, + make, makeAll, - makeWith, + makeWith, -- * Handling reecompilation hasChanged, @@ -40,12 +40,12 @@ module System.Plugins.Make ( recompileAll, recompileAll', - -- * Merging together Haskell source files + -- * Merging together Haskell source files MergeStatus(..), MergeCode, Args, Errors, - merge, + merge, mergeTo, mergeToDir, @@ -88,16 +88,16 @@ import System.IO.Error ( isDoesNotExistError ) -- 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 @@ data MakeCode -- -- | 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 @@ type Errors = [String] -- 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 @@ make src args = rawMake src ("-c":args) True -- 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 @@ makeAll src args = -- > a = 1 -- -- and --- +-- -- > module B where -- > a :: Int -- @@ -176,7 +176,7 @@ makeAll src args = -- > 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 @@ hasChanged' suffices m@(Module {path = p}) _ -> 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 @@ rawMake src args docheck = do ; 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 @@ build src obj extra_opts = do -- 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 @@ build src obj extra_opts = do -- 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 @@ build src obj extra_opts = do -- 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 @@ merge src stb = do 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 @@ rawMerge src stb out always_merge = do 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 @@ rawMerge src stb out always_merge = do 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 @@ makeClean f = let f_hi = dropSuffix f <> hiSuf 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 @@ readFile' f = do length s `seq` return () hClose h return s - diff --git a/src/System/Plugins/Parser.hs b/src/System/Plugins/Parser.hs index 556343e..9970359 100644 --- a/src/System/Plugins/Parser.hs +++ b/src/System/Plugins/Parser.hs @@ -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 @@ module System.Plugins.Parser ( #include "../../../config.h" -import Data.List +import Data.List import Data.Char import Data.Either ( ) @@ -41,12 +41,12 @@ import Language.Haskell.Pretty -- -- | 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 @@ parse f fsrc = 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 -> -- Configure module 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 @@ mImps :: Module -> -- plugin module name [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 @@ class SynEq a where (=~) :: 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 @@ instance SynEq HsImportDecl where -- 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 diff --git a/src/System/Plugins/Process.hs b/src/System/Plugins/Process.hs index c9da315..62a6f04 100644 --- a/src/System/Plugins/Process.hs +++ b/src/System/Plugins/Process.hs @@ -79,11 +79,11 @@ popen file args minput = -- 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 diff --git a/src/System/Plugins/Utils.hs b/src/System/Plugins/Utils.hs index f754157..1d2d124 100644 --- a/src/System/Plugins/Utils.hs +++ b/src/System/Plugins/Utils.hs @@ -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 @@ hWrite hdl src = hPutStr hdl src >> hClose hdl >> return () {- -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 @@ mkUnique = do (t,h) <- hMkUnique 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 @@ isPathSeparator ch = -- 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 @@ replaceSuffix f suf = -- 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 @@ outFilePath src args = | otherwise -> (mk_o src, mk_hi src) } - where + where outpath = "-o" outdir = "-odir" @@ -414,7 +414,7 @@ decode_upper 'N' = ']' 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 _ [] = False isSublistOf x y@(_:ys) | isPrefixOf x y = True | otherwise = isSublistOf x ys -