{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeOperators #-}

-- For head in instance MonadFix []
{-# OPTIONS_GHC -Wno-x-partial #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.Control.Monad.Fix
-- Copyright   :  (c) Andy Gill 2001,
--                (c) Oregon Graduate Institute of Science and Technology, 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- Maintainer  :  libraries@haskell.org
-- Stability   :  stable
-- Portability :  portable
--
-- Monadic fixpoints.
--
-- For a detailed discussion, see Levent Erkok's thesis,
-- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.
--
-----------------------------------------------------------------------------

module GHC.Internal.Control.Monad.Fix (
        MonadFix(mfix),
        fix,
        fixIO,
        -- * Feedback for Arrow
        ArrowLoop(..)
  ) where

import GHC.Internal.Data.Either
import GHC.Internal.Data.Function ( fix )
import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Monoid ( Monoid, Dual(..), Sum(..), Product(..)
                   , First(..), Last(..), Alt(..), Ap(..) )
import GHC.Internal.Data.NonEmpty ( NonEmpty(..) )
import GHC.Internal.Data.Ord ( Down(..) )
import GHC.Internal.Data.Tuple ( Solo(..), fst, snd )
import GHC.Internal.Base ( IO, Monad, errorWithoutStackTrace, (.), return, liftM )
import GHC.Internal.Generics
import GHC.Internal.List ( head, drop )
import GHC.Internal.Control.Monad.ST.Imp
import qualified GHC.Internal.Control.Monad.ST.Lazy.Imp as Lazy
import GHC.Internal.Data.Functor.Identity (Identity(..))
import GHC.Internal.MVar
import GHC.Internal.IO.Unsafe
import GHC.Internal.IO.Exception
import GHC.Internal.TH.Monad
import GHC.Internal.Control.Exception
import GHC.Internal.Control.Arrow

-- | Monads having fixed points with a \'knot-tying\' semantics.
-- Instances of 'MonadFix' should satisfy the following laws:
--
-- [Purity]
--      @'mfix' ('Control.Monad.return' . h)  =  'Control.Monad.return' ('fix' h)@
--
-- [Left shrinking (or Tightening)]
--      @'mfix' (\\x -> a >>= \\y -> f x y)  =  a >>= \\y -> 'mfix' (\\x -> f x y)@
--
-- [Sliding]
--      @'mfix' ('Control.Monad.liftM' h . f)  =  'Control.Monad.liftM' h ('mfix' (f . h))@,
--      for strict @h@.
--
-- [Nesting]
--      @'mfix' (\\x -> 'mfix' (\\y -> f x y))  =  'mfix' (\\x -> f x x)@
--
-- This class is used in the translation of the recursive @do@ notation
-- supported by GHC and Hugs.
class (Monad m) => MonadFix m where
        -- | The fixed point of a monadic computation.
        -- @'mfix' f@ executes the action @f@ only once, with the eventual
        -- output fed back as the input.  Hence @f@ should not be strict,
        -- for then @'mfix' f@ would diverge.
        mfix :: (a -> m a) -> m a

-- Instances of MonadFix for Prelude monads

-- | @since base-4.15
instance MonadFix Solo where
    mfix :: forall a. (a -> Solo a) -> Solo a
mfix a -> Solo a
f = let a :: Solo a
a = a -> Solo a
f (Solo a -> a
forall {a}. Solo a -> a
unSolo Solo a
a) in Solo a
a
             where unSolo :: Solo a -> a
unSolo (MkSolo a
x) = a
x

-- | @since base-4.21
instance Monoid a => MonadFix ((,) a) where
    -- See the CLC proposal thread for discussion and proofs of the laws: https://github.com/haskell/core-libraries-committee/issues/238
    mfix :: forall a. (a -> (a, a)) -> (a, a)
mfix a -> (a, a)
f = let a :: (a, a)
a = a -> (a, a)
f ((a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
a) in (a, a)
a

-- | @since base-2.01
instance MonadFix Maybe where
    mfix :: forall a. (a -> Maybe a) -> Maybe a
mfix a -> Maybe a
f = let a :: Maybe a
a = a -> Maybe a
f (Maybe a -> a
forall {a}. Maybe a -> a
unJust Maybe a
a) in Maybe a
a
             where unJust :: Maybe a -> a
unJust (Just a
x) = a
x
                   unJust Maybe a
Nothing  = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"mfix Maybe: Nothing"

-- | @since base-2.01
instance MonadFix [] where
    mfix :: forall a. (a -> [a]) -> [a]
mfix a -> [a]
f = case ([a] -> [a]) -> [a]
forall a. (a -> a) -> a
fix (a -> [a]
f (a -> [a]) -> ([a] -> a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. HasCallStack => [a] -> a
head) of
               []    -> []
               (a
x:[a]
_) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> [a]) -> [a]
forall a. (a -> [a]) -> [a]
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 ([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
f)

-- | @since base-4.9.0.0
instance MonadFix NonEmpty where
  mfix :: forall a. (a -> NonEmpty a) -> NonEmpty a
mfix a -> NonEmpty a
f = case (NonEmpty a -> NonEmpty a) -> NonEmpty a
forall a. (a -> a) -> a
fix (a -> NonEmpty a
f (a -> NonEmpty a) -> (NonEmpty a -> a) -> NonEmpty a -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> a
forall {a}. NonEmpty a -> a
neHead) of
             ~(a
x :| [a]
_) -> a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| (a -> [a]) -> [a]
forall a. (a -> [a]) -> [a]
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (NonEmpty a -> [a]
forall {a}. NonEmpty a -> [a]
neTail (NonEmpty a -> [a]) -> (a -> NonEmpty a) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmpty a
f)
    where
      neHead :: NonEmpty a -> a
neHead ~(a
a :| [a]
_) = a
a
      neTail :: NonEmpty a -> [a]
neTail ~(a
_ :| [a]
as) = [a]
as

-- | @since base-2.01
instance MonadFix IO where
    mfix :: forall a. (a -> IO a) -> IO a
mfix = (a -> IO a) -> IO a
forall a. (a -> IO a) -> IO a
fixIO

-- ---------------------------------------------------------------------------
-- fixIO

-- | The implementation of 'Control.Monad.Fix.mfix' for 'IO'.
--
-- This operation may fail with:
--
-- * 'FixIOException' if the function passed to 'fixIO' inspects its argument.
--
-- ==== __Examples__
--
-- the IO-action is only executed once. The recursion is only on the values.
--
-- >>> take 3 <$> fixIO (\x -> putStr ":D" >> (:x) <$> readLn @Int)
-- :D
-- 2
-- [2,2,2]
--
-- If we are strict in the value, just as with 'Data.Function.fix', we do not get termination:
--
-- >>> fixIO (\x -> putStr x >> pure ('x' : x))
-- * hangs forever *
--
-- We can tie the knot of a structure within 'IO' using 'fixIO':
--
-- @
-- data Node = MkNode Int (IORef Node)
--
-- foo :: IO ()
-- foo = do
--   p \<- fixIO (\p -> newIORef (MkNode 0 p))
--   q <- output p
--   r <- output q
--   _ <- output r
--   pure ()
--
-- output :: IORef Node -> IO (IORef Node)
-- output ref = do
--   MkNode x p <- readIORef ref
--   print x
--   pure p
-- @
--
-- >>> foo
-- 0
-- 0
-- 0
fixIO :: (a -> IO a) -> IO a
fixIO :: forall a. (a -> IO a) -> IO a
fixIO a -> IO a
k = do
    m <- IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
    ans <- unsafeDupableInterleaveIO
             (readMVar m `catch` \BlockedIndefinitelyOnMVar
BlockedIndefinitelyOnMVar ->
                                    FixIOException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO FixIOException
FixIOException)
    result <- k ans
    putMVar m result
    return result

-- Note [Blackholing in fixIO]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- We do our own explicit black holing here, because GHC's lazy
-- blackholing isn't enough.  In an infinite loop, GHC may run the IO
-- computation a few times before it notices the loop, which is wrong.
--
-- NOTE2: the explicit black-holing with an IORef ran into trouble
-- with multiple threads (see #5421), so now we use an MVar. We used
-- to use takeMVar with unsafeInterleaveIO. This, however, uses noDuplicate#,
-- which is not particularly cheap. Better to use readMVar, which can be
-- performed in multiple threads safely, and to use unsafeDupableInterleaveIO
-- to avoid the noDuplicate cost.
--
-- What we'd ideally want is probably an IVar, but we don't quite have those.
-- STM TVars look like an option at first, but I don't think they are:
-- we'd need to be able to write to the variable in an IO context, which can
-- only be done using 'atomically', and 'atomically' is not allowed within
-- unsafePerformIO. We can't know if someone will try to use the result
-- of fixIO with unsafePerformIO!
--
-- See also System.IO.Unsafe.unsafeFixIO.
--

-- | @since base-2.01
instance MonadFix ((->) r) where
    mfix :: forall a. (a -> r -> a) -> r -> a
mfix a -> r -> a
f = \ r
r -> let a :: a
a = a -> r -> a
f a
a r
r in a
a

-- | @since base-4.3.0.0
instance MonadFix (Either e) where
    mfix :: forall a. (a -> Either e a) -> Either e a
mfix a -> Either e a
f = let a :: Either e a
a = a -> Either e a
f (Either e a -> a
forall {a} {b}. Either a b -> b
unRight Either e a
a) in Either e a
a
             where unRight :: Either a b -> b
unRight (Right b
x) = b
x
                   unRight (Left  a
_) = [Char] -> b
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"mfix Either: Left"

-- | @since base-2.01
instance MonadFix (ST s) where
        mfix :: forall a. (a -> ST s a) -> ST s a
mfix = (a -> ST s a) -> ST s a
forall a s. (a -> ST s a) -> ST s a
fixST

-- | @since base-2.01
instance MonadFix (Lazy.ST s) where
        mfix :: forall a. (a -> ST s a) -> ST s a
mfix = (a -> ST s a) -> ST s a
forall a s. (a -> ST s a) -> ST s a
Lazy.fixST

-- Instances of Data.Monoid wrappers

-- | @since base-4.8.0.0
instance MonadFix Dual where
    mfix :: forall a. (a -> Dual a) -> Dual a
mfix a -> Dual a
f   = a -> Dual a
forall a. a -> Dual a
Dual ((a -> a) -> a
forall a. (a -> a) -> a
fix (Dual a -> a
forall a. Dual a -> a
getDual (Dual a -> a) -> (a -> Dual a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Dual a
f))

-- | @since base-4.8.0.0
instance MonadFix Sum where
    mfix :: forall a. (a -> Sum a) -> Sum a
mfix a -> Sum a
f   = a -> Sum a
forall a. a -> Sum a
Sum ((a -> a) -> a
forall a. (a -> a) -> a
fix (Sum a -> a
forall a. Sum a -> a
getSum (Sum a -> a) -> (a -> Sum a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Sum a
f))

-- | @since base-4.8.0.0
instance MonadFix Product where
    mfix :: forall a. (a -> Product a) -> Product a
mfix a -> Product a
f   = a -> Product a
forall a. a -> Product a
Product ((a -> a) -> a
forall a. (a -> a) -> a
fix (Product a -> a
forall a. Product a -> a
getProduct (Product a -> a) -> (a -> Product a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Product a
f))

-- | @since base-4.8.0.0
instance MonadFix First where
    mfix :: forall a. (a -> First a) -> First a
mfix a -> First a
f   = Maybe a -> First a
forall a. Maybe a -> First a
First ((a -> Maybe a) -> Maybe a
forall a. (a -> Maybe a) -> Maybe a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (First a -> Maybe a
forall a. First a -> Maybe a
getFirst (First a -> Maybe a) -> (a -> First a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> First a
f))

-- | @since base-4.8.0.0
instance MonadFix Last where
    mfix :: forall a. (a -> Last a) -> Last a
mfix a -> Last a
f   = Maybe a -> Last a
forall a. Maybe a -> Last a
Last ((a -> Maybe a) -> Maybe a
forall a. (a -> Maybe a) -> Maybe a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Last a -> Maybe a
forall a. Last a -> Maybe a
getLast (Last a -> Maybe a) -> (a -> Last a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Last a
f))

-- | @since base-4.8.0.0
instance MonadFix f => MonadFix (Alt f) where
    mfix :: forall a. (a -> Alt f a) -> Alt f a
mfix a -> Alt f a
f   = f a -> Alt f a
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt ((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Alt f a -> f a
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt f a -> f a) -> (a -> Alt f a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Alt f a
f))

-- | @since base-4.12.0.0
instance MonadFix f => MonadFix (Ap f) where
    mfix :: forall a. (a -> Ap f a) -> Ap f a
mfix a -> Ap f a
f   = f a -> Ap f a
forall {k} (f :: k -> *) (a :: k). f a -> Ap f a
Ap ((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Ap f a -> f a
forall {k} (f :: k -> *) (a :: k). Ap f a -> f a
getAp (Ap f a -> f a) -> (a -> Ap f a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ap f a
f))

-- Instances for GHC.Generics
-- | @since base-4.9.0.0
instance MonadFix Par1 where
    mfix :: forall a. (a -> Par1 a) -> Par1 a
mfix a -> Par1 a
f = a -> Par1 a
forall p. p -> Par1 p
Par1 ((a -> a) -> a
forall a. (a -> a) -> a
fix (Par1 a -> a
forall p. Par1 p -> p
unPar1 (Par1 a -> a) -> (a -> Par1 a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Par1 a
f))

-- | @since base-4.9.0.0
instance MonadFix f => MonadFix (Rec1 f) where
    mfix :: forall a. (a -> Rec1 f a) -> Rec1 f a
mfix a -> Rec1 f a
f = f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 ((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1 (Rec1 f a -> f a) -> (a -> Rec1 f a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rec1 f a
f))

-- | @since base-4.9.0.0
instance MonadFix f => MonadFix (M1 i c f) where
    mfix :: forall a. (a -> M1 i c f a) -> M1 i c f a
mfix a -> M1 i c f a
f = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (M1 i c f a -> f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1(M1 i c f a -> f a) -> (a -> M1 i c f a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> M1 i c f a
f))

-- | @since base-4.9.0.0
instance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where
    mfix :: forall a. (a -> (:*:) f g a) -> (:*:) f g a
mfix a -> (:*:) f g a
f = ((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((:*:) f g a -> f a
forall {f :: * -> *} {g :: * -> *} {p}. (:*:) f g p -> f p
fstP ((:*:) f g a -> f a) -> (a -> (:*:) f g a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (:*:) f g a
f)) f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: ((a -> g a) -> g a
forall a. (a -> g a) -> g a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((:*:) f g a -> g a
forall {f :: * -> *} {g :: * -> *} {p}. (:*:) f g p -> g p
sndP ((:*:) f g a -> g a) -> (a -> (:*:) f g a) -> a -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (:*:) f g a
f))
      where
        fstP :: (:*:) f g p -> f p
fstP (f p
a :*: g p
_) = f p
a
        sndP :: (:*:) f g p -> g p
sndP (f p
_ :*: g p
b) = g p
b

-- Instances for Data.Ord

-- | @since base-4.12.0.0
instance MonadFix Down where
    mfix :: forall a. (a -> Down a) -> Down a
mfix a -> Down a
f = a -> Down a
forall a. a -> Down a
Down ((a -> a) -> a
forall a. (a -> a) -> a
fix (Down a -> a
forall a. Down a -> a
getDown (Down a -> a) -> (a -> Down a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Down a
f))


-- | @since base-4.8.0.0
instance MonadFix Identity where
    mfix :: forall a. (a -> Identity a) -> Identity a
mfix a -> Identity a
f   = a -> Identity a
forall a. a -> Identity a
Identity ((a -> a) -> a
forall a. (a -> a) -> a
fix (Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
f))

-- | If the function passed to 'mfix' inspects its argument,
-- the resulting action will throw a 'FixIOException'.
--
-- @since 2.17.0.0
instance MonadFix Q where
  -- We use the same blackholing approach as in fixIO.
  -- See Note [Blackholing in fixIO].
  mfix :: forall a. (a -> Q a) -> Q a
mfix a -> Q a
k = do
    m <- IO (MVar a) -> Q (MVar a)
forall a. IO a -> Q a
runIO IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
    ans <- runIO (unsafeDupableInterleaveIO
             (readMVar m `catch` \BlockedIndefinitelyOnMVar
BlockedIndefinitelyOnMVar ->
                                    FixIOException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO FixIOException
FixIOException))
    result <- k ans
    runIO (putMVar m result)
    return result

-- | The 'loop' operator expresses computations in which an output value
-- is fed back as input, although the computation occurs only once.
-- It underlies the @rec@ value recursion construct in arrow notation.
-- 'loop' should satisfy the following laws:
--
-- [/extension/]
--      @'loop' ('arr' f) = 'arr' (\\ b -> 'fst' ('fix' (\\ (c,d) -> f (b,d))))@
--
-- [/left tightening/]
--      @'loop' ('first' h >>> f) = h >>> 'loop' f@
--
-- [/right tightening/]
--      @'loop' (f >>> 'first' h) = 'loop' f >>> h@
--
-- [/sliding/]
--      @'loop' (f >>> 'arr' ('id' *** k)) = 'loop' ('arr' ('id' *** k) >>> f)@
--
-- [/vanishing/]
--      @'loop' ('loop' f) = 'loop' ('arr' unassoc >>> f >>> 'arr' assoc)@
--
-- [/superposing/]
--      @'second' ('loop' f) = 'loop' ('arr' assoc >>> 'second' f >>> 'arr' unassoc)@
--
-- where
--
-- > assoc ((a,b),c) = (a,(b,c))
-- > unassoc (a,(b,c)) = ((a,b),c)
--
class Arrow a => ArrowLoop a where
    -- |
    --
    -- >     ╭──────────────╮
    -- >   b │     ╭───╮    │ c
    -- > >───┼─────┤   ├────┼───>
    -- >     │   ┌─┤   ├─┐  │
    -- >     │ d │ ╰───╯ │  │
    -- >     │   └───<───┘  │
    -- >     ╰──────────────╯
    loop :: a (b,d) (c,d) -> a b c

-- | @since base-2.01
instance ArrowLoop (->) where
    loop :: forall b d c. ((b, d) -> (c, d)) -> b -> c
loop (b, d) -> (c, d)
f b
b = let (c
c,d
d) = (b, d) -> (c, d)
f (b
b,d
d) in c
c

-- | Beware that for many monads (those for which the '>>=' operation
-- is strict) this instance will /not/ satisfy the right-tightening law
-- required by the 'ArrowLoop' class.
--
-- @since base-2.01
instance MonadFix m => ArrowLoop (Kleisli m) where
    loop :: forall b d c. Kleisli m (b, d) (c, d) -> Kleisli m b c
loop (Kleisli (b, d) -> m (c, d)
f) = (b -> m c) -> Kleisli m b c
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (((c, d) -> c) -> m (c, d) -> m c
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (c, d) -> c
forall a b. (a, b) -> a
fst (m (c, d) -> m c) -> (b -> m (c, d)) -> b -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c, d) -> m (c, d)) -> m (c, d)
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (((c, d) -> m (c, d)) -> m (c, d))
-> (b -> (c, d) -> m (c, d)) -> b -> m (c, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> (c, d) -> m (c, d)
forall {a}. b -> (a, d) -> m (c, d)
f')
      where f' :: b -> (a, d) -> m (c, d)
f' b
x (a, d)
y = (b, d) -> m (c, d)
f (b
x, (a, d) -> d
forall a b. (a, b) -> b
snd (a, d)
y)