Question

我正在使用以下代码：

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

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

class (PersistEntity b, ToBackendKey SqlBackend b) =>
      ToPersistEntity a b | a -> b where
  toPersistEntity :: a -> b

type family FromKey a :: * where
  FromKey DbPingId = PingId

instance ToPersistEntity Ping DbPing where
  toPersistEntity = pingToDbPing

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

saveDB
  :: ( Exception e
     , ToPersistEntity value record
     , Num (FromKey (Key record))
     , MonadCatch m
     , MonadIO m
     , MonadReader DbConfig m
     , FromKey (Key record) ~ key
     )
  => value -> m (Either e key)
saveDB x =
  fmap (fromIntegral . fromSqlKey) <$>
  try (liftIO . evaluate =<< runDB (insert (toPersistEntity x)))

简而言之，我有域对象（例如Ping），ToPersistEntity类型类将它们转换为数据库表示，FromKey类型族以映射数据库/域对象ID，以及saveDB函数适用于满足这些条件的任何内容。

作为下一步，我希望创建一个类型类来抽象持久化对象，以便我的其他函数在MonadStore中可以是多态的，并且我可以在我的应用程序和测试中使用不同的实例。要在我的应用程序中使用，我想重用通用的saveDB函数。理想情况下，我希望有以下几点：

class (Monad m) =>
      MonadStore m where
  save
    :: (Exception e)
    => value -> m (Either e key)

在我的应用程序中使用save类型类方法委托给saveDB。如果我将类型类方法专门用于特定类型（例如Ping和PingId），那就可以正常工作。

class (Monad m) =>
      MonadStore m where
  savePing
    :: (Exception e)
    => Ping -> m (Either e PingId)

instance (MonadCatch m, MonadIO m, Monad m, MonadReader DbConfig m) =>
         MonadStore m where
  savePing = saveDB

但缺点是必须为每个对象定义一个新方法。

尝试定义我想要的实例：

instance (MonadCatch m, MonadIO m, Monad m, MonadReader DbConfig m) =>
         MonadStore m where
  save = saveDB

产生类型错误：

/home/ppb/Code/haskell/test/src/Lib.hs:86:10: error:
    • Couldn't match type ‘key’ with ‘FromKey (Key record0)’
        arising from a use of ‘saveDB’
      ‘key’ is a rigid type variable bound by
        the type signature for:
          save :: forall e value key.
                  Exception e =>
                  value -> m (Either e key)
        at src/Lib.hs:86:3
    • In the expression: saveDB
      In an equation for ‘save’: save = saveDB
      In the instance declaration for ‘MonadStore m’
    • Relevant bindings include
        save :: value -> m (Either e key) (bound at src/Lib.hs:86:3)

无论我尝试什么，我都无法弄清楚如何制作save委托给saveDB的有效实例。有什么方法可以让我的工作吗？我也有兴趣更好地理解编译器产生的错误。

如何使这段代码更具多态性？

0 个答案: