{-# 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 : experimental-- 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 )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 2.01instanceMonadFix Maybe wheremfix :: (a -> Maybe a) -> Maybe a
mfix f :: a -> Maybe a
f =leta :: Maybe a
a =a -> Maybe a
f (Maybe a -> a
forall p. Maybe p -> p
unJust Maybe a
a )inMaybe a
a whereunJust :: Maybe p -> p
unJust (Just x :: p
x )=p
x unJust Nothing =[Char] -> p
forall a. [Char] -> a
errorWithoutStackTrace "mfix Maybe: Nothing"-- | @since 2.01instanceMonadFix []wheremfix :: (a -> [a]) -> [a]
mfix f :: 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. [a] -> a
head )of[]->[](x :: a
x :_)->a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> [a]) -> [a]
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ([a] -> [a]
forall a. [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 :: (a -> NonEmpty a) -> NonEmpty a
mfix f :: 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~(x :: a
x :| _)->a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty 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 ~(_:| as :: [a]
as )=[a]
as -- | @since 2.01instanceMonadFix IOwheremfix :: (a -> IO a) -> IO a
mfix =(a -> IO a) -> IO a
forall a. (a -> IO a) -> IO a
fixIO -- | @since 2.01instanceMonadFix ((->)r )wheremfix :: (a -> r -> a) -> r -> a
mfix f :: a -> r -> a
f =\r :: r
r ->leta :: a
a =a -> r -> a
f a
a r
r ina
a -- | @since 4.3.0.0instanceMonadFix (Either e )wheremfix :: (a -> Either e a) -> Either e a
mfix f :: a -> Either e a
f =leta :: Either e a
a =a -> Either e a
f (Either e a -> a
forall a p. Either a p -> p
unRight Either e a
a )inEither e a
a whereunRight :: Either a p -> p
unRight (Right x :: p
x )=p
x unRight (Left _)=[Char] -> p
forall a. [Char] -> a
errorWithoutStackTrace "mfix Either: Left"-- | @since 2.01instanceMonadFix (ST s )wheremfix :: (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 :: (a -> Dual a) -> Dual a
mfix f :: 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 :: (a -> Sum a) -> Sum a
mfix f :: 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 :: (a -> Product a) -> Product a
mfix f :: 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 :: (a -> First a) -> First a
mfix f :: a -> First a
f =Maybe a -> First a
forall a. Maybe a -> First a
First ((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 :: (a -> Last a) -> Last a
mfix f :: a -> Last a
f =Maybe a -> Last a
forall a. Maybe a -> Last a
Last ((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 :: (a -> Alt f a) -> Alt f a
mfix f :: 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 (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 :: (a -> Ap f a) -> Ap f a
mfix f :: 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 (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 :: (a -> Par1 a) -> Par1 a
mfix f :: 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 :: (a -> Rec1 f a) -> Rec1 f a
mfix f :: 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 (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 :: (a -> M1 i c f a) -> M1 i c f a
mfix f :: 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 (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (M1 i c f a -> f a
forall i (c :: Meta) k (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 :: (a -> (:*:) f g a) -> (:*:) f g a
mfix f :: a -> (:*:) f g a
f =((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 (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 (a :: f p
a :*: _)=f p
a sndP :: (:*:) f g p -> g p
sndP (_:*: b :: g p
b )=g p
b -- Instances for Data.Ord-- | @since 4.12.0.0instanceMonadFix Down wheremfix :: (a -> Down a) -> Down a
mfix f :: 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 ))wheregetDown :: Down a -> a
getDown (Down x :: a
x )=a
x