selda-sqlite 0.1.6.0 → 0.1.6.1
raw patch · 3 files changed
+86/−24 lines, 3 filesdep ~selda
Dependency ranges changed: selda
Files
- LICENSE +18/−17
- selda-sqlite.cabal +5/−5
- src/Database/Selda/SQLite.hs +63/−2
LICENSE view
@@ -1,20 +1,21 @@-Copyright (c) 2017 Anton Ekblad+MIT License -Permission is hereby granted, free of charge, to any person obtaining-a copy of this software and associated documentation files (the-"Software"), to deal in the Software without restriction, including-without limitation the rights to use, copy, modify, merge, publish,-distribute, sublicense, and/or sell copies of the Software, and to-permit persons to whom the Software is furnished to do so, subject to-the following conditions:+Copyright (c) 2017-2018 Anton Ekblad -The above copyright notice and this permission notice shall be included-in all copies or substantial portions of the Software.+Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions: -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.-IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY-CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,-TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE-SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
selda-sqlite.cabal view
@@ -1,5 +1,5 @@ name: selda-sqlite-version: 0.1.6.0+version: 0.1.6.1 synopsis: SQLite backend for the Selda database EDSL. description: SQLite backend for the Selda database EDSL. homepage: https://github.com/valderman/selda@@ -22,10 +22,10 @@ GADTs CPP build-depends:- base >=4.8 && <5- , exceptions >=0.8 && <0.9- , selda >=0.1.10.0 && <0.2- , text >=1.0 && <1.3+ base >=4.8 && <5+ , exceptions >=0.8 && <0.11+ , selda >=0.3.0.0 && <0.4+ , text >=1.0 && <1.3 if !flag(haste) build-depends: direct-sqlite >=2.2 && <2.4
src/Database/Selda/SQLite.hs view
@@ -4,7 +4,8 @@ import Database.Selda import Database.Selda.Backend import Data.Dynamic-import Data.Text (pack)+import Data.Text as Text (pack, toLower, take, isSuffixOf)+import Control.Monad (void, when, unless) import Control.Monad.Catch #ifndef __HASTE__ import Database.SQLite3@@ -27,7 +28,7 @@ Right db -> flip onException (liftIO (close db)) . restore $ do absFile <- liftIO $ pack <$> makeAbsolute file let backend = sqliteBackend db- liftIO $ runStmt backend "PRAGMA foreign_keys = ON;" []+ void . liftIO $ runStmt backend "PRAGMA foreign_keys = ON;" [] newConnection backend absFile #endif @@ -45,6 +46,7 @@ , runStmtWithPK = \q ps -> fst <$> sqliteQueryRunner db q ps , prepareStmt = \_ _ -> sqlitePrepare db , runPrepared = sqliteRunPrepared db+ , getTableInfo = sqliteGetTableInfo db . fromTableName , ppConfig = defPPConfig {ppMaxInsertParams = Just 999} , backendId = SQLite , closeConnection = \conn -> do@@ -52,7 +54,66 @@ flip mapM_ stmts $ \(_, stm) -> do finalize $ fromDyn stm (error "BUG: non-statement SQLite statement") close db+ , disableForeignKeys = disableFKs db }++sqliteGetTableInfo :: Database -> Text -> IO [ColumnInfo]+sqliteGetTableInfo db tbl = do+ cols <- (snd . snd) <$> sqliteQueryRunner db tblinfo []+ indexes <- (snd . snd) <$> sqliteQueryRunner db indexes []+ fks <- (snd . snd) <$> sqliteQueryRunner db fklist []+ indexes' <- mapM indexInfo indexes+ mapM (describe fks indexes') cols+ where+ tblinfo = mconcat ["PRAGMA table_info(", tbl, ");"]+ indexes = mconcat ["PRAGMA index_list(", tbl, ");"]+ fklist = mconcat ["PRAGMA foreign_key_list(", tbl, ");"]+ ixinfo name = mconcat ["PRAGMA index_info(", name, ");"]++ toTypeRep _ "text" = Right TText+ toTypeRep _ "double" = Right TFloat+ toTypeRep _ "boolean" = Right TBool+ toTypeRep _ "datetime" = Right TDateTime+ toTypeRep _ "date" = Right TDate+ toTypeRep _ "time" = Right TTime+ toTypeRep _ "blob" = Right TBlob+ toTypeRep True "integer" = Right TRowID+ toTypeRep pk s | Text.take 3 s == "int" = Right $ if pk then TRowID else TInt+ toTypeRep _ typ = Left typ++ indexInfo [_, SqlString ixname, _, SqlString itype, _] = do+ let q = (ixinfo ixname)+ [[_, _, SqlString name]] <- (snd . snd) <$> sqliteQueryRunner db q []+ return (name, itype)+ indexInfo _ = do+ error "unreachable"++ describe fks ixs [_, SqlString name, SqlString ty, SqlInt nonnull, _, SqlInt pk] = do+ return $ ColumnInfo+ { colName = mkColName name+ , colType = toTypeRep (pk == 1) (toLower ty)+ , colIsPK = pk == 1+ , colIsAutoIncrement = "auto_increment" `isSuffixOf` ty+ , colIsUnique = any (== (name, "u")) ixs || pk == 1+ , colHasIndex = any (== (name, "c")) ixs+ , colIsNullable = nonnull == 0+ , colFKs =+ [ (mkTableName reftbl, mkColName refkey)+ | (_:_:SqlString reftbl:SqlString key:SqlString refkey:_) <- fks+ , key == name+ ]+ }+ describe _ _ result = do+ throwM $ SqlError $ "bad result from PRAGMA table_info: " ++ show result++disableFKs :: Database -> Bool -> IO ()+disableFKs db disable = do+ unless disable $ void $ sqliteQueryRunner db "COMMIT;" []+ void $ sqliteQueryRunner db q []+ when disable $ void $ sqliteQueryRunner db "BEGIN TRANSACTION;" []+ where+ q | disable = "PRAGMA foreign_keys = OFF;"+ | otherwise = "PRAGMA foreign_keys = ON;" sqlitePrepare :: Database -> Text -> IO Dynamic sqlitePrepare db qry = do