mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-10-25 08:43:17 -06:00
fix noncanonical Monad instances
This commit is contained in:
1 parent
7b10bee627
commit
2ebaf7da4c
6 files changed
+5
-35
No files matched your search
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in new issue
Block a user