[Pkg-ganeti-devel] [ganeti] 02/03: Revert "Fix compilation with GHC 7.10/base-4.8"
Apollon Oikonomopoulos
apoikos at moszumanska.debian.org
Mon Jan 4 09:13:38 UTC 2016
This is an automated email from the git hooks/post-receive script.
apoikos pushed a commit to branch debian/backports/jessie
in repository ganeti.
commit fe8e9ef3bc45dce6c578aceef40f9ffad245290f
Author: Apollon Oikonomopoulos <apoikos at debian.org>
Date: Sun Jan 3 21:40:01 2016 +0200
Revert "Fix compilation with GHC 7.10/base-4.8"
This reverts commit 7dc7b490215ed1a9707d1d5e350630eb250a578d.
---
debian/patches/ghc-7.10-compatibility.patch | 216 ----------------------------
debian/patches/series | 1 -
2 files changed, 217 deletions(-)
diff --git a/debian/patches/ghc-7.10-compatibility.patch b/debian/patches/ghc-7.10-compatibility.patch
deleted file mode 100644
index 557d65f..0000000
--- a/debian/patches/ghc-7.10-compatibility.patch
+++ /dev/null
@@ -1,216 +0,0 @@
-commit 3aaf10bfa95efec2f2a667cae34caf76b0a0370b
-Author: Bhimanavajjula Aditya <bsrk at google.com>
-Date: Wed Sep 9 12:10:22 2015 +0200
-
- Define MonadPlus instance definitions using Alternative
-
- This is a compatibility fix for base-4.8. All MonadPlus definitions
- have Alternative as a prerequisite. Hence, instead of defining
- Alternative in terms of MonadPlus, we define MonadPlus in terms of
- Alternative.
-
- Signed-off-by: Bhimanavajjula Aditya <bsrk at google.com>
- Signed-off-by: Petr Pudlak <pudlak at google.com>
- Reviewed-by: Petr Pudlak <pudlak at google.com>
-
---- a/src/Ganeti/BasicTypes.hs
-+++ b/src/Ganeti/BasicTypes.hs
-@@ -123,13 +123,17 @@
- fmap _ (Bad msg) = Bad msg
- fmap fn (Ok val) = Ok (fn val)
-
--instance (Error a, Monoid a) => MonadPlus (GenericResult a) where
-- mzero = Bad $ strMsg "zero Result when used as MonadPlus"
-+instance (Error a, Monoid a) => Alternative (GenericResult a) where
-+ empty = Bad $ strMsg "zero Result when used as empty"
- -- for mplus, when we 'add' two Bad values, we concatenate their
- -- error descriptions
-- (Bad x) `mplus` (Bad y) = Bad (x `mappend` strMsg "; " `mappend` y)
-- (Bad _) `mplus` x = x
-- x@(Ok _) `mplus` _ = x
-+ (Bad x) <|> (Bad y) = Bad (x `mappend` strMsg "; " `mappend` y)
-+ (Bad _) <|> x = x
-+ x@(Ok _) <|> _ = x
-+
-+instance (Error a, Monoid a) => MonadPlus (GenericResult a) where
-+ mzero = empty
-+ mplus = (<|>)
-
- instance (Error a) => MonadError a (GenericResult a) where
- throwError = Bad
-@@ -143,10 +147,6 @@
- _ <*> (Bad x) = Bad x
- (Ok f) <*> (Ok x) = Ok $ f x
-
--instance (Error a, Monoid a) => Alternative (GenericResult a) where
-- empty = mzero
-- (<|>) = mplus
--
- -- | This is a monad transformation for Result. It's implementation is
- -- based on the implementations of MaybeT and ErrorT.
- --
-@@ -233,17 +233,18 @@
- {-# INLINE liftBaseWith #-}
- {-# INLINE restoreM #-}
-
--instance (Monad m, Error a, Monoid a) => MonadPlus (ResultT a m) where
-- mzero = ResultT $ return mzero
-+instance (Monad m, Error a, Monoid a)
-+ => Alternative (ResultT a m) where
-+ empty = ResultT $ return mzero
- -- Ensure that 'y' isn't run if 'x' contains a value. This makes it a bit
- -- more complicated than 'mplus' of 'GenericResult'.
-- mplus x y = elimResultT combine return x
-+ x <|> y = elimResultT combine return x
- where combine x' = ResultT $ liftM (mplus (Bad x')) (runResultT y)
-
--instance (Alternative m, Monad m, Error a, Monoid a)
-- => Alternative (ResultT a m) where
-- empty = mzero
-- (<|>) = mplus
-+instance (Monad m, Error a, Monoid a)
-+ => MonadPlus (ResultT a m) where
-+ mzero = empty
-+ mplus = (<|>)
-
- -- | Changes the error message of a result value, if present.
- -- Note that since 'GenericResult' is also a 'MonadError', this function
---- a/src/Ganeti/Utils.hs
-+++ b/src/Ganeti/Utils.hs
-@@ -1,4 +1,4 @@
--{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
-+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, CPP #-}
-
- {-| Utility functions. -}
-
-@@ -109,7 +109,11 @@
- import qualified Data.Either as E
- import Data.Function (on)
- import Data.IORef
-+#if MIN_VERSION_base(4,8,0)
-+import Data.List hiding (isSubsequenceOf)
-+#else
- import Data.List
-+#endif
- import qualified Data.Map as M
- import Data.Maybe (fromMaybe)
- import qualified Data.Set as S
---- a/test/hs/Test/Ganeti/Utils.hs
-+++ b/test/hs/Test/Ganeti/Utils.hs
-@@ -43,7 +43,11 @@
- 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 Data.List
-+#endif
- import Data.Maybe (listToMaybe)
- import qualified Data.Set as S
- import System.Time
---- a/src/Ganeti/Hypervisor/Xen/XmParser.hs
-+++ b/src/Ganeti/Hypervisor/Xen/XmParser.hs
-@@ -71,7 +71,7 @@
- doubleP = LCDouble <$> A.rational <* A.skipSpace <* A.endOfInput
- innerDoubleP = LCDouble <$> A.rational
- stringP = LCString . unpack <$> A.takeWhile1 (not . (\c -> isSpace c
-- || c `elem` "()"))
-+ || c `elem` ("()" :: String)))
- wspace = AC.many1 A.space
- rparen = A.skipSpace *> A.char ')'
- finalP = listConfigP <* rparen
-@@ -163,5 +163,5 @@
- uptimeLineParser = do
- name <- A.takeTill isSpace <* A.skipSpace
- idNum <- A.decimal <* A.skipSpace
-- uptime <- A.takeTill (`elem` "\n\r") <* A.skipSpace
-+ uptime <- A.takeTill (`elem` ("\n\r" :: String)) <* A.skipSpace
- return . UptimeInfo (unpack name) idNum $ unpack uptime
---- a/src/Ganeti/Query/Filter.hs
-+++ b/src/Ganeti/Query/Filter.hs
-@@ -183,10 +183,10 @@
- -- note: the next two implementations are the same, but we have to
- -- repeat them due to the encapsulation done by FilterValue
- containsFilter (QuotedString val) lst = do
-- lst' <- fromJVal lst
-+ lst' <- fromJVal lst :: ErrorResult [String]
- return $! val `elem` lst'
- containsFilter (NumericValue val) lst = do
-- lst' <- fromJVal lst
-+ lst' <- fromJVal lst :: ErrorResult [Integer]
- return $! val `elem` lst'
-
-
---- a/src/Ganeti/THH.hs
-+++ b/src/Ganeti/THH.hs
-@@ -1164,8 +1164,13 @@
- -> Q [Dec]
- genDictObject save_fn load_fn sname fields = do
- let name = mkName sname
-+ -- newName fails in ghc 7.10 when used on keywords
-+ newName' "data" = newName "data_ghcBug10599"
-+ newName' "instance" = newName "instance_ghcBug10599"
-+ newName' "type" = newName "type_ghcBug10599"
-+ newName' s = newName s
- -- toDict
-- fnames <- mapM (newName . fieldVariable) fields
-+ fnames <- mapM (newName' . fieldVariable) fields
- let pat = conP name (map varP fnames)
- tdexp = [| concat $(listE $ zipWith save_fn fnames fields) |]
- tdclause <- clause [pat] (normalB tdexp) []
---- a/src/Ganeti/Query/Language.hs
-+++ b/src/Ganeti/Query/Language.hs
-@@ -94,7 +94,8 @@
-
- -- | No-op 'NFData' instance for 'ResultStatus', since it's a single
- -- constructor data-type.
--instance NFData ResultStatus
-+instance NFData ResultStatus where
-+ rnf x = seq x ()
-
- -- | Check that ResultStatus is success or fail with descriptive
- -- message.
---- a/src/Ganeti/OpParams.hs
-+++ b/src/Ganeti/OpParams.hs
-@@ -903,12 +903,12 @@
- pRequiredNodes :: Field
- pRequiredNodes =
- withDoc "Required list of node names" .
-- renameField "ReqNodes " $ simpleField "nodes" [t| [NonEmptyString] |]
-+ renameField "ReqNodes" $ simpleField "nodes" [t| [NonEmptyString] |]
-
- pRequiredNodeUuids :: Field
- pRequiredNodeUuids =
- withDoc "Required list of node UUIDs" .
-- renameField "ReqNodeUuids " . optionalField $
-+ renameField "ReqNodeUuids" . optionalField $
- simpleField "node_uuids" [t| [NonEmptyString] |]
-
- pRestrictedCommand :: Field
-@@ -1519,7 +1519,7 @@
- pDiskIndex :: Field
- pDiskIndex =
- withDoc "Disk index for e.g. grow disk" .
-- renameField "DiskIndex " $ simpleField "disk" [t| DiskIndex |]
-+ renameField "DiskIndex" $ simpleField "disk" [t| DiskIndex |]
-
- pDiskChgAmount :: Field
- pDiskChgAmount =
-@@ -1740,7 +1740,7 @@
- pIAllocatorInstances :: Field
- pIAllocatorInstances =
- withDoc "IAllocator instances field" .
-- renameField "IAllocatorInstances " .
-+ renameField "IAllocatorInstances" .
- optionalField $
- simpleField "instances" [t| [NonEmptyString] |]
-
---- a/src/Ganeti/WConfd/ConfigModifications.hs
-+++ b/src/Ganeti/WConfd/ConfigModifications.hs
-@@ -1,4 +1,4 @@
--{-# LANGUAGE TemplateHaskell #-}
-+{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}
-
- {-| The WConfd functions for direct configuration manipulation
-
diff --git a/debian/patches/series b/debian/patches/series
index 12a1ea2..5a710d9 100644
--- a/debian/patches/series
+++ b/debian/patches/series
@@ -1,4 +1,3 @@
do-not-backup-export-dir.patch
Makefile.am-use-C.UTF-8
relax-deps
-ghc-7.10-compatibility.patch
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ganeti/ganeti.git
More information about the Pkg-ganeti-devel
mailing list