diff --git a/packages/test/src/SDist.hs b/packages/test/src/SDist.hs index ae8b4ea3..dcfda040 100644 --- a/packages/test/src/SDist.hs +++ b/packages/test/src/SDist.hs @@ -4,12 +4,12 @@ import Shell import System.FilePath import System.Directory (setCurrentDirectory) import System.Process -import System.IO.Error import System.Exit import Data.Ord import Data.List import Data.Maybe import Control.Applicative +import Control.Exception import Control.Monad.IO.Class -- Test whether the tarballs are distribution-ready by calling `cabal sdist`, merging the tarballs into one umbrella directory and building and testing in this directory. @@ -88,11 +88,14 @@ testWithBootstrapping dir executable = do cabalSdistAll :: [String] -> String -> TypedShell [String] cabalSdistAll packageNames baseDir = do liftIO $ setCurrentDirectory baseDir - output <- liftIO $ readProcess "cabal" ["sdist", "all"] "" `catchIOError` const (return "") + output <- liftIO $ readProcess "cabal" ["sdist", "all"] "" `catchIO` const (return "") let fullNames = catMaybes . catMaybes $ map extractFullName $ lines output let matched = catMaybes $ map (bestMatch fullNames) packageNames if length packageNames == length matched then return matched else empty where + catchIO :: IO a -> (IOError -> IO a) -> IO a + catchIO = Control.Exception.catch + -- Find package-name-VERSION matching to package-name. -- Note: we cannot just use `isPrefixOf` because then `happy` would match to `happy-frontend-1.21.0`! bestMatch fullNames packageName = head' $ sortBy (comparing numPrefixMatches) prefixMatches where diff --git a/packages/test/src/Test.hs b/packages/test/src/Test.hs index ea721a74..e8ebda68 100644 --- a/packages/test/src/Test.hs +++ b/packages/test/src/Test.hs @@ -73,10 +73,10 @@ runSingleTest happy arguments dir testFile = do tryRemovingFile :: FilePath -> IO () tryRemovingFile file = do - removeFile file `catch` doNothing + removeFile file `catchIO` const (return ()) where - doNothing :: IOError -> IO () - doNothing _ = return () + catchIO :: IO a -> (IOError -> IO a) -> IO a + catchIO = Control.Exception.catch -- Only works for .y and .ly files. basename :: FilePath -> FilePath