From 81a2d29cdca3c2dcad6d97ddfb5b1b5193f7736a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Thu, 26 Nov 2015 15:23:32 +0100 Subject: [PATCH] Fix ghc-7.4 build --- Data/Binary/Generic.hs | 60 ++++++++++++++++---------------- Language/Haskell/GhcMod/Types.hs | 30 ++++++++-------- System/Directory/ModTime.hs | 2 +- 3 files changed, 46 insertions(+), 46 deletions(-) diff --git a/Data/Binary/Generic.hs b/Data/Binary/Generic.hs index bc040cd..906b081 100644 --- a/Data/Binary/Generic.hs +++ b/Data/Binary/Generic.hs @@ -18,43 +18,43 @@ module Data.Binary.Generic where import Control.Applicative -import Data.Binary hiding (GBinary(..)) +import Data.Binary import Data.Bits import GHC.Generics import Prelude -class GBinary f where - gput :: f t -> Put - gget :: Get (f t) +class GGBinary f where + ggput :: f t -> Put + ggget :: Get (f t) -- Type without constructors -instance GBinary V1 where - gput _ = return () - gget = return undefined +instance GGBinary V1 where + ggput _ = return () + ggget = return undefined -- Constructor without arguments -instance GBinary U1 where - gput U1 = return () - gget = return U1 +instance GGBinary U1 where + ggput U1 = return () + ggget = return U1 -- Product: constructor with parameters -instance (GBinary a, GBinary b) => GBinary (a :*: b) where - gput (x :*: y) = gput x >> gput y - gget = (:*:) <$> gget <*> gget +instance (GGBinary a, GGBinary b) => GGBinary (a :*: b) where + ggput (x :*: y) = ggput x >> ggput y + ggget = (:*:) <$> ggget <*> ggget -- Metadata (constructor name, etc) -instance GBinary a => GBinary (M1 i c a) where - gput = gput . unM1 - gget = M1 <$> gget +instance GGBinary a => GGBinary (M1 i c a) where + ggput = ggput . unM1 + ggget = M1 <$> ggget -- Constants, additional parameters, and rank-1 recursion -instance Binary a => GBinary (K1 i a) where - gput = put . unK1 - gget = K1 <$> get +instance Binary a => GGBinary (K1 i a) where + ggput = put . unK1 + ggget = K1 <$> get -- Borrowed from the cereal package. --- The following GBinary instance for sums has support for serializing +-- The following GGBinary instance for sums has support for serializing -- types with up to 2^64-1 constructors. It will use the minimal -- number of bytes needed to encode the constructor. For example when -- a type has 2^8 constructors or less it will use a single byte to @@ -66,19 +66,19 @@ instance Binary a => GBinary (K1 i a) where #define GETSUM(WORD) GUARD(WORD) = (get :: Get WORD) >>= checkGetSum (fromIntegral size) instance ( GSum a, GSum b - , GBinary a, GBinary b - , SumSize a, SumSize b) => GBinary (a :+: b) where - gput | PUTSUM(Word8) | PUTSUM(Word16) | PUTSUM(Word32) | PUTSUM(Word64) + , GGBinary a, GGBinary b + , SumSize a, SumSize b) => GGBinary (a :+: b) where + ggput | PUTSUM(Word8) | PUTSUM(Word16) | PUTSUM(Word32) | PUTSUM(Word64) | otherwise = sizeError "encode" size where size = unTagged (sumSize :: Tagged (a :+: b) Word64) - {-# INLINE gput #-} + {-# INLINE ggput #-} - gget | GETSUM(Word8) | GETSUM(Word16) | GETSUM(Word32) | GETSUM(Word64) + ggget | GETSUM(Word8) | GETSUM(Word16) | GETSUM(Word32) | GETSUM(Word64) | otherwise = sizeError "decode" size where size = unTagged (sumSize :: Tagged (a :+: b) Word64) - {-# INLINE gget #-} + {-# INLINE ggget #-} sizeError :: Show size => String -> size -> error sizeError s size = @@ -96,7 +96,7 @@ class GSum f where getSum :: (Ord word, Num word, Bits word) => word -> word -> Get (f a) putSum :: (Num w, Bits w, Binary w) => w -> w -> f a -> Put -instance (GSum a, GSum b, GBinary a, GBinary b) => GSum (a :+: b) where +instance (GSum a, GSum b, GGBinary a, GGBinary b) => GSum (a :+: b) where getSum !code !size | code < sizeL = L1 <$> getSum code sizeL | otherwise = R1 <$> getSum (code - sizeL) sizeR where @@ -112,11 +112,11 @@ instance (GSum a, GSum b, GBinary a, GBinary b) => GSum (a :+: b) where sizeR = size - sizeL {-# INLINE putSum #-} -instance GBinary a => GSum (C1 c a) where - getSum _ _ = gget +instance GGBinary a => GSum (C1 c a) where + getSum _ _ = ggget {-# INLINE getSum #-} - putSum !code _ x = put code *> gput x + putSum !code _ x = put code *> ggput x {-# INLINE putSum #-} ------------------------------------------------------------------------ diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 5e6714d..1f5ec41 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -15,7 +15,7 @@ import Control.Exception (Exception) import Control.Applicative import Control.Concurrent import Control.Monad -import Data.Binary hiding (gput, gget) +import Data.Binary import Data.Binary.Generic import Data.Map (Map) import qualified Data.Map as Map @@ -231,8 +231,8 @@ data GhcPkgDb = GlobalDb deriving (Eq, Show, Generic) instance Binary GhcPkgDb where - put = gput . from - get = to `fmap` gget + put = ggput . from + get = to `fmap` ggget -- | A single GHC command line option. type GHCOption = String @@ -304,14 +304,14 @@ data GmComponent (t :: GmComponentType) eps = GmComponent { } deriving (Eq, Ord, Show, Read, Generic, Functor) instance Binary eps => Binary (GmComponent t eps) where - put = gput . from - get = to `fmap` gget + put = ggput . from + get = to `fmap` ggget data ModulePath = ModulePath { mpModule :: ModuleName, mpPath :: FilePath } deriving (Eq, Ord, Show, Read, Generic, Typeable) instance Binary ModulePath where - put = gput . from - get = to `fmap` gget + put = ggput . from + get = to `fmap` ggget instance Binary ModuleName where get = mkModuleName <$> get @@ -372,17 +372,17 @@ instance Error GhcModError where instance Exception GhcModError instance Binary CabalHelper.Programs where - put = gput . from - get = to `fmap` gget + put = ggput . from + get = to `fmap` ggget instance Binary ChModuleName where - put = gput . from - get = to `fmap` gget + put = ggput . from + get = to `fmap` ggget instance Binary ChComponentName where - put = gput . from - get = to `fmap` gget + put = ggput . from + get = to `fmap` ggget instance Binary ChEntrypoint where - put = gput . from - get = to `fmap` gget + put = ggput . from + get = to `fmap` ggget mkLabel ''GhcModCaches mkLabel ''GhcModState diff --git a/System/Directory/ModTime.hs b/System/Directory/ModTime.hs index f8c552a..8a4eeee 100644 --- a/System/Directory/ModTime.hs +++ b/System/Directory/ModTime.hs @@ -48,7 +48,7 @@ instance Binary ModTime where put (ModTime (TOD s ps)) = put s >> put ps get = - ModTime . TOD <$> get <*> get + ModTime <$> (TOD <$> get <*> get) #endif