{-# language FlexibleContexts #-}

module Rel8.Query.Values
  ( values
  )
where

-- base
import Data.Foldable ( toList )
import Prelude

-- opaleye
import qualified Opaleye.Values as Opaleye

-- rel8
import Rel8.Expr ( Expr )
import {-# SOURCE #-} Rel8.Query ( Query )
import Rel8.Query.Opaleye ( fromOpaleye )
import Rel8.Table ( Table )
import Rel8.Table.Opaleye ( valuesspec )


-- | Construct a query that returns the given input list of rows. This is like
-- folding a list of 'return' statements under 'Rel8.union', but uses the SQL
-- @VALUES@ expression for efficiency.
values :: (Table Expr a, Foldable f) => f a -> Query a
values :: f a -> Query a
values = Select a -> Query a
forall a. Select a -> Query a
fromOpaleye (Select a -> Query a) -> (f a -> Select a) -> f a -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Valuesspec a a -> [a] -> Select a
forall fields fields'.
Valuesspec fields fields' -> [fields] -> Select fields'
Opaleye.valuesExplicit Valuesspec a a
forall a. Table Expr a => ValuesspecSafe a a
valuesspec ([a] -> Select a) -> (f a -> [a]) -> f a -> Select a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList