selda 0.1.3.2 → 0.1.3.3

raw patch · 7 files changed

+80/−21 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• README.md +3/−2
• selda.cabal +1/−1
• src/Database/Selda/Backend.hs +52/−4
• src/Database/Selda/Caching.hs +5/−5
• src/Database/Selda/Frontend.hs +11/−8
• src/Database/Selda/Table.hs +0/−1

@@ -1,13 +1,20 @@ # Revision history for selda +## 0.1.3.3 -- 2017-05-04++* Fix cache invalidation race when using transactions.++ ## 0.1.3.2 -- 2017-05-01  * Only throw well-documented, Selda-specific exceptions. + ## 0.1.3.1 -- 2017-05-01  * More hackage-friendly README. + ## 0.1.3.0 -- 2017-04-30  * Add selectors for non-generic tables.@@ -15,6 +22,7 @@ * More sensible API for LIMIT. * Fix broken SQL being generated for pathological corner cases. * Documentation fixes.+  ## 0.1.2.0 -- 2017-04-20 

@@ -1,9 +1,10 @@ Selda =====-[![Build Status](https://travis-ci.org/valderman/selda.svg?branch=master)](https://travis-ci.org/valderman/selda)+[![Hackage](https://img.shields.io/hackage/v/selda.svg?style=flat)](http://hackage.haskell.org/package/selda) [![IRC channel](https://img.shields.io/badge/IRC-%23selda-1e72ff.svg?style=flat)](https://www.irccloud.com/invite?channel=%23selda&hostname=irc.freenode.net&port=6697&ssl=1)-![Hackage Dependencies](https://img.shields.io/hackage-deps/v/selda.svg) ![MIT License](http://img.shields.io/badge/license-MIT-brightgreen.svg)+[![Build Status](https://travis-ci.org/valderman/selda.svg?branch=master)](https://travis-ci.org/valderman/selda)+![Hackage Dependencies](https://img.shields.io/hackage-deps/v/selda.svg)   What is Selda?

@@ -1,5 +1,5 @@ name:                selda-version:             0.1.3.2+version:             0.1.3.3 synopsis:            Type-safe, high-level EDSL for interacting with relational databases. description:         This package provides an EDSL for writing portable, type-safe, high-level                      database code. Its feature set includes querying and modifying databases,

@@ -9,10 +9,13 @@   , sqlDateTimeFormat, sqlDateFormat, sqlTimeFormat   , runSeldaT   ) where+import Database.Selda.Caching (invalidate) import Database.Selda.SQL (Param (..)) import Database.Selda.SqlType-import Database.Selda.Table (ColAttr (..))+import Database.Selda.Table (Table, ColAttr (..), tableName) import Database.Selda.Table.Compile (compileColAttr)+import Database.Selda.Types (TableName)+import Control.Exception (throwIO) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.State@@ -50,24 +53,69 @@   , defaultKeyword :: Text } +data SeldaState = SeldaState+  { -- | Backend in use by the current computation.+    stBackend :: !SeldaBackend++    -- | Tables modified by the current transaction.+    --   Invariant: always @Just xs@ during a transaction, and always+    --   @Nothing@ when not in a transaction.+  , stTouchedTables :: !(Maybe [TableName])+  }+ -- | Some monad with Selda SQL capabilitites. class MonadIO m => MonadSelda m where   -- | Get the backend in use by the computation.   seldaBackend :: m SeldaBackend +  -- | Invalidate the given table as soon as the current transaction finishes.+  --   Invalidate the table immediately if no transaction is ongoing.+  invalidateTable :: Table a -> m ()++  -- | Indicates the start of a new transaction.+  --   Starts bookkeeping to invalidate all tables modified during+  --   the transaction at the next call to 'endTransaction'.+  beginTransaction :: m ()++  -- | Indicates the end of the current transaction.+  --   Invalidates all tables that were modified since the last call to+  --   'beginTransaction', unless the transaction was rolled back.+  endTransaction :: Bool -- ^ @True@ if the transaction was committed,+                         --   @False@ if it was rolled back.+                 -> m ()+ -- | Monad transformer adding Selda SQL capabilities.-newtype SeldaT m a = S {unS :: StateT SeldaBackend m a}+newtype SeldaT m a = S {unS :: StateT SeldaState m a}   deriving ( Functor, Applicative, Monad, MonadIO            , MonadThrow, MonadCatch, MonadMask, MonadTrans            )  instance MonadIO m => MonadSelda (SeldaT m) where-  seldaBackend = S get+  seldaBackend = S $ fmap stBackend get +  invalidateTable tbl = S $ do+    st <- get+    case stTouchedTables st of+      Nothing -> liftIO $ invalidate [tableName tbl]+      Just ts -> put $ st {stTouchedTables = Just (tableName tbl : ts)}++  beginTransaction = S $ do+    st <- get+    case stTouchedTables st of+      Nothing -> put $ st {stTouchedTables = Just []}+      Just _  -> liftIO $ throwIO $ SqlError "attempted to nest transactions"++  endTransaction committed = S $ do+    st <- get+    case stTouchedTables st of+      Just ts | committed -> liftIO $ invalidate ts+      _                   -> return ()+    put $ st {stTouchedTables = Nothing}+ -- | The simplest form of Selda computation; 'SeldaT' specialized to 'IO'. type SeldaM = SeldaT IO  -- | Run a Selda transformer. Backends should use this to implement their --   @withX@ functions. runSeldaT :: MonadIO m => SeldaT m a -> SeldaBackend -> m a-runSeldaT m b = fst <$> runStateT (unS m) b+runSeldaT m b = fst <$> runStateT (unS m) (SeldaState b Nothing)

@@ -2,7 +2,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Selda.Caching    ( CacheKey-    , cache, cached, invalidate, setMaxItems+   , cache, cached, invalidate, setMaxItems    ) where import Prelude hiding (lookup) import Data.Dynamic@@ -27,10 +27,10 @@ cache :: Typeable a => [TableName] -> CacheKey -> a -> IO () cache _ _ _ = return () -cached :: forall a. Typeable a => CacheKey -> IO (Maybe a)+cached :: Typeable a => CacheKey -> IO (Maybe a) cached _ = return Nothing -invalidate :: TableName -> IO ()+invalidate :: [TableName] -> IO () invalidate _ = return ()  setMaxItems :: Int -> IO ()@@ -120,8 +120,8 @@     updatePrio _             = (Nothing, Nothing)  -- | Invalidate all items in cache that depend on the given table.-invalidate :: TableName -> IO ()-invalidate tn = atomicModifyIORef' theCache $ \c -> (invalidate' tn c, ())+invalidate :: [TableName] -> IO ()+invalidate tns = atomicModifyIORef' theCache $ \c -> (foldl' (flip invalidate') c tns, ())  invalidate' :: TableName -> ResultCache -> ResultCache invalidate' tbl rc

@@ -59,7 +59,7 @@ insert t cs = do   kw <- defaultKeyword <$> seldaBackend   res <- uncurry exec $ compileInsert kw t cs-  liftIO $ invalidate (tableName t)+  invalidateTable t   return res  -- | Like 'insert', but does not return anything.@@ -73,10 +73,10 @@ insertWithPK :: (MonadSelda m, Insert a) => Table a -> [a] -> m Int insertWithPK t cs = do   backend <- seldaBackend-  liftIO $ do-    res <- uncurry (runStmtWithPK backend) $ compileInsert (defaultKeyword backend) t cs-    invalidate (tableName t)-    return res+  res <- liftIO $ do+    uncurry (runStmtWithPK backend) $ compileInsert (defaultKeyword backend) t cs+  invalidateTable t+  return res  -- | Update the given table using the given update function, for all rows --   matching the given predicate. Returns the number of updated rows.@@ -87,7 +87,7 @@        -> m Int update tbl check upd = do   res <- uncurry exec $ compileUpdate tbl upd check-  liftIO $ invalidate (tableName tbl)+  invalidateTable tbl   return res  -- | Like 'update', but doesn't return the number of updated rows.@@ -104,7 +104,7 @@            => Table a -> (Cols s a -> Col s Bool) -> m Int deleteFrom tbl f = do   res <- uncurry exec $ compileDelete tbl f-  liftIO $ invalidate (tableName tbl)+  invalidateTable tbl   return res  -- | Like 'deleteFrom', but does not return the number of deleted rows.@@ -137,14 +137,17 @@ --   will be rolled back, and the exception re-thrown. transaction :: (MonadSelda m, MonadThrow m, MonadCatch m) => m a -> m a transaction m = do+  beginTransaction   void $ exec "BEGIN TRANSACTION" []   res <- try m   case res of     Left (SomeException e) -> do       void $ exec "ROLLBACK" []+      endTransaction False       throwM e     Right x -> do       void $ exec "COMMIT" []+      endTransaction True       return x  -- | Set the maximum local cache size to @n@. A cache size of zero disables@@ -185,7 +188,7 @@ withInval :: MonadSelda m => (Table a -> m b) -> Table a -> m b withInval f t = do   res <- f t-  liftIO $ invalidate $ tableName t+  invalidateTable t   return res  -- | Execute a statement without a result.

@@ -10,7 +10,6 @@ import Data.List (sort, group) import Data.Monoid import Data.Text (Text, unpack, intercalate, any)-import Data.Typeable  -- | An error occurred when validating a database table. --   If this error is thrown, there is a bug in your database schema, and the