Following and adapting this blog post, I've been trying to produce a solution which should allow testing of a function which reads env vars (using System.Environment.lookupEnv).
That way, I should be able to inject an artificial environment for tests which can be read in place of performing the actual IO action.
However, the type check fails when attempting to read the env.
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
...
import RIO.Map (Map)
import qualified RIO.Map as Map
...
import qualified System.Environment as E (lookupEnv)
...
newtype MockEnv m a = MockEnv
{ mockEnv :: ReaderT (Map String String) m a
} deriving (Applicative, Functor, Monad, MonadTrans)
runMockEnv :: MockEnv m a -> Map String String -> m a
runMockEnv (MockEnv e) = runReaderT e
class Monad m => MonadEnv m where
lookupEnv :: String -> m (Maybe String)
instance MonadEnv IO where
lookupEnv = E.lookupEnv
instance Monad m => MonadEnv (MockEnv m) where
lookupEnv k = Map.lookup k <$> ask
-- ^^^ error occurs here
At the site of "ask" above, the following error is produced:
/home/[REDACTED].hs:45:34: error:
• Could not deduce (MonadReader (Map String String) (MockEnv m))
arising from a use of ‘ask’
from the context: Monad m
bound by the instance declaration
at [REDACTED].hs:44:10-40
• In the second argument of ‘(<$>)’, namely ‘ask’
In the expression: Map.lookup k <$> ask
In an equation for ‘lookupEnv’: lookupEnv k = Map.lookup k <$> ask
|
45 | lookupEnv k = Map.lookup k <$> ask
| ^^^
-- While building package [REDACTED]
Please could you help me understand why this fails to type check and what I need to do to fix it? Thanks in advance.
The types don't look like they match up. We have:
So, this all means we need the bit where you currently have
ask
to be of typeMockEnv m (Map String a)
. The simplest solution is to wrap upask
with yourMockEnv
newtype wrapper. For instance, the following works:The more robust solution (and the one that GHC hints at with its suggestion that you need a
MonadReader
instance) is to letMockEnv m
be an instance ofMonadReader
:With this instance, your instance definition for
MonadEnv (MockEnv m)
works fine.