永続：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() 

このdoesnのコンパイルすると、私はこのエラーになります：

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する必要があることを意味するので、ユーザは、彼らがそれを指定する必要がありますCRUDクラスを実装の一部としてPersistEntityクラスを実装します。

あなたの視点から、あなただけのTypeFamilies拡張を可能にし、あなたのクラス定義にその制約を追加する必要があります。

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

いくつかのタイプFoo、CRUD意志のユーザのためにPersistEntityのインスタンスを定義する場合SqlBackendするPersistEntityBackendタイプを定義する必要があります。

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