(original) (raw)

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

module Control.Monad.Fix ( MonadFix(mfix), fix ) where

import Data.Either import Data.Function ( fix ) import Data.Maybe import Data.Monoid ( Dual(..), Sum(..), Product(..) , First(..), Last(..), Alt(..), Ap(..) ) import Data.Ord ( Down(..) ) import GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) ) import GHC.Generics import GHC.List ( head, tail ) import GHC.Tuple (Solo (..)) import Control.Monad.ST.Imp import System.IO

class (Monad m) => MonadFix m where

    [mfix](Control.Monad.Fix.html#mfix) :: ([a](#local-6989586621679565068) -> [m](#local-6989586621679565069) [a](#local-6989586621679565068)) -> [m](#local-6989586621679565069) [a](#local-6989586621679565068)

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 (Solo a x) = a x

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"

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. [a] -> a head) of [] -> [] (a x:[a] _) -> 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)

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 (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

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

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

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"

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

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))

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))

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))

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 (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))

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 (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))

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 (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))

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 (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))

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))

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 (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))

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 (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))

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 (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)) 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

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))