{- |
@MonadFix@ transformers. There are also @Monad@ and @MonadPlus@ transformes, see the corresponding modules.

Note that each @MonadFix@ transformer is also a @Monad@ transformer.
-}
module Control.Monad.Trans.MonadFix (MonadF, TransF(..), instF, mfix') where
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Category
import Control.Monad.Trans.Monad
import Control.Monad.Writer
import Data.Monoid
-- | @MonadF m@ is actually a free @MonadFix@ generated by @m@. @MonadF@ is a monad itself (on the @(* -> *)@ category), as usually happens with free structures.
newtype MonadF m x = MonadF {bindF :: forall n. MonadFix n => (m :-> n) -> n x}
-- | A @MonadFix@ is nothing but an algebra over the @MonadF@ monad. @instF@ provides it's structure map.
instF :: MonadFix m => Inst MonadF m
instF mmx = bindF mmx id
-- | Sometimes we need an @instance MonadFix T@, while everything we've got is @InstP MonadF T@. In this case, @mfix'@ serves as a @mfix@ substitution.
mfix' :: Inst MonadF m -> (x -> m x) -> m x
mfix' i f = i $ MonadF {bindF = \mor -> mfix $ mor . f}
-- | A composable @MonadFix@ transformer.
--
-- You shoudn't (and probably can't) use *anything* except for @'instF'@, defined in this very module, as @transFInst@.
--
-- If you define @instance TransF T where transFInst = instF@, then you would also need to define @instance MonadFix m => MonadFix (T m)@ somewhere in your code.
class TransM t => TransF t where transFInst :: MonadFix m => Inst MonadF (t m)
instance (MonadFix m, TransF t) => MonadFix (t :$ m) where
    mfix f = ApplyF {runApplyF = mfix' transFInst $ runApplyF . f}
deriving instance (MonadFix m, TransF t1, TransF t2) => MonadFix ((t2 :. t1) m)
instance (TransF t1, TransF t2) => TransF (t2 :. t1) where transFInst = instF
instance TransF (ReaderT r) where transFInst = instF
instance TransF (StateT s) where transFInst = instF
instance Monoid w => TransF (WriterT w) where transFInst = instF