From dc1ba322a925cf5c081e9f06c4ee155d9fb1eda7 Mon Sep 17 00:00:00 2001 From: Orion Kindel Date: Sun, 23 Jun 2024 20:49:01 -0500 Subject: [PATCH] fix: asyncpipe is mfunctor --- src/Pipes.Async.purs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/Pipes.Async.purs b/src/Pipes.Async.purs index 4feffd1..8fcd167 100644 --- a/src/Pipes.Async.purs +++ b/src/Pipes.Async.purs @@ -8,7 +8,7 @@ import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, fork) import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT) -import Control.Monad.Morph (hoist) +import Control.Monad.Morph (class MFunctor, hoist) import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) import Control.Monad.ST.Class (liftST) import Control.Monad.ST.Ref (STRef) @@ -131,6 +131,18 @@ getAsyncIO (Pure _) = pure Nothing instance MonadTrans (AsyncPipe a b) where lift = M <<< map Pure +instance MFunctor (AsyncPipe a b) where + hoist _ (Pure a) = Pure a + hoist f (M m) = M $ f $ hoist f <$> m + hoist f (AsyncIO ({read, write, awaitWrite, awaitRead} /\ m)) = + AsyncIO + $ { read: f read + , write: f <<< write + , awaitWrite: f awaitWrite + , awaitRead: f awaitRead + } + /\ hoist f m + instance Monad m => Functor (AsyncPipe a b m) where map f (Pure r) = Pure $ f r map f (M m) = M $ map f <$> m