persistent-sqlite 1.3.0.1 → 1.3.0.2
raw patch · 2 files changed
+35/−38 lines, 2 files
Files
- Database/Persist/Sqlite.hs +34/−37
- persistent-sqlite.cabal +1/−1
Database/Persist/Sqlite.hs view
@@ -20,12 +20,11 @@ import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Logger (NoLoggingT, runNoLoggingT)-import Data.List (intercalate) import Data.IORef import qualified Data.Map as Map import Control.Monad.Trans.Control (control) import qualified Control.Exception as E-import Data.Text (Text, pack)+import Data.Text (Text) import Control.Monad (mzero) import Data.Aeson import qualified Data.Text as T@@ -34,6 +33,7 @@ import Control.Applicative import Data.Int (Int64) import Control.Monad ((>=>))+import Data.Monoid ((<>)) createSqlitePool :: MonadIO m => Text -> Int -> m ConnectionPool createSqlitePool s = createSqlPool $ open' s@@ -105,28 +105,28 @@ insertSql' :: EntityDef SqlType -> [PersistValue] -> InsertSqlResult insertSql' ent vals = case entityPrimary ent of- Just _ -> + Just _ -> ISRManyKeys sql vals- where sql = pack $ concat+ where sql = T.concat [ "INSERT INTO "- , escape' $ entityDB ent+ , escape $ entityDB ent , "("- , intercalate "," $ map (escape' . fieldDB) $ entityFields ent+ , T.intercalate "," $ map (escape . fieldDB) $ entityFields ent , ") VALUES("- , intercalate "," (map (const "?") $ entityFields ent)+ , T.intercalate "," (map (const "?") $ entityFields ent) , ")" ]- Nothing -> - ISRInsertGet (pack ins) sel+ Nothing ->+ ISRInsertGet ins sel where sel = "SELECT last_insert_rowid()"- ins = concat+ ins = T.concat [ "INSERT INTO "- , escape' $ entityDB ent+ , escape $ entityDB ent , "("- , intercalate "," $ map (escape' . fieldDB) $ entityFields ent+ , T.intercalate "," $ map (escape . fieldDB) $ entityFields ent , ") VALUES("- , intercalate "," (map (const "?") $ entityFields ent)+ , T.intercalate "," (map (const "?") $ entityFields ent) , ")" ] @@ -161,7 +161,7 @@ showSqlType SqlInt32 = "INTEGER" showSqlType SqlInt64 = "INTEGER" showSqlType SqlReal = "REAL"-showSqlType (SqlNumeric precision scale) = pack $ "NUMERIC(" ++ show precision ++ "," ++ show scale ++ ")"+showSqlType (SqlNumeric precision scale) = T.concat [ "NUMERIC(", T.pack (show precision), ",", T.pack (show scale), ")" ] showSqlType SqlDay = "DATE" showSqlType SqlTime = "TIME" showSqlType SqlDayTimeZoned = "TIMESTAMP"@@ -211,7 +211,7 @@ -> EntityDef SqlType -> IO [(Bool, Text)] getCopyTable allDefs getter val = do- stmt <- getter $ pack $ "PRAGMA table_info(" ++ escape' table ++ ")"+ stmt <- getter $ T.concat [ "PRAGMA table_info(", escape table, ")" ] oldCols' <- runResourceT $ 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@@ -219,10 +219,10 @@ let id_ = entityID val return [ (False, tmpSql) , (False, copyToTemp $ id_ : common)- , (common /= filter (not . safeToRemove def) oldCols, pack dropOld)+ , (common /= filter (not . safeToRemove def) oldCols, dropOld) , (False, newSql) , (False, copyToFinal $ id_ : newCols)- , (False, pack dropTmp)+ , (False, dropTmp) ] where @@ -236,39 +236,36 @@ return $ name : names Just y -> error $ "Invalid result from PRAGMA table_info: " ++ show y table = entityDB def- tableTmp = DBName $ unDBName table `T.append` "_backup"+ tableTmp = DBName $ unDBName table <> "_backup" (cols, uniqs, _) = mkColumns allDefs val cols' = filter (not . safeToRemove def . cName) cols newSql = mkCreateTable False def (cols', uniqs) tmpSql = mkCreateTable True def { entityDB = tableTmp } (cols', uniqs)- dropTmp = "DROP TABLE " ++ escape' tableTmp- dropOld = "DROP TABLE " ++ escape' table- copyToTemp common = pack $ concat+ dropTmp = "DROP TABLE " <> escape tableTmp+ dropOld = "DROP TABLE " <> escape table+ copyToTemp common = T.concat [ "INSERT INTO "- , escape' tableTmp+ , escape tableTmp , "("- , intercalate "," $ map escape' common+ , T.intercalate "," $ map escape common , ") SELECT "- , intercalate "," $ map escape' common+ , T.intercalate "," $ map escape common , " FROM "- , escape' table+ , escape table ]- copyToFinal newCols = pack $ concat+ copyToFinal newCols = T.concat [ "INSERT INTO "- , T.unpack $ escape table+ , escape table , " SELECT "- , intercalate "," $ map escape' newCols+ , T.intercalate "," $ map escape newCols , " FROM "- , escape' tableTmp+ , escape tableTmp ] -escape' :: DBName -> String-escape' = T.unpack . escape- mkCreateTable :: Bool -> EntityDef a -> ([Column], [UniqueDef]) -> Text-mkCreateTable isTemp entity (cols, uniqs) = - case entityPrimary entity of - Just _ -> +mkCreateTable isTemp entity (cols, uniqs) =+ case entityPrimary entity of+ Just _ -> T.concat [ "CREATE" , if isTemp then " TEMP" else ""@@ -304,10 +301,10 @@ , if isNull then " NULL" else " NOT NULL" , case def of Nothing -> ""- Just d -> " DEFAULT " `T.append` d+ Just d -> " DEFAULT " <> d , case ref of Nothing -> ""- Just (table, _) -> " REFERENCES " `T.append` escape table+ Just (table, _) -> " REFERENCES " <> escape table ] sqlUnique :: UniqueDef -> Text
persistent-sqlite.cabal view
@@ -1,5 +1,5 @@ name: persistent-sqlite-version: 1.3.0.1+version: 1.3.0.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>