rel8 1.7.0.0 → 1.8.0.0

raw patch · 179 files changed

+907/−16974 lines, 179 filesdep +rel8-internaldep +template-haskelldep +th-abstractiondep −attoparsecdep −base-compatdep −base16dep ~basedep ~hasqldep ~hedgehogPVP ok

version bump matches the API change (PVP)

Dependencies added: rel8-internal, template-haskell, th-abstraction

Dependencies removed: attoparsec, base-compat, base16, contravariant, pretty, semialign, utf8-string

Dependency ranges changed: base, hasql, hedgehog, iproute, opaleye

API changes (from Hackage documentation)

Files

• Changelog.md +44/−1
• README.md +0/−17
• rel8.cabal +16/−201
• src/Rel8.hs +113/−111
• src/Rel8/Aggregate.hs +0/−197
• src/Rel8/Aggregate/Fold.hs +0/−52
• src/Rel8/Aggregate/Function.hs +0/−45
• src/Rel8/Array.hs +61/−19
• src/Rel8/Column.hs +0/−31
• src/Rel8/Column/ADT.hs +0/−23
• src/Rel8/Column/Either.hs +0/−26
• src/Rel8/Column/Lift.hs +0/−23
• src/Rel8/Column/List.hs +0/−25
• src/Rel8/Column/Maybe.hs +0/−26
• src/Rel8/Column/NonEmpty.hs +0/−27
• src/Rel8/Column/Null.hs +0/−26
• src/Rel8/Column/These.hs +0/−29
• src/Rel8/Decoder.hs +1/−1
• src/Rel8/Encoder.hs +1/−1
• src/Rel8/Expr.hs +0/−137
• src/Rel8/Expr.hs-boot +0/−20
• src/Rel8/Expr/Aggregate.hs +0/−495
• src/Rel8/Expr/Array.hs +0/−55
• src/Rel8/Expr/Bool.hs +0/−90
• src/Rel8/Expr/Default.hs +0/−40
• src/Rel8/Expr/Eq.hs +0/−101
• src/Rel8/Expr/Function.hs +0/−93
• src/Rel8/Expr/List.hs +0/−52
• src/Rel8/Expr/NonEmpty.hs +0/−53
• src/Rel8/Expr/Null.hs +0/−106
• src/Rel8/Expr/Num.hs +7/−7
• src/Rel8/Expr/Opaleye.hs +0/−118
• src/Rel8/Expr/Ord.hs +0/−137
• src/Rel8/Expr/Order.hs +0/−69
• src/Rel8/Expr/Read.hs +0/−29
• src/Rel8/Expr/Sequence.hs +0/−25
• src/Rel8/Expr/Serialize.hs +0/−52
• src/Rel8/Expr/Show.hs +0/−18
• src/Rel8/Expr/Subscript.hs +0/−65
• src/Rel8/Expr/Text.hs +2/−275
• src/Rel8/Expr/Time.hs +3/−3
• src/Rel8/Expr/Window.hs +0/−149
• src/Rel8/FCF.hs +0/−26
• src/Rel8/Generic/Construction.hs +0/−316
• src/Rel8/Generic/Construction/ADT.hs +0/−478
• src/Rel8/Generic/Construction/Record.hs +0/−168
• src/Rel8/Generic/Map.hs +0/−49
• src/Rel8/Generic/Record.hs +0/−155
• src/Rel8/Generic/Rel8able.hs +0/−288
• src/Rel8/Generic/Table.hs +0/−103
• src/Rel8/Generic/Table/ADT.hs +0/−221
• src/Rel8/Generic/Table/Record.hs +0/−181
• src/Rel8/Kind/Algebra.hs +0/−38
• src/Rel8/Kind/Context.hs +0/−50
• src/Rel8/Order.hs +0/−30
• src/Rel8/Query.hs +0/−223
• src/Rel8/Query.hs-boot +0/−19
• src/Rel8/Query/Aggregate.hs +0/−59
• src/Rel8/Query/Distinct.hs +0/−40
• src/Rel8/Query/Each.hs +0/−32
• src/Rel8/Query/Either.hs +0/−69
• src/Rel8/Query/Evaluate.hs +0/−49
• src/Rel8/Query/Exists.hs +0/−66
• src/Rel8/Query/Filter.hs +0/−35
• src/Rel8/Query/Function.hs +0/−32
• src/Rel8/Query/Indexed.hs +0/−21
• src/Rel8/Query/Limit.hs +0/−27
• src/Rel8/Query/List.hs +0/−124
• src/Rel8/Query/Loop.hs +0/−73
• src/Rel8/Query/Materialize.hs +0/−40
• src/Rel8/Query/Maybe.hs +0/−64
• src/Rel8/Query/Null.hs +0/−38
• src/Rel8/Query/Opaleye.hs +0/−70
• src/Rel8/Query/Order.hs +0/−20
• src/Rel8/Query/Rebind.hs +0/−36
• src/Rel8/Query/SQL.hs +0/−27
• src/Rel8/Query/Set.hs +0/−58
• src/Rel8/Query/These.hs +0/−138
• src/Rel8/Query/Values.hs +0/−27
• src/Rel8/Query/Window.hs +0/−26
• src/Rel8/Range.hs +33/−0
• src/Rel8/Schema/Context/Nullify.hs +0/−130
• src/Rel8/Schema/Dict.hs +0/−18
• src/Rel8/Schema/Escape.hs +0/−20
• src/Rel8/Schema/Field.hs +0/−50
• src/Rel8/Schema/HTable.hs +0/−236
• src/Rel8/Schema/HTable/Either.hs +0/−32
• src/Rel8/Schema/HTable/Identity.hs +0/−43
• src/Rel8/Schema/HTable/Label.hs +0/−70
• src/Rel8/Schema/HTable/List.hs +0/−18
• src/Rel8/Schema/HTable/MapTable.hs +0/−99
• src/Rel8/Schema/HTable/Maybe.hs +0/−31
• src/Rel8/Schema/HTable/NonEmpty.hs +0/−19
• src/Rel8/Schema/HTable/Nullify.hs +0/−123
• src/Rel8/Schema/HTable/Product.hs +0/−17
• src/Rel8/Schema/HTable/These.hs +0/−33
• src/Rel8/Schema/HTable/Vectorize.hs +0/−205
• src/Rel8/Schema/Kind.hs +0/−24
• src/Rel8/Schema/Name.hs +0/−77
• src/Rel8/Schema/Null.hs +0/−111
• src/Rel8/Schema/QualifiedName.hs +0/−62
• src/Rel8/Schema/Result.hs +0/−54
• src/Rel8/Schema/Spec.hs +0/−34
• src/Rel8/Schema/Table.hs +0/−43
• src/Rel8/Statement.hs +0/−319
• src/Rel8/Statement/Delete.hs +0/−74
• src/Rel8/Statement/Insert.hs +0/−82
• src/Rel8/Statement/OnConflict.hs +0/−122
• src/Rel8/Statement/Prepared.hs +0/−87
• src/Rel8/Statement/Returning.hs +0/−83
• src/Rel8/Statement/Rows.hs +0/−30
• src/Rel8/Statement/Run.hs +0/−107
• src/Rel8/Statement/SQL.hs +0/−56
• src/Rel8/Statement/Select.hs +0/−132
• src/Rel8/Statement/Set.hs +0/−33
• src/Rel8/Statement/Update.hs +0/−79
• src/Rel8/Statement/Using.hs +0/−45
• src/Rel8/Statement/View.hs +0/−84
• src/Rel8/Statement/Where.hs +0/−31
• src/Rel8/TH.hs +279/−0
• src/Rel8/Table.hs +0/−223
• src/Rel8/Table/ADT.hs +0/−168
• src/Rel8/Table/Aggregate.hs +0/−170
• src/Rel8/Table/Aggregate/Maybe.hs +0/−89
• src/Rel8/Table/Alternative.hs +0/−37
• src/Rel8/Table/Bool.hs +0/−48
• src/Rel8/Table/Cols.hs +0/−51
• src/Rel8/Table/Either.hs +0/−298
• src/Rel8/Table/Eq.hs +0/−118
• src/Rel8/Table/HKD.hs +0/−223
• src/Rel8/Table/List.hs +0/−193
• src/Rel8/Table/Maybe.hs +0/−252
• src/Rel8/Table/Name.hs +0/−89
• src/Rel8/Table/NonEmpty.hs +0/−189
• src/Rel8/Table/Null.hs +0/−149
• src/Rel8/Table/Nullify.hs +0/−222
• src/Rel8/Table/Opaleye.hs +0/−168
• src/Rel8/Table/Ord.hs +0/−154
• src/Rel8/Table/Order.hs +0/−50
• src/Rel8/Table/Projection.hs +0/−73
• src/Rel8/Table/Rel8able.hs +0/−96
• src/Rel8/Table/Serialize.hs +0/−149
• src/Rel8/Table/These.hs +0/−482
• src/Rel8/Table/Transpose.hs +0/−50
• src/Rel8/Table/Undefined.hs +0/−26
• src/Rel8/Table/Verify.hs +0/−644
• src/Rel8/Table/Window.hs +0/−120
• src/Rel8/Tabulate.hs +29/−29
• src/Rel8/Type.hs +0/−560
• src/Rel8/Type/Array.hs +0/−260
• src/Rel8/Type/Builder/ByteString.hs +0/−16
• src/Rel8/Type/Builder/Fold.hs +0/−16
• src/Rel8/Type/Builder/Time.hs +0/−151
• src/Rel8/Type/Composite.hs +0/−263
• src/Rel8/Type/Decimal.hs +0/−103
• src/Rel8/Type/Decoder.hs +0/−54
• src/Rel8/Type/Encoder.hs +0/−43
• src/Rel8/Type/Enum.hs +0/−173
• src/Rel8/Type/Eq.hs +0/−81
• src/Rel8/Type/Information.hs +0/−67
• src/Rel8/Type/JSONBEncoded.hs +0/−67
• src/Rel8/Type/JSONEncoded.hs +0/−69
• src/Rel8/Type/Monoid.hs +0/−79
• src/Rel8/Type/Name.hs +0/−58
• src/Rel8/Type/Nullable.hs +0/−16
• src/Rel8/Type/Num.hs +0/−65
• src/Rel8/Type/Ord.hs +0/−127
• src/Rel8/Type/Parser.hs +0/−17
• src/Rel8/Type/Parser/ByteString.hs +0/−54
• src/Rel8/Type/Parser/Time.hs +0/−156
• src/Rel8/Type/ReadShow.hs +0/−35
• src/Rel8/Type/Semigroup.hs +0/−87
• src/Rel8/Type/String.hs +0/−40
• src/Rel8/Type/Sum.hs +0/−41
• src/Rel8/Type/Tag.hs +0/−98
• src/Rel8/Window.hs +0/−97
• tests/Main.hs +155/−16
• tests/Rel8/Generic/Rel8able/Test.hs +26/−6
• tests/Rel8/TH/Rel8able/Test.hs +137/−0

@@ -1,4 +1,45 @@ +<a id='changelog-1.8.0.0'></a>+# 1.8.0.0 — 2026-09-16++## Added++- Added `Rel8.TH.deriveRel8able` and `Rel8.TH.deriveRel8ables` for deriving `Rel8able` instances using `TemplateHaskell`. +  This can be significantly faster than using `Generics`. In testing, we have seen 80% reductions in build time!+  +- Expose all `rel8` internal modules from the `rel8-internal` package.++- Added new `Conflict` and `Index` types. `Conflict` represents a [`conflict_target`](https://www.postgresql.org/docs/current/sql-insert.html#SQL-ON-CONFLICT) in an `ON CONFLICT`. It can be either a named constraint (`ON CONSTRAINT`) or a an `Index`.++- Added `Index`. `Index` is a description of a unique index which PostgreSQL can use for *unique index inference*. This is an alternative to specifying an explicit named constraint in a `conflict_target`.++- Add `notElem` and `notElem1` to `Rel8.Array`++- Added preliminary support for PostgreSQL ranges.++- Support GHC-9.14 and `semialign >= 1.4`.++- Added `notElem` and `notElem1` to `Rel8.Array`.++- Added `DBType Aeson.Object` instance.++- Bumped a variety of bounds.++## Changed++- The `Upsert` type was changed. Previously it had the columns (`index`, `predicate`) of what is now the `Index` type baked into its record. It now instead has a single `conflict` column (of type `Conflict`, which can be either an `Index` or a named constraint).+- The `DoNothing` constructor of `OnConflict` was changed to also take an optional `Conflict` value. Even though `ON CONFLICT DO NOTHING` does not generally require a `conflict_target`, there are cases where it can be necessary, e.g., if you have table that has both deferrable and non-deferrable constraints.++- `rel8` now requires at least version `0.10.8.0` of `opaleye`++## Fixed++- `elem` and `elem1` now use `IS NOT DISTINCT FROM` semantics (matching `(==.)`) when the element type is nullable, so `null` is found in an array containing `null`. Previously they were implemented with the array containment operator `<@`, which never matches `null`.++- Fixed some issues around the truncation of long column names.++- Improved documentation.+ <a id='changelog-1.7.0.0'></a> # 1.7.0.0 — 2025-07-31 @@ -12,9 +53,11 @@  - Added new `Encoder` type with three members: `binary`, which is the Hasql binary encoder, `text` which encodes a type in PostgreSQL's text format (needed for nested arrays) and `quote`, which is the does the thing that the function we previously called `encode` does (i.e., `a -> Opaleye.PrimExpr`). +- Add `elem` and `elem1` to `Rel8.Array` for testing if an element is contained in `[]` and `NonEmpty` `Expr`s.+ - Support hasql-1.9 -- Add `elem` and `elem1` to `Rel8.Array` for testing if an element is contained in `[]` and `NonEmpty` `Expr`s.+- Support GHC-9.12  ## Changed 

@@ -1,17 +0,0 @@-# Welcome!--Welcome to Rel8! Rel8 is a Haskell library for interacting with PostgreSQL databases, built on top of the fantastic Opaleye library.--The main objectives of Rel8 are:--* *Conciseness*: Users using Rel8 should not need to write boiler-plate code. By using expressive types, we can provide sufficient information for the compiler to infer code whenever possible.--* *Inferrable*: Despite using a lot of type level magic, Rel8 aims to have excellent and predictable type inference.--* *Familiar*: writing Rel8 queries should feel like normal Haskell programming.--Rel8 was presented at ZuriHac 2021. If you want to have a brief overview of what Rel8 is, and a tour of the API - check out the video below:--[![Rel8 presentation at ZuriHac 2021](https://img.youtube.com/vi/3uwrtjxiq6E/hqdefault.jpg)](http://www.youtube.com/watch?v=3uwrtjxiq6E)--For more details, check out the [official documentation](https://rel8.readthedocs.io/en/latest/).

@@ -1,8 +1,8 @@-cabal-version:       2.0+cabal-version:       3.0 name:                rel8-version:             1.7.0.0+version:             1.8.0.0 synopsis:            Hey! Hey! Can u rel8?-license:             BSD3+license:             BSD-3-Clause license-file:        LICENSE author:              Oliver Charles maintainer:          ollie@ocharles.org.uk@@ -10,7 +10,6 @@ bug-reports:         https://github.com/circuithub/rel8/issues build-type:          Simple extra-doc-files:-    README.md     Changelog.md  source-repository head@@ -19,33 +18,19 @@  library   build-depends:-      aeson-    , attoparsec-    , base >= 4.16 && < 4.22-    , base16 >= 1.0-    , base-compat >= 0.11 && < 0.15+      rel8-internal ==1.8.0.0+    , base >= 4.16 && < 4.23     , bifunctors     , bytestring-    , case-insensitive     , comonad-    , containers-    , contravariant-    , hasql >= 1.8 && < 1.10-    , iproute ^>= 1.7-    , opaleye ^>= 0.10.2.1-    , pretty+    , opaleye ^>= 0.10.8.0     , profunctors     , product-profunctors-    , scientific-    , semialign     , semigroupoids-    , text-    , these     , time-    , transformers-    , utf8-string-    , uuid-    , vector+    , containers+    , template-haskell+    , th-abstraction    default-language:     Haskell2010@@ -59,9 +44,11 @@     -Wno-missing-role-annotations     -Wno-missing-deriving-strategies     -Wno-term-variable-capture+    -Wno-all-missed-specializations    hs-source-dirs:     src+   exposed-modules:     Rel8     Rel8.Array@@ -70,183 +57,9 @@     Rel8.Expr.Num     Rel8.Expr.Text     Rel8.Expr.Time-    Rel8.Table.Verify+    Rel8.Range     Rel8.Tabulate--  other-modules:-    Rel8.Aggregate-    Rel8.Aggregate.Fold-    Rel8.Aggregate.Function--    Rel8.Column-    Rel8.Column.ADT-    Rel8.Column.Either-    Rel8.Column.Lift-    Rel8.Column.List-    Rel8.Column.Maybe-    Rel8.Column.NonEmpty-    Rel8.Column.Null-    Rel8.Column.These--    Rel8.Expr-    Rel8.Expr.Aggregate-    Rel8.Expr.Array-    Rel8.Expr.Bool-    Rel8.Expr.Default-    Rel8.Expr.Eq-    Rel8.Expr.Function-    Rel8.Expr.List-    Rel8.Expr.NonEmpty-    Rel8.Expr.Null-    Rel8.Expr.Opaleye-    Rel8.Expr.Ord-    Rel8.Expr.Order-    Rel8.Expr.Read-    Rel8.Expr.Sequence-    Rel8.Expr.Serialize-    Rel8.Expr.Show-    Rel8.Expr.Subscript-    Rel8.Expr.Window--    Rel8.FCF--    Rel8.Kind.Algebra-    Rel8.Kind.Context--    Rel8.Generic.Construction-    Rel8.Generic.Construction.ADT-    Rel8.Generic.Construction.Record-    Rel8.Generic.Map-    Rel8.Generic.Record-    Rel8.Generic.Rel8able-    Rel8.Generic.Table-    Rel8.Generic.Table.ADT-    Rel8.Generic.Table.Record--    Rel8.Order--    Rel8.Query-    Rel8.Query.Aggregate-    Rel8.Query.Distinct-    Rel8.Query.Each-    Rel8.Query.Either-    Rel8.Query.Evaluate-    Rel8.Query.Exists-    Rel8.Query.Filter-    Rel8.Query.Function-    Rel8.Query.Indexed-    Rel8.Query.Limit-    Rel8.Query.List-    Rel8.Query.Loop-    Rel8.Query.Materialize-    Rel8.Query.Maybe-    Rel8.Query.Null-    Rel8.Query.Opaleye-    Rel8.Query.Order-    Rel8.Query.Rebind-    Rel8.Query.Set-    Rel8.Query.SQL-    Rel8.Query.These-    Rel8.Query.Values-    Rel8.Query.Window--    Rel8.Schema.Context.Nullify-    Rel8.Schema.Dict-    Rel8.Schema.Escape-    Rel8.Schema.Field-    Rel8.Schema.HTable-    Rel8.Schema.HTable.Either-    Rel8.Schema.HTable.Identity-    Rel8.Schema.HTable.Label-    Rel8.Schema.HTable.List-    Rel8.Schema.HTable.MapTable-    Rel8.Schema.HTable.Maybe-    Rel8.Schema.HTable.NonEmpty-    Rel8.Schema.HTable.Nullify-    Rel8.Schema.HTable.Product-    Rel8.Schema.HTable.These-    Rel8.Schema.HTable.Vectorize-    Rel8.Schema.Kind-    Rel8.Schema.Name-    Rel8.Schema.Null-    Rel8.Schema.QualifiedName-    Rel8.Schema.Result-    Rel8.Schema.Spec-    Rel8.Schema.Table--    Rel8.Statement-    Rel8.Statement.Delete-    Rel8.Statement.Insert-    Rel8.Statement.OnConflict-    Rel8.Statement.Prepared-    Rel8.Statement.Returning-    Rel8.Statement.Rows-    Rel8.Statement.Run-    Rel8.Statement.Select-    Rel8.Statement.Set-    Rel8.Statement.SQL-    Rel8.Statement.Update-    Rel8.Statement.Using-    Rel8.Statement.View-    Rel8.Statement.Where--    Rel8.Table-    Rel8.Table.ADT-    Rel8.Table.Aggregate-    Rel8.Table.Aggregate.Maybe-    Rel8.Table.Alternative-    Rel8.Table.Bool-    Rel8.Table.Cols-    Rel8.Table.Either-    Rel8.Table.Eq-    Rel8.Table.HKD-    Rel8.Table.List-    Rel8.Table.Maybe-    Rel8.Table.Name-    Rel8.Table.NonEmpty-    Rel8.Table.Null-    Rel8.Table.Nullify-    Rel8.Table.Opaleye-    Rel8.Table.Ord-    Rel8.Table.Order-    Rel8.Table.Projection-    Rel8.Table.Rel8able-    Rel8.Table.Serialize-    Rel8.Table.These-    Rel8.Table.Transpose-    Rel8.Table.Undefined-    Rel8.Table.Window--    Rel8.Type-    Rel8.Type.Array-    Rel8.Type.Builder.ByteString-    Rel8.Type.Builder.Fold-    Rel8.Type.Builder.Time-    Rel8.Type.Composite-    Rel8.Type.Decimal-    Rel8.Type.Decoder-    Rel8.Type.Eq-    Rel8.Type.Encoder-    Rel8.Type.Enum-    Rel8.Type.Information-    Rel8.Type.JSONEncoded-    Rel8.Type.JSONBEncoded-    Rel8.Type.Monoid-    Rel8.Type.Name-    Rel8.Type.Nullable-    Rel8.Type.Num-    Rel8.Type.Ord-    Rel8.Type.Parser-    Rel8.Type.Parser.ByteString-    Rel8.Type.Parser.Time-    Rel8.Type.ReadShow-    Rel8.Type.Semigroup-    Rel8.Type.String-    Rel8.Type.Sum-    Rel8.Type.Tag--    Rel8.Window-+    Rel8.TH  test-suite tests   type:             exitcode-stdio-1.0@@ -258,10 +71,11 @@     , containers     , hasql     , hasql-transaction-    , hedgehog          >= 1.0 && < 1.6+    , hedgehog          >= 1.0 && < 1.8     , mmorph     , iproute     , rel8+    , rel8-internal     , scientific     , tasty     , tasty-hedgehog@@ -275,6 +89,7 @@    other-modules:     Rel8.Generic.Rel8able.Test+    Rel8.TH.Rel8able.Test    main-is:          Main.hs   hs-source-dirs:   tests

@@ -360,6 +360,8 @@     -- ** @INSERT@   , Insert(..)   , OnConflict(..)+  , Conflict (..)+  , Index (..)   , Upsert(..)   , insert   , unsafeDefault@@ -396,115 +398,115 @@ import Prelude ()  -- rel8-import Rel8.Aggregate-import Rel8.Aggregate.Fold-import Rel8.Aggregate.Function-import Rel8.Column-import Rel8.Column.ADT-import Rel8.Column.Either-import Rel8.Column.Lift-import Rel8.Column.List-import Rel8.Column.Maybe-import Rel8.Column.NonEmpty-import Rel8.Column.Null-import Rel8.Column.These-import Rel8.Expr-import Rel8.Expr.Aggregate-import Rel8.Expr.Array-import Rel8.Expr.Bool-import Rel8.Expr.Default-import Rel8.Expr.Eq-import Rel8.Expr.Function-import Rel8.Expr.Null-import Rel8.Expr.Opaleye (unsafeCastExpr, unsafeCoerceExpr, unsafeLiteral, unsafePrimExpr)-import Rel8.Expr.Ord-import Rel8.Expr.Order-import Rel8.Expr.Serialize-import Rel8.Expr.Sequence-import Rel8.Expr.Text ( like, ilike )-import Rel8.Expr.Window-import Rel8.Generic.Rel8able ( KRel8able, Rel8able )-import Rel8.Order-import Rel8.Query-import Rel8.Query.Aggregate-import Rel8.Query.Distinct-import Rel8.Query.Each-import Rel8.Query.Either-import Rel8.Query.Evaluate-import Rel8.Query.Exists-import Rel8.Query.Filter-import Rel8.Query.Function-import Rel8.Query.Indexed-import Rel8.Query.Limit-import Rel8.Query.List-import Rel8.Query.Loop-import Rel8.Query.Materialize-import Rel8.Query.Maybe-import Rel8.Query.Null-import Rel8.Query.Order-import Rel8.Query.Rebind-import Rel8.Query.SQL (showQuery)-import Rel8.Query.Set-import Rel8.Query.These-import Rel8.Query.Values-import Rel8.Query.Window-import Rel8.Schema.Field-import Rel8.Schema.HTable-import Rel8.Schema.Name-import Rel8.Schema.Null hiding ( nullable )-import Rel8.Schema.QualifiedName-import Rel8.Schema.Result ( Result )-import Rel8.Schema.Table-import Rel8.Statement-import Rel8.Statement.Delete-import Rel8.Statement.Insert-import Rel8.Statement.OnConflict-import Rel8.Statement.Prepared-import Rel8.Statement.Returning-import Rel8.Statement.Run-import Rel8.Statement.Select-import Rel8.Statement.SQL-import Rel8.Statement.Update-import Rel8.Statement.View-import Rel8.Table-import Rel8.Table.ADT-import Rel8.Table.Aggregate-import Rel8.Table.Aggregate.Maybe-import Rel8.Table.Alternative-import Rel8.Table.Bool-import Rel8.Table.Either-import Rel8.Table.Eq-import Rel8.Table.HKD-import Rel8.Table.List-import Rel8.Table.Maybe-import Rel8.Table.Name-import Rel8.Table.NonEmpty-import Rel8.Table.Null-import Rel8.Table.Opaleye ( castTable )-import Rel8.Table.Ord-import Rel8.Table.Order-import Rel8.Table.Projection-import Rel8.Table.Rel8able ()-import Rel8.Table.Serialize-import Rel8.Table.These-import Rel8.Table.Transpose-import Rel8.Table.Window-import Rel8.Type-import Rel8.Type.Composite-import Rel8.Type.Eq-import Rel8.Type.Enum-import Rel8.Type.Information-import Rel8.Type.JSONBEncoded-import Rel8.Type.JSONEncoded-import Rel8.Type.Monoid-import Rel8.Type.Name-import Rel8.Type.Num-import Rel8.Type.Ord-import Rel8.Type.ReadShow-import Rel8.Type.Semigroup-import Rel8.Type.String-import Rel8.Type.Sum-import Rel8.Window+import Rel8.Internal.Aggregate+import Rel8.Internal.Aggregate.Fold+import Rel8.Internal.Aggregate.Function+import Rel8.Internal.Column+import Rel8.Internal.Column.ADT+import Rel8.Internal.Column.Either+import Rel8.Internal.Column.Lift+import Rel8.Internal.Column.List+import Rel8.Internal.Column.Maybe+import Rel8.Internal.Column.NonEmpty+import Rel8.Internal.Column.Null+import Rel8.Internal.Column.These+import Rel8.Internal.Expr+import Rel8.Internal.Expr.Aggregate+import Rel8.Internal.Expr.Array+import Rel8.Internal.Expr.Bool+import Rel8.Internal.Expr.Default+import Rel8.Internal.Expr.Eq+import Rel8.Internal.Expr.Function+import Rel8.Internal.Expr.Null+import Rel8.Internal.Expr.Opaleye (unsafeCastExpr, unsafeCoerceExpr, unsafeLiteral, unsafePrimExpr)+import Rel8.Internal.Expr.Ord+import Rel8.Internal.Expr.Order+import Rel8.Internal.Expr.Serialize+import Rel8.Internal.Expr.Sequence+import Rel8.Internal.Expr.Text ( like, ilike )+import Rel8.Internal.Expr.Window+import Rel8.Internal.Generic.Rel8able ( KRel8able, Rel8able )+import Rel8.Internal.Order+import Rel8.Internal.Query+import Rel8.Internal.Query.Aggregate+import Rel8.Internal.Query.Distinct+import Rel8.Internal.Query.Each+import Rel8.Internal.Query.Either+import Rel8.Internal.Query.Evaluate+import Rel8.Internal.Query.Exists+import Rel8.Internal.Query.Filter+import Rel8.Internal.Query.Function+import Rel8.Internal.Query.Indexed+import Rel8.Internal.Query.Limit+import Rel8.Internal.Query.List+import Rel8.Internal.Query.Loop+import Rel8.Internal.Query.Materialize+import Rel8.Internal.Query.Maybe+import Rel8.Internal.Query.Null+import Rel8.Internal.Query.Order+import Rel8.Internal.Query.Rebind+import Rel8.Internal.Query.SQL (showQuery)+import Rel8.Internal.Query.Set+import Rel8.Internal.Query.These+import Rel8.Internal.Query.Values+import Rel8.Internal.Query.Window+import Rel8.Internal.Schema.Field+import Rel8.Internal.Schema.HTable+import Rel8.Internal.Schema.Name+import Rel8.Internal.Schema.Null hiding ( nullable )+import Rel8.Internal.Schema.QualifiedName+import Rel8.Internal.Schema.Result ( Result )+import Rel8.Internal.Schema.Table+import Rel8.Internal.Statement+import Rel8.Internal.Statement.Delete+import Rel8.Internal.Statement.Insert+import Rel8.Internal.Statement.OnConflict+import Rel8.Internal.Statement.Prepared+import Rel8.Internal.Statement.Returning+import Rel8.Internal.Statement.Run+import Rel8.Internal.Statement.Select+import Rel8.Internal.Statement.SQL+import Rel8.Internal.Statement.Update+import Rel8.Internal.Statement.View+import Rel8.Internal.Table+import Rel8.Internal.Table.ADT+import Rel8.Internal.Table.Aggregate+import Rel8.Internal.Table.Aggregate.Maybe+import Rel8.Internal.Table.Alternative+import Rel8.Internal.Table.Bool+import Rel8.Internal.Table.Either+import Rel8.Internal.Table.Eq+import Rel8.Internal.Table.HKD+import Rel8.Internal.Table.List+import Rel8.Internal.Table.Maybe+import Rel8.Internal.Table.Name+import Rel8.Internal.Table.NonEmpty+import Rel8.Internal.Table.Null+import Rel8.Internal.Table.Opaleye ( castTable )+import Rel8.Internal.Table.Ord+import Rel8.Internal.Table.Order+import Rel8.Internal.Table.Projection+import Rel8.Internal.Table.Rel8able ()+import Rel8.Internal.Table.Serialize+import Rel8.Internal.Table.These+import Rel8.Internal.Table.Transpose+import Rel8.Internal.Table.Window+import Rel8.Internal.Type+import Rel8.Internal.Type.Composite+import Rel8.Internal.Type.Eq+import Rel8.Internal.Type.Enum+import Rel8.Internal.Type.Information+import Rel8.Internal.Type.JSONBEncoded+import Rel8.Internal.Type.JSONEncoded+import Rel8.Internal.Type.Monoid+import Rel8.Internal.Type.Name+import Rel8.Internal.Type.Num+import Rel8.Internal.Type.Ord+import Rel8.Internal.Type.ReadShow+import Rel8.Internal.Type.Semigroup+import Rel8.Internal.Type.String+import Rel8.Internal.Type.Sum+import Rel8.Internal.Window   -- $running@@ -534,11 +536,11 @@ -- data Thing f = ThingEmployer (Employer f) | ThingPotato (Potato f) | Nullary --     deriving stock Generic ----- data Employer f = Employer { employerId :: f Int32, employerName :: f Text}+-- data Employer f = Employer { employerId :: Column f Int32, employerName :: Column f Text} --   deriving stock Generic --   deriving anyclass Rel8able ----- data Potato f = Potato { size :: f Int32, grower :: f Text }+-- data Potato f = Potato { size :: Column f Int32, grower :: Column f Text } --   deriving stock Generic --   deriving anyclass Rel8able -- @

@@ -1,197 +0,0 @@-{-# language DataKinds #-}-{-# language GADTs #-}-{-# language KindSignatures #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}--module Rel8.Aggregate-  ( Aggregator' (Aggregator)-  , Aggregator-  , Aggregator1-  , toAggregator-  , toAggregator1-  , filterWhereExplicit-  , unsafeMakeAggregator-  )-where---- base-import Control.Applicative (liftA2)-import Data.Kind (Type)-import Prelude---- opaleye-import qualified Opaleye.Aggregate as Opaleye-import qualified Opaleye.Internal.MaybeFields as Opaleye-import qualified Opaleye.Internal.Operators as Opaleye---- product-profunctor-import Data.Profunctor.Product-  ( ProductProfunctor, purePP, (****)-  , SumProfunctor, (+++!)-  )---- profunctors-import Data.Profunctor (Profunctor, dimap)---- rel8-import Rel8.Expr (Expr)-import Rel8.Expr.Opaleye (toPrimExpr, toColumn)-import Rel8.Aggregate.Fold (Fallback (Empty, Fallback), Fold (Full, Semi))---- semigroupoids-import Data.Functor.Apply (Apply, liftF2)----- | 'Aggregator'' is the most general form of \"aggregator\", of which--- 'Aggregator' and 'Aggregator1' are special cases. 'Aggregator''s are--- comprised of aggregation functions and/or @GROUP BY@ clauses.------ Aggregation functions operating on individual 'Rel8.Expr's such as--- 'Rel8.sum' can be combined into 'Aggregator's operating on larger types--- using the 'Applicative', 'Profunctor' and 'ProductProfunctor' interfaces.--- Working with 'Profunctor's can sometimes be awkward so for every 'Rel8.sum'--- we also provide a 'Rel8.sumOn' which bundles an 'Data.Profunctor.lmap'. For--- complex aggregations, we recommend using these functions along with--- @ApplicativeDo@, @BlockArguments@, @OverloadedRecordDot@ and--- @RecordWildCards@:------ @------ data Input f = Input---   { orderId :: Column f OrderId---   , customerId :: Column f CustomerId---   , productId :: Column f ProductId---   , quantity :: Column f Int64---   , price :: Column f Scientific---   }---   deriving (Generic, Rel8able)--------- totalPrice :: Input Expr -> Expr Scientific--- totalPrice input = fromIntegral input.quantity * input.price--------- data Result f = Result---   { customerId :: Column f CustomerId---   , totalOrders :: Column f Int64---   , productsOrdered :: Column f Int64---   , totalPrice :: Column f Scientific---   }---   deriving (Generic, Rel8able)--------- allResults :: Query (Result Expr)--- allResults =---   aggregate---     do---       customerId <- groupByOn (.customerId)---       totalOrders <- countDistinctOn (.orderId)---       productsOrdered <- countDistinctOn (.productId)---       totalPrice <- sumOn totalPrice---       pure Result {..}---     do---       order <- each orderSchema---       orderLine <- each orderLineSchema---       where_ $ order.id ==. orderLine.orderId---       pure---         Input---           { orderId = order.id---           , customerId = order.customerId---           , productId = orderLine.productId---           , quantity = orderLine.quantity---           , price = orderLine.price---           }--- @-type Aggregator' :: Fold -> Type -> Type -> Type-data Aggregator' fold i a = Aggregator !(Fallback fold a) !(Opaleye.Aggregator i a)---instance Profunctor (Aggregator' fold) where-  dimap f g (Aggregator fallback a) =-    Aggregator (fmap g fallback) (dimap f g a)---instance ProductProfunctor (Aggregator' fold) where-  purePP = pure-  (****) = (<*>)---instance SumProfunctor (Aggregator' fold) where-  Aggregator fallback a +++! Aggregator fallback' b =-    flip Aggregator (a +++! b) $ case fallback of-      Empty -> case fallback' of-        Empty -> Empty-        Fallback x -> Fallback (Right x)-      Fallback x -> Fallback (Left x)---instance Functor (Aggregator' fold i) where-  fmap = dimap id---instance Apply (Aggregator' fold i) where-  liftF2 f (Aggregator fallback a) (Aggregator fallback' b) =-    Aggregator (liftF2 f fallback fallback') (liftA2 f a b)---instance Applicative (Aggregator' fold i) where-  pure a = Aggregator (pure a) (pure a)-  liftA2 = liftF2----- | An 'Aggregator' takes a 'Rel8.Query' producing a collection of rows of--- type @a@ and transforms it into a 'Rel8.Query' producing a single row of--- type @b@. If the given 'Rel8.Query' produces an empty collection of rows,--- then the single row in the resulting 'Rel8.Query' contains the identity--- values of the aggregation functions comprising the 'Aggregator' (i.e.,--- @0@ for 'Rel8.sum', 'Rel8.false' for 'Rel8.or', etc.).------ 'Aggregator' is a special form of 'Aggregator'' parameterised by 'Full'.-type Aggregator :: Type -> Type -> Type-type Aggregator = Aggregator' 'Full----- | An 'Aggregator1' takes a collection of rows of type @a@, groups them, and--- transforms each group into a single row of type @b@. This corresponds to--- aggregators using @GROUP BY@ in SQL. If given an empty collection of rows,--- 'Aggregator1' will have no groups and will therefore also return an empty--- collection of rows.------ 'Aggregator1' is a special form of 'Aggregator'' parameterised by 'Semi'.-type Aggregator1 :: Type -> Type -> Type-type Aggregator1 = Aggregator' 'Semi----- | 'toAggregator1' turns an 'Aggregator' into an 'Aggregator1'.-toAggregator1 :: Aggregator' fold i a -> Aggregator1 i a-toAggregator1 (Aggregator _ a) = Aggregator Empty a----- | Given a value to fall back on if given an empty collection of rows,--- 'toAggregator' turns an 'Aggregator1' into an 'Aggregator'.-toAggregator :: a -> Aggregator' fold i a -> Aggregator' fold' i a-toAggregator fallback (Aggregator _ a) = Aggregator (Fallback fallback) a---filterWhereExplicit :: ()-  => Opaleye.IfPP a a-  -> (i -> Expr Bool)-  -> Aggregator i a-  -> Aggregator' fold i a-filterWhereExplicit ifPP f (Aggregator (Fallback fallback) aggregator) =-  Aggregator (Fallback fallback) aggregator'-  where-    aggregator' =-      Opaleye.fromMaybeFieldsExplicit ifPP fallback-        <$> Opaleye.filterWhere (toColumn . toPrimExpr . f) aggregator---unsafeMakeAggregator :: forall (i :: Type) (o :: Type) (fold :: Fold) i' o'.  ()-  => (i -> i')-  -> (o' -> o)-  -> Fallback fold o-  -> Opaleye.Aggregator i' o'-  -> Aggregator' fold i o-unsafeMakeAggregator input output fallback =-  Aggregator fallback . dimap input output

@@ -1,52 +0,0 @@-{-# language DataKinds #-}-{-# language GADTs #-}-{-# language LambdaCase #-}-{-# language StandaloneKindSignatures #-}--module Rel8.Aggregate.Fold-  ( Fallback (Empty, Fallback)-  , Fold (Semi, Full)-  )-where---- base-import Control.Applicative (liftA2)-import Data.Kind (Type)-import Prelude---- semigroupoids-import Data.Functor.Apply (Apply, liftF2)----- | 'Fold' is a kind that parameterises aggregations. Aggregations--- parameterised by 'Semi' are analogous to 'Data.Semigroup.Foldable.foldMap1'--- (i.e, they can only produce results on a non-empty 'Rel8.Query') whereas--- aggregations parameterised by 'Full' are analagous to 'foldMap' (given a--- non-empty) query, they return the identity values of the aggregation--- functions.-type Fold :: Type-data Fold = Semi | Full---type Fallback :: Fold -> Type -> Type-data Fallback fold a where-  Fallback :: !a -> Fallback fold a-  Empty :: Fallback 'Semi a---instance Functor (Fallback fold) where-  fmap f = \case-    Fallback a -> Fallback (f a)-    Empty -> Empty---instance Apply (Fallback fold) where-  liftF2 f (Fallback a) (Fallback b) = Fallback (f a b)-  liftF2 _ (Fallback _) Empty = Empty-  liftF2 _ Empty (Fallback _) = Empty-  liftF2 _ Empty Empty = Empty---instance Applicative (Fallback fold) where-  pure = Fallback-  liftA2 = liftF2

@@ -1,45 +0,0 @@-{-# language FlexibleContexts #-}-{-# language MonoLocalBinds #-}--module Rel8.Aggregate.Function (-  aggregateFunction,-  rawAggregateFunction,-) where---- base-import Prelude---- opaleye-import qualified Opaleye.Internal.Aggregate as Opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Aggregate (Aggregator1, unsafeMakeAggregator)-import Rel8.Aggregate.Fold (Fallback (Empty))-import Rel8.Expr (Expr)-import Rel8.Expr.Opaleye (castExpr, fromColumn, fromPrimExpr)-import Rel8.Schema.Null (Sql)-import Rel8.Schema.QualifiedName (QualifiedName, showQualifiedName)-import Rel8.Table (Table)-import Rel8.Table.Opaleye (unpackspec)-import Rel8.Type (DBType)----- | 'aggregateFunction' allows the use use of custom aggregation functions--- or PostgreSQL aggregation functions which are not otherwise supported by--- Rel8.-aggregateFunction ::-  (Table Expr i, Sql DBType a) =>-  QualifiedName ->-  Aggregator1 i (Expr a)-aggregateFunction name = castExpr <$> rawAggregateFunction name---rawAggregateFunction :: Table Expr i => QualifiedName -> Aggregator1 i (Expr a)-rawAggregateFunction name =-  unsafeMakeAggregator-    id-    (fromPrimExpr . fromColumn)-    Empty-    (Opaleye.makeAggrExplicit unpackspec-      (Opaleye.AggrOther (showQualifiedName name)))

@@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Rel8.Array   (@@ -10,7 +12,7 @@   , index, indexExpr   , last, lastExpr   , length, lengthExpr-  , elem+  , elem, notElem      -- ** @NonEmptyTable@   , NonEmptyTable@@ -18,7 +20,7 @@   , index1, index1Expr   , last1, last1Expr   , length1, length1Expr-  , elem1+  , elem1, notElem1      -- ** Unsafe   , unsafeSubscript@@ -27,34 +29,74 @@ where  -- base+import Data.Int (Int32) import Data.List.NonEmpty (NonEmpty)-import Prelude hiding (elem, head, last, length)+import Prelude hiding (elem, head, last, length, notElem) +-- opaleye+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye+ -- rel8-import Rel8.Expr (Expr)-import Rel8.Expr.Array (listOf, nonEmptyOf)-import Rel8.Expr.Function (rawBinaryOperator)-import Rel8.Expr.List-import Rel8.Expr.NonEmpty-import Rel8.Expr.Subscript-import Rel8.Schema.Null (Sql)-import Rel8.Table.List-import Rel8.Table.NonEmpty-import Rel8.Type.Eq (DBEq)+import Rel8.Internal.Expr (Expr)+import Rel8.Internal.Expr.Bool (not_)+import Rel8.Internal.Expr.Function (rawFunction)+import Rel8.Internal.Expr.List+import Rel8.Internal.Expr.NonEmpty+import Rel8.Internal.Expr.Null (isNonNull, isNull)+import Rel8.Internal.Expr.Opaleye (fromPrimExpr, toPrimExpr)+import Rel8.Internal.Expr.Subscript+import Rel8.Internal.Schema.Null (Nullity (NotNull, Null), Sql, nullable)+import Rel8.Internal.Table.List+import Rel8.Internal.Table.NonEmpty+import Rel8.Internal.Type (DBType)+import Rel8.Internal.Type.Eq (DBEq)   -- | @'elem' a as@ tests whether @a@ is an element of the list @as@. elem :: Sql DBEq a => Expr a -> Expr [a] -> Expr Bool-elem = (<@) . listOf . pure-  where-    (<@) = rawBinaryOperator "<@"+elem = memberOf infix 4 `elem`   -- | @'elem1' a as@ tests whether @a@ is an element of the non-empty list -- @as@. elem1 :: Sql DBEq a => Expr a -> Expr (NonEmpty a) -> Expr Bool-elem1 = (<@) . nonEmptyOf . pure-  where-    (<@) = rawBinaryOperator "<@"+elem1 = memberOf infix 4 `elem1`+++-- | @'notElem' a as@ tests whether @a@ is not an element of the list @as@.+notElem :: Sql DBEq a => Expr a -> Expr [a] -> Expr Bool+notElem = notMemberOf+infix 4 `notElem`+++-- | @'notElem1' a as@ tests whether @a@ is not an element of the non-empty+-- list @as@.+notElem1 :: Sql DBEq a => Expr a -> Expr (NonEmpty a) -> Expr Bool+notElem1 = notMemberOf+infix 4 `notElem1`+++memberOf :: forall a t. (Sql DBEq a, DBType (t a))+  => Expr a -> Expr (t a) -> Expr Bool+memberOf = case nullable @a of+  Null -> \ma mas -> isNonNull (position mas ma)+  NotNull -> eqAny+++notMemberOf :: forall a t. (Sql DBEq a, DBType (t a))+  => Expr a -> Expr (t a) -> Expr Bool+notMemberOf = case nullable @a of+  Null -> \ma mas -> isNull (position mas ma)+  NotNull -> \a as -> not_ (eqAny a as)+++position :: (DBType (t (Maybe a)), DBType a)+  => Expr (t (Maybe a)) -> Expr (Maybe a) -> Expr (Maybe Int32)+position as a = rawFunction "array_position" (as, a)+++eqAny :: Expr a -> Expr as -> Expr Bool+eqAny a as =+  fromPrimExpr (Opaleye.AnyExpr (Opaleye.:==) (toPrimExpr a) (toPrimExpr as))

@@ -1,31 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilies #-}--module Rel8.Column-  ( Column-  , TColumn-  )-where---- base-import Data.Kind ( Type )-import Prelude ()---- rel8-import Rel8.FCF ( Eval, Exp )-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )----- | This type family is used to specify columns in 'Rel8able's. In @Column f--- a@, @f@ is the context of the column (which should be left polymorphic in--- 'Rel8able' definitions), and @a@ is the type of the column.-type Column :: K.Context -> Type -> Type-type family Column context a where-  Column Result  a = a-  Column context a = context a---data TColumn :: K.Context -> Type -> Exp Type-type instance Eval (TColumn f a) = Column f a

@@ -1,23 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilies #-}--module Rel8.Column.ADT-  ( HADT-  )-where---- base-import Data.Kind ( Type )-import Prelude ()---- rel8-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )-import Rel8.Table.ADT ( ADT )---type HADT :: K.Context -> K.Rel8able -> Type-type family HADT context t where-  HADT Result t = t Result-  HADT context t = ADT t context

@@ -1,26 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilyDependencies #-}--module Rel8.Column.Either-  ( HEither-  )-where---- base-import Data.Kind ( Type )-import Prelude---- rel8-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )-import Rel8.Table.Either ( EitherTable )----- | Nest an 'Either' value within a 'Rel8able'. @HEither f a b@ will produce a--- 'EitherTable' @a b@ in the 'Expr' context, and a 'Either' @a b@ in the--- 'Result' context.-type HEither :: K.Context -> Type -> Type -> Type-type family HEither context = either | either -> context where-  HEither Result = Either-  HEither context = EitherTable context

@@ -1,23 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilies #-}--module Rel8.Column.Lift-  ( Lift-  )-where---- base-import Data.Kind ( Type )-import Prelude ()---- rel8-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )-import Rel8.Table.HKD ( HKD )---type Lift :: K.Context -> Type -> Type-type family Lift context a where-  Lift Result a = a-  Lift context a = HKD a context

@@ -1,25 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilyDependencies #-}--module Rel8.Column.List-  ( HList-  )-where---- base-import Data.Kind ( Type )-import Prelude ()---- rel8-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )-import Rel8.Table.List ( ListTable )----- | Nest a list within a 'Rel8able'. @HList f a@ will produce a 'ListTable'--- @a@ in the 'Expr' context, and a @[a]@ in the 'Result' context.-type HList :: K.Context -> Type -> Type-type family HList context = list | list -> context where-  HList Result = []-  HList context = ListTable context

@@ -1,26 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilyDependencies #-}--module Rel8.Column.Maybe-  ( HMaybe-  )-where---- base-import Data.Kind ( Type )-import Prelude---- rel8-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )-import Rel8.Table.Maybe ( MaybeTable )----- | Nest a 'Maybe' value within a 'Rel8able'. @HMaybe f a@ will produce a--- 'MaybeTable' @a@ in the 'Expr' context, and a 'Maybe' @a@ in the 'Result'--- context.-type HMaybe :: K.Context -> Type -> Type-type family HMaybe context = maybe | maybe -> context where-  HMaybe Result = Maybe-  HMaybe context = MaybeTable context

@@ -1,27 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilyDependencies #-}--module Rel8.Column.NonEmpty-  ( HNonEmpty-  )-where---- base-import Data.Kind ( Type )-import Data.List.NonEmpty ( NonEmpty )-import Prelude ()---- rel8-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )-import Rel8.Table.NonEmpty ( NonEmptyTable )----- | Nest a 'NonEmpty' list within a 'Rel8able'. @HNonEmpty f a@ will produce a--- 'NonEmptyTable' @a@ in the 'Expr' context, and a 'NonEmpty' @a@ in the--- 'Result' context.-type HNonEmpty :: K.Context -> Type -> Type-type family HNonEmpty context = nonEmpty | nonEmpty -> context where-  HNonEmpty Result = NonEmpty-  HNonEmpty context = NonEmptyTable context

@@ -1,26 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilyDependencies #-}--module Rel8.Column.Null-  ( HNull-  )-where---- base-import Data.Kind ( Type )-import Prelude---- rel8-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )-import Rel8.Table.Null ( NullTable )----- | Nest a 'Null' value within a 'Rel8able'. @HNull f a@ will produce a--- 'NullTable' @a@ in the 'Expr' context, and a @'Maybe' a@ in the 'Result'--- context.-type HNull :: K.Context -> Type -> Type-type family HNull context = maybe | maybe -> context where-  HNull Result = Maybe-  HNull context = NullTable context

@@ -1,29 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilyDependencies #-}--module Rel8.Column.These-  ( HThese-  )-where---- base-import Data.Kind ( Type )-import Prelude ()---- rel8-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )-import Rel8.Table.These ( TheseTable )---- these-import Data.These ( These )----- | Nest an 'These' value within a 'Rel8able'. @HThese f a b@ will produce a--- 'TheseTable' @a b@ in the 'Expr' context, and a 'These' @a b@ in the--- 'Result' context.-type HThese :: K.Context -> Type -> Type -> Type-type family HThese context = these | these -> context where-  HThese Result = These-  HThese context = TheseTable context

@@ -3,4 +3,4 @@   Parser,   parseDecoder, ) where-import Rel8.Type.Decoder+import Rel8.Internal.Type.Decoder

@@ -1,4 +1,4 @@ module Rel8.Encoder (   Encoder (..), ) where-import Rel8.Type.Encoder+import Rel8.Internal.Type.Encoder

@@ -1,137 +0,0 @@-{-# language DataKinds #-}-{-# language DerivingStrategies #-}-{-# language FlexibleContexts #-}-{-# language FlexibleInstances #-}-{-# language MultiParamTypeClasses #-}-{-# language OverloadedStrings #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}-{-# language UndecidableInstances #-}--module Rel8.Expr-  ( Expr(..)-  )-where---- base-import Data.Functor.Identity ( Identity( Identity ) )-import Data.Ratio (denominator, numerator)-import Data.String ( IsString, fromString )-import Prelude hiding ( null )---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Expr.Function (function)-import Rel8.Expr.Null ( liftOpNull, nullify )-import Rel8.Expr.Opaleye-  ( castExpr-  , fromPrimExpr-  , mapPrimExpr-  , zipPrimExprsWith-  )-import Rel8.Expr.Serialize ( litExpr )-import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )-import Rel8.Table-  ( Table, Columns, Context, fromColumns, toColumns-  , FromExprs, fromResult, toResult-  , Transpose-  )-import Rel8.Type ( DBType )-import Rel8.Type.Monoid ( DBMonoid, memptyExpr )-import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )-import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )---- scientific-import Data.Scientific (fromRationalRepetendLimited)----- | Typed SQL expressions.-type Expr :: K.Context-newtype Expr a = Expr Opaleye.PrimExpr-  deriving stock Show---instance Sql DBSemigroup a => Semigroup (Expr a) where-  (<>) = case nullable @a of-    Null -> liftOpNull (<>.)-    NotNull -> (<>.)-  {-# INLINABLE (<>) #-}---instance Sql DBMonoid a => Monoid (Expr a) where-  mempty = case nullable @a of-    Null -> nullify memptyExpr-    NotNull -> memptyExpr-  {-# INLINABLE mempty #-}---instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where-  fromString = litExpr . case nullable @a of-    Null -> Just . fromString-    NotNull -> fromString---instance Sql DBNum a => Num (Expr a) where-  (+) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))-  (*) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:*))-  (-) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:-))--  abs = mapPrimExpr (Opaleye.UnExpr Opaleye.OpAbs)-  negate = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNegate)--  signum = castExpr . mapPrimExpr (Opaleye.UnExpr (Opaleye.UnOpOther "SIGN"))--  fromInteger = castExpr . fromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit---instance Sql DBFractional a => Fractional (Expr a) where-  (/) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:/))--  fromRational = castExpr . Expr . toScientific-    where-      toScientific r = case fromRationalRepetendLimited 20 r of-        Right (s, Nothing) -> Opaleye.ConstExpr (Opaleye.NumericLit s)-        _ -> Opaleye.BinExpr (Opaleye.:/) (int n) (int d)-          where-            int = Opaleye.ConstExpr . Opaleye.NumericLit . fromInteger-            n = numerator r-            d = denominator r---instance Sql DBFloating a => Floating (Expr a) where-  pi = function "pi" ()-  exp = function "exp"-  log = function "ln"-  sqrt = function "sqrt"-  (**) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:^))-  logBase a b = function "log" (a, b)-  sin = function "sin"-  cos = function "cos"-  tan = function "tan"-  asin = function "asin"-  acos = function "acos"-  atan = function "atan"-  sinh = function "sinh"-  cosh = function "cosh"-  tanh = function "tanh"-  asinh = function "asinh"-  acosh = function "acosh"-  atanh = function "atanh"---instance Sql DBType a => Table Expr (Expr a) where-  type Columns (Expr a) = HIdentity a-  type Context (Expr a) = Expr-  type FromExprs (Expr a) = a-  type Transpose to (Expr a) = to a--  toColumns a = HIdentity a-  fromColumns (HIdentity a) = a-  toResult a = HIdentity (Identity a)-  fromResult (HIdentity (Identity a)) = a

@@ -1,20 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}--module Rel8.Expr-  ( Expr(..)-  )-where---- base-import Prelude ()---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Schema.Kind ( Context )---type Expr :: Context-newtype Expr a = Expr Opaleye.PrimExpr

@@ -1,495 +0,0 @@-{-# language DataKinds #-}-{-# language DisambiguateRecordFields #-}-{-# language FlexibleContexts #-}-{-# language NamedFieldPuns #-}-{-# language OverloadedStrings #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}--{-# options_ghc -fno-warn-redundant-constraints #-}--module Rel8.Expr.Aggregate-  ( count, countOn, countStar-  , countDistinct, countDistinctOn-  , countWhere, countWhereOn-  , and, andOn, or, orOn-  , min, minOn, max, maxOn-  , sum, sumOn, sumWhere-  , avg, avgOn-  , stringAgg, stringAggOn-  , mode, modeOn-  , percentile, percentileOn-  , percentileContinuous, percentileContinuousOn-  , hypotheticalRank-  , hypotheticalDenseRank-  , hypotheticalPercentRank-  , hypotheticalCumeDist-  , groupByExpr, groupByExprOn-  , distinctAggregate-  , filterWhereExplicit-  , listAggExpr, listAggExprOn, nonEmptyAggExpr, nonEmptyAggExprOn-  , listCatExpr, listCatExprOn, nonEmptyCatExpr, nonEmptyCatExprOn-  , slistAggExpr, snonEmptyAggExpr-  , slistCatExpr, snonEmptyCatExpr-  )-where---- base-import Data.Functor.Contravariant ((>$<))-import Data.Int ( Int64 )-import Data.List.NonEmpty ( NonEmpty )-import Data.String (IsString)-import Prelude hiding (and, max, min, null, or, show, sum)---- opaleye-import qualified Opaleye.Aggregate as Opaleye-import qualified Opaleye.Internal.Aggregate as Opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye-import qualified Opaleye.Internal.Operators as Opaleye---- profunctors-import Data.Profunctor (dimap, lmap)---- rel8-import Rel8.Aggregate-  ( Aggregator' (Aggregator)-  , Aggregator1-  , filterWhereExplicit-  , unsafeMakeAggregator-  )-import Rel8.Aggregate.Fold (Fallback (Empty, Fallback))-import Rel8.Expr ( Expr )-import Rel8.Expr.Array (sempty)-import Rel8.Expr.Bool (false, true)-import Rel8.Expr.Eq ((/=.))-import Rel8.Expr.Opaleye-  ( castExpr-  , fromColumn-  , fromPrimExpr-  , toColumn-  , toPrimExpr-  , unsafeCastExpr-  )-import Rel8.Expr.Order (asc)-import Rel8.Expr.Read (sread)-import Rel8.Expr.Show (show)-import qualified Rel8.Expr.Text as Text-import Rel8.Order (Order (Order))-import Rel8.Schema.Null ( Sql, Unnullify )-import Rel8.Table.Opaleye (fromOrder, unpackspec)-import Rel8.Table.Order (ascTable)-import Rel8.Type ( DBType, typeInformation )-import Rel8.Type.Array (arrayTypeName, quoteArrayElement)-import Rel8.Type.Eq ( DBEq )-import Rel8.Type.Information (TypeInformation)-import Rel8.Type.Num (DBFractional, DBNum)-import Rel8.Type.Ord (DBMax, DBMin, DBOrd)-import Rel8.Type.String ( DBString )-import Rel8.Type.Sum ( DBSum )----- | Count the occurances of a single column. Corresponds to @COUNT(a)@-count :: Aggregator' fold (Expr a) (Expr Int64)-count =-  unsafeMakeAggregator-    (toColumn . toPrimExpr)-    (fromPrimExpr . fromColumn)-    (Fallback 0)-    Opaleye.count----- | Applies 'count' to the column selected by the given function.-countOn :: (i -> Expr a) -> Aggregator' fold i (Expr Int64)-countOn f = lmap f count----- | Count the number of distinct occurrences of a single column. Corresponds to--- @COUNT(DISTINCT a)@-countDistinct :: Sql DBEq a-  => Aggregator' fold (Expr a) (Expr Int64)-countDistinct = distinctAggregate count----- | Applies 'countDistinct' to the column selected by the given function.-countDistinctOn :: Sql DBEq a-  => (i -> Expr a) -> Aggregator' fold i (Expr Int64)-countDistinctOn f = lmap f countDistinct----- | Corresponds to @COUNT(*)@.-countStar :: Aggregator' fold i (Expr Int64)-countStar = lmap (const true) count----- | A count of the number of times a given expression is @true@.-countWhere :: Aggregator' fold (Expr Bool) (Expr Int64)-countWhere = filterWhereExplicit ifPP id countStar----- | Applies 'countWhere' to the column selected by the given function.-countWhereOn :: (i -> Expr Bool) -> Aggregator' fold i (Expr Int64)-countWhereOn f = lmap f countWhere----- | Corresponds to @bool_and@.-and :: Aggregator' fold (Expr Bool) (Expr Bool)-and =-  unsafeMakeAggregator-    (toColumn . toPrimExpr)-    (fromPrimExpr . fromColumn)-    (Fallback true)-    Opaleye.boolAnd----- | Applies 'and' to the column selected by the given function.-andOn :: (i -> Expr Bool) -> Aggregator' fold i (Expr Bool)-andOn f = lmap f and----- | Corresponds to @bool_or@.-or :: Aggregator' fold (Expr Bool) (Expr Bool)-or =-  unsafeMakeAggregator-    (toColumn . toPrimExpr)-    (fromPrimExpr . fromColumn)-    (Fallback false)-    Opaleye.boolOr----- | Applies 'or' to the column selected by the given function.-orOn :: (i -> Expr Bool) -> Aggregator' fold i (Expr Bool)-orOn f = lmap f or----- | Produce an aggregation for @Expr a@ using the @max@ function.-max :: Sql DBMax a => Aggregator1 (Expr a) (Expr a)-max =-  unsafeMakeAggregator-    (toColumn . toPrimExpr)-    (fromPrimExpr . fromColumn)-    Empty-    Opaleye.unsafeMax----- | Applies 'max' to the column selected by the given function.-maxOn :: Sql DBMax a => (i -> Expr a) -> Aggregator1 i (Expr a)-maxOn f = lmap f max----- | Produce an aggregation for @Expr a@ using the @min@ function.-min :: Sql DBMin a => Aggregator1 (Expr a) (Expr a)-min =-  unsafeMakeAggregator-    (toColumn . toPrimExpr)-    (fromPrimExpr . fromColumn)-    Empty-    Opaleye.unsafeMin----- | Applies 'min' to the column selected by the given function.-minOn :: Sql DBMin a => (i -> Expr a) -> Aggregator1 i (Expr a)-minOn f = lmap f min----- | Corresponds to @sum@. Note that in SQL, @sum@ is type changing - for--- example the @sum@ of @integer@ returns a @bigint@. Rel8 doesn't support--- this, and will add explicit casts back to the original input type. This can--- lead to overflows, and if you anticipate very large sums, you should upcast--- your input.-sum :: (Sql DBNum a, Sql DBSum a) => Aggregator' fold (Expr a) (Expr a)-sum =-  unsafeMakeAggregator-    (toColumn . toPrimExpr)-    (fromPrimExpr . fromColumn)-    (Fallback 0)-    Opaleye.unsafeSum----- | Applies 'sum' to the column selected by the given fucntion.-sumOn :: (Sql DBNum a, Sql DBSum a)-  => (i -> Expr a) -> Aggregator' fold i (Expr a)-sumOn f = lmap f sum----- | 'sumWhere' is a combination of 'Rel8.filterWhere' and 'sumOn'.-sumWhere :: (Sql DBNum a, Sql DBSum a)-  => (i -> Expr Bool) -> (i -> Expr a) -> Aggregator' fold i (Expr a)-sumWhere condition = filterWhereExplicit ifPP condition . sumOn----- | Corresponds to @avg@. Note that in SQL, @avg@ is type changing - for--- example, the @avg@ of @integer@ returns a @numeric@. Rel8 doesn't support--- this, and will add explicit casts back to the original input type. If you--- need a fractional result on an integral column, you should cast your input--- to 'Double' or 'Data.Scientific.Scientific' before calling 'avg'.-avg :: Sql DBSum a => Aggregator1 (Expr a) (Expr a)-avg =-  unsafeMakeAggregator-    (toColumn . toPrimExpr)-    (fromPrimExpr . fromColumn)-    Empty-    Opaleye.unsafeAvg----- | Applies 'avg' to the column selected by the given fucntion.-avgOn :: Sql DBSum a => (i -> Expr a) -> Aggregator1 i (Expr a)-avgOn f = lmap f avg----- | Corresponds to @string_agg()@.-stringAgg :: (Sql IsString a, Sql DBString a)-  => Expr a -> Aggregator' fold (Expr a) (Expr a)-stringAgg delimiter =-  unsafeMakeAggregator-    (toColumn . toPrimExpr)-    (castExpr . fromPrimExpr . fromColumn)-    (Fallback "")-    (Opaleye.stringAgg (toColumn (toPrimExpr delimiter)))----- | Applies 'stringAgg' to the column selected by the given function.-stringAggOn :: (Sql IsString a, Sql DBString a)-  => Expr a -> (i -> Expr a) -> Aggregator' fold i (Expr a)-stringAggOn delimiter f = lmap f (stringAgg delimiter)----- | Corresponds to @mode() WITHIN GROUP (ORDER BY _)@.-mode :: Sql DBOrd a => Aggregator1 (Expr a) (Expr a)-mode =-  unsafeMakeAggregator-    id-    (fromPrimExpr . fromColumn)-    Empty-    (Opaleye.withinGroup ((\(Order o) -> o) ascTable)-      (Opaleye.makeAggrExplicit (pure ()) (Opaleye.AggrOther "mode")))----- | Applies 'mode' to the column selected by the given function.-modeOn :: Sql DBOrd a => (i -> Expr a) -> Aggregator1 i (Expr a)-modeOn f = lmap f mode----- | Corresponds to @percentile_disc(_) WITHIN GROUP (ORDER BY _)@.-percentile :: Sql DBOrd a => Expr Double -> Aggregator1 (Expr a) (Expr a)-percentile fraction = -  unsafeMakeAggregator-    (\a -> (fraction, a))-    (castExpr . fromPrimExpr . fromColumn)-    Empty-    (Opaleye.withinGroup ((\(Order o) -> o) (snd >$< ascTable))-      (Opaleye.makeAggrExplicit-        (lmap fst unpackspec)-        (Opaleye.AggrOther "percentile_disc")))----- | Applies 'percentile' to the column selected by the given function.-percentileOn ::-  Sql DBOrd a =>-  Expr Double ->-  (i -> Expr a) ->-  Aggregator1 i (Expr a)-percentileOn fraction f = lmap f (percentile fraction)----- | Corresponds to @percentile_cont(_) WITHIN GROUP (ORDER BY _)@.-percentileContinuous ::-  Sql DBFractional a =>-  Expr Double ->-  Aggregator1 (Expr a) (Expr a)-percentileContinuous fraction = -  unsafeMakeAggregator-    (\a -> (fraction, a))-    (castExpr . fromPrimExpr . fromColumn)-    Empty-    (Opaleye.withinGroup ((\(Order o) -> o) (unsafeCastExpr @Double . snd >$< asc))-      (Opaleye.makeAggrExplicit-        (lmap fst unpackspec)-        (Opaleye.AggrOther "percentile_disc")))------ | Applies 'percentileContinuous' to the column selected by the given--- function.-percentileContinuousOn ::-  Sql DBFractional a =>-  Expr Double ->-  (i -> Expr a) ->-  Aggregator1 i (Expr a)-percentileContinuousOn fraction f = lmap f (percentileContinuous fraction)----- | Corresponds to @rank(_) WITHIN GROUP (ORDER BY _)@.-hypotheticalRank ::-  Order a ->-  a ->-  Aggregator' fold a (Expr Int64)-hypotheticalRank (Order order) args = -  unsafeMakeAggregator-    (\a -> (args, a))-    (castExpr . fromPrimExpr . fromColumn)-    (Fallback 1)-    (Opaleye.withinGroup (snd >$< order)-      (Opaleye.makeAggrExplicit-        (fromOrder (fst >$< order))-        (Opaleye.AggrOther "rank")))----- | Corresponds to @dense_rank(_) WITHIN GROUP (ORDER BY _)@.-hypotheticalDenseRank ::-  Order a ->-  a ->-  Aggregator' fold a (Expr Int64)-hypotheticalDenseRank (Order order) args = -  unsafeMakeAggregator-    (const args)-    (castExpr . fromPrimExpr . fromColumn)-    (Fallback 1)-    (Opaleye.withinGroup order-      (Opaleye.makeAggrExplicit (fromOrder order)-        (Opaleye.AggrOther "dense_rank")))----- | Corresponds to @percent_rank(_) WITHIN GROUP (ORDER BY _)@.-hypotheticalPercentRank ::-  Order a ->-  a ->-  Aggregator' fold a (Expr Double)-hypotheticalPercentRank (Order order) args = -  unsafeMakeAggregator-    (const args)-    (castExpr . fromPrimExpr . fromColumn)-    (Fallback 0)-    (Opaleye.withinGroup order-      (Opaleye.makeAggrExplicit (fromOrder order)-        (Opaleye.AggrOther "percent_rank")))----- | Corresponds to @cume_dist(_) WITHIN GROUP (ORDER BY _)@.-hypotheticalCumeDist ::-  Order a ->-  a ->-  Aggregator' fold a (Expr Double)-hypotheticalCumeDist (Order order) args = -  unsafeMakeAggregator-    (const args)-    (castExpr . fromPrimExpr . fromColumn)-    (Fallback 1)-    (Opaleye.withinGroup order-      (Opaleye.makeAggrExplicit (fromOrder order)-        (Opaleye.AggrOther "cume_dist")))----- | Aggregate a value by grouping by it.-groupByExpr :: Sql DBEq a => Aggregator1 (Expr a) (Expr a)-groupByExpr =-  unsafeMakeAggregator-    (toColumn . toPrimExpr)-    (fromPrimExpr . fromColumn)-    Empty-    Opaleye.groupBy----- | Applies 'groupByExpr' to the column selected by the given function.-groupByExprOn :: Sql DBEq a => (i -> Expr a) -> Aggregator1 i (Expr a)-groupByExprOn f = lmap f groupByExpr----- | Collect expressions values as a list.-listAggExpr :: Sql DBType a => Aggregator' fold (Expr a) (Expr [a])-listAggExpr = slistAggExpr typeInformation----- | Applies 'listAggExpr' to the column selected by the given function.-listAggExprOn :: Sql DBType a => (i -> Expr a) -> Aggregator' fold i (Expr [a])-listAggExprOn f = lmap f listAggExpr----- | Collect expressions values as a non-empty list.-nonEmptyAggExpr :: Sql DBType a => Aggregator1 (Expr a) (Expr (NonEmpty a))-nonEmptyAggExpr = snonEmptyAggExpr typeInformation----- | Applies 'nonEmptyAggExpr' to the column selected by the given function.-nonEmptyAggExprOn :: Sql DBType a-  => (i -> Expr a) -> Aggregator1 i (Expr (NonEmpty a))-nonEmptyAggExprOn f = lmap f nonEmptyAggExpr----- | Concatenate lists into a single list.-listCatExpr :: Sql DBType a => Aggregator' fold (Expr [a]) (Expr [a])-listCatExpr = slistCatExpr typeInformation----- | Applies 'listCatExpr' to the column selected by the given function.-listCatExprOn :: Sql DBType a-  => (i -> Expr [a]) -> Aggregator' fold i (Expr [a])-listCatExprOn f = lmap f listCatExpr----- | Concatenate non-empty lists into a single non-empty list.-nonEmptyCatExpr :: Sql DBType a-  => Aggregator1 (Expr (NonEmpty a)) (Expr (NonEmpty a))-nonEmptyCatExpr = snonEmptyCatExpr typeInformation----- | Applies 'nonEmptyCatExpr' to the column selected by the given function.-nonEmptyCatExprOn :: Sql DBType a-  => (i -> Expr (NonEmpty a)) -> Aggregator1 i (Expr (NonEmpty a))-nonEmptyCatExprOn f = lmap f nonEmptyCatExpr----- | 'distinctAggregate' modifies an 'Aggregator' to consider only distinct--- values of each particular column. Note that this "distinction" only happens--- within each column individually, not across all columns simultaneously.-distinctAggregate :: Aggregator' fold i a -> Aggregator' fold i a-distinctAggregate (Aggregator fallback a) =-  Aggregator fallback (Opaleye.distinctAggregator a)---slistAggExpr :: ()-  => TypeInformation (Unnullify a) -> Aggregator' fold (Expr a) (Expr [a])-slistAggExpr info =-  unsafeMakeAggregator-    (toColumn . quoteArrayElement info . toPrimExpr)-    (fromPrimExpr . fromColumn)-    (Fallback (sempty info))-    Opaleye.arrayAgg---snonEmptyAggExpr :: ()-  => TypeInformation (Unnullify a) -> Aggregator1 (Expr a) (Expr (NonEmpty a))-snonEmptyAggExpr info =-  unsafeMakeAggregator-    (toColumn . quoteArrayElement info . toPrimExpr)-    (fromPrimExpr . fromColumn)-    Empty-    Opaleye.arrayAgg---slistCatExpr :: ()-  => TypeInformation (Unnullify a) -> Aggregator' fold (Expr [a]) (Expr [a])-slistCatExpr info = dimap (unbracket . show) (sread name . bracket) agg-  where-    bracket a = "{" <> a <> "}"-    unbracket a = Text.substr a 2 (Just (Text.length a - 2))-    agg = filterWhereExplicit ifPP (/=. "") (stringAgg ",")-    name = arrayTypeName info---snonEmptyCatExpr :: ()-  => TypeInformation (Unnullify a)-  -> Aggregator1 (Expr (NonEmpty a)) (Expr (NonEmpty a))-snonEmptyCatExpr info = dimap (unbracket . show) (sread name . bracket) agg-  where-    bracket a = "{" <> a <> "}"-    unbracket a = Text.substr a 2 (Just (Text.length a - 2))-    agg = filterWhereExplicit ifPP (/=. "") (stringAgg ",")-    name = arrayTypeName info---ifPP :: Opaleye.IfPP (Expr a) (Expr a)-ifPP = dimap from to Opaleye.ifPPField-  where-    from = toColumn . toPrimExpr-    to = fromPrimExpr . fromColumn

@@ -1,55 +0,0 @@-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language TypeFamilies #-}--{-# options_ghc -fno-warn-redundant-constraints #-}--module Rel8.Expr.Array-  ( listOf, nonEmptyOf-  , slistOf, snonEmptyOf-  , sappend, sappend1, sempty-  )-where---- base-import Data.List.NonEmpty (NonEmpty)-import Prelude---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import {-# SOURCE #-} Rel8.Expr ( Expr )-import Rel8.Expr.Opaleye (fromPrimExpr, toPrimExpr, zipPrimExprsWith)-import Rel8.Type ( DBType, typeInformation )-import Rel8.Type.Array (array)-import Rel8.Type.Information ( TypeInformation(..) )-import Rel8.Schema.Null (Unnullify, Sql)---sappend :: Expr [a] -> Expr [a] -> Expr [a]-sappend = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))---sappend1 :: Expr (NonEmpty a) -> Expr (NonEmpty a) -> Expr (NonEmpty a)-sappend1 = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))---sempty :: TypeInformation (Unnullify a) -> Expr [a]-sempty info = fromPrimExpr $ array info []---slistOf :: TypeInformation (Unnullify a) -> [Expr a] -> Expr [a]-slistOf info = fromPrimExpr . array info . fmap toPrimExpr---snonEmptyOf :: TypeInformation (Unnullify a) -> NonEmpty (Expr a) -> Expr (NonEmpty a)-snonEmptyOf info = fromPrimExpr . array info . fmap toPrimExpr---listOf :: Sql DBType a => [Expr a] -> Expr [a]-listOf = slistOf typeInformation---nonEmptyOf :: Sql DBType a => NonEmpty (Expr a) -> Expr (NonEmpty a)-nonEmptyOf = snonEmptyOf typeInformation

@@ -1,90 +0,0 @@-{-# language GADTs #-}--module Rel8.Expr.Bool-  ( false, true-  , (&&.), (||.), not_-  , and_, or_-  , boolExpr-  , caseExpr-  , coalesce-  )-where---- base-import Data.Foldable ( foldl' )-import Prelude hiding ( null )---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )-import Rel8.Expr.Opaleye ( mapPrimExpr, toPrimExpr, zipPrimExprsWith )-import Rel8.Expr.Serialize ( litExpr )----- | The SQL @false@ literal.-false :: Expr Bool-false = litExpr False----- | The SQL @true@ literal.-true :: Expr Bool-true = litExpr True----- | The SQL @AND@ operator.-(&&.) :: Expr Bool -> Expr Bool -> Expr Bool-(&&.) = zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpAnd)-infixr 3 &&.----- | The SQL @OR@ operator.-(||.) :: Expr Bool -> Expr Bool -> Expr Bool-(||.) = zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpOr)-infixr 2 ||.----- | The SQL @NOT@ operator.-not_ :: Expr Bool -> Expr Bool-not_ = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNot)----- | Fold @AND@ over a collection of expressions.-and_ :: Foldable f => f (Expr Bool) -> Expr Bool-and_ = foldl' (&&.) true----- | Fold @OR@ over a collection of expressions.-or_ :: Foldable f => f (Expr Bool) -> Expr Bool-or_ = foldl' (||.) false----- | Eliminate a boolean-valued expression.------ Corresponds to 'Data.Bool.bool'.-boolExpr :: Expr a -> Expr a -> Expr Bool -> Expr a-boolExpr ifFalse ifTrue condition = caseExpr [(condition, ifTrue)] ifFalse----- | A multi-way if/then/else statement. The first argument to @caseExpr@ is a--- list of alternatives. The first alternative that is of the form @(true, x)@--- will be returned. If no such alternative is found, a fallback expression is--- returned.------ Corresponds to a @CASE@ expression in SQL.-caseExpr :: [(Expr Bool, Expr a)] -> Expr a -> Expr a-caseExpr branches (Expr fallback) =-  Expr $ Opaleye.CaseExpr (map go branches) fallback-  where-    go (condition, value) = (toPrimExpr condition, toPrimExpr value)----- | Convert a @Expr (Maybe Bool)@ to a @Expr Bool@ by treating @Nothing@ as--- @False@. This can be useful when combined with 'Rel8.where_', which expects--- a @Bool@, and produces expressions that optimize better than general case--- analysis.-coalesce :: Expr (Maybe Bool) -> Expr Bool-coalesce (Expr a) = Expr a &&. Expr (Opaleye.FunExpr "COALESCE" [a, untrue])-  where-    untrue = Opaleye.ConstExpr (Opaleye.BoolLit False)

@@ -1,40 +0,0 @@-module Rel8.Expr.Default-  ( unsafeDefault-  )-where---- base-import Prelude ()---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Opaleye ( fromPrimExpr )----- | Corresponds to the SQL @DEFAULT@ expression.------ This 'Expr' is unsafe for numerous reasons, and should be used with care:------ 1. This 'Expr' only makes sense in an @INSERT@ or @UPDATE@ statement.------ 2. Rel8 is not able to verify that a particular column actually has a--- @DEFAULT@ value. Trying to use @unsafeDefault@ where there is no default--- will cause a runtime crash------ 3. @DEFAULT@ values cannot be transformed. For example, the innocuous Rel8--- code @unsafeDefault + 1@ will crash, despite type checking.------ Also note, PostgreSQL's syntax rules mean that @DEFAULT@ can only appear in--- @INSERT@ expressions whose rows are specified using @VALUES@. This means--- that if the @rows@ field of your 'Rel8.Insert' record doesn\'t look like--- @values [..]@, then @unsafeDefault@ won't work.------ Given all these caveats, we suggest avoiding the use of default values where--- possible, instead being explicit. A common scenario where default values are--- used is with auto-incrementing identifier columns. In this case, we suggest--- using 'Rel8.nextval' instead.-unsafeDefault :: Expr a-unsafeDefault = fromPrimExpr Opaleye.DefaultInsertExpr

@@ -1,101 +0,0 @@-{-# language FlexibleContexts #-}-{-# language GADTs #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}-{-# language ViewPatterns #-}--{-# options_ghc -fno-warn-redundant-constraints #-}--module Rel8.Expr.Eq-  ( (==.), (/=.)-  , (==?), (/=?)-  , in_-  )-where---- base-import Data.Foldable ( toList )-import Data.List.NonEmpty ( nonEmpty )-import Prelude---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Bool ( (&&.), (||.), false, or_, coalesce )-import Rel8.Expr.Null ( isNull, unsafeLiftOpNull )-import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr, zipPrimExprsWith )-import Rel8.Schema.Null ( Nullity( NotNull, Null ), Sql, nullable )-import Rel8.Type.Eq ( DBEq )---eq :: DBEq a => Expr a -> Expr a -> Expr Bool-eq = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:==))---ne :: DBEq a => Expr a -> Expr a -> Expr Bool-ne = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<>))----- | Compare two expressions for equality. ------ This corresponds to the SQL @IS NOT DISTINCT FROM@ operator, and will equate--- @null@ values as @true@. This differs from @=@ which would return @null@.--- This operator matches Haskell's '==' operator. For an operator identical to--- SQL @=@, see '==?'.-(==.) :: forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool-(==.) = case nullable @a of-  Null -> \ma mb -> isNull ma &&. isNull mb ||. ma ==? mb-  NotNull -> eq-infix 4 ==.-{-# INLINABLE (==.) #-}----- | Test if two expressions are different (not equal).------ This corresponds to the SQL @IS DISTINCT FROM@ operator, and will return--- @false@ when comparing two @null@ values. This differs from ordinary @<>@--- which would return @null@. This operator is closer to Haskell's '/='--- operator. For an operator identical to SQL @<>@, see '/=?'.-(/=.) :: forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool-(/=.) = case nullable @a of-  Null -> \ma mb -> isNull ma `ne` isNull mb ||. ma /=? mb-  NotNull -> ne-infix 4 /=.-{-# INLINABLE (/=.) #-}----- | Test if two expressions are equal. This operator is usually the best--- choice when forming join conditions, as PostgreSQL has a much harder time--- optimizing a join that has multiple 'True' conditions.------ This corresponds to the SQL @=@ operator, though it will always return a--- 'Bool'.-(==?) :: DBEq a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool-a ==? b = coalesce $ unsafeLiftOpNull eq a b-infix 4 ==?----- | Test if two expressions are different. ------ This corresponds to the SQL @<>@ operator, though it will always return a--- 'Bool'.-(/=?) :: DBEq a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool-a /=? b = coalesce $ unsafeLiftOpNull ne a b-infix 4 /=?----- | Like the SQL @IN@ operator, but implemented by folding over a list with--- '==.' and '||.'.-in_ :: forall a f. (Sql DBEq a, Foldable f)-  => Expr a -> f (Expr a) -> Expr Bool-in_ a (toList -> as) = case nullable @a of-  Null -> or_ $ map (a ==.) as-  NotNull -> case nonEmpty as of-     Nothing -> false-     Just xs ->-       fromPrimExpr $-         Opaleye.BinExpr Opaleye.OpIn-           (toPrimExpr a)-           (Opaleye.ListExpr (toPrimExpr <$> xs))

@@ -1,93 +0,0 @@-{-# language FlexibleContexts #-}-{-# language FlexibleInstances #-}-{-# language MultiParamTypeClasses #-}-{-# language RecordWildCards #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}--module Rel8.Expr.Function-  ( Arguments-  , function-  , primFunction-  , rawFunction-  , binaryOperator-  , rawBinaryOperator-  )-where---- base-import Data.Kind ( Constraint, Type )-import Prelude---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import {-# SOURCE #-} Rel8.Expr (Expr)-import Rel8.Expr.Opaleye-  ( castExpr-  , fromPrimExpr, toPrimExpr, zipPrimExprsWith-  )-import Rel8.Schema.HTable (hfoldMap)-import Rel8.Schema.Null ( Sql )-import Rel8.Schema.QualifiedName-  ( QualifiedName (..)-  , showQualifiedName-  , showQualifiedOperator-  -  )-import Rel8.Table (Table, toColumns)-import Rel8.Type ( DBType )----- | This type class is basically @'Table' 'Expr'@, where each column of the--- 'Table' is an argument to the function, but it also has an additional--- instance for @()@ for calling functions with no arguments.-type Arguments :: Type -> Constraint-class Arguments a where-  arguments :: a -> [Opaleye.PrimExpr]---instance Table Expr a => Arguments a where-  arguments = hfoldMap (pure . toPrimExpr) . toColumns---instance {-# OVERLAPS #-} Arguments () where-  arguments _ = []----- | @'function' name arguments@ runs the PostgreSQL function @name@ with--- the arguments @arguments@ returning an @'Expr' a@.-function :: (Arguments arguments, Sql DBType a)-  => QualifiedName -> arguments -> Expr a-function qualified = castExpr . rawFunction qualified----- | A less safe version of 'function' that does not wrap the return value in--- a cast.-rawFunction :: Arguments arguments => QualifiedName -> arguments -> Expr a-rawFunction qualified = fromPrimExpr . primFunction qualified---primFunction :: Arguments arguments-  => QualifiedName -> arguments -> Opaleye.PrimExpr-primFunction qualified = Opaleye.FunExpr name . arguments-  where-    name = showQualifiedName qualified----- | Construct an expression by applying an infix binary operator to two--- operands.-binaryOperator :: Sql DBType c => QualifiedName -> Expr a -> Expr b -> Expr c-binaryOperator operator a b = castExpr $ rawBinaryOperator operator a b----- | A less safe version of 'binaryOperator' that does not wrap the return--- value in a cast.-rawBinaryOperator :: QualifiedName -> Expr a -> Expr b -> Expr c-rawBinaryOperator operator a b =-  zipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther name)) a b-  where-    name = showQualifiedOperator operator

@@ -1,52 +0,0 @@-{-# language FlexibleContexts #-}-{-# language MonoLocalBinds #-}--module Rel8.Expr.List (-  headExpr,-  indexExpr,-  lastExpr,-  sheadExpr,-  sindexExpr,-  slastExpr,-  lengthExpr,-) where---- base-import Data.Int (Int32)-import Prelude---- rel8-import Rel8.Expr (Expr)-import Rel8.Expr.Opaleye (mapPrimExpr, toPrimExpr)-import Rel8.Schema.Null (Nullify, Sql, Unnullify)-import Rel8.Type (DBType, typeInformation)-import Rel8.Type.Information (TypeInformation)-import qualified Rel8.Type.Array as Prim---headExpr :: Sql DBType a => Expr [a] -> Expr (Nullify a)-headExpr = sheadExpr typeInformation---indexExpr :: Sql DBType a => Expr Int32 -> Expr [a] -> Expr (Nullify a)-indexExpr = sindexExpr typeInformation---lastExpr :: Sql DBType a => Expr [a] -> Expr (Nullify a)-lastExpr = slastExpr typeInformation---sheadExpr :: TypeInformation (Unnullify a) -> Expr [a] -> Expr (Nullify a)-sheadExpr info = mapPrimExpr (Prim.head info)---sindexExpr :: TypeInformation (Unnullify a) -> Expr Int32 -> Expr [a] -> Expr (Nullify a)-sindexExpr info i = mapPrimExpr (Prim.index info (toPrimExpr i))---slastExpr :: TypeInformation (Unnullify a) -> Expr [a] -> Expr (Nullify a)-slastExpr info = mapPrimExpr (Prim.last info)---lengthExpr :: Expr [a] -> Expr Int32-lengthExpr = mapPrimExpr (Prim.length)

@@ -1,53 +0,0 @@-{-# language FlexibleContexts #-}-{-# language MonoLocalBinds #-}--module Rel8.Expr.NonEmpty (-  head1Expr,-  index1Expr,-  last1Expr,-  shead1Expr,-  sindex1Expr,-  slast1Expr,-  length1Expr,-) where---- base-import Data.Int (Int32)-import Data.List.NonEmpty (NonEmpty)-import Prelude---- rel8-import Rel8.Expr (Expr)-import Rel8.Expr.Opaleye (mapPrimExpr, toPrimExpr)-import Rel8.Schema.Null (Nullify, Sql, Unnullify)-import Rel8.Type (DBType, typeInformation)-import Rel8.Type.Information (TypeInformation)-import qualified Rel8.Type.Array as Prim---head1Expr :: Sql DBType a => Expr (NonEmpty a) -> Expr a-head1Expr = shead1Expr typeInformation---index1Expr :: Sql DBType a => Expr Int32 -> Expr (NonEmpty a) -> Expr (Nullify a)-index1Expr = sindex1Expr typeInformation---last1Expr :: Sql DBType a => Expr (NonEmpty a) -> Expr a-last1Expr = slast1Expr typeInformation---shead1Expr :: TypeInformation (Unnullify a) -> Expr (NonEmpty a) -> Expr a-shead1Expr info = mapPrimExpr (Prim.head info)---sindex1Expr :: TypeInformation (Unnullify a) -> Expr Int32 -> Expr (NonEmpty a) -> Expr (Nullify a)-sindex1Expr info i = mapPrimExpr (Prim.index info (toPrimExpr i))---slast1Expr :: TypeInformation (Unnullify a) -> Expr (NonEmpty a) -> Expr a-slast1Expr info = mapPrimExpr (Prim.last info)---length1Expr :: Expr (NonEmpty a) -> Expr Int32-length1Expr = mapPrimExpr (Prim.length)

@@ -1,106 +0,0 @@-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language TypeFamilies #-}--{-# options -fno-warn-redundant-constraints #-}--module Rel8.Expr.Null-  ( null, snull, nullableExpr, nullableOf-  , isNull, isNonNull-  , nullify, unsafeUnnullify-  , mapNull, liftOpNull-  , unsafeMapNull, unsafeLiftOpNull-  )-where---- base-import Prelude hiding ( null )---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )-import Rel8.Expr.Bool ( (||.), boolExpr )-import Rel8.Expr.Opaleye ( scastExpr, mapPrimExpr )-import Rel8.Schema.Null ( NotNull )-import Rel8.Type ( DBType, typeInformation )-import Rel8.Type.Information ( TypeInformation )----- | Lift an expression that can't be @null@ to a type that might be @null@.--- This is an identity operation in terms of any generated query, and just--- modifies the query's type.-nullify :: NotNull a => Expr a -> Expr (Maybe a)-nullify (Expr a) = Expr a----- | Assume that a nullable column's value is non-null. If the column is--- actually @null@, this will lead to runtime errors when you try to decode--- the value into Haskell, so you should prefer to use 'Rel8.nullable'--- unless you know what you're doing.-unsafeUnnullify :: Expr (Maybe a) -> Expr a-unsafeUnnullify (Expr a) = Expr a----- | Like 'maybe', but to eliminate @null@.-nullableExpr :: Expr b -> (Expr a -> Expr b) -> Expr (Maybe a) -> Expr b-nullableExpr b f ma = boolExpr (f (unsafeUnnullify ma)) b (isNull ma)---nullableOf :: DBType a => Maybe (Expr a) -> Expr (Maybe a)-nullableOf = maybe null nullify----- | Like 'Data.Maybe.isNothing', but for @null@.-isNull :: Expr (Maybe a) -> Expr Bool-isNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNull)----- | Like 'Data.Maybe.isJust', but for @null@.-isNonNull :: Expr (Maybe a) -> Expr Bool-isNonNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNotNull)----- | Lift an operation on non-@null@ values to an operation on possibly @null@--- values. When given @null@, @mapNull f@ returns @null@.--- --- This is like 'fmap' for 'Maybe'.-mapNull :: DBType b-  => (Expr a -> Expr b) -> Expr (Maybe a) -> Expr (Maybe b)-mapNull f ma = boolExpr (unsafeMapNull f ma) null (isNull ma)----- | Lift a binary operation on non-@null@ expressions to an equivalent binary--- operator on possibly @null@ expressions. If either of the final arguments--- are @null@, @liftOpNull@ returns @null@.------ This is like 'liftA2' for 'Maybe'.-liftOpNull :: DBType c-  => (Expr a -> Expr b -> Expr c)-  -> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)-liftOpNull f ma mb =-  boolExpr (unsafeLiftOpNull f ma mb) null-    (isNull ma ||. isNull mb)-{-# INLINABLE liftOpNull #-}---snull :: TypeInformation a -> Expr (Maybe a)-snull info = scastExpr info $ Expr $ Opaleye.ConstExpr Opaleye.NullLit----- | Corresponds to SQL @null@.-null :: DBType a => Expr (Maybe a)-null = snull typeInformation---unsafeMapNull :: NotNull b-  => (Expr a -> Expr b) -> Expr (Maybe a) -> Expr (Maybe b)-unsafeMapNull f ma = nullify (f (unsafeUnnullify ma))---unsafeLiftOpNull :: NotNull c-  => (Expr a -> Expr b -> Expr c)-  -> Expr (Maybe a) -> Expr (Maybe b) -> Expr (Maybe c)-unsafeLiftOpNull f ma mb =-  nullify (f (unsafeUnnullify ma) (unsafeUnnullify mb))

@@ -17,13 +17,13 @@ import Prelude ( (+), (-), fst, negate, signum, snd )  -- rel-import Rel8.Expr ( Expr( Expr ) )-import Rel8.Expr.Eq ( (==.) )-import Rel8.Expr.Function (function)-import Rel8.Expr.Opaleye ( castExpr )-import Rel8.Schema.Null ( Homonullable, Sql )-import Rel8.Table.Bool ( bool )-import Rel8.Type.Num ( DBFractional, DBIntegral, DBNum )+import Rel8.Internal.Expr ( Expr( Expr ) )+import Rel8.Internal.Expr.Eq ( (==.) )+import Rel8.Internal.Expr.Function (function)+import Rel8.Internal.Expr.Opaleye ( castExpr )+import Rel8.Internal.Schema.Null ( Homonullable, Sql )+import Rel8.Internal.Table.Bool ( bool )+import Rel8.Internal.Type.Num ( DBFractional, DBIntegral, DBNum )   -- | Cast 'DBIntegral' types to 'DBNum' types. For example, this can be useful

@@ -1,118 +0,0 @@-{-# language FlexibleContexts #-}-{-# language NamedFieldPuns #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}--{-# options_ghc -fno-warn-redundant-constraints #-}--module Rel8.Expr.Opaleye-  ( castExpr, unsafeCastExpr-  , scastExpr, sunsafeCastExpr-  , unsafeCoerceExpr-  , unsafePrimExpr-  , unsafeLiteral-  , fromPrimExpr, toPrimExpr, mapPrimExpr, zipPrimExprsWith, traversePrimExpr-  , toColumn, fromColumn, traverseFieldP-  )-where---- base-import Prelude---- opaleye-import qualified Opaleye.Internal.Column as Opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )-import Rel8.Schema.Null ( Unnullify, Sql )-import Rel8.Type ( DBType, typeInformation )-import Rel8.Type.Information ( TypeInformation(..) )-import Rel8.Type.Name (TypeName, showTypeName)---- profunctors-import Data.Profunctor ( Profunctor, dimap )---castExpr :: Sql DBType a => Expr a -> Expr a-castExpr = scastExpr typeInformation----- | Cast an expression to a different type. Corresponds to a @CAST()@ function--- call.-unsafeCastExpr :: forall b a. Sql DBType b => Expr a -> Expr b-unsafeCastExpr = case typeInformation @(Unnullify b) of-  TypeInformation {typeName} -> sunsafeCastExpr typeName----- | Change the type of an 'Expr', without a cast. Even more unsafe than--- 'unsafeCastExpr'. Only use this if you are certain that the @typeName@s of--- @a@ and @b@ refer to exactly the same PostgreSQL type.-unsafeCoerceExpr :: Expr a -> Expr b-unsafeCoerceExpr (Expr a) = Expr a----- | Import a raw 'Opaleye.PrimExpr' from @opaleye@, without a cast.------ This is an escape hatch, and can be used if Rel8 cannot adequately express--- the expression you need. If you find yourself using this function, please--- let us know, as it may indicate that something is missing from Rel8!-unsafePrimExpr :: Opaleye.PrimExpr -> Expr a-unsafePrimExpr = fromPrimExpr---scastExpr :: TypeInformation (Unnullify a) -> Expr a -> Expr a-scastExpr TypeInformation {typeName} = sunsafeCastExpr typeName---sunsafeCastExpr :: ()-  => TypeName -> Expr a -> Expr b-sunsafeCastExpr name =-  fromPrimExpr . Opaleye.CastExpr (showTypeName name) . toPrimExpr----- | Unsafely construct an expression from literal SQL.------ This is an escape hatch, and can be used if Rel8 cannot adequately express--- the expression you need. If you find yourself using this function, please let--- us know, as it may indicate that something is missing from Rel8!-unsafeLiteral :: String -> Expr a-unsafeLiteral = Expr . Opaleye.ConstExpr . Opaleye.OtherLit---fromPrimExpr :: Opaleye.PrimExpr -> Expr a-fromPrimExpr = Expr---toPrimExpr :: Expr a -> Opaleye.PrimExpr-toPrimExpr (Expr a) = a---mapPrimExpr :: (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Expr a -> Expr b-mapPrimExpr f = fromPrimExpr . f . toPrimExpr---zipPrimExprsWith :: ()-  => (Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr)-  -> Expr a -> Expr b -> Expr c-zipPrimExprsWith f a b = fromPrimExpr (f (toPrimExpr a) (toPrimExpr b))---traversePrimExpr :: Functor f-  => (Opaleye.PrimExpr -> f Opaleye.PrimExpr) -> Expr a -> f (Expr b)-traversePrimExpr f = fmap fromPrimExpr . f . toPrimExpr---traverseFieldP :: Profunctor p-  => p (Opaleye.Field_ n x) (Opaleye.Field_ m y)-  -> p (Expr a) (Expr b)-traverseFieldP =  dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn)---toColumn :: Opaleye.PrimExpr -> Opaleye.Field_ n b-toColumn = Opaleye.Column---fromColumn :: Opaleye.Field_ n b -> Opaleye.PrimExpr-fromColumn (Opaleye.Column a) = a

@@ -1,137 +0,0 @@-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language GADTs #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}--{-# options_ghc -fno-warn-redundant-constraints #-}--module Rel8.Expr.Ord-  ( (<.), (<=.), (>.), (>=.)-  , (<?), (<=?), (>?), (>=?)-  , leastExpr, greatestExpr-  )-where---- base-import Prelude---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Expr ( Expr( Expr ) )-import Rel8.Expr.Bool ( (&&.), (||.), coalesce )-import Rel8.Expr.Null ( isNull, isNonNull, nullableExpr, unsafeLiftOpNull )-import Rel8.Expr.Opaleye ( toPrimExpr, zipPrimExprsWith )-import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )-import Rel8.Type.Ord ( DBOrd )---lt :: DBOrd a => Expr a -> Expr a -> Expr Bool-lt = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<))---le :: DBOrd a => Expr a -> Expr a -> Expr Bool-le = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<=))---gt :: DBOrd a => Expr a -> Expr a -> Expr Bool-gt = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>))---ge :: DBOrd a => Expr a -> Expr a -> Expr Bool-ge = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>=))----- | Corresponds to the SQL @<@ operator. Note that this differs from SQL @<@--- as @null@ will sort below any other value. For a version of @<@ that exactly--- matches SQL, see '(<?)'.-(<.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool-(<.) = case nullable @a of-  Null -> \ma mb -> isNull ma &&. isNonNull mb ||. ma <? mb-  NotNull -> lt-infix 4 <.----- | Corresponds to the SQL @<=@ operator. Note that this differs from SQL @<=@--- as @null@ will sort below any other value. For a version of @<=@ that exactly--- matches SQL, see '(<=?)'.-(<=.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool-(<=.) = case nullable @a of-  Null -> \ma mb -> isNull ma ||. ma <=? mb-  NotNull -> le-infix 4 <=.----- | Corresponds to the SQL @>@ operator. Note that this differs from SQL @>@--- as @null@ will sort below any other value. For a version of @>@ that exactly--- matches SQL, see '(>?)'.-(>.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool-(>.) = case nullable @a of-  Null -> \ma mb -> isNonNull ma &&. isNull mb ||. ma >? mb-  NotNull -> gt-infix 4 >.----- | Corresponds to the SQL @>=@ operator. Note that this differs from SQL @>@--- as @null@ will sort below any other value. For a version of @>=@ that--- exactly matches SQL, see '(>=?)'.-(>=.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool-(>=.) = case nullable @a of-  Null -> \ma mb -> isNull mb ||. ma >=? mb-  NotNull -> ge-infix 4 >=.----- | Corresponds to the SQL @<@ operator. Returns @null@ if either arguments--- are @null@.-(<?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool-a <? b = coalesce $ unsafeLiftOpNull lt a b-infix 4 <?----- | Corresponds to the SQL @<=@ operator. Returns @null@ if either arguments--- are @null@.-(<=?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool-a <=? b = coalesce $ unsafeLiftOpNull le a b-infix 4 <=?----- | Corresponds to the SQL @>@ operator. Returns @null@ if either arguments--- are @null@.-(>?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool-a >? b = coalesce $ unsafeLiftOpNull gt a b-infix 4 >?----- | Corresponds to the SQL @>=@ operator. Returns @null@ if either arguments--- are @null@.-(>=?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool-a >=? b = coalesce $ unsafeLiftOpNull ge a b-infix 4 >=?----- | Given two expressions, return the expression that sorts less than the--- other.--- --- Corresponds to the SQL @least()@ function.-leastExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a-leastExpr ma mb = case nullable @a of-  Null -> nullableExpr ma (\a -> nullableExpr mb (least_ a) mb) ma-  NotNull -> least_ ma mb-  where-    least_ a b = Expr (Opaleye.FunExpr "LEAST" [toPrimExpr a, toPrimExpr b])----- | Given two expressions, return the expression that sorts greater than the--- other.--- --- Corresponds to the SQL @greatest()@ function.-greatestExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a-greatestExpr ma mb = case nullable @a of-  Null -> nullableExpr mb (\a -> nullableExpr ma (greatest_ a) mb) ma-  NotNull -> greatest_ ma mb-  where-    greatest_ a b =-      Expr (Opaleye.FunExpr "GREATEST" [toPrimExpr a, toPrimExpr b])

@@ -1,69 +0,0 @@-{-# language DataKinds #-}--{-# options_ghc -fno-warn-redundant-constraints #-}--module Rel8.Expr.Order-  ( asc-  , desc-  , nullsFirst-  , nullsLast-  )-where---- base-import Data.Bifunctor ( first )-import Prelude---- opaleye-import Opaleye.Internal.HaskellDB.PrimQuery ( OrderOp( orderDirection, orderNulls ) )-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye-import qualified Opaleye.Internal.Order as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Null ( unsafeUnnullify )-import Rel8.Expr.Opaleye ( toPrimExpr )-import Rel8.Order ( Order( Order ) )-import Rel8.Type.Ord ( DBOrd )----- | Sort a column in ascending order.-asc :: DBOrd a => Order (Expr a)-asc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])-  where-    orderOp :: Opaleye.OrderOp-    orderOp = Opaleye.OrderOp-      { orderDirection = Opaleye.OpAsc-      , orderNulls = Opaleye.NullsLast-      }----- | Sort a column in descending order.-desc :: DBOrd a => Order (Expr a)-desc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])-  where-    orderOp :: Opaleye.OrderOp-    orderOp = Opaleye.OrderOp-      { orderDirection = Opaleye.OpDesc-      , orderNulls = Opaleye.NullsFirst-      }----- | Transform an ordering so that @null@ values appear first. This corresponds--- to @NULLS FIRST@ in SQL.-nullsFirst :: Order (Expr a) -> Order (Expr (Maybe a))-nullsFirst (Order (Opaleye.Order f)) =-  Order $ Opaleye.Order $ fmap (first g) . f . unsafeUnnullify-  where-    g :: Opaleye.OrderOp -> Opaleye.OrderOp-    g orderOp = orderOp { Opaleye.orderNulls = Opaleye.NullsFirst }----- | Transform an ordering so that @null@ values appear last. This corresponds--- to @NULLS LAST@ in SQL.-nullsLast :: Order (Expr a) -> Order (Expr (Maybe a))-nullsLast (Order (Opaleye.Order f)) =-  Order $ Opaleye.Order $ fmap (first g) . f . unsafeUnnullify-  where-    g :: Opaleye.OrderOp -> Opaleye.OrderOp-    g orderOp = orderOp { Opaleye.orderNulls = Opaleye.NullsLast }

@@ -1,29 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MonoLocalBinds #-}--module Rel8.Expr.Read-  ( read-  , sread-  )-where---- base-import Prelude ()---- rel8-import Rel8.Expr (Expr)-import Rel8.Expr.Opaleye (unsafeCastExpr, sunsafeCastExpr)-import Rel8.Schema.Null (Sql)-import Rel8.Type (DBType)-import Rel8.Type.Name (TypeName)---- text-import Data.Text (Text)---read :: Sql DBType a => Expr Text -> Expr a-read = unsafeCastExpr---sread :: TypeName -> Expr Text -> Expr a-sread = sunsafeCastExpr

@@ -1,25 +0,0 @@-module Rel8.Expr.Sequence-  ( nextval-  )-where---- base-import Data.Int ( Int64 )-import Prelude---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Opaleye (fromPrimExpr)-import Rel8.Schema.QualifiedName (QualifiedName, showQualifiedName)----- | See https://www.postgresql.org/docs/current/functions-sequence.html-nextval :: QualifiedName -> Expr Int64-nextval name =-  fromPrimExpr $-    Opaleye.FunExpr "nextval"-      [ Opaleye.ConstExpr (Opaleye.StringLit (showQualifiedName name))-      ]

@@ -1,52 +0,0 @@-{-# language DisambiguateRecordFields #-}-{-# language FlexibleContexts #-}-{-# language NamedFieldPuns #-}-{-# language TypeFamilies #-}--module Rel8.Expr.Serialize-  ( litExpr-  , slitExpr-  , sparseValue-  )-where---- base-import Prelude---- hasql-import qualified Hasql.Decoders as Hasql---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )-import Rel8.Expr.Opaleye ( scastExpr )-import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ), Sql, nullable )-import Rel8.Type ( DBType, typeInformation )-import Rel8.Type.Decoder (Decoder (..))-import Rel8.Type.Encoder (Encoder (..))-import Rel8.Type.Information ( TypeInformation(..) )----- | Produce an expression from a literal.------ Note that you can usually use 'Rel8.lit', but @litExpr@ can solve problems--- of inference in polymorphic code.-litExpr :: Sql DBType a => a -> Expr a-litExpr = slitExpr nullable typeInformation---slitExpr :: Nullity a -> TypeInformation (Unnullify a) -> a -> Expr a-slitExpr nullity info@TypeInformation {encode = Encoder {quote}} =-  scastExpr info . Expr . encoder-  where-    encoder = case nullity of-      Null -> maybe (Opaleye.ConstExpr Opaleye.NullLit) quote-      NotNull -> quote---sparseValue :: Nullity a -> TypeInformation (Unnullify a) -> Hasql.Row a-sparseValue nullity TypeInformation {decode = Decoder {binary}} = case nullity of-  Null -> Hasql.column $ Hasql.nullable binary-  NotNull -> Hasql.column $ Hasql.nonNullable binary

@@ -1,18 +0,0 @@-module Rel8.Expr.Show-  ( show-  )-where---- base-import Prelude ()---- rel8-import Rel8.Expr (Expr)-import Rel8.Expr.Opaleye (unsafeCastExpr)---- text-import Data.Text (Text)---show :: Expr a -> Expr Text-show = unsafeCastExpr

@@ -1,65 +0,0 @@-{-# language FlexibleContexts #-}-{-# language MonoLocalBinds #-}--module Rel8.Expr.Subscript-  ( unsafeSubscript-  , unsafeSubscripts-  )-where---- base-import Data.Foldable (foldl')-import Prelude---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Expr (Expr)-import Rel8.Expr.Opaleye (fromPrimExpr, toPrimExpr)-import Rel8.Schema.HTable (hfoldMap)-import Rel8.Schema.Null (Sql, Unnullify)-import Rel8.Table (Table, toColumns)-import Rel8.Type (DBType, typeInformation)-import Rel8.Type.Array (extractArrayElement)-import Rel8.Type.Information (TypeInformation)----- | @'unsafeSubscript' a i@ will generate the SQL @a[i]@.------ Note that this function is not type checked and the generated SQL has no--- casts. This is only intended an escape hatch to be used if Rel8 cannot--- otherwise express the expression you need. If you find yourself using this--- function, please let us know, as it may indicate that something is missing--- from Rel8!-unsafeSubscript :: Sql DBType b => Expr a -> Expr i -> Expr b-unsafeSubscript = sunsafeSubscript typeInformation----- | @'unsafeSubscripts' a (i, j)@ will generate the SQL @a[i][j]@.------ Note that this function is not type checked and the generated SQL has no--- casts. This is only intended an escape hatch to be used if Rel8 cannot--- otherwise express the expression you need. If you find yourself using this--- function, please let us know, as it may indicate that something is missing--- from Rel8!-unsafeSubscripts :: (Table Expr i, Sql DBType b) => Expr a -> i -> Expr b-unsafeSubscripts = sunsafeSubscripts typeInformation---sunsafeSubscript :: TypeInformation (Unnullify b) -> Expr a -> Expr i -> Expr b-sunsafeSubscript info array i =-  fromPrimExpr . extractArrayElement info $-    Opaleye.ArrayIndex (toPrimExpr array) (toPrimExpr i)---sunsafeSubscripts :: Table Expr i => TypeInformation (Unnullify b) -> Expr a -> i -> Expr b-sunsafeSubscripts info array i =-  fromPrimExpr $ extractArrayElement info $ primSubscripts array indices-  where-    indices = hfoldMap (pure . toPrimExpr) $ toColumns i---primSubscripts :: Expr a -> [Opaleye.PrimExpr] -> Opaleye.PrimExpr-primSubscripts array indices =-  foldl' Opaleye.ArrayIndex (toPrimExpr array) indices

@@ -1,6 +1,3 @@-{-# language DataKinds #-}-{-# language OverloadedStrings #-}- module Rel8.Expr.Text   (     -- * String concatenation@@ -25,277 +22,7 @@ where  -- base-import Data.Bool ( Bool )-import Data.Int ( Int32 )-import Data.Maybe ( Maybe( Nothing, Just ) )-import Prelude ( flip )---- bytestring-import Data.ByteString ( ByteString )---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye+import Prelude hiding (length, repeat, reverse)  -- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Function (binaryOperator, function)-import Rel8.Expr.Opaleye (zipPrimExprsWith)---- text-import Data.Text (Text)----- | The PostgreSQL string concatenation operator.-(++.) :: Expr Text -> Expr Text -> Expr Text-(++.) = binaryOperator "||"-infixr 6 ++.----- * Regular expression operators---- See https://www.postgresql.org/docs/9.5/static/functions-matching.html#FUNCTIONS-POSIX-REGEXP----- | Matches regular expression, case sensitive------ Corresponds to the @~@ operator.-(~.) :: Expr Text -> Expr Text -> Expr Bool-(~.) = binaryOperator "~"-infix 2 ~.----- | Matches regular expression, case insensitive------ Corresponds to the @~*@ operator.-(~*) :: Expr Text -> Expr Text -> Expr Bool-(~*) = binaryOperator "~*"-infix 2 ~*----- | Does not match regular expression, case sensitive------ Corresponds to the @!~@ operator.-(!~) :: Expr Text -> Expr Text -> Expr Bool-(!~) = binaryOperator "!~"-infix 2 !~----- | Does not match regular expression, case insensitive------ Corresponds to the @!~*@ operator.-(!~*) :: Expr Text -> Expr Text -> Expr Bool-(!~*) = binaryOperator "!~*"-infix 2 !~*----- See https://www.postgresql.org/docs/9.5/static/functions-Expr.'PGHtml---- * Standard SQL functions----- | Corresponds to the @bit_length@ function.-bitLength :: Expr Text -> Expr Int32-bitLength = function "bit_length"----- | Corresponds to the @char_length@ function.-charLength :: Expr Text -> Expr Int32-charLength = function "char_length"----- | Corresponds to the @lower@ function.-lower :: Expr Text -> Expr Text-lower = function "lower"----- | Corresponds to the @octet_length@ function.-octetLength :: Expr Text -> Expr Int32-octetLength = function "octet_length"----- | Corresponds to the @upper@ function.-upper :: Expr Text -> Expr Text-upper = function "upper"----- | Corresponds to the @ascii@ function.-ascii :: Expr Text -> Expr Int32-ascii = function "ascii"----- | Corresponds to the @btrim@ function.-btrim :: Expr Text -> Maybe (Expr Text) -> Expr Text-btrim a (Just b) = function "btrim" (a, b)-btrim a Nothing = function "btrim" a----- | Corresponds to the @chr@ function.-chr :: Expr Int32 -> Expr Text-chr = function "chr"----- | Corresponds to the @convert@ function.-convert :: Expr ByteString -> Expr Text -> Expr Text -> Expr ByteString-convert a b c = function "convert" (a, b, c)----- | Corresponds to the @convert_from@ function.-convertFrom :: Expr ByteString -> Expr Text -> Expr Text-convertFrom a b = function "convert_from" (a, b)----- | Corresponds to the @convert_to@ function.-convertTo :: Expr Text -> Expr Text -> Expr ByteString-convertTo a b = function "convert_to" (a, b)----- | Corresponds to the @decode@ function.-decode :: Expr Text -> Expr Text -> Expr ByteString-decode a b = function "decode" (a, b)----- | Corresponds to the @encode@ function.-encode :: Expr ByteString -> Expr Text -> Expr Text-encode a b = function "encode" (a, b)----- | Corresponds to the @initcap@ function.-initcap :: Expr Text -> Expr Text-initcap = function "initcap"----- | Corresponds to the @left@ function.-left :: Expr Text -> Expr Int32 -> Expr Text-left a b = function "left" (a, b)----- | Corresponds to the @length@ function.-length :: Expr Text -> Expr Int32-length = function "length"----- | Corresponds to the @length@ function.-lengthEncoding :: Expr ByteString -> Expr Text -> Expr Int32-lengthEncoding a b = function "length" (a, b)----- | Corresponds to the @lpad@ function.-lpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text-lpad a b (Just c) = function "lpad" (a, b, c)-lpad a b Nothing = function "lpad" (a, b)----- | Corresponds to the @ltrim@ function.-ltrim :: Expr Text -> Maybe (Expr Text) -> Expr Text-ltrim a (Just b) = function "ltrim" (a, b)-ltrim a Nothing = function "ltrim" a----- | Corresponds to the @md5@ function.-md5 :: Expr Text -> Expr Text-md5 = function "md5"----- | Corresponds to the @pg_client_encoding()@ expression.-pgClientEncoding :: Expr Text-pgClientEncoding = function "pg_client_encoding" ()----- | Corresponds to the @quote_ident@ function.-quoteIdent :: Expr Text -> Expr Text-quoteIdent = function "quote_ident"----- | Corresponds to the @quote_literal@ function.-quoteLiteral :: Expr Text -> Expr Text-quoteLiteral = function "quote_literal"----- | Corresponds to the @quote_nullable@ function.-quoteNullable :: Expr Text -> Expr Text-quoteNullable = function "quote_nullable"----- | Corresponds to the @regexp_replace@ function.-regexpReplace :: ()-  => Expr Text -> Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr Text-regexpReplace a b c (Just d) = function "regexp_replace" (a, b, c, d)-regexpReplace a b c Nothing = function "regexp_replace" (a, b, c)----- | Corresponds to the @regexp_split_to_array@ function.-regexpSplitToArray :: ()-  => Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr [Text]-regexpSplitToArray a b (Just c) = function "regexp_split_to_array" (a, b, c)-regexpSplitToArray a b Nothing = function "regexp_split_to_array" (a, b)----- | Corresponds to the @repeat@ function.-repeat :: Expr Text -> Expr Int32 -> Expr Text-repeat a b = function "repeat" (a, b)----- | Corresponds to the @replace@ function.-replace :: Expr Text -> Expr Text -> Expr Text -> Expr Text-replace a b c = function "replace" (a, b, c)----- | Corresponds to the @reverse@ function.-reverse :: Expr Text -> Expr Text-reverse = function "reverse"----- | Corresponds to the @right@ function.-right :: Expr Text -> Expr Int32 -> Expr Text-right a b = function "right" (a, b)----- | Corresponds to the @rpad@ function.-rpad :: Expr Text -> Expr Int32 -> Maybe (Expr Text) -> Expr Text-rpad a b (Just c) = function "rpad" (a, b, c)-rpad a b Nothing = function "rpad" (a, b)----- | Corresponds to the @rtrim@ function.-rtrim :: Expr Text -> Maybe (Expr Text) -> Expr Text-rtrim a (Just b) = function "rtrim" (a, b)-rtrim a Nothing = function "rtrim" a----- | Corresponds to the @split_part@ function.-splitPart :: Expr Text -> Expr Text -> Expr Int32 -> Expr Text-splitPart a b c = function "split_part" (a, b, c)----- | Corresponds to the @strpos@ function.-strpos :: Expr Text -> Expr Text -> Expr Int32-strpos a b = function "strpos" (a, b)----- | Corresponds to the @substr@ function.-substr :: Expr Text -> Expr Int32 -> Maybe (Expr Int32) -> Expr Text-substr a b (Just c) = function "substr" (a, b, c)-substr a b Nothing = function "substr" (a, b)----- | Corresponds to the @translate@ function.-translate :: Expr Text -> Expr Text -> Expr Text -> Expr Text-translate a b c = function "translate" (a, b, c)----- | @like x y@ corresponds to the expression @y LIKE x@.------ Note that the arguments to @like@ are swapped. This is to aid currying, so--- you can write expressions like--- @filter (like "Rel%" . packageName) =<< each haskellPackages@-like :: Expr Text -> Expr Text -> Expr Bool-like = flip (zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpLike))----- | @ilike x y@ corresponds to the expression @y ILIKE x@.------ Note that the arguments to @ilike@ are swapped. This is to aid currying, so--- you can write expressions like--- @filter (ilike "Rel%" . packageName) =<< each haskellPackages@-ilike :: Expr Text -> Expr Text -> Expr Bool-ilike = flip (zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpILike))+import Rel8.Internal.Expr.Text 

@@ -31,9 +31,9 @@ import Prelude  -- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Function (binaryOperator, function)-import Rel8.Expr.Opaleye ( castExpr, unsafeCastExpr, unsafeLiteral )+import Rel8.Internal.Expr ( Expr )+import Rel8.Internal.Expr.Function (binaryOperator, function)+import Rel8.Internal.Expr.Opaleye ( castExpr, unsafeCastExpr, unsafeLiteral )  -- time import Data.Time.Calendar ( Day )

@@ -1,149 +0,0 @@-module Rel8.Expr.Window-  ( cumulative-  , rowNumber-  , rank-  , denseRank-  , percentRank-  , cumeDist-  , ntile-  , lagExpr, lagExprOn-  , leadExpr, leadExprOn-  , firstValueExpr, firstValueExprOn-  , lastValueExpr, lastValueExprOn-  , nthValueExpr, nthValueExprOn-  )-where---- base-import Data.Int ( Int32, Int64 )-import Prelude---- opaleye-import qualified Opaleye.Internal.Aggregate as Opaleye-import qualified Opaleye.Internal.PackMap as Opaleye-import qualified Opaleye.Internal.Window as Opaleye-import qualified Opaleye.Window as Opaleye---- profunctors-import Data.Profunctor (dimap, lmap)---- rel8-import Rel8.Aggregate (Aggregator' (Aggregator))-import Rel8.Expr ( Expr )-import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr, toColumn, toPrimExpr )-import Rel8.Schema.Null ( Nullify )-import Rel8.Window ( Window( Window ) )----- | 'cumulative' allows the use of aggregation functions in 'Window'--- expressions. In particular, @'cumulative' 'Rel8.sum'@--- (when combined with 'Rel8.Window.orderPartitionBy') gives a running total,--- also known as a \"cumulative sum\", hence the name @cumulative@.-cumulative :: Aggregator' fold i a -> Window i a-cumulative f =-  fromWindowFunction $ Opaleye.aggregatorWindowFunction (fromAggregate f) id----- | [@row_number()@](https://www.postgresql.org/docs/current/functions-window.html)-rowNumber :: Window i (Expr Int64)-rowNumber = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.rowNumber----- | [@rank()@](https://www.postgresql.org/docs/current/functions-window.html)-rank :: Window i (Expr Int64)-rank = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.rank----- | [@dense_rank()@](https://www.postgresql.org/docs/current/functions-window.html)-denseRank :: Window i (Expr Int64)-denseRank = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.denseRank----- | [@percent_rank()@](https://www.postgresql.org/docs/current/functions-window.html)-percentRank :: Window i (Expr Double)-percentRank = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.percentRank----- | [@cume_dist()@](https://www.postgresql.org/docs/current/functions-window.html)-cumeDist :: Window i (Expr Double)-cumeDist = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.cumeDist----- | [@ntile(num_buckets)@](https://www.postgresql.org/docs/current/functions-window.html)-ntile :: Expr Int32 -> Window i (Expr Int32)-ntile buckets = fromWindowFunction $ fromPrimExpr . fromColumn <$>-  Opaleye.ntile (toColumn (toPrimExpr buckets))----- | [@lag(value, offset, default)@](https://www.postgresql.org/docs/current/functions-window.html)-lagExpr :: Expr Int32 -> Expr a -> Window (Expr a) (Expr a)-lagExpr offset def =-  fromWindowFunction $-    dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn) $-      Opaleye.lag (toColumn (toPrimExpr offset)) (toColumn (toPrimExpr def))----- | Applies 'lag' to the column selected by the given function.-lagExprOn :: Expr Int32 -> Expr a -> (i -> Expr a) -> Window i (Expr a)-lagExprOn offset def f = lmap f (lagExpr offset def)----- | [@lead(value, offset, default)@](https://www.postgresql.org/docs/current/functions-window.html)-leadExpr :: Expr Int32 -> Expr a -> Window (Expr a) (Expr a)-leadExpr offset def =-  fromWindowFunction $-    dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn) $-      Opaleye.lead (toColumn (toPrimExpr offset)) (toColumn (toPrimExpr def))----- | Applies 'lead' to the column selected by the given function.-leadExprOn :: Expr Int32 -> Expr a -> (i -> Expr a) -> Window i (Expr a)-leadExprOn offset def f = lmap f (leadExpr offset def)----- | [@first_value(value)@](https://www.postgresql.org/docs/current/functions-window.html)-firstValueExpr :: Window (Expr a) (Expr a)-firstValueExpr =-  fromWindowFunction $-    dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn)-      Opaleye.firstValue----- | Applies 'firstValue' to the column selected by the given function.-firstValueExprOn :: (i -> Expr a) -> Window i (Expr a)-firstValueExprOn f = lmap f firstValueExpr----- | [@last_value(value)@](https://www.postgresql.org/docs/current/functions-window.html)-lastValueExpr :: Window (Expr a) (Expr a)-lastValueExpr =-  fromWindowFunction $-    dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn)-      Opaleye.lastValue----- | Applies 'lastValue' to the column selected by the given function.-lastValueExprOn :: (i -> Expr a) -> Window i (Expr a)-lastValueExprOn f = lmap f lastValueExpr----- | [@nth_value(value, n)@](https://www.postgresql.org/docs/current/functions-window.html)-nthValueExpr :: Expr Int32 -> Window (Expr a) (Expr (Nullify a))-nthValueExpr n =-  fromWindowFunction $-    dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn) $-      Opaleye.nthValue (toColumn (toPrimExpr n))----- | [@nth_value(value, n)@](https://www.postgresql.org/docs/current/functions-window.html)-nthValueExprOn :: Expr Int32 -> (i -> Expr a) -> Window i (Expr (Nullify a))-nthValueExprOn n f = lmap f (nthValueExpr n)---fromAggregate :: Aggregator' fold i a -> Opaleye.Aggregator i a-fromAggregate (Aggregator _ a) = a---fromWindowFunction :: Opaleye.WindowFunction i a -> Window i a-fromWindowFunction (Opaleye.WindowFunction (Opaleye.PackMap w)) =-  Window $ Opaleye.Windows $ Opaleye.PackMap $ \f -> w $ \o -> f (o, mempty)

@@ -1,26 +0,0 @@-{-# language DataKinds #-}-{-# language PolyKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilies #-}--module Rel8.FCF-  ( Exp, Eval-  , Id-  )-where---- base-import Data.Kind ( Type )-import Prelude ()---type Exp :: Type -> Type-type Exp e = e -> Type---type Eval :: Exp e -> e-type family Eval a---data Id :: a -> Exp a-type instance Eval (Id a) = a

@@ -1,316 +0,0 @@-{-# language AllowAmbiguousTypes #-}-{-# language ConstraintKinds #-}-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language NamedFieldPuns #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}-{-# language ViewPatterns #-}--module Rel8.Generic.Construction-  ( GGBuildable-  , GGBuild, ggbuild-  , GGConstructable-  , GGConstruct, ggconstruct-  , GGDeconstruct, ggdeconstruct, ggdeconstructA-  , GGName, ggname-  )-where---- base-import Data.Bifunctor ( first )-import Data.Functor ((<&>))-import Data.Kind ( Constraint, Type )-import Data.List.NonEmpty ( NonEmpty( (:|) ) )-import GHC.TypeLits ( Symbol )-import Prelude---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Eq ( (==.) )-import Rel8.Expr.Null ( nullify, snull, unsafeUnnullify )-import Rel8.Expr.Serialize ( litExpr )-import Rel8.FCF ( Eval, Exp, Id )-import Rel8.Generic.Construction.ADT-  ( GConstructorADT, GMakeableADT, gmakeADT-  , GConstructableADT-  , GBuildADT, gbuildADT-  , GConstructADT, gconstructADT, gdeconstructADT-  , RepresentableConstructors, GConstructors, gcindex, gctabulate-  , RepresentableFields, gftabulate-  )-import Rel8.Generic.Construction.Record-  ( GConstructor-  , GConstructable, GConstruct, gconstruct, gdeconstruct-  , Representable, gindex, gtabulate-  )-import Rel8.Generic.Table ( GGColumns )-import Rel8.Kind.Algebra-  ( SAlgebra( SProduct, SSum )-  , KnownAlgebra, algebraSing-  )-import qualified Rel8.Kind.Algebra as K-import Rel8.Schema.HTable ( HTable )-import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Name ( Name( Name ) )-import Rel8.Schema.Null ( Nullity( Null, NotNull ) )-import Rel8.Schema.Spec ( Spec( Spec, nullity, info ) )-import Rel8.Table-  ( TTable, TColumns-  , Table, fromColumns, toColumns-  )-import Rel8.Table.Bool ( case_ )-import Rel8.Type.Tag ( Tag )---- semigroupoids-import Data.Functor.Apply (Apply)-import Data.Semigroup.Traversable (sequence1, traverse1)---type GGBuildable :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Constraint-type GGBuildable algebra name rep =-  ( KnownAlgebra algebra-  , Eval (GGColumns algebra TColumns (Eval (rep Expr))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))-  , Eval (GGColumns algebra TColumns (Eval (rep Name))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))-  , HTable (Eval (GGColumns algebra TColumns (Eval (rep Expr))))-  , GGBuildable' algebra name rep-  )---type GGBuildable' :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Constraint-type family GGBuildable' algebra name rep where-  GGBuildable' 'K.Product name rep =-    ( name ~ GConstructor (Eval (rep Expr))-    , Representable Id (Eval (rep Expr))-    , GConstructable (TTable Expr) TColumns Id Expr (Eval (rep Expr))-    )-  GGBuildable' 'K.Sum name rep =-    ( Representable Id (GConstructorADT name (Eval (rep Expr)))-    , GMakeableADT (TTable Expr) TColumns Id Expr name (Eval (rep Expr))-    )---type GGBuild :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Type -> Type-type family GGBuild algebra name rep r where-  GGBuild 'K.Product _name rep r =-    GConstruct Id (Eval (rep Expr)) r-  GGBuild 'K.Sum name rep r =-    GConstruct Id (GConstructorADT name (Eval (rep Expr))) r---ggbuild :: forall algebra name rep a. GGBuildable algebra name rep-  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)-  -> GGBuild algebra name rep a-ggbuild gfromColumns = case algebraSing @algebra of-  SProduct ->-    gtabulate @Id @(Eval (rep Expr)) @a $-    gfromColumns .-    gconstruct-      @(TTable Expr)-      @TColumns-      @Id-      @Expr-      @(Eval (rep Expr))-      (const toColumns)-  SSum ->-    gtabulate @Id @(GConstructorADT name (Eval (rep Expr))) @a $-    gfromColumns .-    gmakeADT-      @(TTable Expr)-      @TColumns-      @Id-      @Expr-      @name-      @(Eval (rep Expr))-      (const toColumns)-      (\Spec {info} -> snull info)-      (\Spec {nullity} -> case nullity of-        Null -> id-        NotNull -> nullify)-      (HIdentity . litExpr)---type GGConstructable :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint-type GGConstructable algebra rep =-  ( KnownAlgebra algebra-  , Eval (GGColumns algebra TColumns (Eval (rep Expr))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))-  , Eval (GGColumns algebra TColumns (Eval (rep Name))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))-  , HTable (Eval (GGColumns algebra TColumns (Eval (rep Expr))))-  , GGConstructable' algebra rep-  )---type GGConstructable' :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint-type family GGConstructable' algebra rep where-  GGConstructable' 'K.Product rep =-    ( Representable Id (Eval (rep Expr))-    , Representable Id (Eval (rep Name))-    , GConstructable (TTable Expr) TColumns Id Expr (Eval (rep Expr))-    , GConstructable (TTable Name) TColumns Id Name (Eval (rep Name))-    )-  GGConstructable' 'K.Sum rep =-    ( RepresentableConstructors Id (Eval (rep Expr))-    , RepresentableFields Id (Eval (rep Expr))-    , RepresentableFields Id (Eval (rep Name))-    , Functor (GConstructors Id (Eval (rep Expr)))-    , GConstructableADT (TTable Expr) TColumns Id Expr (Eval (rep Expr))-    , GConstructableADT (TTable Name) TColumns Id Name (Eval (rep Name))-    )---type GGConstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type-type family GGConstruct algebra rep r where-  GGConstruct 'K.Product rep r = GConstruct Id (Eval (rep Expr)) r -> r-  GGConstruct 'K.Sum rep r = GConstructADT Id (Eval (rep Expr)) r r---ggconstruct :: forall algebra rep a. GGConstructable algebra rep-  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)-  -> GGConstruct algebra rep a -> a-ggconstruct gfromColumns f = case algebraSing @algebra of-  SProduct ->-    f $-    gtabulate @Id @(Eval (rep Expr)) @a $-    gfromColumns .-    gconstruct-      @(TTable Expr)-      @TColumns-      @Id-      @Expr-      @(Eval (rep Expr))-      (const toColumns)-  SSum ->-    gcindex @Id @(Eval (rep Expr)) @a f $-    fmap gfromColumns $-    gconstructADT-      @(TTable Expr)-      @TColumns-      @Id-      @Expr-      @(Eval (rep Expr))-      (const toColumns)-      (\Spec {info} -> snull info)-      (\Spec {nullity} -> case nullity of-        Null -> id-        NotNull -> nullify)-      (HIdentity . litExpr)---type GGDeconstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type -> Type-type family GGDeconstruct algebra rep a r where-  GGDeconstruct 'K.Product rep a r =-    GConstruct Id (Eval (rep Expr)) r -> a -> r-  GGDeconstruct 'K.Sum rep a r =-    GConstructADT Id (Eval (rep Expr)) r (a -> r)---ggdeconstruct :: forall algebra rep a r. (GGConstructable algebra rep, Table Expr r)-  => (a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)-  -> GGDeconstruct algebra rep a r-ggdeconstruct gtoColumns = case algebraSing @algebra of-  SProduct -> \build ->-    gindex @Id @(Eval (rep Expr)) @r build .-    gdeconstruct-      @(TTable Expr)-      @TColumns-      @Id-      @Expr-      @(Eval (rep Expr))-      (const fromColumns) .-    gtoColumns-  SSum ->-    gctabulate @Id @(Eval (rep Expr)) @r @(a -> r) $ \constructors as ->-      let-        (HIdentity tag, cases) =-          gdeconstructADT-            @(TTable Expr)-            @TColumns-            @Id-            @Expr-            @(Eval (rep Expr))-            (const fromColumns)-            (\Spec {nullity} -> case nullity of-              Null -> id-              NotNull -> unsafeUnnullify)-            constructors $-          gtoColumns as-      in-        case cases of-          ((_, r) :| (map (first ((tag ==.) . litExpr)) -> cases')) ->-            case_ cases' r---ggdeconstructA :: forall algebra rep a f r. (GGConstructable algebra rep, Apply f, Table Expr r)-  => (a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)-  -> GGDeconstruct algebra rep a (f r)-ggdeconstructA gtoColumns = case algebraSing @algebra of-  SProduct -> \build ->-    gindex @Id @(Eval (rep Expr)) @(f r) build .-    gdeconstruct-      @(TTable Expr)-      @TColumns-      @Id-      @Expr-      @(Eval (rep Expr))-      (const fromColumns) .-    gtoColumns-  SSum ->-    gctabulate @Id @(Eval (rep Expr)) @(f r) @(a -> f r) $ \constructors as ->-      let-        (HIdentity tag, cases) =-          gdeconstructADT-            @(TTable Expr)-            @TColumns-            @Id-            @Expr-            @(Eval (rep Expr))-            (const fromColumns)-            (\Spec {nullity} -> case nullity of-              Null -> id-              NotNull -> unsafeUnnullify)-            constructors $-          gtoColumns as-        fcases = traverse1 sequence1 cases-      in-        fcases-          <&> \((_, r) :| (map (first ((tag ==.) . litExpr)) -> cases')) ->-            case_ cases' r---type GGName :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type-type family GGName algebra rep a where-  GGName 'K.Product rep a = GConstruct Id (Eval (rep Name)) a-  GGName 'K.Sum rep a = Name Tag -> GBuildADT Id (Eval (rep Name)) a---ggname :: forall algebra rep a. GGConstructable algebra rep-  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a)-  -> GGName algebra rep a-ggname gfromColumns = case algebraSing @algebra of-  SProduct ->-    gtabulate @Id @(Eval (rep Name)) @a $-    gfromColumns .-    gconstruct-      @(TTable Name)-      @TColumns-      @Id-      @Name-      @(Eval (rep Name))-      (const toColumns)-  SSum -> \tag ->-    gftabulate @Id @(Eval (rep Name)) @a $-    gfromColumns .-    gbuildADT-      @(TTable Name)-      @TColumns-      @Id-      @Name-      @(Eval (rep Name))-      (const toColumns)-      (\_ _ (Name a) -> Name a)-      (HIdentity tag)

@@ -1,478 +0,0 @@-{-# language AllowAmbiguousTypes #-}-{-# language BlockArguments #-}-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language FlexibleInstances #-}-{-# language MultiParamTypeClasses #-}-{-# language RankNTypes #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}-{-# language TupleSections #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}--module Rel8.Generic.Construction.ADT-  ( GConstructableADT-  , GBuildADT, gbuildADT, gunbuildADT-  , GConstructADT, gconstructADT, gdeconstructADT-  , GFields, RepresentableFields, gftabulate, gfindex-  , GConstructors, RepresentableConstructors, gctabulate, gcindex-  , GConstructorADT, GMakeableADT, gmakeADT-  )-where---- base-import Data.Bifunctor ( first )-import Data.Functor.Identity ( runIdentity )-import Data.Kind ( Constraint, Type )-import Data.List.NonEmpty ( NonEmpty )-import Data.Proxy ( Proxy( Proxy ) )-import GHC.Generics-  ( (:+:), (:*:)( (:*:) ), M1, U1-  , C, D-  , Meta( MetaData, MetaCons )-  )-import GHC.TypeLits-  ( ErrorMessage( (:<>:), Text ), TypeError-  , Symbol, KnownSymbol, symbolVal-  )-import Prelude hiding ( null )---- rel8-import Rel8.FCF ( Exp )-import Rel8.Generic.Construction.Record-  ( GConstruct, GConstructable, gconstruct, gdeconstruct-  , GFields, Representable, gtabulate, gindex-  , FromColumns, ToColumns-  )-import Rel8.Generic.Table.ADT ( GColumnsADT, GColumnsADT' )-import Rel8.Generic.Table.Record ( GColumns )-import Rel8.Schema.HTable ( HTable )-import Rel8.Schema.HTable.Identity ( HIdentity )-import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )-import Rel8.Schema.HTable.Nullify ( HNullify, hnulls, hnullify, hunnullify )-import Rel8.Schema.HTable.Product ( HProduct( HProduct ) )-import Rel8.Schema.Null ( Nullify )-import Rel8.Schema.Spec ( Spec )-import qualified Rel8.Schema.Kind as K-import Rel8.Type.Tag ( Tag( Tag ) )---- text-import Data.Text ( pack )---type Null :: K.Context -> Type-type Null context = forall a. Spec a -> context (Nullify a)---type Nullifier :: K.Context -> Type-type Nullifier context = forall a. Spec a -> context a -> context (Nullify a)---type Unnullifier :: K.Context -> Type-type Unnullifier context = forall a. Spec a -> context (Nullify a) -> context a---type NoConstructor :: Symbol -> Symbol -> ErrorMessage-type NoConstructor datatype constructor =-  ( 'Text "The type `" ' :<>:-    'Text datatype ' :<>:-    'Text "` has no constructor `" ' :<>:-    'Text constructor ' :<>:-    'Text "`."-  )---type GConstructorADT :: Symbol -> (Type -> Type) -> Type -> Type-type family GConstructorADT name rep where-  GConstructorADT name (M1 D ('MetaData datatype _ _ _) rep) =-    GConstructorADT' name rep (TypeError (NoConstructor datatype name))---type GConstructorADT' :: Symbol -> (Type -> Type) -> (Type -> Type) -> Type -> Type-type family GConstructorADT' name rep fallback where-  GConstructorADT' name (M1 D _ rep) fallback =-    GConstructorADT' name rep fallback-  GConstructorADT' name (a :+: b) fallback =-    GConstructorADT' name a (GConstructorADT' name b fallback)-  GConstructorADT' name (M1 C ('MetaCons name _ _) rep) _ = rep-  GConstructorADT' _ _ fallback = fallback---type GConstructADT-  :: (Type -> Exp Type)-  -> (Type -> Type) -> Type -> Type -> Type-type family GConstructADT f rep r x where-  GConstructADT f (M1 D _ rep) r x = GConstructADT f rep r x-  GConstructADT f (a :+: b) r x = GConstructADT f a r (GConstructADT f b r x)-  GConstructADT f (M1 C _ rep) r x = GConstruct f rep r -> x---type GConstructors :: (Type -> Exp Type) -> (Type -> Type) -> Type -> Type-type family GConstructors f rep where-  GConstructors f (M1 D _ rep) = GConstructors f rep-  GConstructors f (a :+: b) = GConstructors f a :*: GConstructors f b-  GConstructors f (M1 C _ rep) = (->) (GFields f rep)---type RepresentableConstructors :: (Type -> Exp Type) -> (Type -> Type) -> Constraint-class RepresentableConstructors f rep where-  gctabulate :: (GConstructors f rep r -> a) -> GConstructADT f rep r a-  gcindex :: GConstructADT f rep r a -> GConstructors f rep r -> a---instance RepresentableConstructors f rep => RepresentableConstructors f (M1 D meta rep) where-  gctabulate = gctabulate @f @rep-  gcindex = gcindex @f @rep---instance (RepresentableConstructors f a, RepresentableConstructors f b) =>-  RepresentableConstructors f (a :+: b)- where-  gctabulate f =-    gctabulate @f @a \a -> gctabulate @f @b \b -> f (a :*: b)-  gcindex f (a :*: b) = gcindex @f @b (gcindex @f @a f a) b---instance Representable f rep => RepresentableConstructors f (M1 C meta rep) where-  gctabulate f = f . gindex @f @rep-  gcindex f = f . gtabulate @f @rep---type GBuildADT :: (Type -> Exp Type) -> (Type -> Type) -> Type -> Type-type family GBuildADT f rep r where-  GBuildADT f (M1 D _ rep) r = GBuildADT f rep r-  GBuildADT f (a :+: b) r = GBuildADT f a (GBuildADT f b r)-  GBuildADT f (M1 C _ rep) r = GConstruct f rep r---type GFieldsADT :: (Type -> Exp Type) -> (Type -> Type) -> Type-type family GFieldsADT f rep where-  GFieldsADT f (M1 D _ rep) = GFieldsADT f rep-  GFieldsADT f (a :+: b) = (GFieldsADT f a, GFieldsADT f b)-  GFieldsADT f (M1 C _ rep) = GFields f rep---type RepresentableFields :: (Type -> Exp Type) -> (Type -> Type) -> Constraint-class RepresentableFields f rep where-  gftabulate :: (GFieldsADT f rep -> a) -> GBuildADT f rep a-  gfindex :: GBuildADT f rep a -> GFieldsADT f rep -> a---instance RepresentableFields f rep => RepresentableFields f (M1 D meta rep) where-  gftabulate = gftabulate @f @rep-  gfindex = gfindex @f @rep---instance (RepresentableFields f a, RepresentableFields f b) => RepresentableFields f (a :+: b) where-  gftabulate f =-    gftabulate @f @a \a -> gftabulate @f @b \b -> f (a, b)-  gfindex f (a, b) = gfindex @f @b (gfindex @f @a f a) b---instance Representable f rep => RepresentableFields f (M1 C meta rep) where-  gftabulate = gtabulate @f @rep-  gfindex = gindex @f @rep---type GConstructableADT-  :: (Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Exp Type)-  -> K.Context -> (Type -> Type) -> Constraint-class GConstructableADT _Table _Columns f context rep where-  gbuildADT :: ()-    => ToColumns _Table _Columns f context-    -> (Tag -> Nullifier context)-    -> HIdentity Tag context-    -> GFieldsADT f rep-    -> GColumnsADT _Columns rep context--  gunbuildADT :: ()-    => FromColumns _Table _Columns f context-    -> Unnullifier context-    -> GColumnsADT _Columns rep context-    -> (HIdentity Tag context, GFieldsADT f rep)--  gconstructADT :: ()-    => ToColumns _Table _Columns f context-    -> Null context-    -> Nullifier context-    -> (Tag -> HIdentity Tag context)-    -> GConstructors f rep (GColumnsADT _Columns rep context)--  gdeconstructADT :: ()-    => FromColumns _Table _Columns f context-    -> Unnullifier context-    -> GConstructors f rep r-    -> GColumnsADT _Columns rep context-    -> (HIdentity Tag context, NonEmpty (Tag, r))---instance-  ( htable ~ HLabel "tag" (HIdentity Tag)-  , GConstructableADT' _Table _Columns f context htable rep-  )-  => GConstructableADT _Table _Columns f context (M1 D meta rep)- where-  gbuildADT toColumns nullifier =-    gbuildADT' @_Table @_Columns @f @context @htable @rep toColumns nullifier .-    hlabel--  gunbuildADT fromColumns unnullifier =-    first hunlabel .-    gunbuildADT' @_Table @_Columns @f @context @htable @rep fromColumns unnullifier--  gconstructADT toColumns null nullifier mk =-    gconstructADT' @_Table @_Columns @f @context @htable @rep toColumns null nullifier-      (hlabel . mk)--  gdeconstructADT fromColumns unnullifier cases =-    first hunlabel .-    gdeconstructADT' @_Table @_Columns @f @context @htable @rep fromColumns unnullifier cases---type GConstructableADT'-  :: (Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Exp Type)-  -> K.Context -> K.HTable -> (Type -> Type) -> Constraint-class GConstructableADT' _Table _Columns f context htable rep where-  gbuildADT' :: ()-    => ToColumns _Table _Columns f context-    -> (Tag -> Nullifier context)-    -> htable context-    -> GFieldsADT f rep-    -> GColumnsADT' _Columns htable rep context--  gunbuildADT' :: ()-    => FromColumns _Table _Columns f context-    -> Unnullifier context-    -> GColumnsADT' _Columns htable rep context-    -> (htable context, GFieldsADT f rep)--  gconstructADT' :: ()-    => ToColumns _Table _Columns f context-    -> Null context-    -> Nullifier context-    -> (Tag -> htable context)-    -> GConstructors f rep (GColumnsADT' _Columns htable rep context)--  gdeconstructADT' :: ()-    => FromColumns _Table _Columns f context-    -> Unnullifier context-    -> GConstructors f rep r-    -> GColumnsADT' _Columns htable rep context-    -> (htable context, NonEmpty (Tag, r))--  gfill :: ()-    => Null context-    -> htable context-    -> GColumnsADT' _Columns htable rep context---instance-  ( htable' ~ GColumnsADT' _Columns htable a-  , Functor (GConstructors f a)-  , GConstructableADT' _Table _Columns f context htable a-  , GConstructableADT' _Table _Columns f context htable' b-  )-  => GConstructableADT' _Table _Columns f context htable (a :+: b)- where-  gbuildADT' toColumns nullifier htable (a, b) =-    gbuildADT' @_Table @_Columns @f @context @htable' @b toColumns nullifier-      (gbuildADT' @_Table @_Columns @f @context @htable @a toColumns nullifier htable a)-      b--  gunbuildADT' fromColumns unnullifier columns =-    case gunbuildADT' @_Table @_Columns @f @context @htable' @b fromColumns unnullifier columns of-      (htable', b) ->-        case gunbuildADT' @_Table @_Columns @f @context @htable @a fromColumns unnullifier htable' of-          (htable, a) -> (htable, (a, b))--  gconstructADT' toColumns null nullifier mk =-    fmap (gfill @_Table @_Columns @f @context @htable' @b null) (gconstructADT' @_Table @_Columns @f @context @htable @a toColumns null nullifier mk) :*:-    gconstructADT' @_Table @_Columns @f @context @htable' @b toColumns null nullifier (gfill @_Table @_Columns @f @context @htable @a null . mk)--  gdeconstructADT' fromColumns unnullifier (a :*: b) columns =-    case gdeconstructADT' @_Table @_Columns @f @context @htable' @b fromColumns unnullifier b columns of-      (htable', cases) ->-        case gdeconstructADT' @_Table @_Columns @f @context @htable @a fromColumns unnullifier a htable' of-          (htable, cases') -> (htable, cases' <> cases)--  gfill null =-    gfill @_Table @_Columns @f @context @htable' @b null .-    gfill @_Table @_Columns @f @context @htable @a null---instance (meta ~ 'MetaCons label _fixity _isRecord, KnownSymbol label) =>-  GConstructableADT' _Table _Columns f context htable (M1 C meta U1)- where-  gbuildADT' _ _ = const-  gunbuildADT' _ _ = (, ())-  gconstructADT' _ _ _ f _ = f tag-    where-      tag = Tag $ pack $ symbolVal (Proxy @label)-  gdeconstructADT' _ _ r htable = (htable, pure (tag, r ()))-    where-      tag = Tag $ pack $ symbolVal (Proxy @label)-  gfill _ = id---instance {-# OVERLAPPABLE #-}-  ( HTable (GColumns _Columns rep)-  , KnownSymbol label-  , meta ~ 'MetaCons label _fixity _isRecord-  , GConstructable _Table _Columns f context rep-  , GColumnsADT' _Columns htable (M1 C meta rep) ~-      HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))-  )-  => GConstructableADT' _Table _Columns f context htable (M1 C meta rep)- where-  gbuildADT' toColumns nullifier htable =-    HProduct htable .-    hlabel .-    hnullify (nullifier tag) .-    gconstruct @_Table @_Columns @f @context @rep toColumns-    where-      tag = Tag $ pack $ symbolVal (Proxy @label)--  gunbuildADT' fromColumns unnullifier (HProduct htable a) =-    ( htable-    , gdeconstruct @_Table @_Columns @f @context @rep fromColumns $-        runIdentity $-        hunnullify (\spec -> pure . unnullifier spec) $-        hunlabel-        a-    )--  gconstructADT' toColumns _ nullifier mk =-    HProduct htable .-    hlabel .-    hnullify nullifier .-    gconstruct @_Table @_Columns @f @context @rep toColumns-    where-      tag = Tag $ pack $ symbolVal (Proxy @label)-      htable = mk tag--  gdeconstructADT' fromColumns unnullifier r (HProduct htable columns) =-    ( htable-    , pure (tag, r a)-    )-    where-      a = gdeconstruct @_Table @_Columns @f @context @rep fromColumns $-        runIdentity $-        hunnullify (\spec -> pure . unnullifier spec) $-        hunlabel-        columns-      tag = Tag $ pack $ symbolVal (Proxy @label)--  gfill null htable = HProduct htable (hlabel (hnulls null))---type GMakeableADT-  :: (Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Exp Type)-  -> K.Context -> Symbol -> (Type -> Type) -> Constraint-class GMakeableADT _Table _Columns f context name rep where-  gmakeADT :: ()-    => ToColumns _Table _Columns f context-    -> Null context-    -> Nullifier context-    -> (Tag -> HIdentity Tag context)-    -> GFields f (GConstructorADT name rep)-    -> GColumnsADT _Columns rep context---instance-  ( htable ~ HLabel "tag" (HIdentity Tag)-  , meta ~ 'MetaData datatype _module _package _newtype-  , fallback ~ TypeError (NoConstructor datatype name)-  , fields ~ GFields f (GConstructorADT' name rep fallback)-  , GMakeableADT' _Table _Columns f context htable name rep fields-  , KnownSymbol name-  )-  => GMakeableADT _Table _Columns f context name (M1 D meta rep)- where-  gmakeADT toColumns null nullifier wrap =-    gmakeADT'-      @_Table @_Columns @f @context @htable @name @rep @fields-      toColumns null nullifier htable-    where-      tag = Tag $ pack $ symbolVal (Proxy @name)-      htable = hlabel (wrap tag)---type GMakeableADT'-  :: (Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Exp Type)-  -> K.Context -> K.HTable -> Symbol -> (Type -> Type) -> Type -> Constraint-class GMakeableADT' _Table _Columns f context htable name rep fields where-  gmakeADT' :: ()-    => ToColumns _Table _Columns f context-    -> Null context-    -> Nullifier context-    -> htable context-    -> fields-    -> GColumnsADT' _Columns htable rep context---instance-  ( htable' ~ GColumnsADT' _Columns htable a-  , GMakeableADT' _Table _Columns f context htable name a fields-  , GMakeableADT' _Table _Columns f context htable' name b fields-  )-  => GMakeableADT' _Table _Columns f context htable name (a :+: b) fields- where-  gmakeADT' toColumns null nullifier htable x =-    gmakeADT' @_Table @_Columns @f @context @htable' @name @b @fields-      toColumns null nullifier-      (gmakeADT'-         @_Table @_Columns @f @context @htable @name @a @fields toColumns-         null nullifier htable x)-      x---instance {-# OVERLAPPING #-}-  GMakeableADT' _Table _Columns f context htable name (M1 C ('MetaCons name _fixity _isRecord) U1) fields- where-  gmakeADT' _ _ _ = const---instance {-# OVERLAPS #-}-  GMakeableADT' _Table _Columns f context htable name (M1 C ('MetaCons label _fixity _isRecord) U1) fields- where-  gmakeADT' _ _ _ = const---instance {-# OVERLAPS #-}-  ( HTable (GColumns _Columns rep)-  , GConstructable _Table _Columns f context rep-  , fields ~ GFields f rep-  , GColumnsADT' _Columns htable (M1 C ('MetaCons name _fixity _isRecord) rep) ~-      HProduct htable (HLabel name (HNullify (GColumns _Columns rep)))-  )-  => GMakeableADT' _Table _Columns f context htable name (M1 C ('MetaCons name _fixity _isRecord) rep) fields- where-  gmakeADT' toColumns _ nullifier htable =-    HProduct htable .-    hlabel .-    hnullify nullifier .-    gconstruct @_Table @_Columns @f @context @rep toColumns---instance {-# OVERLAPPABLE #-}-  ( HTable (GColumns _Columns rep)-  , GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) rep) ~-      HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))-  )-  => GMakeableADT' _Table _Columns f context htable name (M1 C ('MetaCons label _fixity _isRecord) rep) fields- where-  gmakeADT' _ null _ htable _ =-    HProduct htable $-    hlabel $-    hnulls null

@@ -1,168 +0,0 @@-{-# language AllowAmbiguousTypes #-}-{-# language BlockArguments #-}-{-# language DataKinds #-}-{-# language FlexibleInstances #-}-{-# language MultiParamTypeClasses #-}-{-# language RankNTypes #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}--module Rel8.Generic.Construction.Record-  ( GConstructor, GConstruct, GConstructable, gconstruct, gdeconstruct-  , GFields, Representable, gtabulate, gindex-  , FromColumns, ToColumns-  )-where---- base-import Data.Kind ( Constraint, Type )-import Data.Proxy ( Proxy( Proxy ) )-import GHC.Generics-  ( (:*:), K1, M1, U1-  , D, C, S, Meta( MetaData, MetaCons, MetaSel )-  )-import GHC.TypeLits-  ( ErrorMessage( (:<>:), Text ), TypeError-  , Symbol-  )-import Prelude---- rel8-import Rel8.FCF ( Eval, Exp )-import Rel8.Generic.Table.Record ( GColumns )-import Rel8.Schema.HTable.Label ( hlabel, hunlabel )-import Rel8.Schema.HTable.Product ( HProduct( HProduct ) )-import qualified Rel8.Schema.Kind as K---type FromColumns-  :: (Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Exp Type)-  -> K.Context-  -> Type-type FromColumns _Table _Columns f context = forall proxy x.-  Eval (_Table x) => proxy x -> Eval (_Columns x) context -> Eval (f x)---type ToColumns-  :: (Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Exp Type)-  -> K.Context-  -> Type-type ToColumns _Table _Columns f context = forall proxy x.-  Eval (_Table x) => proxy x -> Eval (f x) -> Eval (_Columns x) context---type GConstructor :: (Type -> Type) -> Symbol-type family GConstructor rep where-  GConstructor (M1 D _ (M1 C ('MetaCons name _ _) _)) = name-  GConstructor (M1 D ('MetaData name _ _ _) _) = TypeError (-    'Text "`" ' :<>:-    'Text name ' :<>:-    'Text "` does not appear to have exactly 1 constructor"-   )---type GConstruct :: (Type -> Exp Type) -> (Type -> Type) -> Type -> Type-type family GConstruct f rep r where-  GConstruct f (M1 _ _ rep) r = GConstruct f rep r-  GConstruct f (a :*: b) r = GConstruct f a (GConstruct f b r)-  GConstruct _ U1 r = r-  GConstruct f (K1 _ a) r = Eval (f a) -> r---type GFields :: (Type -> Exp Type) -> (Type -> Type) -> Type-type family GFields f rep where-  GFields f (M1 _ _ rep) = GFields f rep-  GFields f (a :*: b) = (GFields f a, GFields f b)-  GFields _ U1 = ()-  GFields f (K1 _ a) = Eval (f a)---type Representable :: (Type -> Exp Type) -> (Type -> Type) -> Constraint-class Representable f rep where-  gtabulate :: (GFields f rep -> a) -> GConstruct f rep a-  gindex :: GConstruct f rep a -> GFields f rep -> a---instance Representable f rep => Representable f (M1 i meta rep) where-  gtabulate = gtabulate @f @rep-  gindex = gindex @f @rep---instance (Representable f a, Representable f b) =>-  Representable f (a :*: b)- where-  gtabulate f = gtabulate @f @a \a -> gtabulate @f @b \b -> f (a, b)-  gindex f (a, b) = gindex @f @b (gindex @f @a f a) b---instance Representable f U1 where-  gtabulate = ($ ())-  gindex = const---instance Representable f (K1 i a) where-  gtabulate = id-  gindex = id---type GConstructable-  :: (Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Exp Type)-  -> K.Context -> (Type -> Type) -> Constraint-class GConstructable _Table _Columns f context rep where-  gconstruct :: ()-    => ToColumns _Table _Columns f context-    -> GFields f rep-    -> GColumns _Columns rep context-  gdeconstruct :: ()-    => FromColumns _Table _Columns f context-    -> GColumns _Columns rep context-    -> GFields f rep---instance (GConstructable _Table _Columns f context rep) =>-  GConstructable _Table _Columns f context (M1 D meta rep)- where-  gconstruct = gconstruct @_Table @_Columns @f @context @rep-  gdeconstruct = gdeconstruct @_Table @_Columns @f @context @rep---instance (GConstructable _Table _Columns f context rep) =>-  GConstructable _Table _Columns f context (M1 C meta rep)- where-  gconstruct = gconstruct @_Table @_Columns @f @context @rep-  gdeconstruct = gdeconstruct @_Table @_Columns @f @context @rep---instance-  ( GConstructable _Table _Columns f context a-  , GConstructable _Table _Columns f context b-  )-  => GConstructable _Table _Columns f context (a :*: b)- where-  gconstruct toColumns (a, b) = HProduct-    (gconstruct @_Table @_Columns @f @context @a toColumns a)-    (gconstruct @_Table @_Columns @f @context @b toColumns b)-  gdeconstruct fromColumns (HProduct a b) =-    ( gdeconstruct @_Table @_Columns @f @context @a fromColumns a-    , gdeconstruct @_Table @_Columns @f @context @b fromColumns b-    )---instance-  ( Eval (_Table a)-  , meta ~ 'MetaSel ('Just label) _su _ss _ds-  )-  => GConstructable _Table _Columns f context (M1 S meta (K1 i a))- where-  gconstruct toColumns = hlabel . toColumns (Proxy @a)-  gdeconstruct fromColumns = fromColumns (Proxy @a) . hunlabel

@@ -1,49 +0,0 @@-{-# language DataKinds #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}--module Rel8.Generic.Map-  ( GMap-  , Map-  )-where---- base-import Data.Kind ( Type )-import GHC.Generics-  ( (:+:), (:*:), K1, M1, U1, V1-  )-import Prelude ()---- rel8-import Rel8.FCF ( Eval, Exp )---type GMap :: (Type -> Exp Type) -> (Type -> Type) -> Type -> Type-type family GMap f rep where-  GMap f (M1 i c rep) = M1 i c (GMap f rep)-  GMap _ V1 = V1-  GMap f (rep1 :+: rep2) = GMap f rep1 :+: GMap f rep2-  GMap _ U1 = U1-  GMap f (rep1 :*: rep2) = GMap f rep1 :*: GMap f rep2-  GMap f (K1 i a) = K1 i (Eval (f a))----- | Map a @Type -> Type@ function over the @Type@-kinded type variables in--- of a type constructor.-type Map :: (Type -> Exp Type) -> Type -> Type-type family Map f a where-  Map p (t a b c d e f g) =-    t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d)) (Eval (p e))-      (Eval (p f)) (Eval (p g))-  Map p (t a b c d e f) =-    t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d)) (Eval (p e))-      (Eval (p f))-  Map p (t a b c d e) =-    t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d)) (Eval (p e))-  Map p (t a b c d) = t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d))-  Map p (t a b c) = t (Eval (p a)) (Eval (p b)) (Eval (p c))-  Map p (t a b) = t (Eval (p a)) (Eval (p b))-  Map p (t a) = t (Eval (p a))

@@ -1,155 +0,0 @@-{-# language AllowAmbiguousTypes #-}-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language FlexibleInstances #-}-{-# language MultiParamTypeClasses #-}-{-# language PolyKinds #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}--module Rel8.Generic.Record-  ( Record(..)-  , GRecordable, GRecord, grecord, gunrecord-  )-where---- base-import Data.Kind ( Constraint, Type )-import GHC.Generics-  ( Generic, Rep, from, to-  , (:+:)( L1, R1 ), (:*:)( (:*:) ), M1( M1 )-  , Meta( MetaCons, MetaSel ), D, C, S-  )-import GHC.TypeLits ( type (+), AppendSymbol, Div, Mod, Nat, Symbol )-import Prelude hiding ( Show )---type GRecord :: (Type -> Type) -> Type -> Type-type family GRecord rep where-  GRecord (M1 D meta rep) = M1 D meta (GRecord rep)-  GRecord (l :+: r) = GRecord l :+: GRecord r-  GRecord (M1 C ('MetaCons name fixity 'False) rep) =-    M1 C ('MetaCons name fixity 'True) (Snd (Count 0 rep))-  GRecord rep = rep---type Count :: Nat -> (Type -> Type) -> (Nat, Type -> Type)-type family Count n rep where-  Count n (M1 S ('MetaSel _selector su ss ds) rep) =-    '(n + 1, M1 S ('MetaSel ('Just (Show (n + 1))) su ss ds) rep)-  Count n (a :*: b) = CountHelper1 (Count n a) b-  Count n rep = '(n, rep)---type CountHelper1 :: (Nat, Type -> Type) -> (Type -> Type) -> (Nat, Type -> Type)-type family CountHelper1 tuple b where-  CountHelper1 '(n, a) b = CountHelper2 a (Count n b)---type CountHelper2 :: (Type -> Type) -> (Nat, Type -> Type) -> (Nat, Type -> Type)-type family CountHelper2 a tuple where-  CountHelper2 a '(n, b) = '(n, a :*: b)---type Show :: Nat -> Symbol-type Show n =-  AppendSymbol "_" (AppendSymbol (Show' (Div n 10)) (ShowDigit (Mod n 10)))---type Show' :: Nat -> Symbol-type family Show' n where-  Show' 0 = ""-  Show' n = AppendSymbol (Show' (Div n 10)) (ShowDigit (Mod n 10))---type ShowDigit :: Nat -> Symbol-type family ShowDigit n where-  ShowDigit 0 = "0"-  ShowDigit 1 = "1"-  ShowDigit 2 = "2"-  ShowDigit 3 = "3"-  ShowDigit 4 = "4"-  ShowDigit 5 = "5"-  ShowDigit 6 = "6"-  ShowDigit 7 = "7"-  ShowDigit 8 = "8"-  ShowDigit 9 = "9"---type Snd :: (a, b) -> b-type family Snd tuple where-  Snd '(_a, b) = b---type GRecordable :: (Type -> Type) -> Constraint-class GRecordable rep where-  grecord :: rep x -> GRecord rep x-  gunrecord :: GRecord rep x -> rep x---instance GRecordable rep => GRecordable (M1 D meta rep) where-  grecord (M1 a) = M1 (grecord a)-  gunrecord (M1 a) = M1 (gunrecord a)---instance (GRecordable l, GRecordable r) => GRecordable (l :+: r) where-  grecord (L1 a) = L1 (grecord a)-  grecord (R1 a) = R1 (grecord a)-  gunrecord (L1 a) = L1 (gunrecord a)-  gunrecord (R1 a) = R1 (gunrecord a)---instance Countable 0 rep =>-  GRecordable (M1 C ('MetaCons name fixity 'False) rep)- where-  grecord (M1 a) = M1 (count @0 a)-  gunrecord (M1 a) = M1 (uncount @0 a)---instance {-# OVERLAPPABLE #-} GRecord rep ~ rep => GRecordable rep where-  grecord = id-  gunrecord = id---type Countable :: Nat -> (Type -> Type) -> Constraint-class Countable n rep where-  count :: rep x -> Snd (Count n rep) x-  uncount :: Snd (Count n rep) x -> rep x---instance Countable n (M1 S ('MetaSel selector su ss ds) rep) where-  count (M1 a) = M1 a-  uncount (M1 a) = M1 a---instance-  ( Countable n a, Countable n' b-  , '(n', a') ~ Count n a-  , Snd (CountHelper2 a' (Count n' b)) ~ (a' :*: Snd (Count n' b))-  )-  => Countable n (a :*: b)- where-  count (a :*: b) = count @n a :*: count @n' b-  uncount (a :*: b) = uncount @n a :*: uncount @n' b---instance {-# OVERLAPPABLE #-} Snd (Count n rep) ~ rep => Countable n rep where-  count = id-  uncount = id---type Record :: Type -> Type-newtype Record a = Record-  { unrecord :: a-  }---instance (Generic a, GRecordable (Rep a)) => Generic (Record a) where-  type Rep (Record a) = GRecord (Rep a)--  from (Record a) = grecord (from a)-  to = Record . to . gunrecord

@@ -1,288 +0,0 @@-{-# language AllowAmbiguousTypes #-}-{-# language ConstraintKinds #-}-{-# language DataKinds #-}-{-# language DefaultSignatures #-}-{-# language FlexibleContexts #-}-{-# language FlexibleInstances #-}-{-# language LambdaCase #-}-{-# language MultiParamTypeClasses #-}-{-# language PolyKinds #-}-{-# language QuantifiedConstraints #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeApplications #-}-{-# language TypeFamilyDependencies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}--module Rel8.Generic.Rel8able-  ( KRel8able, Rel8able-  , Algebra-  , GRep-  , GColumns, gfromColumns, gtoColumns-  , GFromExprs, gfromResult, gtoResult-  , TSerialize, serialize, deserialize-  )-where---- base-import Data.Functor.Identity ( Identity )-import Data.Kind ( Constraint, Type )-import Data.Type.Bool ( type (&&) )-import GHC.Generics ( Generic, Rep, from, to )-import Prelude---- rel8-import Rel8.Expr ( Expr )-import Rel8.FCF ( Exp, Eval )-import Rel8.Generic.Record ( Record(..) )-import Rel8.Generic.Table ( GAlgebra )-import qualified Rel8.Generic.Table.Record as G-import qualified Rel8.Kind.Algebra as K ( Algebra(..) )-import Rel8.Kind.Context ( SContext(..) )-import Rel8.Schema.Field ( Field )-import Rel8.Schema.HTable ( HTable )-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Name ( Name )-import Rel8.Schema.Result ( Result )-import Rel8.Table-  ( Table, Columns, Context, fromColumns, toColumns-  , FromExprs, fromResult, toResult-  , Transpose-  , TTable, TColumns-  )-import Rel8.Table.Transpose ( Transposes )----- | The kind of 'Rel8able' types-type KRel8able :: Type-type KRel8able = K.Rel8able----- This is almost 'Data.Type.Equality.==', but we add an extra case.-type (==) :: k -> k -> Bool-type family a == b where-  -- This extra case is needed to solve the equation "a == a" (where a is a-  -- KRel8able), which occurs when we have polymorphic Rel8ables-  -- (e.g., newtype T t f = T { x :: t a })-  (a :: KRel8able) == (a :: KRel8able) = 'True--  -- This extra case is needed to solve the equation "a == Identity a", -  -- which occurs when we have polymorphic Rel8ables -  -- (e.g., newtype T a f = T { x :: Column f a })-  a == Identity a = 'False-  -  -- These cases are exactly the same as those in 'Data.Type.Equality.==.-  f a == g b = f == g && a == b-  a == a = 'True-  _ == _ = 'False---type Serialize :: Bool -> Type -> Type -> Constraint-class transposition ~ (a == Transpose Result expr) =>-  Serialize transposition expr a- where-  serialize :: a -> Columns expr Result-  deserialize :: Columns expr Result -> a---instance-  ( (a == Transpose Result expr) ~ 'True-  , Transposes Expr Result expr a-  )-  => Serialize 'True expr a- where-  serialize = toColumns-  deserialize = fromColumns---instance-  ( (a == Transpose Result expr) ~ 'False-  , Table (Context expr) expr-  , FromExprs expr ~ a-  )-  => Serialize 'False expr a- where-  serialize = toResult @_ @expr-  deserialize = fromResult @_ @expr---data TSerialize :: Type -> Type -> Exp Constraint-type instance Eval (TSerialize expr a) =-  Serialize (a == Transpose Result expr) expr a----- | This type class allows you to define custom 'Table's using higher-kinded--- data types. Higher-kinded data types are data types of the pattern:------ @--- data MyType f =---   MyType { field1 :: Column f T1 OR HK1 f---          , field2 :: Column f T2 OR HK2 f---          , ...---          , fieldN :: Column f Tn OR HKn f---          }--- @------ where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.------ That is, higher-kinded data are records where all fields in the record are--- all either of the type @Column f T@ (for any @T@), or are themselves--- higher-kinded data:------ [Nested]------ @--- data Nested f =---   Nested { nested1 :: MyType f---          , nested2 :: MyType f---          }--- @------ The @Rel8able@ type class is used to give us a special mapping operation--- that lets us change the type parameter @f@.------ [Supplying @Rel8able@ instances]------ This type class should be derived generically for all table types in your--- project. To do this, enable the @DeriveAnyClass@ and @DeriveGeneric@ language--- extensions:------ @--- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}------ data MyType f = MyType { fieldA :: Column f T }---   deriving ( GHC.Generics.Generic, Rel8able )--- @-type Rel8able :: K.Rel8able -> Constraint-class HTable (GColumns t) => Rel8able t where-  type GColumns t :: K.HTable-  type GFromExprs t :: Type--  gfromColumns :: SContext context -> GColumns t context -> t context-  gtoColumns :: SContext context -> t context -> GColumns t context--  gfromResult :: GColumns t Result -> GFromExprs t-  gtoResult :: GFromExprs t -> GColumns t Result--  type GColumns t = G.GColumns TColumns (GRep t Expr)-  type GFromExprs t = t Result--  {-# NOINLINE gfromColumns #-} -- See Note [Generics and Inlining]-  default gfromColumns :: forall context.-    ( SRel8able t Expr-    , forall table. SRel8able t (Field table)-    , SRel8able t Name-    , SSerialize t-    )-    => SContext context -> GColumns t context -> t context-  gfromColumns = \case-    SExpr -> sfromColumns-    SField -> sfromColumns-    SName -> sfromColumns-    SResult -> sfromResult--  {-# NOINLINE gtoColumns #-} -- See Note [Generics and Inlining]-  default gtoColumns :: forall context.-    ( SRel8able t Expr-    , forall table. SRel8able t (Field table)-    , SRel8able t Name-    , SSerialize t-    )-    => SContext context -> t context -> GColumns t context-  gtoColumns = \case-    SExpr -> stoColumns-    SField -> stoColumns-    SName -> stoColumns-    SResult -> stoResult--  {-# NOINLINE gfromResult #-} -- See Note [Generics and Inlining]-  default gfromResult :: (SSerialize t, GFromExprs t ~ t Result)-    => GColumns t Result -> GFromExprs t-  gfromResult = sfromResult--  {-# NOINLINE gtoResult #-} -- See Note [Generics and Inlining]-  default gtoResult :: (SSerialize t, GFromExprs t ~ t Result)-    => GFromExprs t -> GColumns t Result-  gtoResult = stoResult---type Algebra :: K.Rel8able -> K.Algebra-type Algebra t = GAlgebra (GRep t Expr)---type GRep :: K.Rel8able -> K.Context -> Type -> Type-type GRep t context = Rep (Record (t context))---type SRel8able :: K.Rel8able -> K.Context -> Constraint-class-  ( Generic (Record (t context))-  , G.GTable (TTable context) TColumns (GRep t context)-  , G.GColumns TColumns (GRep t context) ~ GColumns t-  )-  => SRel8able t context-instance-  ( Generic (Record (t context))-  , G.GTable (TTable context) TColumns (GRep t context)-  , G.GColumns TColumns (GRep t context) ~ GColumns t-  )-  => SRel8able t context---type SSerialize :: K.Rel8able -> Constraint-type SSerialize t =-  ( Generic (Record (t Result))-  , G.GSerialize TSerialize TColumns (GRep t Expr) (GRep t Result)-  , G.GColumns TColumns (GRep t Expr) ~ GColumns t-  )---sfromColumns :: forall t context. SRel8able t context-  => GColumns t context -> t context-sfromColumns =-  unrecord .-  to .-  G.gfromColumns @(TTable context) @TColumns fromColumns---stoColumns :: forall t context. SRel8able t context-  => t context -> GColumns t context-stoColumns =-  G.gtoColumns @(TTable context) @TColumns toColumns .-  from .-  Record---sfromResult :: forall t. SSerialize t-  => GColumns t Result -> t Result-sfromResult =-  unrecord .-  to .-  G.gfromResult-    @TSerialize-    @TColumns-    @(GRep t Expr)-    @(GRep t Result)-    (\(_ :: proxy x) -> deserialize @_ @x)---stoResult :: forall t. SSerialize t-  => t Result -> GColumns t Result-stoResult =-  G.gtoResult-    @TSerialize-    @TColumns-    @(GRep t Expr)-    @(GRep t Result)-    (\(_ :: proxy x) -> serialize @_ @x) .-  from .-  Record---- Note [Generics and Inlining]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~--- We want to make sure that Generics derived functions (by default)--- do not expose their unfoldings. These are always unoptimised code and can--- therefore be quite large, and bloat our interfaces.--- By marking these as NOINLINE we can considerably speed up our compile times.--- If users do want these INLINEd, they can locally override the default using a pragma.

@@ -1,103 +0,0 @@-{-# language AllowAmbiguousTypes #-}-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language FlexibleInstances #-}-{-# language MultiParamTypeClasses #-}-{-# language RankNTypes #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}--module Rel8.Generic.Table-  ( GGSerialize, GGColumns, ggfromResult, ggtoResult-  , GAlgebra-  )-where---- base-import Data.Kind ( Constraint, Type )-import GHC.Generics ( (:+:), (:*:), K1, M1, U1, V1 )-import Prelude ()---- rel8-import Rel8.FCF ( Eval, Exp )-import Rel8.Generic.Table.ADT-  ( GSerializeADT, GColumnsADT, gtoResultADT, gfromResultADT-  )-import Rel8.Generic.Table.Record ( GSerialize, GColumns, gtoResult, gfromResult )-import Rel8.Kind.Algebra-  ( Algebra( Product, Sum )-  , SAlgebra( SProduct, SSum )-  , KnownAlgebra, algebraSing-  )-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result )---data GGSerialize-  :: Algebra-  -> (Type -> Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Type)-  -> (Type -> Type)-  -> Exp Constraint---type instance Eval (GGSerialize 'Product _Serialize _Columns exprs rep) =-  GSerialize _Serialize _Columns exprs rep---type instance Eval (GGSerialize 'Sum _Serialize _Columns exprs rep) =-  GSerializeADT _Serialize _Columns exprs rep---data GGColumns-  :: Algebra-  -> (Type -> Exp K.HTable)-  -> (Type -> Type)-  -> Exp K.HTable---type instance Eval (GGColumns 'Product _Columns rep) = GColumns _Columns rep---type instance Eval (GGColumns 'Sum _Columns rep) = GColumnsADT _Columns rep---type GAlgebra :: (Type -> Type) -> Algebra-type family GAlgebra rep where-  GAlgebra (M1 _ _ rep) = GAlgebra rep-  GAlgebra V1 = 'Sum-  GAlgebra (_ :+: _) = 'Sum-  GAlgebra U1 = 'Sum-  GAlgebra (_ :*: _) = 'Product-  GAlgebra (K1 _ _) = 'Product---ggfromResult :: forall algebra _Serialize _Columns exprs rep x.-  ( KnownAlgebra algebra-  , Eval (GGSerialize algebra _Serialize _Columns exprs rep)-  )-  => (forall expr a proxy. Eval (_Serialize expr a)-      => proxy expr -> Eval (_Columns expr) Result -> a)-  -> Eval (GGColumns algebra _Columns exprs) Result-  -> rep x-ggfromResult f x = case algebraSing @algebra of-  SProduct -> gfromResult @_Serialize @_Columns @exprs @rep f x-  SSum -> gfromResultADT @_Serialize @_Columns @exprs @rep f x---ggtoResult :: forall algebra _Serialize _Columns exprs rep x.-  ( KnownAlgebra algebra-  , Eval (GGSerialize algebra _Serialize _Columns exprs rep)-  )-  => (forall expr a proxy. Eval (_Serialize expr a)-      => proxy expr -> a -> Eval (_Columns expr) Result)-  -> rep x-  -> Eval (GGColumns algebra _Columns exprs) Result-ggtoResult f x = case algebraSing @algebra of-  SProduct -> gtoResult @_Serialize @_Columns @exprs @rep f x-  SSum -> gtoResultADT @_Serialize @_Columns @exprs @rep f x

@@ -1,221 +0,0 @@-{-# language AllowAmbiguousTypes #-}-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language FlexibleInstances #-}-{-# language LambdaCase #-}-{-# language MultiParamTypeClasses #-}-{-# language RankNTypes #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}--module Rel8.Generic.Table.ADT-  ( GSerializeADT, GColumnsADT, gfromResultADT, gtoResultADT-  , GSerializeADT', GColumnsADT'-  )-where---- base-import Data.Functor.Identity ( Identity( Identity ) )-import Data.Kind ( Constraint, Type )-import Data.Proxy ( Proxy( Proxy ) )-import GHC.Generics-  ( (:+:)( L1, R1 ), M1( M1 ), U1( U1 )-  , C, D-  , Meta( MetaCons )-  )-import GHC.TypeLits ( KnownSymbol, symbolVal )-import Prelude hiding ( null )---- rel8-import Rel8.FCF ( Eval, Exp )-import Rel8.Generic.Table.Record ( GSerialize, GColumns, gfromResult, gtoResult )-import Rel8.Schema.HTable ( HTable )-import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )-import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )-import Rel8.Schema.HTable.Nullify ( HNullify, hnulls, hnullify, hunnullify )-import Rel8.Schema.HTable.Product ( HProduct( HProduct ) )-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Result ( Result, null, nullifier, unnullifier )-import Rel8.Type.Tag ( Tag( Tag ) )---- text-import Data.Text ( pack )---type GColumnsADT-  :: (Type -> Exp K.HTable)-  -> (Type -> Type) -> K.HTable-type family GColumnsADT _Columns rep where-  GColumnsADT _Columns (M1 D _ rep) =-    GColumnsADT' _Columns (HLabel "tag" (HIdentity Tag)) rep---type GColumnsADT'-  :: (Type -> Exp K.HTable)-  -> K.HTable -> (Type -> Type) -> K.HTable-type family GColumnsADT' _Columns htable rep  where-  GColumnsADT' _Columns htable (a :+: b) =-    GColumnsADT' _Columns (GColumnsADT' _Columns htable a) b-  GColumnsADT' _Columns htable (M1 C ('MetaCons _ _ _) U1) = htable-  GColumnsADT' _Columns htable (M1 C ('MetaCons label _ _) rep) =-    HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))---type GSerializeADT-  :: (Type -> Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Type) -> (Type -> Type) -> Constraint-class GSerializeADT _Serialize _Columns exprs rep where-  gfromResultADT :: ()-    => (forall expr a proxy. Eval (_Serialize expr a)-        => proxy expr -> Eval (_Columns expr) Result -> a)-    -> GColumnsADT _Columns exprs Result-    -> rep x--  gtoResultADT :: ()-    => (forall expr a proxy. Eval (_Serialize expr a)-        => proxy expr -> a -> Eval (_Columns expr) Result)-    -> rep x-    -> GColumnsADT _Columns exprs Result---instance-  ( htable ~ HLabel "tag" (HIdentity Tag)-  , GSerializeADT' _Serialize _Columns htable exprs rep-  )-  => GSerializeADT _Serialize _Columns (M1 D meta exprs) (M1 D meta rep)- where-  gfromResultADT fromResult columns =-    case gfromResultADT' @_Serialize @_Columns @htable @exprs @rep fromResult tag columns of-      Just rep -> M1 rep-      _ -> error "ADT.fromColumns: mismatch between tag and data"-    where-      tag = (\(HIdentity (Identity a)) -> a) . hunlabel @"tag"--  gtoResultADT toResult (M1 rep) =-    gtoResultADT' @_Serialize @_Columns @htable @exprs @rep toResult tag (Just rep)-    where-      tag = hlabel @"tag" . HIdentity . Identity---type GSerializeADT'-  :: (Type -> Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> K.HTable -> (Type -> Type) -> (Type -> Type) -> Constraint-class GSerializeADT' _Serialize _Columns htable exprs rep where-  gfromResultADT' :: context ~ Result-    => (forall expr a proxy. Eval (_Serialize expr a)-        => proxy expr -> Eval (_Columns expr) context -> a)-    -> (htable Result -> Tag)-    -> GColumnsADT' _Columns htable exprs context-    -> Maybe (rep x)--  gtoResultADT' :: context ~ Result-    => (forall expr a proxy. Eval (_Serialize expr a)-        => proxy expr -> a -> Eval (_Columns expr) context)-    -> (Tag -> htable Result)-    -> Maybe (rep x)-    -> GColumnsADT' _Columns htable exprs context--  extract :: GColumnsADT' _Columns htable exprs context -> htable context---instance-  ( htable' ~ GColumnsADT' _Columns htable exprs1-  , GSerializeADT' _Serialize _Columns htable exprs1 a-  , GSerializeADT' _Serialize _Columns htable' exprs2 b-  )-  => GSerializeADT' _Serialize _Columns htable (exprs1 :+: exprs2) (a :+: b)- where-  gfromResultADT' fromResult f columns =-    case ma of-      Just a -> Just (L1 a)-      Nothing -> R1 <$>-        gfromResultADT' @_Serialize @_Columns @_ @exprs2 @b-          fromResult-          (f . extract @_Serialize @_Columns @_ @exprs1 @a)-          columns-    where-      ma =-        gfromResultADT' @_Serialize @_Columns @_ @exprs1 @a-          fromResult-          f-          (extract @_Serialize @_Columns @_ @exprs2 @b columns)--  gtoResultADT' toResult tag = \case-    Just (L1 a) ->-      gtoResultADT' @_Serialize @_Columns @_ @exprs2 @b-        toResult-        (\_ -> gtoResultADT' @_Serialize @_Columns @_ @exprs1 @a-          toResult-          tag-          (Just a))-        Nothing-    Just (R1 b) ->-      gtoResultADT' @_Serialize @_Columns @_ @exprs2 @b-        toResult-        (\tag' ->-          gtoResultADT' @_Serialize @_Columns @_ @exprs1 @a-            toResult-            (\_ -> tag tag')-            Nothing)-        (Just b)-    Nothing ->-      gtoResultADT' @_Serialize @_Columns @_ @exprs2 @b-        toResult-        (\_ -> gtoResultADT' @_Serialize @_Columns @_ @exprs1 @a toResult tag Nothing)-        Nothing--  extract =-    extract @_Serialize @_Columns @_ @exprs1 @a .-    extract @_Serialize @_Columns @_ @exprs2 @b---instance (meta ~ 'MetaCons label _fixity _isRecord, KnownSymbol label) =>-  GSerializeADT' _Serialize _Columns _htable (M1 C meta U1) (M1 C meta U1)- where-  gfromResultADT' _ tag columns-    | tag columns == tag' = Just (M1 U1)-    | otherwise = Nothing-    where-      tag' = Tag $ pack $ symbolVal (Proxy @label)--  gtoResultADT' _ tag _ = tag tag'-    where-      tag' = Tag $ pack $ symbolVal (Proxy @label)--  extract = id---instance {-# OVERLAPPABLE #-}-  ( HTable (GColumns _Columns exprs)-  , GSerialize _Serialize _Columns exprs rep-  , meta ~ 'MetaCons label _fixity _isRecord-  , KnownSymbol label-  , GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) exprs) ~-      HProduct htable (HLabel label (HNullify (GColumns _Columns exprs)))-  )-  => GSerializeADT' _Serialize _Columns htable (M1 C meta exprs) (M1 C meta rep)- where-  gfromResultADT' fromResult tag (HProduct a b)-    | tag a == tag' =-        M1 . gfromResult @_Serialize @_Columns @exprs @rep fromResult <$>-          hunnullify unnullifier (hunlabel b)-    | otherwise = Nothing-    where-      tag' = Tag $ pack $ symbolVal (Proxy @label)--  gtoResultADT' toResult tag = \case-    Nothing -> HProduct (tag tag') (hlabel (hnulls (const null)))-    Just (M1 rep) -> HProduct (tag tag') $-      hlabel $-      hnullify nullifier $-      gtoResult @_Serialize @_Columns @exprs @rep toResult rep-    where-      tag' = Tag $ pack $ symbolVal (Proxy @label)--  extract (HProduct a _) = a

@@ -1,181 +0,0 @@-{-# language AllowAmbiguousTypes #-}-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language FlexibleInstances #-}-{-# language MultiParamTypeClasses #-}-{-# language PolyKinds #-}-{-# language RankNTypes #-}-{-# language ScopedTypeVariables #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeApplications #-}-{-# language TypeFamilies #-}-{-# language TypeOperators #-}-{-# language UndecidableInstances #-}--module Rel8.Generic.Table.Record-  ( GTable, GColumns, GContext, gfromColumns, gtoColumns, gtable-  , GSerialize, gfromResult, gtoResult-  )-where---- base-import Data.Kind ( Constraint, Type )-import Data.Proxy ( Proxy( Proxy ) )-import GHC.Generics-  ( (:*:)( (:*:) ), K1( K1 ), M1( M1 )-  , C, D, S-  , Meta( MetaSel )-  )-import Prelude hiding ( null )---- rel8-import Rel8.FCF ( Eval, Exp )-import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )-import Rel8.Schema.HTable.Product ( HProduct(..) )-import qualified Rel8.Schema.Kind as K---type GColumns :: (Type -> Exp K.HTable) -> (Type -> Type) -> K.HTable-type family GColumns _Columns rep where-  GColumns _Columns (M1 D _ rep) = GColumns _Columns rep-  GColumns _Columns (M1 C _ rep) = GColumns _Columns rep-  GColumns _Columns (rep1 :*: rep2) =-    HProduct (GColumns _Columns rep1) (GColumns _Columns rep2)-  GColumns _Columns (M1 S ('MetaSel ('Just label) _ _ _) (K1 _ a)) =-    HLabel label (Eval (_Columns a))---type GContext :: (Type -> Exp K.Context) -> (Type -> Type) -> K.Context-type family GContext _Context rep where-  GContext _Context (M1 _ _ rep) = GContext _Context rep-  GContext _Context (rep1 :*: _rep2) = GContext _Context rep1-  GContext _Context (K1 _ a) = Eval (_Context a)---type GTable-  :: (Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Type) -> Constraint-class GTable _Table _Columns rep- where-  gfromColumns :: ()-    => (forall a. Eval (_Table a) => Eval (_Columns a) context -> a)-    -> GColumns _Columns rep context-    -> rep x--  gtoColumns :: ()-    => (forall a. Eval (_Table a) => a -> Eval (_Columns a) context)-    -> rep x-    -> GColumns _Columns rep context--  gtable :: ()-    => (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)-    -> GColumns _Columns rep context---type GSerialize-  :: (Type -> Type -> Exp Constraint)-  -> (Type -> Exp K.HTable)-  -> (Type -> Type) -> (Type -> Type) -> Constraint-class GSerialize _Serialize _Columns exprs rep- where-  gfromResult :: ()-    => (forall expr a proxy. Eval (_Serialize expr a)-        => proxy expr -> Eval (_Columns expr) context -> a)-    -> GColumns _Columns exprs context-    -> rep x--  gtoResult :: ()-    => (forall expr a proxy. Eval (_Serialize expr a)-        => proxy expr -> a -> Eval (_Columns expr) context)-    -> rep x-    -> GColumns _Columns exprs context---instance GTable _Table _Columns rep => GTable _Table _Columns (M1 D c rep)- where-  gfromColumns fromColumns =-    M1 . gfromColumns @_Table @_Columns @rep fromColumns-  gtoColumns toColumns (M1 a) =-    gtoColumns @_Table @_Columns @rep toColumns a-  gtable = gtable @_Table @_Columns @rep---instance GSerialize _Serialize _Columns exprs rep =>-  GSerialize _Serialize _Columns (M1 D c exprs) (M1 D c rep)- where-  gfromResult fromResult =-    M1 . gfromResult @_Serialize @_Columns @exprs @rep fromResult-  gtoResult toResult (M1 a) =-    gtoResult @_Serialize @_Columns @exprs @rep toResult a---instance GTable _Table _Columns rep => GTable _Table _Columns (M1 C c rep)- where-  gfromColumns fromColumns =-    M1 . gfromColumns @_Table @_Columns @rep fromColumns-  gtoColumns toColumns (M1 a) =-    gtoColumns @_Table @_Columns @rep toColumns a-  gtable = gtable @_Table @_Columns @rep---instance GSerialize _Serialize _Columns exprs rep =>-  GSerialize _Serialize _Columns (M1 C c exprs) (M1 C c rep)- where-  gfromResult fromResult =-    M1 . gfromResult @_Serialize @_Columns @exprs @rep fromResult-  gtoResult toResult (M1 a) =-    gtoResult @_Serialize @_Columns @exprs @rep toResult a---instance (GTable _Table _Columns rep1, GTable _Table _Columns rep2) =>-  GTable _Table _Columns (rep1 :*: rep2)- where-  gfromColumns fromColumns (HProduct a b) =-    gfromColumns @_Table @_Columns @rep1 fromColumns a :*:-    gfromColumns @_Table @_Columns @rep2 fromColumns b-  gtoColumns toColumns (a :*: b) = HProduct-    (gtoColumns @_Table @_Columns @rep1 toColumns a)-    (gtoColumns @_Table @_Columns @rep2 toColumns b)-  gtable table = HProduct-    (gtable @_Table @_Columns @rep1 table)-    (gtable @_Table @_Columns @rep2 table)---instance-  ( GSerialize _Serialize _Columns expr1 rep1-  , GSerialize _Serialize _Columns expr2 rep2-  )-  => GSerialize _Serialize _Columns (expr1 :*: expr2) (rep1 :*: rep2)- where-  gfromResult fromResult (HProduct a b) =-    gfromResult @_Serialize @_Columns @expr1 @rep1 fromResult a :*:-    gfromResult @_Serialize @_Columns @expr2 @rep2 fromResult b-  gtoResult toResult (a :*: b) =-    HProduct-      (gtoResult @_Serialize @_Columns @expr1 @rep1 toResult a)-      (gtoResult @_Serialize @_Columns @expr2 @rep2 toResult b)---instance-  ( Eval (_Table a)-  , meta ~ 'MetaSel ('Just label) _su _ss _ds-  , k1 ~ K1 i a-  )-  => GTable _Table _Columns (M1 S meta k1)- where-  gfromColumns fromColumns = M1 . K1 . fromColumns . hunlabel-  gtoColumns toColumns (M1 (K1 a)) = hlabel (toColumns a)-  gtable table = hlabel (table (Proxy @a))---instance-  ( Eval (_Serialize expr a)-  , meta ~ 'MetaSel ('Just label) _su _ss _ds-  , k1 ~ K1 i expr-  , k1' ~ K1 i a-  )-  => GSerialize _Serialize _Columns (M1 S meta k1) (M1 S meta k1')- where-  gfromResult fromResult = M1 . K1 . fromResult (Proxy @expr) . hunlabel-  gtoResult toResult (M1 (K1 a)) = hlabel (toResult (Proxy @expr) a)

@@ -1,38 +0,0 @@-{-# language DataKinds #-}-{-# language FlexibleContexts #-}-{-# language GADTs #-}-{-# language StandaloneKindSignatures #-}--module Rel8.Kind.Algebra-  ( Algebra( Product, Sum )-  , SAlgebra( SProduct, SSum )-  , KnownAlgebra( algebraSing )-  )-where---- base-import Data.Kind ( Constraint, Type )-import Prelude ()---type Algebra :: Type-data Algebra = Product | Sum---type SAlgebra :: Algebra -> Type-data SAlgebra algebra where-  SProduct :: SAlgebra 'Product-  SSum :: SAlgebra 'Sum---type KnownAlgebra :: Algebra -> Constraint-class KnownAlgebra algebra where-  algebraSing :: SAlgebra algebra---instance KnownAlgebra 'Product where-  algebraSing = SProduct---instance KnownAlgebra 'Sum where-  algebraSing = SSum

@@ -1,50 +0,0 @@-{-# language DataKinds #-}-{-# language GADTs #-}-{-# language StandaloneKindSignatures #-}-{-# language TypeSynonymInstances #-}--module Rel8.Kind.Context-  ( Reifiable( contextSing )-  , SContext(..)-  )-where---- base-import Data.Kind ( Constraint, Type )-import Prelude ()---- rel8-import Rel8.Expr ( Expr )-import Rel8.Schema.Field ( Field )-import Rel8.Schema.Kind ( Context )-import Rel8.Schema.Name ( Name )-import Rel8.Schema.Result ( Result )---type SContext :: Context -> Type-data SContext context where-  SExpr :: SContext Expr-  SField :: SContext (Field table)-  SName :: SContext Name-  SResult :: SContext Result---type Reifiable :: Context -> Constraint-class Reifiable context where-  contextSing :: SContext context---instance Reifiable Expr where-  contextSing = SExpr---instance Reifiable (Field table) where-  contextSing = SField---instance Reifiable Result where-  contextSing = SResult---instance Reifiable Name where-  contextSing = SName

@@ -1,30 +0,0 @@-{-# language DerivingStrategies #-}-{-# language GeneralizedNewtypeDeriving #-}-{-# language StandaloneKindSignatures #-}--module Rel8.Order-  ( Order(..)-  )-where---- base-import Data.Functor.Contravariant ( Contravariant )-import Data.Kind ( Type )-import Prelude---- contravariant-import Data.Functor.Contravariant.Divisible ( Decidable, Divisible )---- opaleye-import qualified Opaleye.Order as Opaleye----- | An ordering expression for @a@. Primitive orderings are defined with--- 'Rel8.asc' and 'Rel8.desc', and you can combine @Order@ via its various--- instances.------ A common pattern is to use '<>' to combine multiple orderings in sequence,--- and 'Data.Functor.Contravariant.>$<' to select individual columns.-type Order :: Type -> Type-newtype Order a = Order (Opaleye.Order a)-  deriving newtype (Contravariant, Divisible, Decidable, Semigroup, Monoid)

@@ -1,223 +0,0 @@-{-# language FlexibleContexts #-}-{-# language StandaloneKindSignatures #-}-{-# language UndecidableInstances #-}--module Rel8.Query-  ( Query( Query )-  )-where---- base-import Control.Applicative ( liftA2 )-import Control.Monad ( liftM2 )-import Data.Kind ( Type )-import Data.Monoid ( Any( Any ) )-import Prelude---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye-import qualified Opaleye.Internal.PackMap as Opaleye-import qualified Opaleye.Internal.PrimQuery as Opaleye hiding (lateral)-import qualified Opaleye.Internal.QueryArr as Opaleye-import qualified Opaleye.Internal.Tag as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Query.Set ( unionAll )-import Rel8.Query.Opaleye ( fromOpaleye )-import Rel8.Query.Values ( values )-import Rel8.Table ( Table, fromColumns, toColumns )-import Rel8.Table.Alternative-  ( AltTable, (<|>:)-  , AlternativeTable, emptyTable-  )-import Rel8.Table.Projection ( Projectable, apply, project )---- semigroupoids-import Data.Functor.Apply ( Apply, (<.>) )-import Data.Functor.Bind ( Bind, (>>-) )----- | The @Query@ monad allows you to compose a @SELECT@ query. This monad has--- semantics similar to the list (@[]@) monad.-type Query :: Type -> Type-newtype Query a =-  Query (-    -- This is based on Opaleye's Select monad, but with two addtions. We-    -- maintain a stack of PrimExprs from parent previous subselects. In-    -- practice, these are always the results of dummy calls to random().-    ---    -- We also return a Bool that indicates to the parent subselect whether-    -- or not that stack of PrimExprs were used at any point. If they weren't,-    -- then the call to random() is never added to the query.-    ---    -- This is all needed to implement evaluate. Consider the following code:-    ---    -- do-    --   x <- values [lit 'a', lit 'b', lit 'c']-    --   y <- evaluate $ nextval "user_id_seq"-    --   pure (x, y)-    ---    -- If we just used Opaleye's Select monad directly, the SQL would come out-    -- like this:-    ---    -- SELECT-    --   a, b-    -- FROM-    --   (VALUES ('a'), ('b'), ('c')) Q1(a),-    --   LATERAL (SELECT nextval('user_id_seq')) Q2(b);-    ---    -- From the Haskell code, you would intuitively expect to get back the-    -- results of three different calls to nextval(), but from Postgres' point-    -- of view, because the Q2 subquery doesn't reference anything from the Q1-    -- query, it thinks it only needs to call nextval() once. This is actually-    -- exactly the same problem you get with the deprecated ListT IO monad from-    -- the transformers package — *> behaves differently to >>=, so-    -- using ApplicativeDo can change the results of a program. ApplicativeDo-    -- is exactly the optimisation Postgres does on a "LATERAL" query that-    -- doesn't make any references to previous subselects.-    ---    -- Rel8's solution is generate the following SQL instead:-    ---    -- SELECT-    --   a, b-    -- FROM-    --   (SELECT-    --      random() AS dummy,-    --      *-    --    FROM-    --      (VALUES ('a'), ('b'), ('c')) Q1(a)) Q1,-    --   LATERAL (SELECT-    --     CASE-    --       WHEN dummy IS NOT NULL-    --       THEN nextval('user_id_seq')-    --     END) Q2(b);-    ---    -- We use random() here as the dummy value (and not some constant) because-    -- Postgres will again optimize if it sees that a value is constant-    -- (and thus only call nextval() once), but because random() is marked as-    -- VOLATILE, this inhibits Postgres from doing that optimisation.-    ---    -- Why not just reference the a column from the previous query directly-    -- instead of adding a dummy value? Basically, even if we extract out all-    -- the bindings introduced in a PrimQuery, we can't always be sure which-    -- ones refer to constant values, so if we end up laterally referencing a-    -- constant value, then all of this would be for nothing.-    ---    -- Why not just add the call to the previous subselect directly, like so:-    ---    -- SELECT-    --   a, b-    -- FROM-    --   (SELECT-    --      nextval('user_id_seq') AS eval,-    --      *-    --    FROM-    --      (VALUES ('a'), ('b'), ('c')) Q1(a)) Q1,-    --   LATERAL (SELECT eval) Q2(b);-    ---    -- That would work in this case. But consider the following Rel8 code:-    ---    -- do-    --   x <- values [lit 'a', lit 'b', lit 'c']-    --   y <- values [lit 'd', lit 'e', lit 'f']-    --   z <- evaluate $ nextval "user_id_seq"-    --   pure (x, y, z)-    ---    -- How many calls to nextval should there be? Our Haskell intuition says-    -- nine. But that's not what you would get if you used the above-    -- technique. The problem is, which VALUES query should the nextval be-    -- added to? You can choose one or the other to get three calls to-    -- nextval, but you still need to make a superfluous LATERAL references to-    -- the other if you want nine calls. So for the above Rel8 code we generate-    -- the following SQL:-    ---    -- SELECT-    --   a, b, c-    -- FROM-    --   (SELECT-    --      random() AS dummy,-    --      *-    --    FROM-    --      (VALUES ('a'), ('b'), ('c')) Q1(a)) Q1,-    --   (SELECT-    --      random() AS dummy,-    --      *-    --    FROM-    --      (VALUES ('d'), ('e'), ('f')) Q2(b)) Q2,-    --   LATERAL (SELECT-    --     CASE-    --       WHEN Q1.dummy IS NOT NULL AND Q2.dummy IS NOT NULL-    --       THEN nextval('user_id_seq')-    --     END) Q3(c);-    ---    -- This gives nine calls to nextval() as we would expect.-    [Opaleye.PrimExpr] -> Opaleye.Select (Any, a)-  )---instance Projectable Query where-  project f = fmap (fromColumns . apply f . toColumns)---instance Functor Query where-  fmap f (Query a) = Query (fmap (fmap (fmap f)) a)---instance Apply Query where-  (<.>) = (<*>)---instance Applicative Query where-  pure = fromOpaleye . pure-  liftA2 = liftM2---instance Bind Query where-  (>>-) = (>>=)---instance Monad Query where-  Query q >>= f = Query $ \dummies -> Opaleye.stateQueryArr $ \_ tag ->-    let-      qa = q dummies-      ((m, a), query, tag') = Opaleye.runStateQueryArr qa () tag-      Query q' = f a-      (dummies', query', tag'') =-        ( dummy : dummies-        , query <> Opaleye.aRebind bindings-        , Opaleye.next tag'-        )-        where-          (dummy, bindings) = Opaleye.run $ name random-            where-              random = Opaleye.FunExpr "random" []-              name = Opaleye.extractAttr "dummy" tag'-      qa' = Opaleye.lateral $ \_ -> q' dummies'-      ((m'@(Any needsDummies), b), query'', tag''') = Opaleye.runStateQueryArr qa' () tag''-      query'''-        | needsDummies = query' <> query''-        | otherwise = query <> query''-      m'' = m <> m'-    in-      ((m'', b), query''', tag''')----- | '<|>:' = 'unionAll'.-instance AltTable Query where-  (<|>:) = unionAll----- | 'emptyTable' = 'values' @[]@.-instance AlternativeTable Query where-  emptyTable = values []----- | '<>' = 'unionAll'.-instance Table Expr a => Semigroup (Query a) where-  (<>) = (<|>:)----- | 'mempty' = @'values' []@.-instance Table Expr a => Monoid (Query a) where-  mempty = emptyTable

@@ -1,19 +0,0 @@-{-# language StandaloneKindSignatures #-}--module Rel8.Query-  ( Query( Query )-  )-where---- base-import Data.Kind ( Type )-import Data.Monoid ( Any )-import Prelude ()---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye-import qualified Opaleye.Select as Opaleye---type Query :: Type -> Type-newtype Query a = Query ([Opaleye.PrimExpr] -> Opaleye.Select (Any, a))

@@ -1,59 +0,0 @@-{-# language FlexibleContexts #-}-{-# language MonoLocalBinds #-}-{-# language ScopedTypeVariables #-}--module Rel8.Query.Aggregate-  ( aggregate-  , aggregate1-  , aggregateU-  , countRows-  )-where---- base-import Control.Applicative (liftA2)-import Data.Int ( Int64 )-import Prelude---- opaleye-import qualified Opaleye.Adaptors as Opaleye-import qualified Opaleye.Aggregate as Opaleye---- rel8-import Rel8.Aggregate (Aggregator' (Aggregator), Aggregator)-import Rel8.Aggregate.Fold (Fallback (Fallback))-import Rel8.Expr ( Expr )-import Rel8.Expr.Aggregate ( countStar )-import Rel8.Expr.Bool (true)-import Rel8.Query ( Query )-import Rel8.Query.Maybe ( optional )-import Rel8.Query.Opaleye ( mapOpaleye )-import Rel8.Table (Table)-import Rel8.Table.Maybe (fromMaybeTable)-import Rel8.Table.Opaleye (unpackspec)----- | Apply an 'Aggregator' to all rows returned by a 'Query'. If the 'Query'--- is empty, then a single \"fallback\" row is returned, composed of the--- identity elements of the constituent aggregation functions.-aggregate :: (Table Expr i, Table Expr a) => Aggregator i a -> Query i -> Query a-aggregate aggregator@(Aggregator (Fallback fallback) _) =-  fmap (fromMaybeTable fallback) . optional . aggregate1 aggregator----- | Apply an 'Rel8.Aggregator1' to all rows returned by a 'Query'. If--- the 'Query' is empty, then zero rows are returned.-aggregate1 :: Table Expr i => Aggregator' fold i a -> Query i -> Query a-aggregate1 = aggregateU unpackspec---aggregateU :: Opaleye.Unpackspec i i -> Aggregator' fold i a -> Query i -> Query a-aggregateU unpack (Aggregator _ aggregator) =-  mapOpaleye (Opaleye.aggregateExplicit unpack aggregator)----- | Count the number of rows returned by a query. Note that this is different--- from @countStar@, as even if the given query yields no rows, @countRows@--- will return @0@.-countRows :: Query a -> Query (Expr Int64)-countRows = aggregate countStar . (true <$)

@@ -1,40 +0,0 @@-module Rel8.Query.Distinct-  ( distinct-  , distinctOn-  , distinctOnBy-  )-where---- base-import Prelude ()---- opaleye-import qualified Opaleye.Distinct as Opaleye-import qualified Opaleye.Order as Opaleye---- rel8-import Rel8.Order ( Order( Order ) )-import Rel8.Query ( Query )-import Rel8.Query.Opaleye ( mapOpaleye )-import Rel8.Table.Eq ( EqTable )-import Rel8.Table.Opaleye (distinctspec, unpackspec)----- | Select all distinct rows from a query, removing duplicates.  @distinct q@--- is equivalent to the SQL statement @SELECT DISTINCT q@.-distinct :: EqTable a => Query a -> Query a-distinct = mapOpaleye (Opaleye.distinctExplicit unpackspec distinctspec)----- | Select all distinct rows from a query, where rows are equivalent according--- to a projection. If multiple rows have the same projection, it is--- unspecified which row will be returned. If this matters, use 'distinctOnBy'.-distinctOn :: EqTable b => (a -> b) -> Query a -> Query a-distinctOn proj = mapOpaleye (Opaleye.distinctOnExplicit unpackspec proj)----- | Select all distinct rows from a query, where rows are equivalent according--- to a projection. If there are multiple rows with the same projection, the--- first row according to the specified 'Order' will be returned.-distinctOnBy :: EqTable b => (a -> b) -> Order a -> Query a -> Query a-distinctOnBy proj (Order order) = mapOpaleye (Opaleye.distinctOnByExplicit unpackspec proj order)

@@ -1,32 +0,0 @@-{-# language FlexibleContexts #-}-{-# language MonoLocalBinds #-}--module Rel8.Query.Each-  ( each-  )-where---- base-import Prelude---- opaleye-import qualified Opaleye.Table as Opaleye---- rel8-import Rel8.Query ( Query )-import Rel8.Query.Opaleye ( fromOpaleye )-import Rel8.Schema.Name ( Selects )-import Rel8.Schema.Table ( TableSchema )-import Rel8.Table.Cols ( fromCols, toCols )-import Rel8.Table.Opaleye ( table, unpackspec )----- | Select each row from a table definition. This is equivalent to @FROM--- table@.-each :: Selects names exprs => TableSchema names -> Query exprs-each =-  fmap fromCols .-  fromOpaleye .-  Opaleye.selectTableExplicit unpackspec .-  table .-  fmap toCols

@@ -1,69 +0,0 @@-{-# language FlexibleContexts #-}--module Rel8.Query.Either-  ( keepLeftTable-  , keepRightTable-  , bitraverseEitherTable-  )-where---- base-import Prelude---- comonad-import Control.Comonad ( extract )---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Eq ( (==.) )-import Rel8.Query ( Query )-import Rel8.Query.Filter ( where_ )-import Rel8.Query.Maybe ( optional )-import Rel8.Table.Either-  ( EitherTable( EitherTable )-  , isLeftTable, isRightTable-  )-import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )----- | Filter 'EitherTable's, keeping only 'leftTable's.-keepLeftTable :: EitherTable Expr a b -> Query a-keepLeftTable e@(EitherTable _ a _) = do-  where_ $ isLeftTable e-  pure (extract a)----- | Filter 'EitherTable's, keeping only 'rightTable's.-keepRightTable :: EitherTable Expr a b -> Query b-keepRightTable e@(EitherTable _ _ b) = do-  where_ $ isRightTable e-  pure (extract b)----- | @bitraverseEitherTable f g x@ will pass all @leftTable@s through @f@ and--- all @rightTable@s through @g@. The results are then lifted back into--- @leftTable@ and @rightTable@, respectively. This is similar to 'bitraverse'--- for 'Either'.------ For example,------ >>> :{--- select do---   x <- values (map lit [ Left True, Right (42 :: Int32) ])---   bitraverseEitherTable (\y -> values [y, not_ y]) (\y -> pure (y * 100)) x--- :}--- [ Left True--- , Left False--- , Right 4200--- ]-bitraverseEitherTable :: ()-  => (a -> Query c)-  -> (b -> Query d)-  -> EitherTable Expr a b-  -> Query (EitherTable Expr c d)-bitraverseEitherTable f g e@(EitherTable tag _ _) = do-  mc@(MaybeTable _ c) <- optional (f =<< keepLeftTable e)-  md@(MaybeTable _ d) <- optional (g =<< keepRightTable e)-  where_ $ isJustTable mc ==. isLeftTable e-  where_ $ isJustTable md ==. isRightTable e-  pure $ EitherTable tag c d

@@ -1,49 +0,0 @@-{-# language FlexibleContexts #-}-{-# language TupleSections #-}--module Rel8.Query.Evaluate-  ( evaluate-  )-where---- base-import Control.Monad ( (>=>) )-import Data.Foldable ( foldl' )-import Data.List.NonEmpty ( NonEmpty( (:|) ), nonEmpty )-import Data.Monoid ( Any( Any ) )-import Prelude hiding ( undefined )---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Bool ( (&&.) )-import Rel8.Expr.Opaleye ( fromPrimExpr )-import Rel8.Query ( Query( Query ) )-import Rel8.Query.Rebind ( rebind )-import Rel8.Table ( Table )-import Rel8.Table.Bool ( case_ )-import Rel8.Table.Undefined ( undefined )----- | 'evaluate' takes expressions that could potentially have side effects and--- \"runs\" them in the 'Query' monad. The returned expressions have no side--- effects and can safely be reused.-evaluate :: Table Expr a => a -> Query a-evaluate = laterally >=> rebind "eval"---laterally :: Table Expr a => a -> Query a-laterally a = Query $ \bindings -> pure $ (Any True,) $-  case nonEmpty bindings of-    Nothing -> a-    Just bindings' -> case_ [(condition, a)] undefined-      where-        condition = foldl1' (&&.) (fmap go bindings')-          where-            go = fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNotNull---foldl1' :: (a -> a -> a) -> NonEmpty a -> a-foldl1' f (a :| as) = foldl' f a as

@@ -1,66 +0,0 @@-{-# language DataKinds #-}--module Rel8.Query.Exists-  ( exists, inQuery-  , present, with, withBy-  , absent, without, withoutBy-  )-where---- base-import Prelude hiding ( filter )---- opaleye-import qualified Opaleye.Exists as Opaleye-import qualified Opaleye.Operators as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr )-import Rel8.Query ( Query )-import Rel8.Query.Filter ( filter )-import Rel8.Query.Opaleye ( mapOpaleye )-import Rel8.Table.Eq ( EqTable, (==:) )----- | Checks if a query returns at least one row.-exists :: Query a -> Query (Expr Bool)-exists = fmap (fromPrimExpr . fromColumn) . mapOpaleye Opaleye.exists---inQuery :: EqTable a => a -> Query a -> Query (Expr Bool)-inQuery a = exists . (>>= filter (a ==:))----- | Produce the empty query if the given query returns no rows. @present@--- is equivalent to @WHERE EXISTS@ in SQL.-present :: Query a -> Query ()-present = mapOpaleye Opaleye.restrictExists----- | Produce the empty query if the given query returns rows. @absent@--- is equivalent to @WHERE NOT EXISTS@ in SQL.-absent :: Query a -> Query ()-absent = mapOpaleye Opaleye.restrictNotExists----- | @with@ is similar to 'filter', but allows the predicate to be a full query.------ @with f a = a <$ present (f a)@, but this form matches 'filter'.-with :: (a -> Query b) -> a -> Query a-with f a = a <$ present (f a)----- | Like @with@, but with a custom membership test.-withBy :: (a -> b -> Expr Bool) -> Query b -> a -> Query a-withBy predicate bs = with $ \a -> bs >>= filter (predicate a)----- | Filter rows where @a -> Query b@ yields no rows.-without :: (a -> Query b) -> a -> Query a-without f a = a <$ absent (f a)----- | Like @without@, but with a custom membership test.-withoutBy :: (a -> b -> Expr Bool) -> Query b -> a -> Query a-withoutBy predicate bs = without $ \a -> bs >>= filter (predicate a)

@@ -1,35 +0,0 @@-module Rel8.Query.Filter-  ( filter-  , where_-  )-where---- base-import Prelude hiding ( filter )---- opaleye-import qualified Opaleye.Operators as Opaleye---- profunctors-import Data.Profunctor ( lmap )---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )-import Rel8.Query ( Query )-import Rel8.Query.Opaleye ( fromOpaleye )----- | @filter f x@ will be a zero-row query when @f x@ is @False@, and will--- return @x@ unchanged when @f x@ is @True@. This is similar to--- 'Control.Monad.guard', but as the predicate is separate from the argument,--- it is easy to use in a pipeline of 'Query' transformations.-filter :: (a -> Expr Bool) -> a -> Query a-filter f a = a <$ where_ (f a)----- | Drop any rows that don't match a predicate.  @where_ expr@ is equivalent--- to the SQL @WHERE expr@.-where_ :: Expr Bool -> Query ()-where_ condition =-  fromOpaleye $ lmap (\_ -> toColumn $ toPrimExpr condition) Opaleye.restrict

@@ -1,32 +0,0 @@-{-# language FlexibleContexts #-}-{-# language MonoLocalBinds #-}--module Rel8.Query.Function-  ( queryFunction-  )-where---- base-import Prelude---- opaleye-import qualified Opaleye.Internal.Operators as Opaleye---- rel8-import Rel8.Expr (Expr)-import Rel8.Expr.Function (Arguments, primFunction)-import Rel8.Query (Query)-import Rel8.Query.Opaleye (fromOpaleye)-import Rel8.Schema.QualifiedName (QualifiedName)-import Rel8.Table (Table)-import Rel8.Table.Opaleye (castTable, relExprPP)----- | Select each row from a function that returns a relation. This is--- equivalent to @FROM function(input)@.-queryFunction :: (Arguments input, Table Expr output)-  => QualifiedName -> input -> Query output-queryFunction name input = fmap castTable $ fromOpaleye $-  Opaleye.relationValuedExprExplicit relExprPP (const expr)-  where-    expr = primFunction name input

@@ -1,21 +0,0 @@-module Rel8.Query.Indexed-  ( indexed-  )-where---- base-import Control.Applicative ( liftA2 )-import Data.Int ( Int64 )-import Prelude---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Window ( rowNumber )-import Rel8.Query ( Query )-import Rel8.Query.Window ( window )-import Rel8.Table.Window ( currentRow )----- | Pair each row of a query with its index within the query.-indexed :: Query a -> Query (Expr Int64, a)-indexed = window (liftA2 (,) (subtract 1 <$> rowNumber) currentRow)

@@ -1,27 +0,0 @@-module Rel8.Query.Limit-  ( limit-  , offset-  )-where---- base-import Prelude---- opaleye-import qualified Opaleye---- rel8-import Rel8.Query ( Query )-import Rel8.Query.Opaleye ( mapOpaleye )----- | @limit n@ select at most @n@ rows from a query.  @limit n@ is equivalent--- to the SQL @LIMIT n@.-limit :: Word -> Query a -> Query a-limit = mapOpaleye . Opaleye.limit . fromIntegral----- | @offset n@ drops the first @n@ rows from a query. @offset n@ is equivalent--- to the SQL @OFFSET n@.-offset :: Word -> Query a -> Query a-offset = mapOpaleye . Opaleye.offset . fromIntegral

@@ -1,124 +0,0 @@-{-# language FlexibleContexts #-}-{-# language GADTs #-}-{-# language NamedFieldPuns #-}--module Rel8.Query.List-  ( many, some-  , manyExpr, someExpr-  , catListTable, catNonEmptyTable-  , catList, catNonEmpty-  )-where---- base-import Control.Monad ((>=>))-import Data.Functor.Identity ( runIdentity )-import Data.List.NonEmpty ( NonEmpty )-import Prelude---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )-import Rel8.Expr.Opaleye ( mapPrimExpr )-import Rel8.Query ( Query )-import Rel8.Query.Aggregate (aggregate, aggregate1)-import Rel8.Query.Rebind (hrebind, rebind)-import Rel8.Schema.HTable (HTable, hfield, hspecs, htabulate)-import Rel8.Schema.HTable.Vectorize ( hunvectorize )-import Rel8.Schema.Null ( Sql )-import Rel8.Schema.Spec ( Spec( Spec, info ) )-import Rel8.Table (Table, fromColumns, toColumns)-import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg )-import Rel8.Table.List ( ListTable( ListTable ) )-import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )-import Rel8.Type ( DBType )-import Rel8.Type.Array ( extractArrayElement )----- | Aggregate a 'Query' into a 'ListTable'. If the supplied query returns 0--- rows, this function will produce a 'Query' that returns one row containing--- the empty @ListTable@. If the supplied @Query@ does return rows, @many@ will--- return exactly one row, with a @ListTable@ collecting all returned rows.------ @many@ is analogous to 'Control.Applicative.many' from--- @Control.Applicative@.-many :: Table Expr a => Query a -> Query (ListTable Expr a)-many = aggregate listAgg----- | Aggregate a 'Query' into a 'NonEmptyTable'. If the supplied query returns--- 0 rows, this function will produce a 'Query' that is empty - that is, will--- produce zero @NonEmptyTable@s. If the supplied @Query@ does return rows,--- @some@ will return exactly one row, with a @NonEmptyTable@ collecting all--- returned rows.------ @some@ is analogous to 'Control.Applicative.some' from--- @Control.Applicative@.-some :: Table Expr a => Query a -> Query (NonEmptyTable Expr a)-some = aggregate1 nonEmptyAgg----- | A version of 'many' specialised to single expressions.-manyExpr :: Sql DBType a => Query (Expr a) -> Query (Expr [a])-manyExpr = aggregate listAggExpr----- | A version of 'many' specialised to single expressions.-someExpr :: Sql DBType a => Query (Expr a) -> Query (Expr (NonEmpty a))-someExpr = aggregate1 nonEmptyAggExpr----- | Expand a 'ListTable' into a 'Query', where each row in the query is an--- element of the given @ListTable@.------ @catListTable@ is an inverse to 'many'.-catListTable :: Table Expr a => ListTable Expr a -> Query a-catListTable (ListTable as) =-  fmap fromColumns $ (hrebind "unnest" >=> hextract) $ runIdentity $-    hunvectorize (\_ -> pure . unnest) as----- | Expand a 'NonEmptyTable' into a 'Query', where each row in the query is an--- element of the given @NonEmptyTable@.------ @catNonEmptyTable@ is an inverse to 'some'.-catNonEmptyTable :: Table Expr a => NonEmptyTable Expr a -> Query a-catNonEmptyTable (NonEmptyTable as) =-  fmap fromColumns $ (hrebind "unnest" >=> hextract) $ runIdentity $-    hunvectorize (\_ -> pure . unnest) as----- | Expand an expression that contains a list into a 'Query', where each row--- in the query is an element of the given list.------ @catList@ is an inverse to 'manyExpr'.-catList :: Sql DBType a => Expr [a] -> Query (Expr a)-catList = rebind "unnest" . unnest >=> extract----- | Expand an expression that contains a non-empty list into a 'Query', where--- each row in the query is an element of the given list.------ @catNonEmpty@ is an inverse to 'someExpr'.-catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)-catNonEmpty = rebind "unnest" . unnest >=> extract---unnest :: Expr (list a) -> Expr a-unnest = mapPrimExpr $ Opaleye.UnExpr (Opaleye.UnOpOther "UNNEST")---extract :: Table Expr a => a -> Query a-extract = fmap fromColumns . hextract . toColumns---hextract :: HTable t => t Expr -> Query (t Expr)-hextract = hrebind "extract" . go-  where-    go as = htabulate $ \field ->-      case hfield as field of-        a -> case hfield hspecs field of-          Spec {info} -> mapPrimExpr (extractArrayElement info) a

@@ -1,73 +0,0 @@-{-# language FlexibleContexts #-}--module Rel8.Query.Loop-  ( loop-  , loopDistinct-  ) where---- base-import Prelude---- opaleye-import Opaleye.With (withRecursiveExplicit, withRecursiveDistinctExplicit)---- rel8-import Rel8.Expr ( Expr )-import Rel8.Query ( Query )-import Rel8.Query.Opaleye ( fromOpaleye, toOpaleye )-import Rel8.Table ( Table )-import Rel8.Table.Opaleye ( binaryspec )----- | 'loop' allows the construction of recursive queries, using Postgres'--- [@WITH RECURSIVE@](https://www.postgresql.org/docs/current/queries-with.html#QUERIES-WITH-RECURSIVE)--- under the hood. The first argument to 'loop' is what the Postgres--- documentation refers to as the \"non-recursive term\" and the second--- argument is the \"recursive term\", which is defined in terms of the result--- of the \"non-recursive term\". 'loop' uses @UNION ALL@ to combine the--- recursive and non-recursive terms.------ Denotionally, @'loop' s f@ is the smallest set of rows @r@ such--- that------ @--- r == s \`'Rel8.unionAll'\` (r >>= f)--- @------ Operationally, @'loop' s f@ takes each row in an initial set @s@ and--- supplies it to @f@, resulting in a new generation of rows which are added--- to the result set. Each row from this new generation is then fed back to--- @f@, and this process is repeated until a generation comes along for which--- @f@ returns an empty set for each row therein.-loop :: Table Expr a => Query a -> (a -> Query a) -> Query a-loop base recurse =-  fromOpaleye $ withRecursiveExplicit binaryspec base' recurse'-  where-    base' = toOpaleye base-    recurse' = toOpaleye . recurse----- | 'loopDistinct' is like 'loop' but uses @UNION@ instead of @UNION ALL@ to--- combine the recursive and non-recursive terms.------ Denotationally, @'loopDistinct' s f@ is the smallest set of rows--- @r@ such that------ @--- r == s \`'Rel8.union'\` (r >>= f)--- @------ Operationally, @'loopDistinct' s f@ takes each /distinct/ row in an--- initial set @s@ and supplies it to @f@, resulting in a new generation of--- rows. Any rows returned by @f@ that already exist in the result set are not--- considered part of this new generation by 'loopDistinct' (in contrast to--- 'loop'). This new generation is then added to the result set, and each row--- therein is then fed back to @f@, and this process is repeated until a--- generation comes along for which @f@ returns no rows that don't already--- exist in the result set.-loopDistinct :: Table Expr a => Query a -> (a -> Query a) -> Query a-loopDistinct base recurse =-  fromOpaleye $ withRecursiveDistinctExplicit binaryspec base' recurse'-  where-    base' = toOpaleye base-    recurse' = toOpaleye . recurse

@@ -1,40 +0,0 @@-{-# language FlexibleContexts #-}--module Rel8.Query.Materialize-  ( materialize-  )-where---- base-import Prelude---- opaleye-import Opaleye.With ( withMaterializedExplicit )---- rel8-import Rel8.Expr ( Expr )-import Rel8.Query ( Query )-import Rel8.Query.Opaleye ( fromOpaleye, toOpaleye )-import Rel8.Table ( Table )-import Rel8.Table.Opaleye ( unpackspec )----- | 'materialize' takes a 'Query' and fully evaluates it and caches the--- results thereof, and passes to a continuation a new 'Query' that simply--- looks up these cached results. It's usually best not to use this and to let--- the Postgres optimizer decide for itself what's best, but if you know what--- you're doing this can sometimes help to nudge it in a particular direction.------ 'materialize' is currently implemented in terms of Postgres'--- [@WITH](https://www.postgresql.org/docs/current/queries-with.html) syntax,--- specifically the @WITH _ AS MATERIALIZED (_)@ form introduced in PostgreSQL--- 12. This means that 'materialize' can only be used with PostgreSQL 12 or--- newer.-materialize :: Table Expr a => Query a -> (Query a -> Query b) -> Query b-materialize query f =-  fromOpaleye $-    withMaterializedExplicit unpackspec-      (toOpaleye query')-      (toOpaleye . f . fromOpaleye)-  where-    query' = query

@@ -1,64 +0,0 @@-{-# language GADTs #-}-{-# language LambdaCase #-}-{-# language NamedFieldPuns #-}--module Rel8.Query.Maybe-  ( optional-  , catMaybeTable-  , traverseMaybeTable-  )-where---- base-import Prelude---- comonad-import Control.Comonad ( extract )---- opaleye-import qualified Opaleye.Internal.MaybeFields as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Eq ( (==.) )-import Rel8.Query ( Query )-import Rel8.Query.Filter ( where_ )-import Rel8.Query.Opaleye ( mapOpaleye )-import Rel8.Table.Maybe (MaybeTable(..), isJustTable, makeMaybeTable)----- | Convert a query that might return zero rows to a query that always returns--- at least one row.------ To speak in more concrete terms, 'optional' is most useful to write @LEFT--- JOIN@s.-optional :: Query a -> Query (MaybeTable Expr a)-optional = mapOpaleye $ Opaleye.optionalInternal makeMaybeTable----- | Filter out 'MaybeTable's, returning only the tables that are not-null.------ This operation can be used to "undo" the effect of 'optional', which--- operationally is like turning a @LEFT JOIN@ back into a full @JOIN@.  You--- can think of this as analogous to 'Data.Maybe.catMaybes'.-catMaybeTable :: MaybeTable Expr a -> Query a-catMaybeTable ma@(MaybeTable _ a) = do-  where_ $ isJustTable ma-  pure (extract a)----- | Extend an optional query with another query.  This is useful if you want--- to step through multiple @LEFT JOINs@.------ Note that @traverseMaybeTable@ takes a @a -> Query b@ function, which means--- you also have the ability to "expand" one row into multiple rows.  If the--- @a -> Query b@ function returns no rows, then the resulting query will also--- have no rows. However, regardless of the given @a -> Query b@ function, if--- the input is @nothingTable@, you will always get exactly one @nothingTable@--- back.-traverseMaybeTable :: (a -> Query b) -> MaybeTable Expr  a -> Query (MaybeTable Expr b)-traverseMaybeTable query ma@(MaybeTable input _) = do-  optional (query =<< catMaybeTable ma) >>= \case-    MaybeTable output b -> do-      where_ $ output ==. input-      pure $ MaybeTable input b

@@ -1,38 +0,0 @@-{-# language FlexibleContexts #-}--module Rel8.Query.Null-  ( catNull-  , catNullTable-  )-where---- base-import Prelude---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Null ( isNonNull, unsafeUnnullify )-import Rel8.Table ( Table )-import Rel8.Table.Null ( NullTable, isNonNullTable, unsafeUnnullifyTable )-import Rel8.Query ( Query )-import Rel8.Query.Filter ( where_ )----- | Filter a 'Query' that might return @null@ to a 'Query' without any--- @null@s.------ Corresponds to 'Data.Maybe.catMaybes'.-catNull :: Expr (Maybe a) -> Query (Expr a)-catNull a = do-  where_ $ isNonNull a-  pure $ unsafeUnnullify a----- | Filter a 'Query' that might return @nullTable@ to a 'Query' without any--- @nullTable@s.------ Corresponds to 'Data.Maybe.catMaybes'.-catNullTable :: Table Expr a => NullTable Expr a -> Query a-catNullTable a = do-  where_ $ isNonNullTable a-  pure $ unsafeUnnullifyTable a

@@ -1,70 +0,0 @@-{-# language TupleSections #-}--module Rel8.Query.Opaleye-  ( fromOpaleye-  , toOpaleye-  , mapOpaleye-  , zipOpaleyeWith-  , unsafePeekQuery-  )-where---- base-import Control.Applicative ( liftA2 )-import Prelude---- opaleye-import qualified Opaleye.Internal.QueryArr as Opaleye-import qualified Opaleye.Internal.Tag as Opaleye---- rel8-import {-# SOURCE #-} Rel8.Query ( Query( Query ) )---fromOpaleye :: Opaleye.Select a -> Query a-fromOpaleye = Query . pure . fmap pure---toOpaleye :: Query a -> Opaleye.Select a-toOpaleye (Query a) = snd <$> a mempty---mapOpaleye :: (Opaleye.Select a -> Opaleye.Select b) -> Query a -> Query b-mapOpaleye f (Query a) = Query (fmap (mapping f) a)---zipOpaleyeWith :: ()-  => (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c)-  -> Query a -> Query b -> Query c-zipOpaleyeWith f (Query a) (Query b) = Query $ liftA2 (zipping f) a b---unsafePeekQuery :: Query a -> a-unsafePeekQuery (Query q) = case q mempty of-  f -> case Opaleye.runStateQueryArr f () Opaleye.start of-    ((_, a), _, _) -> a---mapping :: ()-  => (Opaleye.Select a -> Opaleye.Select b)-  -> Opaleye.Select (m, a) -> Opaleye.Select (m, b)-mapping f q = Opaleye.stateQueryArr $ \_ tag ->-  let-    ((m, _), _, _) = Opaleye.runStateQueryArr q () tag-    q' = (m,) <$> f (snd <$> q)-  in-    Opaleye.runStateQueryArr q' () tag---zipping :: Semigroup m-  => (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c)-  -> Opaleye.Select (m, a) -> Opaleye.Select (m, b) -> Opaleye.Select (m, c)-zipping f q q' =-  Opaleye.stateQueryArr $ \_ tag ->-    let-      ((m, _), _, _) = Opaleye.runStateQueryArr q () tag-      ((m', _), _, _) = Opaleye.runStateQueryArr q' () tag-      m'' = m <> m'-      q'' = (m'',) <$> f (snd <$> q) (snd <$> q')-    in-      Opaleye.runStateQueryArr q'' () tag

@@ -1,20 +0,0 @@-module Rel8.Query.Order-  ( orderBy-  )-where---- base-import Prelude ()---- opaleye-import qualified Opaleye.Order as Opaleye ( orderBy )---- rel8-import Rel8.Order ( Order( Order ) )-import Rel8.Query ( Query )-import Rel8.Query.Opaleye ( mapOpaleye )----- | Order the rows returned by a query.-orderBy :: Order a -> Query a -> Query a-orderBy (Order o) = mapOpaleye (Opaleye.orderBy o)

@@ -1,36 +0,0 @@-{-# language FlexibleContexts #-}--module Rel8.Query.Rebind-  ( rebind-  , hrebind-  )-where---- base-import Prelude-import Control.Arrow ((<<<))---- opaleye-import qualified Opaleye.Internal.Rebind as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Query ( Query )-import Rel8.Query.Limit (offset)-import Rel8.Schema.HTable (HTable)-import Rel8.Table ( Table )-import Rel8.Table.Cols (Cols (Cols))-import Rel8.Table.Opaleye ( unpackspec )-import Rel8.Query.Opaleye (fromOpaleye)----- | 'rebind' takes a variable name, some expressions, and binds each of them--- to a new variable in the SQL. The @a@ returned consists only of these--- variables. It's essentially a @let@ binding for Postgres expressions.-rebind :: Table Expr a => String -> a -> Query a-rebind prefix a = offset 0 $-  fromOpaleye (Opaleye.rebindExplicitPrefix prefix unpackspec <<< pure a)---hrebind :: HTable t => String -> t Expr -> Query (t Expr)-hrebind prefix = fmap (\(Cols a) -> a) . rebind prefix . Cols

@@ -1,27 +0,0 @@-{-# language FlexibleContexts #-}-{-# language MonoLocalBinds #-}--module Rel8.Query.SQL-  ( showQuery-  )-where---- base-import Prelude---- opaleye-import qualified Opaleye.Internal.Tag as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Query ( Query )-import Rel8.Statement.Select ( ppSelect )-import Rel8.Table ( Table )---- transformers-import Control.Monad.Trans.State.Strict (evalState)----- | Convert a 'Query' to a 'String' containing a @SELECT@ statement.-showQuery :: Table Expr a => Query a -> String-showQuery = show . (`evalState` Opaleye.start) . ppSelect

@@ -1,58 +0,0 @@-{-# language FlexibleContexts #-}--module Rel8.Query.Set-  ( union, unionAll-  , intersect, intersectAll-  , except, exceptAll-  )-where---- base-import Prelude ()---- opaleye-import qualified Opaleye.Binary as Opaleye---- rel8-import Rel8.Expr ( Expr )-import {-# SOURCE #-} Rel8.Query ( Query )-import Rel8.Query.Opaleye ( zipOpaleyeWith )-import Rel8.Table ( Table  )-import Rel8.Table.Eq ( EqTable )-import Rel8.Table.Opaleye ( binaryspec )----- | Combine the results of two queries of the same type, collapsing--- duplicates.  @union a b@ is the same as the SQL statement @a UNION b@.-union :: EqTable a => Query a -> Query a -> Query a-union = zipOpaleyeWith (Opaleye.unionExplicit binaryspec)----- | Combine the results of two queries of the same type, retaining duplicates.--- @unionAll a b@ is the same as the SQL statement @a UNION ALL b@.-unionAll :: Table Expr a => Query a -> Query a -> Query a-unionAll = zipOpaleyeWith (Opaleye.unionAllExplicit binaryspec)----- | Find the intersection of two queries, collapsing duplicates.  @intersect a--- b@ is the same as the SQL statement @a INTERSECT b@.-intersect :: EqTable a => Query a -> Query a -> Query a-intersect = zipOpaleyeWith (Opaleye.intersectExplicit binaryspec)----- | Find the intersection of two queries, retaining duplicates.  @intersectAll--- a b@ is the same as the SQL statement @a INTERSECT ALL b@.-intersectAll :: EqTable a => Query a -> Query a -> Query a-intersectAll = zipOpaleyeWith (Opaleye.intersectAllExplicit binaryspec)----- | Find the difference of two queries, collapsing duplicates @except a b@ is--- the same as the SQL statement @a EXCEPT b@.-except :: EqTable a => Query a -> Query a -> Query a-except = zipOpaleyeWith (Opaleye.exceptExplicit binaryspec)----- | Find the difference of two queries, retaining duplicates.  @exceptAll a b@--- is the same as the SQL statement @a EXCEPT ALL b@.-exceptAll :: EqTable a => Query a -> Query a -> Query a-exceptAll = zipOpaleyeWith (Opaleye.exceptAllExplicit binaryspec)

@@ -1,138 +0,0 @@-{-# language FlexibleContexts #-}-{-# language GADTs #-}--module Rel8.Query.These-  ( alignBy-  , keepHereTable, loseHereTable-  , keepThereTable, loseThereTable-  , keepThisTable, loseThisTable-  , keepThatTable, loseThatTable-  , keepThoseTable, loseThoseTable-  , bitraverseTheseTable-  )-where---- base-import Prelude---- comonad-import Control.Comonad ( extract )---- opaleye-import qualified Opaleye.Internal.PackMap as Opaleye-import qualified Opaleye.Internal.PrimQuery as Opaleye-import qualified Opaleye.Internal.QueryArr as Opaleye-import qualified Opaleye.Internal.Tag as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Bool ( boolExpr, not_ )-import Rel8.Expr.Eq ( (==.) )-import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )-import Rel8.Expr.Serialize ( litExpr )-import Rel8.Query ( Query )-import Rel8.Query.Filter ( where_ )-import Rel8.Query.Maybe ( optional )-import Rel8.Query.Opaleye ( zipOpaleyeWith )-import Rel8.Table.Either ( EitherTable( EitherTable ) )-import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )-import Rel8.Table.These-  ( TheseTable( TheseTable, here, there )-  , hasHereTable, hasThereTable-  , isThisTable, isThatTable, isThoseTable-  )-import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )----- | Corresponds to a @FULL OUTER JOIN@ between two queries.-alignBy :: ()-  => (a -> b -> Expr Bool)-  -> Query a -> Query b -> Query (TheseTable Expr a b)-alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.stateQueryArr $ \_ t -> case t of-  tag -> (tab, join', tag''')-    where-      (ma, left', tag') = Opaleye.runStateQueryArr (pure <$> left) () tag-      (mb, right', tag'') = Opaleye.runStateQueryArr (pure <$> right) () tag'-      MaybeTable hasHere a = ma-      MaybeTable hasThere b = mb-      (hasHere', lbindings) = Opaleye.run $ do-        traversePrimExpr (Opaleye.extractAttr "hasHere" tag'') hasHere-      (hasThere', rbindings) = Opaleye.run $ do-        traversePrimExpr (Opaleye.extractAttr "hasThere" tag'') hasThere-      tag''' = Opaleye.next tag''-      join = Opaleye.Join Opaleye.FullJoin on left'' right''-        where-          on = toPrimExpr $ condition (extract a) (extract b)-          left'' = (Opaleye.NonLateral, Opaleye.toPrimQuery (left' <> Opaleye.aRebind lbindings))-          right'' = (Opaleye.NonLateral, Opaleye.toPrimQuery (right' <> Opaleye.aRebind rbindings))-      ma' = MaybeTable hasHere' a-      mb' = MaybeTable hasThere' b-      tab = TheseTable {here = ma', there = mb'}-      join' = Opaleye.aProduct join---keepHereTable :: TheseTable Expr a b -> Query (a, MaybeTable Expr b)-keepHereTable = loseThatTable---loseHereTable :: TheseTable Expr a b -> Query b-loseHereTable = keepThatTable---keepThereTable :: TheseTable Expr a b -> Query (MaybeTable Expr a, b)-keepThereTable = loseThisTable---loseThereTable :: TheseTable Expr a b -> Query a-loseThereTable = keepThisTable---keepThisTable :: TheseTable Expr a b -> Query a-keepThisTable t@(TheseTable (MaybeTable _ a) _) = do-  where_ $ isThisTable t-  pure (extract a)---loseThisTable :: TheseTable Expr a b -> Query (MaybeTable Expr a, b)-loseThisTable t@(TheseTable ma (MaybeTable _ b)) = do-  where_ $ not_ $ isThisTable t-  pure (ma, extract b)---keepThatTable :: TheseTable Expr a b -> Query b-keepThatTable t@(TheseTable _ (MaybeTable _ b)) = do-  where_ $ isThatTable t-  pure (extract b)---loseThatTable :: TheseTable Expr a b -> Query (a, MaybeTable Expr b)-loseThatTable t@(TheseTable (MaybeTable _ a) mb) = do-  where_ $ not_ $ isThatTable t-  pure (extract a, mb)---keepThoseTable :: TheseTable Expr a b -> Query (a, b)-keepThoseTable t@(TheseTable (MaybeTable _ a) (MaybeTable _ b)) = do-  where_ $ isThoseTable t-  pure (extract a, extract b)---loseThoseTable :: TheseTable Expr a b -> Query (EitherTable Expr a b)-loseThoseTable t@(TheseTable (MaybeTable _ a) (MaybeTable _ b)) = do-  where_ $ not_ $ isThoseTable t-  pure $ EitherTable tag a b-  where-    tag = boolExpr (litExpr IsLeft) (litExpr IsRight) (isThatTable t)---bitraverseTheseTable :: ()-  => (a -> Query c)-  -> (b -> Query d)-  -> TheseTable Expr a b-  -> Query (TheseTable Expr c d)-bitraverseTheseTable f g t = do-  mc <- optional (f . fst =<< keepHereTable t)-  md <- optional (g . snd =<< keepThereTable t)-  where_ $ isJustTable mc ==. hasHereTable t-  where_ $ isJustTable md ==. hasThereTable t-  pure $ TheseTable mc md

@@ -1,27 +0,0 @@-{-# language FlexibleContexts #-}--module Rel8.Query.Values-  ( values-  )-where---- base-import Data.Foldable ( toList )-import Prelude---- opaleye-import qualified Opaleye.Values as Opaleye---- rel8-import Rel8.Expr ( Expr )-import {-# SOURCE #-} Rel8.Query ( Query )-import Rel8.Query.Opaleye ( fromOpaleye )-import Rel8.Table ( Table )-import Rel8.Table.Opaleye ( valuesspec )----- | Construct a query that returns the given input list of rows. This is like--- folding a list of 'return' statements under 'Rel8.union', but uses the SQL--- @VALUES@ expression for efficiency.-values :: (Table Expr a, Foldable f) => f a -> Query a-values = fromOpaleye . Opaleye.valuesExplicit valuesspec . toList

@@ -1,26 +0,0 @@-module Rel8.Query.Window-  ( window-  )-where---- base-import Prelude ()---- opaleye-import qualified Opaleye.Window as Opaleye---- rel8-import Rel8.Query ( Query )-import Rel8.Query.Opaleye ( mapOpaleye )-import Rel8.Window ( Window( Window ) )----- | 'window' runs a query composed of expressions containing--- [window functions](https://www.postgresql.org/docs/current/tutorial-window.html).--- 'window' is similar to 'Rel8.aggregate', with the main difference being--- that in a window query, each input row corresponds to one output row,--- whereas aggregation queries fold the entire input query down into a single--- row. To put this into a Haskell context, 'Rel8.aggregate' is to 'foldl' as--- 'window' is to 'scanl'.-window :: Window a b -> Query a -> Query b-window (Window a) = mapOpaleye (Opaleye.runWindows a)

@@ -0,0 +1,33 @@+module Rel8.Range (+  -- * Basic range functionality+  Bound (Incl, Excl, Inf),+  Range (Empty, Range),+  Multirange (Multirange),+  range,+  multirange,+  rangeAgg,+ +  -- * Defining new range types+  DBRange (+    rangeTypeName, rangeDecoder, rangeEncoder,+    multirangeTypeName, multirangeDecoder, multirangeEncoder+  )+) where++-- base+import Prelude ()++-- rel8+import Rel8.Internal.Aggregate.Range (rangeAgg)+import Rel8.Internal.Data.Range (+  Bound (Incl, Excl, Inf),+  Range (Empty, Range),+  Multirange (Multirange),+ )+import Rel8.Internal.Expr.Range (range, multirange)+import Rel8.Internal.Type.Range (+  DBRange (+    rangeTypeName, rangeDecoder, rangeEncoder,+    multirangeTypeName, multirangeDecoder, multirangeEncoder+  ),+ )

@@ -1,130 +0,0 @@-{-# language DataKinds #-}-{-# language EmptyCase #-}-{-# language FlexibleContexts #-}-{-# language GADTs #-}-{-# language LambdaCase #-}-{-# language NamedFieldPuns #-}-{-# language StandaloneKindSignatures #-}--module Rel8.Schema.Context.Nullify-  ( Nullifiability(..), NonNullifiability(..), nullifiableOrNot, absurd-  , Nullifiable, nullifiability-  , guarder, nullifier, unnullifier-  )-where---- base-import Data.Bool ( bool )-import Data.Functor.Identity ( Identity( Identity ) )-import Data.Kind ( Constraint, Type )-import Prelude hiding ( null )---- opaleye-import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye---- rel8-import Rel8.Expr ( Expr )-import Rel8.Expr.Bool ( boolExpr )-import Rel8.Expr.Null ( nullify, unsafeUnnullify )-import Rel8.Expr.Opaleye ( fromPrimExpr )-import Rel8.Kind.Context ( SContext(..) )-import Rel8.Schema.Field ( Field )-import qualified Rel8.Schema.Kind as K-import Rel8.Schema.Name ( Name( Name ) )-import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )-import Rel8.Schema.Result ( Result )-import Rel8.Schema.Spec ( Spec(..) )---type Nullifiability :: K.Context -> Type-data Nullifiability context where-  NExpr :: Nullifiability Expr-  NName :: Nullifiability Name---type Nullifiable :: K.Context -> Constraint-class Nullifiable context where-  nullifiability :: Nullifiability context---instance Nullifiable Expr where-  nullifiability = NExpr---instance Nullifiable Name where-  nullifiability = NName---type NonNullifiability :: K.Context -> Type-data NonNullifiability context where-  NField :: NonNullifiability (Field table)-  NResult :: NonNullifiability Result---nullifiableOrNot :: ()-  => SContext context-  -> Either (NonNullifiability context) (Nullifiability context)-nullifiableOrNot = \case-  SExpr -> Right NExpr-  SField -> Left NField-  SName -> Right NName-  SResult -> Left NResult---absurd :: Nullifiability context -> NonNullifiability context -> a-absurd = \case-  NExpr -> \case-  NName -> \case---guarder :: ()-  => SContext context-  -> context tag-  -> (tag -> Bool)-  -> (Expr tag -> Expr Bool)-  -> context (Maybe a)-  -> context (Maybe a)-guarder = \case-  SExpr -> \tag _ isNonNull -> sguard (isNonNull tag)-  SField -> \_ _ _ -> id-  SName -> \_ _ _ -> id-  SResult -> \(Identity tag) isNonNull _ (Identity a) ->-    Identity (bool Nothing a (isNonNull tag))---nullifier :: ()-  => Nullifiability context-  -> Spec a-  -> context a-  -> context (Nullify a)-nullifier = \case-  NExpr -> \Spec {nullity} a -> snullify nullity a-  NName -> \_ (Name a) -> Name a---unnullifier :: ()-  => Nullifiability context-  -> Spec a-  -> context (Nullify a)-  -> context a-unnullifier = \case-  NExpr -> \Spec {nullity} a -> sunnullify nullity a-  NName -> \_ (Name a) -> Name a---sguard :: Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)-sguard condition a = boolExpr null a condition-  where-    null = fromPrimExpr $ Opaleye.ConstExpr Opaleye.NullLit---snullify :: Nullity a -> Expr a -> Expr (Nullify a)-snullify nullity a = case nullity of-  Null -> a-  NotNull -> nullify a---sunnullify :: Nullity a -> Expr (Nullify a) -> Expr a-sunnullify nullity a = case nullity of-  Null -> a-  NotNull -> unsafeUnnullify a