{-# language FlexibleContexts #-}

module Rel8.Query.Rebind
  ( rebind
  , hrebind
  )
where

-- base
import Prelude
import Control.Arrow ((<<<))

-- opaleye
import qualified Opaleye.Internal.Rebind as Opaleye

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Query ( Query )
import Rel8.Query.Limit (offset)
import Rel8.Schema.HTable (HTable)
import Rel8.Table ( Table )
import Rel8.Table.Cols (Cols (Cols))
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 :: forall a. Table Expr a => String -> a -> Query a
rebind String
prefix a
a = Word -> Query a -> Query a
forall a. Word -> Query a -> Query a
offset Word
0 (Query a -> Query a) -> Query a -> Query a
forall a b. (a -> b) -> a -> b
$
  Select a -> Query a
forall a. Select a -> Query a
fromOpaleye (String -> Unpackspec a a -> SelectArr a a
forall a b. String -> Unpackspec a b -> SelectArr a b
Opaleye.rebindExplicitPrefix String
prefix Unpackspec a a
forall a. Table Expr a => Unpackspec a a
unpackspec SelectArr a a -> Select a -> Select a
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< a -> Select a
forall a. a -> SelectArr () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)


hrebind :: HTable t => String -> t Expr -> Query (t Expr)
hrebind :: forall (t :: HTable).
HTable t =>
String -> t Expr -> Query (t Expr)
hrebind String
prefix = (Cols Expr t -> t Expr) -> Query (Cols Expr t) -> Query (t Expr)
forall a b. (a -> b) -> Query a -> Query b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Cols t Expr
a) -> t Expr
a) (Query (Cols Expr t) -> Query (t Expr))
-> (t Expr -> Query (Cols Expr t)) -> t Expr -> Query (t Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Cols Expr t -> Query (Cols Expr t)
forall a. Table Expr a => String -> a -> Query a
rebind String
prefix (Cols Expr t -> Query (Cols Expr t))
-> (t Expr -> Cols Expr t) -> t Expr -> Query (Cols Expr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Expr -> Cols Expr t
forall (context :: * -> *) (columns :: HTable).
columns context -> Cols context columns
Cols