Many base modules are now also exported by Prelude from 4.8.0. We are now conditionally importing the modules.
Signed-off-by: Bhimanavajjula Aditya <[email protected]> --- src/Ganeti/BasicTypes.hs | 3 ++ src/Ganeti/Codec.hs | 5 +++ src/Ganeti/Confd/Server.hs | 5 ++- src/Ganeti/Confd/Utils.hs | 5 +++ src/Ganeti/Config.hs | 5 ++- src/Ganeti/ConstantUtils.hs | 5 +++ src/Ganeti/Cpu/LoadParser.hs | 6 ++- src/Ganeti/DataCollectors.hs | 5 +++ src/Ganeti/DataCollectors/XenCpuLoad.hs | 6 +++ src/Ganeti/HTools/Cluster.hs | 10 ++++- src/Ganeti/HTools/Dedicated.hs | 10 ++++- src/Ganeti/HTools/Node.hs | 5 +++ src/Ganeti/JQScheduler.hs | 8 +++- src/Ganeti/JQueue.hs | 16 ++++--- src/Ganeti/Kvmd.hs | 5 +++ src/Ganeti/Lens.hs | 4 ++ src/Ganeti/Locking/Allocation.hs | 6 +++ src/Ganeti/Locking/Locks.hs | 4 ++ src/Ganeti/Logging.hs | 9 ++-- src/Ganeti/Metad/ConfigCore.hs | 3 ++ src/Ganeti/Monitoring/Server.hs | 4 ++ src/Ganeti/Objects.hs | 17 +++++--- src/Ganeti/Objects/Disk.hs | 5 ++- src/Ganeti/Objects/Instance.hs | 5 ++- src/Ganeti/OpCodes.hs | 6 ++- src/Ganeti/Parsers.hs | 5 ++- src/Ganeti/Query/Exec.hs | 11 +++-- src/Ganeti/Query/Filter.hs | 11 +++-- src/Ganeti/Query/Language.hs | 5 ++- src/Ganeti/Query/Node.hs | 9 +++- src/Ganeti/Query/Server.hs | 8 +++- src/Ganeti/Ssconf.hs | 5 ++- src/Ganeti/Storage/Diskstats/Parser.hs | 5 +++ src/Ganeti/Storage/Drbd/Parser.hs | 6 +++ src/Ganeti/Storage/Lvm/LVParser.hs | 12 ++++-- src/Ganeti/THH.hs | 3 ++ src/Ganeti/THH/HsRPC.hs | 3 ++ src/Ganeti/THH/PyRPC.hs | 5 +++ src/Ganeti/THH/PyType.hs | 4 ++ src/Ganeti/THH/RPC.hs | 5 ++- src/Ganeti/Types.hs | 5 ++- src/Ganeti/UDSServer.hs | 18 +++++--- src/Ganeti/Utils.hs | 3 ++ src/Ganeti/Utils/MultiMap.hs | 5 ++- src/Ganeti/Utils/Random.hs | 5 +++ src/Ganeti/Utils/Validate.hs | 5 ++- src/Ganeti/WConfd/ConfigModifications.hs | 8 +++- src/Ganeti/WConfd/ConfigState.hs | 4 ++ src/Ganeti/WConfd/ConfigWriter.hs | 20 +++++---- src/Ganeti/WConfd/Monad.hs | 3 ++ src/Ganeti/WConfd/TempRes.hs | 5 ++- test/hs/Test/Ganeti/BasicTypes.hs | 5 ++- test/hs/Test/Ganeti/Confd/Types.hs | 5 ++- test/hs/Test/Ganeti/HTools/Instance.hs | 5 ++- test/hs/Test/Ganeti/HTools/Types.hs | 5 ++- test/hs/Test/Ganeti/JQScheduler.hs | 13 +++--- test/hs/Test/Ganeti/JQueue/Objects.hs | 5 +++ test/hs/Test/Ganeti/Locking/Allocation.hs | 13 +++--- test/hs/Test/Ganeti/Locking/Locks.hs | 5 +++ test/hs/Test/Ganeti/Locking/Waiting.hs | 45 ++++++++++--------- test/hs/Test/Ganeti/Luxi.hs | 9 ++-- test/hs/Test/Ganeti/Objects.hs | 57 +++++++++++++------------ test/hs/Test/Ganeti/OpCodes.hs | 51 +++++++++++----------- test/hs/Test/Ganeti/Query/Language.hs | 4 ++ test/hs/Test/Ganeti/Rpc.hs | 5 ++- test/hs/Test/Ganeti/SlotMap.hs | 16 ++++--- test/hs/Test/Ganeti/Storage/Diskstats/Parser.hs | 5 ++- test/hs/Test/Ganeti/Storage/Lvm/LVParser.hs | 5 ++- test/hs/Test/Ganeti/TestCommon.hs | 3 ++ test/hs/Test/Ganeti/TestHelper.hs | 4 ++ test/hs/Test/Ganeti/Types.hs | 4 ++ test/hs/Test/Ganeti/Utils.hs | 6 +-- test/hs/Test/Ganeti/Utils/MultiMap.hs | 4 ++ test/hs/Test/Ganeti/WConfd/TempRes.hs | 5 ++- test/hs/htest.hs | 5 +++ 75 files changed, 458 insertions(+), 166 deletions(-) diff --git a/src/Ganeti/BasicTypes.hs b/src/Ganeti/BasicTypes.hs index 0591fa3..f6d673b 100644 --- a/src/Ganeti/BasicTypes.hs +++ b/src/Ganeti/BasicTypes.hs @@ -89,7 +89,10 @@ import Control.Monad.Trans.Control import Data.Function import Data.List import Data.Maybe +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid +#endif import Data.Set (Set) import qualified Data.Set as Set (empty) import Text.JSON (JSON) diff --git a/src/Ganeti/Codec.hs b/src/Ganeti/Codec.hs index 85ce266..5fbf2f1 100644 --- a/src/Ganeti/Codec.hs +++ b/src/Ganeti/Codec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Provides interface to the 'zlib' library. -} @@ -42,7 +44,10 @@ import qualified Codec.Compression.Zlib.Internal as I import Control.Monad.Error import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Internal as BL +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid (mempty) +#endif -- | Compresses a lazy bytestring. compressZlib :: BL.ByteString -> BL.ByteString diff --git a/src/Ganeti/Confd/Server.hs b/src/Ganeti/Confd/Server.hs index fac0537..c34cc80 100644 --- a/src/Ganeti/Confd/Server.hs +++ b/src/Ganeti/Confd/Server.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TupleSections, CPP #-} {-| Implementation of the Ganeti confd server functionality. @@ -40,7 +40,10 @@ module Ganeti.Confd.Server , prepMain ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative((<$>)) +#endif import Control.Concurrent import Control.Monad (forever, liftM) import Data.IORef diff --git a/src/Ganeti/Confd/Utils.hs b/src/Ganeti/Confd/Utils.hs index da9075e..c382c3e 100644 --- a/src/Ganeti/Confd/Utils.hs +++ b/src/Ganeti/Confd/Utils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Implementation of the Ganeti confd utilities. This holds a few utility functions that could be useful in both @@ -47,7 +49,10 @@ module Ganeti.Confd.Utils import qualified Data.Attoparsec.Text as P +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((*>)) +#endif import qualified Data.ByteString as B import Data.Text (pack) import qualified Text.JSON as J diff --git a/src/Ganeti/Config.hs b/src/Ganeti/Config.hs index ddbb7b1..8957f63 100644 --- a/src/Ganeti/Config.hs +++ b/src/Ganeti/Config.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns, CPP #-} {-| Implementation of the Ganeti configuration database. @@ -82,7 +82,10 @@ module Ganeti.Config , instNodes ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Arrow ((&&&)) import Control.Monad import Control.Monad.State diff --git a/src/Ganeti/ConstantUtils.hs b/src/Ganeti/ConstantUtils.hs index 6a61cf2..f1cc795 100644 --- a/src/Ganeti/ConstantUtils.hs +++ b/src/Ganeti/ConstantUtils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| ConstantUtils contains the helper functions for constants This module cannot be merged with 'Ganeti.Utils' because it would @@ -38,7 +40,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.ConstantUtils where import Data.Char (ord) +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid (Monoid(..)) +#endif import Data.Set (Set) import qualified Data.Set as Set (difference, fromList, toList, union) diff --git a/src/Ganeti/Cpu/LoadParser.hs b/src/Ganeti/Cpu/LoadParser.hs index 7be0759..04b7a5f 100644 --- a/src/Ganeti/Cpu/LoadParser.hs +++ b/src/Ganeti/Cpu/LoadParser.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, CPP #-} {-| /proc/stat file parser This module holds the definition of the parser that extracts information @@ -36,7 +36,11 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Ganeti.Cpu.LoadParser (cpustatParser) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative ((<|>)) +#else import Control.Applicative ((<*>), (<*), (*>), (<$>), (<|>)) +#endif import qualified Data.Attoparsec.Text as A import qualified Data.Attoparsec.Combinator as AC import Data.Attoparsec.Text (Parser) diff --git a/src/Ganeti/DataCollectors.hs b/src/Ganeti/DataCollectors.hs index 9c2cc3b..fb3ac71 100644 --- a/src/Ganeti/DataCollectors.hs +++ b/src/Ganeti/DataCollectors.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Definition of the data collectors used by MonD. -} @@ -35,7 +37,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.DataCollectors( collectors ) where import Data.Map (findWithDefault) +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid (mempty) +#endif import qualified Ganeti.DataCollectors.CPUload as CPUload import qualified Ganeti.DataCollectors.Diagnose as Diagnose diff --git a/src/Ganeti/DataCollectors/XenCpuLoad.hs b/src/Ganeti/DataCollectors/XenCpuLoad.hs index 3ced7ad..1aa863f 100644 --- a/src/Ganeti/DataCollectors/XenCpuLoad.hs +++ b/src/Ganeti/DataCollectors/XenCpuLoad.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| xentop CPU data collector -} @@ -42,7 +44,11 @@ module Ganeti.DataCollectors.XenCpuLoad , dcUpdate ) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (liftA2) +#else import Control.Applicative ((<$>), liftA2) +#endif import Control.Arrow ((***)) import Control.Monad (liftM, when) import Control.Monad.IO.Class (liftIO) diff --git a/src/Ganeti/HTools/Cluster.hs b/src/Ganeti/HTools/Cluster.hs index f89a58a..990bbab 100644 --- a/src/Ganeti/HTools/Cluster.hs +++ b/src/Ganeti/HTools/Cluster.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Implementation of cluster-wide logic. This module holds all pure cluster-logic; I\/O related functionality @@ -82,7 +84,11 @@ module Ganeti.HTools.Cluster , findSplitInstances ) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (liftA2) +#else import Control.Applicative ((<$>), liftA2) +#endif import Control.Arrow ((&&&)) import Control.Monad (unless) import qualified Data.IntSet as IntSet @@ -612,8 +618,8 @@ findAllocation opts mggl mgnl mgil gdx inst cnt = do il = Container.filter (belongsTo nl . Instance.pNode) mgil group' = Container.find gdx mggl unless (hasRequiredNetworks group' inst) . failError - $ "The group " ++ Group.name group' ++ " is not connected to\ - \ a network required by instance " ++ Instance.name inst + $ "The group " ++ Group.name group' ++ " is not connected to" ++ + " a network required by instance " ++ Instance.name inst solution <- genAllocNodes opts mggl nl cnt False >>= tryAlloc opts nl il inst return (solution, solutionDescription (group', return solution)) diff --git a/src/Ganeti/HTools/Dedicated.hs b/src/Ganeti/HTools/Dedicated.hs index 206513a..9e6bf99 100644 --- a/src/Ganeti/HTools/Dedicated.hs +++ b/src/Ganeti/HTools/Dedicated.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Implementation of special handling of dedicated clusters. -} @@ -44,7 +46,11 @@ module Ganeti.HTools.Dedicated , runDedicatedAllocation ) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (liftA2) +#else import Control.Applicative (liftA2, (<$>)) +#endif import Control.Arrow ((&&&)) import Control.Monad (unless, liftM, foldM, mplus) import qualified Data.Foldable as F @@ -180,8 +186,8 @@ findAllocation opts mggl mgnl gdx inst count = do let nl = Container.filter ((== gdx) . Node.group) mgnl group = Container.find gdx mggl unless (Cluster.hasRequiredNetworks group inst) . failError - $ "The group " ++ Group.name group ++ " is not connected to\ - \ a network required by instance " ++ Instance.name inst + $ "The group " ++ Group.name group ++ " is not connected to" ++ + " a network required by instance " ++ Instance.name inst allocNodes <- Cluster.genAllocNodes opts mggl nl count False solution <- case allocNodes of (Right []) -> fail "Not enough online nodes" diff --git a/src/Ganeti/HTools/Node.hs b/src/Ganeti/HTools/Node.hs index 79993ad..ce16985 100644 --- a/src/Ganeti/HTools/Node.hs +++ b/src/Ganeti/HTools/Node.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Module describing a node. All updates are functional (copy-based) and return a new node with @@ -100,7 +102,10 @@ module Ganeti.HTools.Node ) where import Control.Monad (liftM, liftM2) +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<$>), (<*>)) +#endif import qualified Data.Foldable as Foldable import Data.Function (on) import qualified Data.Graph as Graph diff --git a/src/Ganeti/JQScheduler.hs b/src/Ganeti/JQScheduler.hs index 9ec9e1a..2c33288 100644 --- a/src/Ganeti/JQScheduler.hs +++ b/src/Ganeti/JQScheduler.hs @@ -1,4 +1,6 @@ {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE CPP #-} + {-| Implementation of a reader for the job queue. -} @@ -48,14 +50,18 @@ module Ganeti.JQScheduler , configChangeNeedsRescheduling ) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (liftA2) +#else import Control.Applicative (liftA2, (<$>)) +import Data.Functor ((<$)) +#endif import Control.Arrow import Control.Concurrent import Control.Exception import Control.Monad import Control.Monad.IO.Class import Data.Function (on) -import Data.Functor ((<$)) import Data.IORef import Data.List import Data.Maybe diff --git a/src/Ganeti/JQueue.hs b/src/Ganeti/JQueue.hs index 49f8b5e..d631070 100644 --- a/src/Ganeti/JQueue.hs +++ b/src/Ganeti/JQueue.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Implementation of the job queue. -} @@ -82,7 +84,12 @@ module Ganeti.JQueue , QueuedJob(..) ) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (liftA2, (<|>)) +#else import Control.Applicative (liftA2, (<|>), (<$>)) +import Data.Functor ((<$)) +#endif import Control.Arrow (first, second) import Control.Concurrent (forkIO, threadDelay) import Control.Exception @@ -91,7 +98,6 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans (lift) import Control.Monad.Trans.Maybe -import Data.Functor ((<$)) import Data.List import Data.Maybe import Data.Ord (comparing) @@ -575,8 +581,8 @@ waitForJob jid tmout = do Ok s | s == JOB_STATUS_CANCELED -> return (True, "Job successfully cancelled") | finalizedR jobR -> - return (False, "Job exited before it could have been canceled,\ - \ status " ++ show s) + return (False, "Job exited before it could have been canceled," ++ + " status " ++ show s) | otherwise -> return (False, "Job could not be canceled, status " ++ show s) @@ -608,8 +614,8 @@ cancelJob kill luxiLivelock jid = runResultT $ do liftIO $ signalProcess (if kill then sigKILL else sigTERM) pid if not kill then if calcJobStatus job > JOB_STATUS_WAITING - then return (False, "Job no longer waiting, can't cancel\ - \ (informed it anyway)") + then return (False, "Job no longer waiting, can't cancel" ++ + " (informed it anyway)") else lift $ waitForJob jid C.luxiCancelJobTimeout else return (True, "SIGKILL send to the process") _ -> do diff --git a/src/Ganeti/Kvmd.hs b/src/Ganeti/Kvmd.hs index 4979396..0ac8235 100644 --- a/src/Ganeti/Kvmd.hs +++ b/src/Ganeti/Kvmd.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| KVM daemon The KVM daemon is responsible for determining whether a given KVM @@ -61,7 +63,10 @@ module Ganeti.Kvmd where import Prelude hiding (rem) +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<$>)) +#endif import Control.Exception (try) import Control.Concurrent import Control.Monad (unless, when) diff --git a/src/Ganeti/Lens.hs b/src/Ganeti/Lens.hs index c7951e6..d689d0c 100644 --- a/src/Ganeti/Lens.hs +++ b/src/Ganeti/Lens.hs @@ -44,7 +44,11 @@ module Ganeti.Lens , atSet ) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (WrappedMonad(..)) +#else import Control.Applicative ((<$>), WrappedMonad(..)) +#endif import Control.Lens import Control.Monad import Data.Functor.Compose (Compose(..)) diff --git a/src/Ganeti/Locking/Allocation.hs b/src/Ganeti/Locking/Allocation.hs index 2875d70..798920c 100644 --- a/src/Ganeti/Locking/Allocation.hs +++ b/src/Ganeti/Locking/Allocation.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Implementation of lock allocation. -} @@ -49,7 +51,11 @@ module Ganeti.Locking.Allocation , freeLocks ) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (liftA2) +#else import Control.Applicative (liftA2, (<$>), (<*>), pure) +#endif import Control.Arrow (second, (***)) import Control.Monad import Data.Foldable (for_, find) diff --git a/src/Ganeti/Locking/Locks.hs b/src/Ganeti/Locking/Locks.hs index e5bf524..3e781b1 100644 --- a/src/Ganeti/Locking/Locks.hs +++ b/src/Ganeti/Locking/Locks.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ViewPatterns, FlexibleContexts #-} +{-# LANGUAGE CPP #-} {-| Ganeti lock structure @@ -44,7 +45,10 @@ module Ganeti.Locking.Locks , lockLevel ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<$>), (<*>), pure) +#endif import Control.Monad ((>=>), liftM) import Data.List (stripPrefix) import System.Posix.Types (ProcessID) diff --git a/src/Ganeti/Logging.hs b/src/Ganeti/Logging.hs index bb23d8c..49223fe 100644 --- a/src/Ganeti/Logging.hs +++ b/src/Ganeti/Logging.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell, StandaloneDeriving, - GeneralizedNewtypeDeriving, + GeneralizedNewtypeDeriving, CPP, DeriveGeneric #-} {-| Implementation of the Ganeti logging functionality. @@ -61,15 +61,18 @@ module Ganeti.Logging , isDebugMode ) where -import Control.Applicative ((<$>)) import Control.Monad import Control.Monad.Error (Error(..), MonadError(..), catchError) +#if MIN_VERSION_base(4,8,0) +#else +import Control.Applicative ((<$>)) +import Data.Monoid +#endif import Control.Monad.Reader import qualified Control.Monad.RWS.Strict as RWSS import qualified Control.Monad.State.Strict as SS import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe -import Data.Monoid import System.Log.Logger import System.Log.Handler.Simple import System.Log.Handler.Syslog diff --git a/src/Ganeti/Metad/ConfigCore.hs b/src/Ganeti/Metad/ConfigCore.hs index 41120fd..5af0b05 100644 --- a/src/Ganeti/Metad/ConfigCore.hs +++ b/src/Ganeti/Metad/ConfigCore.hs @@ -35,7 +35,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Ganeti.Metad.ConfigCore where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Concurrent.MVar.Lifted import Control.Monad.Base import Control.Monad.IO.Class diff --git a/src/Ganeti/Monitoring/Server.hs b/src/Ganeti/Monitoring/Server.hs index 530fd5b..8305a9e 100644 --- a/src/Ganeti/Monitoring/Server.hs +++ b/src/Ganeti/Monitoring/Server.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} {-| Implementation of the Ganeti confd server functionality. @@ -49,7 +50,10 @@ import Control.Monad.IO.Class import Data.ByteString.Char8 (unpack) import Data.Maybe (fromMaybe) import Data.List (find) +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid (mempty) +#endif import qualified Data.Map as Map import qualified Data.PSQueue as Queue import Snap.Core diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs index 2501e99..36705d4 100644 --- a/src/Ganeti/Objects.hs +++ b/src/Ganeti/Objects.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, FunctionalDependencies, DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell, FunctionalDependencies, DeriveGeneric, CPP #-} {-| Implementation of the Ganeti config objects. @@ -106,13 +106,16 @@ module Ganeti.Objects , module Ganeti.Objects.Maintenance ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +import Data.Monoid +#endif import Control.Arrow (first) import Control.Monad.State import Data.List (foldl', intercalate) import Data.Maybe import qualified Data.Map as Map -import Data.Monoid import Data.Ord (comparing) import Data.Ratio (numerator, denominator) import Data.Tuple (swap) @@ -513,11 +516,11 @@ instance JSON FilterPredicate where | name == toJSString "opcode" -> FPOpCode <$> readJSON expr | name == toJSString "reason" -> FPReason <$> readJSON expr JSArray (JSString name:params) -> - fail $ "malformed FilterPredicate: bad parameter list for\ - \ '" ++ fromJSString name ++ "' predicate: " - ++ J.showJSArray params "" - _ -> fail "malformed FilterPredicate: must be a list with the first\ - \ entry being a string describing the predicate type" + fail $ "malformed FilterPredicate: bad parameter list for" ++ + " '" ++ fromJSString name ++ "' predicate: " ++ + J.showJSArray params "" + _ -> fail $ "malformed FilterPredicate: must be a list with the first" ++ + " entry being a string describing the predicate type" $(buildObject "FilterRule" "fr" $ diff --git a/src/Ganeti/Objects/Disk.hs b/src/Ganeti/Objects/Disk.hs index 18ae20a..39777cb 100644 --- a/src/Ganeti/Objects/Disk.hs +++ b/src/Ganeti/Objects/Disk.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, FunctionalDependencies #-} +{-# LANGUAGE TemplateHaskell, FunctionalDependencies, CPP #-} {-| Implementation of the Ganeti Disk config object. @@ -36,7 +36,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.Objects.Disk where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<*>), (<$>)) +#endif import Data.Char (isAsciiLower, isAsciiUpper, isDigit) import Data.List (isPrefixOf, isInfixOf) import Language.Haskell.TH.Syntax diff --git a/src/Ganeti/Objects/Instance.hs b/src/Ganeti/Objects/Instance.hs index 238898f..94e5a56 100644 --- a/src/Ganeti/Objects/Instance.hs +++ b/src/Ganeti/Objects/Instance.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, FunctionalDependencies #-} +{-# LANGUAGE TemplateHaskell, FunctionalDependencies, CPP #-} {-| Implementation of the Ganeti Instance config object. @@ -36,7 +36,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.Objects.Instance where +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid +#endif import Ganeti.JSON (emptyContainer) import Ganeti.Objects.Nic diff --git a/src/Ganeti/OpCodes.hs b/src/Ganeti/OpCodes.hs index 162e2d4..94a78fc 100644 --- a/src/Ganeti/OpCodes.hs +++ b/src/Ganeti/OpCodes.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE ExistentialQuantification, TemplateHaskell, StandaloneDeriving #-} +{-# LANGUAGE ExistentialQuantification, + TemplateHaskell, StandaloneDeriving, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Implementation of the opcodes. @@ -56,7 +57,10 @@ module Ganeti.OpCodes , setOpPriority ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Data.List (intercalate) import Data.Map (Map) import qualified Text.JSON diff --git a/src/Ganeti/Parsers.hs b/src/Ganeti/Parsers.hs index 10b0e41..c7158e4 100644 --- a/src/Ganeti/Parsers.hs +++ b/src/Ganeti/Parsers.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, CPP #-} {-| Utility functions for several parsers This module holds the definition for some utility functions for two @@ -37,7 +37,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Ganeti.Parsers where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((*>)) +#endif import qualified Data.Attoparsec.Text as A import Data.Attoparsec.Text (Parser) import Data.Text (unpack) diff --git a/src/Ganeti/Query/Exec.hs b/src/Ganeti/Query/Exec.hs index 124f7f3..7277829 100644 --- a/src/Ganeti/Query/Exec.hs +++ b/src/Ganeti/Query/Exec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Executing jobs as processes The protocol works as follows (MP = master process, FP = forked process): @@ -65,7 +67,10 @@ import Control.Concurrent.Lifted (threadDelay) import Control.Exception (finally) import Control.Monad import Control.Monad.Error +#if MIN_VERSION_base(4,8,0) +#else import Data.Functor +#endif import qualified Data.Map as M import Data.Maybe (listToMaybe, mapMaybe) import System.Directory (getDirectoryContents) @@ -107,9 +112,9 @@ listOpenFds :: (Error e) => ResultT e IO [Fd] listOpenFds = liftM filterReadable $ liftIO (getDirectoryContents "/proc/self/fd") `orElse` liftIO (getDirectoryContents "/dev/fd") `orElse` - ([] <$ logInfo "Listing open file descriptors isn't\ - \ supported by the system,\ - \ not cleaning them up!") + ([] <$ logInfo ("Listing open file descriptors isn't" ++ + " supported by the system," ++ + " not cleaning them up!")) -- FIXME: If we can't get the list of file descriptors, -- try to determine the maximum value and just return -- the full range. diff --git a/src/Ganeti/Query/Filter.hs b/src/Ganeti/Query/Filter.hs index aaae425..469b7af 100644 --- a/src/Ganeti/Query/Filter.hs +++ b/src/Ganeti/Query/Filter.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes, GADTs, StandaloneDeriving #-} +{-# LANGUAGE RankNTypes, GADTs, StandaloneDeriving, CPP #-} {-| Implementation of the Ganeti Query2 filterning. @@ -66,13 +66,16 @@ module Ganeti.Query.Filter , FilterOp(..) ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +import Data.Traversable (traverse) +#endif import Control.Monad (liftM, mzero) import Control.Monad.Trans.Maybe (MaybeT, runMaybeT) import Control.Monad.Trans.Class (lift) import qualified Data.Map as Map import Data.Maybe -import Data.Traversable (traverse) import Text.JSON (JSValue(..), fromJSString) import Text.JSON.Pretty (pp_value) import qualified Text.Regex.PCRE as PCRE @@ -175,8 +178,8 @@ regexpFilter :: FilterRegex -> JSValue -> ErrorResult Bool regexpFilter re (JSString val) = Ok $! PCRE.match (compiledRegex re) (fromJSString val) regexpFilter _ x = - Bad . ParameterError $ "Invalid field value used in regexp matching,\ - \ expecting string but got '" ++ show (pp_value x) ++ "'" + Bad . ParameterError $ "Invalid field value used in regexp matching," ++ + " expecting string but got '" ++ show (pp_value x) ++ "'" -- | Implements the 'ContainsFilter' matching. containsFilter :: FilterValue -> JSValue -> ErrorResult Bool diff --git a/src/Ganeti/Query/Language.hs b/src/Ganeti/Query/Language.hs index 1cfec88..83038ae 100644 --- a/src/Ganeti/Query/Language.hs +++ b/src/Ganeti/Query/Language.hs @@ -65,10 +65,13 @@ module Ganeti.Query.Language , checkRS ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +import Data.Traversable (Traversable) +#endif import Control.DeepSeq import Data.Foldable -import Data.Traversable (Traversable) import Data.Ratio (numerator, denominator) import Text.JSON.Pretty (pp_value) import Text.JSON.Types diff --git a/src/Ganeti/Query/Node.hs b/src/Ganeti/Query/Node.hs index 17c3469..3c233dd 100644 --- a/src/Ganeti/Query/Node.hs +++ b/src/Ganeti/Query/Node.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Implementation of the Ganeti Query2 node queries. -} @@ -38,7 +40,10 @@ module Ganeti.Query.Node , collectLiveData ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Data.List import Data.Maybe import qualified Data.Map as Map @@ -63,8 +68,8 @@ type Runtime = Either RpcError RpcResultNodeInfo nodeLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)] nodeLiveFieldsDefs = [ ("bootid", "BootID", QFTText, "bootid", - "Random UUID renewed for each system reboot, can be used\ - \ for detecting reboots by tracking changes") + "Random UUID renewed for each system reboot, can be used" ++ + " for detecting reboots by tracking changes") , ("cnodes", "CNodes", QFTNumber, "cpu_nodes", "Number of NUMA domains on node (if exported by hypervisor)") , ("cnos", "CNOs", QFTNumber, "cpu_dom0", diff --git a/src/Ganeti/Query/Server.hs b/src/Ganeti/Query/Server.hs index 3ea20bf..c71b026 100644 --- a/src/Ganeti/Query/Server.hs +++ b/src/Ganeti/Query/Server.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} {-| Implementation of the Ganeti Query2 server. @@ -40,7 +41,10 @@ module Ganeti.Query.Server , prepMain ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Concurrent import Control.Exception import Control.Lens ((.~)) @@ -177,8 +181,8 @@ handleCallWrapper :: Lock -> JQStatus -> Result ConfigData -> LuxiOp -> IO (ErrorResult JSValue) handleCallWrapper _ _ (Bad msg) _ = return . Bad . ConfigurationError $ - "I do not have access to a valid configuration, cannot\ - \ process queries: " ++ msg + "I do not have access to a valid configuration, cannot" ++ + " process queries: " ++ msg handleCallWrapper qlock qstat (Ok config) op = handleCall qlock qstat config op -- | Actual luxi operation handler. diff --git a/src/Ganeti/Ssconf.hs b/src/Ganeti/Ssconf.hs index d867cda..543e7d1 100644 --- a/src/Ganeti/Ssconf.hs +++ b/src/Ganeti/Ssconf.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell, DeriveGeneric, CPP #-} {-| Implementation of the Ganeti Ssconf interface. @@ -55,7 +55,10 @@ module Ganeti.Ssconf ) where import Control.Arrow ((&&&)) +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<$>)) +#endif import Control.Exception import Control.Monad (forM, liftM) import qualified Data.Map as M diff --git a/src/Ganeti/Storage/Diskstats/Parser.hs b/src/Ganeti/Storage/Diskstats/Parser.hs index 64d3885..f27381c 100644 --- a/src/Ganeti/Storage/Diskstats/Parser.hs +++ b/src/Ganeti/Storage/Diskstats/Parser.hs @@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} + {-| Diskstats proc file parser This module holds the definition of the parser that extracts status @@ -36,7 +38,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Ganeti.Storage.Diskstats.Parser (diskstatsParser) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<*>), (<*), (<$>)) +#endif import qualified Data.Attoparsec.Text as A import qualified Data.Attoparsec.Combinator as AC import Data.Attoparsec.Text (Parser) diff --git a/src/Ganeti/Storage/Drbd/Parser.hs b/src/Ganeti/Storage/Drbd/Parser.hs index c9c8dce..aed7ca8 100644 --- a/src/Ganeti/Storage/Drbd/Parser.hs +++ b/src/Ganeti/Storage/Drbd/Parser.hs @@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} + {-| DRBD proc file parser This module holds the definition of the parser that extracts status @@ -36,7 +38,11 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Ganeti.Storage.Drbd.Parser (drbdStatusParser, commaIntParser) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative ((<|>)) +#else import Control.Applicative ((<*>), (*>), (<*), (<$>), (<|>), pure) +#endif import qualified Data.Attoparsec.Text as A import qualified Data.Attoparsec.Combinator as AC import Data.Attoparsec.Text (Parser) diff --git a/src/Ganeti/Storage/Lvm/LVParser.hs b/src/Ganeti/Storage/Lvm/LVParser.hs index 470c41a..963bf54 100644 --- a/src/Ganeti/Storage/Lvm/LVParser.hs +++ b/src/Ganeti/Storage/Lvm/LVParser.hs @@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} + {-| Logical Volumer information parser This module holds the definition of the parser that extracts status @@ -37,7 +39,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Ganeti.Storage.Lvm.LVParser (lvParser, lvCommand, lvParams) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<*>), (*>), (<*), (<$>)) +#endif import qualified Data.Attoparsec.Text as A import qualified Data.Attoparsec.Combinator as AC import Data.Attoparsec.Text (Parser) @@ -88,9 +93,10 @@ lvParams = [ "--noheadings" , "--units", "B" , "--separator", ";" - , "-o", "lv_uuid,lv_name,lv_attr,lv_major,lv_minor,lv_kernel_major\ - \,lv_kernel_minor,lv_size,seg_count,lv_tags,modules,vg_uuid,vg_name,segtype\ - \,seg_start,seg_start_pe,seg_size,seg_tags,seg_pe_ranges,devices" + , "-o", "lv_uuid,lv_name,lv_attr,lv_major,lv_minor,lv_kernel_major" ++ + ",lv_kernel_minor,lv_size,seg_count,lv_tags,modules,vg_uuid" ++ + ",vg_name,segtype,seg_start,seg_start_pe,seg_size,seg_tags" ++ + ",seg_pe_ranges,devices" ] -- | The parser for one line of the diskstatus file. diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs index 5374ba6..4167d90 100644 --- a/src/Ganeti/THH.hs +++ b/src/Ganeti/THH.hs @@ -93,7 +93,10 @@ import Data.Function (on) import Data.List import Data.Maybe import qualified Data.Map as M +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid +#endif import qualified Data.Set as S #if MIN_VERSION_base(4,6,0) import GHC.Generics (Generic) diff --git a/src/Ganeti/THH/HsRPC.hs b/src/Ganeti/THH/HsRPC.hs index 7822912..3b09c82 100644 --- a/src/Ganeti/THH/HsRPC.hs +++ b/src/Ganeti/THH/HsRPC.hs @@ -43,7 +43,10 @@ module Ganeti.THH.HsRPC , mkRpcCalls ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Monad import Control.Monad.Base import Control.Monad.Error diff --git a/src/Ganeti/THH/PyRPC.hs b/src/Ganeti/THH/PyRPC.hs index eee1554..e5e59a2 100644 --- a/src/Ganeti/THH/PyRPC.hs +++ b/src/Ganeti/THH/PyRPC.hs @@ -1,4 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} + {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-| Combines the construction of RPC server components and their Python stubs. @@ -42,7 +44,10 @@ module Ganeti.THH.PyRPC import Control.Monad import Data.Char (toLower, toUpper) +#if MIN_VERSION_base(4,8,0) +#else import Data.Functor +#endif import Data.Maybe (fromMaybe) import Language.Haskell.TH import Language.Haskell.TH.Syntax (liftString) diff --git a/src/Ganeti/THH/PyType.hs b/src/Ganeti/THH/PyType.hs index a3dbe44..4bbe1aa 100644 --- a/src/Ganeti/THH/PyType.hs +++ b/src/Ganeti/THH/PyType.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} {-| PyType helper for Ganeti Haskell code. @@ -39,7 +40,10 @@ module Ganeti.THH.PyType , pyOptionalType ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Monad import Data.List (intercalate) import Language.Haskell.TH diff --git a/src/Ganeti/THH/RPC.hs b/src/Ganeti/THH/RPC.hs index 08ae0a3..af124d5 100644 --- a/src/Ganeti/THH/RPC.hs +++ b/src/Ganeti/THH/RPC.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, ExistentialQuantification #-} +{-# LANGUAGE TemplateHaskell, ExistentialQuantification, CPP #-} {-| Implements Template Haskell generation of RPC server components from Haskell functions. @@ -42,7 +42,10 @@ module Ganeti.THH.RPC , mkRpcM ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Arrow ((&&&)) import Control.Monad import Control.Monad.Error.Class diff --git a/src/Ganeti/Types.hs b/src/Ganeti/Types.hs index 0a6bdd0..c19b1e5 100644 --- a/src/Ganeti/Types.hs +++ b/src/Ganeti/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, DeriveFunctor, DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell, DeriveFunctor, DeriveGeneric, CPP #-} {-| Some common Ganeti types. @@ -188,7 +188,10 @@ module Ganeti.Types , TagsObject(..) ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Monad (liftM) import qualified Text.JSON as JSON import Text.JSON (JSON, readJSON, showJSON) diff --git a/src/Ganeti/UDSServer.hs b/src/Ganeti/UDSServer.hs index 8e27c5a..390569b 100644 --- a/src/Ganeti/UDSServer.hs +++ b/src/Ganeti/UDSServer.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} {-| Implementation of the Ganeti Unix Domain Socket JSON server interface. @@ -70,7 +71,10 @@ module Ganeti.UDSServer , listener ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Concurrent.Lifted (fork, yield) import Control.Monad.Base import Control.Monad.Trans.Control @@ -376,9 +380,9 @@ decodeError val = -- call was successful. parseResponse :: String -> ErrorResult JSValue parseResponse s = do - when (UTF8.replacement_char `elem` s) $ - failError "Failed to decode UTF-8,\ - \ detected replacement char after decoding" + when (UTF8.replacement_char `elem` s) . failError $ + ("Failed to decode UTF-8," ++ + " detected replacement char after decoding") oarr <- fromJResultE "Parsing LUXI response" (decodeStrict s) let arr = J.fromJSObject oarr status <- fromObj arr (strOfKey Success) @@ -472,10 +476,10 @@ handleClient handler client = do msg <- liftBase $ recvMsgExt client debugMode <- liftBase isDebugMode - when (debugMode && isRisky msg) $ - logAlert "POSSIBLE LEAKING OF CONFIDENTIAL PARAMETERS. \ - \Daemon is running in debug mode. \ - \The text of the request has been logged." + when (debugMode && isRisky msg) . logAlert $ + ("POSSIBLE LEAKING OF CONFIDENTIAL PARAMETERS. " ++ + "Daemon is running in debug mode. " ++ + "The text of the request has been logged.") logDebug $ "Received message (truncated): " ++ take 500 (show msg) case msg of diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs index 4cb6f57..1b959dc 100644 --- a/src/Ganeti/Utils.hs +++ b/src/Ganeti/Utils.hs @@ -101,7 +101,10 @@ module Ganeti.Utils , threadDelaySeconds ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Concurrent import Control.Exception (try, bracket) import Control.Monad diff --git a/src/Ganeti/Utils/MultiMap.hs b/src/Ganeti/Utils/MultiMap.hs index 0f97e26..9365335 100644 --- a/src/Ganeti/Utils/MultiMap.hs +++ b/src/Ganeti/Utils/MultiMap.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes, TypeFamilies #-} +{-# LANGUAGE RankNTypes, TypeFamilies, CPP #-} {-| Implements multi-maps - maps that map keys to sets of values @@ -60,7 +60,10 @@ import Control.Monad import qualified Data.Foldable as F import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust) +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid +#endif import qualified Data.Set as S import qualified Text.JSON as J diff --git a/src/Ganeti/Utils/Random.hs b/src/Ganeti/Utils/Random.hs index 500e00d..ddc1603 100644 --- a/src/Ganeti/Utils/Random.hs +++ b/src/Ganeti/Utils/Random.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Utilities related to randomized computations. -} @@ -38,7 +40,10 @@ module Ganeti.Utils.Random , delayRandom ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Concurrent (threadDelay) import Control.Monad import Control.Monad.State diff --git a/src/Ganeti/Utils/Validate.hs b/src/Ganeti/Utils/Validate.hs index 421f0c1..d3f8a33 100644 --- a/src/Ganeti/Utils/Validate.hs +++ b/src/Ganeti/Utils/Validate.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, CPP #-} {-| A validation monad and corresponding utilities @@ -51,7 +51,10 @@ module Ganeti.Utils.Validate , validate' ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Arrow import Control.Monad import Control.Monad.Error diff --git a/src/Ganeti/WConfd/ConfigModifications.hs b/src/Ganeti/WConfd/ConfigModifications.hs index fe09a9d..3c07069 100644 --- a/src/Ganeti/WConfd/ConfigModifications.hs +++ b/src/Ganeti/WConfd/ConfigModifications.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction, FlexibleContexts, - RankNTypes #-} + RankNTypes, CPP #-} {-| The WConfd functions for direct configuration manipulation @@ -40,7 +40,12 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.WConfd.ConfigModifications where +#if MIN_VERSION_base(4,8,0) +import Data.Foldable (fold) +#else import Control.Applicative ((<$>)) +import Data.Foldable (fold, foldMap) +#endif import Control.Lens (_2) import Control.Lens.Getter ((^.)) import Control.Lens.Setter (Setter, (.~), (%~), (+~), over) @@ -51,7 +56,6 @@ import Control.Monad.Error (throwError, MonadError) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.State (StateT, get, put, modify, runStateT, execStateT) -import Data.Foldable (fold, foldMap) import Data.List (elemIndex) import Data.Maybe (isJust, maybeToList, fromMaybe, fromJust) import Language.Haskell.TH (Name) diff --git a/src/Ganeti/WConfd/ConfigState.hs b/src/Ganeti/WConfd/ConfigState.hs index fa6e754..2885da8 100644 --- a/src/Ganeti/WConfd/ConfigState.hs +++ b/src/Ganeti/WConfd/ConfigState.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} {-| Pure functions for manipulating the configuration state. @@ -43,7 +44,10 @@ module Ganeti.WConfd.ConfigState , needsFullDist ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Data.Function (on) import System.Time (ClockTime(..)) diff --git a/src/Ganeti/WConfd/ConfigWriter.hs b/src/Ganeti/WConfd/ConfigWriter.hs index f3dd8dd..11d964b 100644 --- a/src/Ganeti/WConfd/ConfigWriter.hs +++ b/src/Ganeti/WConfd/ConfigWriter.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RankNTypes, FlexibleContexts #-} +{-# LANGUAGE CPP #-} {-| Implementation of functions specific to configuration management. @@ -43,7 +44,10 @@ module Ganeti.WConfd.ConfigWriter , distSSConfAsyncTask ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Monad.Base import Control.Monad.Error import qualified Control.Monad.State.Strict as S @@ -80,8 +84,8 @@ loadConfigFromFile path = withLockedFile path $ \_ -> do writeConfigToFile :: (MonadBase IO m, MonadError GanetiException m, MonadLog m) => ConfigData -> FilePath -> FStat -> m FStat writeConfigToFile cfg path oldstat = do - logDebug $ "Async. config. writer: Commencing write\ - \ serial no " ++ show (serialOf cfg) + logDebug $ "Async. config. writer: Commencing write" ++ + " serial no " ++ show (serialOf cfg) r <- toErrorBase $ atomicUpdateLockedFile_ path oldstat doWrite logDebug "Async. config. writer: written" return r @@ -177,12 +181,12 @@ distMCsAsyncTask :: RuntimeEnts -> IO ConfigState -- ^ An action to read the current config -> ResultG (AsyncWorker () ()) distMCsAsyncTask ents cpath cdRef = - lift . mkStatelessAsyncTask ERROR "Can't distribute the configuration\ - \ to master candidates" + lift . mkStatelessAsyncTask ERROR ("Can't distribute the configuration" ++ + " to master candidates") $ \_ -> do cd <- liftBase (csConfigData <$> cdRef) :: ResultG ConfigData - logDebug $ "Distributing the configuration to master candidates,\ - \ serial no " ++ show (serialOf cd) + logDebug $ "Distributing the configuration to master candidates," ++ + " serial no " ++ show (serialOf cd) fupload <- prepareRpcCallUploadFile ents cpath execRpcCallAndLog (getMasterCandidates cd) fupload logDebug "Successfully finished distributing the configuration" @@ -203,8 +207,8 @@ distSSConfAsyncTask cdRef = if oldssc == ssc then logDebug "SSConf unchanged, not distributing" else do - logDebug $ "Starting the distribution of SSConf\ - \ serial no " ++ show (serialOf cd) + logDebug $ "Starting the distribution of SSConf" ++ + " serial no " ++ show (serialOf cd) execRpcCallAndLog (getOnlineNodes cd) (RpcCallWriteSsconfFiles ssc) logDebug "Successfully finished distributing SSConf" diff --git a/src/Ganeti/WConfd/Monad.hs b/src/Ganeti/WConfd/Monad.hs index 93bec0e..fc76d34 100644 --- a/src/Ganeti/WConfd/Monad.hs +++ b/src/Ganeti/WConfd/Monad.hs @@ -68,7 +68,10 @@ module Ganeti.WConfd.Monad , readTempResState ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Arrow ((&&&), second) import Control.Concurrent (forkIO, myThreadId) import Control.Exception.Lifted (bracket) diff --git a/src/Ganeti/WConfd/TempRes.hs b/src/Ganeti/WConfd/TempRes.hs index ef152ea..2f5f6a9 100644 --- a/src/Ganeti/WConfd/TempRes.hs +++ b/src/Ganeti/WConfd/TempRes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, RankNTypes, FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell, RankNTypes, FlexibleContexts, CPP #-} {-| Pure functions for manipulating reservations of temporary objects @@ -73,7 +73,10 @@ module Ganeti.WConfd.TempRes , reserved ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Lens.At import Control.Monad.Error import Control.Monad.State diff --git a/test/hs/Test/Ganeti/BasicTypes.hs b/test/hs/Test/Ganeti/BasicTypes.hs index f29d16f..1ffe8eb 100644 --- a/test/hs/Test/Ganeti/BasicTypes.hs +++ b/test/hs/Test/Ganeti/BasicTypes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -40,7 +40,10 @@ module Test.Ganeti.BasicTypes (testBasicTypes) where import Test.QuickCheck hiding (Result) import Test.QuickCheck.Function +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Monad import Test.Ganeti.TestHelper diff --git a/test/hs/Test/Ganeti/Confd/Types.hs b/test/hs/Test/Ganeti/Confd/Types.hs index 3bc7167..f1a3712 100644 --- a/test/hs/Test/Ganeti/Confd/Types.hs +++ b/test/hs/Test/Ganeti/Confd/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -42,7 +42,10 @@ module Test.Ganeti.Confd.Types , ConfdReqQ(..) ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Test.QuickCheck import Test.HUnit import qualified Text.JSON as J diff --git a/test/hs/Test/Ganeti/HTools/Instance.hs b/test/hs/Test/Ganeti/HTools/Instance.hs index dcd4b79..7e4a640 100644 --- a/test/hs/Test/Ganeti/HTools/Instance.hs +++ b/test/hs/Test/Ganeti/HTools/Instance.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -45,7 +45,10 @@ module Test.Ganeti.HTools.Instance ) where import Control.Arrow ((&&&)) +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<$>)) +#endif import Control.Monad (liftM) import Test.QuickCheck hiding (Result) diff --git a/test/hs/Test/Ganeti/HTools/Types.hs b/test/hs/Test/Ganeti/HTools/Types.hs index 7708b0a..f3b8399 100644 --- a/test/hs/Test/Ganeti/HTools/Types.hs +++ b/test/hs/Test/Ganeti/HTools/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -48,7 +48,10 @@ module Test.Ganeti.HTools.Types import Test.QuickCheck hiding (Result) import Test.HUnit +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Monad (replicateM) import Test.Ganeti.TestHelper diff --git a/test/hs/Test/Ganeti/JQScheduler.hs b/test/hs/Test/Ganeti/JQScheduler.hs index a0aa650..baa4d51 100644 --- a/test/hs/Test/Ganeti/JQScheduler.hs +++ b/test/hs/Test/Ganeti/JQScheduler.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, NamedFieldPuns #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, NamedFieldPuns, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for the job scheduler. @@ -37,14 +37,17 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Test.Ganeti.JQScheduler (testJQScheduler) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +import Data.Traversable (traverse) +#endif import Control.Lens ((&), (.~), _2) import Data.List (inits) import Data.Maybe import qualified Data.Map as Map import Data.Set (Set, difference) import qualified Data.Set as Set -import Data.Traversable (traverse) import Text.JSON (JSValue(..)) import Test.HUnit import Test.QuickCheck @@ -242,9 +245,9 @@ prop_reasonRateLimit = toRun `isSubsequenceOf` enqueued -- This is the key property: - , counterexample "no job may exceed its bucket limits, except from\ - \ jobs that were already running with exceeded\ - \ limits; those must not increase" $ + , counterexample ("no job may exceed its bucket limits, except" ++ + " from jobs that were already running with" ++ + " exceeded limits; those must not increase") $ conjoin [ if occup <= limit -- Within limits, all fine. diff --git a/test/hs/Test/Ganeti/JQueue/Objects.hs b/test/hs/Test/Ganeti/JQueue/Objects.hs index 13e0f0f..14422f5 100644 --- a/test/hs/Test/Ganeti/JQueue/Objects.hs +++ b/test/hs/Test/Ganeti/JQueue/Objects.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Unittests for 'Ganeti.JQueue.Objects'. -} @@ -39,7 +41,10 @@ module Test.Ganeti.JQueue.Objects , genJobId ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Test.QuickCheck as QuickCheck import Text.JSON diff --git a/test/hs/Test/Ganeti/Locking/Allocation.hs b/test/hs/Test/Ganeti/Locking/Allocation.hs index a4ce21b..70880f5 100644 --- a/test/hs/Test/Ganeti/Locking/Allocation.hs +++ b/test/hs/Test/Ganeti/Locking/Allocation.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Tests for lock allocation. @@ -42,7 +42,10 @@ module Test.Ganeti.Locking.Allocation , requestSucceeded ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import qualified Data.Foldable as F import qualified Data.Map as M import Data.Maybe (fromMaybe) @@ -165,8 +168,8 @@ prop_LockslistComplete = prop_LocksAllOwnersSubsetLockslist :: Property prop_LocksAllOwnersSubsetLockslist = forAll (arbitrary :: Gen (LockAllocation TestLock TestOwner)) $ \state -> - counterexample "The list of all active locks must contain all locks mentioned\ - \ in the locks state" $ + counterexample ("The list of all active locks must contain all " ++ + "locks mentioned in the locks state") $ S.isSubsetOf (S.fromList . map fst $ listAllLocksOwners state) (S.fromList $ listAllLocks state) @@ -188,8 +191,8 @@ prop_LocksAllOwnersSound :: Property prop_LocksAllOwnersSound = forAll ((arbitrary :: Gen (LockAllocation TestLock TestOwner)) `suchThat` (not . null . listAllLocksOwners)) $ \state -> - counterexample "All locks mentioned in listAllLocksOwners must be owned by\ - \ the mentioned owner" . + counterexample ("All locks mentioned in listAllLocksOwners " ++ + "must be owned by the mentioned owner") . flip all (listAllLocksOwners state) $ \(lock, owners) -> flip all owners $ \(owner, ownership) -> holdsLock owner lock ownership state diff --git a/test/hs/Test/Ganeti/Locking/Locks.hs b/test/hs/Test/Ganeti/Locking/Locks.hs index 732779f..ff8f3ca 100644 --- a/test/hs/Test/Ganeti/Locking/Locks.hs +++ b/test/hs/Test/Ganeti/Locking/Locks.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -37,7 +38,11 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Test.Ganeti.Locking.Locks (testLocking_Locks) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (liftA2) +#else import Control.Applicative ((<$>), (<*>), liftA2) +#endif import Control.Monad (liftM) import System.Posix.Types (CPid) diff --git a/test/hs/Test/Ganeti/Locking/Waiting.hs b/test/hs/Test/Ganeti/Locking/Waiting.hs index ee1a6b0..45cb589 100644 --- a/test/hs/Test/Ganeti/Locking/Waiting.hs +++ b/test/hs/Test/Ganeti/Locking/Waiting.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Tests for lock waiting structure. @@ -37,7 +37,11 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Test.Ganeti.Locking.Waiting (testLocking_Waiting) where +#if MIN_VERSION_base(4,8,0) +import Control.Applicative (liftA2) +#else import Control.Applicative ((<$>), (<*>), liftA2) +#endif import Control.Monad (liftM) import qualified Data.Map as M import qualified Data.Set as S @@ -160,8 +164,8 @@ forAllBlocked predicate = prop_WaitingRequestsGetPending :: Property prop_WaitingRequestsGetPending = forAllBlocked $ \state owner prio req -> - counterexample "After a not immediately fulfilled waiting request, owner\ - \ must have a pending request" + counterexample ("After a not immediately fulfilled waiting request, owner" ++ + " must have a pending request") . S.member owner . getPendingOwners . fst $ updateLocksWaiting prio owner req state @@ -176,9 +180,9 @@ prop_PendingGetFulfilledEventually = state'' = S.foldl (\s a -> fst $ releaseResources a s) state' $ S.union oldpending blockers finallyOwned = listLocks owner $ getAllocation state'' - in counterexample "After all blockers and old pending owners give up their\ - \ resources, a pending request must be granted\ - \ automatically" + in counterexample ("After all blockers and old pending owners give up " ++ + "their resources, a pending request must be granted" ++ + " automatically") $ all (requestSucceeded finallyOwned) req -- | Verify that the owner of a pending request gets notified once all blockers @@ -194,8 +198,8 @@ prop_PendingGetNotifiedEventually = in (s', newnotify `S.union` tonotify) (_, notified) = S.foldl releaseOneOwner (state', S.empty) $ S.union oldpending blockers - in counterexample "After all blockers and old pending owners give up their\ - \ resources, a pending owner must be notified" + in counterexample ("After all blockers and old pending owners give up" ++ + " their resources, a pending owner must be notified") $ S.member owner notified -- | Verify that some progress is made after the direct blockers give up their @@ -210,8 +214,8 @@ prop_Progress = let (s', newnotify) = releaseResources o s in (s', newnotify `S.union` tonotify) (_, notified) = S.foldl releaseOneOwner (state', S.empty) blockers - in counterexample "Some progress must be made after all blockers release\ - \ their locks" + in counterexample ("Some progress must be made after all blockers release" ++ + " their locks") . not . S.null $ notified S.\\ blockers -- | Verify that the notifications send out are sound, i.e., upon notification @@ -257,8 +261,8 @@ prop_UpdateIdempotent = forAll (arbitrary :: Gen [LockRequest TestLock]) $ \req -> let (state', (answer', _)) = updateLocks owner req state (state'', (answer'', nfy)) = updateLocks owner req state' - in conjoin [ counterexample ("repeated updateLocks waiting gave different\ - \ answers: " ++ show answer' ++ " /= " + in conjoin [ counterexample ("repeated updateLocks waiting gave different" ++ + " answers: " ++ show answer' ++ " /= " ++ show answer'') $ answer' == answer'' , counterexample "updateLocks not idempotent" $ extRepr state' == extRepr state'' @@ -273,8 +277,9 @@ prop_extReprPreserved = forAll (arbitrary :: Gen (LockWaiting TestLock TestOwner Integer)) $ \state -> let rep = extRepr state rep' = extRepr $ fromExtRepr rep - in counterexample "a lock waiting obtained from an extensional representation\ - \ must have the same extensional representation" + in counterexample ("a lock waiting obtained from an extensional" ++ + " representation must have the same" ++ + " extensional representation") $ rep' == rep -- | Verify that any state is indistinguishable from its canonical version @@ -325,8 +330,8 @@ prop_SafeUpdateWaitingCorrect = in conjoin [ counterexample ("safeUpdateLocksWaiting gave different answer: " ++ show answer' ++ " /= " ++ show answer'') $ answer' == answer'' - , counterexample ("safeUpdateLocksWaiting gave different states\ - \ after answer " ++ show answer' ++ ": " + , counterexample ("safeUpdateLocksWaiting gave different states" ++ + " after answer " ++ show answer' ++ ": " ++ show (extRepr state') ++ " /= " ++ show (extRepr state'')) $ extRepr state' == extRepr state'' @@ -342,8 +347,8 @@ prop_SafeUpdateWaitingIdempotent = forAll (arbitrary :: Gen [LockRequest TestLock]) $ \req -> let (state', (answer', _)) = safeUpdateLocksWaiting prio owner req state (state'', (answer'', nfy)) = safeUpdateLocksWaiting prio owner req state' - in conjoin [ counterexample ("repeated safeUpdateLocks waiting gave different\ - \ answers: " ++ show answer' ++ " /= " + in conjoin [ counterexample ("repeated safeUpdateLocks waiting gave" ++ + " different answers: " ++ show answer' ++ " /= " ++ show answer'') $ answer' == answer'' , counterexample "safeUpdateLocksWaiting not idempotent" $ extRepr state' == extRepr state'' @@ -368,8 +373,8 @@ prop_OpportunisticMonotone = oldOwned = listLocks a $ getAllocation state oldLocks = M.keys oldOwned newOwned = listLocks a $ getAllocation state' - in counterexample "Opportunistic union may only increase the set of locks\ - \ held" + in counterexample ("Opportunistic union may only increase the set of locks" ++ + " held") . flip all oldLocks $ \lock -> M.lookup lock newOwned >= M.lookup lock oldOwned diff --git a/test/hs/Test/Ganeti/Luxi.hs b/test/hs/Test/Ganeti/Luxi.hs index c269b8c..6efec2c 100644 --- a/test/hs/Test/Ganeti/Luxi.hs +++ b/test/hs/Test/Ganeti/Luxi.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -42,7 +42,10 @@ import Test.QuickCheck import Test.QuickCheck.Monadic (monadicIO, run, stop) import Data.List +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Concurrent (forkIO) import Control.Exception (bracket) import qualified Text.JSON as J @@ -154,8 +157,8 @@ prop_ClientServer dnschars = monadicIO $ do -- | Check that Python and Haskell define the same Luxi requests list. case_AllDefined :: Assertion case_AllDefined = do - py_stdout <- runPython "from ganeti import luxi\n\ - \print '\\n'.join(luxi.REQ_ALL)" "" >>= + py_stdout <- runPython ("from ganeti import luxi\n" ++ + "print '\\n'.join(luxi.REQ_ALL)") "" >>= checkPythonResult let py_ops = sort $ lines py_stdout hs_ops = Luxi.allLuxiCalls diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs index 857f822..da7f884 100644 --- a/test/hs/Test/Ganeti/Objects.hs +++ b/test/hs/Test/Ganeti/Objects.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances, - OverloadedStrings #-} + OverloadedStrings, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -52,7 +52,10 @@ module Test.Ganeti.Objects import Test.QuickCheck import qualified Test.HUnit as HUnit +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Monad import Data.Char import qualified Data.List as List @@ -578,18 +581,18 @@ casePyCompatNetworks = do "Network has non-ASCII fields: " ++ show net ) networks py_stdout <- - runPython "from ganeti import network\n\ - \from ganeti import objects\n\ - \from ganeti import serializer\n\ - \import sys\n\ - \net_data = serializer.Load(sys.stdin.read())\n\ - \decoded = [objects.Network.FromDict(n) for n in net_data]\n\ - \encoded = []\n\ - \for net in decoded:\n\ - \ a = network.AddressPool(net)\n\ - \ encoded.append((a.GetFreeCount(), a.GetReservedCount(), \\\n\ - \ net.ToDict()))\n\ - \print serializer.Dump(encoded)" serialized + runPython ("from ganeti import network\n" ++ + "from ganeti import objects\n" ++ + "from ganeti import serializer\n" ++ + "import sys\n" ++ + "net_data = serializer.Load(sys.stdin.read())\n" ++ + "decoded = [objects.Network.FromDict(n) for n in net_data]\n" ++ + "encoded = []\n" ++ + "for net in decoded:\n" ++ + " a = network.AddressPool(net)\n" ++ + " encoded.append((a.GetFreeCount(), a.GetReservedCount()," ++ + " \\\n net.ToDict()))\n" ++ + "print serializer.Dump(encoded)") serialized >>= checkPythonResult let deserialised = J.decode py_stdout::J.Result [(Int, Int, Network)] decoded <- case deserialised of @@ -623,13 +626,13 @@ casePyCompatNodegroups = do "Node group has non-ASCII fields: " ++ show group ) groups py_stdout <- - runPython "from ganeti import objects\n\ - \from ganeti import serializer\n\ - \import sys\n\ - \group_data = serializer.Load(sys.stdin.read())\n\ - \decoded = [objects.NodeGroup.FromDict(g) for g in group_data]\n\ - \encoded = [g.ToDict() for g in decoded]\n\ - \print serializer.Dump(encoded)" serialized + runPython ("from ganeti import objects\n" ++ + "from ganeti import serializer\n" ++ + "import sys\n" ++ + "group_data = serializer.Load(sys.stdin.read())\n" ++ + "decoded = [objects.NodeGroup.FromDict(g) for g in " ++ + "group_data]\nencoded = [g.ToDict() for g in decoded]\n" ++ + "print serializer.Dump(encoded)") serialized >>= checkPythonResult let deserialised = J.decode py_stdout::J.Result [NodeGroup] decoded <- case deserialised of @@ -724,13 +727,13 @@ casePyCompatInstances = do "Instance has non-ASCII fields: " ++ show inst ) instances py_stdout <- - runPython "from ganeti import objects\n\ - \from ganeti import serializer\n\ - \import sys\n\ - \inst_data = serializer.Load(sys.stdin.read())\n\ - \decoded = [objects.Instance.FromDict(i) for i in inst_data]\n\ - \encoded = [i.ToDict() for i in decoded]\n\ - \print serializer.Dump(encoded)" serialized + runPython ("from ganeti import objects\n" ++ + "from ganeti import serializer\n" ++ + "import sys\n" ++ + "inst_data = serializer.Load(sys.stdin.read())\n" ++ + "decoded = [objects.Instance.FromDict(i) for i " ++ + "in inst_data]\nencoded = [i.ToDict() for i in decoded]\n" ++ + "print serializer.Dump(encoded)") serialized >>= checkPythonResult let deserialised = J.decode py_stdout::J.Result [Instance] decoded <- case deserialised of diff --git a/test/hs/Test/Ganeti/OpCodes.hs b/test/hs/Test/Ganeti/OpCodes.hs index 5a96831..f4b6e84 100644 --- a/test/hs/Test/Ganeti/OpCodes.hs +++ b/test/hs/Test/Ganeti/OpCodes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -43,7 +43,10 @@ module Test.Ganeti.OpCodes import Test.HUnit as HUnit import Test.QuickCheck as QuickCheck +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Monad import Data.Char import Data.List @@ -608,11 +611,11 @@ prop_serialization = testSerialisation case_AllDefined :: HUnit.Assertion case_AllDefined = do py_stdout <- - runPython "from ganeti import opcodes\n\ - \from ganeti import serializer\n\ - \import sys\n\ - \print serializer.Dump([opid for opid in opcodes.OP_MAPPING])\n" - "" + runPython ("from ganeti import opcodes\n" ++ + "from ganeti import serializer\n" ++ + "import sys\n" ++ + "print serializer.Dump([opid for opid in " ++ + "opcodes.OP_MAPPING])\n") "" >>= checkPythonResult py_ops <- case J.decode py_stdout::J.Result [String] of J.Ok ops -> return ops @@ -659,18 +662,18 @@ case_py_compat_types = do "OpCode has non-ASCII fields: " ++ show op ) opcodes py_stdout <- - runPython "from ganeti import opcodes\n\ - \from ganeti import serializer\n\ - \import sys\n\ - \op_data = serializer.Load(sys.stdin.read())\n\ - \decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n\ - \for op in decoded:\n\ - \ op.Validate(True)\n\ - \encoded = [(op.Summary(), op.__getstate__())\n\ - \ for op in decoded]\n\ - \print serializer.Dump(\ - \ encoded,\ - \ private_encoder=serializer.EncodeWithPrivateFields)" + runPython ("from ganeti import opcodes\n" ++ + "from ganeti import serializer\n" ++ + "import sys\n" ++ + "op_data = serializer.Load(sys.stdin.read())\n" ++ + "decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n" ++ + "for op in decoded:\n" ++ + " op.Validate(True)\n" ++ + "encoded = [(op.Summary(), op.__getstate__())\n" ++ + " for op in decoded]\n" ++ + "print serializer.Dump(" ++ + " encoded," ++ + " private_encoder=serializer.EncodeWithPrivateFields)") serialized >>= checkPythonResult let deserialised = @@ -695,12 +698,12 @@ case_py_compat_fields = do let hs_fields = sort $ map (\op_id -> (op_id, OpCodes.allOpFields op_id)) OpCodes.allOpIDs py_stdout <- - runPython "from ganeti import opcodes\n\ - \import sys\n\ - \from ganeti import serializer\n\ - \fields = [(k, sorted([p[0] for p in v.OP_PARAMS]))\n\ - \ for k, v in opcodes.OP_MAPPING.items()]\n\ - \print serializer.Dump(fields)" "" + runPython ("from ganeti import opcodes\n" ++ + "import sys\n" ++ + "from ganeti import serializer\n" ++ + "fields = [(k, sorted([p[0] for p in v.OP_PARAMS]))\n" ++ + " for k, v in opcodes.OP_MAPPING.items()]\n" ++ + "print serializer.Dump(fields)") "" >>= checkPythonResult let deserialised = J.decode py_stdout::J.Result [(String, [String])] py_fields <- case deserialised of diff --git a/test/hs/Test/Ganeti/Query/Language.hs b/test/hs/Test/Ganeti/Query/Language.hs index 9556bc3..6738c00 100644 --- a/test/hs/Test/Ganeti/Query/Language.hs +++ b/test/hs/Test/Ganeti/Query/Language.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -44,7 +45,10 @@ module Test.Ganeti.Query.Language import Test.HUnit (Assertion, assertEqual) import Test.QuickCheck +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Arrow (second) import Text.JSON diff --git a/test/hs/Test/Ganeti/Rpc.hs b/test/hs/Test/Ganeti/Rpc.hs index 54711d7..4dd82fd 100644 --- a/test/hs/Test/Ganeti/Rpc.hs +++ b/test/hs/Test/Ganeti/Rpc.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -40,7 +40,10 @@ module Test.Ganeti.Rpc (testRpc) where import Test.QuickCheck import Test.QuickCheck.Monadic (monadicIO, run, stop) +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import qualified Data.Map as Map import Test.Ganeti.TestHelper diff --git a/test/hs/Test/Ganeti/SlotMap.hs b/test/hs/Test/Ganeti/SlotMap.hs index 295240d..7d3b6ec 100644 --- a/test/hs/Test/Ganeti/SlotMap.hs +++ b/test/hs/Test/Ganeti/SlotMap.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -44,14 +45,17 @@ module Test.Ganeti.SlotMap import Prelude hiding (all) +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +import Data.Traversable (traverse) +#endif import Control.Monad import Data.Foldable (all) import qualified Data.Map as Map import Data.Map (Map, member, keys, keysSet) import Data.Set (Set, size, union) import qualified Data.Set as Set -import Data.Traversable (traverse) import Test.HUnit import Test.QuickCheck @@ -251,14 +255,14 @@ prop_hasSlotsFor = oldOverfullBucks = overfullKeys sm1 newOverfullBucks = overfullKeys smOcc in conjoin - [ counterexample "if there's enough extra space, then the new\ - \ overfull keys must be as before" $ + [ counterexample ("if there's enough extra space, then the new" ++ + " overfull keys must be as before") $ fits ==> (newOverfullBucks ==? oldOverfullBucks) -- Note that the other way around does not hold: -- (newOverfullBucks == oldOverfullBucks) ==> fits - , counterexample "joining SlotMaps must not change the number of\ - \ overfull keys (but may change their slot\ - \ counts" + , counterexample ("joining SlotMaps must not change the number" ++ + " of overfull keys (but may change their slot" ++ + " counts") . property $ size newOverfullBucks >= size oldOverfullBucks ] diff --git a/test/hs/Test/Ganeti/Storage/Diskstats/Parser.hs b/test/hs/Test/Ganeti/Storage/Diskstats/Parser.hs index 8193ae9..3cea9de 100644 --- a/test/hs/Test/Ganeti/Storage/Diskstats/Parser.hs +++ b/test/hs/Test/Ganeti/Storage/Diskstats/Parser.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for the @/proc/diskstats@ parser -} @@ -41,7 +41,10 @@ import Test.HUnit import Test.Ganeti.TestHelper import Test.Ganeti.TestCommon +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<*>), (<$>)) +#endif import qualified Data.Attoparsec.Text as A import Data.Text (pack) import Text.Printf diff --git a/test/hs/Test/Ganeti/Storage/Lvm/LVParser.hs b/test/hs/Test/Ganeti/Storage/Lvm/LVParser.hs index 9a00799..a4955b8 100644 --- a/test/hs/Test/Ganeti/Storage/Lvm/LVParser.hs +++ b/test/hs/Test/Ganeti/Storage/Lvm/LVParser.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for the LV Parser -} @@ -41,7 +41,10 @@ import Test.HUnit import Test.Ganeti.TestHelper import Test.Ganeti.TestCommon +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative ((<$>), (<*>)) +#endif import Data.List (intercalate) import Ganeti.Storage.Lvm.LVParser diff --git a/test/hs/Test/Ganeti/TestCommon.hs b/test/hs/Test/Ganeti/TestCommon.hs index bcd8421..147e22e 100644 --- a/test/hs/Test/Ganeti/TestCommon.hs +++ b/test/hs/Test/Ganeti/TestCommon.hs @@ -92,7 +92,10 @@ module Test.Ganeti.TestCommon , counterexample ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Control.Exception (catchJust) import Control.Monad import Data.Attoparsec.Text (Parser, parseOnly) diff --git a/test/hs/Test/Ganeti/TestHelper.hs b/test/hs/Test/Ganeti/TestHelper.hs index 399ad58..6d07b27 100644 --- a/test/hs/Test/Ganeti/TestHelper.hs +++ b/test/hs/Test/Ganeti/TestHelper.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-| Unittest helpers for TemplateHaskell components. @@ -39,7 +40,10 @@ module Test.Ganeti.TestHelper , genArbitrary ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Data.List (stripPrefix, isPrefixOf) import Data.Maybe (fromMaybe) import Test.Framework diff --git a/test/hs/Test/Ganeti/Types.hs b/test/hs/Test/Ganeti/Types.hs index 12f957a..7e33e01 100644 --- a/test/hs/Test/Ganeti/Types.hs +++ b/test/hs/Test/Ganeti/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -47,7 +48,10 @@ module Test.Ganeti.Types , genReasonTrail ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import System.Time (ClockTime(..)) import Test.QuickCheck as QuickCheck hiding (Result) diff --git a/test/hs/Test/Ganeti/Utils.hs b/test/hs/Test/Ganeti/Utils.hs index bee30e2..d461f48 100644 --- a/test/hs/Test/Ganeti/Utils.hs +++ b/test/hs/Test/Ganeti/Utils.hs @@ -40,14 +40,14 @@ module Test.Ganeti.Utils (testUtils) where import Test.QuickCheck hiding (Result) import Test.HUnit -import Control.Applicative ((<$>), (<*>)) -import Data.Char (isSpace) -import qualified Data.Either as Either #if MIN_VERSION_base(4,8,0) import Data.List hiding (isSubsequenceOf) #else +import Control.Applicative ((<$>), (<*>)) import Data.List #endif +import Data.Char (isSpace) +import qualified Data.Either as Either import Data.Maybe (listToMaybe) import qualified Data.Set as S import System.Time diff --git a/test/hs/Test/Ganeti/Utils/MultiMap.hs b/test/hs/Test/Ganeti/Utils/MultiMap.hs index 3656841..a811688 100644 --- a/test/hs/Test/Ganeti/Utils/MultiMap.hs +++ b/test/hs/Test/Ganeti/Utils/MultiMap.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -39,7 +40,10 @@ module Test.Ganeti.Utils.MultiMap ( testUtils_MultiMap ) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import qualified Data.Set as S import qualified Data.Map as M diff --git a/test/hs/Test/Ganeti/WConfd/TempRes.hs b/test/hs/Test/Ganeti/WConfd/TempRes.hs index 768804c..c2adda0 100644 --- a/test/hs/Test/Ganeti/WConfd/TempRes.hs +++ b/test/hs/Test/Ganeti/WConfd/TempRes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Tests for temporary configuration resources allocation @@ -37,7 +37,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Test.Ganeti.WConfd.TempRes (testWConfd_TempRes) where +#if MIN_VERSION_base(4,8,0) +#else import Control.Applicative +#endif import Test.QuickCheck diff --git a/test/hs/htest.hs b/test/hs/htest.hs index 86d193e..f48df21 100644 --- a/test/hs/htest.hs +++ b/test/hs/htest.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Unittest runner for ganeti-htools. -} @@ -34,7 +36,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Main(main) where +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid (mappend) +#endif import Test.Framework import System.Environment (getArgs) import System.Log.Logger -- 2.5.0.276.gf5e568e
