<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=utf-8">
<style id="EHTipGlobalStyle">.EHTipToolTip * {background: inherit;font-family: inherit;font-size: inherit;font-size-adjust: none;font-stretch: normal;line-height: inherit;font-variant: normal;border: 0px;text-transform: inherit;color: inherit;font-style: inherit;text-decoration: inherit;margin: 0px 0px 0px 0px;padding: 0px 0px 0px 0px;float: none;display: inline;cursor: default;}
.EHTipReplacer, .EHTipKey, .EHTipAudio {cursor: pointer;}
.EHTipToolTip hr {margin: 0.4em 0;display: block;border: 1px inset;}
.EHTipTranslation {font-style: normal;}
.EHTipTranslation a {color: #000099;font-style: normal;text-decoration: none;}
.EHTipTranslation a:hover {background: inherit;color: #000000;text-decoration: underline;}
</style>
</head>
<body style="background-color: rgb(255, 255, 255); color: rgb(0, 0,
0);" text="#000000" bgcolor="#FFFFFF">
<p>Hello,</p>
<p>I'm trying to use SqlPersistT funcs with MonadError, but am
failing in writing the runDB correctly. <br>
</p>
<p>I tried several things, but always getting:</p>
<p> • Couldn't match type ‘IOException’ with ‘AppException’<br>
arising from a functional dependency between:<br>
constraint ‘MonadError AppException IO’ arising from a
use of ‘f1’<br>
instance ‘MonadError IOException IO’ at <no location
info><br>
• In the second argument of ‘runPool’, namely ‘f1’<br>
In the second argument of ‘($)’, namely ‘runPool pgConf f1
pgPool’<br>
In a stmt of a 'do' block: liftIO $ runPool pgConf f1 pgPool</p>
I understand there already is "instance MonadError IOException IO"
and fundep says it can be only one for IO.
<p>How to make it compile?</p>
<br>
<p>Best regards,</p>
<p>vlatko</p>
<p> <br>
</p>
<p>Here is the minimal reproducible code:<br>
</p>
<font size="-1"><tt>module Test where</tt><tt><br>
</tt><tt><br>
</tt><tt>import Prelude</tt><tt><br>
</tt><tt>import Control.Exception.Base</tt><tt><br>
</tt><tt>import Control.Monad.Except</tt><tt><br>
</tt><tt>import Control.Monad.Trans.Reader</tt><tt><br>
</tt><tt>import Database.Persist.Postgresql</tt><tt><br>
</tt><tt><br>
</tt><tt>data AppException =</tt><tt><br>
</tt><tt> ExcText String</tt><tt><br>
</tt><tt> | ExcIO IOException</tt><tt><br>
</tt><tt> deriving (Show)</tt><tt><br>
</tt><tt><br>
</tt><tt>type AppM m = ExceptT AppException (ReaderT App m)</tt><tt><br>
</tt><tt>data App = App { pgConf :: PostgresConf, pgPool ::
ConnectionPool}</tt><tt><br>
</tt><tt><br>
</tt><tt>runDB :: (MonadIO m, MonadError AppException m) =>
AppM m Bool<br>
</tt><tt>runDB = do</tt><tt><br>
</tt><tt> App{..} <- lift ask</tt><tt><br>
</tt><tt> liftIO $ runPool pgConf <b>f1</b> pgPool -- error</tt><tt><br>
</tt><tt> -- liftIO $ runPool pgConf <b>f2</b> pgPool -- OK</tt><tt><br>
</tt><tt><br>
</tt><tt><br>
</tt><tt>f1 :: (MonadIO m, MonadError AppException m) =>
SqlPersistT m Bool</tt><tt><br>
</tt><tt>f1 = throwError $ ExcText "exception"</tt><tt><br>
</tt><tt><br>
</tt><tt>f2 :: MonadIO m => SqlPersistT m Bool</tt><tt><br>
</tt><tt>f2 = return True</tt></font><br>
<br>
</body>
</html>