diff --git a/package.yaml b/package.yaml index 4490e2c..cb0ddb9 100644 --- a/package.yaml +++ b/package.yaml @@ -8,6 +8,7 @@ library: source-dirs: src dependencies: - base >= 4.10 && < 5 + - containers >= 0.5.10.2 && < 0.7 - mtl >= 2.2.2 && < 3 - persistent >= 2.8.2 && < 3 - resource-pool >= 0.2.3.2 && < 0.3 diff --git a/persistent-mtl.cabal b/persistent-mtl.cabal index b7f9542..0e70027 100644 --- a/persistent-mtl.cabal +++ b/persistent-mtl.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ed87d93280415b4fcbbb88057eb1df14d7ed6b3251947b40b2b150598adef468 +-- hash: f1717fb11c2c334c4fb635d2ab3fafd4960e5d56d9f998a53962019736a970e5 name: persistent-mtl version: 0.1.0.0 @@ -25,6 +25,7 @@ library ghc-options: -Wall build-depends: base >=4.10 && <5 + , containers >=0.5.10.2 && <0.7 , mtl >=2.2.2 && <3 , persistent >=2.8.2 && <3 , resource-pool >=0.2.3.2 && <0.3 diff --git a/src/Database/Persist/Monad/Shim.hs b/src/Database/Persist/Monad/Shim.hs index 2bc97c1..954dd0b 100644 --- a/src/Database/Persist/Monad/Shim.hs +++ b/src/Database/Persist/Monad/Shim.hs @@ -3,6 +3,7 @@ module Database.Persist.Monad.Shim where import Control.Monad.IO.Unlift (MonadUnliftIO) +import Data.Map (Map) import Data.Text (Text) import Data.Typeable (Typeable) import Database.Persist @@ -11,6 +12,31 @@ import Database.Persist.Sql import Database.Persist.Monad.Class (MonadSqlQuery(..)) import Database.Persist.Monad.SqlQueryRep (SqlQueryRep(..)) +{- PersistStoreRead -} + +get :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => Key record -> m (Maybe record) +get a = runQueryRep $ Get a + +getMany :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => [Key record] -> m (Map (Key record) record) +getMany a = runQueryRep $ GetMany a + +getJust :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => Key record -> m record +getJust a = runQueryRep $ GetJust a + +getJustEntity :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => Key record -> m (Entity record) +getJustEntity a = runQueryRep $ GetJustEntity a + +getEntity :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => Key record -> m (Maybe (Entity record)) +getEntity a = runQueryRep $ GetEntity a + +belongsTo :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend, Typeable record1, Typeable record2, MonadSqlQuery m) => (record1 -> Maybe (Key record2)) -> record1 -> m (Maybe record2) +belongsTo a b = runQueryRep $ BelongsTo a b + +belongsToJust :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend, Typeable record1, Typeable record2, MonadSqlQuery m) => (record1 -> Key record2) -> record1 -> m record2 +belongsToJust a b = runQueryRep $ BelongsToJust a b + +{- Other -} + selectList :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => [Filter record] -> [SelectOpt record] -> m [Entity record] selectList a b = runQueryRep $ SelectList a b diff --git a/src/Database/Persist/Monad/SqlQueryRep.hs b/src/Database/Persist/Monad/SqlQueryRep.hs index 39378d3..81da417 100644 --- a/src/Database/Persist/Monad/SqlQueryRep.hs +++ b/src/Database/Persist/Monad/SqlQueryRep.hs @@ -9,16 +9,46 @@ module Database.Persist.Monad.SqlQueryRep ) where import Control.Monad.IO.Unlift (MonadUnliftIO) +import Data.Map (Map) import Data.Proxy (Proxy(..)) import Data.Text (Text) import Data.Typeable (Typeable, eqT, typeRep, (:~:)(..)) import Data.Void (Void) -import Database.Persist (Entity, Filter, Key, PersistRecordBackend, SelectOpt) -import Database.Persist.Sql (Migration, SqlBackend) -import qualified Database.Persist.Sql as Persist +import Database.Persist.Sql as Persist --- TODO: generate this data SqlQueryRep record a where + {- PersistStoreRead -} + + Get + :: PersistRecordBackend record SqlBackend + => Key record -> SqlQueryRep record (Maybe record) + + GetMany + :: PersistRecordBackend record SqlBackend + => [Key record] -> SqlQueryRep record (Map (Key record) record) + + GetJust + :: PersistRecordBackend record SqlBackend + => Key record -> SqlQueryRep record record + + GetJustEntity + :: PersistRecordBackend record SqlBackend + => Key record -> SqlQueryRep record (Entity record) + + GetEntity + :: PersistRecordBackend record SqlBackend + => Key record -> SqlQueryRep record (Maybe (Entity record)) + + BelongsTo + :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend) + => (record1 -> Maybe (Key record2)) -> record1 -> SqlQueryRep (record1, record2) (Maybe record2) + + BelongsToJust + :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend) + => (record1 -> Key record2) -> record1 -> SqlQueryRep (record1, record2) record2 + + {- Other -} + SelectList :: PersistRecordBackend record SqlBackend => [Filter record] -> [SelectOpt record] -> SqlQueryRep record [Entity record] @@ -36,6 +66,14 @@ data SqlQueryRep record a where instance Typeable record => Show (SqlQueryRep record a) where show = \case + Get{} -> "Get{..}" ++ record + GetMany{} -> "GetMany{..}" ++ record + GetJust{} -> "GetJust{..}" ++ record + GetJustEntity{} -> "GetJustEntity{..}" ++ record + GetEntity{} -> "GetEntity{..}" ++ record + BelongsTo{} -> "BelongsTo{..}" ++ record + BelongsToJust{} -> "BelongsToJust{..}" ++ record + SelectList{} -> "SelectList{..}" ++ record Insert{} -> "Insert{..}" ++ record Insert_{} -> "Insert_{..}" ++ record @@ -50,6 +88,14 @@ instance Typeable record => Show (SqlQueryRep record a) where runSqlQueryRep :: MonadUnliftIO m => SqlQueryRep record a -> Persist.SqlPersistT m a runSqlQueryRep = \case + Get a -> Persist.get a + GetMany a -> Persist.getMany a + GetJust a -> Persist.getJust a + GetJustEntity a -> Persist.getJustEntity a + GetEntity a -> Persist.getEntity a + BelongsTo a b -> Persist.belongsTo a b + BelongsToJust a b -> Persist.belongsToJust a b + SelectList a b -> Persist.selectList a b Insert a -> Persist.insert a Insert_ a -> Persist.insert_ a