How can I make this code more polymorphic? - haskell

Question

I'm working with the following code:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Lib where
import Protolude hiding (from, try)
import Control.Exception.Safe
import Database.Esqueleto
import Database.Persist.TH
newtype PingId =
PingId Int
deriving (Enum, Eq, Integral, Num, Ord, Real, Show)
data Ping = Ping
{
} deriving (Show)
share [mkPersist sqlSettings] [persistLowerCase|
DbPing sql=pings
|]
pingToDbPing :: Ping -> DbPing
pingToDbPing _ = undefined
class (PersistEntity b, ToBackendKey SqlBackend b) =>
ToPersistEntity a b | a -> b where
toPersistEntity :: a -> b
type family FromKey a :: * where
FromKey DbPingId = PingId
instance ToPersistEntity Ping DbPing where
toPersistEntity = pingToDbPing
data DbConfig = DbConfig
{ dbConnectionPool :: ConnectionPool
}
runDB
:: (MonadIO m, MonadReader DbConfig m)
=> SqlPersistT IO b -> m b
runDB q = do
pool <- asks dbConnectionPool
liftIO $ runSqlPool q pool
saveDB
:: ( Exception e
, ToPersistEntity value record
, Num (FromKey (Key record))
, MonadCatch m
, MonadIO m
, MonadReader DbConfig m
, FromKey (Key record) ~ key
)
=> value -> m (Either e key)
saveDB x =
fmap (fromIntegral . fromSqlKey) <$>
try (liftIO . evaluate =<< runDB (insert (toPersistEntity x)))
In short I have domain objects (e.g Ping), ToPersistEntity type class to convert those into their database representation, FromKey type family to map between database / domain object id's, and saveDB function that works for anything satisfying those criteria.
As the next step I wish to create a type class to abstract persisting the objects so that my other functions can be polymorphic in MonadStore and I can have different instances for use in my application and for testing. For use in my app I would like to reuse the generic saveDB function. Ideally I would like to have something along the lines of:
class (Monad m) =>
MonadStore m where
save
:: (Exception e)
=> value -> m (Either e key)
with save type class method delegating to saveDB when used in my application. That works fine if I make type class methods specialised to specific types such as Ping and PingId.
class (Monad m) =>
MonadStore m where
savePing
:: (Exception e)
=> Ping -> m (Either e PingId)
instance (MonadCatch m, MonadIO m, Monad m, MonadReader DbConfig m) =>
MonadStore m where
savePing = saveDB
but has the drawback of having to define a new method for each of my objects.
Trying to define my desired instance:
instance (MonadCatch m, MonadIO m, Monad m, MonadReader DbConfig m) =>
MonadStore m where
save = saveDB
produces a type error:
/home/ppb/Code/haskell/test/src/Lib.hs:86:10: error:
• Couldn't match type ‘key’ with ‘FromKey (Key record0)’
arising from a use of ‘saveDB’
‘key’ is a rigid type variable bound by
the type signature for:
save :: forall e value key.
Exception e =>
value -> m (Either e key)
at src/Lib.hs:86:3
• In the expression: saveDB
In an equation for ‘save’: save = saveDB
In the instance declaration for ‘MonadStore m’
• Relevant bindings include
save :: value -> m (Either e key) (bound at src/Lib.hs:86:3)
and no matter what I try I can't figure out how to make a valid instance where save delegates to saveDB. Is there any way I could make this work? I'm also interested to better understand the error the compiler produces.