From 1251817b77befa644217682806c5aa226c1adf50 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 6 Nov 2012 22:25:51 +0100
Subject: [PATCH] Fix compatibility with newer Haskell libraries
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This small patch fixes compatibility with a few newer Haskell libraries:
- base 4.6, included with ghc 7.6, removed the deprecated 'catch'
function from Prelude, so our "import Prelude hiding (catch)" is now
an error; we workaround by using fully-qualified
Control.Exception.catch name
- containers 0.5 changed the signature of 'deleteFindMax'; we
workaround by using separate 'findMax' and 'deleteMax'
- QuickCheck 2.5 removed the 'maxDiscards' test parameter, replacing
it with a much better 'maxDiscardsRatio'; however, until we can
depend on that, we workaround by just removing it (we don't control
anymore the maxDiscards, instead leaving it default; for our default
test size, this is no change, as the default value is already 500,
which is our default as well) and not printing it anymore
Tested on Squeeze (+extra libs), Wheezy and experimental, which covers
all supported GHC versions.
Also, merging this in master will be a pain, but unless we want to
stop supporting 2.6β¦
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htools/Ganeti/Confd/Server.hs | 7 ++++---
htools/Ganeti/Daemon.hs | 9 +++++----
htools/Ganeti/HTools/ExtLoader.hs | 4 ++--
htools/Ganeti/HTools/QC.hs | 3 ++-
htools/Ganeti/HTools/Rapi.hs | 5 ++---
htools/Ganeti/Ssconf.hs | 4 ++--
htools/htools.hs | 1 -
htools/test.hs | 6 ++----
8 files changed, 19 insertions(+), 20 deletions(-)
diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs
index f0ef0f290..149976252 100644
--- a/htools/Ganeti/Confd/Server.hs
+++ b/htools/Ganeti/Confd/Server.hs
@@ -37,7 +37,6 @@ import Data.IORef
import Data.List
import qualified Data.Map as M
import qualified Network.Socket as S
-import Prelude hiding (catch)
import System.Posix.Files
import System.Posix.Types
import System.Time
@@ -307,7 +306,8 @@ updateConfig path r = do
-- | Wrapper over 'updateConfig' that handles IO errors.
safeUpdateConfig :: FilePath -> FStat -> CRef -> IO (FStat, ConfigReload)
safeUpdateConfig path oldfstat cref = do
- catch (do
+ Control.Exception.catch
+ (do
nt <- needsReload oldfstat path
case nt of
Nothing -> return (oldfstat, ConfigToDate)
@@ -430,7 +430,8 @@ onReloadInner inotiaction path cref
-- it will return False.
addNotifier :: INotify -> FilePath -> CRef -> MVar ServerState -> IO Bool
addNotifier inotify path cref mstate = do
- catch (addWatch inotify [CloseWrite] path
+ Control.Exception.catch
+ (addWatch inotify [CloseWrite] path
(onInotify inotify path cref mstate) >> return True)
(\e -> const (return False) (e::IOError))
diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs
index c6708f13f..f9848234b 100644
--- a/htools/Ganeti/Daemon.hs
+++ b/htools/Ganeti/Daemon.hs
@@ -48,7 +48,6 @@ import qualified Data.Version
import Data.Word
import GHC.IO.Handle (hDuplicateTo)
import qualified Network.Socket as Socket
-import Prelude hiding (catch)
import System.Console.GetOpt
import System.Exit
import System.Environment
@@ -218,7 +217,8 @@ formatIOError msg err = msg ++ ": " ++ show err
-- 'Bad' value.
writePidFile :: FilePath -> IO (Result Fd)
writePidFile path = do
- catch (fmap Ok $ _writePidFile path)
+ Control.Exception.catch
+ (fmap Ok $ _writePidFile path)
(return . Bad . formatIOError "Failure during writing of the pid file")
-- | Sets up a daemon's environment.
@@ -282,8 +282,9 @@ parseAddress opts defport = do
def_family <- Ssconf.getPrimaryIPFamily Nothing
ainfo <- case optBindAddress opts of
Nothing -> return (def_family >>= defaultBindAddr port)
- Just saddr -> catch (resolveAddr port saddr)
- (annotateIOError $ "Invalid address " ++ saddr)
+ Just saddr -> Control.Exception.catch
+ (resolveAddr port saddr)
+ (annotateIOError $ "Invalid address " ++ saddr)
return ainfo
-- | Run an I/O action as a daemon.
diff --git a/htools/Ganeti/HTools/ExtLoader.hs b/htools/Ganeti/HTools/ExtLoader.hs
index bd258f5f3..69248d639 100644
--- a/htools/Ganeti/HTools/ExtLoader.hs
+++ b/htools/Ganeti/HTools/ExtLoader.hs
@@ -36,7 +36,6 @@ module Ganeti.HTools.ExtLoader
import Control.Monad
import Control.Exception
import Data.Maybe (isJust, fromJust)
-import Prelude hiding (catch)
import System.FilePath
import System.IO
import Text.Printf (hPrintf)
@@ -55,7 +54,8 @@ import Ganeti.HTools.Utils (sepSplit, tryRead, exitIfBad, exitWhen)
-- | Error beautifier.
wrapIO :: IO (Result a) -> IO (Result a)
-wrapIO = flip catch (\e -> return . Bad . show $ (e::IOException))
+wrapIO = flip Control.Exception.catch
+ (\e -> return . Bad . show $ (e::IOException))
-- | Parses a user-supplied utilisation string.
parseUtilisation :: String -> Result (String, DynUtil)
diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index c00e22d15..133b0db8d 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -1363,7 +1363,8 @@ prop_ClusterAllocBalance =
forAll (choose (3, 5)) $ \count ->
not (Node.offline node) && not (Node.failN1 node) ==>
let nl = makeSmallCluster node count
- (hnode, nl') = IntMap.deleteFindMax nl
+ hnode = snd $ IntMap.findMax nl
+ nl' = IntMap.deleteMax nl
il = Container.empty
allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
diff --git a/htools/Ganeti/HTools/Rapi.hs b/htools/Ganeti/HTools/Rapi.hs
index 710bfbb6f..6f7301741 100644
--- a/htools/Ganeti/HTools/Rapi.hs
+++ b/htools/Ganeti/HTools/Rapi.hs
@@ -38,7 +38,6 @@ import Network.Curl
import Network.Curl.Types ()
#endif
import Control.Monad
-import Prelude hiding (catch)
import Text.JSON (JSObject, fromJSObject, decodeStrict)
import Text.JSON.Types (JSValue(..))
import Text.Printf (printf)
@@ -85,8 +84,8 @@ getUrl url = do
-- | Helper to convert I/O errors in 'Bad' values.
ioErrToResult :: IO a -> IO (Result a)
ioErrToResult ioaction =
- catch (ioaction >>= return . Ok)
- (\e -> return . Bad . show $ (e::IOException))
+ Control.Exception.catch (ioaction >>= return . Ok)
+ (\e -> return . Bad . show $ (e::IOException))
-- | Append the default port if not passed in.
formatHost :: String -> String
diff --git a/htools/Ganeti/Ssconf.hs b/htools/Ganeti/Ssconf.hs
index 39a3d95df..e0020cc09 100644
--- a/htools/Ganeti/Ssconf.hs
+++ b/htools/Ganeti/Ssconf.hs
@@ -40,7 +40,6 @@ import Control.Exception
import Control.Monad (liftM)
import Data.Char (isSpace)
import Data.Maybe (fromMaybe)
-import Prelude hiding (catch)
import qualified Network.Socket as Socket
import System.FilePath ((</>))
import System.IO.Error (isDoesNotExistError)
@@ -96,7 +95,8 @@ catchIOErrors :: Maybe a -- ^ Optional default
-> IO a -- ^ Action to run
-> IO (Result a)
catchIOErrors def action =
- catch (do
+ Control.Exception.catch
+ (do
result <- action
return (Ok result)
) (\err -> let bad_result = Bad (show err)
diff --git a/htools/htools.hs b/htools/htools.hs
index 2e847d7f2..89081a70d 100644
--- a/htools/htools.hs
+++ b/htools/htools.hs
@@ -28,7 +28,6 @@ module Main (main) where
import Control.Exception
import Control.Monad (guard)
import Data.Char (toLower)
-import Prelude hiding (catch)
import System.Environment
import System.Exit
import System.IO
diff --git a/htools/test.hs b/htools/test.hs
index 6e434274b..25519543b 100644
--- a/htools/test.hs
+++ b/htools/test.hs
@@ -102,9 +102,8 @@ runTests name opts tests max_count = do
printf "Test %s failed (seed was %s, test size %d): %s\n"
desc (show u) size o
GaveUp { numTests = passed } ->
- printf "Test %s incomplete: gave up with only %d\
- \ passes after discarding %d tests\n"
- desc passed (maxDiscard opts)
+ printf "Test %s incomplete: gave up with only %d passes\n"
+ desc passed
_ -> return ()
) results
return results
@@ -149,7 +148,6 @@ transformTestOpts args opts = do
return args { chatty = optVerbose opts > 1
, replay = r
, maxSuccess = fromMaybe (maxSuccess args) (optTestCount opts)
- , maxDiscard = fromMaybe (maxDiscard args) (optTestCount opts)
}
main :: IO ()
--
GitLab