beam-sqlite 0.5.4.0 → 0.5.4.1

raw patch · 6 files changed

+89/−40 lines, 6 filesdep +direct-sqlitedep ~basedep ~beam-migratedep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: direct-sqlite

Dependency ranges changed: base, beam-migrate, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Database/Beam/Sqlite.hs +2/−0
• Database/Beam/Sqlite/Migrate.hs +62/−29
• Database/Beam/Sqlite/SqliteSpecific.hs +0/−3
• Database/Beam/Sqlite/Syntax.hs +11/−4
• beam-sqlite.cabal +8/−4

@@ -1,3 +1,9 @@+# 0.5.4.1++## Dependencies++* Ensure that beam-sqlite uses sqlite-3.24+, which is the minimum supported version (#589).+ # 0.5.4.0  ## Added features

@@ -8,6 +8,8 @@   , SqliteSelectSyntax, SqliteInsertSyntax   , SqliteUpdateSyntax, SqliteDeleteSyntax +  , SqliteDataTypeSyntax(..), mkSqliteDataType+   , fromSqliteCommand, sqliteRenderSyntaxScript    ,  module Database.Beam.Sqlite.SqliteSpecific

@@ -3,7 +3,7 @@  -- | Migrations support for SQLite databases module Database.Beam.Sqlite.Migrate-  ( migrationBackend, SqliteCommandSyntax+  ( migrationBackend, mkCustomMigrationBackend, SqliteCommandSyntax      -- * @beam-migrate@ utility functions   , migrateScript, writeMigrationScript@@ -30,7 +30,8 @@ import           Control.Monad import           Control.Monad.Reader -import           Database.SQLite.Simple (open, close, query_)+import           Database.SQLite.Simple (open, close, query_, execute_, connectionHandle)+import           Database.SQLite3 (exec)  import           Data.Aeson import           Data.Attoparsec.Text (asciiCI, skipSpace)@@ -49,21 +50,38 @@  -- | Top-level 'Tool.BeamMigrationBackend' migrationBackend :: Tool.BeamMigrationBackend Sqlite SqliteM-migrationBackend = Tool.BeamMigrationBackend-                       "sqlite"-                       "For beam-sqlite, this is the path to a sqlite3 file"-                       getDbConstraints-                       (Db.sql92Deserializers <> sqliteDataTypeDeserializers <>-                        Db.beamCheckDeserializers)-                       (BL.unpack . (<> ";") . sqliteRenderSyntaxScript . fromSqliteCommand)-                       "sqlite.sql"-                       sqlitePredConverter Db.defaultActionProvider-                       (\fp action ->-                            bracket (open fp) close $ \conn ->-                              catch (Right <$> runReaderT (runSqliteM action)-                                                          (\_ -> pure (), conn))-                                    (\e -> pure (Left (show (e :: SomeException)))))+migrationBackend = mkCustomMigrationBackend empty +mkCustomMigrationBackend :: A.Parser SqliteDataTypeSyntax -> Tool.BeamMigrationBackend Sqlite SqliteM+mkCustomMigrationBackend extraParser =+    Tool.BeamMigrationBackend+    { Tool.backendName = "sqlite"+    , Tool.backendConnStringExplanation = "For beam-sqlite, this is the path to a sqlite3 file"+    , Tool.backendGetDbConstraints = getDbConstraints extraParser+    , Tool.backendPredicateParsers = Db.sql92Deserializers <> sqliteDataTypeDeserializers <>+                                     Db.beamCheckDeserializers+    , Tool.backendRenderSyntax = (BL.unpack . (<> ";") . sqliteRenderSyntaxScript . fromSqliteCommand)+    , Tool.backendFileExtension = "sqlite.sql"+    , Tool.backendConvertToHaskell = sqlitePredConverter+    , Tool.backendActionProvider = Db.defaultActionProvider+    , Tool.backendRunSqlScript = runSqlScript+    , Tool.backendWithTransaction =+        \(SqliteM go) ->+          SqliteM . ReaderT $ \ctx@(pt, conn) ->+            mask $ \unmask -> do+              let ex q = pt (show q) >> execute_ conn q+              ex "BEGIN TRANSACTION"+              unmask (runReaderT go ctx <* ex "COMMIT TRANSACTION") `catch`+                \(SomeException e) -> ex "ROLLBACK TRANSACTION" >> throwIO e+      , Tool.backendConnect = \fp -> do+        conn <- open fp+        pure Tool.BeamMigrateConnection+             { Tool.backendRun = \action ->+                 catch (Right <$> runReaderT (runSqliteM action)+                                             (\_ -> pure (), conn))+                       (\e -> pure (Left (show (e :: SomeException))))+             , Tool.backendClose = close conn } }+ -- | 'Db.BeamDeserializers' or SQLite specific types. Specifically, -- 'sqliteBlob', 'sqliteText', and 'sqliteBigInt'. These are compatible with the -- "typical" serialized versions of the standard 'Db.binaryLargeObject',@@ -78,8 +96,13 @@     "bigint" -> pure sqliteBigIntType     Object o ->        (fmap (\(_ :: Maybe Word) -> sqliteBlobType) (o .: "binary")) <|>-       (fmap (\(_ :: Maybe Word) -> sqliteBlobType) (o .: "varbinary"))+       (fmap (\(_ :: Maybe Word) -> sqliteBlobType) (o .: "varbinary")) <|>+       Db.beamDeserializeJSON "sqlite" customDtParser v     _ -> fail "Could not parse sqlite-specific data type"+  where+    customDtParser = withObject "custom data type" $ \v -> do+                       txt <- v .: "custom"+                       pure (parseSqliteDataType empty txt)  -- | Render a series of 'Db.MigrationSteps' in the 'SqliteCommandSyntax' into a -- line-by-line list of lazy 'BL'ByteString's. The output is suitable for@@ -121,15 +144,19 @@                -> Maybe HsDataType sqliteTypeToHs = Just . sqliteDataTypeToHs -parseSqliteDataType :: T.Text -> SqliteDataTypeSyntax-parseSqliteDataType txt =+customSqliteDataType :: T.Text -> SqliteDataTypeSyntax+customSqliteDataType txt =+    SqliteDataTypeSyntax (emit (TE.encodeUtf8 txt) <> emit "/* unknown sqlite type */")+                         (hsErrorType ("Unknown SQLite datatype '" ++ T.unpack txt ++ "'"))+                         (Db.BeamSerializedDataType $+                            Db.beamSerializeJSON "sqlite"+                                  (object [ "custom" .= txt ]))+                         False++parseSqliteDataType :: A.Parser SqliteDataTypeSyntax -> T.Text -> SqliteDataTypeSyntax+parseSqliteDataType extraParser txt =   case A.parseOnly dtParser txt of-    Left {} -> SqliteDataTypeSyntax (emit (TE.encodeUtf8 txt))-                                    (hsErrorType ("Unknown SQLite datatype '" ++ T.unpack txt ++ "'"))-                                    (Db.BeamSerializedDataType $-                                     Db.beamSerializeJSON "sqlite"-                                       (toJSON txt))-                                    False+    Left {} -> customSqliteDataType txt     Right x -> x   where     dtParser = charP <|> varcharP <|>@@ -139,7 +166,7 @@                smallIntP <|> bigIntP <|> floatP <|>                doubleP <|> realP <|> dateP <|>                timestampP <|> timeP <|> textP <|>-               blobP <|> booleanP+               blobP <|> booleanP <|> extraParser      ws = A.many1 A.space @@ -226,6 +253,12 @@                          asciiCI "SET" *> ws *>                          A.takeWhile (not . isSpace)) +runSqlScript :: T.Text -> SqliteM ()+runSqlScript t =+    SqliteM . ReaderT $ \(_, conn) ->+        let hdl = connectionHandle conn+        in exec hdl t+ -- TODO constraints and foreign keys  -- | Get a list of database predicates for the current database. This is beam's@@ -236,8 +269,8 @@ -- correctly parse any type generated by beam and most SQL compliant types, but -- it may falter on databases created or managed by tools that do not follow -- these standards.-getDbConstraints :: SqliteM [Db.SomeDatabasePredicate]-getDbConstraints =+getDbConstraints :: A.Parser SqliteDataTypeSyntax -> SqliteM [Db.SomeDatabasePredicate]+getDbConstraints extraParser =   SqliteM . ReaderT $ \(_, conn) -> do     tblNames <- query_ conn "SELECT name, sql from sqlite_master where type='table'"     tblPreds <-@@ -249,7 +282,7 @@         let columnPreds =               foldMap                 (\(_ ::Int, nm, typStr, notNull, _, _) ->-                     let dtType = if isAutoincrement then sqliteSerialType else parseSqliteDataType typStr+                     let dtType = if isAutoincrement then sqliteSerialType else parseSqliteDataType extraParser typStr                          isAutoincrement = isJust (A.maybeResult (A.parse autoincrementParser sql))                           autoincrementParser = do

@@ -13,9 +13,6 @@ import           Database.Beam.Query.Internal import           Database.Beam.Sqlite.Connection import           Database.Beam.Sqlite.Syntax-#if !MIN_VERSION_base(4, 11, 0)-import           Data.Semigroup-#endif  -- | The SQLite @group_concat@ function. -- Joins the value in each row of the first argument, using the second

@@ -33,6 +33,7 @@   , SqliteDataTypeSyntax(..)   , sqliteTextType, sqliteBlobType   , sqliteBigIntType, sqliteSerialType+  , mkSqliteDataType      -- * Building and consuming 'SqliteSyntax'   , fromSqliteCommand, formatSqliteInsert, formatSqliteInsertOnConflict@@ -51,8 +52,10 @@ import           Database.Beam.Migrate.SQL.Builder hiding (fromSqlConstraintAttributes) import           Database.Beam.Migrate.SQL.SQL92 import           Database.Beam.Migrate.Serialization+import qualified Database.Beam.Migrate.Serialization as Db import           Database.Beam.Query hiding (ExtractField(..)) +import           Data.Aeson (object, (.=)) import           Data.ByteString (ByteString) import qualified Data.ByteString as B import           Data.ByteString.Builder@@ -70,9 +73,7 @@ import           Data.Time import qualified Data.Time.Format.ISO8601 as Time import           Data.Word-#if !MIN_VERSION_base(4, 11, 0)-import           Data.Semigroup-#endif+ import           GHC.TypeLits  import           Database.SQLite.Simple (SQLData(..))@@ -560,6 +561,12 @@ instance IsSql2008BigIntDataTypeSyntax SqliteDataTypeSyntax where   bigIntType = sqliteBigIntType +mkSqliteDataType :: String -> SqliteDataTypeSyntax+mkSqliteDataType s = SqliteDataTypeSyntax (emit (fromString s)) (hsErrorType s)+                       (Db.BeamSerializedDataType $+                          Db.beamSerializeJSON "sqlite" (object [ "custom" .= s ]))+                       False+ sqliteTextType, sqliteBlobType, sqliteBigIntType :: SqliteDataTypeSyntax sqliteTextType = SqliteDataTypeSyntax (emit "TEXT")                                       (HsDataType (hsVarFrom "sqliteText" "Database.Beam.Sqlite")@@ -710,7 +717,7 @@ instance HasSqlValueSyntax SqliteValueSyntax Int32 where   sqlValueSyntax i = SqliteValueSyntax (emitValue (SQLInteger (fromIntegral i))) instance HasSqlValueSyntax SqliteValueSyntax Int64 where-  sqlValueSyntax i = SqliteValueSyntax (emitValue (SQLInteger (fromIntegral i)))+  sqlValueSyntax i = SqliteValueSyntax (emitValue (SQLInteger i)) instance HasSqlValueSyntax SqliteValueSyntax Word8 where   sqlValueSyntax i = SqliteValueSyntax (emitValue (SQLInteger (fromIntegral i))) instance HasSqlValueSyntax SqliteValueSyntax Word16 where

@@ -1,5 +1,5 @@ name:                beam-sqlite-version:             0.5.4.0+version:             0.5.4.1 synopsis:            Beam driver for SQLite description:         Beam driver for the <https://sqlite.org/ SQLite> embedded database.                      See <https://haskell-beam.github.io/beam/user-guide/backends/beam-sqlite/ here>@@ -23,7 +23,7 @@                       Database.Beam.Sqlite.Connection                       Database.Beam.Sqlite.Migrate   other-modules:      Database.Beam.Sqlite.SqliteSpecific-  build-depends:      base          >=4.7  && <5,+  build-depends:      base          >=4.11 && <5,                        beam-core     >=0.10 && <0.11,                       beam-migrate  >=0.5  && <0.6,@@ -41,14 +41,18 @@                       network-uri   >=2.6  && <2.7,                       aeson         >=0.11 && <2.3,                       attoparsec    >=0.13 && <0.15,-                      transformers-base    >=0.4  && <0.5+                      transformers-base    >=0.4  && <0.5,+                      direct-sqlite >=2.3.24   default-language:   Haskell2010   default-extensions: ScopedTypeVariables, OverloadedStrings, MultiParamTypeClasses, RankNTypes, FlexibleInstances,                       DeriveDataTypeable, DeriveGeneric, StandaloneDeriving, TypeFamilies, GADTs, OverloadedStrings,                       CPP, TypeApplications, FlexibleContexts, ConstraintKinds, DerivingStrategies   ghc-options:        -Wall+                      -Widentities+                      -Wincomplete-uni-patterns+                      -Wincomplete-record-updates   if flag(werror)-    ghc-options:       -Werror+    ghc-options: -Werror  test-suite beam-sqlite-tests   type: exitcode-stdio-1.0