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)
|
fmap f (CO m) = CO (fmap (fmap f) m)
|
||||||
|
|
||||||
instance (Functor m,Monad m) => Applicative (CollectOutput m) where
|
instance (Functor m,Monad m) => Applicative (CollectOutput m) where
|
||||||
pure = return
|
pure x = CO (return (return (),x))
|
||||||
(<*>) = ap
|
(<*>) = ap
|
||||||
|
|
||||||
instance Monad m => Monad (CollectOutput m) where
|
instance Monad m => Monad (CollectOutput m) where
|
||||||
return x = CO (return (return (),x))
|
|
||||||
CO m >>= f = CO $ do (o1,x) <- m
|
CO m >>= f = CO $ do (o1,x) <- m
|
||||||
let CO m2 = f x
|
let CO m2 = f x
|
||||||
(o2,y) <- m2
|
(o2,y) <- m2
|
||||||
|
|||||||
@@ -64,11 +64,10 @@ finalStates :: BacktrackM s () -> s -> [s]
|
|||||||
finalStates bm = map fst . runBM bm
|
finalStates bm = map fst . runBM bm
|
||||||
|
|
||||||
instance Applicative (BacktrackM s) where
|
instance Applicative (BacktrackM s) where
|
||||||
pure = return
|
pure a = BM (\c s b -> c a s b)
|
||||||
(<*>) = ap
|
(<*>) = ap
|
||||||
|
|
||||||
instance Monad (BacktrackM s) where
|
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)
|
BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
|
||||||
where unBM (BM m) = m
|
where unBM (BM m) = m
|
||||||
|
|
||||||
|
|||||||
@@ -34,7 +34,6 @@ fromErr :: a -> Err a -> a
|
|||||||
fromErr a = err (const a) id
|
fromErr a = err (const a) id
|
||||||
|
|
||||||
instance Monad Err where
|
instance Monad Err where
|
||||||
return = Ok
|
|
||||||
Ok a >>= f = f a
|
Ok a >>= f = f a
|
||||||
Bad s >>= f = Bad s
|
Bad s >>= f = Bad s
|
||||||
|
|
||||||
@@ -54,7 +53,7 @@ instance Functor Err where
|
|||||||
fmap f (Bad s) = Bad s
|
fmap f (Bad s) = Bad s
|
||||||
|
|
||||||
instance Applicative Err where
|
instance Applicative Err where
|
||||||
pure = return
|
pure = Ok
|
||||||
(<*>) = ap
|
(<*>) = ap
|
||||||
|
|
||||||
-- | added by KJ
|
-- | added by KJ
|
||||||
|
|||||||
@@ -317,11 +317,10 @@ instance Functor P where
|
|||||||
fmap = liftA
|
fmap = liftA
|
||||||
|
|
||||||
instance Applicative P where
|
instance Applicative P where
|
||||||
pure = return
|
pure a = a `seq` (P $ \_ s -> POk s a)
|
||||||
(<*>) = ap
|
(<*>) = ap
|
||||||
|
|
||||||
instance Monad P where
|
instance Monad P where
|
||||||
return a = a `seq` (P $ \_ s -> POk s a)
|
|
||||||
(P m) >>= k = P $ \l s -> case m l s of
|
(P m) >>= k = P $ \l s -> case m l s of
|
||||||
POk s a -> unP (k a) l s
|
POk s a -> unP (k a) l s
|
||||||
PFailed posn err -> PFailed posn err
|
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 Functor SIO where fmap = liftM
|
||||||
|
|
||||||
instance Applicative SIO where
|
instance Applicative SIO where
|
||||||
pure = return
|
pure x = SIO (const (pure x))
|
||||||
(<*>) = ap
|
(<*>) = ap
|
||||||
|
|
||||||
instance Monad SIO where
|
instance Monad SIO where
|
||||||
return x = SIO (const (return x))
|
|
||||||
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
|
SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
|
||||||
|
|
||||||
instance Fail.MonadFail SIO where
|
instance Fail.MonadFail SIO where
|
||||||
|
|||||||
@@ -149,31 +149,6 @@ instance ErrorMonad IO where
|
|||||||
handle m h = catch m $ \ e -> if isUserError e
|
handle m h = catch m $ \ e -> if isUserError e
|
||||||
then h (ioeGetErrorString e)
|
then h (ioeGetErrorString e)
|
||||||
else ioError 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
|
-- | Print the error message and return a default value if the IO operation 'fail's
|
||||||
useIOE :: a -> IOE a -> IO a
|
useIOE :: a -> IOE a -> IO a
|
||||||
|
|||||||
Reference in new issue
Block a user