Commit 1251817b authored by Iustin Pop's avatar Iustin Pop
Browse files

Fix compatibility with newer Haskell libraries



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: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 1f5557ca
......@@ -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))
......
......@@ -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.
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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 ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment