persistent 1.1.0 → 1.1.0.1
raw patch · 4 files changed
+15/−128 lines, 4 filesdep +silentlydep ~blaze-htmldep ~blaze-markupdep ~monad-control
Dependencies added: silently
Dependency ranges changed: blaze-html, blaze-markup, monad-control, monad-logger, path-pieces, pool-conduit
Files
- Database/Persist/GenericSql.hs +0/−110
- Database/Persist/GenericSql/Migration.hs +4/−1
- Database/Persist/TH/Library.hs +0/−1
- persistent.cabal +11/−16
Database/Persist/GenericSql.hs view
@@ -252,116 +252,6 @@ dummyFromKey :: KeyBackend R.SqlBackend v -> v dummyFromKey _ = error "dummyFromKey" -{- FIXME-<<<<<<< HEAD--type Sql = Text---- Bool indicates if the Sql is safe-type CautiousMigration = [(Bool, Sql)]-allSql :: CautiousMigration -> [Sql]-allSql = map snd-unsafeSql :: CautiousMigration -> [Sql]-unsafeSql = allSql . filter fst-safeSql :: CautiousMigration -> [Sql]-safeSql = allSql . filter (not . fst)--type Migration m = WriterT [Text] (WriterT CautiousMigration m) ()--parseMigration :: Monad m => Migration m -> m (Either [Text] CautiousMigration)-parseMigration =- liftM go . runWriterT . execWriterT- where- go ([], sql) = Right sql- go (errs, _) = Left errs---- like parseMigration, but call error or return the CautiousMigration-parseMigration' :: Monad m => Migration m -> m (CautiousMigration)-parseMigration' m = do- x <- parseMigration m- case x of- Left errs -> error $ unpack $ unlines errs- Right sql -> return sql--printMigration :: (MBCIO m, MonadIO m) => Migration (SqlPersist m) -> SqlPersist m ()-printMigration m = do- mig <- parseMigration' m- mapM_ (liftIO . Data.Text.IO.putStrLn . flip snoc ';') (allSql mig)--getMigration :: (MBCIO m, MonadIO m) => Migration (SqlPersist m) -> SqlPersist m [Sql]-getMigration m = do- mig <- parseMigration' m- return $ allSql mig--runMigration :: (MonadIO m, MBCIO m)- => Migration (SqlPersist m)- -> SqlPersist 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 :: (MBCIO m, MonadIO m)- => Migration (SqlPersist m)- -> SqlPersist m [Text]-runMigrationSilent m = runMigration' m True--runMigration'- :: (MBCIO m, MonadIO m)- => Migration (SqlPersist m)- -> Bool -- ^ is silent?- -> SqlPersist m [Text]-runMigration' m silent = do- mig <- parseMigration' m- case unsafeSql mig of- [] -> mapM (executeMigrate silent) $ safeSql mig- errs -> error $ unpack $ concat- [ "\n\nDatabase migration: manual intervention required.\n"- , "The following actions are considered unsafe:\n\n"- , unlines $ map (\s -> " " ++ s ++ ";") $ errs- ]--runMigrationUnsafe :: (MBCIO m, MonadIO m)- => Migration (SqlPersist m)- -> SqlPersist m ()-runMigrationUnsafe m = do- mig <- parseMigration' m- mapM_ (executeMigrate False) $ allSql mig--executeMigrate :: MonadIO m => Bool -> Text -> SqlPersist m Text-executeMigrate silent s = do- unless silent $ liftIO $ hPutStrLn stderr $ "Migrating: " ++ s- execute' s []- return s--migrate :: (MonadIO m, MBCIO m, PersistEntity val)- => [EntityDef]- -> val- -> Migration (SqlPersist m)-migrate allDefs val = do- conn <- lift $ lift $ SqlPersist ask- let getter = R.getStmt' conn- res <- liftIO $ migrateSql conn allDefs getter val- either tell (lift . tell) res--updatePersistValue :: Update v -> PersistValue-updatePersistValue (Update _ v _) = toPersistValue v---- | Perform a database commit.-commit :: MonadIO m => SqlPersist m ()-commit = do- conn <- SqlPersist ask- let getter = R.getStmt' conn- liftIO $ commitC conn getter >> begin conn getter---- | Perform a database rollback.-rollback :: MonadIO m => SqlPersist m ()-rollback = do- conn <- SqlPersist ask- let getter = R.getStmt' conn- liftIO $ rollbackC conn getter >> begin conn getter-=======--}- dummyFromUnique :: Unique v -> v dummyFromUnique _ = error "dummyFromUnique"
Database/Persist/GenericSql/Migration.hs view
@@ -36,6 +36,9 @@ import qualified Data.Text.IO import System.IO import Control.Monad.Logger (MonadLogger)+import System.IO.Silently (hSilence)+import System.IO (stderr)+import Control.Monad.Trans.Control (liftBaseOp_) execute' :: (MonadIO m, MonadLogger m) => Text -> [PersistValue] -> SqlPersist m () execute' = R.execute@@ -88,7 +91,7 @@ runMigrationSilent :: (MBCIO m, MonadIO m, MonadLogger m) => Migration (SqlPersist m) -> SqlPersist m [Text]-runMigrationSilent m = runMigration' m True+runMigrationSilent m = liftBaseOp_ (hSilence [stderr]) $ runMigration' m True runMigration' :: (MBCIO m, MonadIO m, MonadLogger m)
Database/Persist/TH/Library.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-#include "cabal_macros.h" module Database.Persist.TH.Library ( apE ) where
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 1.1.0+version: 1.1.0.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -11,17 +11,11 @@ cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/book/persistent-extra-source-files:- test/main.hs flag nooverlap default: False description: test out our assumption that OverlappingInstances is just for String -flag blaze_html_0_5- description: use blaze-html 0.5 and blaze-markup 0.5- default: True- library if flag(nooverlap) cpp-options: -DNO_OVERLAP@@ -32,22 +26,23 @@ , time >= 1.1.4 , text >= 0.8 , containers >= 0.2- , conduit >= 0.5.5 && < 0.6- , resourcet >= 0.4 && < 0.5- , monad-control >= 0.3 && < 0.4+ , conduit >= 0.5.5+ , resourcet >= 0.4+ , monad-control >= 0.3 , lifted-base >= 0.1- , pool-conduit >= 0.1.1 && < 0.2- , path-pieces >= 0.1 && < 0.2- , aeson >= 0.5 && < 0.7- , monad-logger >= 0.2.3 && < 0.3+ , pool-conduit >= 0.1.1+ , path-pieces >= 0.1+ , aeson >= 0.5+ , monad-logger >= 0.2.3 , transformers-base , base64-bytestring , unordered-containers , vector , attoparsec , template-haskell- , blaze-html >= 0.5 && < 0.6- , blaze-markup >= 0.5.1 && < 0.6+ , blaze-html >= 0.5+ , blaze-markup >= 0.5.1+ , silently exposed-modules: Database.Persist Database.Persist.EntityDef