persistent 2.1.1 → 2.1.1.1

raw patch · 5 files changed

+78/−14 lines, 5 filesdep ~monad-controlPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: monad-control

API changes (from Hackage documentation)

Files

• ChangeLog.md +3/−0
• Database/Persist/Sql/Orphan/PersistStore.hs +54/−6
• Database/Persist/Sql/Run.hs +13/−6
• README.md +5/−0
• persistent.cabal +3/−2

@@ -0,0 +1,3 @@+## 2.1.1.1++Support for monad-control 1.0

@@ -4,12 +4,17 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Persist.Sql.Orphan.PersistStore   ( withRawQuery   , BackendKey(..)   , toSqlKey   , fromSqlKey+  , getFieldName+  , getTableName+  , tableDBName+  , fieldDBName   ) where  import Database.Persist@@ -54,6 +59,48 @@     Nothing   -> connEscapeName conn (fieldDB (entityId t)) <> "=?"   where t = entityDef $ dummyFromKey k ++-- | get the SQL string for the table that a PeristEntity represents+-- Useful for raw SQL queries+--+-- Your backend may provide a more convenient tableName function+-- which does not operate in a Monad+getTableName :: forall record m.+             ( PersistEntity record+             , PersistEntityBackend record ~ SqlBackend+             , Monad m+             ) => record -> ReaderT SqlBackend m Text+getTableName rec = do+    conn <- ask+    return $ connEscapeName conn $ tableDBName rec++-- | useful for a backend to implement tableName by adding escaping+tableDBName :: forall record.+            ( PersistEntity record+            , PersistEntityBackend record ~ SqlBackend+            ) => record -> DBName+tableDBName rec = entityDB $ entityDef (Just rec)++-- | get the SQL string for the field that an EntityField represents+-- Useful for raw SQL queries+--+-- Your backend may provide a more convenient fieldName function+-- which does not operate in a Monad+getFieldName :: forall record typ m.+             ( PersistEntity record+             , PersistEntityBackend record ~ SqlBackend+             , Monad m+             )+             => EntityField record typ -> ReaderT SqlBackend m Text+getFieldName rec = do+    conn <- ask+    return $ connEscapeName conn $ fieldDBName rec++-- | useful for a backend to implement fieldName by adding escaping+fieldDBName :: forall record typ. (PersistEntity record) => EntityField record typ -> DBName+fieldDBName = fieldDB . persistFieldDef++ instance PersistStore SqlBackend where     newtype BackendKey SqlBackend = SqlBackendKey { unSqlBackendKey :: Int64 }         deriving (Show, Read, Eq, Ord, Num, Integral, PersistField, PersistFieldSql, PathPiece, Real, Enum, Bounded, A.ToJSON, A.FromJSON)@@ -71,7 +118,7 @@         let wher = whereStmtForKey conn k         let sql = T.concat                 [ "UPDATE "-                , connEscapeName conn $ entityDB t+                , connEscapeName conn $ tableDBName $ recordTypeFromKey k                 , " SET "                 , T.intercalate "," $ map (go' . go) upds                 , " WHERE "@@ -80,7 +127,6 @@         rawExecute sql $             map updatePersistValue upds `mappend` keyToValues k       where-        t = entityDef $ dummyFromKey k         go x = (fieldDB $ updateFieldDef x, updateUpdate x)      insert val = do@@ -216,17 +262,19 @@         conn <- ask         rawExecute (sql conn) (keyToValues k)       where-        t = entityDef $ dummyFromKey k         wher conn = whereStmtForKey conn k         sql conn = T.concat             [ "DELETE FROM "-            , connEscapeName conn $ entityDB t+            , connEscapeName conn $ tableDBName $ recordTypeFromKey k             , " WHERE "             , wher conn             ] -dummyFromKey :: Key v -> Maybe v-dummyFromKey _ = Nothing+dummyFromKey :: Key record -> Maybe record+dummyFromKey = Just . recordTypeFromKey++recordTypeFromKey :: Key record -> record+recordTypeFromKey _ = error "dummyFromKey"  insrepHelper :: (MonadIO m, PersistEntity val)              => Text

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-} module Database.Persist.Sql.Run where  import Database.Persist.Sql.Types@@ -15,7 +16,7 @@ import Control.Exception (mask) import System.Timeout (timeout) import Control.Monad.Trans.Control (control)-import Data.IORef (readIORef)+import Data.IORef (readIORef, writeIORef, newIORef) import qualified Data.Map as Map import Control.Exception.Lifted (throwIO) import Control.Exception (mask)@@ -33,8 +34,8 @@ -- allocation does not complete within the given timeout period. -- -- Since 2.0.0-withResourceTimeout ::-    (MonadBaseControl IO m)+withResourceTimeout+  :: forall a m b.  (MonadBaseControl IO m)   => Int -- ^ Timeout period in microseconds   -> Pool a   -> (a -> m b)@@ -43,7 +44,7 @@ withResourceTimeout ms pool act = control $ \runInIO -> mask $ \restore -> do     mres <- timeout ms $ takeResource pool     case mres of-        Nothing -> runInIO $ return Nothing+        Nothing -> runInIO $ return (Nothing :: Maybe b)         Just (resource, local) -> do             ret <- restore (runInIO (liftM Just $ act resource)) `onException`                     destroyResource pool local resource@@ -86,9 +87,15 @@  -- NOTE: This function is a terrible, ugly hack. It would be much better to -- just clean up monad-logger.-askLogFunc :: (MonadBaseControl IO m, MonadLogger m) => m LogFunc+--+-- FIXME: in a future release, switch over to the new askLoggerIO function+-- added in monad-logger 0.3.10. That function was not available at the time+-- this code was written.+askLogFunc :: forall m. (MonadBaseControl IO m, MonadLogger m) => m LogFunc askLogFunc = do-    runInBase <- control $ \run -> run $ return run+    ref <- liftBase $ newIORef undefined+    liftBaseWith $ \run -> writeIORef ref run+    runInBase <- liftBase $ readIORef ref     return $ \a b c d -> do         _ <- runInBase (monadLoggerLog a b c d)         return ()

@@ -0,0 +1,5 @@+## persistent++Type-safe, data serialization. You must use a specific backend in order to make+this useful. For more information, see [the chapter in the Yesod+book](http://www.yesodweb.com/book/persistent).

@@ -1,17 +1,18 @@ name:            persistent-version:         2.1.1+version:         2.1.1.1 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com> maintainer:      Michael Snoyman <michael@snoyman.com>, Greg Weber <greg@gregweber.info> synopsis:        Type-safe, multi-backend data serialization.-description:     Type-safe, data serialization. You must use a specific backend in order to make this useful.+description:     Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/persistent>. category:        Database, Yesod stability:       Stable cabal-version:   >= 1.8 build-type:      Simple homepage:        http://www.yesodweb.com/book/persistent bug-reports:     https://github.com/yesodweb/persistent/issues+extra-source-files: ChangeLog.md README.md  flag nooverlap     default: False