[commit: packages/binary] master: Canonicalise Monad instances (b8adfe6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/binary

On branch  : master
Link       : http://git.haskell.org/packages/binary.git/commitdiff/b8adfe6d61d3152a947dd8efb87e8024e3faa7c6

>---------------------------------------------------------------

commit b8adfe6d61d3152a947dd8efb87e8024e3faa7c6
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Tue Nov 24 14:49:03 2015 +0100

    Canonicalise Monad instances
    
    This avoids potential performance issues as well as
    future proofing code.


>---------------------------------------------------------------

b8adfe6d61d3152a947dd8efb87e8024e3faa7c6
 src/Data/Binary/Get/Internal.hs |  2 +-
 src/Data/Binary/Put.hs          | 21 +++++++++++++--------
 2 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs
index 3669242..2c5def9 100644
--- a/src/Data/Binary/Get/Internal.hs
+++ b/src/Data/Binary/Get/Internal.hs
@@ -91,7 +91,7 @@ newtype Get a = C { runCont :: forall r.
 type Success a r = B.ByteString -> a -> Decoder r
 
 instance Monad Get where
-  return = returnG
+  return = pure
   (>>=) = bindG
   fail = failG
 
diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs
index 5ada9b2..a05bfc7 100644
--- a/src/Data/Binary/Put.hs
+++ b/src/Data/Binary/Put.hs
@@ -84,27 +84,32 @@ instance Functor PutM where
         {-# INLINE fmap #-}
 
 instance Applicative PutM where
-        pure    = return
+        pure a  = Put $ PairS a mempty
+        {-# INLINE pure #-}
+
         m <*> k = Put $
             let PairS f w  = unPut m
                 PairS x w' = unPut k
             in PairS (f x) (w `mappend` w')
 
+        m *> k  = Put $
+            let PairS _ w  = unPut m
+                PairS b w' = unPut k
+            in PairS b (w `mappend` w')
+        {-# INLINE (*>) #-}
+
 -- Standard Writer monad, with aggressive inlining
 instance Monad PutM where
-    return a = Put $ PairS a mempty
-    {-# INLINE return #-}
-
     m >>= k  = Put $
         let PairS a w  = unPut m
             PairS b w' = unPut (k a)
         in PairS b (w `mappend` w')
     {-# INLINE (>>=) #-}
 
-    m >> k  = Put $
-        let PairS _ w  = unPut m
-            PairS b w' = unPut k
-        in PairS b (w `mappend` w')
+    return = pure
+    {-# INLINE return #-}
+
+    (>>) = (*>)
     {-# INLINE (>>) #-}
 
 tell :: Builder -> Put