selda 0.5.1.0 → 0.5.2.0

raw patch · 35 files changed

+799/−698 lines, 35 filesdep −ghc-primdep ~basedep ~bytestringdep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: ghc-prim

Dependency ranges changed: base, bytestring, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +0/−239
• LICENSE +0/−21
• README.md +0/−148
• selda.cabal +7/−18
• src/Database/Selda.hs +158/−19
• src/Database/Selda/Backend.hs +60/−5
• src/Database/Selda/Backend/Internal.hs +38/−17
• src/Database/Selda/Column.hs +15/−7
• src/Database/Selda/Compile.hs +21/−11
• src/Database/Selda/Debug.hs +3/−1
• src/Database/Selda/Exp.hs +3/−3
• src/Database/Selda/FieldSelectors.hs +9/−7
• src/Database/Selda/Frontend.hs +33/−7
• src/Database/Selda/Generic.hs +27/−14
• src/Database/Selda/Inner.hs +4/−3
• src/Database/Selda/MakeSelectors.hs +9/−8
• src/Database/Selda/Migrations.hs +16/−7
• src/Database/Selda/Nullable.hs +20/−2
• src/Database/Selda/Prepared.hs +21/−7
• src/Database/Selda/Query.hs +69/−9
• src/Database/Selda/Query/Type.hs +4/−5
• src/Database/Selda/SQL.hs +16/−14
• src/Database/Selda/SQL/Print.hs +24/−7
• src/Database/Selda/SQL/Print/Config.hs +6/−4
• src/Database/Selda/Selectors.hs +3/−2
• src/Database/Selda/SqlRow.hs +9/−3
• src/Database/Selda/SqlType.hs +116/−49
• src/Database/Selda/Table.hs +15/−18
• src/Database/Selda/Table/Compile.hs +18/−6
• src/Database/Selda/Table/Type.hs +2/−2
• src/Database/Selda/Table/Validation.hs +10/−7
• src/Database/Selda/Transform.hs +20/−14
• src/Database/Selda/Types.hs +2/−2
• src/Database/Selda/Unsafe.hs +19/−3
• src/Database/Selda/Validation.hs +22/−9

@@ -1,239 +0,0 @@-# 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)-* Custom type errors for scope mismatches.-* Provide Generic instances for ID and RowID.-* Provide To/FromJSON instances for ID and RowID (selda-json).-* Add back MonadTrans instance for SeldaT.---## 0.4.0.0 -- 2019-06-02--* Type-safe support for backend-specific functionality. Top level query definitions now require explicit type signature. (#80)-* Native UUID support. (#47)-* Support JSON columns on all backends through aeson.-* Support JSON lookups (i.e. SELECT json_column.some_property FROM ...) on PostgreSQL.-* Multi-column primary key and uniqueness constraint support. (#25, #99)-* Switch to PostgreSQL binary protocol. (#18)-* Prevent dangerous user-defined SQL result instances.-* Expose backend internals through Database.Selda.Backend.Internal. (#109)-* Expose SQLite connection handle. (#101)-* Make MonadSelda more amenable to connection pooling. (#108)-* Add weakly auto-incrementing primary keys. (#94)-* Move compile* functions to Database.Selda.Debug.-* Remove half the tuple convenience functions.-* Remove in-process cache. (#117)-* Officially support GHC 8.6, 8.8 (SQLite only until postgres dependencies catch up with 8.8).-* Drop support for GHC 7.10. (#118)-* Manual (i.e. non record label) selectors are no longer exported by default; import Database.Selda.MakeSelectors is you need them. (#118)-* Update toolchain to use v2-style cabal commands.-* Fix date/time types for PostgreSQL. (#104)-* Fix bug when migrating tables with indexes. (#107)-* Misc. smaller bug fixes.---## 0.3.4.0 -- 2018-09-29--* Added convenience functions for working with nullable columns.---## 0.3.3.1 -- 2018-09-04--* DISTINCT should now always return distinct results.-* DISTINCT can no longer produce ill-scoped queries.---## 0.3.3.0 -- 2018-09-01--* Ad hoc selectors using OverloadedLabels.-* Shorter build times.-* Minor API updates and simplifications.---## 0.3.2.0 -- 2018-08-07--* Some aggregates are now nullable.-* sum_ on an empty table doesn't crash anymore.-* Aggregating over an empty selectValues doesn't crash anymore.---## 0.3.1.0 -- 2018-08-06--* Minor API fix when defining table attributes.---## 0.3.0.0 -- 2018-08-05--* Support for Stack and GHC 8.4.-* Precedence fix for selector index (!) operator.-* Accept INT and SMALLINT columns in user-created PostgreSQL tables.-* Add combinator for turning off foreign key checking.-* Rename unsafeRowId/unsafeId to toRowId/rowId.-* Add typed row identifiers.-* More generic type for sum_.-* Table validation against current database.-* Basic migration support.-* Basic index support.-* Remove ad hoc tables; only generic tables from now on.---## 0.2.0.0 -- 2018-04-02--* Support custom column names for generic tables.-* Scope safety fix for inner queries.-* Better type errors on GHC 8+ for inner queries.---## 0.1.12.1 -- 2018-02-27--* New PPConfig hook for more flexibility when compiling types.---## 0.1.12.0 -- 2018-01-11--* Allow recursive and optional foreign keys.-* Allow arbitrary enums in tables, represented as text.-* Fix RowID issues for PostgreSQL.-* Fix auto-incrementing primary keys for generic tables.---## 0.1.11.2 -- 2017-12-14--* Fix treatment of booleans in PostgreSQL backend.---## 0.1.11.1 -- 2017-10-10--* Fix rare infinite loop bug in in-process cache.---## 0.1.11.0 -- 2017-09-08--* Fix name generation in the presence of isIn over queries.-* SELECT DISTINCT support.-* Conditional expressions and matchNull.---## 0.1.10.1 -- 2017-08-11--* Fix name generation in the presence of multiple aggregates.---## 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.-* Export conditional inserts.-* Fix Haste build for backends.---## 0.1.8.0 -- 2017-06-10--* Move SQL pretty-printing config into a single type.-* Support for binary blobs.-* Support for prepared statements.-* Support for connection reuse across Selda computations.-* Cleaner and more robust backend API.-* Stricter type constraints on comparisons.-* Allow limit on inner queries.-* Allow inspecting row identifiers.---## 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.-* 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.-* More sensible names in backend API.-* Fix rounding and casts.---## 0.1.4.1 -- 2017-05-04--* Fix cache consistency bug in the presence of multiple databases.---## 0.1.4.0 -- 2017-05-04--* Add uniqueness constraints and foreign keys.---## 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.-* Allow default insertions on all columns.-* More sensible API for LIMIT.-* Fix broken SQL being generated for pathological corner cases.-* Documentation fixes.---## 0.1.2.0 -- 2017-04-20--* Replace `¤` with `:*:` in table definitions.---## 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.-* Tutorial updates.-* Minor bugfixes.---## 0.1.0.0 -- 2017-04-14--* Initial release.

@@ -1,21 +0,0 @@-MIT License--Copyright (c) 2017-2019 Anton Ekblad--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-SOFTWARE.

@@ -1,148 +0,0 @@-Selda-=====--[![Join the chat at https://gitter.im/selda-hs/Lobby](https://badges.gitter.im/selda-hs/Lobby.svg)](https://gitter.im/selda-hs/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)-[![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)-![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)](https://packdeps.haskellers.com/feed?needle=selda)---What is Selda?-==============-[Selda](https://selda.link) is a Haskell library for interacting with SQL-based relational databases.-It was inspired by [LINQ](https://en.wikipedia.org/wiki/Language_Integrated_Query) and-[Opaleye](http://hackage.haskell.org/package/opaleye).---Features-========--* Monadic interface.-* Portable: backends for SQLite and PostgreSQL.-* Generic: easy integration with your existing Haskell types.-* 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.-* Type-safe, backend-specific functionality, such as JSON lookups.-* Seamless prepared statements.-* Lightweight and modular: few dependencies, and non-essential features are-  optional or split into add-on packages.---Getting started-===============--Install the `selda` package from Hackage, as well as at least one of the-backends:--    $ cabal update-    $ cabal install selda selda-sqlite selda-postgresql--Then, read [the tutorial](https://selda.link/tutorial).-The [API documentation](http://hackage.haskell.org/package/selda) will probably-also come in handy.---Requirements-============--Selda requires GHC 8.0+, as well as SQLite 3.7.11+ or PostgreSQL 9.4+.-To build the SQLite backend, you need a C compiler installed.-To build the PostgreSQL backend, you need the `libpq` development libraries-installed (`libpq-dev` on Debian-based Linux distributions).--Hacking-=======--Contributing---------------All forms of contributions are welcome!--If you have a bug to report, please try to include as much information as-possible, preferably including:--* A brief description (one or two sentences) of the bug.-* The version of Selda+backend where the bug was found.-* A step-by-step guide to reproduce the bug.-* The *expected* result from following these steps.-* What *actually* happens when following the steps.-* Which component contains the bug (selda, selda-sqlite or selda-postgresql),-  if you're reasonably sure about where the bug is.--Bonus points for a small code example that illustrates the problem.--If you want to contribute code, please consult the following checklist before-sending a pull request:--* Does the code build with a recent version of GHC?-* Do all the tests pass?-* Have you added any tests covering your code?--If you want to contribute code but don't really know where to begin,-issues tagged [good first issue](https://github.com/valderman/selda/issues?q=is%3Aissue+is%3Aopen+label%3A%22good+first+issue%22) are a good start.---Setting up the build environment-----------------------------------From the repository root:--* Install `libpq-dev` from your package manager.-    This is required to build the PostgreSQL backend.-* Make sure you're running a cabal version that supports v2-style commands.-* Familiarise yourself with the various targets in the makefile.-    The dependencies between Selda, the backends and the tests are slightly-    complex, so straight-up cabal is too quirky for day to day hacking.---Setting up a VM for PostgreSQL testing-----------------------------------------While the SQLite backend is completely self-contained, the PostgreSQL backend-needs an appropriate server for testing. Setting this up in a virtual machine-is definitely less intrusive than setting up a server on your development-machine. To set up a VM for the PostgreSQL backend tests:--* Install your favourite hypervisor, such as VMWare player or VirtualBox.-* Download a pre-built PostgreSQL VM from-    [Bitnami](https://bitnami.com/stack/postgresql/virtual-machine).-* Import the OVA file into your hypervisor.-* Change the network settings of your newly imported VM to NAT, and make sure-    that port 5432 is forwarded. Note that this will conflict with any PostgreSQL-    server running on your machine while the VM is running.-* Boot your VM and note the password displayed on the login screen.-* Create the file `selda-tests/PGConnectInfo.hs` with the following content:-    ```haskell-    {-# LANGUAGE OverloadedStrings #-}-    module PGConnectInfo where-    import Database.Selda.PostgreSQL-    -    pgConnectInfo = "test" `on` "localhost" `auth` ("postgres", "$PASSWORD")-    ```-    Where `$PASSWORD` is the password from the VM's login screen.-* Log in to the VM and disable the built-in firewall by running-    `sudo systemctl disable ufw ; sudo systemctl stop ufw`.-* From your host machine, create the test database:-    ```-    $ psql -h 127.0.0.1 -U postgres -W-    [password from login screen]-    # CREATE DATABASE test;-    # \q-    ```-* Run `make pgtest` to check that everything works.---TODOs--------Features that would be nice to have but are not yet implemented.--* Monadic if/else-* Streaming-* MySQL/MariaDB backend-* MSSQL backend

@@ -1,5 +1,5 @@ name:                selda-version:             0.5.1.0+version:             0.5.2.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,@@ -7,23 +7,18 @@                      support.                       See the project website for a comprehensive tutorial.-                     +                      To use this package you need at least one backend package, in addition to                      this package. There are currently two different backend packages:                      selda-sqlite and selda-postgresql. homepage:            https://selda.link license:             MIT-license-file:        LICENSE author:              Anton Ekblad maintainer:          anton@ekblad.cc category:            Database build-type:          Simple-extra-source-files:  ChangeLog.md cabal-version:       >=1.10-tested-with:         GHC == 8.0.2, GHC == 8.4.1, GHC == 8.6.3, GHC == 8.8.1--extra-source-files:-  README.md+tested-with:         GHC == 8.8.2, GHC == 8.10.1, GHC == 9.0.2, GHC == 9.2.3  source-repository head   type:     git@@ -76,24 +71,18 @@     GeneralizedNewtypeDeriving     FlexibleContexts   build-depends:-      base       >=4.9  && <5-    , bytestring >=0.10 && <0.11+      base       >=4.10 && <5+    , bytestring >=0.10 && <0.12     , exceptions >=0.8  && <0.11     , mtl        >=2.0  && <2.3     , text       >=1.0  && <1.3-    , time       >=1.5  && <1.10+    , time       >=1.5  && <1.12     , containers >=0.4  && <0.7-    , random     >=1.1  && <1.2+    , random     >=1.1  && <1.3     , uuid-types >=1.0  && <1.1-  if impl(ghc < 8.1) && impl(ghc >= 8.0)-    build-depends:-      ghc-prim >= 0.5.0.0   hs-source-dirs:     src   default-language:     Haskell2010   ghc-options:     -Wall-  if impl(ghc > 8.0)-    ghc-options:-      -fno-warn-redundant-constraints

@@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables, TypeOperators, GADTs, FlexibleContexts #-} {-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, TypeFamilies, CPP #-} {-# LANGUAGE DataKinds #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Selda is not LINQ, but they're definitely related. -- --   Selda is a high-level EDSL for interacting with relational databases.@@ -31,7 +32,7 @@   , newUuid      -- * Constructing queries-  , SqlType (..), SqlRow (..), SqlEnum (..)+  , SqlType (..), SqlRow (..), GSqlRow, SqlEnum (..)   , Columns, Same   , Order (..)   , (:*:)(..)@@ -39,7 +40,7 @@   , restrict, limit   , order, ascending, descending   , orderRandom-  , inner, suchThat+  , union, unionAll, inner, suchThat      -- * Working with selectors   , Selector, Coalesce@@ -48,14 +49,16 @@   , (+=), (-=), (*=), (||=), (&&=), ($=)      -- * Expressions over columns-  , Set (..)+  , Set (..), Monoid (..), Semigroup (..)   , ID, invalidId, isInvalidId, untyped, fromId, toId+  , IsUUID (..), UUID', typedUuid, untypedUuid   , RowID, invalidRowId, isInvalidRowId, fromRowId, toRowId   , (.==), (./=), (.>), (.<), (.>=), (.<=), like   , (.&&), (.||), not_   , literal, is, int, float, text, true, false, null_   , roundTo, length_, isNull, ifThenElse, ifNull, matchNull-  , new, only+  , toUpper, toLower+  , new, row, only   , Mappable (..)      -- * Converting between column types@@ -100,33 +103,137 @@   , Text, Day, TimeOfDay, UTCTime, UUID   ) where import Control.Monad.Catch (MonadMask)-import Data.Typeable (Typeable)-import Database.Selda.Backend+import Data.Typeable ( Typeable, eqT, (:~:)(..) )+import Database.Selda.Backend.Internal+    ( SqlType(..),+      SeldaM,+      SeldaT,+      MonadSelda(Backend),+      SeldaError(..) )+import Database.Selda.SqlType+    ( UUID,+      UUID'(..),+      ID(..),+      RowID,+      SqlEnum(..),+      invalidRowId,+      isInvalidRowId,+      toRowId,+      fromRowId,+      typedUuid,+      toId,+      fromId,+      invalidId,+      isInvalidId )+import Database.Selda.Table.Type ( IndexMethod(..) )+import Database.Selda.Types+    ( TableName,+      ColName,+      Tup,+      Head,+      type (:*:)(..),+      first,+      second,+      third,+      fourth,+      fifth ) import Database.Selda.Column+    ( BinOp(Like, Eq, Neq, Gt, Lt, Gte, Lte, And, Or),+      UnOp(Not, IsNull),+      Exp(If, InQuery, InList, BinOp, UnOp),+      UntypedCol(Untyped),+      Same(..),+      Row(..),+      Col(..),+      Columns,+      literal,+      liftC3,+      liftC ) import Database.Selda.Compile+    ( Result, Res, compQueryWithFreshScope ) import Database.Selda.FieldSelectors+    ( IsLabel, HasField, FieldType ) import Database.Selda.Frontend+    ( MonadIO(..),+      query,+      queryInto,+      insert,+      tryInsert,+      upsert,+      insertUnless,+      insertWhen,+      insert_,+      insertWithPK,+      update,+      update_,+      deleteFrom,+      deleteFrom_,+      createTable,+      tryCreateTable,+      dropTable,+      tryDropTable,+      transaction,+      withoutForeignKeyEnforcement ) import Database.Selda.Generic+    ( Generic, gRow, gNew, Relational, def ) import Database.Selda.Inner-import Database.Selda.Prepared+    ( Aggregates,+      LeftCols,+      AggrCols,+      OuterCols,+      Inner,+      Aggr,+      liftAggr,+      aggr )+import Database.Selda.Prepared ( Prepare, Preparable, prepared ) import Database.Selda.Query-import Database.Selda.Query.Type+    ( select,+      selectValues,+      union,+      unionAll,+      restrict,+      aggregate,+      leftJoin,+      innerJoin,+      groupBy,+      limit,+      order,+      orderRandom,+      distinct )+import Database.Selda.Query.Type ( Query ) import Database.Selda.Selectors-import Database.Selda.SQL hiding (distinct)-import Database.Selda.SqlRow+    ( Selector, Assignment(..), Coalesce, (!), (?), ($=), with )+import Database.Selda.SQL ( Order(..) )+import Database.Selda.SqlRow ( GSqlRow, SqlRow(..) ) import Database.Selda.Table-import Database.Selda.Table.Validation-import Database.Selda.Types-import Database.Selda.Unsafe-import Data.Proxy+    ( Table(tableName),+      ForeignKey(..),+      Attribute,+      SelectorLike,+      Attr(..),+      Group(..),+      table,+      tableFieldMod,+      primary,+      index,+      indexUsing,+      autoPrimary,+      weakAutoPrimary,+      untypedAutoPrimary,+      weakUntypedAutoPrimary,+      unique )+import Database.Selda.Table.Validation ( ValidationError )+import Database.Selda.Unsafe ( cast, fun, fun2, operator )+import Data.Proxy ( Proxy(..) ) import Data.String (IsString) import Data.Text (Text) import Data.Time (Day, TimeOfDay, UTCTime)-import Data.Typeable (eqT, (:~:)(..)) import GHC.Generics (Rep)-import Unsafe.Coerce+import qualified GHC.Generics as G (from)+import Unsafe.Coerce ( unsafeCoerce ) import System.Random (randomIO) import GHC.TypeLits as TL+    ( TypeError, ErrorMessage(Text, (:<>:), ShowType, (:$$:)) )  -- | Any column type that can be used with the 'min_' and 'max_' functions. class SqlType a => SqlOrd a@@ -167,14 +274,22 @@   fromSql = error "unreachable"   defaultValue = error "unreachable" +-- | Any type which is backed by an UUID.+class IsUUID a where+  uuid :: UUID -> a+instance IsUUID UUID where+  uuid = id+instance IsUUID (UUID' a) where+  uuid = typedUuid+ -- | Generate a new random UUID using the system's random number generator. --   UUIDs generated this way are (astronomically likely to be) unique, --   but not necessarily unpredictable. -- --   For applications where unpredictability is crucial, take care to use a --   proper cryptographic PRNG to generate your UUIDs.-newUuid :: MonadIO m => m UUID-newUuid = liftIO randomIO+newUuid :: (MonadIO m, IsUUID uuid) => m uuid+newUuid = uuid <$> liftIO randomIO  -- | Annotation to force the type of a polymorphic label (i.e. @#foo@) to --   be a selector. This is useful, for instance, when defining unique@@ -227,11 +342,19 @@ only :: SqlType a => Col s a -> Row s (Only a) only (One x)  = Many [Untyped x] --- | Create a new column with the given fields.+-- | Create a new row with the given fields. --   Any unassigned fields will contain their default values. new :: forall s a. Relational a => [Assignment s a] -> Row s a new fields = Many (gNew (Proxy :: Proxy (Rep a))) `with` fields +-- | Create a new row from the given value.+--   This can be useful when you want to update all or most of a row:+--+-- > update users (#uid `is` user_id)+-- >              (\old -> row user_info `with` [...])+row :: forall s a. Relational a => a -> Row s a+row x = Many (gRow (G.from x))+ -- | Convenient shorthand for @fmap (! sel) q@. --   The following two queries are quivalent: --@@ -456,6 +579,22 @@ -- | Convert any SQL type to a string. toString :: SqlType a => Col s a -> Col s Text toString = cast++-- | Convert the given string to uppercase.+toUpper :: Col s Text -> Col s Text+toUpper = fun "UPPER"++-- | Convert the given string to lowercase.+toLower :: Col s Text -> Col s Text+toLower = fun "LOWER"++instance Semigroup (Col s Text) where+  (<>) = operator "||"+instance Monoid (Col s Text) where+  mempty = ""+++  -- | Perform a conditional on a column ifThenElse :: (Same s t, Same t u, SqlType a) => Col s Bool -> Col t a -> Col u a -> Col s a

@@ -15,14 +15,69 @@   , runSeldaT, seldaClose   , module SqlType   ) where-import Control.Monad-import Control.Monad.Catch-import Control.Monad.IO.Class-import Data.IORef+import Control.Monad ( unless )+import Control.Monad.Catch ( mask_ )+import Control.Monad.IO.Class ( MonadIO(..) )+import Data.IORef ( atomicModifyIORef' ) import Database.Selda.Backend.Internal+    ( Param(..),+      ColAttr(..),+      AutoIncType(..),+      isAutoPrimary,+      isPrimary,+      isUnique,+      PPConfig(..),+      defPPConfig,+      SeldaM,+      SeldaT,+      MonadSelda(..),+      SeldaBackend(..),+      ColumnInfo(..),+      TableInfo(..),+      SeldaConnection(connClosed, connBackend),+      QueryRunner,+      StmtID,+      SeldaError(..),+      BackendID(..),+      newConnection,+      allStmts,+      fromColInfo,+      tableInfo,+      withBackend,+      runSeldaT ) import Database.Selda.SqlType as SqlType-import Database.Selda.Table (IndexMethod (..))+    ( UUID,+      UUID'(..),+      ID(..),+      RowID,+      SqlValue(..),+      Lit(..),+      SqlEnum(..),+      SqlType(..),+      SqlTypeRep(..),+      sqlDateTimeFormat,+      sqlDateFormat,+      sqlTimeFormat,+      litType,+      compLit,+      invalidRowId,+      isInvalidRowId,+      toRowId,+      fromRowId,+      typedUuid,+      toId,+      fromId,+      invalidId,+      isInvalidId )+import Database.Selda.Table.Type ( IndexMethod(..) ) import Database.Selda.Types+    ( TableName,+      ColName,+      fromColName,+      fromTableName,+      rawTableName,+      mkColName,+      mkTableName )  -- | Close a reusable Selda connection. --   Closing a connection while in use is undefined.

@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, DefaultSignatures, CPP, TypeFamilies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, CPP, TypeFamilies #-} -- | Internal backend API. --   Using anything exported from this module may or may not invalidate any --   safety guarantees made by Selda; use at your own peril.@@ -20,23 +20,41 @@ import Data.List (nub) import Database.Selda.SQL (Param (..)) import Database.Selda.SqlType-import Database.Selda.Table hiding (colName, colType, colFKs)-import qualified Database.Selda.Table as Table (ColInfo (..))+    ( SqlValue(..),+      Lit(..),+      SqlType(..),+      SqlTypeRep(..),+      sqlDateTimeFormat,+      sqlDateFormat,+      sqlTimeFormat )+import Database.Selda.Table.Type+    ( ColAttr(..),+      AutoIncType(..),+      Table(Table, tableAttrs, tableName, tableCols),+      isAutoPrimary,+      isPrimary,+      isUnique )+import qualified Database.Selda.Table.Type as Table ( ColInfo(..) ) import Database.Selda.SQL.Print.Config+    ( PPConfig(..), defPPConfig ) import Database.Selda.Types (TableName, ColName)-import Control.Concurrent+import Data.Int (Int64)+import Control.Concurrent ( newMVar, putMVar, takeMVar, MVar ) import Control.Monad.Catch-import Control.Monad.IO.Class-import Control.Monad.State-import Data.Dynamic+    ( Exception, bracket, MonadCatch, MonadMask, MonadThrow(..) )+import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.Reader+    ( MonadTrans(..), when, ReaderT(..), MonadReader(ask) )+import Data.Dynamic ( Typeable, Dynamic ) import qualified Data.IntMap as M import Data.IORef+    ( IORef, atomicModifyIORef', newIORef, readIORef ) import Data.Text (Text) import System.IO.Unsafe (unsafePerformIO)-#if !MIN_VERSION_base(4, 13, 0)-import Control.Monad.Fail (MonadFail)-#endif +++ -- | Uniquely identifies some particular backend. -- --   When publishing a new backend, consider submitting a pull request with a@@ -126,8 +144,10 @@  -- | Comprehensive information about a table. data TableInfo = TableInfo-  { -- | Ordered information about each table column.-    tableColumnInfos :: [ColumnInfo]+  { -- | Name of the table.+    tableInfoName :: TableName+    -- | Ordered information about each table column.+  , tableColumnInfos :: [ColumnInfo]     -- | Unordered list of all (non-PK) uniqueness constraints on this table.   , tableUniqueGroups :: [[ColName]]     -- | Unordered list of all primary key constraints on this table.@@ -167,7 +187,8 @@ -- | Get the column information for each column in the given table. tableInfo :: Table a -> TableInfo tableInfo t = TableInfo-  { tableColumnInfos = map fromColInfo (tableCols t)+  { tableInfoName = tableName t+  , tableColumnInfos = map fromColInfo (tableCols t)   , tableUniqueGroups = uniqueGroups   , tablePrimaryKey = pkGroup   }@@ -197,7 +218,7 @@     -- | Execute an SQL statement and return the last inserted primary key,     --   where the primary key is auto-incrementing.     --   Backends must take special care to make this thread-safe.-  , runStmtWithPK :: Text -> [Param] -> IO Int+  , runStmtWithPK :: Text -> [Param] -> IO Int64      -- | Prepare a statement using the given statement identifier.   , prepareStmt :: StmtID -> [SqlTypeRep] -> Text -> IO Dynamic@@ -256,14 +277,14 @@ withBackend m = withConnection (m . connBackend)  -- | Monad transformer adding Selda SQL capabilities.-newtype SeldaT b m a = S {unS :: StateT (SeldaConnection b) m a}+newtype SeldaT b m a = S {unS :: ReaderT (SeldaConnection b) m a}   deriving ( Functor, Applicative, Monad, MonadIO            , MonadThrow, MonadCatch, MonadMask , MonadFail            )  instance (MonadIO m, MonadMask m) => MonadSelda (SeldaT b m) where   type Backend (SeldaT b m) = b-  withConnection m = S get >>= m+  withConnection m = S ask >>= m  instance MonadTrans (SeldaT b) where   lift = S . lift@@ -286,4 +307,4 @@       closed <- liftIO $ readIORef (connClosed c)       when closed $ do         liftIO $ throwM $ DbError "runSeldaT called with a closed connection"-      fst <$> runStateT (unS m) c+      runReaderT (unS m) c

@@ -12,14 +12,22 @@   , literal   ) where import Database.Selda.Exp-import Database.Selda.SQL-import Database.Selda.SqlType-import Database.Selda.SqlRow-import Database.Selda.Types-import Data.Proxy-import Data.String+    ( Names(allNamesIn),+      BinOp(..),+      UnOp(..),+      NulOp(..),+      Exp(..),+      UntypedCol(..),+      SomeCol(..),+      hideRenaming )+import Database.Selda.SQL ( SQL )+import Database.Selda.SqlType ( SqlType(mkLit) )+import Database.Selda.SqlRow ( SqlRow(nestedCols) )+import Database.Selda.Types ( type (:*:)(..), ColName )+import Data.Proxy ( Proxy(..) )+import Data.String ( IsString(..) ) import Data.Text (Text)-import GHC.TypeLits as TL+import GHC.TypeLits as TL ( TypeError, ErrorMessage(Text) )  -- | Any column tuple. class Columns a where

@@ -11,24 +11,34 @@   where import Control.Monad (liftM2) import Database.Selda.Column-import Database.Selda.Generic+    ( UntypedCol(Untyped),+      SomeCol(Some),+      Row(..),+      Col(..),+      Columns(toTup) )+import Database.Selda.Generic ( Relational, params ) import Database.Selda.Query.Type-import Database.Selda.SQL-import Database.Selda.SQL.Print+    ( GenState(nameSupply), Query, Scope, runQueryM )+import Database.Selda.SQL ( Param, SQL(SQL), SqlSource(Product) )+import Database.Selda.SQL.Print ( compSql, compUpdate, compDelete ) import Database.Selda.SQL.Print.Config+    ( PPConfig(ppMaxInsertParams), defPPConfig ) import Database.Selda.SqlRow-import Database.Selda.SqlType+    ( SqlRow(nextResult), ResultReader, runResultReader, next )+import Database.Selda.SqlType ( SqlValue, SqlType(fromSql) ) import Database.Selda.Table-import Database.Selda.Table.Compile+    ( ColInfo(colName), Table(tableCols, tableName), tableExpr )+import Database.Selda.Table.Compile ( compInsert ) import Database.Selda.Transform-import Database.Selda.Types-import Data.Proxy+    ( removeDeadCols, implicitlyLiveCols, colNames, state2sql )+import Database.Selda.Types ( type (:*:)(..) )+import Data.Proxy ( Proxy(..) ) import Data.Text (Text, empty) import Data.Typeable (Typeable)  -- For scope supply-import Data.IORef-import System.IO.Unsafe+import Data.IORef ( IORef, atomicModifyIORef', newIORef )+import System.IO.Unsafe ( unsafePerformIO )  -- | Compile a query into a parameterised SQL statement. --@@ -88,12 +98,12 @@ --   Groups are ignored, as they are only used by 'aggregate'. compQuery :: Result a => Scope -> Query s a -> (Int, SQL) compQuery ns q =-    (nameSupply st, SQL final (Product [srcs]) [] [] [] Nothing False)+    (nameSupply st, SQL final (Product [srcs]) [] [] [] Nothing [] False)   where     (cs, st) = runQueryM ns q     final = finalCols cs     sql = state2sql st-    live = colNames final ++ allNonOutputColNames sql+    live = colNames final ++ implicitlyLiveCols sql     srcs = removeDeadCols live sql  {-# NOINLINE scopeSupply #-}

@@ -5,6 +5,8 @@   , compileCreateTable, compileDropTable   , compileInsert, compileUpdate   ) where-import Database.Selda.Backend+import Database.Selda.SQL.Print.Config ( defPPConfig ) import Database.Selda.Compile+    ( compile, compileInsert, compileUpdate ) import Database.Selda.Table.Compile+    ( OnError(..), compileCreateTable, compileDropTable )

@@ -1,9 +1,9 @@ {-# LANGUAGE GADTs, FlexibleContexts, FlexibleInstances #-}-{-# LANGUAGE TypeOperators, CPP, DataKinds #-}+{-# LANGUAGE CPP, DataKinds #-} -- | The expression type underlying 'Col'. module Database.Selda.Exp where-import Database.Selda.SqlType-import Database.Selda.Types+import Database.Selda.SqlType ( Lit, SqlTypeRep )+import Database.Selda.Types ( ColName ) import Data.Text (Text)  -- | A type-erased column, which may also be renamed.

@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds, KindSignatures, TypeOperators, PolyKinds #-}+{-# LANGUAGE DataKinds, TypeOperators, PolyKinds #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables, AllowAmbiguousTypes, TypeFamilies #-} {-# LANGUAGE UndecidableInstances, ConstraintKinds, UndecidableSuperClasses #-}@@ -10,12 +10,14 @@   (FieldType, HasField, IsLabel   ) where import Database.Selda.Generic (Relational)-import Database.Selda.Selectors as S+import Database.Selda.Selectors as S ( Selector, unsafeSelector ) import Database.Selda.SqlType (SqlType) import Data.Kind (Constraint) import GHC.Generics+    ( Generic(Rep), K1, M1, type (:*:), S, Meta(MetaSel) ) import GHC.TypeLits-import GHC.OverloadedLabels+    ( Symbol, TypeError, ErrorMessage(Text, (:<>:), ShowType) )+import GHC.OverloadedLabels ( IsLabel(..) )  -- | Get the next nested type. type family GetFieldType (f :: * -> *) :: * where@@ -58,11 +60,11 @@  instance (Relational t, HasField name t, FieldType name t ~ a) =>          IsLabel name (S.Selector t a) where-#if MIN_VERSION_base(4, 10, 0)+   fromLabel = field @name @t-#else-  fromLabel _ = field @name @t-#endif+++  -- | Create a selector from a record selector and a type application. --

@@ -11,19 +11,45 @@   , transaction, withoutForeignKeyEnforcement   ) where import Database.Selda.Backend.Internal-import Database.Selda.Column+    ( SqlValue,+      Param,+      SeldaT,+      MonadSelda(..),+      SeldaBackend(runStmtWithPK, disableForeignKeys, ppConfig, runStmt),+      QueryRunner,+      SeldaError(SqlError),+      withBackend )+import Database.Selda.Column ( Row, Col ) import Database.Selda.Compile-import Database.Selda.Generic-import Database.Selda.Query.Type+    ( Result,+      Res,+      compileWith,+      compileInsert,+      compileUpdate,+      compileDelete,+      buildResult )+import Database.Selda.Generic ( Relational )+import Database.Selda.Query.Type ( Query ) import Database.Selda.SqlType (ID, invalidId, toId)-import Database.Selda.Table+import Database.Selda.Table.Type+    ( Table(tableName, tableHasAutoPK) ) import Database.Selda.Table.Compile+    ( OnError(..),+      compileCreateTable,+      compileCreateIndexes,+      compileDropTable ) import Database.Selda.Types (fromTableName)-import Data.Proxy+import Data.Proxy ( Proxy(..) ) import Data.Text (Text)-import Control.Monad+import Control.Monad ( void ) import Control.Monad.Catch-import Control.Monad.IO.Class+    ( bracket_,+      onException,+      try,+      MonadCatch,+      MonadMask(mask),+      MonadThrow(throwM) )+import Control.Monad.IO.Class ( MonadIO(..) )  -- | Run a query within a Selda monad. In practice, this is often a 'SeldaT' --   transformer on top of some other monad.

@@ -2,35 +2,39 @@ {-# LANGUAGE TypeFamilies, TypeOperators, FlexibleInstances #-} {-# LANGUAGE UndecidableInstances, MultiParamTypeClasses, OverloadedStrings #-} {-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ConstraintKinds #-}-{-# LANGUAGE GADTs, CPP, DeriveGeneric, DataKinds #-}+{-# LANGUAGE GADTs, CPP, DataKinds #-} -- | Generics utilities. module Database.Selda.Generic   ( Relational, Generic-  , tblCols, params, def, gNew+  , tblCols, params, def, gNew, gRow   ) where import Control.Monad.State-import Data.Dynamic+    ( liftM2, MonadState(put, get), evalState, State )+import Data.Dynamic ( Typeable ) import Data.Text as Text (Text, pack)-#if MIN_VERSION_base(4, 10, 0)-import Data.Typeable-#endif-import GHC.Generics hiding (R, (:*:), Selector)-import qualified GHC.Generics as G ((:*:)(..), Selector)++import Data.Typeable ( Proxy(..), typeRep, typeRepTyCon )++import GHC.Generics+    ( Generic(from, Rep), Selector(selName), K1(K1), M1(M1), S )+import qualified GHC.Generics as G+    ( (:*:)(..), Selector, (:+:)(..) ) import qualified GHC.TypeLits as TL-import qualified GHC.Generics as G ((:+:)(..)) import qualified Database.Selda.Column as C (Col) import Control.Exception (Exception (..), try, throw)-import System.IO.Unsafe-import Database.Selda.Types+import System.IO.Unsafe ( unsafePerformIO )+import Database.Selda.Types ( ColName, modColName, mkColName ) import Database.Selda.SqlType+    ( Lit, SqlType(sqlType, defaultValue, mkLit) ) import Database.Selda.SqlRow (SqlRow) import Database.Selda.Table.Type+    ( ColAttr(Required, Optional), ColInfo(..) ) import Database.Selda.SQL (Param (..)) import Database.Selda.Exp (Exp (Col, Lit), UntypedCol (..))-#if !MIN_VERSION_base(4, 11, 0)-import Data.Monoid-#endif +++ -- | Any type which has a corresponding relation. --   To make a @Relational@ instance for some type, simply derive 'Generic'. --@@ -85,10 +89,14 @@   -- | Create a new value with all default fields.   gNew :: Proxy f -> [UntypedCol sql] +  -- | Create a new row from the given value.+  gRow :: f a -> [UntypedCol sql]+ instance {-# OVERLAPPABLE #-} GRelation a => GRelation (M1 t c a) where   gParams (M1 x) = gParams x   gTblCols _ = gTblCols (Proxy :: Proxy a)   gNew _ = gNew (Proxy :: Proxy a)+  gRow (M1 x) = gRow x  instance {-# OVERLAPPING #-} (G.Selector c, GRelation a) =>          GRelation (M1 S c a) where@@ -100,6 +108,7 @@           "" -> Nothing           s  -> Just (mkColName $ pack s)   gNew _ = gNew (Proxy :: Proxy a)+  gRow (M1 x) = gRow x  instance (Typeable a, SqlType a) => GRelation (K1 i a) where   gParams (K1 x) = do@@ -129,6 +138,7 @@         | otherwise                                               = [Required]    gNew _ = [Untyped (Lit (defaultValue :: Lit a))]+  gRow (K1 x) = [Untyped (Lit (mkLit x))]  instance (GRelation a, GRelation b) => GRelation (a G.:*: b) where   gParams (a G.:*: b) = liftM2 (++) (gParams a) (gParams b)@@ -140,6 +150,7 @@       a = Proxy :: Proxy a       b = Proxy :: Proxy b   gNew _ = gNew (Proxy :: Proxy a) ++ gNew (Proxy :: Proxy b)+  gRow (a G.:*: b) = gRow a ++ gRow b  instance   (TL.TypeError@@ -150,6 +161,7 @@   gParams = error "unreachable"   gTblCols = error "unreachable"   gNew = error "unreachable"+  gRow = error "unreachable"  instance {-# OVERLAPS #-}   (TL.TypeError@@ -160,3 +172,4 @@   gParams = error "unreachable"   gTblCols = error "unreachable"   gNew = error "unreachable"+  gRow = error "unreachable"

@@ -4,12 +4,13 @@ -- | Helpers for working with inner queries. module Database.Selda.Inner where import Database.Selda.Column+    ( Exp(AggrEx), UntypedCol(..), Row, Col(..) ) import Database.Selda.SQL (SQL) import Database.Selda.SqlType (SqlType)-import Database.Selda.Types+import Database.Selda.Types ( type (:*:)(..) ) import Data.Text (Text)-import Data.Typeable-import GHC.TypeLits as TL+import Data.Typeable ( Typeable )+import GHC.TypeLits as TL ( TypeError, ErrorMessage(Text, (:$$:)) )  -- | A single aggregate column. --   Aggregate columns may not be used to restrict queries.

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, TypeOperators, KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables, TypeOperators #-} {-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts, UndecidableInstances #-} -- | Utilities for creating selectors for non-record types.@@ -10,15 +10,16 @@  , selectors, tableWithSelectors  ) where import Control.Monad.State.Strict-import Data.Proxy-import GHC.Generics hiding (Selector, (:*:))+    ( MonadState(state), State, evalState )+import Data.Proxy ( Proxy(..) )+import GHC.Generics ( Generic(Rep), K1, M1 ) import qualified GHC.Generics as G import Database.Selda.Generic (Relational)-import Database.Selda.Selectors-import Database.Selda.SqlRow-import Database.Selda.SqlType-import Database.Selda.Table-import Database.Selda.Types+import Database.Selda.Selectors ( Selector, unsafeSelector )+import Database.Selda.SqlRow ( SqlRow )+import Database.Selda.SqlType ( SqlType )+import Database.Selda.Table ( Table, Attr, table )+import Database.Selda.Types ( type (:*:)(..), TableName )  -- | Generate selector functions for the given table. --   Selectors can be used to access the fields of a query result tuple, avoiding

@@ -5,17 +5,26 @@   , migrate, migrateM, migrateAll, autoMigrate   ) where import Control.Monad (void, when)-import Control.Monad.Catch-import Database.Selda hiding (from)-import Database.Selda.Frontend-  ( OnError (..)-  , createTableWithoutIndexes, createTableIndexes-  )+import Control.Monad.Catch ( MonadMask, MonadThrow(..) ) import Database.Selda.Backend.Internal-import Database.Selda.Table.Type (tableName)+    ( MonadSelda(..), SeldaBackend(runStmt), withBackend )+import Database.Selda.Column ( Row )+import Database.Selda.Frontend+    ( MonadIO(liftIO),+      queryInto,+      transaction,+      withoutForeignKeyEnforcement,+      OnError(..),+      createTableWithoutIndexes,+      createTableIndexes )+import Database.Selda.Generic ( Relational )+import Database.Selda.Query ( select )+import Database.Selda.Query.Type ( Query )+import Database.Selda.Table.Type ( Table(..) ) import Database.Selda.Table.Validation (ValidationError (..)) import Database.Selda.Types (mkTableName, fromTableName, rawTableName) import Database.Selda.Validation+    ( TableDiff(TableOK), validateTable, validateSchema, diffTable )  -- | Wrapper for user with 'migrateAll', enabling multiple migrations to be --   packed into the same list:

@@ -7,10 +7,28 @@   , (?==), (?/=), (?>), (?<), (?>=), (?<=), (?+), (?-), (?*), (?/)   ) where import Database.Selda+    ( SqlType,+      Same,+      Row,+      Col,+      Selector,+      Coalesce,+      Query,+      restrict,+      SqlOrd,+      (.==),+      (./=),+      (.>),+      (.<),+      (.>=),+      (.<=),+      isNull,+      not_ ) import Database.Selda.Unsafe (cast)-import Database.Selda.Selectors+import Database.Selda.Selectors ( Selector(selectorIndex) ) import Database.Selda.Column-import Unsafe.Coerce+    ( UntypedCol(Untyped), Row(Many), Col(One) )+import Unsafe.Coerce ( unsafeCoerce )  -- | Two SQL types which are identical modulo nullability. type a :?~ b =

@@ -4,18 +4,32 @@ -- | Building and executing prepared statements. module Database.Selda.Prepared (Preparable, Prepare, prepared) where import Database.Selda.Backend.Internal-import Database.Selda.Column+    ( Lit(LCustom),+      SqlType(sqlType),+      SqlTypeRep,+      Param(..),+      MonadSelda(Backend, withConnection),+      SeldaBackend(ppConfig, runPrepared, backendId, prepareStmt),+      SeldaConnection(connBackend, connStmts),+      SeldaStmt(SeldaStmt, stmtHandle, stmtParams, stmtText),+      StmtID(..),+      BackendID,+      freshStmtId,+      withBackend )+import Database.Selda.Column ( Exp(Lit), Col(..) ) import Database.Selda.Compile-import Database.Selda.Query.Type+    ( Result, Res, compileWith, buildResult )+import Database.Selda.Query.Type ( Query ) import Database.Selda.SQL (param, paramType)-import Control.Exception-import Control.Monad.IO.Class+import Control.Exception ( Exception, try, throw, mask )+import Control.Monad.IO.Class ( MonadIO(liftIO) ) import qualified Data.IntMap as M import Data.IORef-import Data.Proxy+    ( IORef, atomicModifyIORef', newIORef, readIORef, writeIORef )+import Data.Proxy ( Proxy(..) ) import Data.Text (Text)-import Data.Typeable-import System.IO.Unsafe+import Data.Typeable ( Typeable )+import System.IO.Unsafe ( unsafePerformIO )  data Placeholder = Placeholder Int   deriving Show

@@ -1,23 +1,50 @@ {-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Query monad and primitive operations. module Database.Selda.Query   ( select, selectValues, Database.Selda.Query.distinct   , restrict, groupBy, limit, order, orderRandom-  , aggregate, leftJoin, innerJoin+  , aggregate, leftJoin, innerJoin, union, unionAll   ) where import Data.Maybe (isNothing) import Database.Selda.Column-import Database.Selda.Generic+    ( NulOp(Fun0),+      Exp(Lit, Col, NulOp),+      SomeCol(Some, Named),+      hideRenaming,+      Same,+      Row(..),+      Col(..),+      Columns(..) )+import Database.Selda.Generic ( gNew, Relational, params ) import Database.Selda.Inner+    ( Aggregates(..),+      LeftCols,+      AggrCols,+      OuterCols,+      Inner,+      Aggr(Aggr) ) import Database.Selda.Query.Type+    ( GenState(staticRestricts, groupCols, sources),+      Query(..),+      isolate,+      renameAll,+      freshName ) import Database.Selda.SQL as SQL+    ( Param(Param),+      Order(Asc),+      SQL(liveExtras, cols, restricts, groups, limits, ordering,+          distinct),+      JoinType(..),+      SqlSource(Product, TableName, EmptyTable, Values, Union, Join),+      sqlFrom ) import Database.Selda.SqlType (SqlType)-import Database.Selda.Table-import Database.Selda.Transform-import Control.Monad.State.Strict-import Data.Proxy+import Database.Selda.Table.Type ( ColInfo(colExpr), Table(Table) )+import Database.Selda.Transform ( colNames, state2sql, allCols )+import Control.Monad.State.Strict ( MonadState(put, get), modify )+import Data.Proxy ( Proxy(..) ) import GHC.Generics (Rep)-import Unsafe.Coerce+import Unsafe.Coerce ( unsafeCoerce )  -- | Query the given table. select :: Relational a => Table a -> Query s (Row s a)@@ -51,6 +78,39 @@     defToVal (Left x)  = x     defToVal (Right x) = x +internalUnion :: (Columns a, Columns (OuterCols a))+              => Bool+              -> Query (Inner s) a+              -> Query (Inner s) a+              -> Query s (OuterCols a)+internalUnion union_all a b = Query $ do+  (st_a, cols_a) <- isolate a+  (st_b, cols_b) <- isolate b+  renamed_a <- renameAll (fromTup cols_a)+  renamed_b <- renameAll (fromTup cols_b)+  let sql_a = (sqlFrom renamed_a (Product [state2sql st_a])) {liveExtras = renamed_a}+      sql_b = (sqlFrom renamed_b (Product [state2sql st_b])) {liveExtras = renamed_b}+      out_col_names = [n | Named n _ <- renamed_a]+      out_cols = map (Some . Col) out_col_names+  modify $ \st ->+    st {sources = sqlFrom out_cols (Union union_all sql_a sql_b) : sources st}+  return (toTup out_col_names)++-- | The set union of two queries. Equivalent to the SQL @UNION@ operator.+union :: (Columns a, Columns (OuterCols a))+      => Query (Inner s) a+      -> Query (Inner s) a+      -> Query s (OuterCols a)+union = internalUnion False++-- | The multiset union of two queries.+--   Equivalent to the SQL @UNION ALL@ operator.+unionAll :: (Columns a, Columns (OuterCols a))+         => Query (Inner s) a+         -> Query (Inner s) a+         -> Query s (OuterCols a)+unionAll = internalUnion True+ -- | Restrict the query somehow. Roughly equivalent to @WHERE@. restrict :: Same s t => Col s Bool -> Query t () restrict (One p) = Query $ do@@ -225,8 +285,8 @@          => Query (Inner s) a          -> Query s (OuterCols a) distinct q = Query $ do-  (inner_st, res) <- isolate q+  res <- unQ q   st <- get-  let ss = sources inner_st+  let ss = sources st   put st {sources = [(sqlFrom (allCols ss) (Product ss)) {SQL.distinct = True}]}   return (unsafeCoerce res)

@@ -1,12 +1,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, CPP #-} module Database.Selda.Query.Type where import Control.Monad.State.Strict-#if !MIN_VERSION_base(4, 11, 0)-import Data.Monoid-#endif+    ( StateT(StateT), MonadState(put, get), State, runState ) import Data.Text (pack)-import Database.Selda.SQL-import Database.Selda.Column+import Database.Selda.SQL ( SQL )+import Database.Selda.Exp+    ( Exp(Col), UntypedCol(..), SomeCol(Named) ) import Database.Selda.Types (ColName, mkColName, addColSuffix)  type Scope = Int

@@ -1,16 +1,14 @@ {-# LANGUAGE GADTs, OverloadedStrings, ScopedTypeVariables, RecordWildCards #-}-{-# LANGUAGE TypeOperators, FlexibleInstances, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-} {-# LANGUAGE RankNTypes, CPP, MultiParamTypeClasses #-} -- | SQL AST and parameters for prepared statements. module Database.Selda.SQL where-import Data.String+import Data.String ( IsString(..) ) import Data.Text (Text)-import Database.Selda.Exp+import Database.Selda.Exp ( Names(..), Exp, SomeCol ) import Database.Selda.SqlType-import Database.Selda.Types-#if !MIN_VERSION_base(4, 11, 0)-import Data.Semigroup (Semigroup (..))-#endif+    ( Lit, SqlType(mkLit), SqlTypeRep, litType, compLit )+import Database.Selda.Types ( TableName )  instance Semigroup QueryFragment where   (<>) = RawCat@@ -27,6 +25,7 @@ data SqlSource  = TableName !TableName  | Product ![SQL]+ | Union !Bool !SQL !SQL  | Join !JoinType !(Exp SQL Bool) !SQL !SQL  | Values ![SomeCol SQL] ![[Param]]  | RawSql !QueryFragment@@ -37,13 +36,14 @@  -- | AST for SQL queries. data SQL = SQL-  { cols      :: ![SomeCol SQL]-  , source    :: !SqlSource-  , restricts :: ![Exp SQL Bool]-  , groups    :: ![SomeCol SQL]-  , ordering  :: ![(Order, SomeCol SQL)]-  , limits    :: !(Maybe (Int, Int))-  , distinct  :: !Bool+  { cols       :: ![SomeCol SQL]+  , source     :: !SqlSource+  , restricts  :: ![Exp SQL Bool]+  , groups     :: ![SomeCol SQL]+  , ordering   :: ![(Order, SomeCol SQL)]+  , limits     :: !(Maybe (Int, Int))+  , liveExtras :: ![SomeCol SQL] -- ^ Columns which are never considered dead.+  , distinct   :: !Bool   }  instance Names QueryFragment where@@ -58,6 +58,7 @@   allNamesIn (TableName _)  = []   allNamesIn (RawSql r)     = allNamesIn r   allNamesIn (EmptyTable)   = []+  allNamesIn (Union _ l r)  = concatMap allNamesIn [l, r]  instance Names SQL where   -- Note that we don't include @cols@ here: the names in @cols@ are not@@ -79,6 +80,7 @@   , groups = []   , ordering = []   , limits = Nothing+  , liveExtras = []   , distinct = False   } 

@@ -1,17 +1,24 @@ {-# LANGUAGE GADTs, OverloadedStrings, CPP #-} -- | Pretty-printing for SQL queries. For some values of pretty. module Database.Selda.SQL.Print where-import Database.Selda.Column+import Database.Selda.Exp+    ( BinOp(..), UnOp(..), NulOp(..), Exp(..), SomeCol(..) ) import Database.Selda.SQL+    ( Param(..),+      Order(Desc, Asc),+      SQL(SQL),+      JoinType(InnerJoin, LeftJoin),+      SqlSource(Union, EmptyTable, RawSql, TableName, Product, Values,+                Join),+      QueryFragment(..) ) import Database.Selda.SQL.Print.Config (PPConfig) import qualified Database.Selda.SQL.Print.Config as Cfg-import Database.Selda.SqlType+import Database.Selda.SqlType ( Lit(LJust, LNull), SqlTypeRep ) import Database.Selda.Types+    ( TableName, ColName, fromColName, fromTableName ) import Control.Monad.State-import Data.List-#if !MIN_VERSION_base(4, 11, 0)-import Data.Monoid hiding (Product)-#endif+    ( liftM2, MonadState(get, put), runState, State )+import Data.List ( group, sort ) import Data.Text (Text) import qualified Data.Text as Text @@ -107,7 +114,7 @@  -- | Pretty-print an SQL AST. ppSql :: SQL -> PP Text-ppSql (SQL cs src r gs ord lim dist) = do+ppSql (SQL cs src r gs ord lim _live dist) = do   cs' <- mapM ppSomeCol cs   src' <- ppSrc src   r' <- ppRestricts r@@ -163,6 +170,16 @@         [ " FROM (", l', ") AS ", lqn         , " ",  ppJoinType jointype, " (", r', ") AS ", rqn         , " ON ", on'+        ]+    ppSrc (Union union_all left right) = do+      qs <- mapM ppSql [left, right]+      qn <- freshQueryName+      let union = if union_all then " UNION ALL " else " UNION "+      pure $ mconcat+        [ " FROM ("+        , Text.intercalate union qs+        , ") AS "+        , qn         ]      ppJoinType LeftJoin  = "LEFT JOIN"

@@ -2,8 +2,9 @@ module Database.Selda.SQL.Print.Config (PPConfig (..), defPPConfig) where import Data.Text (Text) import qualified Data.Text as T-import Database.Selda.SqlType-import Database.Selda.Table+import Database.Selda.SqlType ( SqlTypeRep(..) )+import Database.Selda.Table.Type+    ( IndexMethod, ColAttr(..), AutoIncType(Weak, Strong) )  -- | Backend-specific configuration for the SQL pretty-printer. data PPConfig = PPConfig@@ -70,8 +71,9 @@ defType :: SqlTypeRep -> Text defType TText     = "TEXT" defType TRowID    = "INTEGER"-defType TInt      = "INT"-defType TFloat    = "DOUBLE"+defType TInt32    = "INT"+defType TInt64    = "BIGINT"+defType TFloat    = "DOUBLE PRECISION" defType TBool     = "BOOLEAN" defType TDateTime = "DATETIME" defType TDate     = "DATE"

@@ -5,10 +5,11 @@   , selectorIndex, unsafeSelector   ) where import Database.Selda.SqlRow (SqlRow)-import Database.Selda.SqlType+import Database.Selda.SqlType ( SqlType ) import Database.Selda.Column+    ( UntypedCol(Untyped), Row(..), Col(..) ) import Data.List (foldl')-import Unsafe.Coerce+import Unsafe.Coerce ( unsafeCoerce )  -- | Coalesce nested nullable column into a single level of nesting. type family Coalesce a where

@@ -1,17 +1,23 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, DataKinds #-} {-# LANGUAGE UndecidableInstances, FlexibleInstances, FlexibleContexts #-} {-# LANGUAGE TypeOperators, DefaultSignatures, ScopedTypeVariables, CPP #-}-#if MIN_VERSION_base(4, 10, 0) {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}-#endif module Database.Selda.SqlRow   ( SqlRow (..), ResultReader+  , GSqlRow   , runResultReader, next   ) where import Control.Monad.State.Strict+    ( liftM2,+      StateT(StateT),+      MonadState(state, get),+      State,+      evalState ) import Database.Selda.SqlType-import Data.Typeable+    ( SqlValue(SqlNull), SqlType(fromSql) )+import Data.Typeable ( Typeable, Proxy(..) ) import GHC.Generics+    ( Generic(Rep, to), K1(K1), M1(M1), type (:+:), type (:*:)(..) ) import qualified GHC.TypeLits as TL  newtype ResultReader a = R (State [SqlValue] a)

@@ -3,20 +3,30 @@ -- | Types representable as columns in Selda's subset of SQL. module Database.Selda.SqlType   ( SqlType (..), SqlEnum (..)-  , Lit (..), UUID, RowID, ID, SqlValue (..), SqlTypeRep (..)+  , Lit (..), UUID, UUID', RowID, ID, SqlValue (..), SqlTypeRep (..)   , invalidRowId, isInvalidRowId, toRowId, fromRowId   , fromId, toId, invalidId, isInvalidId, untyped   , compLit, litType   , sqlDateTimeFormat, sqlDateFormat, sqlTimeFormat+  , typedUuid, untypedUuid   ) where import Control.Applicative ((<|>))+import Control.Exception (Exception (..), throw) import Data.ByteString (ByteString, empty) import qualified Data.ByteString.Lazy as BSL+import Data.Int (Int32, Int64) import Data.Maybe (fromJust)-import Data.Proxy+import Data.Proxy ( Proxy(..) ) import Data.Text (Text, pack, unpack)+import qualified Data.Text.Lazy as LazyText import Data.Time-import Data.Typeable+    ( defaultTimeLocale,+      parseTimeM,+      Day(ModifiedJulianDay),+      UTCTime(UTCTime),+      ParseTime,+      TimeOfDay(TimeOfDay) )+import Data.Typeable ( Typeable ) import Data.UUID.Types (UUID, toString, fromByteString, nil) import GHC.Generics (Generic) @@ -42,7 +52,8 @@ data SqlTypeRep   = TText   | TRowID-  | TInt+  | TInt64+  | TInt32   | TFloat   | TBool   | TDateTime@@ -94,7 +105,8 @@ -- | An SQL literal. data Lit a where   LText     :: !Text       -> Lit Text-  LInt      :: !Int        -> Lit Int+  LInt32    :: !Int32      -> Lit Int32+  LInt64    :: !Int64      -> Lit Int64   LDouble   :: !Double     -> Lit Double   LBool     :: !Bool       -> Lit Bool   LDateTime :: !UTCTime    -> Lit UTCTime@@ -109,7 +121,8 @@ -- | The SQL type representation for the given literal. litType :: Lit a -> SqlTypeRep litType (LText{})     = TText-litType (LInt{})      = TInt+litType (LInt32{})    = TInt32+litType (LInt64{})    = TInt64 litType (LDouble{})   = TFloat litType (LBool{})     = TBool litType (LDateTime{}) = TDateTime@@ -133,22 +146,24 @@ -- | Constructor tag for all literals. Used for Ord instance. litConTag :: Lit a -> Int litConTag (LText{})     = 0-litConTag (LInt{})      = 1-litConTag (LDouble{})   = 2-litConTag (LBool{})     = 3-litConTag (LDateTime{}) = 4-litConTag (LDate{})     = 5-litConTag (LTime{})     = 6-litConTag (LJust{})     = 7-litConTag (LBlob{})     = 8-litConTag (LNull)       = 9-litConTag (LCustom{})   = 10-litConTag (LUUID{})     = 11+litConTag (LInt32{})    = 2+litConTag (LInt64{})    = 3+litConTag (LDouble{})   = 4+litConTag (LBool{})     = 5+litConTag (LDateTime{}) = 6+litConTag (LDate{})     = 7+litConTag (LTime{})     = 8+litConTag (LJust{})     = 9+litConTag (LBlob{})     = 10+litConTag (LNull)       = 11+litConTag (LCustom{})   = 12+litConTag (LUUID{})     = 13  -- | Compare two literals of different type for equality. compLit :: Lit a -> Lit b -> Ordering compLit (LText x)     (LText x')     = x `compare` x'-compLit (LInt x)      (LInt x')      = x `compare` x'+compLit (LInt32 x)    (LInt32 x')    = x `compare` x'+compLit (LInt64 x)    (LInt64 x')    = x `compare` x' compLit (LDouble x)   (LDouble x')   = x `compare` x' compLit (LBool x)     (LBool x')     = x `compare` x' compLit (LDateTime x) (LDateTime x') = x `compare` x'@@ -162,7 +177,8 @@  -- | Some value that is representable in SQL. data SqlValue where-  SqlInt     :: !Int        -> SqlValue+  SqlInt32   :: !Int32      -> SqlValue+  SqlInt64   :: !Int64      -> SqlValue   SqlFloat   :: !Double     -> SqlValue   SqlString  :: !Text       -> SqlValue   SqlBool    :: !Bool       -> SqlValue@@ -173,7 +189,8 @@   SqlNull    :: SqlValue  instance Show SqlValue where-  show (SqlInt n)     = "SqlInt " ++ show n+  show (SqlInt32 n)   = "SqlInt32 " ++ show n+  show (SqlInt64 n)   = "SqlInt64 " ++ show n   show (SqlFloat f)   = "SqlFloat " ++ show f   show (SqlString s)  = "SqlString " ++ show s   show (SqlBool b)    = "SqlBool " ++ show b@@ -185,7 +202,8 @@  instance Show (Lit a) where   show (LText s)     = show s-  show (LInt i)      = show i+  show (LInt32 i)    = show i+  show (LInt64 i)    = show i   show (LDouble d)   = show d   show (LBool b)     = show b   show (LDateTime s) = show s@@ -199,7 +217,7 @@  -- | A row identifier for some table. --   This is the type of auto-incrementing primary keys.-newtype RowID = RowID Int+newtype RowID = RowID Int64   deriving (Eq, Ord, Typeable, Generic) instance Show RowID where   show (RowID n) = show n@@ -215,11 +233,11 @@  -- | Create a row identifier from an integer. --   Use with caution, preferably only when reading user input.-toRowId :: Int -> RowID+toRowId :: Int64 -> RowID toRowId = RowID  -- | Inspect a row identifier.-fromRowId :: RowID -> Int+fromRowId :: RowID -> Int64 fromRowId (RowID n) = n  -- | A typed row identifier.@@ -232,14 +250,25 @@ instance Show (ID a) where   show = show . untyped +-- | An UUID identifying a database row.+newtype UUID' a = UUID { untypedUuid :: UUID }+  deriving (Eq, Ord, Typeable, Generic)+instance Show (UUID' a) where+  show = show . untypedUuid++-- | Convert an untyped UUID to a typed one.+--   Use sparingly, preferably only during deserialization.+typedUuid :: UUID -> UUID' a+typedUuid = UUID+ -- | Create a typed row identifier from an integer. --   Use with caution, preferably only when reading user input.-toId :: Int -> ID a+toId :: Int64 -> ID a toId = ID . toRowId  -- | Create a typed row identifier from an integer. --   Use with caution, preferably only when reading user input.-fromId :: ID a -> Int+fromId :: ID a -> Int64 fromId (ID i) = fromRowId i  -- | A typed row identifier which is guaranteed to not match any row in any@@ -252,11 +281,19 @@ isInvalidId :: ID a -> Bool isInvalidId = isInvalidRowId . untyped +fromSqlError :: String -> a+fromSqlError = throw . FromSqlError++newtype FromSqlError = FromSqlError String+instance Show FromSqlError where+  show (FromSqlError e) = "[SELDA BUG] fromSql: " ++ e+instance Exception FromSqlError+ instance SqlType RowID where-  mkLit (RowID n) = LCustom TRowID (LInt n)+  mkLit (RowID n) = LCustom TRowID (LInt64 n)   sqlType _ = TRowID-  fromSql (SqlInt x) = RowID x-  fromSql v          = error $ "fromSql: RowID column with non-int value: " ++ show v+  fromSql (SqlInt64 x) = RowID x+  fromSql v          = fromSqlError $ "RowID column with non-int value: " ++ show v   defaultValue = mkLit invalidRowId  instance Typeable a => SqlType (ID a) where@@ -266,33 +303,56 @@   defaultValue = mkLit (ID invalidRowId)  instance SqlType Int where-  mkLit = LInt-  sqlType _ = TInt-  fromSql (SqlInt x) = x-  fromSql v          = error $ "fromSql: int column with non-int value: " ++ show v-  defaultValue = LInt 0+  mkLit n = LCustom TInt64 (LInt64 $ fromIntegral n)+  sqlType _ = TInt64+  fromSql (SqlInt64 x) = fromIntegral x+  fromSql v            = fromSqlError $ "int column with non-int value: " ++ show v+  defaultValue = mkLit (0 :: Int) +instance SqlType Int64 where+  mkLit = LInt64+  sqlType _ = TInt64+  fromSql (SqlInt64 x) = x+  fromSql v          = fromSqlError $ "int64 column with non-int value: " ++ show v+  defaultValue = LInt64 0++instance SqlType Int32 where+  mkLit = LInt32+  sqlType _ = TInt32+  fromSql (SqlInt32 x) = x+  fromSql v          = fromSqlError $ "int32 column with non-int value: " ++ show v+  defaultValue = LInt32 0+ instance SqlType Double where   mkLit = LDouble   sqlType _ = TFloat   fromSql (SqlFloat x) = x-  fromSql v            = error $ "fromSql: float column with non-float value: " ++ show v+  fromSql v            = fromSqlError $ "float column with non-float value: " ++ show v   defaultValue = LDouble 0  instance SqlType Text where   mkLit = LText   sqlType _ = TText   fromSql (SqlString x) = x-  fromSql v             = error $ "fromSql: text column with non-text value: " ++ show v+  fromSql v             = fromSqlError $ "text column with non-text value: " ++ show v   defaultValue = LText "" +instance SqlType LazyText.Text where+  mkLit = LCustom TText . LText . mconcat . LazyText.toChunks+  sqlType _ = TText+  fromSql (SqlString x) = LazyText.fromChunks [x]+  fromSql v             = fromSqlError $ "lazy text column with non-text value: " ++ show v+  defaultValue = mkLit ""+ instance SqlType Bool where   mkLit = LBool   sqlType _ = TBool-  fromSql (SqlBool x) = x-  fromSql (SqlInt 0)  = False-  fromSql (SqlInt _)  = True-  fromSql v           = error $ "fromSql: bool column with non-bool value: " ++ show v+  fromSql (SqlBool x)  = x+  fromSql (SqlInt32 0) = False+  fromSql (SqlInt32 _) = True+  fromSql (SqlInt64 0) = False+  fromSql (SqlInt64 _) = True+  fromSql v            = fromSqlError $ "bool column with non-bool value: " ++ show v   defaultValue = LBool False  instance SqlType UTCTime where@@ -302,8 +362,8 @@   fromSql (SqlString s) =     case withWeirdTimeZone sqlDateTimeFormat (unpack s) of       Just t -> t-      _      -> error $ "fromSql: bad datetime string: " ++ unpack s-  fromSql v = error $ "fromSql: datetime column with non-datetime value: " ++ show v+      _      -> fromSqlError $ "bad datetime string: " ++ unpack s+  fromSql v = fromSqlError $ "datetime column with non-datetime value: " ++ show v   defaultValue = LDateTime $ UTCTime (ModifiedJulianDay 40587) 0  instance SqlType Day where@@ -313,8 +373,8 @@   fromSql (SqlString s) =     case parseTimeM True defaultTimeLocale sqlDateFormat (unpack s) of       Just t -> t-      _      -> error $ "fromSql: bad date string: " ++ unpack s-  fromSql v = error $ "fromSql: date column with non-date value: " ++ show v+      _      -> fromSqlError $ "bad date string: " ++ unpack s+  fromSql v = fromSqlError $ "date column with non-date value: " ++ show v   defaultValue = LDate $ ModifiedJulianDay 40587  instance SqlType TimeOfDay where@@ -324,8 +384,8 @@   fromSql (SqlString s) =     case withWeirdTimeZone sqlTimeFormat (unpack s) of       Just t -> t-      _      -> error $ "fromSql: bad time string: " ++ unpack s-  fromSql v = error $ "fromSql: time column with non-time value: " ++ show v+      _      -> fromSqlError $ "bad time string: " ++ unpack s+  fromSql v = fromSqlError $ "time column with non-time value: " ++ show v   defaultValue = LTime $ TimeOfDay 0 0 0  -- | Both PostgreSQL and SQLite to weird things with time zones.@@ -341,14 +401,14 @@   mkLit = LBlob   sqlType _ = TBlob   fromSql (SqlBlob x) = x-  fromSql v           = error $ "fromSql: blob column with non-blob value: " ++ show v+  fromSql v           = fromSqlError $ "blob column with non-blob value: " ++ show v   defaultValue = LBlob empty  instance SqlType BSL.ByteString where   mkLit = LCustom TBlob . LBlob . BSL.toStrict   sqlType _ = TBlob   fromSql (SqlBlob x) = BSL.fromStrict x-  fromSql v           = error $ "fromSql: blob column with non-blob value: " ++ show v+  fromSql v           = fromSqlError $ "blob column with non-blob value: " ++ show v   defaultValue = LCustom TBlob (LBlob empty)  -- | @defaultValue@ for UUIDs is the all-zero RFC4122 nil UUID.@@ -356,8 +416,15 @@   mkLit = LUUID   sqlType _ = TUUID   fromSql (SqlBlob x) = fromJust . fromByteString $ BSL.fromStrict x-  fromSql v           = error $ "fromSql: UUID column with non-blob value: " ++ show v+  fromSql v           = fromSqlError $ "UUID column with non-blob value: " ++ show v   defaultValue = LUUID nil++-- | @defaultValue@ for UUIDs is the all-zero RFC4122 nil UUID.+instance Typeable a => SqlType (UUID' a) where+  mkLit = LCustom TUUID . LUUID . untypedUuid+  sqlType _ = TUUID+  fromSql = typedUuid . fromSql+  defaultValue = LCustom TUUID (LUUID nil)  instance SqlType a => SqlType (Maybe a) where   mkLit (Just x) = LJust $ mkLit x

@@ -2,10 +2,8 @@ {-# LANGUAGE TypeFamilies, TypeOperators, FlexibleInstances #-} {-# LANGUAGE UndecidableInstances, MultiParamTypeClasses, OverloadedStrings #-} {-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ConstraintKinds #-}-{-# LANGUAGE GADTs, CPP, DeriveGeneric, DataKinds, MagicHash #-}-#if MIN_VERSION_base(4, 10, 0)+{-# LANGUAGE GADTs, CPP, DataKinds #-} {-# LANGUAGE TypeApplications #-}-#endif module Database.Selda.Table   ( SelectorLike, Group (..), Attr (..), Table (..), Attribute   , ColInfo (..), AutoIncType (..), ColAttr (..), IndexMethod (..)@@ -19,27 +17,26 @@   , isAutoPrimary, isPrimary, isUnique   ) where import Data.Text (Text)-#if MIN_VERSION_base(4, 10, 0)-import Data.Typeable-#else-import Data.Proxy-import GHC.Prim-#endif-import Database.Selda.Types-import Database.Selda.Selectors-import Database.Selda.SqlType+import Data.Typeable ( Proxy(..) )+import Database.Selda.Types ( type (:*:), TableName, ColName )+import Database.Selda.Selectors ( Selector(..) )+import Database.Selda.SqlType ( ID, RowID ) import Database.Selda.Column (Row (..))-import Database.Selda.Generic+import Database.Selda.Generic ( Relational, tblCols ) import Database.Selda.Table.Type+    ( IndexMethod(..),+      ColAttr(..),+      AutoIncType(..),+      ColInfo(..),+      Table(..),+      isAutoPrimary,+      isPrimary,+      isUnique ) import Database.Selda.Table.Validation (snub)-import GHC.OverloadedLabels+import GHC.OverloadedLabels ( IsLabel(..) )  instance forall x t a. IsLabel x (Selector t a) => IsLabel x (Group t a) where-#if MIN_VERSION_base(4, 10, 0)   fromLabel = Single (fromLabel @x)-#else-  fromLabel _ = Single (fromLabel (proxy# :: Proxy# x))-#endif  -- | A non-empty list of selectors, where the element selectors need not have --   the same type. Used to specify constraints, such as uniqueness or primary

@@ -1,20 +1,32 @@ {-# LANGUAGE OverloadedStrings, CPP #-} -- | Generating SQL for creating and deleting tables. module Database.Selda.Table.Compile where-import Database.Selda.Table-import Database.Selda.Table.Validation+import Database.Selda.Table.Type+    ( IndexMethod,+      ColAttr(Indexed, Primary, Unique),+      ColInfo(colFKs, colType, colName, colAttrs),+      Table(Table, tableAttrs, tableName, tableCols),+      isAutoPrimary )+import Database.Selda.Table.Validation ( validateOrThrow ) import           Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import Data.List (foldl')-#if !MIN_VERSION_base(4, 11, 0)-import Data.Monoid-#endif import Data.Text (Text, intercalate, pack) import qualified Data.Text as Text-import Database.Selda.SQL hiding (param,cols)+import Database.Selda.SQL ( Param ) import Database.Selda.SQL.Print.Config+    ( PPConfig(ppIndexMethodHook, ppTypeHook, ppColAttrsHook,+               ppColAttrs, ppTypePK, ppType, ppAutoIncInsert) ) import Database.Selda.SqlType (SqlTypeRep(..)) import Database.Selda.Types+    ( TableName,+      ColName,+      modColName,+      addColPrefix,+      fromColName,+      intercalateColNames,+      fromTableName,+      rawTableName )  data OnError = Fail | Ignore   deriving (Eq, Ord, Show)

@@ -1,8 +1,8 @@ module Database.Selda.Table.Type where import Database.Selda.SqlType (SqlTypeRep) import Database.Selda.SQL (SQL)-import Database.Selda.Types-import Database.Selda.Exp+import Database.Selda.Types ( TableName, ColName )+import Database.Selda.Exp ( UntypedCol )  -- | A database table, based on some Haskell data type. --   Any single constructor type can form the basis of a table, as long as

@@ -1,14 +1,17 @@ {-# LANGUAGE OverloadedStrings, CPP #-} module Database.Selda.Table.Validation where-import Control.Exception+import Control.Exception ( Exception, throw ) import Data.List (group, sort) import Data.Text (Text, any, intercalate, unpack)-import Data.Typeable+import Data.Typeable ( Typeable ) import Database.Selda.Table.Type+    ( ColAttr(Required, Optional),+      ColInfo(colFKs, colName, colAttrs),+      Table(Table),+      isPrimary,+      isUnique ) import Database.Selda.Types-#if !MIN_VERSION_base(4, 11, 0)-import Data.Monoid-#endif+    ( TableName, fromColName, fromTableName )  -- | An error occurred when validating a database table. --   If this error is thrown, there is a bug in your database schema, and the@@ -42,7 +45,7 @@       | fromTableName name == "\"\"" = ["table name is empty"]       | otherwise                    = []     emptyIdents-      | Prelude.any (== "\"\"") colIdents =+      | "\"\"" `elem` colIdents =         ["table has columns with empty names"]       | otherwise =         []@@ -54,7 +57,7 @@     dupes =       ["duplicate column: " <> fromColName x | (x:_:_) <- soup $ map colName cis]     pkDupes =-      if moreThanOne pkAttrs then ["multiple primary keys"] else []+      ["multiple primary keys" | moreThanOne pkAttrs]     nonPkFks =       [ "column is used as a foreign key, but is not primary or unique: "           <> fromTableName ftn <> "." <> fromColName fcn

@@ -1,38 +1,44 @@ -- | Analysis and transformation of SQL queries. module Database.Selda.Transform where-import Database.Selda.Column+import Database.Selda.Exp+    ( allNamesIn, Exp(Col, AggrEx), SomeCol(..) ) import Database.Selda.SQL-import Database.Selda.Query.Type-import Database.Selda.Types+    ( SQL(SQL, groups, ordering, liveExtras, source, restricts, cols),+      SqlSource(Product, EmptyTable, TableName, Values, RawSql, Union,+                Join) )+import Database.Selda.Query.Type ( GenState(GenState) )+import Database.Selda.Types ( ColName )  -- | Remove all dead columns recursively, assuming that the given list of --   column names contains all names present in the final result. removeDeadCols :: [ColName] -> SQL -> SQL removeDeadCols live sql =     case source sql' of-      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)}+      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)}+      Union union_all l r -> sql' {source = Union union_all (noDead l) (noDead r)}   where     noDead = removeDeadCols live'-    sql' = keepCols (allNonOutputColNames sql ++ live) sql+    sql' = keepCols (implicitlyLiveCols sql ++ live) sql     live' = allColNames sql'  -- | Return the names of all columns in the given top-level query. --   Subqueries are not traversed. allColNames :: SQL -> [ColName]-allColNames sql = colNames (cols sql) ++ allNonOutputColNames sql+allColNames sql = colNames (cols sql) ++ implicitlyLiveCols sql  -- | Return the names of all non-output (i.e. 'cols') columns in the given --   top-level query. Subqueries are not traversed.-allNonOutputColNames :: SQL -> [ColName]-allNonOutputColNames sql = concat+implicitlyLiveCols :: SQL -> [ColName]+implicitlyLiveCols sql = concat   [ concatMap allNamesIn (restricts sql)   , colNames (groups sql)   , colNames (map snd $ ordering sql)+  , colNames (liveExtras sql)   , case source sql of       Join _ on _ _ -> allNamesIn on       _             -> []@@ -69,7 +75,7 @@ state2sql (GenState [sql] srs _ _ _) =   sql {restricts = restricts sql ++ srs} state2sql (GenState ss srs _ _ _) =-  SQL (allCols ss) (Product ss) srs [] [] Nothing False+  SQL (allCols ss) (Product ss) srs [] [] Nothing [] False  -- | Get all output columns from a list of SQL ASTs. allCols :: [SQL] -> [SomeCol SQL]

@@ -11,8 +11,8 @@   , modColName, mkColName, mkTableName, addColSuffix, addColPrefix   , fromColName, fromTableName, rawTableName, intercalateColNames   ) where-import Data.Dynamic-import Data.String+import Data.Dynamic ( Typeable )+import Data.String ( IsString ) import Data.Text (Text, replace, append, intercalate) import GHC.Generics (Generic) 

@@ -10,9 +10,25 @@   ) where import Control.Exception (throw) import Control.Monad.State.Strict+    ( MonadIO(liftIO), void, MonadState(put, get) ) import Database.Selda.Backend.Internal+    ( SqlType(mkLit, sqlType),+      MonadSelda,+      SeldaBackend(runStmt, ppConfig),+      SeldaError(UnsafeError),+      withBackend ) import Database.Selda.Column-import Database.Selda.Exp (UntypedCol (..))+    ( BinOp(CustomOp),+      UnOp(Fun),+      NulOp(Fun0),+      Exp(Col, Cast, UnOp, Fun2, BinOp, NulOp, Lit, Raw),+      UntypedCol(Untyped),+      SomeCol(Named),+      hideRenaming,+      Same(liftC2),+      Row(..),+      Col(..),+      liftC ) import Database.Selda.Inner (Inner, Aggr, aggr, liftAggr) import Database.Selda.Selectors (unsafeSelector) import Database.Selda.Query.Type (Query (..), sources, renameAll, rename)@@ -21,8 +37,8 @@ import Database.Selda.SqlRow (SqlRow (..)) import Database.Selda.Types (ColName) import Data.Text (Text)-import Data.Proxy-import Unsafe.Coerce+import Data.Proxy ( Proxy(..) )+import Unsafe.Coerce ( unsafeCoerce )  -- | Cast a column to another type, using whichever coercion semantics are used --   by the underlying SQL implementation.

@@ -7,22 +7,33 @@   , describeTable, diffTable, diffTables   , validateTable, validateSchema   ) where-import Control.Monad.Catch+import Control.Monad.Catch ( MonadThrow(..) ) import Data.List ((\\)) import Data.Maybe (catMaybes)-#if !MIN_VERSION_base(4, 11, 0)-import Data.Monoid ((<>))-#endif import Data.Text (pack, unpack, intercalate) import Database.Selda-import Database.Selda.Backend-import Database.Selda.Table.Type (tableName, tableCols)+    ( Text,+      MonadIO(liftIO),+      TableName,+      ColName,+      Table(..),+      MonadSelda )+import Database.Selda.Backend.Internal+    ( SqlTypeRep(TInt64, TRowID),+      SeldaBackend(getTableInfo),+      ColumnInfo(colType, colIsAutoPrimary, colIsNullable, colHasIndex,+                 colFKs, colName),+      TableInfo(tableColumnInfos, tableUniqueGroups, tablePrimaryKey),+      tableInfo,+      withBackend )+import Database.Selda.Types ( fromColName, fromTableName )+import Database.Selda.Table.Type (tableCols) import Database.Selda.Table.Validation (ValidationError (..), validateOrThrow)  -- | Are the given types compatible? isCompatibleWith :: SqlTypeRep -> SqlTypeRep -> Bool-isCompatibleWith TRowID TInt = True-isCompatibleWith TInt TRowID = True+isCompatibleWith TRowID TInt64 = True+isCompatibleWith TInt64 TRowID = True isCompatibleWith a b         = a == b  -- | Validate a table schema, and check it for consistency against the current@@ -227,7 +238,9 @@              (colFKs db \\ colFKs schema)        ]))       where-        Right schemaColType = colType schema+        schemaColType = case colType schema of+          Right t -> t+          Left t -> error $ "Selda has no idea what to make of this type: " ++ show t         check :: Eq a               => (ColumnInfo -> a)               -> (a -> ColumnDiff)