{-# language DeriveTraversable #-}
{-# language DerivingStrategies #-}
{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}

module Rel8.Statement.Select
  ( select
  , ppSelect

  , Optimized(..)
  , ppPrimSelect
  , ppRows
  )
where

-- base
import Data.Foldable ( toList )
import Data.Kind ( Type )
import Data.Void ( Void )
import Prelude hiding ( undefined )

-- hasql
import qualified Hasql.Decoders as Hasql
import qualified Hasql.Encoders as Hasql
import qualified Hasql.Statement as Hasql

-- opaleye
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

-- pretty
import Text.PrettyPrint ( Doc )

-- rel8
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 )

-- text
import qualified Data.Text as Text
import Data.Text.Encoding ( encodeUtf8 )


-- | Run a @SELECT@ statement, returning all rows.
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
  -- Special case VALUES because we can't use DEFAULT inside a SELECT
  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))