Fix compilation on GHC >= 8.0

protobuf.cabal

@@ -59,6 +59,9 @@ library
   ghc-options:
     -Wall
 
+  if impl(ghc < 8.0)
+    build-depends: semigroups == 0.18.*
+
 -- executable protoc-gen-hs
   -- default-language:
     -- Haskell2010

src/Data/Binary/Builder/Sized.hs

@@ -4,13 +4,17 @@ import qualified Data.ByteString.Builder as B
 import Data.Monoid (mempty, mappend, Monoid)
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString as BS
+import Data.Semigroup (Semigroup, (<>))
 import qualified Data.Word as W
 
 data Builder = Builder {-# UNPACK #-} !Int B.Builder
 
+instance Semigroup Builder where
+  Builder i b <> Builder i' b' = Builder (i + i') (mappend b b')
+
 instance Monoid Builder where
   mempty = Builder 0 mempty
-  (Builder i b) `mappend` (Builder i' b') = Builder (i + i') (mappend b b')
+  mappend = (<>)
 
 toLazyByteString :: Builder -> LBS.ByteString
 toLazyByteString (Builder _ b) = B.toLazyByteString b

src/Data/ProtocolBuffers/Message.hs

@@ -17,9 +17,10 @@ module Data.ProtocolBuffers.Message
 import Control.Applicative
 import Control.DeepSeq (NFData(..))
 import Data.Foldable
-import Data.Monoid
+import Data.Monoid hiding ((<>))
 import Data.Binary.Get
 import Data.Traversable
+import Data.Semigroup (Semigroup(..))
 
 import GHC.Generics
 import GHC.TypeLits
@@ -96,9 +97,12 @@ import qualified Data.ByteString.Lazy as LBS
 newtype Message m = Message {runMessage :: m}
   deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
 
+instance (Generic m, GMessageMonoid (Rep m)) => Semigroup (Message m) where
+  Message x <> Message y = Message . to $ gmappend (from x) (from y)
+
 instance (Generic m, GMessageMonoid (Rep m)) => Monoid (Message m) where
   mempty = Message . to $ gmempty
-  Message x `mappend` Message y = Message . to $ gmappend (from x) (from y)
+  mappend = (<>)
 
 instance (Decode a, Monoid (Message a), KnownNat n) => GDecode (K1 i (Field n (RequiredField (Always (Message a))))) where
   gdecode = fieldDecode (Required . Always)

src/Data/ProtocolBuffers/Types.hs

@@ -29,7 +29,8 @@ module Data.ProtocolBuffers.Types
 import Control.DeepSeq (NFData)
 import Data.Bits
 import Data.Foldable as Fold
-import Data.Monoid
+import Data.Monoid hiding ((<>))
+import Data.Semigroup (Semigroup(..))
 import Data.Traversable
 import Data.Typeable
 
@@ -38,33 +39,33 @@ import GHC.TypeLits
 -- |
 -- 'Value' selects the normal/typical way for encoding scalar (primitive) values.
 newtype Value a       = Value       {runValue       :: a}
-  deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
+  deriving (Bounded, Eq, Enum, Foldable, Functor, Semigroup, Monoid, Ord, NFData, Show, Traversable, Typeable)
 
 -- |
 -- 'RequiredField' is a newtype wrapped used to break overlapping instances
 -- for encoding and decoding values
 newtype RequiredField a    = Required    {runRequired    :: a}
-  deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
+  deriving (Bounded, Eq, Enum, Foldable, Functor, Semigroup, Monoid, Ord, NFData, Show, Traversable, Typeable)
 
 -- |
 -- 'OptionalField' is a newtype wrapped used to break overlapping instances
 -- for encoding and decoding values
 newtype OptionalField a    = Optional    {runOptional    :: a}
-  deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
+  deriving (Bounded, Eq, Enum, Foldable, Functor, Semigroup, Monoid, Ord, NFData, Show, Traversable, Typeable)
 
 -- |
 -- 'RepeatedField' is a newtype wrapped used to break overlapping instances
 -- for encoding and decoding values
 newtype RepeatedField a    = Repeated    {runRepeated    :: a}
-  deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
+  deriving (Bounded, Eq, Enum, Foldable, Functor, Semigroup, Monoid, Ord, NFData, Show, Traversable, Typeable)
 
 -- |
 -- Fields are merely a way to hold a field tag along with its type, this shouldn't normally be referenced directly.
 --
 -- This provides better error messages than older versions which used 'Data.Tagged.Tagged'
 --
 newtype Field (n :: Nat) a = Field {runField :: a}
-  deriving (Bounded, Eq, Enum, Foldable, Functor, Monoid, Ord, NFData, Show, Traversable, Typeable)
+  deriving (Bounded, Eq, Enum, Foldable, Functor, Semigroup, Monoid, Ord, NFData, Show, Traversable, Typeable)
 
 -- |
 -- To provide consistent instances for serialization a 'Traversable' 'Functor' is needed to
@@ -74,9 +75,12 @@ newtype Field (n :: Nat) a = Field {runField :: a}
 newtype Always a = Always {runAlways :: a}
   deriving (Bounded, Eq, Enum, Foldable, Functor, Ord, NFData, Show, Traversable, Typeable)
 
+instance Semigroup (Always a) where
+  _ <> y = y
+
 instance Monoid (Always a) where
   mempty = error "Always is not a Monoid"
-  mappend _ y = y
+  mappend = (<>)
 
 -- |
 -- Functions for wrapping and unwrapping record fields.
@@ -175,24 +179,24 @@ type Packed n a = Field n (PackedField (PackedList a))
 -- |
 -- 'Enumeration' fields use 'Prelude.fromEnum' and 'Prelude.toEnum' when encoding and decoding messages.
 newtype Enumeration a = Enumeration {runEnumeration :: a}
-  deriving (Bounded, Eq, Enum, Foldable, Functor, Ord, Monoid, NFData, Show, Traversable, Typeable)
+  deriving (Bounded, Eq, Enum, Foldable, Functor, Ord, Semigroup, Monoid, NFData, Show, Traversable, Typeable)
 
 -- |
 -- A 'Traversable' 'Functor' used to select packed sequence encoding/decoding.
 newtype PackedField a = PackedField {runPackedField :: a}
-  deriving (Eq, Foldable, Functor, Monoid, NFData, Ord, Show, Traversable, Typeable)
+  deriving (Eq, Foldable, Functor, Semigroup, Monoid, NFData, Ord, Show, Traversable, Typeable)
 
 -- |
 -- A list that is stored in a packed format.
 newtype PackedList a = PackedList {unPackedList :: [a]}
-  deriving (Eq, Foldable, Functor, Monoid, NFData, Ord, Show, Traversable, Typeable)
+  deriving (Eq, Foldable, Functor, Semigroup, Monoid, NFData, Ord, Show, Traversable, Typeable)
 
 -- |
 -- Signed integers are stored in a zz-encoded form.
 newtype Signed a = Signed a
-  deriving (Bits, Bounded, Enum, Eq, Floating, Foldable, Fractional, Functor, Integral, Monoid, NFData, Num, Ord, Real, RealFloat, RealFrac, Show, Traversable, Typeable)
+  deriving (Bits, Bounded, Enum, Eq, Floating, Foldable, Fractional, Functor, Integral, Semigroup, Monoid, NFData, Num, Ord, Real, RealFloat, RealFrac, Show, Traversable, Typeable)
 
 -- |
 -- Fixed integers are stored in little-endian form without additional encoding.
 newtype Fixed a = Fixed a
-  deriving (Bits, Bounded, Enum, Eq, Floating, Foldable, Fractional, Functor, Integral, Monoid, NFData, Num, Ord, Real, RealFloat, RealFrac, Show, Traversable, Typeable)
+  deriving (Bits, Bounded, Enum, Eq, Floating, Foldable, Fractional, Functor, Integral, Semigroup, Monoid, NFData, Num, Ord, Real, RealFloat, RealFrac, Show, Traversable, Typeable)