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

module Rel8.Internal.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.Internal.Expr ( Expr )
import Rel8.Internal.Expr.Bool ( false )
import Rel8.Internal.Expr.Opaleye ( toPrimExpr )
import Rel8.Internal.Query ( Query )
import Rel8.Internal.Query.Opaleye ( toOpaleye )
import Rel8.Internal.Schema.Name ( Selects )
import Rel8.Internal.Statement (Statement, statementReturning)
import Rel8.Internal.Table ( Table )
import Rel8.Internal.Table.Cols ( toCols )
import Rel8.Internal.Table.Name ( namesFromLabelsTagged )
import Rel8.Internal.Table.Opaleye ( castTable, exprsWithNames )
import qualified Rel8.Internal.Table.Opaleye as T
import Rel8.Internal.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
  relationTag <- State Tag Tag
Opaleye.fresh
  (exprs, primQuery) <- Opaleye.runSimpleSelect (toOpaleye query)
  let
    names = Tag -> Cols Name (Columns a)
forall a. Table Name a => Tag -> a
namesFromLabelsTagged Tag
relationTag
    (exprs', primQuery') = case optimize 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)
  pure $ Opaleye.ppSql $ primSelectWith names (toCols exprs') primQuery'
  where
    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 [Char]
name (Opaleye.UnsafeTag Int
tag))
      (Opaleye.Symbol [Char]
name' (Opaleye.UnsafeTag Int
tag'))
      = [Char]
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
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, 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)
  pure $ (Opaleye.ppSql . primSelect <$> optimize primQuery, 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 -> [Char]
(Int -> Optimized a -> ShowS)
-> (Optimized a -> [Char])
-> ([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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([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 -> [Char]
show :: Optimized a -> [Char]
$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 = ([Char], PrimExpr) -> (SqlExpr, Maybe SqlColumn)
makeAttr (([Char], PrimExpr) -> (SqlExpr, Maybe SqlColumn))
-> NonEmpty ([Char], PrimExpr)
-> NonEmpty (SqlExpr, Maybe SqlColumn)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> names -> exprs -> NonEmpty ([Char], PrimExpr)
forall names exprs.
Selects names exprs =>
names -> exprs -> NonEmpty ([Char], PrimExpr)
exprsWithNames names
names (exprs -> exprs
forall a. Table Expr a => a -> a
castTable exprs
exprs)
      where
        makeAttr :: ([Char], PrimExpr) -> (SqlExpr, Maybe SqlColumn)
makeAttr ([Char]
label, PrimExpr
expr) =
          (PrimExpr -> SqlExpr
Opaleye.sqlExpr PrimExpr
expr, SqlColumn -> Maybe SqlColumn
forall a. a -> Maybe a
Just ([Char] -> SqlColumn
Opaleye.SqlColumn [Char]
label))