Persistent: CRUD TypeClass

Question

Próbuję napisać typeclass który ułatwia pisanie backend CRUD używając trwałe, ajzon i Scotty

Oto mój pomysł:

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

To nie robi Kompilacja, pojawia się ten błąd:

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

Wygląda na to, że muszę dodać kolejne ograniczenie typu, takie jak PersistMonadBackend m ~ PersistEntityBackend a, ale nie widzę sposobu.

Answer 1

Ograniczenie oznacza, że ​​wiąże typu backend dla instancji PersistEntity musi być SqlBackend, więc kiedy użytkownik implementuje klasę PersistEntity w ramach realizacji klasę CRUD będą musieli określić, że.

ze swojego punktu widzenia, po prostu trzeba włączyć rozszerzenie TypeFamilies i dodać, że ograniczenie do definicji klasy:

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

Przy definiowaniu instancji PersistEntity jakiegoś rodzaju Foo, użytkownik CRUD będzie trzeba określić typ PersistEntityBackend być SqlBackend:

instance PersistEntity Foo where 
    type PersistEntityBackend Foo = SqlBackend 

Oto moja kompletna kopia kodu, który przechodzi Sprawdzanie typu 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()