持久性：CRUD类型类

Question

我想写的是简化了编写使用持续，埃宋和斯科蒂

这里一个CRUD后端一个类型类是我的想法：

runDB x = liftIO $ do info <- mysqlInfo 
         runResourceT $ SQL.withMySQLConn info $ SQL.runSqlConn x 

class (J.FromJSON a, J.ToJSON a, SQL.PersistEntity a) => CRUD a where 
    getBasePath :: a -> String 
    getCrudName :: a -> String 

    getFromBody :: a -> ActionM a 
    getFromBody _ = do body <- jsonData 
         return body 

    mkInsertRoute :: a -> ScottyM() 
    mkInsertRoute el = 
     do post (fromString ((getBasePath el) ++ "/" ++ (getCrudName el))) $ do 
       body <- getFromBody el 
       runDB $ SQL.insert body 
       json $ J.Bool True 

    mkUpdateRoute :: a -> ScottyM() 
    mkDeleteRoute :: a -> ScottyM() 
    mkGetRoute :: a -> ScottyM() 
    mkGetAllRoute :: a -> ScottyM() 

这并未“T编译，我得到这个错误：

Could not deduce (SQL.PersistEntityBackend a 
        ~ Database.Persist.GenericSql.Raw.SqlBackend) 
from the context (CRUD a) 
    bound by the class declaration for `CRUD' 
    at WebIf/CRUD.hs:(18,1)-(36,36) 
Expected type: SQL.PersistEntityBackend a 
    Actual type: SQL.PersistMonadBackend 
       (SQL.SqlPersist (Control.Monad.Trans.Resource.ResourceT IO)) 
In the second argument of `($)', namely `SQL.insert body' 
In a stmt of a 'do' block: runDB $ SQL.insert body 
In the second argument of `($)', namely 
    `do { body <- getFromBody el; 
     runDB $ SQL.insert body; 
     json $ J.Bool True }' 

似乎我不得不添加另一个类型约束，如PersistMonadBackend m ~ PersistEntityBackend a，但我看不出如何。

Answer 1

约束意味着对于PersistEntity实例相关的后端类型必须SqlBackend，所以当用户实现了PersistEntity类作为实施CRUD类的一部分，他们将需要指定。

从你的角度来看，你只需要启用TypeFamilies扩展和约束添加到您的类定义：

class (J.FromJSON a, J.ToJSON a, SQL.PersistEntity a 
     , SQL.PersistEntityBackend a ~ SQL.SqlBackend 
    ) => CRUD a where 
    ... 

当定义为某种类型Foo的PersistEntity一个实例中，CRUD用户将需要定义PersistEntityBackend类型为SqlBackend：

instance PersistEntity Foo where 
    type PersistEntityBackend Foo = SqlBackend 

下面是经过你的代码我的完整副本GHC型检查器：

{-# LANGUAGE TypeFamilies #-} 

import Control.Monad.Logger 
import Control.Monad.Trans 
import qualified Data.Aeson as J 
import Data.Conduit 
import Data.String (fromString) 
import qualified Database.Persist.Sql as SQL 
import Web.Scotty 

-- incomplete definition, not sure why this instance is now needed 
-- but it's not related to your problem 
instance MonadLogger IO 

-- I can't build persistent-mysql on Windows so I replaced it with a stub 
runDB x = liftIO $ runResourceT $ SQL.withSqlConn undefined $ SQL.runSqlConn x 

class (J.FromJSON a, J.ToJSON a, SQL.PersistEntity a 
     , SQL.PersistEntityBackend a ~ SQL.SqlBackend 
    ) => CRUD a where 

    getBasePath :: a -> String 
    getCrudName :: a -> String 

    getFromBody :: a -> ActionM a 
    getFromBody _ = do body <- jsonData 
         return body 

    mkInsertRoute :: a -> ScottyM() 
    mkInsertRoute el = 
     do post (fromString ((getBasePath el) ++ "/" ++ (getCrudName el))) $ do 
       body <- getFromBody el 
       runDB $ SQL.insert body 
       json $ J.Bool True 

    mkUpdateRoute :: a -> ScottyM() 
    mkDeleteRoute :: a -> ScottyM() 
    mkGetRoute :: a -> ScottyM() 
    mkGetAllRoute :: a -> ScottyM()