I have a typeclass with a default implementation, and would like to provide a simple way to derive the typeclass if a user wants to use their custom monad.
Here's a solution someone else provided me:
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
import Control.Monad.Cont (MonadIO, MonadTrans (lift))
import Control.Monad.Reader (MonadReader, ReaderT (runReaderT))
----------------- My module's definitions -----------------
class Monad m => MonadFoo m where
foo :: m ()
instance MonadFoo IO where
foo = putStrLn "Hello world!"
instance MonadFoo m => MonadFoo (ReaderT r m) where
foo = lift foo
------------------------------------------------------------
------ The user's custom monad instance definitions ------
data AppEnv = AppEnv
newtype AppM a = AppM
{ runAppM :: ReaderT AppEnv IO a
}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader AppEnv)
deriving via (ReaderT AppEnv IO) instance MonadFoo AppM
------------------------------------------------------------
-- Example usage
program :: IO ()
program = runReaderT (runAppM foo) AppEnv
> program
"Hello world!"
If my typeclass uses a type family, I'm unable to use deriving via. For example:
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Monad.Cont (MonadIO, MonadTrans (lift))
import Control.Monad.Reader (MonadReader, ReaderT (runReaderT))
----------------- My module's definitions -----------------
class Monad m => MonadFoo ctx m where
type FooCtx ctx
foo :: m (FooCtx ctx)
data DummyCtx = DummyCtx
instance MonadFoo DummyCtx IO where
type FooCtx DummyCtx = ()
foo :: IO ()
foo = putStrLn "hello"
instance MonadFoo DummyCtx m => MonadFoo DummyCtx (ReaderT r m) where
type FooCtx DummyCtx = ()
foo :: ReaderT r m ()
foo = lift $ foo @DummyCtx
------------------------------------------------------------
------ The user's custom monad instance definitions ------
data AppEnv = AppEnv
newtype AppM a = AppM
{ runAppM :: ReaderT AppEnv IO a
}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader AppEnv)
deriving via (ReaderT AppEnv IO) instance MonadFoo DummyCtx AppM
The last line doesn't compile:
[typecheck] [E] • Can't make a derived instance of
~ ‘MonadFoo DummyCtx AppM’ with the via strategy:
~ the associated type ‘FooCtx’ is not parameterized over the last type
~ variable
~ of the class ‘MonadFoo’
~ • In the stand-alone deriving instance for ‘MonadFoo DummyCtx AppM’
How do I get the deriving via clause to compile when the typeclass has a type family?
CodePudding user response:
As the error message says, your associated type FooCtx
depends only on ctx
, but not on m
, thus creating a potential for ambiguity like this:
instance MonadFoo X A where
type FooCtx X = Int
...
instance MonadFoo X B where
type FooCtx X = String
...
Now it's ambiguous whether FooCtx X
evaluates to Int
or to String
.
To fix that, just add m
to parameters of FooCtx
:
class Monad m => MonadFoo ctx m where
type FooCtx ctx m
...
instance MonadFoo DummyCtx IO where
type FooCtx DummyCtx IO = ()
...
instance MonadFoo DummyCtx m => MonadFoo DummyCtx (ReaderT r m) where
type FooCtx DummyCtx (ReaderT r m) = ()
...
(I figured I'd add this as an answer since it turned out to be that simple after all)