diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,26 @@ # Revision history for sqlc-haskell +## 0.4.0.0 -- 2026-09-25 + +* The hasql driver no longer declares codec classes of its own. Overrides go + through `hasql-mapping`'s `IsScalar`, which has both `encoder` and `decoder` + where sqlc-hs had a `ToField` and a `FromField`; because it comes from a + library rather than the generated code, the instance can live wherever the + type does — including a package the generated one depends on, which an + instance of a generated class could not (hasql). +* `ToRow`/`FromRow` are gone with them. Each query module now carries a + `hasql-mapping` `IsStatement` instance, whose associated `Result` is sqlc's + command annotation spelled as a type; the parameter encoder and row decoder + are local to its `statement`. Anything accepting an `IsStatement` — + `toSession`, `toTransaction` — works on a generated query unchanged (hasql). +* The runners keep their names, arguments and command tags, so call sites are + unaffected; only their constraints change, from the two removed classes to + `IsStatement` (hasql). +* `fold` is removed. A query's result shape is now fixed by its command + annotation, so a result you want to fold is a query to declare with that + shape (hasql). +* Requires `hasql < 2.1`, which is `hasql-mapping`'s own bound (hasql). + ## 0.3.0.0 -- 2026-08-20 * A hasql backend for PostgreSQL, selected with the new `driver` option diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -101,8 +101,8 @@ The generated `Queries.Internal` module gives every query the same helpers as the other drivers do — `exec`, `execRows`, `execResult`, `queryOne`, -`queryMany`, `fold` and `execMany` — taking a `Hasql.Connection.Connection` and -returning `IO (Either Hasql.Errors.SessionError a)`: +`queryMany` and `execMany` — taking a `Hasql.Connection.Connection` and +returning `IO (Either RunnerError a)`: ```haskell users <- queryMany connection query_ListUsers Params_ListUsers {age = 42} @@ -121,45 +121,82 @@ Two things work differently from the postgresql-simple driver: -* `fold`'s step function is pure (`a -> Result name -> a`) — hasql folds a - result without `IO`. +* There is no `fold`. A query's result shape is fixed by its command + annotation, so a query you want to fold, or to decode into something other + than the generated row, is a query to declare with that shape. * `sqlc.slice` parameters are bound as one array parameter, which PostgreSQL only accepts with the array operators, so `IN ($1)` is generated as `= ANY ($1)` and `NOT IN ($1)` as `<> ALL ($1)`. A slice used anywhere else is an error; write `= ANY(sqlc.arg(...)::type[])` in your SQL instead of using `sqlc.slice`. +#### One instance per query + +Each query module carries a [`hasql-mapping`][hasql-mapping] `IsStatement` +instance for its parameters, which is where the SQL, the parameter encoder and +the result decoder come together: + +```haskell +instance IsStatement (Params "ListUsers") where + type Result (Params "ListUsers") = Data.Vector.Vector (Queries.Internal.Result "ListUsers") + statement = Hasql.Statement.preparable sql paramsEncoder (Hasql.Decoders.rowVector rowDecoder) + where + Query sql = query_ListUsers +``` + +The associated `Result` is what sqlc's command annotation means, spelled as a +type: `Maybe` a row for `:one`, a `Vector` of them for `:many`, `()` for +`:exec`, `Int64` for `:execrows`. The runners above return it, which is why they +need no constraint beyond `IsStatement`. + +The parameter encoder and row decoder are local to `statement`: the instance is +the interface, and a query module exports nothing but its `Query`, its `Params` +and its `Result`. + +Anything that takes an `IsStatement` — `Hasql.Mapping.IsStatement.toSession`, +`toTransaction` — therefore works on a generated query without adapting it. + #### Codecs -hasql has no `ToField`-style class. Its encoders and decoders are values, chosen -per SQL type, and from 1.10 on it checks that a column's type matches the -decoder reading it — so `text`, `varchar` and `bpchar`, all `Text` on the -Haskell side, each need their own decoder. sqlc-hs picks the codec from the SQL -type sqlc reported, for every type it knows. +hasql's encoders and decoders are values, chosen per SQL type, and from 1.10 on +it checks that a column's type matches the decoder reading it — so `text`, +`varchar` and `bpchar`, all `Text` on the Haskell side, each need their own +decoder. sqlc-hs picks the codec from the SQL type sqlc reported, for every type +it knows. Columns typed by an `overrides` entry are a different matter: sqlc-hs cannot -know what codec your type wants. Those go through the `ToField` and `FromField` -classes that the generated `Queries.Internal` module declares: +know what codec your type wants. Those go through +[`hasql-mapping`][hasql-mapping]'s `IsScalar`: ```haskell -class ToField a where toField :: Hasql.Encoders.Value a -class FromField a where fromField :: Hasql.Decoders.Value a +class IsScalar a where + encoder :: Hasql.Encoders.Value a + decoder :: Hasql.Decoders.Value a ``` Instances ship for `Bool`, the sized `Int`s, `Float`, `Double`, `Scientific`, -`Char`, `Text`, `ByteString`, `UUID`, `Day`, `LocalTime`, `UTCTime`, -`TimeOfDay`, `(TimeOfDay, TimeZone)`, `DiffTime`, `Data.Aeson.Value`, and lists -and vectors of those. The usual overrides therefore need nothing extra — a -`uuid` column mapped to `Data.UUID.UUID`, a `timestamptz` to `UTCTime`, a `date` -to `Day` all work as they stand. For a type of your own, write the instance: +`Text`, `ByteString`, `UUID`, `Day`, `LocalTime`, `UTCTime`, `TimeOfDay`, +`(TimeOfDay, TimeZone)`, `DiffTime`, `IPRange` and `Data.Aeson.Value`. The usual +overrides therefore need nothing extra — a `uuid` column mapped to +`Data.UUID.UUID`, a `timestamptz` to `UTCTime`, a `date` to `Day` all work as +they stand. For a type of your own, write the instance: ```haskell -instance ToField UserId where - toField = Data.Functor.Contravariant.contramap unUserId toField - -instance FromField UserId where - fromField = fmap UserId fromField +instance IsScalar UserId where + encoder = Data.Functor.Contravariant.contramap unUserId encoder + decoder = fmap UserId decoder ``` + +`IsScalar` is scalar-only by contract, so do not instantiate it for an array +type: an array *column* is wrapped for you from the column's own arrayness, and +an override whose Haskell type is itself an array should name its codecs with +`hasql_encoder` and `hasql_decoder` instead. + +Because the class comes from a library rather than from the generated code, the +instance can live wherever the type does — including a package the generated one +depends on, which an instance of a generated class could not. + +[hasql-mapping]: https://hackage.haskell.org/package/hasql-mapping When an instance is the wrong place for it, because the same Haskell type wants different codecs in different columns, an override can name the codecs itself diff --git a/sqlc-hs.cabal b/sqlc-hs.cabal --- a/sqlc-hs.cabal +++ b/sqlc-hs.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: sqlc-hs -version: 0.3.0.0 +version: 0.4.0.0 -- synopsis: -- description: diff --git a/src/Sqlc/Hs/Codegen.hs b/src/Sqlc/Hs/Codegen.hs --- a/src/Sqlc/Hs/Codegen.hs +++ b/src/Sqlc/Hs/Codegen.hs @@ -209,11 +209,13 @@ ) Just Hasql -> ( internalHasqlTemplate, - -- The ToField/FromField instances the internal module ships cover - -- the types the built-in mappings and the common overrides use. - -- Every one of these packages is already in hasql's own dependency + -- hasql-mapping supplies IsScalar, the codec class an override's + -- type is resolved through, and IsStatement, which the per-query + -- modules instantiate. The rest are for the types the built-in + -- mappings use, and are all already in hasql's own dependency -- closure, so none of them costs an extra build. [ HaskellType {package = Just "hasql", module' = Just "Hasql.Session", name = Just "Session"}, + HaskellType {package = Just "hasql-mapping", module' = Just "Hasql.Mapping.IsScalar", name = Just "IsScalar"}, HaskellType {package = Just "aeson", module' = Just "Data.Aeson", name = Just "Value"}, HaskellType {package = Just "scientific", module' = Just "Data.Scientific", name = Just "Scientific"}, HaskellType {package = Just "time", module' = Just "Data.Time", name = Just "UTCTime"}, @@ -444,8 +446,49 @@ "parameterColumns" Text.EDE..= fmap (toParameterColumn . snd) parameterColumns, "queryColumns" Text.EDE..= fmap toParameterColumn (toQueryColumns parameterColumns), "encoderColumns" Text.EDE..= fmap (toParameterColumn . snd) (sortOn fst parameterColumns), - "resultColumns" Text.EDE..= fmap toResultColumn resultColumns + "resultColumns" Text.EDE..= fmap toResultColumn resultColumns, + "hasqlResultType" Text.EDE..= hasqlResultType, + "hasqlResultDecoder" Text.EDE..= hasqlResultDecoder, + -- Whether the result decoder reads rows at all, so the row decoder + -- is only bound for the commands that use it and does not sit there + -- unused under -Wall. + "hasqlDecodesRows" Text.EDE..= ((query ^. #cmd) `elem` [":one" :: Text, ":many"]) ] + + -- What 'Hasql.Mapping.IsStatement.Result' is for this query, and the + -- 'Hasql.Decoders.Result' that produces it. sqlc's command annotation + -- decides both, so the class carries what the per-command runners used to + -- express in their types. + (hasqlResultType, hasqlResultDecoder) = + case query ^. #cmd of + ":one" -> + ( "Prelude.Maybe (" <> rowType <> ")", + "Hasql.Decoders.rowMaybe rowDecoder" + ) + ":many" -> + ( "Data.Vector.Vector (" <> rowType <> ")", + "Hasql.Decoders.rowVector rowDecoder" + ) + ":execrows" -> + ("Data.Int.Int64", "Hasql.Decoders.rowsAffected") + ":execresult" -> + ( internalModule.toHaskellModuleName <> ".ExecResult", + "Prelude.fmap " + <> internalModule.toHaskellModuleName + <> ".ExecResult Hasql.Decoders.rowsAffected" + ) + -- One statement per set of parameters, so the result is per set too; + -- the caller pipelines them and folds the counts. + ":copyfrom" -> + ("Data.Int.Int64", "Hasql.Decoders.rowsAffected") + -- ":exec" and anything sqlc adds later: no rows to decode. + _ -> + ("()", "Hasql.Decoders.noResult") + where + rowType = + internalModule.toHaskellModuleName + <> ".Result " + <> show @Text (query ^. #name) pure Module diff --git a/src/Sqlc/Hs/Resolve.hs b/src/Sqlc/Hs/Resolve.hs --- a/src/Sqlc/Hs/Resolve.hs +++ b/src/Sqlc/Hs/Resolve.hs @@ -908,10 +908,10 @@ -- -- An override that carries @hasql_encoder@ / @hasql_decoder@ decides the codec -- outright. Failing that, an override that chose the column's Haskell type also --- decides its codec, so we go through the generated @ToField@ / @FromField@ --- classes, which the user can instantiate for whatever type they picked. Only --- when sqlc-hs typed the column itself do we know the codec, and then we take --- it from the SQL type. +-- decides its codec, so we go through @hasql-mapping@'s 'IsScalar', which the +-- user can instantiate for whatever type they picked. Only when sqlc-hs typed +-- the column itself do we know the codec, and then we take it from the SQL +-- type. hasqlColumnCodec :: -- | The override that matched the column, if any Maybe Override -> @@ -931,8 +931,11 @@ Nothing -> fromMaybe classCodec (hasqlValueCodec (columnDataType (column ^. #type'))) + -- One class with both methods, rather than the two sqlc-hs used to + -- declare itself. Scalar-only by contract, which is why the array wrapping + -- above stays outside it. classCodec = - ("toField", "fromField") + ("Hasql.Mapping.IsScalar.encoder", "Hasql.Mapping.IsScalar.decoder") -- | hasql's codec for a PostgreSQL type, as @(encoder, decoder)@ expressions. -- diff --git a/templates/internal.hasql.hs.jinja b/templates/internal.hasql.hs.jinja --- a/templates/internal.hasql.hs.jinja +++ b/templates/internal.hasql.hs.jinja @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} module {{ moduleName }} ( @@ -10,13 +9,6 @@ Result, {{ moduleName }}.Enum, - -- * Codecs - ToRow(..), - FromRow(..), - ToField(..), - FromField(..), - statement, - -- * :execResult ExecResult(..), execResult, @@ -37,8 +29,6 @@ -- * :many queryMany, queryManySession, - fold, - foldSession, -- * :copyfrom execMany, @@ -47,29 +37,25 @@ -- * Reexports Hasql.Connection.Connection, Hasql.Session.Session, + -- Without @(..)@: the class re-exports an associated type called @Result@, + -- which would collide with the row family of the same name above. A caller + -- that needs to name the statement's result imports + -- "Hasql.Mapping.IsStatement" directly. + Hasql.Mapping.IsStatement.IsStatement, RunnerError, Hasql.Errors.SessionError, ) where import Data.Foldable (Foldable) -import Data.Vector (Vector) import GHC.TypeLits (Symbol) -import qualified Data.Aeson -import qualified Data.ByteString import qualified Data.Foldable import qualified Data.Int -import qualified Data.Scientific import qualified Data.Text -import qualified Data.Time -import qualified Data.UUID -import qualified Data.Vector import qualified Hasql.Connection -import qualified Hasql.Decoders -import qualified Hasql.Encoders import qualified Hasql.Errors +import qualified Hasql.Mapping.IsStatement import qualified Hasql.Pipeline import qualified Hasql.Session -import qualified Hasql.Statement -- | What a runner reports when it fails. -- @@ -89,6 +75,12 @@ -- | The SQL of a query, with PostgreSQL's positional @$1@, @$2@ placeholders -- left as sqlc emitted them. +-- +-- The generated 'Hasql.Mapping.IsStatement.IsStatement' instance builds its +-- statement from this, so a runner does not need it to execute anything. It is +-- still an argument to every runner below, for two reasons: the @command@ tag +-- is what makes @queryMany@ reject a @:one@ query at compile time, and the SQL +-- is the obvious thing to attach to a trace span. newtype Query (name :: Symbol) (command :: Symbol) = Query Data.Text.Text @@ -98,309 +90,120 @@ data family Enum (name :: Symbol) --- | The parameter encoder of a query. hasql has no such class of its own -- --- encoders are plain values -- so sqlc-hs declares one and generates an --- instance per query. -class ToRow a where - toRow :: Hasql.Encoders.Params a - --- | The row decoder of a query's result. The counterpart of 'ToRow'. -class FromRow a where - fromRow :: Hasql.Decoders.Row a - --- | The codec of a single value. --- --- sqlc-hs takes hasql's codec from the SQL type for every column it typed --- itself, because hasql checks column types when decoding and @text@, @varchar@ --- and @bpchar@ need three different decoders. Columns typed through an --- @overrides@ entry go through this class instead, so a custom type only needs --- an instance here: --- --- @ --- instance ToField MyId where --- toField = Data.Functor.Contravariant.contramap unMyId toField --- @ --- --- An override can also name the codecs directly, with the @hasql_encoder@ and --- @hasql_decoder@ keys, in which case no instance is needed. -class ToField a where - toField :: Hasql.Encoders.Value a - --- | The counterpart of 'ToField'. --- --- @ --- instance FromField MyId where --- fromField = fmap MyId fromField --- @ -class FromField a where - fromField :: Hasql.Decoders.Value a - -instance ToField Bool where - toField = Hasql.Encoders.bool - -instance ToField Data.Int.Int16 where - toField = Hasql.Encoders.int2 - -instance ToField Data.Int.Int32 where - toField = Hasql.Encoders.int4 - -instance ToField Data.Int.Int64 where - toField = Hasql.Encoders.int8 - -instance ToField Float where - toField = Hasql.Encoders.float4 - -instance ToField Double where - toField = Hasql.Encoders.float8 - -instance ToField Data.Scientific.Scientific where - toField = Hasql.Encoders.numeric - -instance ToField Char where - toField = Hasql.Encoders.char - -instance ToField Data.Text.Text where - toField = Hasql.Encoders.text - -instance ToField Data.ByteString.ByteString where - toField = Hasql.Encoders.bytea - -instance ToField Data.UUID.UUID where - toField = Hasql.Encoders.uuid - -instance ToField Data.Time.Day where - toField = Hasql.Encoders.date - -instance ToField Data.Time.LocalTime where - toField = Hasql.Encoders.timestamp - -instance ToField Data.Time.UTCTime where - toField = Hasql.Encoders.timestamptz - -instance ToField Data.Time.TimeOfDay where - toField = Hasql.Encoders.time - -instance ToField (Data.Time.TimeOfDay, Data.Time.TimeZone) where - toField = Hasql.Encoders.timetz - -instance ToField Data.Time.DiffTime where - toField = Hasql.Encoders.interval - -instance ToField Data.Aeson.Value where - toField = Hasql.Encoders.jsonb - -instance (ToField a) => ToField (Data.Vector.Vector a) where - toField = Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable toField) - -instance (ToField a) => ToField [a] where - toField = Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable toField) - -instance FromField Bool where - fromField = Hasql.Decoders.bool - -instance FromField Data.Int.Int16 where - fromField = Hasql.Decoders.int2 - -instance FromField Data.Int.Int32 where - fromField = Hasql.Decoders.int4 - -instance FromField Data.Int.Int64 where - fromField = Hasql.Decoders.int8 - -instance FromField Float where - fromField = Hasql.Decoders.float4 - -instance FromField Double where - fromField = Hasql.Decoders.float8 - -instance FromField Data.Scientific.Scientific where - fromField = Hasql.Decoders.numeric - -instance FromField Char where - fromField = Hasql.Decoders.char - -instance FromField Data.Text.Text where - fromField = Hasql.Decoders.text - -instance FromField Data.ByteString.ByteString where - fromField = Hasql.Decoders.bytea - -instance FromField Data.UUID.UUID where - fromField = Hasql.Decoders.uuid - -instance FromField Data.Time.Day where - fromField = Hasql.Decoders.date - -instance FromField Data.Time.LocalTime where - fromField = Hasql.Decoders.timestamp - -instance FromField Data.Time.UTCTime where - fromField = Hasql.Decoders.timestamptz - -instance FromField Data.Time.TimeOfDay where - fromField = Hasql.Decoders.time - -instance FromField (Data.Time.TimeOfDay, Data.Time.TimeZone) where - fromField = Hasql.Decoders.timetz - -instance FromField Data.Time.DiffTime where - fromField = Hasql.Decoders.interval - -instance FromField Data.Aeson.Value where - fromField = Hasql.Decoders.jsonb - -instance (FromField a) => FromField (Data.Vector.Vector a) where - fromField = Hasql.Decoders.vectorArray (Hasql.Decoders.nonNullable fromField) - -instance (FromField a) => FromField [a] where - fromField = Hasql.Decoders.listArray (Hasql.Decoders.nonNullable fromField) - data ExecResult = ExecResult { rowsAffected :: !Data.Int.Int64 } --- | The statement a query and a result decoder make up. Use it to run a query --- inside a 'Hasql.Pipeline.Pipeline'. -statement :: - (ToRow (Params name)) => - Query name command -> - Hasql.Decoders.Result result -> - Hasql.Statement.Statement (Params name) result -statement (Query sql) decoder = - Hasql.Statement.preparable sql toRow decoder - +-- | The codecs come from the query's +-- 'Hasql.Mapping.IsStatement.IsStatement' instance, and the shape of what it +-- returns is that instance's @Result@ -- @Maybe@ a row for @:one@, a @Vector@ +-- of them for @:many@, @()@ for @:exec@, and so on. Naming it through the +-- associated type rather than spelling each shape out is what lets these +-- signatures stay free of equality constraints. exec :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":exec" -> Params name -> - IO (Either RunnerError ()) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) exec connection query params = Hasql.Connection.use connection (execSession query params) execSession :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":exec" -> Params name -> - Hasql.Session.Session () -execSession query params = - Hasql.Session.statement params (statement query Hasql.Decoders.noResult) + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +execSession _query params = + Hasql.Mapping.IsStatement.toSession params execRows :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":execrows" -> Params name -> - IO (Either RunnerError Data.Int.Int64) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) execRows connection query params = Hasql.Connection.use connection (execRowsSession query params) execRowsSession :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":execrows" -> Params name -> - Hasql.Session.Session Data.Int.Int64 -execRowsSession query params = - Hasql.Session.statement params (statement query Hasql.Decoders.rowsAffected) + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +execRowsSession _query params = + Hasql.Mapping.IsStatement.toSession params execResult :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":execresult" -> Params name -> - IO (Either RunnerError ExecResult) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) execResult connection query params = Hasql.Connection.use connection (execResultSession query params) execResultSession :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":execresult" -> Params name -> - Hasql.Session.Session ExecResult -execResultSession query params = do - rowsAffected <- Hasql.Session.statement params (statement query Hasql.Decoders.rowsAffected) - pure ExecResult { - rowsAffected - } + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +execResultSession _query params = + Hasql.Mapping.IsStatement.toSession params queryOne :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":one" -> Params name -> - IO (Either RunnerError (Maybe (Result name))) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) queryOne connection query params = Hasql.Connection.use connection (queryOneSession query params) queryOneSession :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":one" -> Params name -> - Hasql.Session.Session (Maybe (Result name)) -queryOneSession query params = - Hasql.Session.statement params (statement query (Hasql.Decoders.rowMaybe fromRow)) + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +queryOneSession _query params = + Hasql.Mapping.IsStatement.toSession params queryMany :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":many" -> Params name -> - IO (Either RunnerError (Vector (Result name))) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) queryMany connection query params = Hasql.Connection.use connection (queryManySession query params) queryManySession :: - (ToRow (Params name), FromRow (Result name)) => - Query name ":many" -> - Params name -> - Hasql.Session.Session (Vector (Result name)) -queryManySession query params = - Hasql.Session.statement params (statement query (Hasql.Decoders.rowVector fromRow)) - --- | Note that hasql folds a result purely, so unlike the postgresql-simple --- backend the step function is not in 'IO'. -fold :: - (ToRow (Params name), FromRow (Result name)) => - Hasql.Connection.Connection -> - Query name ":many" -> - Params name -> - a -> - (a -> Result name -> a) -> - IO (Either RunnerError a) -fold connection query params initial step = - Hasql.Connection.use connection (foldSession query params initial step) -{-# INLINABLE fold #-} - -foldSession :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":many" -> Params name -> - a -> - (a -> Result name -> a) -> - Hasql.Session.Session a -foldSession query params initial step = - Hasql.Session.statement params (statement query (Hasql.Decoders.foldlRows step initial fromRow)) -{-# INLINABLE foldSession #-} + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +queryManySession _query params = + Hasql.Mapping.IsStatement.toSession params -- | Runs the query once per set of parameters, pipelined into a single --- round trip, and returns the total number of rows affected. +-- round trip. execMany :: - (ToRow (Params name), Foldable f) => + (Hasql.Mapping.IsStatement.IsStatement (Params name), Foldable f) => Hasql.Connection.Connection -> Query name ":copyfrom" -> f (Params name) -> - IO (Either RunnerError Data.Int.Int64) + IO (Either RunnerError [Hasql.Mapping.IsStatement.Result (Params name)]) execMany connection query params = Hasql.Connection.use connection (execManySession query params) execManySession :: - (ToRow (Params name), Foldable f) => + (Hasql.Mapping.IsStatement.IsStatement (Params name), Foldable f) => Query name ":copyfrom" -> f (Params name) -> - Hasql.Session.Session Data.Int.Int64 -execManySession query params = + Hasql.Session.Session [Hasql.Mapping.IsStatement.Result (Params name)] +execManySession _query params = Hasql.Session.pipeline - (fmap sum (traverse pipelined (Data.Foldable.toList params))) + (traverse pipelined (Data.Foldable.toList params)) where pipelined param = - Hasql.Pipeline.statement param (statement query Hasql.Decoders.rowsAffected) + Hasql.Pipeline.statement param Hasql.Mapping.IsStatement.statement diff --git a/templates/query.hs.jinja b/templates/query.hs.jinja --- a/templates/query.hs.jinja +++ b/templates/query.hs.jinja @@ -16,9 +16,19 @@ import qualified Database.PostgreSQL.Simple.ToRow {% endif %} {% if generateHasql %} -import {{ internalModuleName }} (Query(..), Enum, Params, Result, ToRow(..), FromRow(..), ToField(..), FromField(..)) +import {{ internalModuleName }} (Query(..), Enum, Params) +{# The row type is named `Result`, and so is IsStatement's associated type. GHC + rejects a qualified name on the left of an associated type instance + (GHC-28329), so it is the row family that gets qualified instead. Kept as a + template comment: it explains this template, not the code it emits. #} +import qualified {{ internalModuleName }} +import qualified Data.Int +import qualified Data.Vector import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar +import qualified Hasql.Mapping.IsStatement +import qualified Hasql.Statement {% endif %} {% if generateSqlite %} import {{ internalModuleName }} (Query(..), Enum, Params, Result) @@ -48,7 +58,11 @@ {% endfor %} } +{% if generateHasql %} +data instance {{ internalModuleName }}.Result {{ escapedQueryName }} = {{ haskellResultName }} +{% else %} data instance Result {{ escapedQueryName }} = {{ haskellResultName }} +{% endif %} { {% for column in resultColumns %} {{ column.value.name }} :: !({{ column.value.type }}){% if !column.last %},{% endif %} @@ -79,22 +93,30 @@ {% endfor %} {% endif %} {% if generateHasql %} -instance ToRow (Params {{ escapedQueryName }}) where - {-# INLINE toRow #-} - toRow = - mconcat - [ {% for param in encoderColumns %} - Data.Functor.Contravariant.contramap (\{{ haskellParamsName }}{..} -> {{ param.value.name }}) (Hasql.Encoders.param ({{ param.value.encoder }})){% if !param.last %}, {% endif %} - {% endfor %} - ] +instance Hasql.Mapping.IsStatement.IsStatement (Params {{ escapedQueryName }}) where + type Result (Params {{ escapedQueryName }}) = {{ hasqlResultType }} + statement = + Hasql.Statement.preparable sql paramsEncoder ({{ hasqlResultDecoder }}) + where + Query sql = {{ haskellQueryName }} -instance FromRow (Result {{ escapedQueryName }}) where - {-# INLINE fromRow #-} - fromRow = - pure {{ haskellResultName }} - {% for column in resultColumns %} - <*> Hasql.Decoders.column ({{ column.value.decoder }}) - {% endfor %} + paramsEncoder :: Hasql.Encoders.Params (Params {{ escapedQueryName }}) + paramsEncoder = + mconcat + [ {% for param in encoderColumns %} + Data.Functor.Contravariant.contramap (\{{ haskellParamsName }}{..} -> {{ param.value.name }}) (Hasql.Encoders.param ({{ param.value.encoder }})){% if !param.last %}, {% endif %} + {% endfor %} + ] + {-# INLINE paramsEncoder #-} +{% if hasqlDecodesRows %} + rowDecoder :: Hasql.Decoders.Row ({{ internalModuleName }}.Result {{ escapedQueryName }}) + rowDecoder = + pure {{ haskellResultName }} + {% for column in resultColumns %} + <*> Hasql.Decoders.column ({{ column.value.decoder }}) + {% endfor %} + {-# INLINE rowDecoder #-} +{% endif %} {% endif %} {% if generateSqlite %} diff --git a/templates/types.hs.jinja b/templates/types.hs.jinja --- a/templates/types.hs.jinja +++ b/templates/types.hs.jinja @@ -21,6 +21,7 @@ {% if generateHasql %} import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar {% endif %} {% if generateSqlite %} import qualified Database.SQLite.Simple.FromRow @@ -63,16 +64,14 @@ Nothing -> Database.PostgreSQL.Simple.FromField.returnError Database.PostgreSQL.Simple.FromField.UnexpectedNull field "" {% endif %} {% if generateHasql %} -instance ToField (Enum {{ enum.value.escapedEnumName }}) where - toField = +instance Hasql.Mapping.IsScalar.IsScalar (Enum {{ enum.value.escapedEnumName }}) where + encoder = Hasql.Encoders.enum {{ enum.value.escapedEnumSchema }} {{ enum.value.escapedEnumName }} $ \x -> case x of {% for value in enum.value.values %} {{ value.value.haskellConstructorName }} -> {{ value.value.escapedEnumValue }} {% endfor %} - -instance FromField (Enum {{ enum.value.escapedEnumName }}) where - fromField = + decoder = Hasql.Decoders.enum {{ enum.value.escapedEnumSchema }} {{ enum.value.escapedEnumName }} $ \x -> case x of {% for value in enum.value.values %} diff --git a/test/golden/hasql-features/Queries/DeleteUsers.hs b/test/golden/hasql-features/Queries/DeleteUsers.hs --- a/test/golden/hasql-features/Queries/DeleteUsers.hs +++ b/test/golden/hasql-features/Queries/DeleteUsers.hs @@ -8,9 +8,15 @@ {-# LANGUAGE TypeFamilies #-} module Queries.DeleteUsers where -import Queries.Internal (Query(..), Enum, Params, Result, ToRow(..), FromRow(..), ToField(..), FromField(..)) +import Queries.Internal (Query(..), Enum, Params) +import qualified Queries.Internal +import qualified Data.Int +import qualified Data.Vector import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar +import qualified Hasql.Mapping.IsStatement +import qualified Hasql.Statement import qualified Data.Foldable import qualified Data.Functor.Contravariant @@ -22,19 +28,21 @@ { } -data instance Result "DeleteUsers" = Result_DeleteUsers +data instance Queries.Internal.Result "DeleteUsers" = Result_DeleteUsers { } -instance ToRow (Params "DeleteUsers") where - {-# INLINE toRow #-} - toRow = - mconcat - [ ] +instance Hasql.Mapping.IsStatement.IsStatement (Params "DeleteUsers") where + type Result (Params "DeleteUsers") = () + statement = + Hasql.Statement.preparable sql paramsEncoder (Hasql.Decoders.noResult) + where + Query sql = query_DeleteUsers -instance FromRow (Result "DeleteUsers") where - {-# INLINE fromRow #-} - fromRow = - pure Result_DeleteUsers + paramsEncoder :: Hasql.Encoders.Params (Params "DeleteUsers") + paramsEncoder = + mconcat + [ ] + {-# INLINE paramsEncoder #-} diff --git a/test/golden/hasql-features/Queries/FindMembers.hs b/test/golden/hasql-features/Queries/FindMembers.hs --- a/test/golden/hasql-features/Queries/FindMembers.hs +++ b/test/golden/hasql-features/Queries/FindMembers.hs @@ -8,9 +8,15 @@ {-# LANGUAGE TypeFamilies #-} module Queries.FindMembers where -import Queries.Internal (Query(..), Enum, Params, Result, ToRow(..), FromRow(..), ToField(..), FromField(..)) +import Queries.Internal (Query(..), Enum, Params) +import qualified Queries.Internal +import qualified Data.Int +import qualified Data.Vector import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar +import qualified Hasql.Mapping.IsStatement +import qualified Hasql.Statement import qualified Queries.Types import qualified GHC.Base @@ -25,25 +31,31 @@ role :: (Queries.Types.Enum "organization_role") } -data instance Result "FindMembers" = Result_FindMembers +data instance Queries.Internal.Result "FindMembers" = Result_FindMembers { role :: !((Queries.Types.Enum "organization_role")), previous_role :: !(GHC.Base.Maybe ((Queries.Types.Enum "organization_role"))) } -instance ToRow (Params "FindMembers") where - {-# INLINE toRow #-} - toRow = - mconcat - [ - Data.Functor.Contravariant.contramap (\Params_FindMembers{..} -> role) (Hasql.Encoders.param (Hasql.Encoders.nonNullable toField)) - ] +instance Hasql.Mapping.IsStatement.IsStatement (Params "FindMembers") where + type Result (Params "FindMembers") = Data.Vector.Vector (Queries.Internal.Result "FindMembers") + statement = + Hasql.Statement.preparable sql paramsEncoder (Hasql.Decoders.rowVector rowDecoder) + where + Query sql = query_FindMembers -instance FromRow (Result "FindMembers") where - {-# INLINE fromRow #-} - fromRow = - pure Result_FindMembers - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable fromField) - <*> Hasql.Decoders.column (Hasql.Decoders.nullable fromField) + paramsEncoder :: Hasql.Encoders.Params (Params "FindMembers") + paramsEncoder = + mconcat + [ + Data.Functor.Contravariant.contramap (\Params_FindMembers{..} -> role) (Hasql.Encoders.param (Hasql.Encoders.nonNullable Hasql.Mapping.IsScalar.encoder)) + ] + {-# INLINE paramsEncoder #-} + rowDecoder :: Hasql.Decoders.Row (Queries.Internal.Result "FindMembers") + rowDecoder = + pure Result_FindMembers + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Mapping.IsScalar.decoder) + <*> Hasql.Decoders.column (Hasql.Decoders.nullable Hasql.Mapping.IsScalar.decoder) + {-# INLINE rowDecoder #-} diff --git a/test/golden/hasql-features/Queries/FindPosts.hs b/test/golden/hasql-features/Queries/FindPosts.hs --- a/test/golden/hasql-features/Queries/FindPosts.hs +++ b/test/golden/hasql-features/Queries/FindPosts.hs @@ -8,9 +8,15 @@ {-# LANGUAGE TypeFamilies #-} module Queries.FindPosts where -import Queries.Internal (Query(..), Enum, Params, Result, ToRow(..), FromRow(..), ToField(..), FromField(..)) +import Queries.Internal (Query(..), Enum, Params) +import qualified Queries.Internal +import qualified Data.Int +import qualified Data.Vector import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar +import qualified Hasql.Mapping.IsStatement +import qualified Hasql.Statement import qualified Data.Text import qualified Data.Vector @@ -26,25 +32,31 @@ tags :: Data.Vector.Vector Data.Text.Text } -data instance Result "FindPosts" = Result_FindPosts +data instance Queries.Internal.Result "FindPosts" = Result_FindPosts { tags :: !(Data.Vector.Vector Data.Text.Text), labels :: !(GHC.Base.Maybe (Data.Vector.Vector Data.Text.Text)) } -instance ToRow (Params "FindPosts") where - {-# INLINE toRow #-} - toRow = - mconcat - [ - Data.Functor.Contravariant.contramap (\Params_FindPosts{..} -> tags) (Hasql.Encoders.param (Hasql.Encoders.nonNullable (Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable Hasql.Encoders.text)))) - ] +instance Hasql.Mapping.IsStatement.IsStatement (Params "FindPosts") where + type Result (Params "FindPosts") = Data.Vector.Vector (Queries.Internal.Result "FindPosts") + statement = + Hasql.Statement.preparable sql paramsEncoder (Hasql.Decoders.rowVector rowDecoder) + where + Query sql = query_FindPosts -instance FromRow (Result "FindPosts") where - {-# INLINE fromRow #-} - fromRow = - pure Result_FindPosts - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable (Hasql.Decoders.vectorArray (Hasql.Decoders.nonNullable Hasql.Decoders.text))) - <*> Hasql.Decoders.column (Hasql.Decoders.nullable (Hasql.Decoders.vectorArray (Hasql.Decoders.nonNullable Hasql.Decoders.varchar))) + paramsEncoder :: Hasql.Encoders.Params (Params "FindPosts") + paramsEncoder = + mconcat + [ + Data.Functor.Contravariant.contramap (\Params_FindPosts{..} -> tags) (Hasql.Encoders.param (Hasql.Encoders.nonNullable (Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable Hasql.Encoders.text)))) + ] + {-# INLINE paramsEncoder #-} + rowDecoder :: Hasql.Decoders.Row (Queries.Internal.Result "FindPosts") + rowDecoder = + pure Result_FindPosts + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable (Hasql.Decoders.vectorArray (Hasql.Decoders.nonNullable Hasql.Decoders.text))) + <*> Hasql.Decoders.column (Hasql.Decoders.nullable (Hasql.Decoders.vectorArray (Hasql.Decoders.nonNullable Hasql.Decoders.varchar))) + {-# INLINE rowDecoder #-} diff --git a/test/golden/hasql-features/Queries/FindUserByName.hs b/test/golden/hasql-features/Queries/FindUserByName.hs --- a/test/golden/hasql-features/Queries/FindUserByName.hs +++ b/test/golden/hasql-features/Queries/FindUserByName.hs @@ -8,9 +8,15 @@ {-# LANGUAGE TypeFamilies #-} module Queries.FindUserByName where -import Queries.Internal (Query(..), Enum, Params, Result, ToRow(..), FromRow(..), ToField(..), FromField(..)) +import Queries.Internal (Query(..), Enum, Params) +import qualified Queries.Internal +import qualified Data.Int +import qualified Data.Vector import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar +import qualified Hasql.Mapping.IsStatement +import qualified Hasql.Statement import qualified Data.Text import qualified Data.Int @@ -25,23 +31,29 @@ name :: Data.Text.Text } -data instance Result "FindUserByName" = Result_FindUserByName +data instance Queries.Internal.Result "FindUserByName" = Result_FindUserByName { id :: !(Data.Int.Int32) } -instance ToRow (Params "FindUserByName") where - {-# INLINE toRow #-} - toRow = - mconcat - [ - Data.Functor.Contravariant.contramap (\Params_FindUserByName{..} -> name) (Hasql.Encoders.param (Hasql.Encoders.nonNullable Hasql.Encoders.text)) - ] +instance Hasql.Mapping.IsStatement.IsStatement (Params "FindUserByName") where + type Result (Params "FindUserByName") = Data.Vector.Vector (Queries.Internal.Result "FindUserByName") + statement = + Hasql.Statement.preparable sql paramsEncoder (Hasql.Decoders.rowVector rowDecoder) + where + Query sql = query_FindUserByName -instance FromRow (Result "FindUserByName") where - {-# INLINE fromRow #-} - fromRow = - pure Result_FindUserByName - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.int4) + paramsEncoder :: Hasql.Encoders.Params (Params "FindUserByName") + paramsEncoder = + mconcat + [ + Data.Functor.Contravariant.contramap (\Params_FindUserByName{..} -> name) (Hasql.Encoders.param (Hasql.Encoders.nonNullable Hasql.Encoders.text)) + ] + {-# INLINE paramsEncoder #-} + rowDecoder :: Hasql.Decoders.Row (Queries.Internal.Result "FindUserByName") + rowDecoder = + pure Result_FindUserByName + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.int4) + {-# INLINE rowDecoder #-} diff --git a/test/golden/hasql-features/Queries/FindUsers.hs b/test/golden/hasql-features/Queries/FindUsers.hs --- a/test/golden/hasql-features/Queries/FindUsers.hs +++ b/test/golden/hasql-features/Queries/FindUsers.hs @@ -8,9 +8,15 @@ {-# LANGUAGE TypeFamilies #-} module Queries.FindUsers where -import Queries.Internal (Query(..), Enum, Params, Result, ToRow(..), FromRow(..), ToField(..), FromField(..)) +import Queries.Internal (Query(..), Enum, Params) +import qualified Queries.Internal +import qualified Data.Int +import qualified Data.Vector import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar +import qualified Hasql.Mapping.IsStatement +import qualified Hasql.Statement import qualified Data.Text import qualified Data.Int @@ -27,27 +33,33 @@ age :: Data.Int.Int32 } -data instance Result "FindUsers" = Result_FindUsers +data instance Queries.Internal.Result "FindUsers" = Result_FindUsers { id :: !(Data.Int.Int32) } -instance ToRow (Params "FindUsers") where - {-# INLINE toRow #-} - toRow = - mconcat - [ - Data.Functor.Contravariant.contramap (\Params_FindUsers{..} -> names) (Hasql.Encoders.param (Hasql.Encoders.nonNullable (Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable Hasql.Encoders.text)))), +instance Hasql.Mapping.IsStatement.IsStatement (Params "FindUsers") where + type Result (Params "FindUsers") = Data.Vector.Vector (Queries.Internal.Result "FindUsers") + statement = + Hasql.Statement.preparable sql paramsEncoder (Hasql.Decoders.rowVector rowDecoder) + where + Query sql = query_FindUsers - Data.Functor.Contravariant.contramap (\Params_FindUsers{..} -> emails) (Hasql.Encoders.param (Hasql.Encoders.nonNullable (Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable Hasql.Encoders.text)))), + paramsEncoder :: Hasql.Encoders.Params (Params "FindUsers") + paramsEncoder = + mconcat + [ + Data.Functor.Contravariant.contramap (\Params_FindUsers{..} -> names) (Hasql.Encoders.param (Hasql.Encoders.nonNullable (Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable Hasql.Encoders.text)))), - Data.Functor.Contravariant.contramap (\Params_FindUsers{..} -> age) (Hasql.Encoders.param (Hasql.Encoders.nonNullable Hasql.Encoders.int4)) - ] + Data.Functor.Contravariant.contramap (\Params_FindUsers{..} -> emails) (Hasql.Encoders.param (Hasql.Encoders.nonNullable (Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable Hasql.Encoders.text)))), -instance FromRow (Result "FindUsers") where - {-# INLINE fromRow #-} - fromRow = - pure Result_FindUsers - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.int4) + Data.Functor.Contravariant.contramap (\Params_FindUsers{..} -> age) (Hasql.Encoders.param (Hasql.Encoders.nonNullable Hasql.Encoders.int4)) + ] + {-# INLINE paramsEncoder #-} + rowDecoder :: Hasql.Decoders.Row (Queries.Internal.Result "FindUsers") + rowDecoder = + pure Result_FindUsers + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.int4) + {-# INLINE rowDecoder #-} diff --git a/test/golden/hasql-features/Queries/GetEvent.hs b/test/golden/hasql-features/Queries/GetEvent.hs --- a/test/golden/hasql-features/Queries/GetEvent.hs +++ b/test/golden/hasql-features/Queries/GetEvent.hs @@ -8,9 +8,15 @@ {-# LANGUAGE TypeFamilies #-} module Queries.GetEvent where -import Queries.Internal (Query(..), Enum, Params, Result, ToRow(..), FromRow(..), ToField(..), FromField(..)) +import Queries.Internal (Query(..), Enum, Params) +import qualified Queries.Internal +import qualified Data.Int +import qualified Data.Vector import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar +import qualified Hasql.Mapping.IsStatement +import qualified Hasql.Statement import qualified Data.UUID import qualified Data.Time @@ -26,7 +32,7 @@ since :: Data.Time.UTCTime } -data instance Result "GetEvent" = Result_GetEvent +data instance Queries.Internal.Result "GetEvent" = Result_GetEvent { id :: !(Data.UUID.UUID), created_at :: !(Data.Time.UTCTime), @@ -34,23 +40,29 @@ legacy_at :: !(Data.Time.UTCTime) } -instance ToRow (Params "GetEvent") where - {-# INLINE toRow #-} - toRow = - mconcat - [ - Data.Functor.Contravariant.contramap (\Params_GetEvent{..} -> id) (Hasql.Encoders.param (Hasql.Encoders.nonNullable toField)), +instance Hasql.Mapping.IsStatement.IsStatement (Params "GetEvent") where + type Result (Params "GetEvent") = Prelude.Maybe (Queries.Internal.Result "GetEvent") + statement = + Hasql.Statement.preparable sql paramsEncoder (Hasql.Decoders.rowMaybe rowDecoder) + where + Query sql = query_GetEvent - Data.Functor.Contravariant.contramap (\Params_GetEvent{..} -> since) (Hasql.Encoders.param (Hasql.Encoders.nonNullable (Data.Functor.Contravariant.contramap (Data.Time.utcToLocalTime Data.Time.utc) Hasql.Encoders.timestamp))) - ] + paramsEncoder :: Hasql.Encoders.Params (Params "GetEvent") + paramsEncoder = + mconcat + [ + Data.Functor.Contravariant.contramap (\Params_GetEvent{..} -> id) (Hasql.Encoders.param (Hasql.Encoders.nonNullable Hasql.Mapping.IsScalar.encoder)), -instance FromRow (Result "GetEvent") where - {-# INLINE fromRow #-} - fromRow = - pure Result_GetEvent - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable fromField) - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable fromField) - <*> Hasql.Decoders.column (Hasql.Decoders.nullable fromField) - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable (fmap (Data.Time.localTimeToUTC Data.Time.utc) Hasql.Decoders.timestamp)) + Data.Functor.Contravariant.contramap (\Params_GetEvent{..} -> since) (Hasql.Encoders.param (Hasql.Encoders.nonNullable (Data.Functor.Contravariant.contramap (Data.Time.utcToLocalTime Data.Time.utc) Hasql.Encoders.timestamp))) + ] + {-# INLINE paramsEncoder #-} + rowDecoder :: Hasql.Decoders.Row (Queries.Internal.Result "GetEvent") + rowDecoder = + pure Result_GetEvent + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Mapping.IsScalar.decoder) + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Mapping.IsScalar.decoder) + <*> Hasql.Decoders.column (Hasql.Decoders.nullable Hasql.Mapping.IsScalar.decoder) + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable (fmap (Data.Time.localTimeToUTC Data.Time.utc) Hasql.Decoders.timestamp)) + {-# INLINE rowDecoder #-} diff --git a/test/golden/hasql-features/Queries/Internal.hs b/test/golden/hasql-features/Queries/Internal.hs --- a/test/golden/hasql-features/Queries/Internal.hs +++ b/test/golden/hasql-features/Queries/Internal.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} module Queries.Internal ( @@ -10,13 +9,6 @@ Result, Queries.Internal.Enum, - -- * Codecs - ToRow(..), - FromRow(..), - ToField(..), - FromField(..), - statement, - -- * :execResult ExecResult(..), execResult, @@ -37,8 +29,6 @@ -- * :many queryMany, queryManySession, - fold, - foldSession, -- * :copyfrom execMany, @@ -47,29 +37,25 @@ -- * Reexports Hasql.Connection.Connection, Hasql.Session.Session, + -- Without @(..)@: the class re-exports an associated type called @Result@, + -- which would collide with the row family of the same name above. A caller + -- that needs to name the statement's result imports + -- "Hasql.Mapping.IsStatement" directly. + Hasql.Mapping.IsStatement.IsStatement, RunnerError, Hasql.Errors.SessionError, ) where import Data.Foldable (Foldable) -import Data.Vector (Vector) import GHC.TypeLits (Symbol) -import qualified Data.Aeson -import qualified Data.ByteString import qualified Data.Foldable import qualified Data.Int -import qualified Data.Scientific import qualified Data.Text -import qualified Data.Time -import qualified Data.UUID -import qualified Data.Vector import qualified Hasql.Connection -import qualified Hasql.Decoders -import qualified Hasql.Encoders import qualified Hasql.Errors +import qualified Hasql.Mapping.IsStatement import qualified Hasql.Pipeline import qualified Hasql.Session -import qualified Hasql.Statement -- | What a runner reports when it fails. -- @@ -89,6 +75,12 @@ -- | The SQL of a query, with PostgreSQL's positional @$1@, @$2@ placeholders -- left as sqlc emitted them. +-- +-- The generated 'Hasql.Mapping.IsStatement.IsStatement' instance builds its +-- statement from this, so a runner does not need it to execute anything. It is +-- still an argument to every runner below, for two reasons: the @command@ tag +-- is what makes @queryMany@ reject a @:one@ query at compile time, and the SQL +-- is the obvious thing to attach to a trace span. newtype Query (name :: Symbol) (command :: Symbol) = Query Data.Text.Text @@ -98,309 +90,120 @@ data family Enum (name :: Symbol) --- | The parameter encoder of a query. hasql has no such class of its own -- --- encoders are plain values -- so sqlc-hs declares one and generates an --- instance per query. -class ToRow a where - toRow :: Hasql.Encoders.Params a - --- | The row decoder of a query's result. The counterpart of 'ToRow'. -class FromRow a where - fromRow :: Hasql.Decoders.Row a - --- | The codec of a single value. --- --- sqlc-hs takes hasql's codec from the SQL type for every column it typed --- itself, because hasql checks column types when decoding and @text@, @varchar@ --- and @bpchar@ need three different decoders. Columns typed through an --- @overrides@ entry go through this class instead, so a custom type only needs --- an instance here: --- --- @ --- instance ToField MyId where --- toField = Data.Functor.Contravariant.contramap unMyId toField --- @ --- --- An override can also name the codecs directly, with the @hasql_encoder@ and --- @hasql_decoder@ keys, in which case no instance is needed. -class ToField a where - toField :: Hasql.Encoders.Value a - --- | The counterpart of 'ToField'. --- --- @ --- instance FromField MyId where --- fromField = fmap MyId fromField --- @ -class FromField a where - fromField :: Hasql.Decoders.Value a - -instance ToField Bool where - toField = Hasql.Encoders.bool - -instance ToField Data.Int.Int16 where - toField = Hasql.Encoders.int2 - -instance ToField Data.Int.Int32 where - toField = Hasql.Encoders.int4 - -instance ToField Data.Int.Int64 where - toField = Hasql.Encoders.int8 - -instance ToField Float where - toField = Hasql.Encoders.float4 - -instance ToField Double where - toField = Hasql.Encoders.float8 - -instance ToField Data.Scientific.Scientific where - toField = Hasql.Encoders.numeric - -instance ToField Char where - toField = Hasql.Encoders.char - -instance ToField Data.Text.Text where - toField = Hasql.Encoders.text - -instance ToField Data.ByteString.ByteString where - toField = Hasql.Encoders.bytea - -instance ToField Data.UUID.UUID where - toField = Hasql.Encoders.uuid - -instance ToField Data.Time.Day where - toField = Hasql.Encoders.date - -instance ToField Data.Time.LocalTime where - toField = Hasql.Encoders.timestamp - -instance ToField Data.Time.UTCTime where - toField = Hasql.Encoders.timestamptz - -instance ToField Data.Time.TimeOfDay where - toField = Hasql.Encoders.time - -instance ToField (Data.Time.TimeOfDay, Data.Time.TimeZone) where - toField = Hasql.Encoders.timetz - -instance ToField Data.Time.DiffTime where - toField = Hasql.Encoders.interval - -instance ToField Data.Aeson.Value where - toField = Hasql.Encoders.jsonb - -instance (ToField a) => ToField (Data.Vector.Vector a) where - toField = Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable toField) - -instance (ToField a) => ToField [a] where - toField = Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable toField) - -instance FromField Bool where - fromField = Hasql.Decoders.bool - -instance FromField Data.Int.Int16 where - fromField = Hasql.Decoders.int2 - -instance FromField Data.Int.Int32 where - fromField = Hasql.Decoders.int4 - -instance FromField Data.Int.Int64 where - fromField = Hasql.Decoders.int8 - -instance FromField Float where - fromField = Hasql.Decoders.float4 - -instance FromField Double where - fromField = Hasql.Decoders.float8 - -instance FromField Data.Scientific.Scientific where - fromField = Hasql.Decoders.numeric - -instance FromField Char where - fromField = Hasql.Decoders.char - -instance FromField Data.Text.Text where - fromField = Hasql.Decoders.text - -instance FromField Data.ByteString.ByteString where - fromField = Hasql.Decoders.bytea - -instance FromField Data.UUID.UUID where - fromField = Hasql.Decoders.uuid - -instance FromField Data.Time.Day where - fromField = Hasql.Decoders.date - -instance FromField Data.Time.LocalTime where - fromField = Hasql.Decoders.timestamp - -instance FromField Data.Time.UTCTime where - fromField = Hasql.Decoders.timestamptz - -instance FromField Data.Time.TimeOfDay where - fromField = Hasql.Decoders.time - -instance FromField (Data.Time.TimeOfDay, Data.Time.TimeZone) where - fromField = Hasql.Decoders.timetz - -instance FromField Data.Time.DiffTime where - fromField = Hasql.Decoders.interval - -instance FromField Data.Aeson.Value where - fromField = Hasql.Decoders.jsonb - -instance (FromField a) => FromField (Data.Vector.Vector a) where - fromField = Hasql.Decoders.vectorArray (Hasql.Decoders.nonNullable fromField) - -instance (FromField a) => FromField [a] where - fromField = Hasql.Decoders.listArray (Hasql.Decoders.nonNullable fromField) - data ExecResult = ExecResult { rowsAffected :: !Data.Int.Int64 } --- | The statement a query and a result decoder make up. Use it to run a query --- inside a 'Hasql.Pipeline.Pipeline'. -statement :: - (ToRow (Params name)) => - Query name command -> - Hasql.Decoders.Result result -> - Hasql.Statement.Statement (Params name) result -statement (Query sql) decoder = - Hasql.Statement.preparable sql toRow decoder - +-- | The codecs come from the query's +-- 'Hasql.Mapping.IsStatement.IsStatement' instance, and the shape of what it +-- returns is that instance's @Result@ -- @Maybe@ a row for @:one@, a @Vector@ +-- of them for @:many@, @()@ for @:exec@, and so on. Naming it through the +-- associated type rather than spelling each shape out is what lets these +-- signatures stay free of equality constraints. exec :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":exec" -> Params name -> - IO (Either RunnerError ()) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) exec connection query params = Hasql.Connection.use connection (execSession query params) execSession :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":exec" -> Params name -> - Hasql.Session.Session () -execSession query params = - Hasql.Session.statement params (statement query Hasql.Decoders.noResult) + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +execSession _query params = + Hasql.Mapping.IsStatement.toSession params execRows :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":execrows" -> Params name -> - IO (Either RunnerError Data.Int.Int64) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) execRows connection query params = Hasql.Connection.use connection (execRowsSession query params) execRowsSession :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":execrows" -> Params name -> - Hasql.Session.Session Data.Int.Int64 -execRowsSession query params = - Hasql.Session.statement params (statement query Hasql.Decoders.rowsAffected) + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +execRowsSession _query params = + Hasql.Mapping.IsStatement.toSession params execResult :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":execresult" -> Params name -> - IO (Either RunnerError ExecResult) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) execResult connection query params = Hasql.Connection.use connection (execResultSession query params) execResultSession :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":execresult" -> Params name -> - Hasql.Session.Session ExecResult -execResultSession query params = do - rowsAffected <- Hasql.Session.statement params (statement query Hasql.Decoders.rowsAffected) - pure ExecResult { - rowsAffected - } + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +execResultSession _query params = + Hasql.Mapping.IsStatement.toSession params queryOne :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":one" -> Params name -> - IO (Either RunnerError (Maybe (Result name))) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) queryOne connection query params = Hasql.Connection.use connection (queryOneSession query params) queryOneSession :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":one" -> Params name -> - Hasql.Session.Session (Maybe (Result name)) -queryOneSession query params = - Hasql.Session.statement params (statement query (Hasql.Decoders.rowMaybe fromRow)) + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +queryOneSession _query params = + Hasql.Mapping.IsStatement.toSession params queryMany :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":many" -> Params name -> - IO (Either RunnerError (Vector (Result name))) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) queryMany connection query params = Hasql.Connection.use connection (queryManySession query params) queryManySession :: - (ToRow (Params name), FromRow (Result name)) => - Query name ":many" -> - Params name -> - Hasql.Session.Session (Vector (Result name)) -queryManySession query params = - Hasql.Session.statement params (statement query (Hasql.Decoders.rowVector fromRow)) - --- | Note that hasql folds a result purely, so unlike the postgresql-simple --- backend the step function is not in 'IO'. -fold :: - (ToRow (Params name), FromRow (Result name)) => - Hasql.Connection.Connection -> - Query name ":many" -> - Params name -> - a -> - (a -> Result name -> a) -> - IO (Either RunnerError a) -fold connection query params initial step = - Hasql.Connection.use connection (foldSession query params initial step) -{-# INLINABLE fold #-} - -foldSession :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":many" -> Params name -> - a -> - (a -> Result name -> a) -> - Hasql.Session.Session a -foldSession query params initial step = - Hasql.Session.statement params (statement query (Hasql.Decoders.foldlRows step initial fromRow)) -{-# INLINABLE foldSession #-} + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +queryManySession _query params = + Hasql.Mapping.IsStatement.toSession params -- | Runs the query once per set of parameters, pipelined into a single --- round trip, and returns the total number of rows affected. +-- round trip. execMany :: - (ToRow (Params name), Foldable f) => + (Hasql.Mapping.IsStatement.IsStatement (Params name), Foldable f) => Hasql.Connection.Connection -> Query name ":copyfrom" -> f (Params name) -> - IO (Either RunnerError Data.Int.Int64) + IO (Either RunnerError [Hasql.Mapping.IsStatement.Result (Params name)]) execMany connection query params = Hasql.Connection.use connection (execManySession query params) execManySession :: - (ToRow (Params name), Foldable f) => + (Hasql.Mapping.IsStatement.IsStatement (Params name), Foldable f) => Query name ":copyfrom" -> f (Params name) -> - Hasql.Session.Session Data.Int.Int64 -execManySession query params = + Hasql.Session.Session [Hasql.Mapping.IsStatement.Result (Params name)] +execManySession _query params = Hasql.Session.pipeline - (fmap sum (traverse pipelined (Data.Foldable.toList params))) + (traverse pipelined (Data.Foldable.toList params)) where pipelined param = - Hasql.Pipeline.statement param (statement query Hasql.Decoders.rowsAffected) + Hasql.Pipeline.statement param Hasql.Mapping.IsStatement.statement diff --git a/test/golden/hasql-features/Queries/Types.hs b/test/golden/hasql-features/Queries/Types.hs --- a/test/golden/hasql-features/Queries/Types.hs +++ b/test/golden/hasql-features/Queries/Types.hs @@ -12,6 +12,7 @@ import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar import Queries.Internal import Prelude hiding (Enum) import qualified Prelude @@ -22,16 +23,14 @@ | Enum_organization_role_member deriving stock (Eq, Ord, Show, Bounded, Prelude.Enum) -instance ToField (Enum "organization_role") where - toField = +instance Hasql.Mapping.IsScalar.IsScalar (Enum "organization_role") where + encoder = Hasql.Encoders.enum Prelude.Nothing "organization_role" $ \x -> case x of Enum_organization_role_owner -> "owner" Enum_organization_role_admin -> "admin" Enum_organization_role_member -> "member" - -instance FromField (Enum "organization_role") where - fromField = + decoder = Hasql.Decoders.enum Prelude.Nothing "organization_role" $ \x -> case x of "owner" -> Prelude.Just Enum_organization_role_owner diff --git a/test/golden/hasql-features/hasql-features.cabal b/test/golden/hasql-features/hasql-features.cabal --- a/test/golden/hasql-features/hasql-features.cabal +++ b/test/golden/hasql-features/hasql-features.cabal @@ -7,6 +7,7 @@ base, bytestring, hasql, + hasql-mapping, scientific, text, time, diff --git a/test/golden/simple-query-hasql/Queries/Internal.hs b/test/golden/simple-query-hasql/Queries/Internal.hs --- a/test/golden/simple-query-hasql/Queries/Internal.hs +++ b/test/golden/simple-query-hasql/Queries/Internal.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} module Queries.Internal ( @@ -10,13 +9,6 @@ Result, Queries.Internal.Enum, - -- * Codecs - ToRow(..), - FromRow(..), - ToField(..), - FromField(..), - statement, - -- * :execResult ExecResult(..), execResult, @@ -37,8 +29,6 @@ -- * :many queryMany, queryManySession, - fold, - foldSession, -- * :copyfrom execMany, @@ -47,29 +37,25 @@ -- * Reexports Hasql.Connection.Connection, Hasql.Session.Session, + -- Without @(..)@: the class re-exports an associated type called @Result@, + -- which would collide with the row family of the same name above. A caller + -- that needs to name the statement's result imports + -- "Hasql.Mapping.IsStatement" directly. + Hasql.Mapping.IsStatement.IsStatement, RunnerError, Hasql.Errors.SessionError, ) where import Data.Foldable (Foldable) -import Data.Vector (Vector) import GHC.TypeLits (Symbol) -import qualified Data.Aeson -import qualified Data.ByteString import qualified Data.Foldable import qualified Data.Int -import qualified Data.Scientific import qualified Data.Text -import qualified Data.Time -import qualified Data.UUID -import qualified Data.Vector import qualified Hasql.Connection -import qualified Hasql.Decoders -import qualified Hasql.Encoders import qualified Hasql.Errors +import qualified Hasql.Mapping.IsStatement import qualified Hasql.Pipeline import qualified Hasql.Session -import qualified Hasql.Statement -- | What a runner reports when it fails. -- @@ -89,6 +75,12 @@ -- | The SQL of a query, with PostgreSQL's positional @$1@, @$2@ placeholders -- left as sqlc emitted them. +-- +-- The generated 'Hasql.Mapping.IsStatement.IsStatement' instance builds its +-- statement from this, so a runner does not need it to execute anything. It is +-- still an argument to every runner below, for two reasons: the @command@ tag +-- is what makes @queryMany@ reject a @:one@ query at compile time, and the SQL +-- is the obvious thing to attach to a trace span. newtype Query (name :: Symbol) (command :: Symbol) = Query Data.Text.Text @@ -98,309 +90,120 @@ data family Enum (name :: Symbol) --- | The parameter encoder of a query. hasql has no such class of its own -- --- encoders are plain values -- so sqlc-hs declares one and generates an --- instance per query. -class ToRow a where - toRow :: Hasql.Encoders.Params a - --- | The row decoder of a query's result. The counterpart of 'ToRow'. -class FromRow a where - fromRow :: Hasql.Decoders.Row a - --- | The codec of a single value. --- --- sqlc-hs takes hasql's codec from the SQL type for every column it typed --- itself, because hasql checks column types when decoding and @text@, @varchar@ --- and @bpchar@ need three different decoders. Columns typed through an --- @overrides@ entry go through this class instead, so a custom type only needs --- an instance here: --- --- @ --- instance ToField MyId where --- toField = Data.Functor.Contravariant.contramap unMyId toField --- @ --- --- An override can also name the codecs directly, with the @hasql_encoder@ and --- @hasql_decoder@ keys, in which case no instance is needed. -class ToField a where - toField :: Hasql.Encoders.Value a - --- | The counterpart of 'ToField'. --- --- @ --- instance FromField MyId where --- fromField = fmap MyId fromField --- @ -class FromField a where - fromField :: Hasql.Decoders.Value a - -instance ToField Bool where - toField = Hasql.Encoders.bool - -instance ToField Data.Int.Int16 where - toField = Hasql.Encoders.int2 - -instance ToField Data.Int.Int32 where - toField = Hasql.Encoders.int4 - -instance ToField Data.Int.Int64 where - toField = Hasql.Encoders.int8 - -instance ToField Float where - toField = Hasql.Encoders.float4 - -instance ToField Double where - toField = Hasql.Encoders.float8 - -instance ToField Data.Scientific.Scientific where - toField = Hasql.Encoders.numeric - -instance ToField Char where - toField = Hasql.Encoders.char - -instance ToField Data.Text.Text where - toField = Hasql.Encoders.text - -instance ToField Data.ByteString.ByteString where - toField = Hasql.Encoders.bytea - -instance ToField Data.UUID.UUID where - toField = Hasql.Encoders.uuid - -instance ToField Data.Time.Day where - toField = Hasql.Encoders.date - -instance ToField Data.Time.LocalTime where - toField = Hasql.Encoders.timestamp - -instance ToField Data.Time.UTCTime where - toField = Hasql.Encoders.timestamptz - -instance ToField Data.Time.TimeOfDay where - toField = Hasql.Encoders.time - -instance ToField (Data.Time.TimeOfDay, Data.Time.TimeZone) where - toField = Hasql.Encoders.timetz - -instance ToField Data.Time.DiffTime where - toField = Hasql.Encoders.interval - -instance ToField Data.Aeson.Value where - toField = Hasql.Encoders.jsonb - -instance (ToField a) => ToField (Data.Vector.Vector a) where - toField = Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable toField) - -instance (ToField a) => ToField [a] where - toField = Hasql.Encoders.foldableArray (Hasql.Encoders.nonNullable toField) - -instance FromField Bool where - fromField = Hasql.Decoders.bool - -instance FromField Data.Int.Int16 where - fromField = Hasql.Decoders.int2 - -instance FromField Data.Int.Int32 where - fromField = Hasql.Decoders.int4 - -instance FromField Data.Int.Int64 where - fromField = Hasql.Decoders.int8 - -instance FromField Float where - fromField = Hasql.Decoders.float4 - -instance FromField Double where - fromField = Hasql.Decoders.float8 - -instance FromField Data.Scientific.Scientific where - fromField = Hasql.Decoders.numeric - -instance FromField Char where - fromField = Hasql.Decoders.char - -instance FromField Data.Text.Text where - fromField = Hasql.Decoders.text - -instance FromField Data.ByteString.ByteString where - fromField = Hasql.Decoders.bytea - -instance FromField Data.UUID.UUID where - fromField = Hasql.Decoders.uuid - -instance FromField Data.Time.Day where - fromField = Hasql.Decoders.date - -instance FromField Data.Time.LocalTime where - fromField = Hasql.Decoders.timestamp - -instance FromField Data.Time.UTCTime where - fromField = Hasql.Decoders.timestamptz - -instance FromField Data.Time.TimeOfDay where - fromField = Hasql.Decoders.time - -instance FromField (Data.Time.TimeOfDay, Data.Time.TimeZone) where - fromField = Hasql.Decoders.timetz - -instance FromField Data.Time.DiffTime where - fromField = Hasql.Decoders.interval - -instance FromField Data.Aeson.Value where - fromField = Hasql.Decoders.jsonb - -instance (FromField a) => FromField (Data.Vector.Vector a) where - fromField = Hasql.Decoders.vectorArray (Hasql.Decoders.nonNullable fromField) - -instance (FromField a) => FromField [a] where - fromField = Hasql.Decoders.listArray (Hasql.Decoders.nonNullable fromField) - data ExecResult = ExecResult { rowsAffected :: !Data.Int.Int64 } --- | The statement a query and a result decoder make up. Use it to run a query --- inside a 'Hasql.Pipeline.Pipeline'. -statement :: - (ToRow (Params name)) => - Query name command -> - Hasql.Decoders.Result result -> - Hasql.Statement.Statement (Params name) result -statement (Query sql) decoder = - Hasql.Statement.preparable sql toRow decoder - +-- | The codecs come from the query's +-- 'Hasql.Mapping.IsStatement.IsStatement' instance, and the shape of what it +-- returns is that instance's @Result@ -- @Maybe@ a row for @:one@, a @Vector@ +-- of them for @:many@, @()@ for @:exec@, and so on. Naming it through the +-- associated type rather than spelling each shape out is what lets these +-- signatures stay free of equality constraints. exec :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":exec" -> Params name -> - IO (Either RunnerError ()) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) exec connection query params = Hasql.Connection.use connection (execSession query params) execSession :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":exec" -> Params name -> - Hasql.Session.Session () -execSession query params = - Hasql.Session.statement params (statement query Hasql.Decoders.noResult) + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +execSession _query params = + Hasql.Mapping.IsStatement.toSession params execRows :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":execrows" -> Params name -> - IO (Either RunnerError Data.Int.Int64) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) execRows connection query params = Hasql.Connection.use connection (execRowsSession query params) execRowsSession :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":execrows" -> Params name -> - Hasql.Session.Session Data.Int.Int64 -execRowsSession query params = - Hasql.Session.statement params (statement query Hasql.Decoders.rowsAffected) + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +execRowsSession _query params = + Hasql.Mapping.IsStatement.toSession params execResult :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":execresult" -> Params name -> - IO (Either RunnerError ExecResult) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) execResult connection query params = Hasql.Connection.use connection (execResultSession query params) execResultSession :: - (ToRow (Params name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":execresult" -> Params name -> - Hasql.Session.Session ExecResult -execResultSession query params = do - rowsAffected <- Hasql.Session.statement params (statement query Hasql.Decoders.rowsAffected) - pure ExecResult { - rowsAffected - } + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +execResultSession _query params = + Hasql.Mapping.IsStatement.toSession params queryOne :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":one" -> Params name -> - IO (Either RunnerError (Maybe (Result name))) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) queryOne connection query params = Hasql.Connection.use connection (queryOneSession query params) queryOneSession :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":one" -> Params name -> - Hasql.Session.Session (Maybe (Result name)) -queryOneSession query params = - Hasql.Session.statement params (statement query (Hasql.Decoders.rowMaybe fromRow)) + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +queryOneSession _query params = + Hasql.Mapping.IsStatement.toSession params queryMany :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Hasql.Connection.Connection -> Query name ":many" -> Params name -> - IO (Either RunnerError (Vector (Result name))) + IO (Either RunnerError (Hasql.Mapping.IsStatement.Result (Params name))) queryMany connection query params = Hasql.Connection.use connection (queryManySession query params) queryManySession :: - (ToRow (Params name), FromRow (Result name)) => - Query name ":many" -> - Params name -> - Hasql.Session.Session (Vector (Result name)) -queryManySession query params = - Hasql.Session.statement params (statement query (Hasql.Decoders.rowVector fromRow)) - --- | Note that hasql folds a result purely, so unlike the postgresql-simple --- backend the step function is not in 'IO'. -fold :: - (ToRow (Params name), FromRow (Result name)) => - Hasql.Connection.Connection -> - Query name ":many" -> - Params name -> - a -> - (a -> Result name -> a) -> - IO (Either RunnerError a) -fold connection query params initial step = - Hasql.Connection.use connection (foldSession query params initial step) -{-# INLINABLE fold #-} - -foldSession :: - (ToRow (Params name), FromRow (Result name)) => + (Hasql.Mapping.IsStatement.IsStatement (Params name)) => Query name ":many" -> Params name -> - a -> - (a -> Result name -> a) -> - Hasql.Session.Session a -foldSession query params initial step = - Hasql.Session.statement params (statement query (Hasql.Decoders.foldlRows step initial fromRow)) -{-# INLINABLE foldSession #-} + Hasql.Session.Session (Hasql.Mapping.IsStatement.Result (Params name)) +queryManySession _query params = + Hasql.Mapping.IsStatement.toSession params -- | Runs the query once per set of parameters, pipelined into a single --- round trip, and returns the total number of rows affected. +-- round trip. execMany :: - (ToRow (Params name), Foldable f) => + (Hasql.Mapping.IsStatement.IsStatement (Params name), Foldable f) => Hasql.Connection.Connection -> Query name ":copyfrom" -> f (Params name) -> - IO (Either RunnerError Data.Int.Int64) + IO (Either RunnerError [Hasql.Mapping.IsStatement.Result (Params name)]) execMany connection query params = Hasql.Connection.use connection (execManySession query params) execManySession :: - (ToRow (Params name), Foldable f) => + (Hasql.Mapping.IsStatement.IsStatement (Params name), Foldable f) => Query name ":copyfrom" -> f (Params name) -> - Hasql.Session.Session Data.Int.Int64 -execManySession query params = + Hasql.Session.Session [Hasql.Mapping.IsStatement.Result (Params name)] +execManySession _query params = Hasql.Session.pipeline - (fmap sum (traverse pipelined (Data.Foldable.toList params))) + (traverse pipelined (Data.Foldable.toList params)) where pipelined param = - Hasql.Pipeline.statement param (statement query Hasql.Decoders.rowsAffected) + Hasql.Pipeline.statement param Hasql.Mapping.IsStatement.statement diff --git a/test/golden/simple-query-hasql/Queries/ListUsers.hs b/test/golden/simple-query-hasql/Queries/ListUsers.hs --- a/test/golden/simple-query-hasql/Queries/ListUsers.hs +++ b/test/golden/simple-query-hasql/Queries/ListUsers.hs @@ -8,9 +8,15 @@ {-# LANGUAGE TypeFamilies #-} module Queries.ListUsers where -import Queries.Internal (Query(..), Enum, Params, Result, ToRow(..), FromRow(..), ToField(..), FromField(..)) +import Queries.Internal (Query(..), Enum, Params) +import qualified Queries.Internal +import qualified Data.Int +import qualified Data.Vector import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar +import qualified Hasql.Mapping.IsStatement +import qualified Hasql.Statement import qualified Data.Int import qualified Data.Text @@ -30,7 +36,7 @@ age :: Data.Int.Int32 } -data instance Result "ListUsers" = Result_ListUsers +data instance Queries.Internal.Result "ListUsers" = Result_ListUsers { id :: !(Data.Int.Int32), name :: !(Data.Text.Text), @@ -43,26 +49,32 @@ avatar :: !(GHC.Base.Maybe Data.ByteString.ByteString) } -instance ToRow (Params "ListUsers") where - {-# INLINE toRow #-} - toRow = - mconcat - [ - Data.Functor.Contravariant.contramap (\Params_ListUsers{..} -> age) (Hasql.Encoders.param (Hasql.Encoders.nonNullable Hasql.Encoders.int4)) - ] +instance Hasql.Mapping.IsStatement.IsStatement (Params "ListUsers") where + type Result (Params "ListUsers") = Data.Vector.Vector (Queries.Internal.Result "ListUsers") + statement = + Hasql.Statement.preparable sql paramsEncoder (Hasql.Decoders.rowVector rowDecoder) + where + Query sql = query_ListUsers -instance FromRow (Result "ListUsers") where - {-# INLINE fromRow #-} - fromRow = - pure Result_ListUsers - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.int4) - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.varchar) - <*> Hasql.Decoders.column (Hasql.Decoders.nullable Hasql.Decoders.text) - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.bpchar) - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.bool) - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.numeric) - <*> Hasql.Decoders.column (Hasql.Decoders.nullable Hasql.Decoders.float8) - <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.jsonb) - <*> Hasql.Decoders.column (Hasql.Decoders.nullable Hasql.Decoders.bytea) + paramsEncoder :: Hasql.Encoders.Params (Params "ListUsers") + paramsEncoder = + mconcat + [ + Data.Functor.Contravariant.contramap (\Params_ListUsers{..} -> age) (Hasql.Encoders.param (Hasql.Encoders.nonNullable Hasql.Encoders.int4)) + ] + {-# INLINE paramsEncoder #-} + rowDecoder :: Hasql.Decoders.Row (Queries.Internal.Result "ListUsers") + rowDecoder = + pure Result_ListUsers + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.int4) + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.varchar) + <*> Hasql.Decoders.column (Hasql.Decoders.nullable Hasql.Decoders.text) + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.bpchar) + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.bool) + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.numeric) + <*> Hasql.Decoders.column (Hasql.Decoders.nullable Hasql.Decoders.float8) + <*> Hasql.Decoders.column (Hasql.Decoders.nonNullable Hasql.Decoders.jsonb) + <*> Hasql.Decoders.column (Hasql.Decoders.nullable Hasql.Decoders.bytea) + {-# INLINE rowDecoder #-} diff --git a/test/golden/simple-query-hasql/Queries/Types.hs b/test/golden/simple-query-hasql/Queries/Types.hs --- a/test/golden/simple-query-hasql/Queries/Types.hs +++ b/test/golden/simple-query-hasql/Queries/Types.hs @@ -12,6 +12,7 @@ import qualified Hasql.Decoders import qualified Hasql.Encoders +import qualified Hasql.Mapping.IsScalar import Queries.Internal import Prelude hiding (Enum) import qualified Prelude diff --git a/test/golden/simple-query-hasql/simple-query-hasql.cabal b/test/golden/simple-query-hasql/simple-query-hasql.cabal --- a/test/golden/simple-query-hasql/simple-query-hasql.cabal +++ b/test/golden/simple-query-hasql/simple-query-hasql.cabal @@ -8,6 +8,7 @@ bytestring, ghc-prim, hasql, + hasql-mapping, scientific, text, time,