Add Rel8.Tabulate, a complementary API for writing queries (circuith…

…ub#70)

rel8.cabal

@@ -21,6 +21,7 @@ library
   build-depends:
       aeson
     , base ^>= 4.14 || ^>=4.15
+    , bifunctors
     , bytestring
     , case-insensitive
     , comonad
@@ -29,6 +30,7 @@ library
     , opaleye ^>= 0.7.3.0
     , pretty
     , profunctors
+    , product-profunctors
     , scientific
     , semialign
     , semigroupoids
@@ -52,6 +54,7 @@ library
     Rel8.Expr.Num
     Rel8.Expr.Text
     Rel8.Expr.Time
+    Rel8.Tabulate
 
   other-modules:
     Rel8.Aggregate

src/Rel8/Query.hs

@@ -23,10 +23,12 @@ import qualified Opaleye.Internal.Tag as Opaleye
 import Rel8.Query.Set ( unionAll )
 import Rel8.Query.Opaleye ( fromOpaleye )
 import Rel8.Query.Values ( values )
+import Rel8.Table ( fromColumns, toColumns )
 import Rel8.Table.Alternative
   ( AltTable, (<|>:)
   , AlternativeTable, emptyTable
   )
+import Rel8.Table.Projection ( Projectable, apply, project )
 
 -- semigroupoids
 import Data.Functor.Apply ( Apply, (<.>) )
@@ -151,6 +153,10 @@ newtype Query 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)
 

src/Rel8/Query/Opaleye.hs

@@ -5,6 +5,7 @@ module Rel8.Query.Opaleye
   , toOpaleye
   , mapOpaleye
   , zipOpaleyeWith
+  , unsafePeekQuery
   )
 where
 
@@ -14,6 +15,7 @@ import Prelude
 
 -- opaleye
 import qualified Opaleye.Internal.QueryArr as Opaleye
+import qualified Opaleye.Internal.Tag as Opaleye
 
 -- rel8
 import {-# SOURCE #-} Rel8.Query ( Query( Query ) )
@@ -37,6 +39,12 @@ zipOpaleyeWith :: ()
 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
+    ((_, a), _, _) -> a
+
+
 mapping :: ()
   => (Opaleye.Select a -> Opaleye.Select b)
   -> Opaleye.Select (m, a) -> Opaleye.Select (m, b)