Merge branch 'master' into doc-ddl

Changelog.md

@@ -1,10 +1,25 @@
 # 1.1.0.0 (??)
 
-* Fixes a bug where cartesian products of queries using `catListTable`, `catNonEmptyTable`, `catList` and `catNonEmpty` would incorrectly be zipped instead.
+## Breaking changes
 
-* Simplify `evaluate` to run directly inside the `Query` monad, rendering the `Evaluate` monad unnecessary.
+* Rename `whereExists` and `whereNotExists` to `present` and `absent` respectively. ([#57](https://github.com/circuithub/rel8/pull/57))
+
+* Simplify `evaluate` to run directly inside the `Query` monad, rendering the `Evaluate` monad unnecessary. ([#56](https://github.com/circuithub/rel8/pull/56))
+
+* The `Labelable` type class has been removed as it's no longer necessary. This class was mostly internal, though was visible in some public API functions. ([#76](https://github.com/circuithub/rel8/pull/76))
+
+## Bug fixes
+
+* Fixes a bug where cartesian products of queries using `catListTable`, `catNonEmptyTable`, `catList` and `catNonEmpty` would incorrectly be zipped instead. ([#61](https://github.com/circuithub/rel8/pull/61))
+
+* Require Opaleye 0.7.3.0. This version has better support for lateral queries, which can improve query plans, especially in `optional`/`LEFT JOIN` ([#72](https://github.com/circuithub/rel8/pull/72))
+
+## Other changes
+
+* `exists` is now implemented in terms of the SQL `EXISTS` keyword. ([#69](https://github.com/circuithub/rel8/pull/69))
+
+* `alignBy` no longer requires `Table`s. ([#67](https://github.com/circuithub/rel8/pull/67))
 
-* Rename `whereExists` and `whereNotExists` to `present` and `absent` respectively.
 
 # 1.0.0.1 (2021-06-21)
 

nix/sources.json

@@ -5,10 +5,10 @@
         "homepage": "https://input-output-hk.github.io/haskell.nix",
         "owner": "input-output-hk",
         "repo": "haskell.nix",
-        "rev": "e7bb8ab2921a11a1d014c70a87898f73e086594d",
-        "sha256": "17c0xqzwnchcy71p8372cydcxc7qf0i8x12d0lf6p1g8yd4al6fa",
+        "rev": "3856d2d24dca0ecc71fcfc314253a2a2d07a3c4f",
+        "sha256": "0s69nasqhkv8n0qmdv075k83p3z584ja9vkzdnp2291mymghvx87",
         "type": "tarball",
-        "url": "https://github.com/input-output-hk/haskell.nix/archive/e7bb8ab2921a11a1d014c70a87898f73e086594d.tar.gz",
+        "url": "https://github.com/input-output-hk/haskell.nix/archive/3856d2d24dca0ecc71fcfc314253a2a2d07a3c4f.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "niv": {
@@ -17,10 +17,10 @@
         "homepage": "https://github.com/nmattia/niv",
         "owner": "nmattia",
         "repo": "niv",
-        "rev": "af958e8057f345ee1aca714c1247ef3ba1c15f5e",
-        "sha256": "1qjavxabbrsh73yck5dcq8jggvh3r2jkbr6b5nlz5d9yrqm9255n",
+        "rev": "e0ca65c81a2d7a4d82a189f1e23a48d59ad42070",
+        "sha256": "1pq9nh1d8nn3xvbdny8fafzw87mj7gsmp6pxkdl65w2g18rmcmzx",
         "type": "tarball",
-        "url": "https://github.com/nmattia/niv/archive/af958e8057f345ee1aca714c1247ef3ba1c15f5e.tar.gz",
+        "url": "https://github.com/nmattia/niv/archive/e0ca65c81a2d7a4d82a189f1e23a48d59ad42070.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "nixpkgs": {
@@ -29,10 +29,10 @@
         "homepage": null,
         "owner": "nixos",
         "repo": "nixpkgs",
-        "rev": "a6847cb5460b47241eb35d1a6588652411642066",
-        "sha256": "0wb5hwgffr4in66qng22sfvbascwnq078q81ziwwayvmnkn73rrm",
+        "rev": "59b8d9cf24e9fcf10341a0923c9bdca088dca8c8",
+        "sha256": "08f38v4b2kcxnbapdwrb54bglka92cxj9qlnqlk5px206jyq9v4c",
         "type": "tarball",
-        "url": "https://github.com/nixos/nixpkgs/archive/a6847cb5460b47241eb35d1a6588652411642066.tar.gz",
+        "url": "https://github.com/nixos/nixpkgs/archive/59b8d9cf24e9fcf10341a0923c9bdca088dca8c8.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     }
 }

nix/sources.nix

@@ -6,25 +6,33 @@ let
   # The fetchers. fetch_<type> fetches specs of type <type>.
   #
 
-  fetch_file = pkgs: spec:
-    if spec.builtin or true then
-      builtins_fetchurl { inherit (spec) url sha256; }
-    else
-      pkgs.fetchurl { inherit (spec) url sha256; };
+  fetch_file = pkgs: name: spec:
+    let
+      name' = sanitizeName name + "-src";
+    in
+      if spec.builtin or true then
+        builtins_fetchurl { inherit (spec) url sha256; name = name'; }
+      else
+        pkgs.fetchurl { inherit (spec) url sha256; name = name'; };
 
   fetch_tarball = pkgs: name: spec:
     let
-      ok = str: ! builtins.isNull (builtins.match "[a-zA-Z0-9+-._?=]" str);
-      # sanitize the name, though nix will still fail if name starts with period
-      name' = stringAsChars (x: if ! ok x then "-" else x) "${name}-src";
+      name' = sanitizeName name + "-src";
     in
       if spec.builtin or true then
         builtins_fetchTarball { name = name'; inherit (spec) url sha256; }
       else
         pkgs.fetchzip { name = name'; inherit (spec) url sha256; };
 
-  fetch_git = spec:
-    builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };
+  fetch_git = name: spec:
+    let
+      ref =
+        if spec ? ref then spec.ref else
+          if spec ? branch then "refs/heads/${spec.branch}" else
+            if spec ? tag then "refs/tags/${spec.tag}" else
+              abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!";
+    in
+      builtins.fetchGit { url = spec.repo; inherit (spec) rev; inherit ref; };
 
   fetch_local = spec: spec.path;
 
@@ -40,11 +48,21 @@ let
   # Various helpers
   #
 
+  # https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695
+  sanitizeName = name:
+    (
+      concatMapStrings (s: if builtins.isList s then "-" else s)
+        (
+          builtins.split "[^[:alnum:]+._?=-]+"
+            ((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name)
+        )
+    );
+
   # The set of packages used when specs are fetched using non-builtins.
-  mkPkgs = sources:
+  mkPkgs = sources: system:
     let
       sourcesNixpkgs =
-        import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) {};
+        import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; };
       hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;
       hasThisAsNixpkgsPath = <nixpkgs> == ./.;
     in
@@ -64,9 +82,9 @@ let
 
     if ! builtins.hasAttr "type" spec then
       abort "ERROR: niv spec ${name} does not have a 'type' attribute"
-    else if spec.type == "file" then fetch_file pkgs spec
+    else if spec.type == "file" then fetch_file pkgs name spec
     else if spec.type == "tarball" then fetch_tarball pkgs name spec
-    else if spec.type == "git" then fetch_git spec
+    else if spec.type == "git" then fetch_git name spec
     else if spec.type == "local" then fetch_local spec
     else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
     else if spec.type == "builtin-url" then fetch_builtin-url name
@@ -80,7 +98,10 @@ let
       saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name;
       ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";
     in
-      if ersatz == "" then drv else ersatz;
+      if ersatz == "" then drv else
+        # this turns the string into an actual Nix path (for both absolute and
+        # relative paths)
+        if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}";
 
   # Ports of functions for older nix versions
 
@@ -98,25 +119,29 @@ let
 
   # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269
   stringAsChars = f: s: concatStrings (map f (stringToCharacters s));
+  concatMapStrings = f: list: concatStrings (map f list);
   concatStrings = builtins.concatStringsSep "";
 
+  # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331
+  optionalAttrs = cond: as: if cond then as else {};
+
   # fetchTarball version that is compatible between all the versions of Nix
-  builtins_fetchTarball = { url, name, sha256 }@attrs:
+  builtins_fetchTarball = { url, name ? null, sha256 }@attrs:
     let
       inherit (builtins) lessThan nixVersion fetchTarball;
     in
       if lessThan nixVersion "1.12" then
-        fetchTarball { inherit name url; }
+        fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
       else
         fetchTarball attrs;
 
   # fetchurl version that is compatible between all the versions of Nix
-  builtins_fetchurl = { url, sha256 }@attrs:
+  builtins_fetchurl = { url, name ? null, sha256 }@attrs:
     let
       inherit (builtins) lessThan nixVersion fetchurl;
     in
       if lessThan nixVersion "1.12" then
-        fetchurl { inherit url; }
+        fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
       else
         fetchurl attrs;
 
@@ -135,7 +160,8 @@ let
   mkConfig =
     { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null
     , sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)
-    , pkgs ? mkPkgs sources
+    , system ? builtins.currentSystem
+    , pkgs ? mkPkgs sources system
     }: rec {
       # The sources, i.e. the attribute set of spec name to spec
       inherit sources;

rel8.cabal

@@ -25,7 +25,7 @@ library
     , case-insensitive
     , contravariant
     , hasql ^>= 1.4.5.1
-    , opaleye ^>= 0.7.2.0
+    , opaleye ^>= 0.7.3.0
     , profunctors
     , scientific
     , semialign
@@ -79,7 +79,6 @@ library
 
     Rel8.Kind.Algebra
     Rel8.Kind.Context
-    Rel8.Kind.Labels
 
     Rel8.Generic.Construction
     Rel8.Generic.Construction.ADT
@@ -115,7 +114,6 @@ library
     Rel8.Query.Values
 
     Rel8.Schema.Context
-    Rel8.Schema.Context.Label
     Rel8.Schema.Context.Nullify
     Rel8.Schema.Dict
     Rel8.Schema.HTable

src/Rel8.hs

@@ -270,7 +270,6 @@ module Rel8
   , evaluate
 
     -- * Implementation details
-  , Labelable
   , HKDT(..)
   ) where
 
@@ -317,7 +316,6 @@ import Rel8.Query.SQL (showQuery)
 import Rel8.Query.Set
 import Rel8.Query.These
 import Rel8.Query.Values
-import Rel8.Schema.Context.Label
 import Rel8.Schema.HTable
 import Rel8.Schema.Name
 import Rel8.Schema.Null hiding ( nullable )

src/Rel8/Aggregate.hs

@@ -33,7 +33,6 @@ import qualified Opaleye.Internal.PackMap as Opaleye
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Schema.Context ( Interpretation(..) )
-import Rel8.Schema.Context.Label ( Labelable(..) )
 import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Null ( Sql )
@@ -62,7 +61,7 @@ instance Interpretation Aggregate where
   data Col Aggregate _spec where
     A :: ()
       => { unA :: !(Aggregate a) }
-      -> Col Aggregate ('Spec labels a)
+      -> Col Aggregate ('Spec a)
 
 
 instance Sql DBType a => Table Aggregate (Aggregate a) where
@@ -104,11 +103,6 @@ instance Sql DBType a =>
   Recontextualize Name Aggregate (Name a) (Aggregate a)
 
 
-instance Labelable Aggregate where
-  labeler (A aggregate) = A aggregate
-  unlabeler (A aggregate) = A aggregate
-
-
 -- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
 -- for the columns in @b@.
 type Aggregates :: Type -> Type -> Constraint

src/Rel8/Column.hs

@@ -20,7 +20,7 @@ import Rel8.Aggregate ( Aggregate, Col( A ) )
 import Rel8.Expr ( Expr, Col( E ) )
 import Rel8.FCF ( Eval, Exp )
 import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
-import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
+import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name(..), Col( N ) )
 import Rel8.Schema.Null ( Sql )
@@ -55,11 +55,11 @@ instance (Reifiable context, Sql DBType a) =>
   Table (Reify context) (AColumn context a)
  where
   type Context (AColumn context a) = Reify context
-  type Columns (AColumn context a) = HIdentity ('Spec '[] a)
+  type Columns (AColumn context a) = HType a
   type Unreify (AColumn context a) = Column context a
 
-  fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
-  toColumns = HIdentity . Reify . stoColumn contextSing
+  fromColumns (HType (Reify a)) = sfromColumn contextSing a
+  toColumns = HType . Reify . stoColumn contextSing
   reify _ = AColumn
   unreify _ (AColumn a) = a
 
@@ -77,7 +77,7 @@ instance
 
 sfromColumn :: ()
   => SContext context
-  -> Col context ('Spec labels a)
+  -> Col context ('Spec a)
   -> AColumn context a
 sfromColumn = \case
   SAggregate -> \(A a) -> AColumn a
@@ -90,7 +90,7 @@ sfromColumn = \case
 stoColumn :: ()
   => SContext context
   -> AColumn context a
-  -> Col context ('Spec labels a)
+  -> Col context ('Spec a)
 stoColumn = \case
   SAggregate -> \(AColumn a) -> A a
   SExpr -> \(AColumn a) -> E a

src/Rel8/Expr.hs

@@ -39,7 +39,6 @@ import Rel8.Expr.Opaleye
   )
 import Rel8.Expr.Serialize ( litExpr )
 import Rel8.Schema.Context ( Interpretation, Col )
-import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
 import Rel8.Schema.Reify ( notReify )
@@ -128,7 +127,7 @@ instance Sql DBFloating a => Floating (Expr a) where
 
 instance Interpretation Expr where
   data Col Expr _spec where
-    E :: {unE :: !(Expr a)} -> Col Expr ('Spec labels a)
+    E :: {unE :: !(Expr a)} -> Col Expr ('Spec a)
 
 
 instance Sql DBType a => Table Expr (Expr a) where
@@ -148,8 +147,3 @@ instance Sql DBType a => Recontextualize Expr Result (Expr a) (Identity a)
 
 
 instance Sql DBType a => Recontextualize Result Expr (Identity a) (Expr a)
-
-
-instance Labelable Expr where
-  labeler (E a) = E a
-  unlabeler (E a) = E a