packages feed

persistent 2.1 → 2.1.0.1

raw patch · 5 files changed

+50/−35 lines, 5 files

Files

Database/Persist/Class/PersistUnique.hs view
@@ -23,13 +23,19 @@  import Database.Persist.Class.PersistStore import Database.Persist.Class.PersistEntity+import Data.Monoid (mappend)+import Data.Text (unpack, Text) --- | Queries against unique keys (other than the id).+-- | Queries against 'Unique' keys (other than the id 'Key'). -- -- Please read the general Persistent documentation to learn how to create--- Unique keys.--- SQL backends automatically create uniqueness constraints, but for MongoDB you must manually place a unique index on the field.+-- 'Unique' keys. --+-- Using this with an Entity without a Unique key leads to undefined behavior.+-- A few of these functions require a *single* 'Unique', so using an Entity with multiple 'Unique's is also undefined. In these cases persistent's goal is to throw an exception as soon as possible, but persistent is still transitioning to that.+--+-- SQL backends automatically create uniqueness constraints, but for MongoDB you must manually place a unique index on a field to have a uniqueness constraint.+-- -- Some functions in this module (insertUnique, insertBy, and replaceUnique) first query the unique indexes to check for conflicts. -- You could instead optimistically attempt to perform the operation (e.g. replace instead of replaceUnique). However, --@@ -91,7 +97,7 @@            => val -> ReaderT backend m (Unique val) onlyUnique record = case onlyUniqueEither record of     Right u -> return u-    Left us -> liftIO $ throwIO $ OnlyUniqueException $ show $ length us+    Left us -> requireUniques record us >>= liftIO . throwIO . OnlyUniqueException . show . length  onlyUniqueEither :: (PersistEntity val) => val -> Either [Unique val] (Unique val) onlyUniqueEither record = case persistUniqueKeys record of@@ -99,12 +105,12 @@     us     -> Left us  -- | A modification of 'getBy', which takes the 'PersistEntity' itself instead--- of a 'Unique' value. Returns a value matching /one/ of the unique keys. This+-- of a 'Unique' record. Returns a record matching /one/ of the unique keys. This -- function makes the most sense on entities with a single 'Unique' -- constructor.-getByValue :: (MonadIO m, PersistEntity value, PersistUnique backend, PersistEntityBackend value ~ backend)-           => value -> ReaderT backend m (Maybe (Entity value))-getByValue = checkUniques . persistUniqueKeys+getByValue :: (MonadIO m, PersistEntity record, PersistUnique backend, PersistEntityBackend record ~ backend)+           => record -> ReaderT backend m (Maybe (Entity record))+getByValue record = checkUniques =<< requireUniques record (persistUniqueKeys record)   where     checkUniques [] = return Nothing     checkUniques (x:xs) = do@@ -113,6 +119,15 @@             Nothing -> checkUniques xs             Just z -> return $ Just z +requireUniques :: (MonadIO m, PersistEntity record) => record -> [Unique record] -> m [Unique record]+requireUniques record [] = liftIO $ throwIO $ userError errorMsg+  where+    errorMsg = "getByValue: " `mappend` unpack (recordName record) `mappend` " does not have any Unique"+requireUniques _ xs = return xs++-- TODO: expose this to users+recordName :: (PersistEntity record) => record -> Text+recordName = unHaskellName . entityHaskell . entityDef . Just  -- | Attempt to replace the record of the given key with the given new record. -- First query the unique fields to make sure the replacement maintains uniqueness constraints.
Database/Persist/Sql/Migration.hs view
@@ -34,7 +34,7 @@ safeSql :: CautiousMigration -> [Sql] safeSql = allSql . filter (not . fst) -parseMigration :: MonadIO m => Migration -> ReaderT Connection m (Either [Text] CautiousMigration)+parseMigration :: MonadIO m => Migration -> ReaderT SqlBackend m (Either [Text] CautiousMigration) parseMigration =     liftIOReader . liftM go . runWriterT . execWriterT   where@@ -44,40 +44,40 @@     liftIOReader (ReaderT m) = ReaderT $ liftIO . m  -- like parseMigration, but call error or return the CautiousMigration-parseMigration' :: MonadIO m => Migration -> ReaderT Connection m (CautiousMigration)+parseMigration' :: MonadIO m => Migration -> ReaderT SqlBackend m (CautiousMigration) parseMigration' m = do   x <- parseMigration m   case x of       Left errs -> error $ unlines $ map unpack errs       Right sql -> return sql -printMigration :: MonadIO m => Migration -> ReaderT Connection m ()+printMigration :: MonadIO m => Migration -> ReaderT SqlBackend m () printMigration m = do   mig <- parseMigration' m   mapM_ (liftIO . Data.Text.IO.putStrLn . flip snoc ';') (allSql mig) -getMigration :: (MonadBaseControl IO m, MonadIO m) => Migration -> ReaderT Connection m [Sql]+getMigration :: (MonadBaseControl IO m, MonadIO m) => Migration -> ReaderT SqlBackend m [Sql] getMigration m = do   mig <- parseMigration' m   return $ allSql mig  runMigration :: MonadIO m              => Migration-             -> ReaderT Connection m ()+             -> ReaderT SqlBackend m () runMigration m = runMigration' m False >> return ()  -- | Same as 'runMigration', but returns a list of the SQL commands executed -- instead of printing them to stderr. runMigrationSilent :: (MonadBaseControl IO m, MonadIO m)                    => Migration-                   -> ReaderT Connection m [Text]+                   -> ReaderT SqlBackend m [Text] runMigrationSilent m = liftBaseOp_ (hSilence [stderr]) $ runMigration' m True  runMigration'     :: MonadIO m     => Migration     -> Bool -- ^ is silent?-    -> ReaderT Connection m [Text]+    -> ReaderT SqlBackend m [Text] runMigration' m silent = do     mig <- parseMigration' m     case unsafeSql mig of@@ -90,12 +90,12 @@  runMigrationUnsafe :: MonadIO m                    => Migration-                   -> ReaderT Connection m ()+                   -> ReaderT SqlBackend m () runMigrationUnsafe m = do     mig <- parseMigration' m     mapM_ (executeMigrate False) $ sortMigrations $ allSql mig -executeMigrate :: MonadIO m => Bool -> Text -> ReaderT Connection m Text+executeMigrate :: MonadIO m => Bool -> Text -> ReaderT SqlBackend m Text executeMigrate silent s = do     unless silent $ liftIO $ hPutStrLn stderr $ "Migrating: " ++ unpack s     rawExecute s []
Database/Persist/Sql/Raw.hs view
@@ -21,7 +21,7 @@ import Data.Conduit import Control.Monad.Trans.Resource (MonadResource) -rawQuery :: (MonadResource m, MonadReader env m, HasPersistBackend env Connection)+rawQuery :: (MonadResource m, MonadReader env m, HasPersistBackend env SqlBackend)          => Text          -> [PersistValue]          -> Source m [PersistValue]@@ -35,7 +35,7 @@     :: (MonadIO m1, MonadIO m2)     => Text     -> [PersistValue]-    -> ReaderT Connection m1 (Acquire (Source m2 [PersistValue]))+    -> ReaderT SqlBackend m1 (Acquire (Source m2 [PersistValue])) rawQueryRes sql vals = do     conn <- ask     let make = do@@ -46,10 +46,10 @@         stmt <- mkAcquire make stmtReset         stmtQuery stmt vals -rawExecute :: MonadIO m => Text -> [PersistValue] -> ReaderT Connection m ()+rawExecute :: MonadIO m => Text -> [PersistValue] -> ReaderT SqlBackend m () rawExecute x y = liftM (const ()) $ rawExecuteCount x y -rawExecuteCount :: MonadIO m => Text -> [PersistValue] -> ReaderT Connection m Int64+rawExecuteCount :: MonadIO m => Text -> [PersistValue] -> ReaderT SqlBackend m Int64 rawExecuteCount sql vals = do     conn <- ask     runLoggingT ($logDebugS (pack "SQL") $ pack $ show sql ++ " " ++ show vals)@@ -59,12 +59,12 @@     liftIO $ stmtReset stmt     return res -getStmt :: MonadIO m => Text -> ReaderT Connection m Statement+getStmt :: MonadIO m => Text -> ReaderT SqlBackend m Statement getStmt sql = do     conn <- ask     liftIO $ getStmtConn conn sql -getStmtConn :: Connection -> Text -> IO Statement+getStmtConn :: SqlBackend -> Text -> IO Statement getStmtConn conn sql = do     smap <- liftIO $ readIORef $ connStmtMap conn     case Map.lookup sql smap of@@ -122,7 +122,7 @@ rawSql :: (RawSql a, MonadIO m)        => Text             -- ^ SQL statement, possibly with placeholders.        -> [PersistValue]   -- ^ Values to fill the placeholders.-       -> ReaderT Connection m [a]+       -> ReaderT SqlBackend m [a] rawSql stmt = run     where       getType :: (x -> m [a]) -> a
Database/Persist/Sql/Run.hs view
@@ -24,7 +24,7 @@  -- | Get a connection from the pool, run the given action, and then return the -- connection to the pool.-runSqlPool :: MonadBaseControl IO m => SqlPersistT m a -> Pool Connection -> m a+runSqlPool :: MonadBaseControl IO m => SqlPersistT m a -> Pool SqlBackend -> m a runSqlPool r pconn = do     mres <- withResourceTimeout 2000000 pconn $ runSqlConn r     maybe (throwIO Couldn'tGetSQLConnection) return mres@@ -51,7 +51,7 @@             return ret {-# INLINABLE withResourceTimeout #-} -runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> Connection -> m a+runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> SqlBackend -> m a runSqlConn r conn = do     let getter = getStmtConn conn     liftBase $ connBegin conn getter@@ -61,25 +61,25 @@     liftBase $ connCommit conn getter     return x -runSqlPersistM :: SqlPersistM a -> Connection -> IO a+runSqlPersistM :: SqlPersistM a -> SqlBackend -> IO a runSqlPersistM x conn = runResourceT $ runNoLoggingT $ runSqlConn x conn -runSqlPersistMPool :: SqlPersistM a -> Pool Connection -> IO a+runSqlPersistMPool :: SqlPersistM a -> Pool SqlBackend -> IO a runSqlPersistMPool x pool = runResourceT $ runNoLoggingT $ runSqlPool x pool  withSqlPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)-            => (LogFunc -> IO Connection) -- ^ create a new connection+            => (LogFunc -> IO SqlBackend) -- ^ create a new connection             -> Int -- ^ connection count-            -> (Pool Connection -> m a)+            -> (Pool SqlBackend -> m a)             -> m a withSqlPool mkConn connCount f = do     pool <- createSqlPool mkConn connCount     f pool  createSqlPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m)-              => (LogFunc -> IO Connection)+              => (LogFunc -> IO SqlBackend)               -> Int-              -> m (Pool Connection)+              -> m (Pool SqlBackend) createSqlPool mkConn size = do     logFunc <- askLogFunc     liftIO $ createPool (mkConn logFunc) close' 1 20 size@@ -94,12 +94,12 @@         return ()  withSqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m)-            => (LogFunc -> IO Connection) -> (Connection -> m a) -> m a+            => (LogFunc -> IO SqlBackend) -> (SqlBackend -> m a) -> m a withSqlConn open f = do     logFunc <- askLogFunc     bracket (liftIO $ open logFunc) (liftIO . close') f -close' :: Connection -> IO ()+close' :: SqlBackend -> IO () close' conn = do     readIORef (connStmtMap conn) >>= mapM_ stmtFinalize . Map.elems     connClose conn
persistent.cabal view
@@ -1,5 +1,5 @@ name:            persistent-version:         2.1+version:         2.1.0.1 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>