为什么GHC在这里发出错误的“冗余约束”警告？

根据标题，我很好奇GHC为什么在删除代码时不再编译时发出关于冗余约束的警告。

{-# 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

并产生以下警告：

/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))

并删除约束导致以下错误：

/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))

我正在使用GHC 8.0.1并使用-Wall编译。

有没有什么办法可以重构代码以避免警告？ 或者如果这不可能，有没有办法在每个功能的基础上使警告OPTIONS_GHC ，而不是通过OPTIONS_GHC整个模块？

---

编辑 ：编译与GHC 8.0.2不再产生警告。

链接地址: http://www.djcxy.com/p/33173.html

上一篇: Why is GHC emitting incorrect "redundant constraint" warning here?

下一篇: instance only) of typeclasses in Agda