selda 0.1.6.0 → 0.1.7.0

raw patch · 13 files changed

+117/−35 lines, 13 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/−5
• selda.cabal +5/−5
• src/Database/Selda.hs +1/−0
• src/Database/Selda/Caching.hs +1/−0
• src/Database/Selda/Frontend.hs +43/−12
• src/Database/Selda/Generic.hs +5/−3
• src/Database/Selda/Query.hs +1/−1
• src/Database/Selda/SqlType.hs +36/−1
• src/Database/Selda/Table.hs +10/−5
• src/Database/Selda/Table/Compile.hs +1/−1
• src/Database/Selda/Table/Foreign.hs +2/−2
• src/Database/Selda/Unsafe.hs +1/−0

@@ -1,6 +1,14 @@ # Revision history for Selda  +## 0.1.7.0 -- 2017-05-17++* Add specialized insertUnless upsert variant.+* Fix potential race condition in upserts.+* Use abstract row identifier type for auto-incrementing primary keys.+* Less strict version bounds on dependencies.++ ## 0.1.6.0 -- 2017-05-07  * Conditional insert ("upsert") support.

@@ -187,7 +187,7 @@ auto-incrementing primary key:  ```-people' :: Table (Int :*: Text :*: Int :*: Maybe Text)+people' :: Table (RowID :*: Text :*: Int :*: Maybe Text) people' = table "people_with_ids"   $   autoPrimary "id"   :*: required "name"@@ -219,9 +219,7 @@  3 | Miyu      | 10  | ``` -Also note that `def` can *only* be used for columns that have default values.-Currently, only auto-incrementing primary keys can have defaults.-Attempting to use `def` in any other context results in a runtime error.+Auto-incrementing primary keys must always have the type `RowID`.   Updating rows@@ -321,7 +319,7 @@ and its selector functions at the same time:  ```-posts :: Table (Int :*: Maybe Text :*: Text)+posts :: Table (RowID :*: Maybe Text :*: Text) (posts, postId :*: author :*: content)   =   tableWithSelectors "posts"   $   autoPrimary "id"

@@ -1,5 +1,5 @@ name:                selda-version:             0.1.6.0+version:             0.1.7.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,@@ -83,15 +83,15 @@     , exceptions >=0.8 && <0.9     , mtl        >=2.0 && <2.3     , text       >=1.0 && <1.3-    , time       >=1.6 && <1.9+    , time       >=1.5 && <1.9   if impl(ghc < 7.11)     build-depends:       transformers  >=0.4 && <0.6   if !flag(haste) && flag(localcache)     build-depends:-        hashable             >=1.1 && <1.3-      , psqueues             >=0.2 && <0.3-      , unordered-containers >=0.2 && <0.3+        hashable             >=1.1   && <1.3+      , psqueues             >=0.2   && <0.3+      , unordered-containers >=0.2.6 && <0.3   else     cpp-options:       -DNO_LOCALCACHE

@@ -79,6 +79,7 @@   , inner, suchThat     -- * Expressions over columns   , Set (..)+  , RowID, invalidRowId, isInvalidRowId   , (.==), (./=), (.>), (.<), (.>=), (.<=), like   , (.&&), (.||), not_   , literal, int, float, text, true, false, null_

@@ -49,6 +49,7 @@   hashWithSalt s (LTime x)     = hashWithSalt s x   hashWithSalt s (LJust x)     = hashWithSalt s x   hashWithSalt _ (LNull)       = 0+  hashWithSalt s (LCustom l)   = hashWithSalt s l  data ResultCache = ResultCache   { -- | Query to result mapping.

@@ -3,7 +3,7 @@ module Database.Selda.Frontend   ( Result, Res, MonadIO (..), MonadSelda (..), SeldaT   , query-  , insert, insert_, insertWithPK, tryInsert+  , insert, insert_, insertWithPK, tryInsert, insertUnless   , update, update_, upsert   , deleteFrom, deleteFrom_   , createTable, tryCreateTable@@ -16,6 +16,7 @@ import Database.Selda.Compile import Database.Selda.Query.Type import Database.Selda.SQL+import Database.Selda.SqlType (RowID, invalidRowId, unsafeRowId) import Database.Selda.Table import Database.Selda.Table.Compile import Data.Proxy@@ -80,7 +81,11 @@     Left e            -> throwM e  -- | Attempt to perform the given update. If no rows were updated, insert the---   given rowr.+--   given row.+--   Returns the primary key of the inserted row, if the insert was performed.+--   Calling this function on a table which does not have a primary key will+--   return @Just id@ on a successful insert, where @id@ is a row identifier+--   guaranteed to not match any row in any table. -- --   Note that this may perform two separate queries: one update, potentially --   followed by one insert.@@ -94,11 +99,31 @@        -> (Cols s a -> Col s Bool)        -> (Cols s a -> Cols s a)        -> [a]-       -> m ()-upsert tbl check upd rows = do+       -> m (Maybe RowID)+upsert tbl check upd rows = transaction $ do   updated <- update tbl check upd-  when (updated == 0) $ insert_ tbl rows+  if updated == 0+    then Just <$> insertWithPK tbl rows+    else pure Nothing +-- | Perform the given insert, if no rows already present in the table match+--   the given predicate.+--   Returns the primary key of the inserted row, if the insert was performed.+--   If called on a table which doesn't have an auto-incrementing primary key,+--   @Just id@ is always returned on successful insert, where @id@ is a row+--   identifier guaranteed to not match any row in any table.+insertUnless :: ( MonadCatch m+                , MonadSelda m+                , Insert a+                , Columns (Cols s a)+                , Result (Cols s a)+                )+             => Table a+             -> (Cols s a -> Col s Bool)+             -> [a]+             -> m (Maybe RowID)+insertUnless tbl check rows = upsert tbl check id rows+ -- | Like 'insert', but does not return anything. --   Use this when you really don't care about how many rows were inserted. insert_ :: (MonadSelda m, Insert a) => Table a -> [a] -> m ()@@ -106,14 +131,20 @@  -- | Like 'insert', but returns the primary key of the last inserted row. --   Attempting to run this operation on a table without an auto-incrementing---   primary key is a type error.-insertWithPK :: (MonadSelda m, Insert a) => Table a -> [a] -> m Int+--   primary key will always return a row identifier that is guaranteed to not+--   match any row in any table.+insertWithPK :: (MonadSelda m, Insert a) => Table a -> [a] -> m RowID insertWithPK t cs = do-  backend <- seldaBackend-  res <- liftIO $ do-    uncurry (runStmtWithPK backend) $ compileInsert (defaultKeyword backend) t cs-  invalidateTable t-  return res+  b <- seldaBackend+  if tableHasAutoPK t+    then do+      res <- liftIO $ do+        uncurry (runStmtWithPK b) $ compileInsert (defaultKeyword b) t cs+      invalidateTable t+      return $ unsafeRowId res+    else do+      insert_ t cs+      return invalidRowId  -- | Update the given table using the given update function, for all rows --   matching the given predicate. Returns the number of updated rows.

@@ -101,10 +101,11 @@          => TableName          -> [GenAttr a]          -> GenTable a-genTable tn attrs = GenTable $ Table tn (validate tn (map tidy cols))+genTable tn attrs = GenTable $ Table tn (validate tn (map tidy cols)) apk   where     dummy = mkDummy     cols = zipWith addAttrs [0..] (tblCols (Proxy :: Proxy a))+    apk = or [AutoIncrement `elem` as | _ :- Attribute as <- attrs]     addAttrs n ci = ci       { colAttrs = colAttrs ci ++ concat           [ as@@ -177,7 +178,7 @@  -- | Like 'insertWithPK', but accepts a generic table and --   its corresponding data type.-insertGenWithPK :: (Relational a, MonadSelda m) => GenTable a -> [a] -> m Int+insertGenWithPK :: (Relational a, MonadSelda m) => GenTable a -> [a] -> m RowID insertGenWithPK t = insertWithPK (gen t) . map toRel  -- | Like 'insert', but accepts a generic table and its corresponding data type.@@ -207,7 +208,8 @@  -- | A foreign key constraint referencing the given table and column. fkGen :: Table t -> Selector t a -> Attribute-fkGen (Table tn tcs) (Selector i) = ForeignKey (Table tn tcs, colName (tcs !! i))+fkGen (Table tn tcs tapk) (Selector i) =+  ForeignKey (Table tn tcs tapk, colName (tcs !! i))  -- | A dummy of some type. Encapsulated to avoid improper use, since all of --   its fields are 'unsafeCoerce'd ints.

@@ -16,7 +16,7 @@ -- | Query the given table. Result is returned as an inductive tuple, i.e. --   @first :*: second :*: third <- query tableOfThree@. select :: Columns (Cols s a) => Table a -> Query s (Cols s a)-select (Table name cs) = Query $ do+select (Table name cs _) = Query $ do     rns <- mapM (rename . Some . Col) cs'     st <- get     put $ st {sources = SQL rns (TableName name) [] [] [] Nothing : sources st}

@@ -1,7 +1,8 @@ {-# LANGUAGE GADTs, OverloadedStrings, ScopedTypeVariables, FlexibleInstances #-} -- | Types representable in Selda's subset of SQL. module Database.Selda.SqlType-  ( Lit (..), SqlValue (..), SqlType+  ( Lit (..), RowID, SqlValue (..), SqlType+  , invalidRowId, isInvalidRowId, unsafeRowId   , mkLit, sqlType, fromSql, defaultValue   , compLit   , sqlDateTimeFormat, sqlDateFormat, sqlTimeFormat@@ -44,6 +45,7 @@   LTime     :: !Text    -> Lit TimeOfDay   LJust     :: !(Lit a) -> Lit (Maybe a)   LNull     :: Lit (Maybe a)+  LCustom   :: !(Lit a) -> Lit b  instance Eq (Lit a) where   a == b = compLit a b == EQ@@ -62,6 +64,7 @@ litConTag (LTime{})     = 6 litConTag (LJust{})     = 7 litConTag (LNull)       = 8+litConTag (LCustom{})   = 9  -- | Compare two literals of different type for equality. compLit :: Lit a -> Lit b -> Ordering@@ -73,6 +76,7 @@ compLit (LDate x)     (LDate x')     = x `compare` x' compLit (LTime x)     (LTime x')     = x `compare` x' compLit (LJust x)     (LJust x')     = x `compLit` x'+compLit (LCustom x)   (LCustom x')   = x `compLit` x' compLit a             b              = litConTag a `compare` litConTag b  -- | Some value that is representable in SQL.@@ -100,6 +104,37 @@   show (LTime s)     = show s   show (LJust x)     = "Just " ++ show x   show (LNull)       = "Nothing"+  show (LCustom l)   = show l++-- | A row identifier for some table.+--   This is the type of auto-incrementing primary keys.+newtype RowID = RowID Int+  deriving (Eq, Typeable)+instance Show RowID where+  show (RowID n) = show n++-- | A row identifier which is guaranteed to not match any row in any table.+invalidRowId :: RowID+invalidRowId = RowID (-1)++-- | Is the given row identifier invalid? I.e. is it guaranteed to not match any+--   row in any table?+isInvalidRowId :: RowID -> Bool+isInvalidRowId (RowID n) = n < 0++-- | Create a row identifier from an integer.+--   A row identifier created using this function is not guaranteed to be a+--   valid row identifier.+--   Do not use unless you are absolutely sure what you're doing.+unsafeRowId :: Int -> RowID+unsafeRowId = RowID++instance SqlType RowID where+  mkLit (RowID n) = LCustom $ LInt n+  sqlType _ = sqlType (Proxy :: Proxy Int)+  fromSql (SqlInt x) = RowID x+  fromSql v          = error $ "fromSql: RowID column with non-int value: " ++ show v+  defaultValue = mkLit invalidRowId  instance SqlType Int where   mkLit = LInt

@@ -38,6 +38,8 @@     --   Invariant: the 'colAttrs' list of each column is sorted and contains     --   no duplicates.   , tableCols :: ![ColInfo]+    -- | Does the given table have an auto-incrementing primary key?+  , tableHasAutoPK :: !Bool   }  data ColInfo = ColInfo@@ -96,7 +98,7 @@  -- | Automatically increment the given attribute if not specified during insert. --   Also adds the @PRIMARY KEY@ and @UNIQUE@ attributes on the column.-autoPrimary :: ColName -> ColSpec Int+autoPrimary :: ColName -> ColSpec RowID autoPrimary n = ColSpec [c {colAttrs = [Primary, AutoIncrement, Required, Unique]}]   where ColSpec [c] = newCol n :: ColSpec Int @@ -127,9 +129,12 @@ -- | A table with the given name and columns. table :: forall a. TableSpec a => TableName -> ColSpecs a -> Table a table name cs = Table-  { tableName = name-  , tableCols = validate name $ map tidy $ mergeSpecs (Proxy :: Proxy a) cs-  }+    { tableName = name+    , tableCols = tcs+    , tableHasAutoPK = Prelude.any ((AutoIncrement `elem`) . colAttrs) tcs+    }+  where+    tcs = validate name $ map tidy $ mergeSpecs (Proxy :: Proxy a) cs  -- | Remove duplicate attributes. tidy :: ColInfo -> ColInfo@@ -185,7 +190,7 @@       [ "column is used as a foreign key, but is not a primary key of its table: "           <> fromTableName ftn <> "." <> fromColName fcn       | ci <- cis-      , (Table ftn fcs, fcn) <- colFKs ci+      , (Table ftn fcs _, fcn) <- colFKs ci       , fc <- fcs       , colName fc == fcn       , not (Unique `elem` colAttrs fc)

@@ -30,7 +30,7 @@  -- | Compile a foreign key constraint. compileFK :: ColName -> (Table (), ColName) -> Int -> Text-compileFK col (Table ftbl _, fcol) n = mconcat+compileFK col (Table ftbl _ _, fcol) n = mconcat   [ "CONSTRAINT ", fkName, " FOREIGN KEY (", fromColName col, ") "   , "REFERENCES ", fromTableName ftbl, "(", fromColName fcol, ")"   ]

@@ -9,10 +9,10 @@ --   uniqueness constraint, a 'ValidationError' will be thrown --   during validation. fk :: ColSpec a -> (Table t, Selector t a) -> ColSpec a-fk (ColSpec [c]) (Table tn tcs, Selector i) =+fk (ColSpec [c]) (Table tn tcs tapk, Selector i) =     ColSpec [c {colFKs = thefk : colFKs c}]   where-    thefk = (Table tn tcs, colName (tcs !! i))+    thefk = (Table tn tcs tapk, colName (tcs !! i)) fk _ _ =   error "impossible: ColSpec with several columns" 

@@ -5,6 +5,7 @@   ( fun, fun2   , aggr   , cast+  , unsafeRowId   ) where import Database.Selda.Column import Database.Selda.Inner (aggr)