bf19395 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

Require Opaleye >= 0.7.3 (#81)

bf19395Ollie Charles5 years ago

nix/sources.json+9−9

compare with master

unifiedsplit

@@ -5,10 +5,10 @@

5 "homepage": "https://input-output-hk.github.io/haskell.nix",

6 "owner": "input-output-hk",

7 "repo": "haskell.nix",

8− "rev": "e7bb8ab2921a11a1d014c70a87898f73e086594d",

8+ "rev": "3856d2d24dca0ecc71fcfc314253a2a2d07a3c4f",

9− "sha256": "17c0xqzwnchcy71p8372cydcxc7qf0i8x12d0lf6p1g8yd4al6fa",

9+ "sha256": "0s69nasqhkv8n0qmdv075k83p3z584ja9vkzdnp2291mymghvx87",

10 "type": "tarball",

11− "url": "https://github.com/input-output-hk/haskell.nix/archive/e7bb8ab2921a11a1d014c70a87898f73e086594d.tar.gz",

11+ "url": "https://github.com/input-output-hk/haskell.nix/archive/3856d2d24dca0ecc71fcfc314253a2a2d07a3c4f.tar.gz",

12 "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

13 },

14 "niv": {

@@ -17,10 +17,10 @@

17 "homepage": "https://github.com/nmattia/niv",

18 "owner": "nmattia",

19 "repo": "niv",

20− "rev": "af958e8057f345ee1aca714c1247ef3ba1c15f5e",

20+ "rev": "e0ca65c81a2d7a4d82a189f1e23a48d59ad42070",

21− "sha256": "1qjavxabbrsh73yck5dcq8jggvh3r2jkbr6b5nlz5d9yrqm9255n",

21+ "sha256": "1pq9nh1d8nn3xvbdny8fafzw87mj7gsmp6pxkdl65w2g18rmcmzx",

22 "type": "tarball",

23− "url": "https://github.com/nmattia/niv/archive/af958e8057f345ee1aca714c1247ef3ba1c15f5e.tar.gz",

23+ "url": "https://github.com/nmattia/niv/archive/e0ca65c81a2d7a4d82a189f1e23a48d59ad42070.tar.gz",

24 "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

25 },

26 "nixpkgs": {

@@ -29,10 +29,10 @@

29 "homepage": null,

30 "owner": "nixos",

31 "repo": "nixpkgs",

32− "rev": "a6847cb5460b47241eb35d1a6588652411642066",

32+ "rev": "59b8d9cf24e9fcf10341a0923c9bdca088dca8c8",

33− "sha256": "0wb5hwgffr4in66qng22sfvbascwnq078q81ziwwayvmnkn73rrm",

33+ "sha256": "08f38v4b2kcxnbapdwrb54bglka92cxj9qlnqlk5px206jyq9v4c",

34 "type": "tarball",

35− "url": "https://github.com/nixos/nixpkgs/archive/a6847cb5460b47241eb35d1a6588652411642066.tar.gz",

35+ "url": "https://github.com/nixos/nixpkgs/archive/59b8d9cf24e9fcf10341a0923c9bdca088dca8c8.tar.gz",

36 "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

37 }

38}

nix/sources.nix+46−20

@@ -6,25 +6,33 @@ let

6 # The fetchers. fetch_<type> fetches specs of type <type>.

7 #

9− fetch_file = pkgs: spec:

9+ fetch_file = pkgs: name: spec:

10+ let

11+ name' = sanitizeName name + "-src";

12+ in

10− if spec.builtin or true then

13+ if spec.builtin or true then

11− builtins_fetchurl { inherit (spec) url sha256; }

14+ builtins_fetchurl { inherit (spec) url sha256; name = name'; }

12− else

15+ else

13− pkgs.fetchurl { inherit (spec) url sha256; };

16+ pkgs.fetchurl { inherit (spec) url sha256; name = name'; };

15 fetch_tarball = pkgs: name: spec:

18 fetch_tarball = pkgs: name: spec:

16 let

19 let

17− ok = str: ! builtins.isNull (builtins.match "[a-zA-Z0-9+-._?=]" str);

20+ name' = sanitizeName name + "-src";

18− # sanitize the name, though nix will still fail if name starts with period

19− name' = stringAsChars (x: if ! ok x then "-" else x) "${name}-src";

20 in

21 in

21 if spec.builtin or true then

22 if spec.builtin or true then

22 builtins_fetchTarball { name = name'; inherit (spec) url sha256; }

23 builtins_fetchTarball { name = name'; inherit (spec) url sha256; }

23 else

24 else

24 pkgs.fetchzip { name = name'; inherit (spec) url sha256; };

25 pkgs.fetchzip { name = name'; inherit (spec) url sha256; };

26− fetch_git = spec:

27+ fetch_git = name: spec:

28+ let

29+ ref =

30+ if spec ? ref then spec.ref else

31+ if spec ? branch then "refs/heads/${spec.branch}" else

32+ if spec ? tag then "refs/tags/${spec.tag}" else

33+ abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!";

34+ in

27− builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };

35+ builtins.fetchGit { url = spec.repo; inherit (spec) rev; inherit ref; };

29 fetch_local = spec: spec.path;

37 fetch_local = spec: spec.path;

@@ -40,11 +48,21 @@ let

40 # Various helpers

48 # Various helpers

41 #

49 #

51+ # https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695

52+ sanitizeName = name:

53+ (

54+ concatMapStrings (s: if builtins.isList s then "-" else s)

55+ (

56+ builtins.split "[^[:alnum:]+._?=-]+"

57+ ((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name)

58+ )

59+ );

60+

43 # The set of packages used when specs are fetched using non-builtins.

61 # The set of packages used when specs are fetched using non-builtins.

44− mkPkgs = sources:

62+ mkPkgs = sources: system:

45 let

63 let

46 sourcesNixpkgs =

64 sourcesNixpkgs =

47− import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) {};

65+ import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; };

48 hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;

66 hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;

49 hasThisAsNixpkgsPath = <nixpkgs> == ./.;

67 hasThisAsNixpkgsPath = <nixpkgs> == ./.;

50 in

68 in

@@ -64,9 +82,9 @@ let

65 if ! builtins.hasAttr "type" spec then

83 if ! builtins.hasAttr "type" spec then

66 abort "ERROR: niv spec ${name} does not have a 'type' attribute"

84 abort "ERROR: niv spec ${name} does not have a 'type' attribute"

67− else if spec.type == "file" then fetch_file pkgs spec

85+ else if spec.type == "file" then fetch_file pkgs name spec

68 else if spec.type == "tarball" then fetch_tarball pkgs name spec

86 else if spec.type == "tarball" then fetch_tarball pkgs name spec

69− else if spec.type == "git" then fetch_git spec

87+ else if spec.type == "git" then fetch_git name spec

70 else if spec.type == "local" then fetch_local spec

88 else if spec.type == "local" then fetch_local spec

71 else if spec.type == "builtin-tarball" then fetch_builtin-tarball name

89 else if spec.type == "builtin-tarball" then fetch_builtin-tarball name

72 else if spec.type == "builtin-url" then fetch_builtin-url name

90 else if spec.type == "builtin-url" then fetch_builtin-url name

@@ -80,7 +98,10 @@ let

80 saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name;

98 saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name;

81 ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";

99 ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";

82 in

100 in

83− if ersatz == "" then drv else ersatz;

101+ if ersatz == "" then drv else

102+ # this turns the string into an actual Nix path (for both absolute and

103+ # relative paths)

104+ if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}";

105

85 # Ports of functions for older nix versions

106 # Ports of functions for older nix versions

107

@@ -98,25 +119,29 @@ let

119

99 # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269

120 # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269

100 stringAsChars = f: s: concatStrings (map f (stringToCharacters s));

121 stringAsChars = f: s: concatStrings (map f (stringToCharacters s));

122+ concatMapStrings = f: list: concatStrings (map f list);

101 concatStrings = builtins.concatStringsSep "";

123 concatStrings = builtins.concatStringsSep "";

102

124

125+ # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331

126+ optionalAttrs = cond: as: if cond then as else {};

127+

103 # fetchTarball version that is compatible between all the versions of Nix

128 # fetchTarball version that is compatible between all the versions of Nix

104− builtins_fetchTarball = { url, name, sha256 }@attrs:

129+ builtins_fetchTarball = { url, name ? null, sha256 }@attrs:

105 let

130 let

106 inherit (builtins) lessThan nixVersion fetchTarball;

131 inherit (builtins) lessThan nixVersion fetchTarball;

107 in

132 in

108 if lessThan nixVersion "1.12" then

133 if lessThan nixVersion "1.12" then

109− fetchTarball { inherit name url; }

134+ fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))

110 else

135 else

111 fetchTarball attrs;

136 fetchTarball attrs;

112

137

113 # fetchurl version that is compatible between all the versions of Nix

138 # fetchurl version that is compatible between all the versions of Nix

114− builtins_fetchurl = { url, sha256 }@attrs:

139+ builtins_fetchurl = { url, name ? null, sha256 }@attrs:

115 let

140 let

116 inherit (builtins) lessThan nixVersion fetchurl;

141 inherit (builtins) lessThan nixVersion fetchurl;

117 in

142 in

118 if lessThan nixVersion "1.12" then

143 if lessThan nixVersion "1.12" then

119− fetchurl { inherit url; }

144+ fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))

120 else

145 else

121 fetchurl attrs;

146 fetchurl attrs;

122

147

@@ -135,7 +160,8 @@ let

135 mkConfig =

160 mkConfig =

136 { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null

161 { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null

137 , sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)

162 , sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)

163+ , system ? builtins.currentSystem

138− , pkgs ? mkPkgs sources

164+ , pkgs ? mkPkgs sources system

139 }: rec {

165 }: rec {

140 # The sources, i.e. the attribute set of spec name to spec

166 # The sources, i.e. the attribute set of spec name to spec

141 inherit sources;

167 inherit sources;

rel8.cabal+1−1

@@ -25,7 +25,7 @@ library

25 , case-insensitive

26 , contravariant

27 , hasql ^>= 1.4.5.1

28− , opaleye ^>= 0.7.2.0

28+ , opaleye ^>= 0.7.3.0

29 , profunctors

30 , scientific

31 , semialign

src/Rel8/Query.hs+8−14

@@ -169,14 +169,14 @@ instance Bind Query where

169

170

171instance Monad Query where

172− Query q >>= f = Query $ \dummies -> Opaleye.QueryArr $ \(_, query, tag) ->

172+ Query q >>= f = Query $ \dummies -> Opaleye.QueryArr $ \(_, tag) ->

173 let

174 Opaleye.QueryArr qa = q dummies

175− ((m, a), query', tag') = qa ((), query, tag)

175+ ((m, a), query, tag') = qa ((), tag)

176 Query q' = f a

177− (dummies', query'', tag'') =

177+ (dummies', query', tag'') =

178 ( dummy : dummies

179− , Opaleye.Rebind True bindings query'

179+ , \lateral -> Opaleye.Rebind True bindings . query lateral

180 , Opaleye.next tag'

181 )

182 where

@@ -185,19 +185,13 @@ instance Monad Query where

185 random = Opaleye.FunExpr "random" []

186 name = Opaleye.extractAttr "dummy" tag'

187 Opaleye.QueryArr qa' = Opaleye.lateral $ \_ -> q' dummies'

188− -- NOTE: query''' and needsDummies are corecursive; only laziness saves

189− -- us here.

190− --

191− -- This refactoring, if adopted, would allow us to do this without

192− -- relying on laziness:

193− -- https://github.com/tomjaguarpaw/haskell-opaleye/commit/8a23f5028ab7396290984d63a8316949909fdbb4

194− ((m'@(Any needsDummies), b), query'''', tag''') = qa' ((), query''', tag'')

188+ ((m'@(Any needsDummies), b), query'', tag''') = qa' ((), tag'')

195 query'''

189 query'''

196− | needsDummies = query''

190+ | needsDummies = \lateral -> query'' lateral . query' lateral

197− | otherwise = query'

191+ | otherwise = \lateral -> query'' lateral . query lateral

198 m'' = m <> m'

192 m'' = m <> m'

199 in

193 in

200− ((m'', b), query'''', tag''')

194+ ((m'', b), query''', tag''')

201

195

202

196

203-- | '<|>:' = 'unionAll'.

197-- | '<|>:' = 'unionAll'.

src/Rel8/Query/Evaluate.hs+2−2

@@ -55,13 +55,13 @@ laterally a = Query $ \bindings -> pure $ (Any True,) $

55-- variable in the SQL. The @a@ returned consists only of these

56-- variables. It's essentially a @let@ binding for Postgres expressions.

57rebind :: Table Expr a => a -> Query a

58−rebind a = Query $ \_ -> Opaleye.QueryArr $ \(_, query, tag) ->

58+rebind a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->

59 let

60 tag' = Opaleye.next tag

61 (a', bindings) = Opaleye.run $

62 Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "eval" tag') a

63 in

64− ((mempty, a'), Opaleye.Rebind True bindings query, tag')

64+ ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag')

67foldl1' :: (a -> a -> a) -> NonEmpty a -> a

src/Rel8/Query/Maybe.hs+6−18

@@ -9,15 +9,11 @@ where

9import Prelude

11-- opaleye

12−import qualified Opaleye.Internal.PackMap as Opaleye

12+import qualified Opaleye.Internal.MaybeFields as Opaleye

13−import qualified Opaleye.Internal.PrimQuery as Opaleye

14−import qualified Opaleye.Internal.QueryArr as Opaleye

15−import qualified Opaleye.Internal.Tag as Opaleye

17-- rel8

14-- rel8

18−import Rel8.Expr.Bool ( true )

19import Rel8.Expr.Eq ( (==.) )

15import Rel8.Expr.Eq ( (==.) )

20−import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )

16+import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr )

21import Rel8.Query ( Query )

17import Rel8.Query ( Query )

22import Rel8.Query.Filter ( where_ )

18import Rel8.Query.Filter ( where_ )

23import Rel8.Query.Opaleye ( mapOpaleye )

19import Rel8.Query.Opaleye ( mapOpaleye )

@@ -31,18 +27,10 @@ import Rel8.Table.Tag ( Tag(..), fromExpr )

31-- To speak in more concrete terms, 'optional' is most useful to write @LEFT

27-- To speak in more concrete terms, 'optional' is most useful to write @LEFT

32-- JOIN@s.

28-- JOIN@s.

33optional :: Query a -> Query (MaybeTable a)

29optional :: Query a -> Query (MaybeTable a)

34−optional = mapOpaleye $ \query -> Opaleye.QueryArr $ \i -> case i of

30+optional =

35− (_, left, tag) -> (ma', join, tag'')

31+ mapOpaleye $

36− where

32+ Opaleye.optionalInternal $

37− (ma, right, tag') = Opaleye.runSimpleQueryArr (pure <$> query) ((), tag)

33+ MaybeTable . fromExpr . fromPrimExpr . fromColumn

38− MaybeTable Tag {expr = just} a = ma

39− (just', bindings) = Opaleye.run $ do

40− traversePrimExpr (Opaleye.extractAttr "isJust" tag') just

41− tag'' = Opaleye.next tag'

42− join = Opaleye.Join Opaleye.LeftJoin on [] bindings left right

43− where

44− on = toPrimExpr true

45− ma' = MaybeTable (fromExpr just') a

48-- | Filter out 'MaybeTable's, returning only the tables that are not-null.

36-- | Filter out 'MaybeTable's, returning only the tables that are not-null.

src/Rel8/Query/Opaleye.hs+7−7

@@ -40,23 +40,23 @@ zipOpaleyeWith f (Query a) (Query b) = Query $ liftA2 (zipping f) a b

40mapping :: ()

41 => (Opaleye.Select a -> Opaleye.Select b)

42 -> Opaleye.Select (m, a) -> Opaleye.Select (m, b)

43−mapping f q@(Opaleye.QueryArr qa) = Opaleye.QueryArr $ \(_, query, tag) ->

43+mapping f q@(Opaleye.QueryArr qa) = Opaleye.QueryArr $ \(_, tag) ->

44 let

45− ((m, _), _, _) = qa ((), query, tag)

45+ ((m, _), _, _) = qa ((), tag)

46 Opaleye.QueryArr qa' = (m,) <$> f (snd <$> q)

47 in

48− qa' ((), query, tag)

48+ qa' ((), tag)

51zipping :: Semigroup m

52 => (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c)

53 -> Opaleye.Select (m, a) -> Opaleye.Select (m, b) -> Opaleye.Select (m, c)

54zipping f q@(Opaleye.QueryArr qa) q'@(Opaleye.QueryArr qa') =

55− Opaleye.QueryArr $ \(_, query, tag) ->

55+ Opaleye.QueryArr $ \(_, tag) ->

56 let

57− ((m, _), _, _) = qa ((), query, tag)

57+ ((m, _), _, _) = qa ((), tag)

58− ((m', _), _, _) = qa' ((), query, tag)

58+ ((m', _), _, _) = qa' ((), tag)

59 m'' = m <> m'

60 Opaleye.QueryArr qa'' = (m'',) <$> f (snd <$> q) (snd <$> q')

61 in

62− qa'' ((), query, tag)

62+ qa'' ((), tag)

src/Rel8/Query/These.hs+5−3

@@ -46,7 +46,7 @@ alignBy :: ()

46 => (a -> b -> Expr Bool)

47 -> Query a -> Query b -> Query (TheseTable a b)

48alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> case i of

49− (_, input, tag) -> (tab, join', tag''')

49+ (_, tag) -> (tab, join', tag''')

50 where

51 (ma, left', tag') = Opaleye.runSimpleQueryArr (pure <$> left) ((), tag)

52 (mb, right', tag'') = Opaleye.runSimpleQueryArr (pure <$> right) ((), tag')

@@ -57,13 +57,15 @@ alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> cas

57 (hasThere', rbindings) = Opaleye.run $ do

58 traversePrimExpr (Opaleye.extractAttr "hasThere" tag'') hasThere

59 tag''' = Opaleye.next tag''

60− join = Opaleye.Join Opaleye.FullJoin on lbindings rbindings left' right'

60+ join lateral = Opaleye.Join Opaleye.FullJoin on left'' right''

61 where

62 on = toPrimExpr $ condition a b

63+ left'' = (lateral, Opaleye.Rebind True lbindings left')

64+ right'' = (lateral, Opaleye.Rebind True rbindings right')

63 ma' = MaybeTable (fromExpr hasHere') a

65 ma' = MaybeTable (fromExpr hasHere') a

64 mb' = MaybeTable (fromExpr hasThere') b

66 mb' = MaybeTable (fromExpr hasThere') b

65 tab = TheseTable {here = ma', there = mb'}

67 tab = TheseTable {here = ma', there = mb'}

66− join' = Opaleye.times input join

68+ join' lateral input = Opaleye.times lateral input (join lateral)

69-- | Filter 'TheseTable's, keeping only 'thisTable's and 'thoseTable's.

71-- | Filter 'TheseTable's, keeping only 'thisTable's and 'thoseTable's.

tests/Main.hs+6−6

@@ -759,13 +759,13 @@ testEvaluate = databasePropertyTest "evaluate has the evaluation order we expect

759

760 normalize selected' ===

761 [ (('a', 'd'), (0, 0))

762+ , (('a', 'e'), (1, 1))

763+ , (('a', 'f'), (2, 2))

762− , (('b', 'd'), (1, 1))

764+ , (('b', 'd'), (3, 3))

763− , (('c', 'd'), (2, 2))

764− , (('a', 'e'), (3, 3))

765 , (('b', 'e'), (4, 4))

766+ , (('b', 'f'), (5, 5))

767+ , (('c', 'd'), (6, 6))

766− , (('c', 'e'), (5, 5))

768+ , (('c', 'e'), (7, 7))

767− , (('a', 'f'), (6, 6))

768− , (('b', 'f'), (7, 7))

769 , (('c', 'f'), (8, 8))

770 ]

771