selda 0.1.9.0 → 0.1.10.0

raw patch · 14 files changed

+150/−76 lines, 14 filesdep ~basedep ~hashablePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, hashable

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• README.md +40/−3
• selda.cabal +5/−2
• src/Database/Selda.hs +1/−1
• src/Database/Selda/Backend.hs +2/−1
• src/Database/Selda/Backend/Internal.hs +38/−27
• src/Database/Selda/Caching.hs +2/−1
• src/Database/Selda/Compile.hs +15/−3
• src/Database/Selda/Frontend.hs +12/−22
• src/Database/Selda/Generic.hs +8/−11
• src/Database/Selda/Prepared.hs +7/−4
• src/Database/Selda/SQL/Print/Config.hs +9/−0
• src/Database/Selda/Selectors.hs +1/−0
• src/Database/Selda/Table.hs +2/−1

@@ -1,6 +1,14 @@ # Revision history for Selda  +## 0.1.10.0 -- 2017-08-01++* Async exception safety.+* Allow MonadSelda instances not built on SeldaT.+* Chunk very large insertions on backends that request it (i.e. SQLite).+* GHC 8.2 support.++ ## 0.1.9.0 -- 2017-06-16  * Properly document semantics of order.

@@ -395,7 +395,7 @@ allPeople = do   (people_name :*: _ :*: _) <- select people   (addresses_name :*: city) <- select addresses-  restrict (people_name == addresses_name)+  restrict (people_name .== addresses_name)   return (people_name :*: city) ``` @@ -418,7 +418,7 @@ `addresses` table), you would have to use a join:  ```-allPeople' :: Query s (Col s Text :*: Col s Maybe Text)+allPeople' :: Query s (Col s Text :*: Col s (Maybe Text)) allPeople' = do   (name :*: _ :*: _) <- select people   (_ :*: city) <- leftJoin (\(name' :*: _) -> name .== name')@@ -478,7 +478,7 @@   (owner :*: homes) <- aggregate $ do     (owner :*: city) <- select addresses     owner' <- groupBy owner-    return (count city :*: owner')+    return (owner' :*: count city)   restrict (owner .== name)   order homes descending   return (owner :*: homes)@@ -674,6 +674,43 @@ when *calling* `preparedGrownupsIn`, we instead pass in a value of type `Text`; for convenience, `prepared` automatically converts all arguments to prepared functions into their equivalent column types.+++Foreign keys+------------++To add a foreign key constraint on a column, use the `fk` function.+This function takes two parameters: a column of the table being defined, and+a tuple of the `(table, column)` the foreign key refers to.+The table identifier is simply a value of type `Table t`, while the column+is specified using a selector of type `Selector t a`.++The following example creates a table to store users, and one to store blog+posts. The `users` table stores a name, a password, and a unique identifier+for each user.+The `posts` table stores, for each post, the post body, a unique+post identifier, and the identifier of the user who wrote the post.+The column storing a post's author has a foreign key constraint on the `userid`+column of the `users` table, to ensure that each post has a valid author.++```+users :: Table (RowID :*: Text)+users = table "users"+  $   primary "userid"+  :*: required "username"+  :*: required "password"+(userId :*: userName :*: userPass) = selectors users++posts :: Table (RowID :*: RowID :*: Text)+posts = table "posts"+  $   primary "postid"+  :*: required "authorid" `fk` (users, userId)+  :*: required "post_body"+```++Note that a foreign key can *only* refer to a column which is either+a primary key or has a unique constraint. This is not specific to Selda, but+a restriction of SQL.  And with that, we conclude this tutorial. Hopefully it has been enough to get you comfortably started using Selda.

@@ -1,5 +1,5 @@ name:                selda-version:             0.1.9.0+version:             0.1.10.0 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,@@ -20,7 +20,7 @@ build-type:          Simple extra-source-files:  ChangeLog.md cabal-version:       >=1.10-tested-with:         GHC == 7.10.3, GHC == 8.0.2+tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1  extra-source-files:   README.md@@ -93,6 +93,9 @@   if impl(ghc < 7.11)     build-depends:       transformers  >=0.4 && <0.6+  if impl(ghc >= 8.2)+    build-depends:+      hashable >= 1.2.6.1   if !flag(haste) && flag(localcache)     build-depends:       psqueues >=0.2 && <0.3

@@ -250,7 +250,7 @@ --   Useful for creating expressions over optional columns: -- -- > people :: Table (Text :*: Int :*: Maybe Text)--- > people = table "people" $ required "name" ¤ required "age" ¤ optional "pet"+-- > people = table "people" $ required "name" :*: required "age" :*: optional "pet" -- > -- > peopleWithCats = do -- >   name :*: _ :*: pet <- select people

@@ -12,6 +12,7 @@   ) where import Database.Selda.Backend.Internal import Control.Monad+import Control.Monad.Catch import Control.Monad.IO.Class import Data.IORef @@ -20,6 +21,6 @@ --   Passing a closed connection to 'runSeldaT' results in a 'SeldaError' --   being thrown. Closing a connection more than once is a no-op. seldaClose :: MonadIO m => SeldaConnection -> m ()-seldaClose c = liftIO $ do+seldaClose c = liftIO $ mask_ $ do   closed <- atomicModifyIORef' (connClosed c) $ \closed -> (True, closed)   unless closed $ closeConnection (connBackend c) c

@@ -10,6 +10,7 @@   , PPConfig (..), defPPConfig   , sqlDateTimeFormat, sqlDateFormat, sqlTimeFormat   , freshStmtId+  , invalidate   , newConnection, allStmts   , runSeldaT, seldaBackend   ) where@@ -20,6 +21,7 @@ import Database.Selda.SQL.Print.Config import Database.Selda.Types (TableName) import Control.Concurrent+import Control.Exception (throw) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.State@@ -162,17 +164,26 @@   --   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 ()+  -- | Safely wrap a transaction. To ensure consistency of the in-process cache,+  --   it is important that any cached tables modified during a transaction are+  --   invalidated ONLY if that transaction succeeds, AFTER the changes become+  --   visible in the database.+  --+  --   In order to be thread-safe in the presence of asynchronous exceptions,+  --   instances should:+  --+  --   1. Mask async exceptions.+  --   2. Start bookkeeping of tables invalidated during the transaction.+  --   3. Perform the transaction, with async exceptions restored.+  --   4. Commit transaction, invalidate tables, and disable bookkeeping; OR+  --   5. If an exception was raised, rollback transaction and+  --      disable bookkeeping.+  --+  --   See the instance for 'SeldaT' for an example of how to do this safely.+  wrapTransaction :: m () -- ^ Signal transaction commit to SQL backend.+                  -> m () -- ^ Signal transaction rollback to SQL backend.+                  -> m a  -- ^ Transaction to perform.+                  -> m a  -- | Get the backend in use by the computation. seldaBackend :: MonadSelda m => m SeldaBackend@@ -184,7 +195,7 @@            , MonadThrow, MonadCatch, MonadMask, MonadTrans            ) -instance MonadIO m => MonadSelda (SeldaT m) where+instance (MonadIO m, MonadMask m) => MonadSelda (SeldaT m) where   seldaConnection = S $ fmap stConnection get    invalidateTable tbl = S $ do@@ -193,18 +204,17 @@       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 $ throwM $ 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}+  wrapTransaction commit rollback m = mask $ \restore -> do+    S $ modify' $ \st ->+      case stTouchedTables st of+        Nothing -> st {stTouchedTables = Just []}+        Just _  -> throw $ SqlError "attempted to nest transactions"+    x <- restore m `onException` rollback+    commit+    st <- S get+    maybe (return ()) (liftIO . invalidate) (stTouchedTables st)+    S $ put $ st {stTouchedTables = Nothing}+    return x  -- | The simplest form of Selda computation; 'SeldaT' specialized to 'IO'. type SeldaM = SeldaT IO@@ -212,9 +222,10 @@ -- | Run a Selda transformer. Backends should use this to implement their --   @withX@ functions. runSeldaT :: (MonadIO m, MonadMask m) => SeldaT m a -> SeldaConnection -> m a-runSeldaT m c = do-    liftIO $ takeMVar (connLock c)-    go `finally` liftIO (putMVar (connLock c) ())+runSeldaT m c =+    bracket (liftIO $ takeMVar (connLock c))+            (const $ liftIO $ putMVar (connLock c) ())+            (const go)   where     go = do       closed <- liftIO $ readIORef (connClosed c)

@@ -121,7 +121,8 @@     updatePrio (Just (_, v)) = (Just v, Just (nextPrio rc, v))     updatePrio _             = (Nothing, Nothing) --- | Invalidate all items in cache that depend on the given table.+-- | Invalidate all items in the per-process cache that depend on+--   the given table. invalidate :: [TableName] -> IO () invalidate tns = atomicModifyIORef' theCache $ \c -> (foldl' (flip invalidate') c tns, ()) 

@@ -44,9 +44,21 @@ -- | Compile an @INSERT@ query, given the keyword representing default values --   in the target SQL dialect, a table and a list of items corresponding --   to the table.-compileInsert :: Insert a => PPConfig -> Table a -> [a] -> (Text, [Param])-compileInsert _ _ []       = (empty, [])-compileInsert cfg tbl rows = compInsert cfg tbl (map params rows)+compileInsert :: Insert a => PPConfig -> Table a -> [a] -> [(Text, [Param])]+compileInsert _ _ [] =+  [(empty, [])]+compileInsert cfg tbl rows =+    case ppMaxInsertParams cfg of+      Nothing -> [compInsert cfg tbl rows']+      Just n  -> map (compInsert cfg tbl) (chunk (n `div` rowlen) rows')+  where+    rows' = map params rows+    rowlen = length (head rows')+    chunk chunksize xs =+      case splitAt chunksize xs of+        ([], []) -> []+        (x, [])  -> [x]+        (x, xs') -> x : chunk chunksize xs'  -- | Compile an @UPDATE@ query. compileUpdate :: forall s a. (Columns (Cols s a), Result (Cols s a))

@@ -44,10 +44,10 @@ -- -- > people :: Table (Int :*: Text :*: Int :*: Maybe Text) -- > people = table "ppl"--- >        $ autoPrimary "id"--- >        ¤ required "name"--- >        ¤ required "age"--- >        ¤ optional "pet"+-- >        $   autoPrimary "id"+-- >        :*: required "name"+-- >        :*: required "age"+-- >        :*: optional "pet" -- > -- > main = withSQLite "my_database.sqlite" $ do -- >   insert_ people@@ -63,9 +63,9 @@   return 0 insert t cs = do   cfg <- ppConfig <$> seldaBackend-  res <- uncurry exec $ compileInsert cfg t cs+  res <- mapM (uncurry exec) $ compileInsert cfg t cs   invalidateTable t-  return res+  return (sum res)  -- | Attempt to insert a list of rows into a table, but don't raise an error --   if the insertion fails. Returns @True@ if the insertion succeeded, otherwise@@ -159,9 +159,9 @@   if tableHasAutoPK t     then do       res <- liftIO $ do-        uncurry (runStmtWithPK b) $ compileInsert (ppConfig b) t cs+        mapM (uncurry (runStmtWithPK b)) $ compileInsert (ppConfig b) t cs       invalidateTable t-      return $ unsafeRowId res+      return $ unsafeRowId (last res)     else do       insert_ t cs       return invalidRowId@@ -225,20 +225,10 @@ -- | Perform the given computation atomically. --   If an exception is raised during its execution, the enture transaction --   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+transaction :: (MonadSelda m, MonadCatch m) => m a -> m a+transaction m =+  wrapTransaction (void $ exec "COMMIT" []) (void $ exec "ROLLBACK" []) $ do+    exec "BEGIN TRANSACTION" [] *> m  -- | Set the maximum local cache size to @n@. A cache size of zero disables --   local cache altogether. Changing the cache size will also flush all

@@ -29,7 +29,9 @@   ) where import Control.Monad.State import Data.Dynamic+import Data.Proxy import Data.Text (pack)+import Data.Typeable import GHC.Generics hiding (R, (:*:), Selector) import qualified GHC.Generics as G ((:*:)(..), Selector) import Unsafe.Coerce@@ -155,7 +157,7 @@ -- > demoPerson = fromRel ("Miyu" :*: 10) -- > -- > adhoc :: Table (Text :*: Int)--- > adhoc = table "adhoc" $ required "name" ¤ required "age"+-- > adhoc = table "adhoc" $ required "name" :*: required "age" -- > -- > getPersons1 :: MonadSelda m => m [SimplePerson] -- > getPersons1 = map fromRel <$> query (select adhoc)@@ -234,13 +236,6 @@ identify :: Dummy a -> (a -> b) -> Int identify (Dummy d) f = unsafeCoerce $ f d -class Traits a where-  isMaybeType :: Proxy a -> Bool-  isMaybeType _ = False-instance Traits (Maybe a) where-  isMaybeType _ = True-instance {-# OVERLAPPABLE #-} Traits a- -- | The relation corresponding to the given type. type family Rel (rep :: * -> *) where   Rel (M1 t c a)  = Rel a@@ -281,13 +276,15 @@         }   gMkDummy = M1 <$> gMkDummy -instance (Traits a, SqlType a) => GRelation (K1 i a) where+instance (Typeable a, SqlType a) => GRelation (K1 i a) where   gToRel (K1 x) = x   gTblCols _    = [ColInfo "" (sqlType (Proxy :: Proxy a)) optReq []]     where+      -- workaround for GHC 8.2 not resolving overlapping instances properly+      maybeTyCon = typeRepTyCon (typeRep (Proxy :: Proxy (Maybe ())))       optReq-        | isMaybeType (Proxy :: Proxy a) = [Optional]-        | otherwise                      = [Required]+        | typeRepTyCon (typeRep (Proxy :: Proxy a)) == maybeTyCon = [Optional]+        | otherwise                                               = [Required]   gMkDummy = do     n <- get     put (n+1)

@@ -60,6 +60,10 @@  instance (MonadSelda m, a ~ Res (ResultT q), Result (ResultT q)) =>          Prepare q (m [a]) where+  -- This function uses read/writeIORef instead of atomicModifyIORef.+  -- For once, this is actually safe: the IORef points to a single compiled+  -- statement, so the only consequence of a race between the read and the write+  -- is that the statement gets compiled (note: NOT prepared) twice.   mkFun ref sid qry arguments = do     conn <- seldaConnection     let backend = connBackend conn@@ -68,8 +72,7 @@     case M.lookup sid stmts of       Just stm -> do         -- Statement already prepared for this connection; just execute it.-        liftIO $ do-          runQuery conn stm args+        liftIO $ runQuery conn stm args       _ -> do         -- Statement wasn't prepared for this connection; check if it was at         -- least previously compiled for this backend.@@ -83,7 +86,7 @@             return comp          -- Prepare and execute-        liftIO $ do+        liftIO $ mask $ \restore -> do           hdl <- prepareStmt backend sid reps q           let stm = SeldaStmt                 { stmtHandle = hdl@@ -92,7 +95,7 @@                 , stmtText = q                 }           atomicModifyIORef' (connStmts conn) $ \m -> (M.insert sid stm m, ())-          runQuery conn stm args+          restore $ runQuery conn stm args     where       runQuery conn stm args = do         let backend = connBackend conn

@@ -19,6 +19,14 @@     -- | The value used for the next value for an auto-incrementing column.     --   For instance, @DEFAULT@ for PostgreSQL, and @NULL@ for SQLite.   , ppAutoIncInsert :: Text++    -- | Insert queries may have at most this many parameters; if an insertion+    --   has more parameters than this, it will be chunked.+    --+    --   Note that only insertions of multiple rows are chunked. If your table+    --   has more than this many columns, you should really rethink+    --   your database design.+  , ppMaxInsertParams :: Maybe Int   }  -- | Default settings for pretty-printing.@@ -29,6 +37,7 @@     , ppPlaceholder = T.cons '$' . T.pack . show     , ppColAttrs = T.unwords . map defColAttr     , ppAutoIncInsert = "NULL"+    , ppMaxInsertParams = Nothing     }  -- | Default compilation for SQL types.

@@ -7,6 +7,7 @@ import Database.Selda.Column import Data.Dynamic import Data.List (foldl')+import Data.Proxy import Unsafe.Coerce  -- | Get the value at the given index from the given inductive tuple.

@@ -9,6 +9,7 @@ import Data.Dynamic import Data.List (sort, group) import Data.Monoid+import Data.Proxy import Data.Text (unpack, intercalate, any)  -- | An error occurred when validating a database table.@@ -187,7 +188,7 @@     pkDupes =       ["multiple primary keys" | (Primary:_:_) <- soup $ concatMap colAttrs cis]     nonPkFks =-      [ "column is used as a foreign key, but is not a primary key of its table: "+      [ "column is used as a foreign key, but is not primary or unique: "           <> fromTableName ftn <> "." <> fromColName fcn       | ci <- cis       , (Table ftn fcs _, fcn) <- colFKs ci