fix noncanonical Monad instances

This commit is contained in:
Krasimir Angelov committed 2026-10-22 19:08:29 +02:00
1 parent 7b10bee627
commit 2ebaf7da4c
6 files changed
+5 -35

No files matched your search

+1 -2
View File
@@ -236,11 +236,10 @@ instance Functor m => Functor (CollectOutput m) where
fmap f (CO m) = CO (fmap (fmap f) m)
instance (Functor m,Monad m) => Applicative (CollectOutput m) where
pure = return
pure x = CO (return (return (),x))
(<*>) = ap
instance Monad m => Monad (CollectOutput m) where
return x = CO (return (return (),x))
CO m >>= f = CO $ do (o1,x) <- m
let CO m2 = f x
(o2,y) <- m2
+1 -2
View File
@@ -64,11 +64,10 @@ finalStates :: BacktrackM s () -> s -> [s]
finalStates bm = map fst . runBM bm
instance Applicative (BacktrackM s) where
pure = return
pure a = BM (\c s b -> c a s b)
(<*>) = ap
instance Monad (BacktrackM s) where
return a = BM (\c s b -> c a s b)
BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
where unBM (BM m) = m
+1 -2
View File
@@ -34,7 +34,6 @@ fromErr :: a -> Err a -> a
fromErr a = err (const a) id
instance Monad Err where
return = Ok
Ok a >>= f = f a
Bad s >>= f = Bad s
@@ -54,7 +53,7 @@ instance Functor Err where
fmap f (Bad s) = Bad s
instance Applicative Err where
pure = return
pure = Ok
(<*>) = ap
-- | added by KJ
+1 -2
View File
@@ -317,11 +317,10 @@ instance Functor P where
fmap = liftA
instance Applicative P where
pure = return
pure a = a `seq` (P $ \_ s -> POk s a)
(<*>) = ap
instance Monad P where
return a = a `seq` (P $ \_ s -> POk s a)
(P m) >>= k = P $ \l s -> case m l s of
POk s a -> unP (k a) l s
PFailed posn err -> PFailed posn err
+1 -2
View File
@@ -53,11 +53,10 @@ newtype SIO a = SIO {unS::PutStr->IO a}
instance Functor SIO where fmap = liftM
instance Applicative SIO where
pure = return
pure x = SIO (const (pure x))
(<*>) = ap
instance Monad SIO where
return x = SIO (const (return x))
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
instance Fail.MonadFail SIO where
-25
View File
@@ -149,31 +149,6 @@ instance ErrorMonad IO where
handle m h = catch m $ \ e -> if isUserError e
then h (ioeGetErrorString e)
else ioError e
{-
-- Control.Monad.Fail import will become redundant in GHC 8.8+
import qualified Control.Monad.Fail as Fail
instance Functor IOE where fmap = liftM
instance Applicative IOE where
pure = return
(<*>) = ap
instance Monad IOE where
return a = ioe (return (return a))
IOE c >>= f = IOE $ do
x <- c -- Err a
appIOE $ err raise f x -- f :: a -> IOE a
#if !(MIN_VERSION_base(4,13,0))
fail = raise
#endif
instance Fail.MonadFail IOE where
fail = raise
-}
-- | Print the error message and return a default value if the IO operation 'fail's
useIOE :: a -> IOE a -> IO a