{-# language DeriveTraversable #-}
{-# language DerivingStrategies #-}
{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
module Rel8.Statement.Select
( select
, ppSelect
, Optimized(..)
, ppPrimSelect
, ppRows
)
where
import Data.Foldable ( toList )
import Data.Kind ( Type )
import Data.Void ( Void )
import Prelude hiding ( undefined )
import qualified Hasql.Decoders as Hasql
import qualified Hasql.Encoders as Hasql
import qualified Hasql.Statement as Hasql
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
import qualified Opaleye.Internal.PrimQuery as Opaleye
import qualified Opaleye.Internal.Print as Opaleye
import qualified Opaleye.Internal.Optimize as Opaleye
import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
import qualified Opaleye.Internal.Sql as Opaleye hiding ( Values )
import qualified Opaleye.Internal.Tag as Opaleye
import Text.PrettyPrint ( Doc )
import Rel8.Expr ( Expr )
import Rel8.Expr.Bool ( false )
import Rel8.Expr.Opaleye ( toPrimExpr )
import Rel8.Query ( Query )
import Rel8.Query.Opaleye ( toOpaleye )
import Rel8.Schema.Name ( Selects )
import Rel8.Table ( Table )
import Rel8.Table.Cols ( toCols )
import Rel8.Table.Name ( namesFromLabels )
import Rel8.Table.Opaleye ( castTable, exprsWithNames )
import qualified Rel8.Table.Opaleye as T
import Rel8.Table.Serialize ( Serializable, parse )
import Rel8.Table.Undefined ( undefined )
import qualified Data.Text as Text
import Data.Text.Encoding ( encodeUtf8 )
select :: forall exprs a. Serializable exprs a
=> Query exprs -> Hasql.Statement () [a]
select :: forall exprs a.
Serializable exprs a =>
Query exprs -> Statement () [a]
select Query exprs
query = forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Hasql.Statement ByteString
bytes Params ()
params Result [a]
decode Bool
prepare
where
bytes :: ByteString
bytes = Text -> ByteString
encodeUtf8 (String -> Text
Text.pack String
sql)
params :: Params ()
params = Params ()
Hasql.noParams
decode :: Result [a]
decode = forall a. Row a -> Result [a]
Hasql.rowList (forall exprs a. Serializable exprs a => Row a
parse @exprs @a)
prepare :: Bool
prepare = Bool
False
sql :: String
sql = forall a. Show a => a -> String
show Doc
doc
doc :: Doc
doc = forall a. Table Expr a => Query a -> Doc
ppSelect Query exprs
query
ppSelect :: Table Expr a => Query a -> Doc
ppSelect :: forall a. Table Expr a => Query a -> Doc
ppSelect Query a
query =
Select -> Doc
Opaleye.ppSql forall a b. (a -> b) -> a -> b
$ forall names exprs.
Selects names exprs =>
names -> exprs -> PrimQuery' Void -> Select
primSelectWith Cols Name (Columns a)
names (forall (context :: Context) a.
Table context a =>
a -> Cols context (Columns a)
toCols a
exprs') PrimQuery' Void
primQuery'
where
names :: Cols Name (Columns a)
names = forall a. Table Name a => a
namesFromLabels
(a
exprs, PrimQuery
primQuery, Tag
_) =
forall a b. QueryArr a b -> a -> (b, PrimQuery, Tag)
Opaleye.runSimpleQueryArrStart (forall a. Query a -> Select a
toOpaleye Query a
query) ()
(a
exprs', PrimQuery' Void
primQuery') = case forall a. PrimQuery' a -> Optimized (PrimQuery' Void)
optimize PrimQuery
primQuery of
Optimized (PrimQuery' Void)
Empty -> (forall a. Table Expr a => a
undefined, forall a.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
Opaleye.Product (forall (f :: Context) a. Applicative f => a -> f a
pure (forall (f :: Context) a. Applicative f => a -> f a
pure forall a. PrimQuery' a
Opaleye.Unit)) [PrimExpr]
never)
Optimized (PrimQuery' Void)
Unit -> (a
exprs, forall a. PrimQuery' a
Opaleye.Unit)
Optimized PrimQuery' Void
pq -> (a
exprs, PrimQuery' Void
pq)
never :: [PrimExpr]
never = forall (f :: Context) a. Applicative f => a -> f a
pure (forall a. Expr a -> PrimExpr
toPrimExpr Expr Bool
false)
ppRows :: Table Expr a => Query a -> Doc
ppRows :: forall a. Table Expr a => Query a -> Doc
ppRows Query a
query = case forall a. PrimQuery' a -> Optimized (PrimQuery' Void)
optimize PrimQuery
primQuery of
Optimized (Opaleye.Values [Symbol]
symbols NonEmpty [PrimExpr]
rows)
| [Symbol] -> [PrimExpr] -> Bool
eqSymbols [Symbol]
symbols (forall (t :: Context) a. Foldable t => t a -> [a]
toList (forall a. Table Expr a => a -> NonEmpty PrimExpr
T.exprs a
a)) ->
[[SqlExpr]] -> Doc
Opaleye.ppValues_ (forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
Opaleye.sqlExpr forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: Context) a. Foldable t => t a -> [a]
toList NonEmpty [PrimExpr]
rows)
Optimized (PrimQuery' Void)
_ -> forall a. Table Expr a => Query a -> Doc
ppSelect Query a
query
where
(a
a, PrimQuery
primQuery, Tag
_) = forall a b. QueryArr a b -> a -> (b, PrimQuery, Tag)
Opaleye.runSimpleQueryArrStart (forall a. Query a -> Select a
toOpaleye Query a
query) ()
eqSymbols :: [Symbol] -> [PrimExpr] -> Bool
eqSymbols (Symbol
symbol : [Symbol]
symbols) (Opaleye.AttrExpr Symbol
symbol' : [PrimExpr]
exprs)
| Symbol -> Symbol -> Bool
eqSymbol Symbol
symbol Symbol
symbol' = [Symbol] -> [PrimExpr] -> Bool
eqSymbols [Symbol]
symbols [PrimExpr]
exprs
| Bool
otherwise = Bool
False
eqSymbols [] [] = Bool
True
eqSymbols [Symbol]
_ [PrimExpr]
_ = Bool
False
eqSymbol :: Symbol -> Symbol -> Bool
eqSymbol
(Opaleye.Symbol String
name (Opaleye.UnsafeTag Int
tag))
(Opaleye.Symbol String
name' (Opaleye.UnsafeTag Int
tag'))
= String
name forall a. Eq a => a -> a -> Bool
== String
name' Bool -> Bool -> Bool
&& Int
tag forall a. Eq a => a -> a -> Bool
== Int
tag'
ppPrimSelect :: Query a -> (Optimized Doc, a)
ppPrimSelect :: forall a. Query a -> (Optimized Doc, a)
ppPrimSelect Query a
query =
(Select -> Doc
Opaleye.ppSql forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimQuery' Void -> Select
primSelect forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. PrimQuery' a -> Optimized (PrimQuery' Void)
optimize PrimQuery
primQuery, a
a)
where
(a
a, PrimQuery
primQuery, Tag
_) = forall a b. QueryArr a b -> a -> (b, PrimQuery, Tag)
Opaleye.runSimpleQueryArrStart (forall a. Query a -> Select a
toOpaleye Query a
query) ()
type Optimized :: Type -> Type
data Optimized a = Empty | Unit | Optimized a
deriving stock (forall a b. a -> Optimized b -> Optimized a
forall a b. (a -> b) -> Optimized a -> Optimized b
forall (f :: Context).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Optimized b -> Optimized a
$c<$ :: forall a b. a -> Optimized b -> Optimized a
fmap :: forall a b. (a -> b) -> Optimized a -> Optimized b
$cfmap :: forall a b. (a -> b) -> Optimized a -> Optimized b
Functor, forall a. Eq a => a -> Optimized a -> Bool
forall a. Num a => Optimized a -> a
forall a. Ord a => Optimized a -> a
forall m. Monoid m => Optimized m -> m
forall a. Optimized a -> Bool
forall a. Optimized a -> Int
forall a. Optimized a -> [a]
forall a. (a -> a -> a) -> Optimized a -> a
forall m a. Monoid m => (a -> m) -> Optimized a -> m
forall b a. (b -> a -> b) -> b -> Optimized a -> b
forall a b. (a -> b -> b) -> b -> Optimized a -> b
forall (t :: Context).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Optimized a -> a
$cproduct :: forall a. Num a => Optimized a -> a
sum :: forall a. Num a => Optimized a -> a
$csum :: forall a. Num a => Optimized a -> a
minimum :: forall a. Ord a => Optimized a -> a
$cminimum :: forall a. Ord a => Optimized a -> a
maximum :: forall a. Ord a => Optimized a -> a
$cmaximum :: forall a. Ord a => Optimized a -> a
elem :: forall a. Eq a => a -> Optimized a -> Bool
$celem :: forall a. Eq a => a -> Optimized a -> Bool
length :: forall a. Optimized a -> Int
$clength :: forall a. Optimized a -> Int
null :: forall a. Optimized a -> Bool
$cnull :: forall a. Optimized a -> Bool
toList :: forall a. Optimized a -> [a]
$ctoList :: forall a. Optimized a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Optimized a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Optimized a -> a
foldr1 :: forall a. (a -> a -> a) -> Optimized a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Optimized a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Optimized a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Optimized a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Optimized a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Optimized a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Optimized a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Optimized a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Optimized a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Optimized a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Optimized a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Optimized a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Optimized a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Optimized a -> m
fold :: forall m. Monoid m => Optimized m -> m
$cfold :: forall m. Monoid m => Optimized m -> m
Foldable, Functor Optimized
Foldable Optimized
forall (t :: Context).
Functor t
-> Foldable t
-> (forall (f :: Context) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: Context) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: Context) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: Context) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Context) a.
Monad m =>
Optimized (m a) -> m (Optimized a)
forall (f :: Context) a.
Applicative f =>
Optimized (f a) -> f (Optimized a)
forall (m :: Context) a b.
Monad m =>
(a -> m b) -> Optimized a -> m (Optimized b)
forall (f :: Context) a b.
Applicative f =>
(a -> f b) -> Optimized a -> f (Optimized b)
sequence :: forall (m :: Context) a.
Monad m =>
Optimized (m a) -> m (Optimized a)
$csequence :: forall (m :: Context) a.
Monad m =>
Optimized (m a) -> m (Optimized a)
mapM :: forall (m :: Context) a b.
Monad m =>
(a -> m b) -> Optimized a -> m (Optimized b)
$cmapM :: forall (m :: Context) a b.
Monad m =>
(a -> m b) -> Optimized a -> m (Optimized b)
sequenceA :: forall (f :: Context) a.
Applicative f =>
Optimized (f a) -> f (Optimized a)
$csequenceA :: forall (f :: Context) a.
Applicative f =>
Optimized (f a) -> f (Optimized a)
traverse :: forall (f :: Context) a b.
Applicative f =>
(a -> f b) -> Optimized a -> f (Optimized b)
$ctraverse :: forall (f :: Context) a b.
Applicative f =>
(a -> f b) -> Optimized a -> f (Optimized b)
Traversable, Int -> Optimized a -> ShowS
forall a. Show a => Int -> Optimized a -> ShowS
forall a. Show a => [Optimized a] -> ShowS
forall a. Show a => Optimized a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Optimized a] -> ShowS
$cshowList :: forall a. Show a => [Optimized a] -> ShowS
show :: Optimized a -> String
$cshow :: forall a. Show a => Optimized a -> String
showsPrec :: Int -> Optimized a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Optimized a -> ShowS
Show)
optimize :: Opaleye.PrimQuery' a -> Optimized (Opaleye.PrimQuery' Void)
optimize :: forall a. PrimQuery' a -> Optimized (PrimQuery' Void)
optimize PrimQuery' a
query = case forall a b. PrimQuery' a -> Maybe (PrimQuery' b)
Opaleye.removeEmpty (forall a. PrimQuery' a -> PrimQuery' a
Opaleye.optimize PrimQuery' a
query) of
Maybe (PrimQuery' Void)
Nothing -> forall a. Optimized a
Empty
Just PrimQuery' Void
Opaleye.Unit -> forall a. Optimized a
Unit
Just PrimQuery' Void
query' -> forall a. a -> Optimized a
Optimized PrimQuery' Void
query'
primSelect :: Opaleye.PrimQuery' Void -> Opaleye.Select
primSelect :: PrimQuery' Void -> Select
primSelect = forall a p. PrimQueryFold' a p -> PrimQuery' a -> p
Opaleye.foldPrimQuery PrimQueryFold' Void Select
Opaleye.sqlQueryGenerator
primSelectWith :: Selects names exprs
=> names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
primSelectWith :: forall names exprs.
Selects names exprs =>
names -> exprs -> PrimQuery' Void -> Select
primSelectWith names
names exprs
exprs PrimQuery' Void
query =
From -> Select
Opaleye.SelectFrom forall a b. (a -> b) -> a -> b
$ From
Opaleye.newSelect
{ attrs :: SelectAttrs
Opaleye.attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
Opaleye.SelectAttrs NonEmpty (SqlExpr, Maybe SqlColumn)
attrs
, tables :: [(Lateral, Select)]
Opaleye.tables = forall t. t -> [(Lateral, t)]
Opaleye.oneTable (PrimQuery' Void -> Select
primSelect PrimQuery' Void
query)
}
where
attrs :: NonEmpty (SqlExpr, Maybe SqlColumn)
attrs = (String, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
makeAttr forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> forall names exprs.
Selects names exprs =>
names -> exprs -> NonEmpty (String, PrimExpr)
exprsWithNames names
names (forall a. Table Expr a => a -> a
castTable exprs
exprs)
where
makeAttr :: (String, PrimExpr) -> (SqlExpr, Maybe SqlColumn)
makeAttr (String
label, PrimExpr
expr) =
(PrimExpr -> SqlExpr
Opaleye.sqlExpr PrimExpr
expr, forall a. a -> Maybe a
Just (String -> SqlColumn
Opaleye.SqlColumn String
label))