mysql-json-table 0.1.1.0 → 0.1.2.0

raw patch · 3 files changed

+32/−13 lines, 3 filesdep +exceptions

Dependencies added: exceptions

Files

changelog.md +6/−0
mysql-json-table.cabal +2/−1
src/Database/MySQL/JSONTable.hs +24/−12

changelog.md view

@@ -1,3 +1,9 @@+## 0.1.2.0+* Re-export: `ConnectInfo`, `defaultConnectInfo`, `Connection`.+* New function: `withSQL`.+* Fix id table creation.+* Fixes for id table queries.+ ## 0.1.1.0 * Add new function: `moveId`.

mysql-json-table.cabal view

@@ -1,5 +1,5 @@ name: mysql-json-table-version: 0.1.1.0+version: 0.1.2.0 category: Database synopsis: Using MySQL to store id-to-json tables. description: Visit the homepage for more information, or read the readme.@@ -27,6 +27,7 @@     , aeson     , bytestring     , conduit+    , exceptions   exposed-modules: Database.MySQL.JSONTable  executable mysql-json-table-test

src/Database/MySQL/JSONTable.hs view

@@ -15,6 +15,11 @@     Id   , Row (..)   , JSONTable (..)+    -- * Connections+  , SQL.ConnectInfo (..)+  , SQL.defaultConnectInfo+  , SQL.Connection+  , withSQL     -- ** Table operations   , createTable   , deleteTable@@ -54,7 +59,8 @@ import Data.Proxy import Control.Applicative (liftA2) import Control.Monad (forM_, when, unless)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Catch (MonadMask, bracket) #if MIN_VERSION_bytestring(0,11,0) import Data.ByteString qualified as ByteString #else@@ -70,6 +76,11 @@ import Conduit (ResourceT) import Data.Conduit qualified as Conduit +-- | Open a connection to a MySQL server and apply a function to it.+--   The connection is closed both when the function completes or throws an exception.+withSQL :: (MonadMask m, MonadIO m) => SQL.ConnectInfo -> (SQL.Connection -> m a) -> m a+withSQL sql = bracket (liftIO $ SQL.connect sql) (liftIO . SQL.close)+ -- | Row identifier used for table lookups. --   The type parameter indicates the type of data --   stored in the table.@@ -286,12 +297,13 @@ typeToSpec SQLBase.LongLong = "BIGINT" typeToSpec SQLBase.NewDate = "DATE" typeToSpec SQLBase.NewDecimal = "DECIMAL"+typeToSpec SQLBase.VarChar = "VARCHAR(255)" typeToSpec t = fmap toUpper $ show t  idTableSpecs :: forall proxy key . SQL.FromField key => proxy key -> String idTableSpecs _ = concat   [ "("-  , "key " ++ typeToSpec (head $ fst (SQL.fromField @key)) ++ " NOT NULL PRIMARY KEY"+  , "`key` " ++ typeToSpec (head $ fst (SQL.fromField @key)) ++ " NOT NULL PRIMARY KEY"   , ", "   , "id BIGINT UNSIGNED NOT NULL"   , ")"@@ -337,7 +349,7 @@   -> Id a   -> IO () insertId conn itable k i = do-  let query = "INSERT INTO `" ++ idTableName itable ++ "` (key,id) VALUES (?,?)"+  let query = "INSERT INTO `" ++ idTableName itable ++ "` (`key`,id) VALUES (?,?)"   _ <- SQL.execute conn (fromString query) (Key k, i)   pure () @@ -349,7 +361,7 @@   -> key   -> IO (Maybe (Id a)) lookupId conn itable k = do-  let query = "SELECT id FROM `" ++ idTableName itable ++ "` WHERE key=?"+  let query = "SELECT id FROM `" ++ idTableName itable ++ "` WHERE `key`=?"   fmap SQL.fromOnly . listToMaybe <$> SQL.query conn (fromString query) (SQL.Only $ Key k)  -- | Update an 'Id' by applying the supplied function. If the key is not found,@@ -362,11 +374,11 @@   -> key   -> IO () adjustId conn itable f k = SQL.withTransaction conn $ do-  let query1 = "SELECT id FROM `" ++ idTableName itable ++ "` WHERE key=? FOR SHARE"+  let query1 = "SELECT id FROM `" ++ idTableName itable ++ "` WHERE `key`=? FOR SHARE"   mr <- listToMaybe <$> SQL.query conn (fromString query1) (SQL.Only $ Key k)   forM_ mr $ \(SQL.Only i) -> do     j <- f i-    let query2 = "UPDATE `" ++ idTableName itable ++ "` SET id=? WHERE key=?"+    let query2 = "UPDATE `" ++ idTableName itable ++ "` SET id=? WHERE `key`=?"     _ <- SQL.execute conn (fromString query2) (j,Key k)     pure () @@ -380,7 +392,7 @@   -> key   -> IO () alterId conn itable f k = SQL.withTransaction conn $ do-  let query1 = "SELECT id FROM `" ++ idTableName itable ++ "` WHERE key=? FOR SHARE"+  let query1 = "SELECT id FROM `" ++ idTableName itable ++ "` WHERE `key`=? FOR SHARE"   mi <- fmap SQL.fromOnly . listToMaybe <$> SQL.query conn (fromString query1) (SQL.Only $ Key k)   case mi of     Nothing -> do@@ -388,18 +400,18 @@       case mj of         Nothing -> pure ()         Just j -> do-          let query2 = "INSERT INTO `" ++ idTableName itable ++ "` (key,id) VALUES (?,?)"+          let query2 = "INSERT INTO `" ++ idTableName itable ++ "` (`key`,id) VALUES (?,?)"           _ <- SQL.execute conn (fromString query2) (Key k,j)           pure ()     _ -> do       mj <- f mi       case mj of         Nothing -> do-          let query2 = "DELETE FROM `" ++ idTableName itable ++ "` WHERE key=?"+          let query2 = "DELETE FROM `" ++ idTableName itable ++ "` WHERE `key`=?"           _ <- SQL.execute conn (fromString query2) $ SQL.Only $ Key k           pure ()         Just j -> do-          let query2 = "UPDATE `" ++ idTableName itable ++ "` SET id=? WHERE key=?"+          let query2 = "UPDATE `" ++ idTableName itable ++ "` SET id=? WHERE `key`=?"           _ <- SQL.execute conn (fromString query2) (j,Key k)           pure () @@ -411,7 +423,7 @@   -> key   -> IO () deleteId conn itable k = do-  let query = "DELETE FROM `" ++ idTableName itable ++ "` WHERE id=?"+  let query = "DELETE FROM `" ++ idTableName itable ++ "` WHERE `key`=?"   _ <- SQL.execute conn (fromString query) $ SQL.Only $ Key k   pure () @@ -425,7 +437,7 @@   -> Id a   -> IO () replaceId conn itable k i = do-  let query = "UPDATE `" ++ idTableName itable ++ "` SET id=? WHERE key=?"+  let query = "UPDATE `" ++ idTableName itable ++ "` SET id=? WHERE `key`=?"   _ <- SQL.execute conn (fromString query) (i,Key k)   pure ()