{-# language DataKinds #-}
{-# 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 )

-- 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.Statement (Statement, statementReturning)
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.Undefined ( undefined )

-- transformers
import Control.Monad.Trans.State.Strict (State)


-- | Build a @SELECT@ 'Statement'.
select :: Table Expr a => Query a -> Statement (Query a)
select :: forall a. Table Expr a => Query a -> Statement (Query a)
select Query a
query = State Tag Doc -> Statement (Query a)
forall a. Table Expr a => State Tag Doc -> Statement (Query a)
statementReturning (Query a -> State Tag Doc
forall a. Table Expr a => Query a -> State Tag Doc
ppSelect Query a
query)


ppSelect :: Table Expr a => Query a -> State Opaleye.Tag Doc
ppSelect :: forall a. Table Expr a => Query a -> State Tag Doc
ppSelect Query a
query = do
  (a
exprs, PrimQuery
primQuery) <- Select a -> State Tag (a, PrimQuery)
forall a. Select a -> State Tag (a, PrimQuery)
Opaleye.runSimpleSelect (Query a -> Select a
forall a. Query a -> Select a
toOpaleye Query a
query)
  let
    (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 a. a -> NonEmpty a
forall (f :: Context) a. Applicative f => a -> f a
pure (PrimQuery' Void -> (Lateral, PrimQuery' Void)
forall a. a -> (Lateral, a)
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)
  Doc -> State Tag Doc
forall a. a -> StateT Tag Identity a
forall (f :: Context) a. Applicative f => a -> f a
pure (Doc -> State Tag Doc) -> Doc -> State Tag Doc
forall a b. (a -> b) -> a -> b
$ 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
    never :: [PrimExpr]
never = PrimExpr -> [PrimExpr]
forall a. a -> [a]
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 -> State Opaleye.Tag Doc
ppRows :: forall a. Table Expr a => Query a -> State Tag 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.Values [Symbol]
symbols NonEmpty [PrimExpr]
rows)
    | [Symbol] -> [PrimExpr] -> Bool
eqSymbols [Symbol]
symbols (NonEmpty PrimExpr -> [PrimExpr]
forall a. NonEmpty a -> [a]
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)) ->
        Doc -> State Tag Doc
forall a. a -> StateT Tag Identity a
forall (f :: Context) a. Applicative f => a -> f a
pure (Doc -> State Tag Doc) -> Doc -> State Tag Doc
forall a b. (a -> b) -> a -> b
$ [[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 a. NonEmpty a -> [a]
forall (t :: Context) a. Foldable t => t a -> [a]
toList NonEmpty [PrimExpr]
rows)
  Optimized (PrimQuery' Void)
_ -> Query a -> State Tag Doc
forall a. Table Expr a => Query a -> State Tag 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 -> State Opaleye.Tag (Optimized Doc, a)
ppPrimSelect :: forall a. Query a -> State Tag (Optimized Doc, a)
ppPrimSelect Query a
query = do
  (a
a, PrimQuery
primQuery) <- Select a -> State Tag (a, PrimQuery)
forall a. Select a -> State Tag (a, PrimQuery)
Opaleye.runSimpleSelect (Query a -> Select a
forall a. Query a -> Select a
toOpaleye Query a
query)
  (Optimized Doc, a) -> State Tag (Optimized Doc, a)
forall a. a -> StateT Tag Identity a
forall (f :: Context) a. Applicative f => a -> f a
pure ((Optimized Doc, a) -> State Tag (Optimized Doc, a))
-> (Optimized Doc, a) -> State Tag (Optimized Doc, a)
forall a b. (a -> b) -> a -> b
$ (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)


type Optimized :: Type -> Type
data Optimized a = Empty | Unit | Optimized a
  deriving stock ((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
$cfmap :: forall a b. (a -> b) -> Optimized a -> Optimized b
fmap :: forall a b. (a -> b) -> Optimized a -> Optimized b
$c<$ :: forall a b. a -> Optimized b -> Optimized a
<$ :: forall a b. a -> Optimized b -> Optimized a
Functor, (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
$cfold :: forall m. Monoid m => Optimized m -> m
fold :: forall m. Monoid m => Optimized m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> Optimized a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> Optimized a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Optimized a -> a
foldr1 :: forall a. (a -> a -> a) -> Optimized a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Optimized a -> a
foldl1 :: forall a. (a -> a -> a) -> Optimized a -> a
$ctoList :: forall a. Optimized a -> [a]
toList :: forall a. Optimized a -> [a]
$cnull :: forall a. Optimized a -> Bool
null :: forall a. Optimized a -> Bool
$clength :: forall a. Optimized a -> Int
length :: forall a. Optimized a -> Int
$celem :: forall a. Eq a => a -> Optimized a -> Bool
elem :: forall a. Eq a => a -> Optimized a -> Bool
$cmaximum :: forall a. Ord a => Optimized a -> a
maximum :: forall a. Ord a => Optimized a -> a
$cminimum :: forall a. Ord a => Optimized a -> a
minimum :: forall a. Ord a => Optimized a -> a
$csum :: forall a. Num a => Optimized a -> a
sum :: forall a. Num a => Optimized a -> a
$cproduct :: forall a. Num a => Optimized a -> a
product :: forall a. Num a => Optimized a -> a
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
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)
$ctraverse :: forall (f :: Context) a b.
Applicative f =>
(a -> f b) -> Optimized a -> f (Optimized b)
traverse :: forall (f :: Context) a b.
Applicative f =>
(a -> f b) -> Optimized a -> f (Optimized b)
$csequenceA :: forall (f :: Context) a.
Applicative f =>
Optimized (f a) -> f (Optimized a)
sequenceA :: forall (f :: Context) a.
Applicative f =>
Optimized (f a) -> f (Optimized a)
$cmapM :: forall (m :: Context) a b.
Monad m =>
(a -> m b) -> Optimized a -> m (Optimized b)
mapM :: forall (m :: Context) a b.
Monad m =>
(a -> m b) -> Optimized a -> m (Optimized b)
$csequence :: forall (m :: Context) a.
Monad m =>
Optimized (m a) -> m (Optimized a)
sequence :: forall (m :: Context) a.
Monad m =>
Optimized (m a) -> m (Optimized a)
Traversable, Int -> Optimized a -> ShowS
[Optimized a] -> ShowS
Optimized a -> String
(Int -> Optimized a -> ShowS)
-> (Optimized a -> String)
-> ([Optimized a] -> ShowS)
-> Show (Optimized a)
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
$cshowsPrec :: forall a. Show a => Int -> Optimized a -> ShowS
showsPrec :: Int -> Optimized a -> ShowS
$cshow :: forall a. Show a => Optimized a -> String
show :: Optimized a -> String
$cshowList :: forall a. Show a => [Optimized a] -> ShowS
showList :: [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 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 :: forall names exprs.
Selects names exprs =>
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
    { Opaleye.attrs = Opaleye.SelectAttrs attrs
    , Opaleye.tables = Opaleye.oneTable (primSelect 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))