Changes required for Opaleye 0.9.1.0 (#165)

* Use distinctOnExplicit and distinctOnByExplicit

* Use rebindExplicitPrefix

* Use distinctOnExplicit

* Adapt to Opaleye 0.9.1.0 State monad based QueryArr

* opaleye -> 0.9.1.0

* Simplify alignBy

* Update Haskell.nix

Co-authored-by: Ollie Charles <ollie@ocharles.org.uk>

nix/sources.json

@@ -5,10 +5,10 @@
         "homepage": "https://input-output-hk.github.io/haskell.nix",
         "owner": "input-output-hk",
         "repo": "haskell.nix",
-        "rev": "bfb828ccb8621613677a9c226f65e3b46f3ef4ce",
-        "sha256": "0jx0bfm9zi3rav1s807y4nqvm3g487rj4bgxri7yyqq7z2cmpsnm",
+        "rev": "f3b66b194cd95bfd269a29f89b686eb62269a2b4",
+        "sha256": "16nk8ahn1n8fg24zrxj4bp4zrmacdw11zhjk80r5fnmshm232s47",
         "type": "tarball",
-        "url": "https://github.com/input-output-hk/haskell.nix/archive/bfb828ccb8621613677a9c226f65e3b46f3ef4ce.tar.gz",
+        "url": "https://github.com/input-output-hk/haskell.nix/archive/f3b66b194cd95bfd269a29f89b686eb62269a2b4.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "niv": {

rel8.cabal

@@ -27,7 +27,7 @@ library
     , comonad
     , contravariant
     , hasql ^>= 1.4.5.1 || ^>= 1.5.0.0
-    , opaleye ^>= 0.9.0.0
+    , opaleye ^>= 0.9.1.0
     , pretty
     , profunctors
     , product-profunctors

src/Rel8/Query.hs

@@ -15,7 +15,7 @@ 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
+import qualified Opaleye.Internal.PrimQuery as Opaleye hiding (lateral)
 import qualified Opaleye.Internal.QueryArr as Opaleye
 import qualified Opaleye.Internal.Tag as Opaleye
 
@@ -175,26 +175,26 @@ instance Bind Query where
 
 
 instance Monad Query where
-  Query q >>= f = Query $ \dummies -> Opaleye.QueryArr $ \(_, tag) ->
+  Query q >>= f = Query $ \dummies -> Opaleye.stateQueryArr $ \_ tag ->
     let
-      Opaleye.QueryArr qa = q dummies
-      ((m, a), query, tag') = qa ((), tag)
+      qa = q dummies
+      ((m, a), query, tag') = Opaleye.runStateQueryArr qa () tag
       Query q' = f a
       (dummies', query', tag'') =
         ( dummy : dummies
-        , \lateral -> Opaleye.Rebind True bindings . query lateral
+        , query <> Opaleye.aRebind bindings
         , Opaleye.next tag'
         )
         where
           (dummy, bindings) = Opaleye.run $ name random
             where
               random = Opaleye.FunExpr "random" []
               name = Opaleye.extractAttr "dummy" tag'
-      Opaleye.QueryArr qa' = Opaleye.lateral $ \_ -> q' dummies'
-      ((m'@(Any needsDummies), b), query'', tag''') = qa' ((), tag'')
+      qa' = Opaleye.lateral $ \_ -> q' dummies'
+      ((m'@(Any needsDummies), b), query'', tag''') = Opaleye.runStateQueryArr qa' () tag''
       query'''
-        | needsDummies = \lateral -> query'' lateral . query' lateral
-        | otherwise = \lateral -> query'' lateral . query lateral
+        | needsDummies = query' <> query''
+        | otherwise = query <> query''
       m'' = m <> m'
     in
       ((m'', b), query''', tag''')

src/Rel8/Query/Distinct.hs

@@ -11,8 +11,8 @@ where
 import Prelude
 
 -- opaleye
-import qualified Opaleye.Distinct as Opaleye hiding ( distinctOn, distinctOnBy )
-import qualified Opaleye.Internal.Order as Opaleye
+import qualified Opaleye.Distinct as Opaleye
+import qualified Opaleye.Order as Opaleye
 import qualified Opaleye.Internal.QueryArr as Opaleye
 
 -- rel8
@@ -33,13 +33,11 @@ distinct = mapOpaleye (Opaleye.distinctExplicit distinctspec)
 -- 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 (\q -> Opaleye.productQueryArr (Opaleye.distinctOn unpackspec proj . Opaleye.runSimpleQueryArr q))
+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 (\q -> Opaleye.productQueryArr (Opaleye.distinctOnBy unpackspec proj order . Opaleye.runSimpleQueryArr q))
+distinctOnBy proj (Order order) = mapOpaleye (Opaleye.distinctOnByExplicit unpackspec proj order)

src/Rel8/Query/Indexed.hs

@@ -23,12 +23,12 @@ import Rel8.Query.Opaleye ( mapOpaleye )
 
 -- | Pair each row of a query with its index within the query.
 indexed :: Query a -> Query (Expr Int64, a)
-indexed = mapOpaleye $ \(Opaleye.QueryArr f) -> Opaleye.QueryArr $ \(_, tag) ->
+indexed = mapOpaleye $ \f -> Opaleye.stateQueryArr $ \_ tag ->
   let
-    (a, query, tag') = f ((), tag)
+    (a, query, tag') = Opaleye.runStateQueryArr f () tag
     tag'' = Opaleye.next tag'
     window = Opaleye.ConstExpr $ Opaleye.OtherLit "ROW_NUMBER() OVER () - 1"
     (index, bindings) = Opaleye.run $ Opaleye.extractAttr "index" tag' window
-    query' lateral = Opaleye.Rebind True bindings . query lateral
+    query' = query <> Opaleye.aRebind bindings
   in
     ((fromPrimExpr index, a), query', tag'')

src/Rel8/Query/Opaleye.hs

@@ -41,30 +41,30 @@ zipOpaleyeWith f (Query a) (Query b) = Query $ liftA2 (zipping f) a b
 
 unsafePeekQuery :: Query a -> a
 unsafePeekQuery (Query q) = case q mempty of
-  Opaleye.QueryArr f -> case f ((), Opaleye.start) 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.QueryArr qa) = Opaleye.QueryArr $ \(_, tag) ->
+mapping f q = Opaleye.stateQueryArr $ \_ tag ->
   let
-    ((m, _), _, _) = qa ((), tag)
-    Opaleye.QueryArr qa' = (m,) <$> f (snd <$> q)
+    ((m, _), _, _) = Opaleye.runStateQueryArr q () tag
+    q' = (m,) <$> f (snd <$> q)
   in
-    qa' ((), tag)
+    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@(Opaleye.QueryArr qa) q'@(Opaleye.QueryArr qa') =
-  Opaleye.QueryArr $ \(_, tag) ->
+zipping f q q' =
+  Opaleye.stateQueryArr $ \_ tag ->
     let
-      ((m, _), _, _) = qa ((), tag)
-      ((m', _), _, _) = qa' ((), tag)
+      ((m, _), _, _) = Opaleye.runStateQueryArr q () tag
+      ((m', _), _, _) = Opaleye.runStateQueryArr q' () tag
       m'' = m <> m'
-      Opaleye.QueryArr qa'' = (m'',) <$> f (snd <$> q) (snd <$> q')
+      q'' = (m'',) <$> f (snd <$> q) (snd <$> q')
     in
-      qa'' ((), tag)
+      Opaleye.runStateQueryArr q'' () tag

src/Rel8/Query/Rebind.hs

@@ -7,29 +7,21 @@ where
 
 -- base
 import Prelude
+import Control.Arrow ((<<<))
 
 -- 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
-import qualified Opaleye.Internal.Unpackspec as Opaleye
+import qualified Opaleye.Internal.Rebind as Opaleye
 
 -- rel8
 import Rel8.Expr ( Expr )
-import Rel8.Query ( Query( Query ) )
+import Rel8.Query ( Query )
 import Rel8.Table ( Table )
 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 = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->
-  let
-    tag' = Opaleye.next tag
-    (a', bindings) = Opaleye.run $
-      Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr prefix tag) a
-  in
-    ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag')
+rebind prefix a = fromOpaleye (Opaleye.rebindExplicitPrefix prefix unpackspec <<< pure a)

src/Rel8/Query/These.hs

@@ -48,27 +48,27 @@ import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )
 alignBy :: ()
   => (a -> b -> Expr Bool)
   -> Query a -> Query b -> Query (TheseTable Expr a b)
-alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.QueryArr $ \i -> case i of
-  (_, tag) -> (tab, join', tag''')
+alignBy condition = zipOpaleyeWith $ \left right -> Opaleye.stateQueryArr $ \_ t -> case t of
+  tag -> (tab, join', tag''')
     where
-      (ma, left', tag') = Opaleye.runSimpleQueryArr (pure <$> left) ((), tag)
-      (mb, right', tag'') = Opaleye.runSimpleQueryArr (pure <$> right) ((), tag')
+      (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 lateral = Opaleye.Join Opaleye.FullJoin on left'' right''
+      join = Opaleye.Join Opaleye.FullJoin on left'' right''
         where
           on = toPrimExpr $ condition (extract a) (extract b)
-          left'' = (lateral, Opaleye.Rebind True lbindings left')
-          right'' = (lateral, Opaleye.Rebind True rbindings right')
+          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' lateral input = Opaleye.times lateral input (join lateral)
+      join' = Opaleye.aProduct join
 
 
 keepHereTable :: TheseTable Expr a b -> Query (a, MaybeTable Expr b)

src/Rel8/Tabulate.hs

@@ -69,9 +69,7 @@ import Control.Comonad ( extract )
 
 -- opaleye
 import qualified Opaleye.Aggregate as Opaleye
-import qualified Opaleye.Internal.Order as Opaleye
-import qualified Opaleye.Internal.QueryArr as Opaleye
-import qualified Opaleye.Order as Opaleye ( orderBy )
+import qualified Opaleye.Order as Opaleye ( orderBy, distinctOnExplicit )
 
 -- profunctors
 import Data.Profunctor ( dimap, lmap )
@@ -350,14 +348,7 @@ distinct (Tabulation f) = Tabulation $ \p ->
   case fst (unsafePeekQuery (f p)) of
     Nothing -> limit 1 (f p)
     Just _ ->
-      mapOpaleye
-        (\q ->
-          Opaleye.productQueryArr
-            ( Opaleye.distinctOn (key unpackspec) fst
-            . Opaleye.runSimpleQueryArr q
-            )
-        )
-        (f p)
+      mapOpaleye (Opaleye.distinctOnExplicit (key unpackspec) fst) (f p)
 
 
 -- | 'order' orders the /values/ of a 'Tabulation' within their