selda 0.5.0.0 → 0.5.1.0

raw patch · 10 files changed

+133/−16 lines, 10 filesdep ~randomdep ~timePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: random, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• selda.cabal +1/−1
• src/Database/Selda.hs +1/−1
• src/Database/Selda/Backend/Internal.hs +17/−11
• src/Database/Selda/Exp.hs +2/−0
• src/Database/Selda/Frontend.hs +3/−0
• src/Database/Selda/SQL.hs +22/−2
• src/Database/Selda/SQL/Print.hs +14/−0
• src/Database/Selda/Transform.hs +1/−0
• src/Database/Selda/Unsafe.hs +64/−1

@@ -1,6 +1,14 @@ # Revision history for Selda  +## 0.5.1.0 -- 2020-01-20++* Support for raw SQL fragments. (#134)+* Expose tableName.+* Document performance drawbacks of withoutForeignKeyEnforcement.+* Fix several bugs validating auto-incrementing PKs. (#133)++ ## 0.5.0.0 -- 2019-09-21  * index and indexUsing now accept a Group instead of a Selector (#121)

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

@@ -25,7 +25,7 @@   , SeldaError (..), ValidationError   , SeldaT, SeldaM   , Relational, Only (..), The (..)-  , Table, Query, Row, Col, Res, Result+  , Table (tableName), Query, Row, Col, Res, Result   , query, queryInto   , transaction, withoutForeignKeyEnforcement   , newUuid

@@ -17,6 +17,7 @@   , newConnection, allStmts   , runSeldaT, withBackend   ) where+import Data.List (nub) import Database.Selda.SQL (Param (..)) import Database.Selda.SqlType import Database.Selda.Table hiding (colName, colType, colFKs)@@ -45,8 +46,10 @@  -- | Thrown by any function in 'SeldaT' if an error occurs. data SeldaError-  = DbError String  -- ^ Unable to open or connect to database.-  | SqlError String -- ^ An error occurred while executing query.+  = DbError String     -- ^ Unable to open or connect to database.+  | SqlError String    -- ^ An error occurred while executing query.+  | UnsafeError String -- ^ An error occurred due to improper use of an unsafe+                       --   function.   deriving (Show, Eq, Typeable)  instance Exception SeldaError@@ -166,16 +169,24 @@ tableInfo t = TableInfo   { tableColumnInfos = map fromColInfo (tableCols t)   , tableUniqueGroups = uniqueGroups-  , tablePrimaryKey = pkGroups+  , tablePrimaryKey = pkGroup   }   where     uniqueGroups =       [ map (Table.colName . ((tableCols t) !!)) ixs       | (ixs, Unique) <- tableAttrs t       ]-    pkGroups = concat-      [ map (Table.colName . ((tableCols t) !!)) ixs-      | (ixs, Primary) <- tableAttrs t+    pkGroup = nub $ concat+      [ concat+        [ map (Table.colName . ((tableCols t) !!)) ixs+        | (ixs, attr) <- tableAttrs t+        , isPrimary attr+        ]+      , [ Table.colName col+        | col <- tableCols t+        , attr <- Table.colAttrs col+        , isPrimary attr+        ]       ]  -- | A collection of functions making up a Selda backend.@@ -219,11 +230,6 @@   }  -- | Some monad with Selda SQL capabilitites.------   Note that the default implementations of 'invalidateTable' and---   'wrapTransaction' flush the entire cache and disable caching when---   invoked. If you want to use Selda's built-in caching mechanism, you will---   need to implement these operations yourself. class MonadIO m => MonadSelda m where   {-# MINIMAL withConnection #-} 

@@ -33,6 +33,7 @@   Fun2    :: !Text -> !(Exp sql a) -> !(Exp sql b) -> Exp sql c   If      :: !(Exp sql Bool) -> !(Exp sql a) -> !(Exp sql a) -> Exp sql a   Cast    :: !SqlTypeRep -> !(Exp sql a) -> Exp sql b+  Raw     :: !Text -> Exp sql a   AggrEx  :: !Text -> !(Exp sql a) -> Exp sql b   InList  :: !(Exp sql a) -> ![Exp sql a] -> Exp sql Bool   InQuery :: !(Exp sql a) -> !sql -> Exp sql Bool@@ -84,6 +85,7 @@   allNamesIn (AggrEx _ x)  = allNamesIn x   allNamesIn (InList x xs) = concatMap allNamesIn (x:xs)   allNamesIn (InQuery x q) = allNamesIn x ++ allNamesIn q+  allNamesIn (Raw _)       = []  instance Names sql => Names (SomeCol sql) where   allNamesIn (Some c)    = allNamesIn c

@@ -247,6 +247,9 @@ --   Use with extreme caution, preferably only for migrations. -- --   On the PostgreSQL backend, at least PostgreSQL 9.6 is required.+--+--   Using this should be avoided in favor of deferred foreign key+--   constraints. See SQL backend documentation for deferred constraints. withoutForeignKeyEnforcement :: (MonadSelda m, MonadMask m) => m a -> m a withoutForeignKeyEnforcement m = withBackend $ \b -> do   bracket_ (liftIO $ disableForeignKeys b True)

@@ -1,21 +1,35 @@ {-# LANGUAGE GADTs, OverloadedStrings, ScopedTypeVariables, RecordWildCards #-} {-# LANGUAGE TypeOperators, FlexibleInstances, UndecidableInstances #-}-{-# LANGUAGE RankNTypes, CPP #-}+{-# LANGUAGE RankNTypes, CPP, MultiParamTypeClasses #-} -- | SQL AST and parameters for prepared statements. module Database.Selda.SQL where+import Data.String+import Data.Text (Text) import Database.Selda.Exp import Database.Selda.SqlType import Database.Selda.Types #if !MIN_VERSION_base(4, 11, 0)-import Data.Monoid hiding (Product)+import Data.Semigroup (Semigroup (..)) #endif +instance Semigroup QueryFragment where+  (<>) = RawCat++data QueryFragment where+  RawText :: !Text -> QueryFragment+  RawExp  :: !(Exp SQL a) -> QueryFragment+  RawCat  :: !QueryFragment -> !QueryFragment -> QueryFragment++instance IsString QueryFragment where+  fromString = RawText . fromString+ -- | A source for an SQL query. data SqlSource  = TableName !TableName  | Product ![SQL]  | Join !JoinType !(Exp SQL Bool) !SQL !SQL  | Values ![SomeCol SQL] ![[Param]]+ | RawSql !QueryFragment  | EmptyTable  -- | Type of join to perform.@@ -32,11 +46,17 @@   , distinct  :: !Bool   } +instance Names QueryFragment where+  allNamesIn (RawText _)  = []+  allNamesIn (RawExp e)   = allNamesIn e+  allNamesIn (RawCat a b) = allNamesIn a ++ allNamesIn b+ instance Names SqlSource where   allNamesIn (Product qs)   = concatMap allNamesIn qs   allNamesIn (Join _ e l r) = allNamesIn e ++ concatMap allNamesIn [l, r]   allNamesIn (Values vs _)  = allNamesIn vs   allNamesIn (TableName _)  = []+  allNamesIn (RawSql r)     = allNamesIn r   allNamesIn (EmptyTable)   = []  instance Names SQL where

@@ -46,6 +46,10 @@ compExp :: PPConfig -> Exp SQL a -> (Text, [Param]) compExp cfg = runPP cfg . ppCol +-- | Compile a raw SQL fragment.+compRaw :: PPConfig -> QueryFragment -> (Text, [Param])+compRaw cfg = runPP cfg . ppRaw+ -- | Compile an @UPATE@ statement. compUpdate :: PPConfig            -> TableName@@ -125,6 +129,10 @@     ppSrc EmptyTable = do       qn <- freshQueryName       pure $ " FROM (SELECT NULL LIMIT 0) AS " <> qn+    ppSrc (RawSql raw) = do+      s <- ppRaw raw+      qn <- freshQueryName+      pure (" FROM (" <> s <> ") AS " <> qn)     ppSrc (TableName n)  = do       pure $ " FROM " <> fromTableName n     ppSrc (Product [])   = do@@ -187,6 +195,11 @@      ppInt = Text.pack . show +ppRaw :: QueryFragment -> PP Text+ppRaw (RawText t)  = pure t+ppRaw (RawExp e)   = ppCol e+ppRaw (RawCat a b) = liftM2 (<>) (ppRaw a) (ppRaw b)+ ppSomeCol :: SomeCol SQL -> PP Text ppSomeCol (Some c)    = ppCol c ppSomeCol (Named n c) = do@@ -214,6 +227,7 @@ ppCol (BinOp op a b) = ppBinOp op a b ppCol (UnOp op a)    = ppUnOp op a ppCol (NulOp a)      = ppNulOp a+ppCol (Raw e)        = pure e ppCol (Fun2 f a b)   = do   a' <- ppCol a   b' <- ppCol b

@@ -13,6 +13,7 @@       EmptyTable      -> sql'       TableName _     -> sql'       Values  _ _     -> sql'+      RawSql _        -> sql'       Product qs      -> sql' {source = Product $ map noDead qs}       Join jt on l r  -> sql' {source = Join jt on (noDead l) (noDead r)}   where

@@ -6,11 +6,20 @@   , aggr   , cast, castAggr, sink, sink2   , unsafeSelector+  , QueryFragment, inj, injLit, rawName, rawExp, rawStm, rawQuery, rawQuery1   ) where+import Control.Exception (throw)+import Control.Monad.State.Strict+import Database.Selda.Backend.Internal import Database.Selda.Column+import Database.Selda.Exp (UntypedCol (..)) import Database.Selda.Inner (Inner, Aggr, aggr, liftAggr) import Database.Selda.Selectors (unsafeSelector)-import Database.Selda.SqlType+import Database.Selda.Query.Type (Query (..), sources, renameAll, rename)+import Database.Selda.SQL (QueryFragment (..), SqlSource (RawSql), sqlFrom)+import Database.Selda.SQL.Print (compRaw)+import Database.Selda.SqlRow (SqlRow (..))+import Database.Selda.Types (ColName) import Data.Text (Text) import Data.Proxy import Unsafe.Coerce@@ -69,3 +78,57 @@ -- | Like 'fun', but with zero arguments. fun0 :: Text -> Col s a fun0 = One . NulOp . Fun0++-- | Create a raw SQL query fragment from the given column.+inj :: Col s a -> QueryFragment+inj (One x) = RawExp x++-- | Create a raw SQL query fragment from the given value.+injLit :: SqlType a => a -> QueryFragment+injLit = RawExp . Lit . mkLit++-- | Create a column referring to a name of your choice.+--   Use this to refer to variables not exposed by Selda.+rawName :: SqlType a => ColName -> Col s a+rawName = One . Col++-- | Create an expression from the given text.+--   The expression will be inserted verbatim into your query, so you should+--   NEVER pass user-provided text to this function.+rawExp :: SqlType a => Text -> Col s a+rawExp = One . Raw++-- | Execute a raw SQL statement.+rawStm :: MonadSelda m => QueryFragment -> m ()+rawStm q = withBackend $ \b -> liftIO $ do+  void $ uncurry (runStmt b) $ compRaw (ppConfig b) q++-- | Execute a raw SQL statement, returning a row consisting of columns by the+--   given names.+--   Will fail if the number of names given does not match up with+--   the type of the returned row.+--   Will generate invalid SQL if the given names don't match up with the+--   column names in the given query.+rawQuery :: forall a s. SqlRow a => [ColName] -> QueryFragment -> Query s (Row s a)+rawQuery names q+  | length names /= nestedCols (Proxy :: Proxy a) = do+      let err = concat+            [ "rawQuery: return type has ", show (nestedCols (Proxy :: Proxy a))+            , " columns, but only ", show (length names), " names were given"+            ]+      throw (UnsafeError err)+  | otherwise = Query $ do+      rns <- renameAll [Untyped (Col name) | name <- names]+      st <- get+      put $ st { sources = sqlFrom rns (RawSql q) : sources st }+      return (Many (map hideRenaming rns))++-- | As 'rawQuery', but returns only a single column. Same warnings still apply.+rawQuery1 :: SqlType a => ColName -> QueryFragment -> Query s (Col s a)+rawQuery1 name q = Query $ do+  name' <- head <$> rename (Untyped (Col name))+  st <- get+  put $ st { sources = sqlFrom [name'] (RawSql q) : sources st }+  case name' of+    Named n _ -> return (One (Col n))+    _         -> error "BUG: renaming did not rename"