apiary-persistent 1.1.1 → 1.2.0

raw patch · 2 files changed

+48/−54 lines, 2 filesdep ~apiarydep ~apiary-loggerPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: apiary, apiary-logger

API changes (from Hackage documentation)

Files

• apiary-persistent.cabal +3/−3
• src/Web/Apiary/Database/Persist.hs +45/−51

@@ -1,5 +1,5 @@ name:                apiary-persistent-version:             1.1.1+version:             1.2.0 synopsis:            persistent support for apiary web framework. description:   example: <https://github.com/philopon/apiary/blob/master/examples/persistent.hs>@@ -21,8 +21,8 @@   build-depends:       base               >=4.6   && <4.8                      , persistent         >=2.1   && <2.2 -                     , apiary             >=1.1   && <1.2-                     , apiary-logger      >=1.1.1 && <1.2+                     , apiary             >=1.2   && <1.3+                     , apiary-logger      >=1.2   && <1.3                       , resourcet          >=1.1   && <1.2                      , resource-pool      >=0.2   && <0.3

@@ -1,16 +1,11 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE DataKinds #-} {-# LANGUAGE Rank2Types #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}  module Web.Apiary.Database.Persist     ( Persist@@ -26,32 +21,34 @@     , sql     ) where -import Data.Pool-import Control.Monad-import Control.Monad.Apiary-import Control.Monad.Logger-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Control-import Web.Apiary.Logger+import qualified Data.Pool as Pool+import Control.Monad(void, mzero)+import Control.Monad.IO.Class(MonadIO(..))+import Control.Monad.Logger(NoLoggingT(runNoLoggingT))+import Control.Monad.Trans.Reader(runReaderT)+import Control.Monad.Trans.Control(MonadBaseControl)+import Web.Apiary.Logger(LogWrapper, runLogWrapper) -import Database.Persist.Sql+import qualified Database.Persist.Sql as Sql -import Web.Apiary-import Control.Monad.Apiary.Action-import Control.Monad.Apiary.Filter+import Web.Apiary(Html)+import Control.Monad.Apiary(ApiaryT)+import Control.Monad.Apiary.Action(ActionT, getParams)+import Control.Monad.Apiary.Filter(focus, Doc(DocPrecondition)) import qualified Data.Apiary.Dict as Dict-import Data.Apiary.Compat+import Data.Apiary.Compat(Proxy(..), KnownSymbol) import Data.Apiary.Extension+    (Has, Initializer, initializer, Extensions, Extension, MonadExts, getExt)  data Migrator-    = Logging Migration-    | Silent  Migration-    | Unsafe  Migration+    = Logging Sql.Migration+    | Silent  Sql.Migration+    | Unsafe  Sql.Migration     | NoMigrate  data Persist-    = PersistPool ConnectionPool-    | PersistConn SqlBackend+    = PersistPool Sql.ConnectionPool+    | PersistConn Sql.SqlBackend  instance Extension Persist @@ -59,7 +56,7 @@  initPersist' :: (MonadIO n, MonadBaseControl IO n, Monad m)               => (forall a. Extensions exts -> n a -> m a)-             -> With SqlBackend n -> Migrator -> Initializer m exts (Persist ': exts)+             -> With Sql.SqlBackend n -> Migrator -> Initializer m exts (Persist ': exts) initPersist' run with migr = initializer $ \es -> run es $     with $ \conn -> do         doMigration migr conn@@ -73,62 +70,59 @@ -- initPersist (withSqliteConn "db.sqlite") migrateAll -- @ initPersist :: (MonadIO m, MonadBaseControl IO m) -            => With SqlBackend (LogWrapper exts m) -> Migration+            => With Sql.SqlBackend (LogWrapper exts m) -> Sql.Migration             -> Initializer m exts (Persist ': exts) initPersist with = initPersist' runLogWrapper with . Logging  initPersistNoLog :: (MonadIO m, MonadBaseControl IO m) -                 => With SqlBackend (NoLoggingT m)-                 -> Migration -> Initializer m es (Persist ': es)+                 => With Sql.SqlBackend (NoLoggingT m)+                 -> Sql.Migration -> Initializer m es (Persist ': es) initPersistNoLog with = initPersist' (const runNoLoggingT) with . Silent  initPersistPool' :: (MonadIO n, MonadBaseControl IO n, Monad m)                  => (forall a. Extensions exts -> n a -> m a)-                 -> With ConnectionPool n -> Migrator -> Initializer m exts (Persist ': exts)+                 -> With Sql.ConnectionPool n -> Migrator -> Initializer m exts (Persist ': exts) initPersistPool' run with migr = initializer $ \es -> run es $     with $ \pool -> do-        withResource pool $ doMigration migr+        Pool.withResource pool $ doMigration migr         return (PersistPool pool)  initPersistPool :: (MonadIO m, MonadBaseControl IO m)-                => With ConnectionPool (LogWrapper exts m) -> Migration+                => With Sql.ConnectionPool (LogWrapper exts m) -> Sql.Migration                 -> Initializer m exts (Persist ': exts) initPersistPool with = initPersistPool' runLogWrapper with . Logging  initPersistPoolNoLog :: (MonadIO m, MonadBaseControl IO m)-                     => With ConnectionPool (NoLoggingT m)-                     -> Migration -> Initializer m es (Persist ': es)+                     => With Sql.ConnectionPool (NoLoggingT m)+                     -> Sql.Migration -> Initializer m es (Persist ': es) initPersistPoolNoLog with = initPersistPool' (const runNoLoggingT) with . Silent -doMigration :: (MonadIO m, MonadBaseControl IO m) => Migrator -> SqlBackend -> m ()+doMigration :: (MonadIO m, MonadBaseControl IO m) => Migrator -> Sql.SqlBackend -> m () doMigration migr conn = case migr of-    Logging m -> runReaderT (runMigration m) conn-    Silent  m -> runReaderT (void (runMigrationSilent m)) conn-    Unsafe  m -> runReaderT (runMigrationUnsafe m) conn+    Logging m -> runReaderT (Sql.runMigration m) conn+    Silent  m -> runReaderT (void $ Sql.runMigrationSilent m) conn+    Unsafe  m -> runReaderT (Sql.runMigrationUnsafe m) conn     NoMigrate -> return ()  -- | execute sql in action. class RunSQL m where-    runSql :: SqlPersistT m a -> m a+    runSql :: Sql.SqlPersistT m a -> m a -runSql' :: MonadBaseControl IO m => SqlPersistT m a -> Persist -> m a+runSql' :: MonadBaseControl IO m => Sql.SqlPersistT m a -> Persist -> m a runSql' a persist = case persist of-    PersistPool p -> runSqlPool a p-    PersistConn c -> runSqlConn a c+    PersistPool p -> Sql.runSqlPool a p+    PersistConn c -> Sql.runSqlConn a c -instance (Has Persist exts, MonadBaseControl IO m) => RunSQL (ActionT exts prms m) where+instance (Has Persist es, MonadExts es m, MonadBaseControl IO m) => RunSQL m where     runSql a = getExt (Proxy :: Proxy Persist) >>= runSql' a -instance (Has Persist exts, MonadBaseControl IO m, Monad actM) => RunSQL (ApiaryT exts prms actM m) where-    runSql a = apiaryExt (Proxy :: Proxy Persist) >>= runSql' a- -- | filter by sql query. since 0.9.0.0.-sql :: (Has Persist exts, MonadBaseControl IO actM, Dict.NotMember k prms)+sql :: (KnownSymbol k, Has Persist exts, MonadBaseControl IO actM, Dict.NotMember k prms)     => Maybe Html -- ^ documentation.     -> proxy k-    -> SqlPersistT (ActionT exts prms actM) a+    -> Sql.SqlPersistT (ActionT exts prms actM) a     -> (a -> Maybe b) -- ^ result check function. Nothing: fail filter, Just a: success filter and add parameter.-    -> ApiaryT exts (k := b ': prms) actM m () -> ApiaryT exts prms actM m ()+    -> ApiaryT exts (k Dict.:= b ': prms) actM m () -> ApiaryT exts prms actM m () sql doc k q p = focus (maybe id DocPrecondition doc) $ do     fmap p (runSql q) >>= \case         Nothing -> mzero