mirror of
https://github.com/circuithub/rel8.git
synced 2024-09-11 16:05:41 +03:00
Require Opaleye >= 0.7.3 (#81)
0.7.3 has important changes to where lateral joins are introduced, and fixes #72.
This commit is contained in:
parent
ac2d382e5e
commit
bf193950ab
@ -5,10 +5,10 @@
|
|||||||
"homepage": "https://input-output-hk.github.io/haskell.nix",
|
"homepage": "https://input-output-hk.github.io/haskell.nix",
|
||||||
"owner": "input-output-hk",
|
"owner": "input-output-hk",
|
||||||
"repo": "haskell.nix",
|
"repo": "haskell.nix",
|
||||||
"rev": "e7bb8ab2921a11a1d014c70a87898f73e086594d",
|
"rev": "3856d2d24dca0ecc71fcfc314253a2a2d07a3c4f",
|
||||||
"sha256": "17c0xqzwnchcy71p8372cydcxc7qf0i8x12d0lf6p1g8yd4al6fa",
|
"sha256": "0s69nasqhkv8n0qmdv075k83p3z584ja9vkzdnp2291mymghvx87",
|
||||||
"type": "tarball",
|
"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"
|
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
||||||
},
|
},
|
||||||
"niv": {
|
"niv": {
|
||||||
@ -17,10 +17,10 @@
|
|||||||
"homepage": "https://github.com/nmattia/niv",
|
"homepage": "https://github.com/nmattia/niv",
|
||||||
"owner": "nmattia",
|
"owner": "nmattia",
|
||||||
"repo": "niv",
|
"repo": "niv",
|
||||||
"rev": "af958e8057f345ee1aca714c1247ef3ba1c15f5e",
|
"rev": "e0ca65c81a2d7a4d82a189f1e23a48d59ad42070",
|
||||||
"sha256": "1qjavxabbrsh73yck5dcq8jggvh3r2jkbr6b5nlz5d9yrqm9255n",
|
"sha256": "1pq9nh1d8nn3xvbdny8fafzw87mj7gsmp6pxkdl65w2g18rmcmzx",
|
||||||
"type": "tarball",
|
"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"
|
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
||||||
},
|
},
|
||||||
"nixpkgs": {
|
"nixpkgs": {
|
||||||
@ -29,10 +29,10 @@
|
|||||||
"homepage": null,
|
"homepage": null,
|
||||||
"owner": "nixos",
|
"owner": "nixos",
|
||||||
"repo": "nixpkgs",
|
"repo": "nixpkgs",
|
||||||
"rev": "a6847cb5460b47241eb35d1a6588652411642066",
|
"rev": "59b8d9cf24e9fcf10341a0923c9bdca088dca8c8",
|
||||||
"sha256": "0wb5hwgffr4in66qng22sfvbascwnq078q81ziwwayvmnkn73rrm",
|
"sha256": "08f38v4b2kcxnbapdwrb54bglka92cxj9qlnqlk5px206jyq9v4c",
|
||||||
"type": "tarball",
|
"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"
|
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -6,25 +6,33 @@ let
|
|||||||
# The fetchers. fetch_<type> fetches specs of type <type>.
|
# The fetchers. fetch_<type> fetches specs of type <type>.
|
||||||
#
|
#
|
||||||
|
|
||||||
fetch_file = pkgs: spec:
|
fetch_file = pkgs: name: spec:
|
||||||
if spec.builtin or true then
|
let
|
||||||
builtins_fetchurl { inherit (spec) url sha256; }
|
name' = sanitizeName name + "-src";
|
||||||
else
|
in
|
||||||
pkgs.fetchurl { inherit (spec) url sha256; };
|
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:
|
fetch_tarball = pkgs: name: spec:
|
||||||
let
|
let
|
||||||
ok = str: ! builtins.isNull (builtins.match "[a-zA-Z0-9+-._?=]" str);
|
name' = sanitizeName name + "-src";
|
||||||
# sanitize the name, though nix will still fail if name starts with period
|
|
||||||
name' = stringAsChars (x: if ! ok x then "-" else x) "${name}-src";
|
|
||||||
in
|
in
|
||||||
if spec.builtin or true then
|
if spec.builtin or true then
|
||||||
builtins_fetchTarball { name = name'; inherit (spec) url sha256; }
|
builtins_fetchTarball { name = name'; inherit (spec) url sha256; }
|
||||||
else
|
else
|
||||||
pkgs.fetchzip { name = name'; inherit (spec) url sha256; };
|
pkgs.fetchzip { name = name'; inherit (spec) url sha256; };
|
||||||
|
|
||||||
fetch_git = spec:
|
fetch_git = name: spec:
|
||||||
builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };
|
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;
|
fetch_local = spec: spec.path;
|
||||||
|
|
||||||
@ -40,11 +48,21 @@ let
|
|||||||
# Various helpers
|
# 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.
|
# The set of packages used when specs are fetched using non-builtins.
|
||||||
mkPkgs = sources:
|
mkPkgs = sources: system:
|
||||||
let
|
let
|
||||||
sourcesNixpkgs =
|
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;
|
hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;
|
||||||
hasThisAsNixpkgsPath = <nixpkgs> == ./.;
|
hasThisAsNixpkgsPath = <nixpkgs> == ./.;
|
||||||
in
|
in
|
||||||
@ -64,9 +82,9 @@ let
|
|||||||
|
|
||||||
if ! builtins.hasAttr "type" spec then
|
if ! builtins.hasAttr "type" spec then
|
||||||
abort "ERROR: niv spec ${name} does not have a 'type' attribute"
|
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 == "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 == "local" then fetch_local spec
|
||||||
else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
|
else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
|
||||||
else if spec.type == "builtin-url" then fetch_builtin-url 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;
|
saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name;
|
||||||
ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";
|
ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";
|
||||||
in
|
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
|
# Ports of functions for older nix versions
|
||||||
|
|
||||||
@ -98,25 +119,29 @@ let
|
|||||||
|
|
||||||
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269
|
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269
|
||||||
stringAsChars = f: s: concatStrings (map f (stringToCharacters s));
|
stringAsChars = f: s: concatStrings (map f (stringToCharacters s));
|
||||||
|
concatMapStrings = f: list: concatStrings (map f list);
|
||||||
concatStrings = builtins.concatStringsSep "";
|
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
|
# 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
|
let
|
||||||
inherit (builtins) lessThan nixVersion fetchTarball;
|
inherit (builtins) lessThan nixVersion fetchTarball;
|
||||||
in
|
in
|
||||||
if lessThan nixVersion "1.12" then
|
if lessThan nixVersion "1.12" then
|
||||||
fetchTarball { inherit name url; }
|
fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
|
||||||
else
|
else
|
||||||
fetchTarball attrs;
|
fetchTarball attrs;
|
||||||
|
|
||||||
# fetchurl version that is compatible between all the versions of Nix
|
# fetchurl version that is compatible between all the versions of Nix
|
||||||
builtins_fetchurl = { url, sha256 }@attrs:
|
builtins_fetchurl = { url, name ? null, sha256 }@attrs:
|
||||||
let
|
let
|
||||||
inherit (builtins) lessThan nixVersion fetchurl;
|
inherit (builtins) lessThan nixVersion fetchurl;
|
||||||
in
|
in
|
||||||
if lessThan nixVersion "1.12" then
|
if lessThan nixVersion "1.12" then
|
||||||
fetchurl { inherit url; }
|
fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
|
||||||
else
|
else
|
||||||
fetchurl attrs;
|
fetchurl attrs;
|
||||||
|
|
||||||
@ -135,7 +160,8 @@ let
|
|||||||
mkConfig =
|
mkConfig =
|
||||||
{ sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null
|
{ sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null
|
||||||
, sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)
|
, sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)
|
||||||
, pkgs ? mkPkgs sources
|
, system ? builtins.currentSystem
|
||||||
|
, pkgs ? mkPkgs sources system
|
||||||
}: rec {
|
}: rec {
|
||||||
# The sources, i.e. the attribute set of spec name to spec
|
# The sources, i.e. the attribute set of spec name to spec
|
||||||
inherit sources;
|
inherit sources;
|
||||||
|
@ -25,7 +25,7 @@ library
|
|||||||
, case-insensitive
|
, case-insensitive
|
||||||
, contravariant
|
, contravariant
|
||||||
, hasql ^>= 1.4.5.1
|
, hasql ^>= 1.4.5.1
|
||||||
, opaleye ^>= 0.7.2.0
|
, opaleye ^>= 0.7.3.0
|
||||||
, profunctors
|
, profunctors
|
||||||
, scientific
|
, scientific
|
||||||
, semialign
|
, semialign
|
||||||
|
@ -169,14 +169,14 @@ instance Bind Query where
|
|||||||
|
|
||||||
|
|
||||||
instance Monad Query where
|
instance Monad Query where
|
||||||
Query q >>= f = Query $ \dummies -> Opaleye.QueryArr $ \(_, query, tag) ->
|
Query q >>= f = Query $ \dummies -> Opaleye.QueryArr $ \(_, tag) ->
|
||||||
let
|
let
|
||||||
Opaleye.QueryArr qa = q dummies
|
Opaleye.QueryArr qa = q dummies
|
||||||
((m, a), query', tag') = qa ((), query, tag)
|
((m, a), query, tag') = qa ((), tag)
|
||||||
Query q' = f a
|
Query q' = f a
|
||||||
(dummies', query'', tag'') =
|
(dummies', query', tag'') =
|
||||||
( dummy : dummies
|
( dummy : dummies
|
||||||
, Opaleye.Rebind True bindings query'
|
, \lateral -> Opaleye.Rebind True bindings . query lateral
|
||||||
, Opaleye.next tag'
|
, Opaleye.next tag'
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
@ -185,19 +185,13 @@ instance Monad Query where
|
|||||||
random = Opaleye.FunExpr "random" []
|
random = Opaleye.FunExpr "random" []
|
||||||
name = Opaleye.extractAttr "dummy" tag'
|
name = Opaleye.extractAttr "dummy" tag'
|
||||||
Opaleye.QueryArr qa' = Opaleye.lateral $ \_ -> q' dummies'
|
Opaleye.QueryArr qa' = Opaleye.lateral $ \_ -> q' dummies'
|
||||||
-- NOTE: query''' and needsDummies are corecursive; only laziness saves
|
((m'@(Any needsDummies), b), query'', tag''') = qa' ((), tag'')
|
||||||
-- us here.
|
|
||||||
--
|
|
||||||
-- This refactoring, if adopted, would allow us to do this without
|
|
||||||
-- relying on laziness:
|
|
||||||
-- https://github.com/tomjaguarpaw/haskell-opaleye/commit/8a23f5028ab7396290984d63a8316949909fdbb4
|
|
||||||
((m'@(Any needsDummies), b), query'''', tag''') = qa' ((), query''', tag'')
|
|
||||||
query'''
|
query'''
|
||||||
| needsDummies = query''
|
| needsDummies = \lateral -> query'' lateral . query' lateral
|
||||||
| otherwise = query'
|
| otherwise = \lateral -> query'' lateral . query lateral
|
||||||
m'' = m <> m'
|
m'' = m <> m'
|
||||||
in
|
in
|
||||||
((m'', b), query'''', tag''')
|
((m'', b), query''', tag''')
|
||||||
|
|
||||||
|
|
||||||
-- | '<|>:' = 'unionAll'.
|
-- | '<|>:' = 'unionAll'.
|
||||||
|
@ -55,13 +55,13 @@ laterally a = Query $ \bindings -> pure $ (Any True,) $
|
|||||||
-- variable in the SQL. The @a@ returned consists only of these
|
-- variable in the SQL. The @a@ returned consists only of these
|
||||||
-- variables. It's essentially a @let@ binding for Postgres expressions.
|
-- variables. It's essentially a @let@ binding for Postgres expressions.
|
||||||
rebind :: Table Expr a => a -> Query a
|
rebind :: Table Expr a => a -> Query a
|
||||||
rebind a = Query $ \_ -> Opaleye.QueryArr $ \(_, query, tag) ->
|
rebind a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->
|
||||||
let
|
let
|
||||||
tag' = Opaleye.next tag
|
tag' = Opaleye.next tag
|
||||||
(a', bindings) = Opaleye.run $
|
(a', bindings) = Opaleye.run $
|
||||||
Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "eval" tag') a
|
Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "eval" tag') a
|
||||||
in
|
in
|
||||||
((mempty, a'), Opaleye.Rebind True bindings query, tag')
|
((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag')
|
||||||
|
|
||||||
|
|
||||||
foldl1' :: (a -> a -> a) -> NonEmpty a -> a
|
foldl1' :: (a -> a -> a) -> NonEmpty a -> a
|
||||||
|
@ -9,15 +9,11 @@ where
|
|||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
-- opaleye
|
-- opaleye
|
||||||
import qualified Opaleye.Internal.PackMap as Opaleye
|
import qualified Opaleye.Internal.MaybeFields as Opaleye
|
||||||
import qualified Opaleye.Internal.PrimQuery as Opaleye
|
|
||||||
import qualified Opaleye.Internal.QueryArr as Opaleye
|
|
||||||
import qualified Opaleye.Internal.Tag as Opaleye
|
|
||||||
|
|
||||||
-- rel8
|
-- rel8
|
||||||
import Rel8.Expr.Bool ( true )
|
|
||||||
import Rel8.Expr.Eq ( (==.) )
|
import Rel8.Expr.Eq ( (==.) )
|
||||||
import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )
|
import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr )
|
||||||
import Rel8.Query ( Query )
|
import Rel8.Query ( Query )
|
||||||
import Rel8.Query.Filter ( where_ )
|
import Rel8.Query.Filter ( where_ )
|
||||||
import Rel8.Query.Opaleye ( mapOpaleye )
|
import Rel8.Query.Opaleye ( mapOpaleye )
|
||||||
@ -31,18 +27,10 @@ import Rel8.Table.Tag ( Tag(..), fromExpr )
|
|||||||
-- To speak in more concrete terms, 'optional' is most useful to write @LEFT
|
-- To speak in more concrete terms, 'optional' is most useful to write @LEFT
|
||||||
-- JOIN@s.
|
-- JOIN@s.
|
||||||
optional :: Query a -> Query (MaybeTable a)
|
optional :: Query a -> Query (MaybeTable a)
|
||||||
optional = mapOpaleye $ \query -> Opaleye.QueryArr $ \i -> case i of
|
optional =
|
||||||
(_, left, tag) -> (ma', join, tag'')
|
mapOpaleye $
|
||||||
where
|
Opaleye.optionalInternal $
|
||||||
(ma, right, tag') = Opaleye.runSimpleQueryArr (pure <$> query) ((), tag)
|
MaybeTable . fromExpr . fromPrimExpr . fromColumn
|
||||||
MaybeTable Tag {expr = just} a = ma
|
|
||||||
(just', bindings) = Opaleye.run $ do
|
|
||||||
traversePrimExpr (Opaleye.extractAttr "isJust" tag') just
|
|
||||||
tag'' = Opaleye.next tag'
|
|
||||||
join = Opaleye.Join Opaleye.LeftJoin on [] bindings left right
|
|
||||||
where
|
|
||||||
on = toPrimExpr true
|
|
||||||
ma' = MaybeTable (fromExpr just') a
|
|
||||||
|
|
||||||
|
|
||||||
-- | Filter out 'MaybeTable's, returning only the tables that are not-null.
|
-- | Filter out 'MaybeTable's, returning only the tables that are not-null.
|
||||||
|
@ -40,23 +40,23 @@ zipOpaleyeWith f (Query a) (Query b) = Query $ liftA2 (zipping f) a b
|
|||||||
mapping :: ()
|
mapping :: ()
|
||||||
=> (Opaleye.Select a -> Opaleye.Select b)
|
=> (Opaleye.Select a -> Opaleye.Select b)
|
||||||
-> Opaleye.Select (m, a) -> Opaleye.Select (m, b)
|
-> Opaleye.Select (m, a) -> Opaleye.Select (m, b)
|
||||||
mapping f q@(Opaleye.QueryArr qa) = Opaleye.QueryArr $ \(_, query, tag) ->
|
mapping f q@(Opaleye.QueryArr qa) = Opaleye.QueryArr $ \(_, tag) ->
|
||||||
let
|
let
|
||||||
((m, _), _, _) = qa ((), query, tag)
|
((m, _), _, _) = qa ((), tag)
|
||||||
Opaleye.QueryArr qa' = (m,) <$> f (snd <$> q)
|
Opaleye.QueryArr qa' = (m,) <$> f (snd <$> q)
|
||||||
in
|
in
|
||||||
qa' ((), query, tag)
|
qa' ((), tag)
|
||||||
|
|
||||||
|
|
||||||
zipping :: Semigroup m
|
zipping :: Semigroup m
|
||||||
=> (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c)
|
=> (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c)
|
||||||
-> Opaleye.Select (m, a) -> Opaleye.Select (m, b) -> Opaleye.Select (m, c)
|
-> Opaleye.Select (m, a) -> Opaleye.Select (m, b) -> Opaleye.Select (m, c)
|
||||||
zipping f q@(Opaleye.QueryArr qa) q'@(Opaleye.QueryArr qa') =
|
zipping f q@(Opaleye.QueryArr qa) q'@(Opaleye.QueryArr qa') =
|
||||||
Opaleye.QueryArr $ \(_, query, tag) ->
|
Opaleye.QueryArr $ \(_, tag) ->
|
||||||
let
|
let
|
||||||
((m, _), _, _) = qa ((), query, tag)
|
((m, _), _, _) = qa ((), tag)
|
||||||
((m', _), _, _) = qa' ((), query, tag)
|
((m', _), _, _) = qa' ((), tag)
|
||||||
m'' = m <> m'
|
m'' = m <> m'
|
||||||
Opaleye.QueryArr qa'' = (m'',) <$> f (snd <$> q) (snd <$> q')
|
Opaleye.QueryArr qa'' = (m'',) <$> f (snd <$> q) (snd <$> q')
|
||||||
in
|
in
|
||||||
qa'' ((), query, tag)
|
qa'' ((), tag)
|
||||||
|
@ -46,7 +46,7 @@ alignBy :: ()
|
|||||||
=> (a -> b -> Expr Bool)
|
=> (a -> b -> Expr Bool)
|
||||||
-> Query a -> Query b -> Query (TheseTable a b)
|
-> Query a -> Query b -> Query (TheseTable a b)
|
||||||
alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> case i of
|
alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> case i of
|
||||||
(_, input, tag) -> (tab, join', tag''')
|
(_, tag) -> (tab, join', tag''')
|
||||||
where
|
where
|
||||||
(ma, left', tag') = Opaleye.runSimpleQueryArr (pure <$> left) ((), tag)
|
(ma, left', tag') = Opaleye.runSimpleQueryArr (pure <$> left) ((), tag)
|
||||||
(mb, right', tag'') = Opaleye.runSimpleQueryArr (pure <$> right) ((), tag')
|
(mb, right', tag'') = Opaleye.runSimpleQueryArr (pure <$> right) ((), tag')
|
||||||
@ -57,13 +57,15 @@ alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> cas
|
|||||||
(hasThere', rbindings) = Opaleye.run $ do
|
(hasThere', rbindings) = Opaleye.run $ do
|
||||||
traversePrimExpr (Opaleye.extractAttr "hasThere" tag'') hasThere
|
traversePrimExpr (Opaleye.extractAttr "hasThere" tag'') hasThere
|
||||||
tag''' = Opaleye.next tag''
|
tag''' = Opaleye.next tag''
|
||||||
join = Opaleye.Join Opaleye.FullJoin on lbindings rbindings left' right'
|
join lateral = Opaleye.Join Opaleye.FullJoin on left'' right''
|
||||||
where
|
where
|
||||||
on = toPrimExpr $ condition a b
|
on = toPrimExpr $ condition a b
|
||||||
|
left'' = (lateral, Opaleye.Rebind True lbindings left')
|
||||||
|
right'' = (lateral, Opaleye.Rebind True rbindings right')
|
||||||
ma' = MaybeTable (fromExpr hasHere') a
|
ma' = MaybeTable (fromExpr hasHere') a
|
||||||
mb' = MaybeTable (fromExpr hasThere') b
|
mb' = MaybeTable (fromExpr hasThere') b
|
||||||
tab = TheseTable {here = ma', there = mb'}
|
tab = TheseTable {here = ma', there = mb'}
|
||||||
join' = Opaleye.times input join
|
join' lateral input = Opaleye.times lateral input (join lateral)
|
||||||
|
|
||||||
|
|
||||||
-- | Filter 'TheseTable's, keeping only 'thisTable's and 'thoseTable's.
|
-- | Filter 'TheseTable's, keeping only 'thisTable's and 'thoseTable's.
|
||||||
|
@ -759,13 +759,13 @@ testEvaluate = databasePropertyTest "evaluate has the evaluation order we expect
|
|||||||
|
|
||||||
normalize selected' ===
|
normalize selected' ===
|
||||||
[ (('a', 'd'), (0, 0))
|
[ (('a', 'd'), (0, 0))
|
||||||
, (('b', 'd'), (1, 1))
|
, (('a', 'e'), (1, 1))
|
||||||
, (('c', 'd'), (2, 2))
|
, (('a', 'f'), (2, 2))
|
||||||
, (('a', 'e'), (3, 3))
|
, (('b', 'd'), (3, 3))
|
||||||
, (('b', 'e'), (4, 4))
|
, (('b', 'e'), (4, 4))
|
||||||
, (('c', 'e'), (5, 5))
|
, (('b', 'f'), (5, 5))
|
||||||
, (('a', 'f'), (6, 6))
|
, (('c', 'd'), (6, 6))
|
||||||
, (('b', 'f'), (7, 7))
|
, (('c', 'e'), (7, 7))
|
||||||
, (('c', 'f'), (8, 8))
|
, (('c', 'f'), (8, 8))
|
||||||
]
|
]
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user