Why is GHC emitting incorrect "redundant constraint" warning here? - haskell

Question

As per the title I'm curious as to why GHC is emitting a warning about a redundant constraint when its removal makes the code no longer compile.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Lib where
import Protolude hiding (from, try)
import Control.Exception.Safe
import Database.Esqueleto
import Database.Persist.TH
newtype PingId =
PingId Int
deriving (Enum, Eq, Integral, Num, Ord, Real, Show)
data Ping = Ping
{
} deriving (Show)
share [mkPersist sqlSettings] [persistLowerCase|
DbPing sql=pings
|]
pingToDbPing :: Ping -> DbPing
pingToDbPing _ = undefined
dbPingToPing :: DbPing -> Either Text Ping
dbPingToPing _ = undefined
class (PersistEntity a, ToBackendKey SqlBackend a) =>
FromPersistEntity a b | a -> b where
fromPersistEntity :: a -> Either Text b
instance FromPersistEntity DbPing Ping where
fromPersistEntity = dbPingToPing
type family ToKey a :: * where
ToKey PingId = DbPingId
findById
:: forall m key record val.
( Integral key
, Key record ~ ToKey key
, FromPersistEntity record val
, MonadCatch m
, MonadIO m
, MonadReader DbConfig m
)
=> key -> m (Either Text (Maybe val))
findById key = do
maybeRetOrErr <-
try
(liftIO . evaluate =<<
runDB
(select $
from $ \table -> do
where_
(table ^. persistIdField ==. val (toSqlKey . fromIntegral $ key))
return table))
case maybeRetOrErr of
Left (e :: SomeException) -> return . Left . toS . displayException $ e
Right [] -> return . Right $ Nothing
Right [ret :: Entity record] ->
return . fmap Just . fromPersistEntity . entityVal $ ret
Right _ -> return . Left $ "impossible happened, more than one result"
data DbConfig = DbConfig
{ dbConnectionPool :: ConnectionPool
}
runDB
:: (MonadIO m, MonadReader DbConfig m)
=> SqlPersistT IO b -> m b
runDB q = do
pool <- asks dbConnectionPool
liftIO $ runSqlPool q pool
test :: IO ()
test = do
let dbConfig = DbConfig undefined
flip runReaderT dbConfig $ do
pingOrErr <- findById (PingId 1)
print pingOrErr
and produces the following warning:
/home/ppb/Code/haskell/test/src/Lib.hs:49:1: warning: [-Wredundant-constraints]
• Redundant constraint: Key record ~ ToKey key
• In the type signature for:
findById :: (Integral key, Key record ~ ToKey key,
FromPersistEntity record val, MonadCatch m, MonadIO m,
MonadReader DbConfig m) =>
key -> m (Either Text (Maybe val))
and removing the constraint results in the following error:
/home/ppb/Code/haskell/test/src/Lib.hs:50:6: error:
• Could not deduce (FromPersistEntity record0 val)
from the context: (Integral key,
FromPersistEntity record val,
MonadCatch m,
MonadIO m,
MonadReader DbConfig m)
bound by the type signature for:
findById :: (Integral key, FromPersistEntity record val,
MonadCatch m, MonadIO m, MonadReader DbConfig m) =>
key -> m (Either Text (Maybe val))
at src/Lib.hs:(50,6)-(57,39)
The type variable ‘record0’ is ambiguous
• In the ambiguity check for ‘findById’
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
In the type signature:
findById :: forall m key record val.
(Integral key,
FromPersistEntity record val,
MonadCatch m,
MonadIO m,
MonadReader DbConfig m) =>
key -> m (Either Text (Maybe val))
I'm using GHC 8.0.1 and compiling with -Wall.
Is there any way I could restructure the code to avoid the warning? Or if that's not possible is there a way to silence the warning on per-function basis, rather than across the whole module with OPTIONS_GHC?
EDIT: compiling with GHC 8.0.2 no longer produces a warning.