代码之家 › 专栏 › 技术社区 › agrafix

持久:CRUD类型类

yesod persistent crud haskell

agrafix · 技术社区 · 11 年前

我正在尝试编写一个类型类,该类使用 持久的 , 伊森和 苏格兰

这是我的想法:

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

这没有编译,我得到了这个错误:

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 ,但我不知道怎么做。

1 回复 | 直到 11 年前

Ganesh Sittampalam 11 年前

约束意味着 PersistEntity 实例需要 SqlBackend ,因此当用户实现 持久实体 类作为实现的一部分 CRUD 类,他们需要指定。

从您的角度来看,您只需要启用 TypeFamilies 扩展,并将该约束添加到类定义中:

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

定义的实例时 持久实体 对于某些类型 Foo ,的用户 积垢 将需要定义 PersistEntityBackend 类型为 SQL后端 :

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