packages feed

selda 0.1.5.0 → 0.1.6.0

raw patch · 16 files changed

+299/−130 lines, 16 filesdep ~timedep ~unordered-containers

Dependency ranges changed: time, unordered-containers

Files

ChangeLog.md view
@@ -1,5 +1,16 @@-# Revision history for selda+# Revision history for Selda ++## 0.1.6.0 -- 2017-05-07++* Conditional insert ("upsert") support.+* Support `SELECT x IN (SELECT ...)` and `SELECT x IN (a, b, ...)` queries.+* Explicit inner queries.+* Rename `inner` to `innerJoin`, more intuitive behavior for `suchThat`.+* Add `from` shorthand for `\s q -> fmap (!s) q`.+* Unique and foreign key constraints for generics.++ ## 0.1.5.0 -- 2017-05-05  * Inner join support.@@ -29,7 +40,7 @@  ## 0.1.3.1 -- 2017-05-01 -* More hackage-friendly README.+* More Hackage-friendly README.   ## 0.1.3.0 -- 2017-04-30@@ -47,6 +58,11 @@   ## 0.1.1.1 -- 2017-04-20++* Minor documentation fixes.+++## 0.1.1.0 -- 2017-04-20  * Generic tables, queries and mutation. * Select from inline tables.
README.md view
@@ -24,6 +24,7 @@ * Creating, dropping and querying tables using type-safe database schemas. * Typed query language with products, filtering, joins and aggregation. * Inserting, updating and deleting rows from tables.+* Conditional insert/update. * Transactions, uniqueness constraints and foreign keys. * Configurable, automatic, consistent in-process caching of query results. * Lightweight and modular: non-essential features are optional or split into@@ -649,8 +650,8 @@ * If/else. * Streaming * Type-safe migrations-* `WHERE x IN (SELECT ...)` * `SELECT INTO`. * Database schema upgrades. * Stack build. * MySQL/MariaDB backend.+* Automatically sanity check changelog, versions and date before release.
selda.cabal view
@@ -1,5 +1,5 @@ name:                selda-version:             0.1.5.0+version:             0.1.6.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,@@ -52,6 +52,7 @@     Database.Selda.Caching     Database.Selda.Column     Database.Selda.Compile+    Database.Selda.Exp     Database.Selda.Frontend     Database.Selda.Inner     Database.Selda.Query
src/Database/Selda.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables, TypeOperators, GADTs #-}+{-# LANGUAGE ScopedTypeVariables, TypeOperators, GADTs, FlexibleContexts #-} -- | Selda is not LINQ, but they're definitely related. -- --   Selda is a high-level EDSL for interacting with relational databases.@@ -73,10 +73,12 @@   , Text, Cols, Columns   , Order (..)   , (:*:)(..)-  , select, selectValues-  , restrict, limit, order-  , ascending, descending+  , select, selectValues, from+  , restrict, limit+  , order , ascending, descending+  , inner, suchThat     -- * Expressions over columns+  , Set (..)   , (.==), (./=), (.>), (.<), (.>=), (.<=), like   , (.&&), (.||), not_   , literal, int, float, text, true, false, null_@@ -85,13 +87,13 @@   , round_, just, fromBool, fromInt, toString     -- * Inner queries   , Aggr, Aggregates, OuterCols, LeftCols, Inner, MinMax-  , inner, suchThat, leftJoin+  , innerJoin, leftJoin   , aggregate, groupBy   , count, avg, sum_, max_, min_     -- * Modifying tables   , Insert-  , insert, insert_, insertWithPK, def-  , update, update_+  , insert, insert_, insertWithPK, tryInsert, def+  , update, update_, upsert   , deleteFrom, deleteFrom_     -- * Defining schemas   , TableSpec, ColSpecs, ColSpec, TableName, ColName@@ -131,7 +133,8 @@ import Database.Selda.Unsafe import Control.Exception (throw) import Data.Text (Text)-import Data.Typeable (Typeable, eqT, (:~:)(..))+import Data.Typeable (eqT, (:~:)(..))+import Unsafe.Coerce  -- | Any column type that can be used with the 'min_' and 'max_' functions. class SqlType a => MinMax a@@ -139,6 +142,47 @@ instance MinMax Text instance MinMax a => MinMax (Maybe a) +-- | Convenient shorthand for @fmap (! sel) q@.+--   The following two queries are quivalent:+--+-- > q1 = name `from` select people+-- > q2 = do+-- >   person <- select people+-- >   return (person ! name)+from :: ToDyn (Cols () a)+     => Selector a b+     -> Query s (Cols s a)+     -> Query s (Col s b)+from s q = (! s) <$> q+infixr 7 `from`++-- | Explicitly create an inner query. Equivalent to @innerJoin (const true)@.+--+--   Sometimes it's handy, for performance+--   reasons and otherwise, to perform a subquery and restrict only that query+--   before adding the result of the query to the result set, instead of first+--   adding the query to the result set and restricting the whole result set+--   afterwards.+inner :: (Columns a, Columns (OuterCols a))+      => Query (Inner s) a+      -> Query s (OuterCols a)+inner = innerJoin (const true)++-- | Create and filter an inner query, before adding it to the current result+--   set.+--+--   @q `suchThat` p@ is generally more efficient than+--   @select q >>= \x -> restrict (p x) >> pure x@.+suchThat :: (Columns a, Columns (OuterCols a))+         => Query (Inner s) a+         -> (a -> Col (Inner s) Bool)+         -> Query s (OuterCols a)+suchThat q p = inner $ do+  x <- q+  restrict (p x)+  return x+infixr 7 `suchThat`+ (.==), (./=), (.>), (.<), (.>=), (.<=) :: SqlType a => Col s a -> Col s a -> Col s Bool (.==) = liftC2 $ BinOp Eq (./=) = liftC2 $ BinOp Neq@@ -157,6 +201,20 @@ isNull :: Col s (Maybe a) -> Col s Bool isNull = liftC $ UnOp IsNull +-- | Any container type for which we can check object membership.+class Set set where+  -- | Is the given column contained in the given set?+  isIn :: SqlType a => Col s a -> set (Col s a) -> Col s Bool+infixl 4 `isIn`++instance Set [] where+  -- TODO: use safe coercions instead of unsafeCoerce+  isIn _ []     = false+  isIn (C x) xs = C $ InList x (unsafeCoerce xs)++instance Set (Query s) where+  isIn (C x) = C . InQuery x . snd . compQuery+ (.&&), (.||) :: Col s Bool -> Col s Bool -> Col s Bool (.&&) = liftC2 $ BinOp And (.||) = liftC2 $ BinOp Or@@ -240,7 +298,7 @@ sum_ = aggr "SUM"  -- | Round a value to the nearest integer. Equivalent to @roundTo 0@.-round_ :: forall s a. (Typeable a, SqlType a, Num a) => Col s Double -> Col s a+round_ :: forall s a. (SqlType a, Num a) => Col s Double -> Col s a round_ =   case eqT :: Maybe (a :~: Double) of     Just Refl -> fun "ROUND"
src/Database/Selda/Column.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, TypeFamilies, TypeOperators, PolyKinds, FlexibleInstances #-}--- | Columns and associated utility functions.+-- | Columns and associated utility functions, specialized to 'SQL'. module Database.Selda.Column   ( Cols, Columns   , Col (..), SomeCol (..), Exp (..), UnOp (..), BinOp (..)@@ -7,6 +7,8 @@   , allNamesIn   , literal   ) where+import Database.Selda.Exp+import Database.Selda.SQL import Database.Selda.SqlType import Database.Selda.Types import Data.String@@ -20,7 +22,7 @@ -- | Any column tuple. class Columns a where   toTup :: [ColName] -> a-  fromTup :: a -> [SomeCol]+  fromTup :: a -> [SomeCol SQL]  instance Columns b => Columns (Col s a :*: b) where   toTup (x:xs) = C (Col x) :*: toTup xs@@ -33,72 +35,21 @@   toTup xs  = C (TblCol xs)   fromTup (C x) = [Some x] --- | A type-erased column, which may also be renamed.---   Only for internal use.-data SomeCol where-  Some  :: !(Exp a) -> SomeCol-  Named :: !ColName -> !(Exp a) -> SomeCol- -- | A database column. A column is often a literal column table, but can also --   be an expression over such a column or a constant expression.-newtype Col s a = C {unC :: Exp a}+newtype Col s a = C {unC :: Exp SQL a}  -- | A literal expression. literal :: SqlType a => a -> Col s a literal = C . Lit . mkLit --- | Underlying column expression type, not tied to any particular query.-data Exp a where-  Col    :: !ColName -> Exp a-  TblCol :: ![ColName] -> Exp a-  Lit    :: !(Lit a) -> Exp a-  BinOp  :: !(BinOp a b) -> !(Exp a) -> !(Exp a) -> Exp b-  UnOp   :: !(UnOp a b) -> !(Exp a) -> Exp b-  Fun2   :: !Text -> !(Exp a) -> !(Exp b) -> Exp c-  Cast   :: !Text -> !(Exp a) -> Exp b-  AggrEx :: !Text -> !(Exp a) -> Exp b---- | Get all column names in the given expression.-allNamesIn :: Exp a -> [ColName]-allNamesIn (TblCol ns)   = ns-allNamesIn (Col n)       = [n]-allNamesIn (Lit _)       = []-allNamesIn (BinOp _ a b) = allNamesIn a ++ allNamesIn b-allNamesIn (UnOp _ a)    = allNamesIn a-allNamesIn (Fun2 _ a b)  = allNamesIn a ++ allNamesIn b-allNamesIn (Cast _ x)    = allNamesIn x-allNamesIn (AggrEx _ x)  = allNamesIn x--data UnOp a b where-  Abs    :: UnOp a a-  Not    :: UnOp Bool Bool-  Neg    :: UnOp a a-  Sgn    :: UnOp a a-  IsNull :: UnOp (Maybe a) Bool-  Fun    :: Text -> UnOp a b--data BinOp a b where-  Gt    :: BinOp a Bool-  Lt    :: BinOp a Bool-  Gte   :: BinOp a Bool-  Lte   :: BinOp a Bool-  Eq    :: BinOp a Bool-  Neq   :: BinOp a Bool-  And   :: BinOp Bool Bool-  Or    :: BinOp Bool Bool-  Add   :: BinOp a a-  Sub   :: BinOp a a-  Mul   :: BinOp a a-  Div   :: BinOp a a-  Like  :: BinOp Text Bool- instance IsString (Col s Text) where   fromString = literal . fromString -liftC2 :: (Exp a -> Exp b -> Exp c) -> Col s a -> Col s b -> Col s c+liftC2 :: (Exp SQL a -> Exp SQL b -> Exp SQL c) -> Col s a -> Col s b -> Col s c liftC2 f (C a) (C b) = C (f a b) -liftC :: (Exp a -> Exp b) -> Col s a -> Col s b+liftC :: (Exp SQL a -> Exp SQL b) -> Col s a -> Col s b liftC f = C . f . unC  instance (SqlType a, Num a) => Num (Col s a) where
src/Database/Selda/Compile.hs view
@@ -3,7 +3,7 @@ -- | Selda SQL compilation. module Database.Selda.Compile   ( Result, Res-  , toRes+  , toRes, compQuery   , compile, compileWith, compileWithTables   , compileInsert, compileUpdate, compileDelete   )@@ -19,7 +19,7 @@ import Database.Selda.Types import Data.Proxy import Data.Text (Text, empty)-import Data.Typeable+import Data.Typeable (Typeable)  -- | Compile a query into a parameterised SQL statement. --@@ -93,15 +93,15 @@   toRes :: Proxy r -> [SqlValue] -> Res r    -- | Produce a list of all columns present in the result.-  finalCols :: r -> [SomeCol]+  finalCols :: r -> [SomeCol SQL] -instance (Typeable a, SqlType a, Result b) => Result (Col s a :*: b) where+instance (SqlType a, Result b) => Result (Col s a :*: b) where   type Res (Col s a :*: b) = a :*: Res b   toRes _ (x:xs) = fromSql x :*: toRes (Proxy :: Proxy b) xs   toRes _ _      = error "backend bug: too few result columns to toRes"   finalCols (a :*: b) = finalCols a ++ finalCols b -instance (Typeable a, SqlType a) => Result (Col s a) where+instance SqlType a => Result (Col s a) where   type Res (Col s a) = a   toRes _ [x] = fromSql x   toRes _ []  = error "backend bug: too few result columns to toRes"
+ src/Database/Selda/Exp.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE GADTs #-}+-- | The expression type underlying 'Col'.+module Database.Selda.Exp where+import Database.Selda.SqlType+import Database.Selda.Types+import Data.Text (Text)++-- | A type-erased column, which may also be renamed.+--   Only for internal use.+data SomeCol sql where+  Some  :: !(Exp sql a) -> SomeCol sql+  Named :: !ColName -> !(Exp sql a) -> SomeCol sql++-- | Underlying column expression type, parameterised over the type of+--   SQL queries.+data Exp sql a where+  Col     :: !ColName -> Exp sql a+  TblCol  :: ![ColName] -> Exp sql a+  Lit     :: !(Lit a) -> Exp sql a+  BinOp   :: !(BinOp a b) -> !(Exp sql a) -> !(Exp sql a) -> Exp sql b+  UnOp    :: !(UnOp a b) -> !(Exp sql a) -> Exp sql b+  Fun2    :: !Text -> !(Exp sql a) -> !(Exp sql b) -> Exp sql c+  Cast    :: !Text -> !(Exp sql a) -> Exp sql b+  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++data UnOp a b where+  Abs    :: UnOp a a+  Not    :: UnOp Bool Bool+  Neg    :: UnOp a a+  Sgn    :: UnOp a a+  IsNull :: UnOp (Maybe a) Bool+  Fun    :: Text -> UnOp a b++data BinOp a b where+  Gt    :: BinOp a Bool+  Lt    :: BinOp a Bool+  Gte   :: BinOp a Bool+  Lte   :: BinOp a Bool+  Eq    :: BinOp a Bool+  Neq   :: BinOp a Bool+  And   :: BinOp Bool Bool+  Or    :: BinOp Bool Bool+  Add   :: BinOp a a+  Sub   :: BinOp a a+  Mul   :: BinOp a a+  Div   :: BinOp a a+  Like  :: BinOp Text Bool++-- | Any type which may contain column names.+class Names a where+  -- | Get all column names used in the given expression.+  allNamesIn :: a -> [ColName]++instance Names a => Names [a] where+  allNamesIn = concatMap allNamesIn++instance Names sql => Names (Exp sql a) where+  allNamesIn (TblCol ns)   = ns+  allNamesIn (Col n)       = [n]+  allNamesIn (Lit _)       = []+  allNamesIn (BinOp _ a b) = allNamesIn a ++ allNamesIn b+  allNamesIn (UnOp _ a)    = allNamesIn a+  allNamesIn (Fun2 _ a b)  = allNamesIn a ++ allNamesIn b+  allNamesIn (Cast _ x)    = allNamesIn x+  allNamesIn (AggrEx _ x)  = allNamesIn x+  allNamesIn (InList x xs) = concatMap allNamesIn (x:xs)+  allNamesIn (InQuery x q) = allNamesIn x ++ allNamesIn q++instance Names sql => Names (SomeCol sql) where+  allNamesIn (Some c)    = allNamesIn c+  allNamesIn (Named n c) = n : allNamesIn c
src/Database/Selda/Frontend.hs view
@@ -3,8 +3,8 @@ module Database.Selda.Frontend   ( Result, Res, MonadIO (..), MonadSelda (..), SeldaT   , query-  , insert, insert_, insertWithPK-  , update, update_+  , insert, insert_, insertWithPK, tryInsert+  , update, update_, upsert   , deleteFrom, deleteFrom_   , createTable, tryCreateTable   , dropTable, tryDropTable@@ -53,6 +53,9 @@ -- >     , def :*: "Zelda" :*: 119 :*: Nothing -- >     , ... -- >     ]+--+--   Note that if one or more of the inserted rows would cause a constraint+--   violation, NO rows will be inserted; the whole insertion fails atomically. insert :: (MonadSelda m, Insert a) => Table a -> [a] -> m Int insert _ [] = do   return 0@@ -61,6 +64,40 @@   res <- uncurry exec $ compileInsert kw t cs   invalidateTable t   return 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+--   @False@.+--+--   Like 'insert', if even one of the inserted rows would cause a constraint+--   violation, the whole insert operation fails.+tryInsert :: (MonadCatch m, MonadSelda m, Insert a) => Table a -> [a] -> m Bool+tryInsert tbl row = do+  mres <- try $ insert tbl row+  case mres of+    Right _           -> return True+    Left (SqlError _) -> return False+    Left e            -> throwM e++-- | Attempt to perform the given update. If no rows were updated, insert the+--   given rowr.+--+--   Note that this may perform two separate queries: one update, potentially+--   followed by one insert.+upsert :: ( MonadCatch m+          , MonadSelda m+          , Insert a+          , Columns (Cols s a)+          , Result (Cols s a)+          )+       => Table a+       -> (Cols s a -> Col s Bool)+       -> (Cols s a -> Cols s a)+       -> [a]+       -> m ()+upsert tbl check upd rows = do+  updated <- update tbl check upd+  when (updated == 0) $ insert_ tbl rows  -- | Like 'insert', but does not return anything. --   Use this when you really don't care about how many rows were inserted.
src/Database/Selda/Generic.hs view
@@ -25,7 +25,7 @@   , GenAttr (..), GenTable (..), Attribute, Relation   , genTable, toRel, toRels, fromRel, fromRels   , insertGen, insertGen_, insertGenWithPK-  , primaryGen, autoPrimaryGen+  , primaryGen, autoPrimaryGen, uniqueGen, fkGen   ) where import Control.Monad.State import Data.Dynamic@@ -33,9 +33,10 @@ import GHC.Generics hiding (R, (:*:), Selector) import qualified GHC.Generics as G ((:*:)(..), Selector) import Unsafe.Coerce-import Database.Selda+import Database.Selda hiding (from) import Database.Selda.Table import Database.Selda.Types+import Database.Selda.Selectors import Database.Selda.SqlType  -- | Any type which has a corresponding relation.@@ -110,6 +111,11 @@           | f :- Attribute as <- attrs           , identify dummy f == n           ]+      , colFKs = colFKs ci +++          [ thefk+          | f :- ForeignKey thefk <- attrs+          , identify dummy f == n+          ]       }  -- | Convert a generic type into the corresponding database relation.@@ -183,15 +189,25 @@ insertGen_ t = void . insertGen t  -- | Some attribute that may be set on a table column.-newtype Attribute = Attribute [ColAttr]+data Attribute+  = Attribute [ColAttr]+  | ForeignKey (Table (), ColName)  -- | A primary key which does not auto-increment. primaryGen :: Attribute-primaryGen = Attribute [Primary, Required]+primaryGen = Attribute [Primary, Required, Unique]  -- | An auto-incrementing primary key. autoPrimaryGen :: Attribute-autoPrimaryGen = Attribute [Primary, AutoIncrement, Required]+autoPrimaryGen = Attribute [Primary, AutoIncrement, Required, Unique]++-- | A table-unique value.+uniqueGen :: Attribute+uniqueGen = Attribute [Unique]++-- | 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))  -- | A dummy of some type. Encapsulated to avoid improper use, since all of --   its fields are 'unsafeCoerce'd ints.
src/Database/Selda/Inner.hs view
@@ -3,6 +3,7 @@ -- | Helpers for working with inner queries. module Database.Selda.Inner where import Database.Selda.Column+import Database.Selda.SQL (SQL) import Database.Selda.Types import Data.Text (Text) import Data.Typeable@@ -11,7 +12,7 @@ --   Aggregate columns may not be used to restrict queries. --   When returned from an 'aggregate' subquery, an aggregate column is --   converted into a non-aggregate column.-newtype Aggr s a = Aggr {unAggr :: Exp a}+newtype Aggr s a = Aggr {unAggr :: Exp SQL a}  -- | Denotes an inner query. --   For aggregation, treating sequencing as the cartesian product of queries@@ -56,7 +57,7 @@  -- | One or more aggregate columns. class Aggregates a where-  unAggrs :: a -> [SomeCol]+  unAggrs :: a -> [SomeCol SQL] instance Aggregates (Aggr (Inner s) a) where   unAggrs (Aggr x) = [Some x] instance Aggregates b => Aggregates (Aggr (Inner s) a :*: b) where
src/Database/Selda/Query.hs view
@@ -3,7 +3,7 @@ module Database.Selda.Query   (select, selectValues   , restrict, groupBy, limit, order-  , aggregate, leftJoin, inner, suchThat+  , aggregate, leftJoin, innerJoin   ) where import Database.Selda.Column import Database.Selda.Inner@@ -133,24 +133,13 @@ leftJoin = someJoin LeftJoin  -- | Perform an @INNER JOIN@ with the current result set and the given query.-inner :: (Columns a, Columns (OuterCols a))-      => (OuterCols a -> Col s Bool)-            -- ^ Predicate determining which lines to join.-            -- | Right-hand query to join.-      -> Query (Inner s) a-      -> Query s (OuterCols a)-inner = someJoin InnerJoin---- | Synonym for 'inner' for infix use:------ > person <- select people--- > home <- select homes `suchThat` \home -> home ! owner .== person ! name--- > return (person ! name :*: home ! isApartment)-suchThat :: (Columns a, Columns (OuterCols a))-         => (OuterCols a -> Col s Bool)-         -> Query (Inner s) a-         -> Query s (OuterCols a)-suchThat = inner+innerJoin :: (Columns a, Columns (OuterCols a))+          => (OuterCols a -> Col s Bool)+             -- ^ Predicate determining which lines to join.+             -- | Right-hand query to join.+          -> Query (Inner s) a+          -> Query s (OuterCols a)+innerJoin = someJoin InnerJoin  -- | The actual code for any join. someJoin :: (Columns a, Columns (OuterCols a), Columns a')
src/Database/Selda/Query/Type.hs view
@@ -31,8 +31,8 @@ --   for column renaming. data GenState = GenState   { sources         :: ![SQL]-  , staticRestricts :: ![Exp Bool]-  , groupCols       :: ![SomeCol]+  , staticRestricts :: ![Exp SQL Bool]+  , groupCols       :: ![SomeCol SQL]   , nameSupply      :: !Int   } @@ -46,7 +46,7 @@   }  -- | Generate a unique name for the given column.-rename :: SomeCol -> State GenState SomeCol+rename :: SomeCol sql -> State GenState (SomeCol sql) rename (Some col) = do     n <- freshId     return $ Named (newName n) col
src/Database/Selda/SQL.hs view
@@ -1,20 +1,20 @@-{-# LANGUAGE GADTs, OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE GADTs, OverloadedStrings, ScopedTypeVariables, RecordWildCards #-} {-# LANGUAGE TypeOperators, FlexibleInstances, UndecidableInstances #-} -- | SQL AST and parameters for prepared statements. module Database.Selda.SQL where-import Database.Selda.Column+import Database.Selda.Exp import Database.Selda.SqlType import Database.Selda.Types import Control.Exception-import Data.Monoid+import Data.Monoid hiding (Product) import System.IO.Unsafe  -- | A source for an SQL query. data SqlSource  = TableName !TableName  | Product ![SQL]- | Join !JoinType !(Exp Bool) !SQL !SQL- | Values ![SomeCol] ![[Param]]+ | Join !JoinType !(Exp SQL Bool) !SQL !SQL+ | Values ![SomeCol SQL] ![[Param]]  | EmptyTable  -- | Type of join to perform.@@ -22,13 +22,30 @@  -- | AST for SQL queries. data SQL = SQL-  { cols      :: ![SomeCol]+  { cols      :: ![SomeCol SQL]   , source    :: !SqlSource-  , restricts :: ![Exp Bool]-  , groups    :: ![SomeCol]-  , ordering  :: ![(Order, SomeCol)]+  , restricts :: ![Exp SQL Bool]+  , groups    :: ![SomeCol SQL]+  , ordering  :: ![(Order, SomeCol SQL)]   , limits    :: !(Maybe (Int, Int))   }++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 (EmptyTable)   = []++instance Names SQL where+  -- Note that we don't include @cols@ here: the names in @cols@ are not+  -- necessarily used, only declared.+  allNamesIn (SQL{..}) = concat+    [ allNamesIn groups+    , concatMap (allNamesIn . snd) ordering+    , allNamesIn restricts+    , allNamesIn source+    ]  -- | The order in which to sort result rows. data Order = Asc | Desc
src/Database/Selda/SQL/Print.hs view
@@ -42,14 +42,14 @@ compSql typetr = runPP typetr . ppSql  -- | Compile a single column expression.-compExp :: (Text -> Text) -> Exp a -> (Text, [Param])+compExp :: (Text -> Text) -> Exp SQL a -> (Text, [Param]) compExp typetr = snd . runPP typetr . ppCol  -- | Compile an @UPATE@ statement. compUpdate :: (Text -> Text)            -> TableName-           -> Exp Bool-           -> [(ColName, SomeCol)]+           -> Exp SQL Bool+           -> [(ColName, SomeCol SQL)]            -> (Text, [Param]) compUpdate typetr tbl p cs = snd $ runPP typetr ppUpd   where@@ -76,7 +76,7 @@         us' -> Text.intercalate ", " us'  -- | Compile a @DELETE@ statement.-compDelete :: TableName -> Exp Bool -> (Text, [Param])+compDelete :: TableName -> Exp SQL Bool -> (Text, [Param]) compDelete tbl p = snd $ runPP id ppDelete   where     ppDelete = do@@ -130,7 +130,7 @@     ]   where     result []  = "1"-    result cs' = Text.intercalate "," cs'+    result cs' = Text.intercalate ", " cs'      ppSrc EmptyTable = do       qn <- freshQueryName@@ -145,7 +145,7 @@       qs <- flip mapM ["(" <> s <> ")" | s <- srcs] $ \q -> do         qn <- freshQueryName         pure (q <> " AS " <> qn)-      pure $ " FROM " <> Text.intercalate "," qs+      pure $ " FROM " <> Text.intercalate ", " qs     ppSrc (Values row rows) = do       row' <- Text.intercalate ", " <$> mapM ppSomeCol row       rows' <- mapM ppRow rows@@ -198,18 +198,18 @@      ppInt = Text.pack . show -ppSomeCol :: SomeCol -> PP Text+ppSomeCol :: SomeCol SQL -> PP Text ppSomeCol (Some c)    = ppCol c ppSomeCol (Named n c) = do   c' <- ppCol c   pure $ c' <> " AS " <> fromColName n -ppCols :: [Exp Bool] -> PP Text+ppCols :: [Exp SQL Bool] -> PP Text ppCols cs = do   cs' <- mapM ppCol (reverse cs)   pure $ "(" <> Text.intercalate ") AND (" cs' <> ")" -ppCol :: Exp a -> PP Text+ppCol :: Exp SQL a -> PP Text ppCol (TblCol xs)    = error $ "compiler bug: ppCol saw TblCol: " ++ show xs ppCol (Col name)     = pure (fromColName name) ppCol (Lit l)        = ppLit l@@ -224,8 +224,16 @@   x' <- ppCol x   t' <- ppType t   pure $ mconcat ["CAST(", x', " AS ", t', ")"]+ppCol (InList x xs) = do+  x' <- ppCol x+  xs' <- mapM ppCol xs+  pure $ mconcat [x', " IN (", Text.intercalate ", " xs', ")"]+ppCol (InQuery x q) = do+  x' <- ppCol x+  q' <- ppSql q+  pure $ mconcat [x', " IN (", q', ")"] -ppUnOp :: UnOp a b -> Exp a -> PP Text+ppUnOp :: UnOp a b -> Exp SQL a -> PP Text ppUnOp op c = do   c' <- ppCol c   pure $ case op of@@ -236,13 +244,13 @@     IsNull -> "(" <> c' <> ") IS NULL"     Fun f  -> f <> "(" <> c' <> ")" -ppBinOp :: BinOp a b -> Exp a -> Exp a -> PP Text+ppBinOp :: BinOp a b -> Exp SQL a -> Exp SQL a -> PP Text ppBinOp op a b = do     a' <- ppCol a     b' <- ppCol b     pure $ paren a a' <> " " <> ppOp op <> " " <> paren b b'   where-    paren :: Exp a -> Text -> Text+    paren :: Exp SQL a -> Text -> Text     paren (Col{}) c = c     paren (Lit{}) c = c     paren _ c       = "(" <> c <> ")"
src/Database/Selda/SqlType.hs view
@@ -6,9 +6,10 @@   , compLit   , sqlDateTimeFormat, sqlDateFormat, sqlTimeFormat   ) where+import Data.Proxy import Data.Text (Text, pack, unpack) import Data.Time-import Data.Proxy+import Data.Typeable  -- | Format string used to represent date and time when --   talking to the database backend.@@ -26,7 +27,7 @@ sqlTimeFormat = "%H:%M:%S%Q"  -- | Any datatype representable in (Selda's subset of) SQL.-class SqlType a where+class Typeable a => SqlType a where   mkLit        :: a -> Lit a   sqlType      :: Proxy a -> Text   fromSql      :: SqlValue -> a
src/Database/Selda/Transform.hs view
@@ -39,7 +39,7 @@  -- | Get all column names appearing in the given list of (possibly complex) --   columns.-colNames :: [SomeCol] -> [ColName]+colNames :: [SomeCol SQL] -> [ColName] colNames cs = concat   [ [n | Some c <- cs, n <- allNamesIn c]   , [n | Named _ c <- cs, n <- allNamesIn c]@@ -71,7 +71,7 @@   SQL (allCols ss) (Product ss) srs [] [] Nothing  -- | Get all output columns from a list of SQL ASTs.-allCols :: [SQL] -> [SomeCol]+allCols :: [SQL] -> [SomeCol SQL] allCols sqls = [outCol col | sql <- sqls, col <- cols sql]   where     outCol (Named n _) = Some (Col n)