From b914a25de326dd937e3a1d05f4eefb46af6da7b4 Mon Sep 17 00:00:00 2001
From: Inari Listenmaa <inari.listenmaa@gmail.com>
Date: Mon, 9 Sep 2024 19:43:39 +0200
Subject: define return in terms of pure, >> as *>, mappend as <>

In preparation for deprecation, see https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid and https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return
---
 src/runtime/haskell/Data/Binary/Put.hs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

(limited to 'src/runtime/haskell/Data/Binary/Put.hs')

diff --git a/src/runtime/haskell/Data/Binary/Put.hs b/src/runtime/haskell/Data/Binary/Put.hs
index 189cf806f..05d23fba6 100644
--- a/src/runtime/haskell/Data/Binary/Put.hs
+++ b/src/runtime/haskell/Data/Binary/Put.hs
@@ -77,15 +77,20 @@ instance Functor PutM where
         {-# INLINE fmap #-}
 
 instance Applicative PutM where
-        pure    = return
+        pure a  = Put $ PairS a mempty
         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
+    return = pure
     {-# INLINE return #-}
 
     m >>= k  = Put $
@@ -94,10 +99,7 @@ instance Monad PutM where
         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')
+    (>>) = (*>)
     {-# INLINE (>>) #-}
 
 tell :: Builder -> Put
-- 
cgit v1.2.3