forked from GitHub/gf-core
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
This commit is contained in:
@@ -201,11 +201,11 @@ instance Fail.MonadFail CnvMonad where
|
||||
fail = bug
|
||||
|
||||
instance Applicative CnvMonad where
|
||||
pure = return
|
||||
pure a = CM (\gr c s -> c a s)
|
||||
(<*>) = ap
|
||||
|
||||
instance Monad CnvMonad where
|
||||
return a = CM (\gr c s -> c a s)
|
||||
return = pure
|
||||
CM m >>= k = CM (\gr c s -> m gr (\a s -> unCM (k a) gr c s) s)
|
||||
|
||||
instance MonadState ([ProtoFCat],[Symbol]) CnvMonad where
|
||||
|
||||
@@ -644,7 +644,7 @@ data TcResult a
|
||||
newtype TcM a = TcM {unTcM :: MetaStore -> [Message] -> TcResult a}
|
||||
|
||||
instance Monad TcM where
|
||||
return x = TcM (\ms msgs -> TcOk x ms msgs)
|
||||
return = pure
|
||||
f >>= g = TcM (\ms msgs -> case unTcM f ms msgs of
|
||||
TcOk x ms msgs -> unTcM (g x) ms msgs
|
||||
TcFail msgs -> TcFail msgs)
|
||||
@@ -659,7 +659,7 @@ instance Fail.MonadFail TcM where
|
||||
|
||||
|
||||
instance Applicative TcM where
|
||||
pure = return
|
||||
pure x = TcM (\ms msgs -> TcOk x ms msgs)
|
||||
(<*>) = ap
|
||||
|
||||
instance Functor TcM where
|
||||
|
||||
@@ -238,12 +238,12 @@ runCO (CO m) = do (o,x) <- m
|
||||
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
|
||||
instance (Functor m,Monad m) => Applicative (CollectOutput m) where
|
||||
pure x = CO (return (return (),x))
|
||||
(<*>) = ap
|
||||
|
||||
instance Monad m => Monad (CollectOutput m) where
|
||||
return x = CO (return (return (),x))
|
||||
return = pure
|
||||
CO m >>= f = CO $ do (o1,x) <- m
|
||||
let CO m2 = f x
|
||||
(o2,y) <- m2
|
||||
|
||||
@@ -64,11 +64,11 @@ 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)
|
||||
return = pure
|
||||
BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
|
||||
where unBM (BM m) = m
|
||||
|
||||
|
||||
@@ -34,7 +34,7 @@ fromErr :: a -> Err a -> a
|
||||
fromErr a = err (const a) id
|
||||
|
||||
instance Monad Err where
|
||||
return = Ok
|
||||
return = pure
|
||||
Ok a >>= f = f a
|
||||
Bad s >>= f = Bad s
|
||||
|
||||
@@ -54,7 +54,7 @@ instance Functor Err where
|
||||
fmap f (Bad s) = Bad s
|
||||
|
||||
instance Applicative Err where
|
||||
pure = return
|
||||
pure = Ok
|
||||
(<*>) = ap
|
||||
|
||||
-- | added by KJ
|
||||
|
||||
@@ -283,11 +283,11 @@ 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)
|
||||
return = pure
|
||||
(P m) >>= k = P $ \ s -> case m s of
|
||||
POk s a -> unP (k a) s
|
||||
PFailed posn err -> PFailed posn err
|
||||
|
||||
@@ -48,7 +48,7 @@ newtype Check a
|
||||
instance Functor Check where fmap = liftM
|
||||
|
||||
instance Monad Check where
|
||||
return x = Check $ \{-ctxt-} ws -> (ws,Success x)
|
||||
return = pure
|
||||
f >>= g = Check $ \{-ctxt-} ws ->
|
||||
case unCheck f {-ctxt-} ws of
|
||||
(ws,Success x) -> unCheck (g x) {-ctxt-} ws
|
||||
@@ -58,7 +58,7 @@ instance Fail.MonadFail Check where
|
||||
fail = raise
|
||||
|
||||
instance Applicative Check where
|
||||
pure = return
|
||||
pure x = Check $ \{-ctxt-} ws -> (ws,Success x)
|
||||
(<*>) = ap
|
||||
|
||||
instance ErrorMonad Check where
|
||||
|
||||
@@ -52,11 +52,11 @@ 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))
|
||||
return = pure
|
||||
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
|
||||
|
||||
instance Fail.MonadFail SIO where
|
||||
|
||||
Reference in New Issue
Block a user