summaryrefslogtreecommitdiff
path: root/src/runtime/haskell/Data/Binary/Put.hs
diff options
context:
space:
mode:
authorInari Listenmaa <inari.listenmaa@gmail.com>2024-09-09 19:43:39 +0200
committerInari Listenmaa <inari.listenmaa@gmail.com>2025-08-02 16:39:31 +0200
commitb914a25de326dd937e3a1d05f4eefb46af6da7b4 (patch)
treee816d5ec4b91425f3f7e41dd8bd75a2681ff524c /src/runtime/haskell/Data/Binary/Put.hs
parent1037b209ae225d5de604ff832d915c590ced4c38 (diff)
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
Diffstat (limited to 'src/runtime/haskell/Data/Binary/Put.hs')
-rw-r--r--src/runtime/haskell/Data/Binary/Put.hs14
1 files changed, 8 insertions, 6 deletions
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