{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Database.Esqueleto.Experimental.From
    where

import qualified Control.Monad.Trans.Writer as W
import Data.Coerce (coerce)
import Data.Proxy
import qualified Data.Text.Lazy.Builder as TLB
import Database.Esqueleto.Experimental.ToAlias
import Database.Esqueleto.Experimental.ToAliasReference
import Database.Esqueleto.Internal.Internal hiding (From(..), from, on)
import Database.Esqueleto.Internal.PersistentImport

import Database.Persist.Names (EntityNameDB(..))

-- | 'FROM' clause, used to bring entities into scope.
--
-- Internally, this function uses the `From` datatype.
-- Unlike the old `Database.Esqueleto.from`, this does not
-- take a function as a parameter, but rather a value that
-- represents a 'JOIN' tree constructed out of instances of `From`.
-- This implementation eliminates certain
-- types of runtime errors by preventing the construction of
-- invalid SQL (e.g. illegal nested-@from@).
from :: ToFrom a a' => a -> SqlQuery a'
from :: a -> SqlQuery a'
from a
f = do
    (a'
a, RawFn
clause) <- From a' -> SqlQuery (a', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (a -> From a'
forall a r. ToFrom a r => a -> From r
toFrom a
f)
    WriterT SideData (State IdentState) () -> SqlQuery ()
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) () -> SqlQuery ())
-> WriterT SideData (State IdentState) () -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SideData -> WriterT SideData (State IdentState) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
W.tell SideData
forall a. Monoid a => a
mempty{sdFromClause :: [FromClause]
sdFromClause=[RawFn -> FromClause
FromRaw (RawFn -> FromClause) -> RawFn -> FromClause
forall a b. (a -> b) -> a -> b
$ RawFn
clause]}
    a' -> SqlQuery a'
forall (f :: * -> *) a. Applicative f => a -> f a
pure a'
a

type RawFn = NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])

-- | Data type defining the "From" language. This should not
-- constructed directly in application code.
--
-- A @From@ is a SqlQuery which returns a reference to the result of calling from
-- and a function that produces a portion of a FROM clause. This gets passed to
-- the FromRaw FromClause constructor directly when converting
-- from a @From@ to a @SqlQuery@ using @from@
--
-- @since 3.5.0.0
newtype From a = From
    { From a -> SqlQuery (a, RawFn)
unFrom :: SqlQuery (a, RawFn)}


-- | A helper class primarily designed to allow using @SqlQuery@ directly in
-- a From expression. This is also useful for embedding a @SqlSetOperation@,
-- as well as supporting backwards compatibility for the
-- data constructor join tree used prior to /3.5.0.0/
--
-- @since 3.5.0.0
class ToFrom a r | a -> r where
    toFrom :: a -> From r
instance ToFrom (From a) a where
    toFrom :: From a -> From a
toFrom = From a -> From a
forall a. a -> a
id

{-# DEPRECATED Table "@since 3.5.0.0 - use 'table' instead" #-}
data Table a = Table

instance PersistEntity ent => ToFrom (Table ent) (SqlExpr (Entity ent)) where
    toFrom :: Table ent -> From (SqlExpr (Entity ent))
toFrom Table ent
_ = From (SqlExpr (Entity ent))
forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table

-- | Bring a PersistEntity into scope from a table
--
-- @
-- select $ from $ table \@People
-- @
--
-- @since 3.5.0.0
table :: forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table :: From (SqlExpr (Entity ent))
table = SqlQuery (SqlExpr (Entity ent), RawFn)
-> From (SqlExpr (Entity ent))
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (SqlExpr (Entity ent), RawFn)
 -> From (SqlExpr (Entity ent)))
-> SqlQuery (SqlExpr (Entity ent), RawFn)
-> From (SqlExpr (Entity ent))
forall a b. (a -> b) -> a -> b
$ do
    let ed :: EntityDef
ed = Proxy ent -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy ent
forall k (t :: k). Proxy t
Proxy @ent)
    Ident
ident <- DBName -> SqlQuery Ident
newIdentFor (EntityNameDB -> DBName
coerce (EntityNameDB -> DBName) -> EntityNameDB -> DBName
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
ed)
    let entity :: SqlExpr (Entity ent)
entity = Ident -> SqlExpr (Entity ent)
forall ent. PersistEntity ent => Ident -> SqlExpr (Entity ent)
unsafeSqlEntity Ident
ident
    (SqlExpr (Entity ent), RawFn)
-> SqlQuery (SqlExpr (Entity ent), RawFn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SqlExpr (Entity ent), RawFn)
 -> SqlQuery (SqlExpr (Entity ent), RawFn))
-> (SqlExpr (Entity ent), RawFn)
-> SqlQuery (SqlExpr (Entity ent), RawFn)
forall a b. (a -> b) -> a -> b
$ ( SqlExpr (Entity ent)
entity, (IdentInfo -> (Builder, [PersistValue])) -> RawFn
forall a b. a -> b -> a
const ((IdentInfo -> (Builder, [PersistValue])) -> RawFn)
-> (IdentInfo -> (Builder, [PersistValue])) -> RawFn
forall a b. (a -> b) -> a -> b
$ Ident -> EntityDef -> IdentInfo -> (Builder, [PersistValue])
forall b.
Monoid b =>
Ident -> EntityDef -> IdentInfo -> (Builder, b)
base Ident
ident EntityDef
ed )
      where
        base :: Ident -> EntityDef -> IdentInfo -> (Builder, b)
base ident :: Ident
ident@(I Text
identText) EntityDef
def IdentInfo
info =
            let db :: Text
db = EntityNameDB -> Text
coerce (EntityNameDB -> Text) -> EntityNameDB -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
def
            in ( (IdentInfo -> DBName -> Builder
fromDBName IdentInfo
info (Text -> DBName
coerce Text
db)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                     if  Text
db Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
identText
                     then Builder
forall a. Monoid a => a
mempty
                     else Builder
" AS " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
ident
               , b
forall a. Monoid a => a
mempty
               )


{-# DEPRECATED SubQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SubQuery@" #-}
newtype SubQuery a = SubQuery a
instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SubQuery (SqlQuery a)) a where
    toFrom :: SubQuery (SqlQuery a) -> From a
toFrom (SubQuery SqlQuery a
q) = SqlQuery a -> From a
forall a r.
(SqlSelect a r, ToAlias a, ToAliasReference a) =>
SqlQuery a -> From a
selectQuery SqlQuery a
q
instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SqlQuery a) a where
    toFrom :: SqlQuery a -> From a
toFrom = SqlQuery a -> From a
forall a r.
(SqlSelect a r, ToAlias a, ToAliasReference a) =>
SqlQuery a -> From a
selectQuery

-- | Select from a subquery, often used in conjuction with joins but can be
-- used without any joins. Because @SqlQuery@ has a @ToFrom@ instance you probably
-- dont need to use this function directly.
--
-- @
-- select $
--      p <- from $
--              selectQuery do
--              p <- from $ table \@Person
--              limit 5
--              orderBy [ asc p ^. PersonAge ]
--      ...
-- @
--
-- @since 3.5.0.0
selectQuery :: (SqlSelect a r, ToAlias a, ToAliasReference a) => SqlQuery a -> From a
selectQuery :: SqlQuery a -> From a
selectQuery SqlQuery a
subquery = SqlQuery (a, RawFn) -> From a
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (a, RawFn) -> From a) -> SqlQuery (a, RawFn) -> From a
forall a b. (a -> b) -> a -> b
$ do
    -- We want to update the IdentState without writing the query to side data
    (a
ret, SideData
sideData) <- WriterT SideData (State IdentState) (a, SideData)
-> SqlQuery (a, SideData)
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) (a, SideData)
 -> SqlQuery (a, SideData))
-> WriterT SideData (State IdentState) (a, SideData)
-> SqlQuery (a, SideData)
forall a b. (a -> b) -> a -> b
$ (SideData -> SideData)
-> WriterT SideData (State IdentState) (a, SideData)
-> WriterT SideData (State IdentState) (a, SideData)
forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
W.censor (\SideData
_ -> SideData
forall a. Monoid a => a
mempty) (WriterT SideData (State IdentState) (a, SideData)
 -> WriterT SideData (State IdentState) (a, SideData))
-> WriterT SideData (State IdentState) (a, SideData)
-> WriterT SideData (State IdentState) (a, SideData)
forall a b. (a -> b) -> a -> b
$ WriterT SideData (State IdentState) a
-> WriterT SideData (State IdentState) (a, SideData)
forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
W.listen (WriterT SideData (State IdentState) a
 -> WriterT SideData (State IdentState) (a, SideData))
-> WriterT SideData (State IdentState) a
-> WriterT SideData (State IdentState) (a, SideData)
forall a b. (a -> b) -> a -> b
$ SqlQuery a -> WriterT SideData (State IdentState) a
forall a. SqlQuery a -> WriterT SideData (State IdentState) a
unQ SqlQuery a
subquery
    a
aliasedValue <- a -> SqlQuery a
forall a. ToAlias a => a -> SqlQuery a
toAlias a
ret
    -- Make a fake query with the aliased results, this allows us to ensure that the query is only run once
    let aliasedQuery :: SqlQuery a
aliasedQuery = WriterT SideData (State IdentState) a -> SqlQuery a
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) a -> SqlQuery a)
-> WriterT SideData (State IdentState) a -> SqlQuery a
forall a b. (a -> b) -> a -> b
$ State IdentState (a, SideData)
-> WriterT SideData (State IdentState) a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
W.WriterT (State IdentState (a, SideData)
 -> WriterT SideData (State IdentState) a)
-> State IdentState (a, SideData)
-> WriterT SideData (State IdentState) a
forall a b. (a -> b) -> a -> b
$ (a, SideData) -> State IdentState (a, SideData)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
aliasedValue, SideData
sideData)
    -- Add the FromQuery that renders the subquery to our side data
    Ident
subqueryAlias <- DBName -> SqlQuery Ident
newIdentFor (Text -> DBName
DBName Text
"q")
    -- Pass the aliased results of the subquery to the outer query
    -- create aliased references from the outer query results (e.g value from subquery will be `subquery`.`value`),
    -- this is probably overkill as the aliases should already be unique but seems to be good practice.
    a
ref <- Ident -> a -> SqlQuery a
forall a. ToAliasReference a => Ident -> a -> SqlQuery a
toAliasReference Ident
subqueryAlias a
aliasedValue

    (a, RawFn) -> SqlQuery (a, RawFn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
ref, \NeedParens
_ IdentInfo
info ->
            let (Builder
queryText,[PersistValue]
queryVals) = Mode -> IdentInfo -> SqlQuery a -> (Builder, [PersistValue])
forall a r backend.
(SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
toRawSql Mode
SELECT IdentInfo
info SqlQuery a
aliasedQuery
            in
            ( (Builder -> Builder
parens Builder
queryText) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" AS " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
subqueryAlias
            , [PersistValue]
queryVals
            )
         )