{-# 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.List.NonEmpty ( NonEmpty( (:|) ) )
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 :: Query exprs -> Statement () [a]
select Query exprs
query = ByteString -> Params () -> Result [a] -> Bool -> Statement () [a]
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 = Row a -> Result [a]
forall a. Row a -> Result [a]
Hasql.rowList (Serializable exprs a => Row a
forall exprs a. Serializable exprs a => Row a
parse @exprs @a)
    prepare :: Bool
prepare = Bool
False
    sql :: String
sql = Doc -> String
forall a. Show a => a -> String
show Doc
doc
    doc :: Doc
doc = Query exprs -> Doc
forall a. Table Expr a => Query a -> Doc
ppSelect Query exprs
query


ppSelect :: Table Expr a => Query a -> Doc
ppSelect :: Query a -> Doc
ppSelect Query a
query =
  Select -> Doc
Opaleye.ppSql (Select -> Doc) -> Select -> Doc
forall a b. (a -> b) -> a -> b
$ Cols Name (Columns a)
-> Cols Expr (Columns a) -> PrimQuery' Void -> Select
forall names exprs.
Selects names exprs =>
names -> exprs -> PrimQuery' Void -> Select
primSelectWith Cols Name (Columns a)
names (a -> Cols Expr (Columns a)
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 = Cols Name (Columns a)
forall a. Table Name a => a
namesFromLabels
    (a
exprs, PrimQuery
primQuery, Tag
_) =
      QueryArr () a -> () -> (a, PrimQuery, Tag)
forall a b. QueryArr a b -> a -> (b, PrimQuery, Tag)
Opaleye.runSimpleQueryArrStart (Query a -> QueryArr () a
forall a. Query a -> Select a
toOpaleye Query a
query) ()
    (a
exprs', PrimQuery' Void
primQuery') = case PrimQuery -> Optimized (PrimQuery' Void)
forall a. PrimQuery' a -> Optimized (PrimQuery' Void)
optimize PrimQuery
primQuery of
      Optimized (PrimQuery' Void)
Empty -> (a
forall a. Table Expr a => a
undefined, NonEmpty (Lateral, PrimQuery' Void)
-> [PrimExpr] -> PrimQuery' Void
forall a.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
Opaleye.Product ((Lateral, PrimQuery' Void) -> NonEmpty (Lateral, PrimQuery' Void)
forall (f :: Context) a. Applicative f => a -> f a
pure (PrimQuery' Void -> (Lateral, PrimQuery' Void)
forall (f :: Context) a. Applicative f => a -> f a
pure PrimQuery' Void
forall a. PrimQuery' a
Opaleye.Unit)) [PrimExpr]
never)
      Optimized (PrimQuery' Void)
Unit -> (a
exprs, PrimQuery' Void
forall a. PrimQuery' a
Opaleye.Unit)
      Optimized PrimQuery' Void
pq -> (a
exprs, PrimQuery' Void
pq)
    never :: [PrimExpr]
never = PrimExpr -> [PrimExpr]
forall (f :: Context) a. Applicative f => a -> f a
pure (Expr Bool -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr Bool
false)


ppRows :: Table Expr a => Query a -> Doc
ppRows :: Query a -> Doc
ppRows Query a
query = case PrimQuery -> Optimized (PrimQuery' Void)
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.Product ((Lateral
_, Opaleye.Values [Symbol]
symbols NonEmpty [PrimExpr]
rows) :| []) [])
    | [Symbol] -> [PrimExpr] -> Bool
eqSymbols [Symbol]
symbols (NonEmpty PrimExpr -> [PrimExpr]
forall (t :: Context) a. Foldable t => t a -> [a]
toList (a -> NonEmpty PrimExpr
forall a. Table Expr a => a -> NonEmpty PrimExpr
T.exprs a
a)) ->
        [[SqlExpr]] -> Doc
Opaleye.ppValues_ ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
Opaleye.sqlExpr ([PrimExpr] -> [SqlExpr]) -> [[PrimExpr]] -> [[SqlExpr]]
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty [PrimExpr] -> [[PrimExpr]]
forall (t :: Context) a. Foldable t => t a -> [a]
toList NonEmpty [PrimExpr]
rows)
  Optimized (PrimQuery' Void)
_ -> Query a -> Doc
forall a. Table Expr a => Query a -> Doc
ppSelect Query a
query
  where
    (a
a, PrimQuery
primQuery, Tag
_) = QueryArr () a -> () -> (a, PrimQuery, Tag)
forall a b. QueryArr a b -> a -> (b, PrimQuery, Tag)
Opaleye.runSimpleQueryArrStart (Query a -> QueryArr () a
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name' Bool -> Bool -> Bool
&& Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
tag'


ppPrimSelect :: Query a -> (Optimized Doc, a)
ppPrimSelect :: Query a -> (Optimized Doc, a)
ppPrimSelect Query a
query =
  (Select -> Doc
Opaleye.ppSql (Select -> Doc)
-> (PrimQuery' Void -> Select) -> PrimQuery' Void -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimQuery' Void -> Select
primSelect (PrimQuery' Void -> Doc)
-> Optimized (PrimQuery' Void) -> Optimized Doc
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimQuery -> Optimized (PrimQuery' Void)
forall a. PrimQuery' a -> Optimized (PrimQuery' Void)
optimize PrimQuery
primQuery, a
a)
  where
    (a
a, PrimQuery
primQuery, Tag
_) = QueryArr () a -> () -> (a, PrimQuery, Tag)
forall a b. QueryArr a b -> a -> (b, PrimQuery, Tag)
Opaleye.runSimpleQueryArrStart (Query a -> QueryArr () a
forall a. Query a -> Select a
toOpaleye Query a
query) ()


type Optimized :: Type -> Type
data Optimized a = Empty | Unit | Optimized a
  deriving stock (a -> Optimized b -> Optimized a
(a -> b) -> Optimized a -> Optimized b
(forall a b. (a -> b) -> Optimized a -> Optimized b)
-> (forall a b. a -> Optimized b -> Optimized a)
-> Functor Optimized
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
<$ :: a -> Optimized b -> Optimized a
$c<$ :: forall a b. a -> Optimized b -> Optimized a
fmap :: (a -> b) -> Optimized a -> Optimized b
$cfmap :: forall a b. (a -> b) -> Optimized a -> Optimized b
Functor, Optimized a -> Bool
(a -> m) -> Optimized a -> m
(a -> b -> b) -> b -> Optimized a -> b
(forall m. Monoid m => Optimized m -> m)
-> (forall m a. Monoid m => (a -> m) -> Optimized a -> m)
-> (forall m a. Monoid m => (a -> m) -> Optimized a -> m)
-> (forall a b. (a -> b -> b) -> b -> Optimized a -> b)
-> (forall a b. (a -> b -> b) -> b -> Optimized a -> b)
-> (forall b a. (b -> a -> b) -> b -> Optimized a -> b)
-> (forall b a. (b -> a -> b) -> b -> Optimized a -> b)
-> (forall a. (a -> a -> a) -> Optimized a -> a)
-> (forall a. (a -> a -> a) -> Optimized a -> a)
-> (forall a. Optimized a -> [a])
-> (forall a. Optimized a -> Bool)
-> (forall a. Optimized a -> Int)
-> (forall a. Eq a => a -> Optimized a -> Bool)
-> (forall a. Ord a => Optimized a -> a)
-> (forall a. Ord a => Optimized a -> a)
-> (forall a. Num a => Optimized a -> a)
-> (forall a. Num a => Optimized a -> a)
-> Foldable Optimized
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 :: Optimized a -> a
$cproduct :: forall a. Num a => Optimized a -> a
sum :: Optimized a -> a
$csum :: forall a. Num a => Optimized a -> a
minimum :: Optimized a -> a
$cminimum :: forall a. Ord a => Optimized a -> a
maximum :: Optimized a -> a
$cmaximum :: forall a. Ord a => Optimized a -> a
elem :: a -> Optimized a -> Bool
$celem :: forall a. Eq a => a -> Optimized a -> Bool
length :: Optimized a -> Int
$clength :: forall a. Optimized a -> Int
null :: Optimized a -> Bool
$cnull :: forall a. Optimized a -> Bool
toList :: Optimized a -> [a]
$ctoList :: forall a. Optimized a -> [a]
foldl1 :: (a -> a -> a) -> Optimized a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Optimized a -> a
foldr1 :: (a -> a -> a) -> Optimized a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Optimized a -> a
foldl' :: (b -> a -> b) -> b -> Optimized a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Optimized a -> b
foldl :: (b -> a -> b) -> b -> Optimized a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Optimized a -> b
foldr' :: (a -> b -> b) -> b -> Optimized a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Optimized a -> b
foldr :: (a -> b -> b) -> b -> Optimized a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Optimized a -> b
foldMap' :: (a -> m) -> Optimized a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Optimized a -> m
foldMap :: (a -> m) -> Optimized a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Optimized a -> m
fold :: Optimized m -> m
$cfold :: forall m. Monoid m => Optimized m -> m
Foldable, Functor Optimized
Foldable Optimized
Functor Optimized
-> Foldable Optimized
-> (forall (f :: Context) a b.
    Applicative f =>
    (a -> f b) -> Optimized a -> f (Optimized b))
-> (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 (m :: Context) a.
    Monad m =>
    Optimized (m a) -> m (Optimized a))
-> Traversable Optimized
(a -> f b) -> Optimized a -> f (Optimized b)
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 :: Optimized (m a) -> m (Optimized a)
$csequence :: forall (m :: Context) a.
Monad m =>
Optimized (m a) -> m (Optimized a)
mapM :: (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 :: Optimized (f a) -> f (Optimized a)
$csequenceA :: forall (f :: Context) a.
Applicative f =>
Optimized (f a) -> f (Optimized a)
traverse :: (a -> f b) -> Optimized a -> f (Optimized b)
$ctraverse :: forall (f :: Context) a b.
Applicative f =>
(a -> f b) -> Optimized a -> f (Optimized b)
$cp2Traversable :: Foldable Optimized
$cp1Traversable :: Functor Optimized
Traversable)


optimize :: Opaleye.PrimQuery' a -> Optimized (Opaleye.PrimQuery' Void)
optimize :: PrimQuery' a -> Optimized (PrimQuery' Void)
optimize PrimQuery' a
query = case PrimQuery' a -> Maybe (PrimQuery' Void)
forall a b. PrimQuery' a -> Maybe (PrimQuery' b)
Opaleye.removeEmpty (PrimQuery' a -> PrimQuery' a
forall a. PrimQuery' a -> PrimQuery' a
Opaleye.optimize PrimQuery' a
query) of
  Maybe (PrimQuery' Void)
Nothing -> Optimized (PrimQuery' Void)
forall a. Optimized a
Empty
  Just PrimQuery' Void
Opaleye.Unit -> Optimized (PrimQuery' Void)
forall a. Optimized a
Unit
  Just PrimQuery' Void
query' -> PrimQuery' Void -> Optimized (PrimQuery' Void)
forall a. a -> Optimized a
Optimized PrimQuery' Void
query'


primSelect :: Opaleye.PrimQuery' Void -> Opaleye.Select
primSelect :: PrimQuery' Void -> Select
primSelect = PrimQueryFold' Void Select -> PrimQuery' Void -> Select
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 :: names -> exprs -> PrimQuery' Void -> Select
primSelectWith names
names exprs
exprs PrimQuery' Void
query =
  From -> Select
Opaleye.SelectFrom (From -> Select) -> From -> Select
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 = Select -> [(Lateral, Select)]
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 ((String, PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> NonEmpty (String, PrimExpr)
-> NonEmpty (SqlExpr, Maybe SqlColumn)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> names -> exprs -> NonEmpty (String, PrimExpr)
forall names exprs.
Selects names exprs =>
names -> exprs -> NonEmpty (String, PrimExpr)
exprsWithNames names
names (exprs -> exprs
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, SqlColumn -> Maybe SqlColumn
forall a. a -> Maybe a
Just (String -> SqlColumn
Opaleye.SqlColumn String
label))