"MonadReader (Foo m) m" results in infinite type from functional dependency

Question

I am trying to pass a function in a Reader that is to be called from the same monad as the calling function, but I get an infinite type error.

The simplified code is:

{-# LANGUAGE FlexibleContexts #-}

module G2 where

import Control.Monad
import Control.Monad.Reader

data Foo m = Foo { bar :: m () }

runFoo :: MonadReader (Foo m) m => m ()
runFoo = do
    b <- asks bar
    b

main :: Monad m => m ()
main = do
    let bar = return () :: m ()
        foo = Foo bar
    runReaderT runFoo foo

And the error is:

    • Occurs check: cannot construct the infinite type:
        m0 ~ ReaderT (Foo m0) m
        arising from a functional dependency between:
          constraint ‘MonadReader
                        (Foo (ReaderT (Foo m0) m)) (ReaderT (Foo m0) m)’
            arising from a use of ‘runFoo’
          instance ‘MonadReader r (ReaderT r m1)’ at <no location info>
    • In the first argument of ‘runReaderT’, namely ‘runFoo’
      In a stmt of a 'do' block: runReaderT runFoo foo
      In the expression:
        do let bar = ...
               foo = Foo bar
           runReaderT runFoo foo
    • Relevant bindings include main :: m () (bound at G2.hs:16:1)
   |
19 |     runReaderT runFoo foo
   |                ^^

Any help would be much appreciated, thanks!

Answer 1

runFoo :: MonadReader (Foo m) m => m ()

Let's forget about the class, and just assume that MonadReader env mon means that mon ~ ((->) env). This corresponds to simply using (->) as our monad instead of the fancier ReaderT. Then you get m ~ ((->) m) => m (). You see that m needs to contain itself (specifically, the argument to m is m). This is OK for values, but it would be quite bad if the typechecker had to deal with infinitely large types. The same is true for ReaderT (and you need to use ReaderT because you call runReaderT runFoo). You need to define another newtype to encode this recursion:

data RecReader c a = RecReader { runRecReader :: c (RecReader c) -> a }
instance Functor (RecReader c) where
  fmap f (RecReader r) = RecReader $ f . r
instance Applicative (RecReader c) where
 pure = RecReader . const
 RecReader f <*> RecReader g = RecReader $ \e -> f e (g e)
instance Monad (RecReader c) where
  return = pure
  RecReader x >>= f = RecReader $ \e -> runRecReader (f (x e)) e
instance MonadReader (c (RecReader c)) (RecReader c) where
  ask = RecReader id
  local f (RecReader x) = RecReader $ x . f

And it works:

runRecReader runFoo (Foo $ return ())
-- ==>
()