dai dẳng: CRUD TypeClass

Question

Tôi cố gắng để viết một typeclass mà đơn giản hoá việc viết một backend CRUD sử dụng dai dẳng, aeson và scotty

Đây là ý tưởng của tôi:

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

này doesn Không biên dịch, tôi nhận được lỗi này:

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 }' 

Có vẻ như tôi phải thêm một ràng buộc kiểu khác, chẳng hạn như PersistMonadBackend m ~ PersistEntityBackend a, nhưng tôi không thấy như thế nào.

Answer 1

Ràng buộc có nghĩa là các loại phụ trợ liên quan cho một trường hợp PersistEntity cần phải được SqlBackend, vì vậy khi người dùng thực hiện các lớp PersistEntity như một phần của việc thực hiện các lớp CRUD họ sẽ cần phải xác định đó.

Từ quan điểm của bạn, bạn chỉ cần phải kích hoạt phần mở rộng TypeFamilies và thêm ràng buộc để định nghĩa lớp học của bạn:

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

Khi xác định một thể hiện của PersistEntity đối với một số loại Foo, người dùng của CRUD sẽ cần phải xác định loại PersistEntityBackend là SqlBackend:

instance PersistEntity Foo where 
    type PersistEntityBackend Foo = SqlBackend 

Dưới đây là bản sao hoàn chỉnh của tôi mã của bạn đã vượt qua Trình kiểm tra loại 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()