persistent-sqlite 1.3.0.5 → 2.0.0
raw patch · 4 files changed
+31/−31 lines, 4 filesdep ~persistentdep ~resourcet
Dependency ranges changed: persistent, resourcet
Files
- Database/Persist/Sqlite.hs +27/−26
- Database/Sqlite.hs +1/−2
- cbits/sqlite3.c too large to diff
- persistent-sqlite.cabal +3/−3
Database/Persist/Sqlite.hs view
@@ -19,10 +19,11 @@ import qualified Database.Sqlite as Sqlite import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.Logger (NoLoggingT, runNoLoggingT)+import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLogger) import Data.IORef import qualified Data.Map as Map import Control.Monad.Trans.Control (control)+import Data.Acquire (Acquire, mkAcquire, with) import qualified Control.Exception as E import Data.Text (Text) import Control.Monad (mzero)@@ -37,27 +38,27 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Resource (ResourceT, MonadResource, runResourceT) -createSqlitePool :: MonadIO m => Text -> Int -> m ConnectionPool+createSqlitePool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) => Text -> Int -> m ConnectionPool createSqlitePool s = createSqlPool $ open' s -withSqlitePool :: (MonadBaseControl IO m, MonadIO m)+withSqlitePool :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Text -> Int -- ^ number of connections to open -> (ConnectionPool -> m a) -> m a withSqlitePool s = withSqlPool $ open' s -withSqliteConn :: (MonadBaseControl IO m, MonadIO m)+withSqliteConn :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Text -> (Connection -> m a) -> m a withSqliteConn = withSqlConn . open' -open' :: Text -> IO Connection-open' = Sqlite.open >=> wrapConnection+open' :: Text -> LogFunc -> IO Connection+open' connStr logFunc = Sqlite.open connStr >>= flip wrapConnection logFunc -- | Wrap up a raw 'Sqlite.Connection' as a Persistent SQL 'Connection'. -- -- Since 1.1.5-wrapConnection :: Sqlite.Connection -> IO Connection-wrapConnection conn = do+wrapConnection :: Sqlite.Connection -> LogFunc -> IO Connection+wrapConnection conn logFunc = do smap <- newIORef $ Map.empty return Connection { connPrepare = prepare' conn@@ -72,6 +73,7 @@ , connNoLimit = "LIMIT -1" , connRDBMS = "sqlite" , connLimitOffset = decorateSQLWithLimitOffset "LIMIT -1"+ , connLogFunc = logFunc } where helper t getter = do@@ -104,7 +106,7 @@ , stmtQuery = withStmt' conn stmt } -insertSql' :: EntityDef SqlType -> [PersistValue] -> InsertSqlResult+insertSql' :: EntityDef -> [PersistValue] -> InsertSqlResult insertSql' ent vals = case entityPrimary ent of Just _ ->@@ -143,15 +145,16 @@ Sqlite.changes conn withStmt'- :: MonadResource m+ :: MonadIO m => Sqlite.Connection -> Sqlite.Statement -> [PersistValue]- -> Source m [PersistValue]-withStmt' conn stmt vals = bracketP- (Sqlite.bind stmt vals >> return stmt)- (Sqlite.reset conn)- (const pull)+ -> Acquire (Source m [PersistValue])+withStmt' conn stmt vals = do+ _ <- mkAcquire+ (Sqlite.bind stmt vals >> return stmt)+ (Sqlite.reset conn)+ return pull where pull = do x <- liftIO $ Sqlite.step stmt@@ -170,22 +173,20 @@ showSqlType (SqlNumeric precision scale) = T.concat [ "NUMERIC(", T.pack (show precision), ",", T.pack (show scale), ")" ] showSqlType SqlDay = "DATE" showSqlType SqlTime = "TIME"-showSqlType SqlDayTimeZoned = "TIMESTAMP" showSqlType SqlDayTime = "TIMESTAMP" showSqlType SqlBlob = "BLOB" showSqlType SqlBool = "BOOLEAN" showSqlType (SqlOther t) = t -migrate' :: [EntityDef a]+migrate' :: [EntityDef] -> (Text -> IO Statement)- -> EntityDef SqlType+ -> EntityDef -> IO (Either [Text] [(Bool, Text)]) migrate' allDefs getter val = do let (cols, uniqs, _) = mkColumns allDefs val let newSql = mkCreateTable False def (filter (not . safeToRemove val . cName) cols, uniqs) stmt <- getter "SELECT sql FROM sqlite_master WHERE type='table' AND name=?"- oldSql' <- runResourceT- $ stmtQuery stmt [PersistText $ unDBName table] $$ go+ oldSql' <- with (stmtQuery stmt [PersistText $ unDBName table]) ($$ go) case oldSql' of Nothing -> return $ Right [(False, newSql)] Just oldSql -> do@@ -206,19 +207,19 @@ -- | Check if a column name is listed as the "safe to remove" in the entity -- list.-safeToRemove :: EntityDef a -> DBName -> Bool+safeToRemove :: EntityDef -> DBName -> Bool safeToRemove def (DBName colName) = any (elem "SafeToRemove" . fieldAttrs) $ filter ((== (DBName colName)) . fieldDB) $ entityFields def -getCopyTable :: [EntityDef a]+getCopyTable :: [EntityDef] -> (Text -> IO Statement)- -> EntityDef SqlType+ -> EntityDef -> IO [(Bool, Text)] getCopyTable allDefs getter val = do stmt <- getter $ T.concat [ "PRAGMA table_info(", escape table, ")" ]- oldCols' <- runResourceT $ stmtQuery stmt [] $$ getCols+ oldCols' <- with (stmtQuery stmt []) ($$ getCols) let oldCols = map DBName $ filter (/= "id") oldCols' -- need to update for table id attribute ? let newCols = filter (not . safeToRemove def) $ map cName cols let common = filter (`elem` oldCols) newCols@@ -268,7 +269,7 @@ , escape tableTmp ] -mkCreateTable :: Bool -> EntityDef a -> ([Column], [UniqueDef]) -> Text+mkCreateTable :: Bool -> EntityDef -> ([Column], [UniqueDef]) -> Text mkCreateTable isTemp entity (cols, uniqs) = case entityPrimary entity of Just _ ->@@ -339,7 +340,7 @@ instance PersistConfig SqliteConf where type PersistConfigBackend SqliteConf = SqlPersistT type PersistConfigPool SqliteConf = ConnectionPool- createPoolConfig (SqliteConf cs size) = createSqlitePool cs size+ createPoolConfig (SqliteConf cs size) = runNoLoggingT $ createSqlitePool cs size -- FIXME runPool _ = runSqlPool loadConfig (Object o) = SqliteConf <$> o .: "database"
Database/Sqlite.hs view
@@ -34,7 +34,7 @@ import qualified Data.ByteString.Internal as BSI import Foreign import Foreign.C-import Database.Persist (PersistValue (..), listToJSON, mapToJSON, ZT (ZT))+import Database.Persist (PersistValue (..), listToJSON, mapToJSON) import Data.Text (Text, pack, unpack) import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode)@@ -352,7 +352,6 @@ PersistDay d -> bindText statement parameterIndex $ pack $ show d PersistTimeOfDay d -> bindText statement parameterIndex $ pack $ show d PersistUTCTime d -> bindText statement parameterIndex $ pack $ show d- PersistZonedTime (ZT d) -> bindText statement parameterIndex $ pack $ show d PersistList l -> bindText statement parameterIndex $ listToJSON l PersistMap m -> bindText statement parameterIndex $ mapToJSON m PersistDbSpecific s -> bindText statement parameterIndex $ decodeUtf8With lenientDecode s
cbits/sqlite3.c view
file too large to diff
persistent-sqlite.cabal view
@@ -1,5 +1,5 @@ name: persistent-sqlite-version: 1.3.0.5+version: 2.0.0 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -24,14 +24,14 @@ build-depends: base >= 4 && < 5 , bytestring >= 0.9.1 , transformers >= 0.2.1- , persistent >= 1.3 && < 1.4+ , persistent >= 2.0 && < 2.1 , monad-control >= 0.2 , containers >= 0.2 , text >= 0.7 , aeson >= 0.5 , conduit >= 0.5.3 , monad-logger >= 0.2.4- , resourcet+ , resourcet >= 1.1 exposed-modules: Database.Sqlite Database.Persist.Sqlite ghc-options: -Wall