persistent-typed-db 0.0.1.0 → 0.0.1.1
raw patch · 3 files changed
+54/−23 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- persistent-typed-db.cabal +9/−9
- src/Database/Persist/Typed.hs +40/−14
CHANGELOG.md view
@@ -2,6 +2,11 @@ # Upcoming +# v0.0.1.1++- Fix build on earlier versions of GHC.+- Use the bulk insertMany functions where possible.+ # v0.0.1.0 - Initial Release
persistent-typed-db.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9ca3677808b2b77f7610f921cfb79cefbfe8d610360376b7b23b481af479b127+-- hash: 3ae9dc27e1c8f46a8a8113bb14311522ef631291dc5ae951b1f8082a83789c00 name: persistent-typed-db-version: 0.0.1.0+version: 0.0.1.1 synopsis: Type safe access to multiple database schemata. description: See README.md for more details, examples, and fun. category: Web@@ -28,6 +28,10 @@ location: https://github.com/parsonsmatt/persistent-typed-db library+ exposed-modules:+ Database.Persist.Typed+ other-modules:+ Paths_persistent_typed_db hs-source-dirs: src ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wcompat -Wincomplete-uni-patterns@@ -46,15 +50,14 @@ , template-haskell , text , transformers- exposed-modules:- Database.Persist.Typed- other-modules:- Paths_persistent_typed_db default-language: Haskell2010 test-suite specs type: exitcode-stdio-1.0 main-is: Spec.hs+ other-modules:+ EsqueletoSpec+ Paths_persistent_typed_db hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N@@ -76,7 +79,4 @@ , template-haskell , text , transformers- other-modules:- EsqueletoSpec- Paths_persistent_typed_db default-language: Haskell2010
src/Database/Persist/Typed.hs view
@@ -47,12 +47,14 @@ import Data.Int (Int64) import Data.List (find, inits, transpose) import Data.Maybe (isJust)-import Data.Monoid (mappend)+import Data.Monoid (mappend, (<>)) import Data.Pool (Pool) import Data.Text (Text) import qualified Data.Text as Text+import qualified Data.Text as T import Database.Persist.Sql hiding (deleteWhereCount, updateWhereCount)+import qualified Data.Foldable as Foldable import Database.Persist.Sql.Types.Internal (IsPersistBackend (..)) import Database.Persist.Sql.Util (dbColumns, dbIdColumns, entityColumnNames,@@ -352,6 +354,13 @@ ent = entityDef vals valss = map (map toPersistValue . toPersistFields) vals + insertEntityMany es' = specializeQuery $ do+ conn <- ask+ let entDef = entityDef $ map entityVal es'+ let columnNames = keyAndEntityColumnNames entDef conn+ runChunked (length columnNames) go es'+ where+ go = insrepHelper "INSERT" insertMany_ [] = return ()@@ -378,9 +387,6 @@ rawExecute sql (concat valss) t = entityDef vals0- -- Implement this here to avoid depending on the split package- chunksOf _ [] = []- chunksOf size xs = let (chunk, rest) = splitAt size xs in chunk : chunksOf size rest replace k val = do conn <- asks unSqlFor@@ -399,7 +405,7 @@ where go conn x = connEscapeName conn x `Text.append` "=?" - insertKey k = specializeQuery . insrepHelper "INSERT" k+ insertKey k v = specializeQuery $ insrepHelper "INSERT" [Entity k v] repsert key value = do mExisting <- get key@@ -676,26 +682,26 @@ insrepHelper :: (MonadIO m, PersistEntity val) => Text- -> Key val- -> val+ -> [Entity val] -> ReaderT SqlBackend m ()-insrepHelper command k record = do+insrepHelper _ [] = return ()+insrepHelper command es = do conn <- ask let columnNames = keyAndEntityColumnNames entDef conn rawExecute (sql conn columnNames) vals where- entDef = entityDef $ Just record- sql conn columnNames = Text.concat+ entDef = entityDef $ map entityVal es+ sql conn columnNames = T.concat [ command , " INTO " , connEscapeName conn (entityDB entDef) , "("- , Text.intercalate "," columnNames- , ") VALUES("- , Text.intercalate "," (map (const "?") columnNames)+ , T.intercalate "," columnNames+ , ") VALUES ("+ , T.intercalate "),(" $ replicate (length es) $ T.intercalate "," $ map (const "?") columnNames , ")" ]- vals = entityValues (Entity k record)+ vals = Foldable.foldMap entityValues es updateFieldDef :: PersistEntity v => Update v -> FieldDef updateFieldDef (Update f _ _) =@@ -925,3 +931,23 @@ escapeQuote "" = "" escapeQuote ('"':xs) = "\"\"" ++ escapeQuote xs escapeQuote (x:xs) = x : escapeQuote xs++runChunked+ :: (Monad m)+ => Int+ -> ([a] -> ReaderT SqlBackend m ())+ -> [a]+ -> ReaderT SqlBackend m ()+runChunked _ _ [] = return ()+runChunked width m xs = do+ conn <- ask+ case connMaxParams conn of+ Nothing -> m xs+ Just maxParams -> let chunkSize = maxParams `div` width in+ mapM_ m (chunksOf chunkSize xs)++-- Implement this here to avoid depending on the split package+chunksOf :: Int -> [a] -> [[a]]+chunksOf _ [] = []+chunksOf size xs = let (chunk, rest) = splitAt size xs in chunk : chunksOf size rest+