[commit: packages/binary] master: Add Binary instances for datatypes in Data.Monoid/Data.Semigroup (2e1c4b2)
git at git.haskell.org
git at git.haskell.org
Sat Feb 4 21:17:21 UTC 2017
Repository : ssh://git@git.haskell.org/binary
On branch : master
Link : http://git.haskell.org/packages/binary.git/commitdiff/2e1c4b2a9ca1722429ef5eb23015f30055d7aef9
>---------------------------------------------------------------
commit 2e1c4b2a9ca1722429ef5eb23015f30055d7aef9
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date: Wed May 11 10:13:21 2016 -0400
Add Binary instances for datatypes in Data.Monoid/Data.Semigroup
This adds simple `Binary` instances for:
1. The newtype wrappers in `Data.Monoid`
2. The datatypes brought into `base` (from `semigroups`) in `base-4.9`:
* The datatypes in `Data.Semigroup`
* `Data.List.NonEmpty.NonEmpty`
Fixes #107.
>---------------------------------------------------------------
2e1c4b2a9ca1722429ef5eb23015f30055d7aef9
src/Data/Binary/Class.hs | 102 +++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 102 insertions(+)
diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs
index 19d00ae..4526f09 100644
--- a/src/Data/Binary/Class.hs
+++ b/src/Data/Binary/Class.hs
@@ -2,6 +2,10 @@
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE Safe #-}
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds #-}
+#endif
+
#if MIN_VERSION_base(4,8,0)
#define HAS_NATURAL
#define HAS_VOID
@@ -55,7 +59,12 @@ import Data.Binary.Get
import Control.Applicative
import Data.Monoid (mempty)
#endif
+import qualified Data.Monoid as Monoid
import Data.Monoid ((<>))
+#if MIN_VERSION_base(4,9,0)
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Semigroup as Semigroup
+#endif
import Control.Monad
import Data.ByteString.Lazy (ByteString)
@@ -699,3 +708,96 @@ instance Binary Fingerprint where
instance Binary Version where
put (Version br tags) = put br <> put tags
get = Version <$> get <*> get
+
+------------------------------------------------------------------------
+-- Data.Monoid datatypes
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Monoid.Dual a) where
+ get = fmap Monoid.Dual get
+ put = put . Monoid.getDual
+
+-- | /Since: 0.8.4.0/
+instance Binary Monoid.All where
+ get = fmap Monoid.All get
+ put = put . Monoid.getAll
+
+-- | /Since: 0.8.4.0/
+instance Binary Monoid.Any where
+ get = fmap Monoid.Any get
+ put = put . Monoid.getAny
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Monoid.Sum a) where
+ get = fmap Monoid.Sum get
+ put = put . Monoid.getSum
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Monoid.Product a) where
+ get = fmap Monoid.Product get
+ put = put . Monoid.getProduct
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Monoid.First a) where
+ get = fmap Monoid.First get
+ put = put . Monoid.getFirst
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Monoid.Last a) where
+ get = fmap Monoid.Last get
+ put = put . Monoid.getLast
+
+#if MIN_VERSION_base(4,8,0)
+-- | /Since: 0.8.4.0/
+instance Binary (f a) => Binary (Monoid.Alt f a) where
+ get = fmap Monoid.Alt get
+ put = put . Monoid.getAlt
+#endif
+
+#if MIN_VERSION_base(4,9,0)
+------------------------------------------------------------------------
+-- Data.Semigroup datatypes
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Semigroup.Min a) where
+ get = fmap Semigroup.Min get
+ put = put . Semigroup.getMin
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Semigroup.Max a) where
+ get = fmap Semigroup.Max get
+ put = put . Semigroup.getMax
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Semigroup.First a) where
+ get = fmap Semigroup.First get
+ put = put . Semigroup.getFirst
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Semigroup.Last a) where
+ get = fmap Semigroup.Last get
+ put = put . Semigroup.getLast
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (Semigroup.Option a) where
+ get = fmap Semigroup.Option get
+ put = put . Semigroup.getOption
+
+-- | /Since: 0.8.4.0/
+instance Binary m => Binary (Semigroup.WrappedMonoid m) where
+ get = fmap Semigroup.WrapMonoid get
+ put = put . Semigroup.unwrapMonoid
+
+-- | /Since: 0.8.4.0/
+instance (Binary a, Binary b) => Binary (Semigroup.Arg a b) where
+ get = liftM2 Semigroup.Arg get get
+ put (Semigroup.Arg a b) = put a <> put b
+
+------------------------------------------------------------------------
+-- Non-empty lists
+
+-- | /Since: 0.8.4.0/
+instance Binary a => Binary (NE.NonEmpty a) where
+ get = fmap NE.fromList get
+ put = put . NE.toList
+#endif
More information about the ghc-commits
mailing list