{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude #-}{-# LANGUAGE TypeOperators #-}------------------------------------------------------------------------------- |-- Module : 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.-------------------------------------------------------------------------------moduleControl.Monad.Fix(MonadFix (mfix ),fix )whereimportData.Either importData.Function (fix )importData.Maybe importData.Monoid (Dual (..),Sum (..),Product (..),First (..),Last (..),Alt (..),Ap (..))importData.Ord (Down (..))importGHC.Base (Monad ,NonEmpty (..),errorWithoutStackTrace ,(.) )importGHC.Generics importGHC.List (head ,tail )importGHC.Tuple (Solo (..))importControl.Monad.ST.Imp importSystem.IO -- | 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 4.15instanceMonadFix Solo wheremfix :: forall a. (a -> Solo a) -> Solo a
mfix a -> Solo a
f =leta :: Solo a
a =a -> Solo a
f (Solo a -> a
forall {a}. Solo a -> a
unSolo Solo a
a )inSolo a
a whereunSolo :: Solo a -> a
unSolo (MkSolo a
x )=a
x -- | @since 2.01instanceMonadFix Maybe wheremfix :: forall a. (a -> Maybe a) -> Maybe a
mfix a -> Maybe a
f =leta :: Maybe a
a =a -> Maybe a
f (Maybe a -> a
forall {a}. Maybe a -> a
unJust Maybe a
a )inMaybe a
a whereunJust :: 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 2.01instanceMonadFix []wheremfix :: 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 ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail ([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
f )-- | @since 4.9.0.0instanceMonadFix NonEmpty wheremfix :: 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 )whereneHead :: NonEmpty a -> a
neHead ~(a
a :| [a]
_)=a
a neTail :: NonEmpty a -> [a]
neTail ~(a
_:| [a]
as )=[a]
as -- | @since 2.01instanceMonadFix IO wheremfix :: forall a. (a -> IO a) -> IO a
mfix =(a -> IO a) -> IO a
forall a. (a -> IO a) -> IO a
fixIO -- | @since 2.01instanceMonadFix ((->)r )wheremfix :: forall a. (a -> r -> a) -> r -> a
mfix a -> r -> a
f =\r
r ->leta :: a
a =a -> r -> a
f a
a r
r ina
a -- | @since 4.3.0.0instanceMonadFix (Either e )wheremfix :: forall a. (a -> Either e a) -> Either e a
mfix a -> Either e a
f =leta :: 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 )inEither e a
a whereunRight :: 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 2.01instanceMonadFix (ST s )wheremfix :: 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 -- Instances of Data.Monoid wrappers-- | @since 4.8.0.0instanceMonadFix Dual wheremfix :: 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 4.8.0.0instanceMonadFix Sum wheremfix :: 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 4.8.0.0instanceMonadFix Product wheremfix :: 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 4.8.0.0instanceMonadFix First wheremfix :: 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 4.8.0.0instanceMonadFix Last wheremfix :: 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 4.8.0.0instanceMonadFix f =>MonadFix (Alt f )wheremfix :: 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 4.12.0.0instanceMonadFix f =>MonadFix (Ap f )wheremfix :: 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 4.9.0.0instanceMonadFix Par1 wheremfix :: 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 4.9.0.0instanceMonadFix f =>MonadFix (Rec1 f )wheremfix :: 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 4.9.0.0instanceMonadFix f =>MonadFix (M1 i c f )wheremfix :: 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 4.9.0.0instance(MonadFix f ,MonadFix g )=>MonadFix (f :*: g )wheremfix :: 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 ))wherefstP :: (:*:) 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 4.12.0.0instanceMonadFix Down wheremfix :: 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 ))