-- | Translate from the DML to the MySQL dialect.
module Hasura.Backends.MySQL.FromIr
  ( fromSelectRows,
    mkSQLSelect,
    fromRootField,
    FromIr,
    Error (..),
    runFromIr,
  )
where

import Control.Monad.Validate
import Data.HashMap.Strict qualified as HM
import Data.HashSet.InsOrd qualified as OSet
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.Proxy
import Data.Text qualified as T
import Database.MySQL.Base.Types qualified as MySQL
import Hasura.Backends.MySQL.Instances.Types ()
import Hasura.Backends.MySQL.Types
import Hasura.Prelude hiding (GT)
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.Types.Column qualified as IR
import Hasura.RQL.Types.Common qualified as IR
import Hasura.RQL.Types.Relationships.Local qualified as IR
import Hasura.SQL.Backend

data FieldSource
  = ExpressionFieldSource (Aliased Expression)
  | JoinFieldSource (Aliased Join)
  | AggregateFieldSource [Aliased Aggregate]
  deriving (FieldSource -> FieldSource -> Bool
(FieldSource -> FieldSource -> Bool)
-> (FieldSource -> FieldSource -> Bool) -> Eq FieldSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldSource -> FieldSource -> Bool
$c/= :: FieldSource -> FieldSource -> Bool
== :: FieldSource -> FieldSource -> Bool
$c== :: FieldSource -> FieldSource -> Bool
Eq, Int -> FieldSource -> ShowS
[FieldSource] -> ShowS
FieldSource -> String
(Int -> FieldSource -> ShowS)
-> (FieldSource -> String)
-> ([FieldSource] -> ShowS)
-> Show FieldSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldSource] -> ShowS
$cshowList :: [FieldSource] -> ShowS
show :: FieldSource -> String
$cshow :: FieldSource -> String
showsPrec :: Int -> FieldSource -> ShowS
$cshowsPrec :: Int -> FieldSource -> ShowS
Show)

-- | Most of these errors should be checked for legitimacy.
data Error
  = UnsupportedOpExpG (IR.OpExpG 'MySQL Expression)
  | IdentifierNotSupported
  | FunctionNotSupported
  | NodesUnsupportedForNow
  | ConnectionsNotSupported
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq)

-- | The base monad used throughout this module for all conversion
-- functions.
--
-- It's a Validate, so it'll continue going when it encounters errors
-- to accumulate as many as possible.
--
-- It also contains a mapping from entity prefixes to counters. So if
-- my prefix is "table" then there'll be a counter that lets me
-- generate table1, table2, etc. Same for any other prefix needed
-- (e.g. names for joins).
--
-- A ReaderT is used around this in most of the module too, for
-- setting the current entity that a given field name refers to. See
-- @fromColumn@.
newtype FromIr a = FromIr
  { FromIr a -> StateT (Map Text Int) (Validate (NonEmpty Error)) a
unFromIr :: StateT (Map Text Int) (Validate (NonEmpty Error)) a
  }
  deriving (a -> FromIr b -> FromIr a
(a -> b) -> FromIr a -> FromIr b
(forall a b. (a -> b) -> FromIr a -> FromIr b)
-> (forall a b. a -> FromIr b -> FromIr a) -> Functor FromIr
forall a b. a -> FromIr b -> FromIr a
forall a b. (a -> b) -> FromIr a -> FromIr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FromIr b -> FromIr a
$c<$ :: forall a b. a -> FromIr b -> FromIr a
fmap :: (a -> b) -> FromIr a -> FromIr b
$cfmap :: forall a b. (a -> b) -> FromIr a -> FromIr b
Functor, Functor FromIr
a -> FromIr a
Functor FromIr
-> (forall a. a -> FromIr a)
-> (forall a b. FromIr (a -> b) -> FromIr a -> FromIr b)
-> (forall a b c.
    (a -> b -> c) -> FromIr a -> FromIr b -> FromIr c)
-> (forall a b. FromIr a -> FromIr b -> FromIr b)
-> (forall a b. FromIr a -> FromIr b -> FromIr a)
-> Applicative FromIr
FromIr a -> FromIr b -> FromIr b
FromIr a -> FromIr b -> FromIr a
FromIr (a -> b) -> FromIr a -> FromIr b
(a -> b -> c) -> FromIr a -> FromIr b -> FromIr c
forall a. a -> FromIr a
forall a b. FromIr a -> FromIr b -> FromIr a
forall a b. FromIr a -> FromIr b -> FromIr b
forall a b. FromIr (a -> b) -> FromIr a -> FromIr b
forall a b c. (a -> b -> c) -> FromIr a -> FromIr b -> FromIr c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: FromIr a -> FromIr b -> FromIr a
$c<* :: forall a b. FromIr a -> FromIr b -> FromIr a
*> :: FromIr a -> FromIr b -> FromIr b
$c*> :: forall a b. FromIr a -> FromIr b -> FromIr b
liftA2 :: (a -> b -> c) -> FromIr a -> FromIr b -> FromIr c
$cliftA2 :: forall a b c. (a -> b -> c) -> FromIr a -> FromIr b -> FromIr c
<*> :: FromIr (a -> b) -> FromIr a -> FromIr b
$c<*> :: forall a b. FromIr (a -> b) -> FromIr a -> FromIr b
pure :: a -> FromIr a
$cpure :: forall a. a -> FromIr a
$cp1Applicative :: Functor FromIr
Applicative, Applicative FromIr
a -> FromIr a
Applicative FromIr
-> (forall a b. FromIr a -> (a -> FromIr b) -> FromIr b)
-> (forall a b. FromIr a -> FromIr b -> FromIr b)
-> (forall a. a -> FromIr a)
-> Monad FromIr
FromIr a -> (a -> FromIr b) -> FromIr b
FromIr a -> FromIr b -> FromIr b
forall a. a -> FromIr a
forall a b. FromIr a -> FromIr b -> FromIr b
forall a b. FromIr a -> (a -> FromIr b) -> FromIr b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> FromIr a
$creturn :: forall a. a -> FromIr a
>> :: FromIr a -> FromIr b -> FromIr b
$c>> :: forall a b. FromIr a -> FromIr b -> FromIr b
>>= :: FromIr a -> (a -> FromIr b) -> FromIr b
$c>>= :: forall a b. FromIr a -> (a -> FromIr b) -> FromIr b
$cp1Monad :: Applicative FromIr
Monad, MonadValidate (NonEmpty Error))

--------------------------------------------------------------------------------
-- Runners

runFromIr :: FromIr a -> Validate (NonEmpty Error) a
runFromIr :: FromIr a -> Validate (NonEmpty Error) a
runFromIr FromIr a
fromIr = StateT (Map Text Int) (Validate (NonEmpty Error)) a
-> Map Text Int -> Validate (NonEmpty Error) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (FromIr a -> StateT (Map Text Int) (Validate (NonEmpty Error)) a
forall a.
FromIr a -> StateT (Map Text Int) (Validate (NonEmpty Error)) a
unFromIr FromIr a
fromIr) Map Text Int
forall a. Monoid a => a
mempty

data NameTemplate
  = ArrayRelationTemplate Text
  | ArrayAggregateTemplate Text
  | ObjectRelationTemplate Text
  | TableTemplate Text
  | ForOrderAlias Text
  | IndexTemplate

generateEntityAlias :: NameTemplate -> FromIr Text
generateEntityAlias :: NameTemplate -> FromIr Text
generateEntityAlias NameTemplate
template = do
  StateT (Map Text Int) (Validate (NonEmpty Error)) () -> FromIr ()
forall a.
StateT (Map Text Int) (Validate (NonEmpty Error)) a -> FromIr a
FromIr ((Map Text Int -> Map Text Int)
-> StateT (Map Text Int) (Validate (NonEmpty Error)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Int -> Int -> Int) -> Text -> Int -> Map Text Int -> Map Text Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Text
prefix Int
start))
  Map Text Int
i <- StateT (Map Text Int) (Validate (NonEmpty Error)) (Map Text Int)
-> FromIr (Map Text Int)
forall a.
StateT (Map Text Int) (Validate (NonEmpty Error)) a -> FromIr a
FromIr StateT (Map Text Int) (Validate (NonEmpty Error)) (Map Text Int)
forall s (m :: * -> *). MonadState s m => m s
get
  Text -> FromIr Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
start (Text -> Map Text Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
prefix Map Text Int
i)))
  where
    start :: Int
start = Int
1
    prefix :: Text
prefix = Int -> Text -> Text
T.take Int
20 Text
rendered
    rendered :: Text
rendered =
      case NameTemplate
template of
        ArrayRelationTemplate Text
sample -> Text
"ar_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sample
        ArrayAggregateTemplate Text
sample -> Text
"aa_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sample
        ObjectRelationTemplate Text
sample -> Text
"or_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sample
        TableTemplate Text
sample -> Text
"t_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sample
        ForOrderAlias Text
sample -> Text
"order_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sample
        NameTemplate
IndexTemplate -> Text
"idx_"

-- | This is really the start where you query the base table,
-- everything else is joins attached to it.
fromQualifiedTable :: TableName -> FromIr From
fromQualifiedTable :: TableName -> FromIr From
fromQualifiedTable schemadTableName :: TableName
schemadTableName@(TableName {Text
name :: TableName -> Text
name :: Text
name}) = do
  Text
alias <- NameTemplate -> FromIr Text
generateEntityAlias (Text -> NameTemplate
TableTemplate Text
name)
  From -> FromIr From
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Aliased TableName -> From
FromQualifiedTable
        ( Aliased :: forall a. a -> Text -> Aliased a
Aliased
            { aliasedThing :: TableName
aliasedThing =
                TableName
schemadTableName,
              aliasedAlias :: Text
aliasedAlias = Text
alias
            }
        )
    )

fromAlias :: From -> EntityAlias
fromAlias :: From -> EntityAlias
fromAlias (FromQualifiedTable Aliased {Text
aliasedAlias :: Text
aliasedAlias :: forall a. Aliased a -> Text
aliasedAlias}) = Text -> EntityAlias
EntityAlias Text
aliasedAlias
fromAlias (FromSelect Aliased {Text
aliasedAlias :: Text
aliasedAlias :: forall a. Aliased a -> Text
aliasedAlias}) = Text -> EntityAlias
EntityAlias Text
aliasedAlias

trueExpression :: Expression
trueExpression :: Expression
trueExpression = ScalarValue -> Expression
ValueExpression (Bool -> ScalarValue
BitValue Bool
True)

existsFieldName :: Text
existsFieldName :: Text
existsFieldName = Text
"exists_placeholder"

fromGExists :: IR.GExists 'MySQL Expression -> ReaderT EntityAlias FromIr Select
fromGExists :: GExists 'MySQL Expression -> ReaderT EntityAlias FromIr Select
fromGExists IR.GExists {TableName 'MySQL
_geTable :: forall (backend :: BackendType) field.
GExists backend field -> TableName backend
_geTable :: TableName 'MySQL
_geTable, GBoolExp 'MySQL Expression
_geWhere :: forall (backend :: BackendType) field.
GExists backend field -> GBoolExp backend field
_geWhere :: GBoolExp 'MySQL Expression
_geWhere} = do
  From
selectFrom <- FromIr From -> ReaderT EntityAlias FromIr From
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TableName -> FromIr From
fromQualifiedTable TableName 'MySQL
TableName
_geTable)
  Expression
whereExpression <-
    (EntityAlias -> EntityAlias)
-> ReaderT EntityAlias FromIr Expression
-> ReaderT EntityAlias FromIr Expression
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const (From -> EntityAlias
fromAlias From
selectFrom)) (GBoolExp 'MySQL Expression -> ReaderT EntityAlias FromIr Expression
fromGBoolExp GBoolExp 'MySQL Expression
_geWhere)
  Select -> ReaderT EntityAlias FromIr Select
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Select :: InsOrdHashSet Projection
-> From
-> [Join]
-> Where
-> Maybe (NonEmpty OrderBy)
-> Maybe Int
-> Top
-> [FieldName]
-> Maybe [Text]
-> Select
Select
      { selectOrderBy :: Maybe (NonEmpty OrderBy)
selectOrderBy = Maybe (NonEmpty OrderBy)
forall a. Maybe a
Nothing,
        selectProjections :: InsOrdHashSet Projection
selectProjections =
          [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList
            [ Aliased Expression -> Projection
ExpressionProjection
                ( Aliased :: forall a. a -> Text -> Aliased a
Aliased
                    { aliasedThing :: Expression
aliasedThing = Expression
trueExpression,
                      aliasedAlias :: Text
aliasedAlias = Text
existsFieldName
                    }
                )
            ],
        selectFrom :: From
selectFrom = From
selectFrom,
        selectGroupBy :: [FieldName]
selectGroupBy = [],
        selectJoins :: [Join]
selectJoins = [Join]
forall a. Monoid a => a
mempty,
        selectWhere :: Where
selectWhere = [Expression] -> Where
Where [Expression
whereExpression],
        selectSqlTop :: Top
selectSqlTop = Top
NoTop,
        selectSqlOffset :: Maybe Int
selectSqlOffset = Maybe Int
forall a. Maybe a
Nothing,
        selectFinalWantedFields :: Maybe [Text]
selectFinalWantedFields = Maybe [Text]
forall a. Maybe a
Nothing
      }

fromGBoolExp :: IR.GBoolExp 'MySQL Expression -> ReaderT EntityAlias FromIr Expression
fromGBoolExp :: GBoolExp 'MySQL Expression -> ReaderT EntityAlias FromIr Expression
fromGBoolExp = do
  \case
    IR.BoolAnd [GBoolExp 'MySQL Expression]
expressions ->
      ([Expression] -> Expression)
-> ReaderT EntityAlias FromIr [Expression]
-> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Expression] -> Expression
AndExpression ((GBoolExp 'MySQL Expression
 -> ReaderT EntityAlias FromIr Expression)
-> [GBoolExp 'MySQL Expression]
-> ReaderT EntityAlias FromIr [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GBoolExp 'MySQL Expression -> ReaderT EntityAlias FromIr Expression
fromGBoolExp [GBoolExp 'MySQL Expression]
expressions)
    IR.BoolOr [GBoolExp 'MySQL Expression]
expressions ->
      ([Expression] -> Expression)
-> ReaderT EntityAlias FromIr [Expression]
-> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Expression] -> Expression
OrExpression ((GBoolExp 'MySQL Expression
 -> ReaderT EntityAlias FromIr Expression)
-> [GBoolExp 'MySQL Expression]
-> ReaderT EntityAlias FromIr [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GBoolExp 'MySQL Expression -> ReaderT EntityAlias FromIr Expression
fromGBoolExp [GBoolExp 'MySQL Expression]
expressions)
    IR.BoolNot GBoolExp 'MySQL Expression
expression ->
      (Expression -> Expression)
-> ReaderT EntityAlias FromIr Expression
-> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expression -> Expression
NotExpression (GBoolExp 'MySQL Expression -> ReaderT EntityAlias FromIr Expression
fromGBoolExp GBoolExp 'MySQL Expression
expression)
    IR.BoolExists GExists 'MySQL Expression
gExists ->
      (Select -> Expression)
-> ReaderT EntityAlias FromIr Select
-> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Select -> Expression
ExistsExpression (GExists 'MySQL Expression -> ReaderT EntityAlias FromIr Select
fromGExists GExists 'MySQL Expression
gExists)
    IR.BoolField Expression
expression ->
      Expression -> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
expression

fromAnnBoolExp ::
  IR.GBoolExp 'MySQL (IR.AnnBoolExpFld 'MySQL Expression) ->
  ReaderT EntityAlias FromIr Expression
fromAnnBoolExp :: GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExp GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
boolExp = do
  GBoolExp 'MySQL Expression
fields <- (AnnBoolExpFld 'MySQL Expression
 -> ReaderT EntityAlias FromIr Expression)
-> GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr (GBoolExp 'MySQL Expression)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse AnnBoolExpFld 'MySQL Expression
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExpFld GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
boolExp
  GBoolExp 'MySQL Expression -> ReaderT EntityAlias FromIr Expression
fromGBoolExp GBoolExp 'MySQL Expression
fields

-- | For boolean operators, various comparison operators used need
-- special handling to ensure that SQL Server won't outright reject
-- the comparison. See also 'shouldCastToVarcharMax'.
fromColumnInfoForBoolExp :: IR.ColumnInfo 'MySQL -> ReaderT EntityAlias FromIr Expression
fromColumnInfoForBoolExp :: ColumnInfo 'MySQL -> ReaderT EntityAlias FromIr Expression
fromColumnInfoForBoolExp IR.ColumnInfo {ciColumn :: forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn = Column 'MySQL
column, ciType :: forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType = ColumnType 'MySQL
_ciType} = do
  FieldName
fieldName <- Column -> EntityAlias -> FieldName
columnNameToFieldName Column 'MySQL
Column
column (EntityAlias -> FieldName)
-> ReaderT EntityAlias FromIr EntityAlias
-> ReaderT EntityAlias FromIr FieldName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT EntityAlias FromIr EntityAlias
forall r (m :: * -> *). MonadReader r m => m r
ask
  Expression -> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldName -> Expression
ColumnExpression FieldName
fieldName)

fromAnnBoolExpFld ::
  IR.AnnBoolExpFld 'MySQL Expression ->
  ReaderT EntityAlias FromIr Expression
fromAnnBoolExpFld :: AnnBoolExpFld 'MySQL Expression
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExpFld =
  \case
    IR.AVColumn ColumnInfo 'MySQL
columnInfo [OpExpG 'MySQL Expression]
opExpGs -> do
      Expression
expression <- ColumnInfo 'MySQL -> ReaderT EntityAlias FromIr Expression
fromColumnInfoForBoolExp ColumnInfo 'MySQL
columnInfo
      [Expression]
expressions <- (OpExpG 'MySQL Expression -> ReaderT EntityAlias FromIr Expression)
-> [OpExpG 'MySQL Expression]
-> ReaderT EntityAlias FromIr [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FromIr Expression -> ReaderT EntityAlias FromIr Expression
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FromIr Expression -> ReaderT EntityAlias FromIr Expression)
-> (OpExpG 'MySQL Expression -> FromIr Expression)
-> OpExpG 'MySQL Expression
-> ReaderT EntityAlias FromIr Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> OpExpG 'MySQL Expression -> FromIr Expression
fromOpExpG Expression
expression) [OpExpG 'MySQL Expression]
opExpGs
      Expression -> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expression] -> Expression
AndExpression [Expression]
expressions)
    IR.AVRelationship IR.RelInfo {riMapping :: forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping = HashMap (Column 'MySQL) (Column 'MySQL)
mapping, riRTable :: forall (b :: BackendType). RelInfo b -> TableName b
riRTable = TableName 'MySQL
table} GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
annBoolExp -> do
      From
selectFrom <- FromIr From -> ReaderT EntityAlias FromIr From
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TableName -> FromIr From
fromQualifiedTable TableName 'MySQL
TableName
table)
      [Expression]
foreignKeyConditions <- From
-> HashMap Column Column -> ReaderT EntityAlias FromIr [Expression]
fromMapping From
selectFrom HashMap (Column 'MySQL) (Column 'MySQL)
HashMap Column Column
mapping

      Expression
whereExpression <-
        (EntityAlias -> EntityAlias)
-> ReaderT EntityAlias FromIr Expression
-> ReaderT EntityAlias FromIr Expression
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const (From -> EntityAlias
fromAlias From
selectFrom)) (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExp GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
annBoolExp)
      Expression -> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Select -> Expression
ExistsExpression
            Select :: InsOrdHashSet Projection
-> From
-> [Join]
-> Where
-> Maybe (NonEmpty OrderBy)
-> Maybe Int
-> Top
-> [FieldName]
-> Maybe [Text]
-> Select
Select
              { selectOrderBy :: Maybe (NonEmpty OrderBy)
selectOrderBy = Maybe (NonEmpty OrderBy)
forall a. Maybe a
Nothing,
                selectProjections :: InsOrdHashSet Projection
selectProjections =
                  [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList
                    [ Aliased Expression -> Projection
ExpressionProjection
                        ( Aliased :: forall a. a -> Text -> Aliased a
Aliased
                            { aliasedThing :: Expression
aliasedThing = Expression
trueExpression,
                              aliasedAlias :: Text
aliasedAlias = Text
existsFieldName
                            }
                        )
                    ],
                selectFrom :: From
selectFrom = From
selectFrom,
                selectGroupBy :: [FieldName]
selectGroupBy = [],
                selectJoins :: [Join]
selectJoins = [Join]
forall a. Monoid a => a
mempty,
                selectWhere :: Where
selectWhere = [Expression] -> Where
Where ([Expression]
foreignKeyConditions [Expression] -> [Expression] -> [Expression]
forall a. Semigroup a => a -> a -> a
<> [Expression
whereExpression]),
                selectSqlTop :: Top
selectSqlTop = Top
NoTop,
                selectSqlOffset :: Maybe Int
selectSqlOffset = Maybe Int
forall a. Maybe a
Nothing,
                selectFinalWantedFields :: Maybe [Text]
selectFinalWantedFields = Maybe [Text]
forall a. Maybe a
Nothing
              }
        )

-- | The context given by the reader is of the previous/parent
-- "remote" table. The WHERE that we're generating goes in the child,
-- "local" query. The @From@ passed in as argument is the local table.
--
-- We should hope to see e.g. "post.category = category.id" for a
-- local table of post and a remote table of category.
--
-- The left/right columns in @HashMap Column Column@ corresponds
-- to the left/right of @select ... join ...@. Therefore left=remote,
-- right=local in this context.
fromMapping ::
  From ->
  HashMap Column Column ->
  ReaderT EntityAlias FromIr [Expression]
fromMapping :: From
-> HashMap Column Column -> ReaderT EntityAlias FromIr [Expression]
fromMapping From
localFrom = ((Column, Column) -> ReaderT EntityAlias FromIr Expression)
-> [(Column, Column)] -> ReaderT EntityAlias FromIr [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Column, Column) -> ReaderT EntityAlias FromIr Expression
columnsToEqs ([(Column, Column)] -> ReaderT EntityAlias FromIr [Expression])
-> (HashMap Column Column -> [(Column, Column)])
-> HashMap Column Column
-> ReaderT EntityAlias FromIr [Expression]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Column Column -> [(Column, Column)]
forall k v. HashMap k v -> [(k, v)]
HM.toList
  where
    columnsToEqs :: (Column, Column) -> ReaderT EntityAlias FromIr Expression
columnsToEqs (Column
remoteColumn, Column
localColumn) = do
      FieldName
localFieldName <- (EntityAlias -> EntityAlias)
-> ReaderT EntityAlias FromIr FieldName
-> ReaderT EntityAlias FromIr FieldName
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const (From -> EntityAlias
fromAlias From
localFrom)) (Column -> ReaderT EntityAlias FromIr FieldName
fromColumn Column
localColumn)
      FieldName
remoteFieldName <- Column -> ReaderT EntityAlias FromIr FieldName
fromColumn Column
remoteColumn
      Expression -> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Op -> Expression -> Expression -> Expression
OpExpression
            Op
EQ'
            (FieldName -> Expression
ColumnExpression FieldName
localFieldName)
            (FieldName -> Expression
ColumnExpression FieldName
remoteFieldName)
        )

fromColumn :: Column -> ReaderT EntityAlias FromIr FieldName
fromColumn :: Column -> ReaderT EntityAlias FromIr FieldName
fromColumn Column
column = Column -> EntityAlias -> FieldName
columnNameToFieldName Column
column (EntityAlias -> FieldName)
-> ReaderT EntityAlias FromIr EntityAlias
-> ReaderT EntityAlias FromIr FieldName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT EntityAlias FromIr EntityAlias
forall r (m :: * -> *). MonadReader r m => m r
ask

columnNameToFieldName :: Column -> EntityAlias -> FieldName
columnNameToFieldName :: Column -> EntityAlias -> FieldName
columnNameToFieldName (Column Text
fieldName) EntityAlias {entityAliasText :: EntityAlias -> Text
entityAliasText = Text
fieldNameEntity} =
  FieldName :: Text -> Text -> FieldName
FieldName {fName :: Text
fName = Text
fieldName, fNameEntity :: Text
fNameEntity = Text
fieldNameEntity}

fromOpExpG :: Expression -> IR.OpExpG 'MySQL Expression -> FromIr Expression
fromOpExpG :: Expression -> OpExpG 'MySQL Expression -> FromIr Expression
fromOpExpG Expression
expression OpExpG 'MySQL Expression
op =
  case OpExpG 'MySQL Expression
op of
    IR.AEQ Bool
True Expression
val -> do
      Expression -> FromIr Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> FromIr Expression)
-> Expression -> FromIr Expression
forall a b. (a -> b) -> a -> b
$ Op -> Expression -> Expression -> Expression
OpExpression Op
EQ' Expression
expression Expression
val
    OpExpG 'MySQL Expression
_ -> NonEmpty Error -> FromIr Expression
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute (Error -> NonEmpty Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpExpG 'MySQL Expression -> Error
UnsupportedOpExpG OpExpG 'MySQL Expression
op))

data Args = Args
  { Args -> Where
argsWhere :: Where,
    Args -> Maybe (NonEmpty OrderBy)
argsOrderBy :: Maybe (NonEmpty OrderBy),
    Args -> [Join]
argsJoins :: [Join],
    Args -> Top
argsTop :: Top,
    Args -> Maybe Int
argsOffset :: Maybe Int,
    Args -> Proxy (Maybe (NonEmpty FieldName))
argsDistinct :: Proxy (Maybe (NonEmpty FieldName)),
    Args -> Map TableName EntityAlias
argsExistingJoins :: Map TableName EntityAlias
  }
  deriving (Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
(Int -> Args -> ShowS)
-> (Args -> String) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> String
$cshow :: Args -> String
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show)

data UnfurledJoin = UnfurledJoin
  { UnfurledJoin -> Join
unfurledJoin :: Join,
    -- | Recorded if we joined onto an object relation.
    UnfurledJoin -> Maybe (TableName, EntityAlias)
unfurledObjectTableAlias :: Maybe (TableName, EntityAlias)
  }
  deriving (Int -> UnfurledJoin -> ShowS
[UnfurledJoin] -> ShowS
UnfurledJoin -> String
(Int -> UnfurledJoin -> ShowS)
-> (UnfurledJoin -> String)
-> ([UnfurledJoin] -> ShowS)
-> Show UnfurledJoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnfurledJoin] -> ShowS
$cshowList :: [UnfurledJoin] -> ShowS
show :: UnfurledJoin -> String
$cshow :: UnfurledJoin -> String
showsPrec :: Int -> UnfurledJoin -> ShowS
$cshowsPrec :: Int -> UnfurledJoin -> ShowS
Show)

fromColumnInfo :: IR.ColumnInfo 'MySQL -> ReaderT EntityAlias FromIr FieldName
fromColumnInfo :: ColumnInfo 'MySQL -> ReaderT EntityAlias FromIr FieldName
fromColumnInfo IR.ColumnInfo {ciColumn :: forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn = Column 'MySQL
column} =
  Column -> EntityAlias -> FieldName
columnNameToFieldName Column 'MySQL
Column
column (EntityAlias -> FieldName)
-> ReaderT EntityAlias FromIr EntityAlias
-> ReaderT EntityAlias FromIr FieldName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT EntityAlias FromIr EntityAlias
forall r (m :: * -> *). MonadReader r m => m r
ask

tableNameText :: TableName -> Text
tableNameText :: TableName -> Text
tableNameText (TableName {Text
name :: Text
name :: TableName -> Text
name}) = Text
name

aggFieldName :: Text
aggFieldName :: Text
aggFieldName = Text
"agg"

-- | Unfurl the nested set of object relations (tell'd in the writer)
-- that are terminated by field name (IR.AOCColumn and
-- IR.AOCArrayAggregation).
unfurlAnnOrderByElement ::
  IR.AnnotatedOrderByElement 'MySQL Expression ->
  WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) (FieldName, Maybe ScalarType)
unfurlAnnOrderByElement :: AnnotatedOrderByElement 'MySQL Expression
-> WriterT
     (Seq UnfurledJoin)
     (ReaderT EntityAlias FromIr)
     (FieldName, Maybe ScalarType)
unfurlAnnOrderByElement =
  \case
    IR.AOCColumn ColumnInfo 'MySQL
columnInfo -> do
      FieldName
fieldName <- ReaderT EntityAlias FromIr FieldName
-> WriterT
     (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) FieldName
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ColumnInfo 'MySQL -> ReaderT EntityAlias FromIr FieldName
fromColumnInfo ColumnInfo 'MySQL
columnInfo)
      (FieldName, Maybe ScalarType)
-> WriterT
     (Seq UnfurledJoin)
     (ReaderT EntityAlias FromIr)
     (FieldName, Maybe ScalarType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( FieldName
fieldName,
          case ColumnInfo 'MySQL -> ColumnType 'MySQL
forall (b :: BackendType). ColumnInfo b -> ColumnType b
IR.ciType ColumnInfo 'MySQL
columnInfo of
            IR.ColumnScalar ScalarType 'MySQL
t -> ScalarType -> Maybe ScalarType
forall a. a -> Maybe a
Just ScalarType 'MySQL
ScalarType
t
            ColumnType 'MySQL
_ -> Maybe ScalarType
forall a. Maybe a
Nothing
        )
    IR.AOCObjectRelation IR.RelInfo {riRTable :: forall (b :: BackendType). RelInfo b -> TableName b
riRTable = TableName 'MySQL
table} GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
annBoolExp AnnotatedOrderByElement 'MySQL Expression
annOrderByElementG -> do
      From
selectFrom <- ReaderT EntityAlias FromIr From
-> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) From
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FromIr From -> ReaderT EntityAlias FromIr From
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TableName -> FromIr From
fromQualifiedTable TableName 'MySQL
TableName
table))
      Text
joinAliasEntity <-
        ReaderT EntityAlias FromIr Text
-> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FromIr Text -> ReaderT EntityAlias FromIr Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NameTemplate -> FromIr Text
generateEntityAlias (Text -> NameTemplate
ForOrderAlias (TableName -> Text
tableNameText TableName 'MySQL
TableName
table))))
      Expression
whereExpression <-
        ReaderT EntityAlias FromIr Expression
-> WriterT
     (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) Expression
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((EntityAlias -> EntityAlias)
-> ReaderT EntityAlias FromIr Expression
-> ReaderT EntityAlias FromIr Expression
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const (From -> EntityAlias
fromAlias From
selectFrom)) (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExp GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
annBoolExp))
      Seq UnfurledJoin
-> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
        ( UnfurledJoin -> Seq UnfurledJoin
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            UnfurledJoin :: Join -> Maybe (TableName, EntityAlias) -> UnfurledJoin
UnfurledJoin
              { unfurledJoin :: Join
unfurledJoin =
                  Join :: EntityAlias
-> Select -> JoinType -> Text -> Top -> Maybe Int -> Join
Join
                    { joinSelect :: Select
joinSelect =
                        Select :: InsOrdHashSet Projection
-> From
-> [Join]
-> Where
-> Maybe (NonEmpty OrderBy)
-> Maybe Int
-> Top
-> [FieldName]
-> Maybe [Text]
-> Select
Select
                          { selectProjections :: InsOrdHashSet Projection
selectProjections = [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList [Projection
StarProjection],
                            selectSqlTop :: Top
selectSqlTop = Top
NoTop,
                            selectSqlOffset :: Maybe Int
selectSqlOffset = Maybe Int
forall a. Maybe a
Nothing,
                            selectFrom :: From
selectFrom = From
selectFrom,
                            selectJoins :: [Join]
selectJoins = [],
                            selectWhere :: Where
selectWhere =
                              [Expression] -> Where
Where [Expression
whereExpression],
                            selectOrderBy :: Maybe (NonEmpty OrderBy)
selectOrderBy = Maybe (NonEmpty OrderBy)
forall a. Maybe a
Nothing,
                            selectFinalWantedFields :: Maybe [Text]
selectFinalWantedFields = Maybe [Text]
forall a. Maybe a
Nothing,
                            selectGroupBy :: [FieldName]
selectGroupBy = []
                          },
                      joinRightTable :: EntityAlias
joinRightTable = From -> EntityAlias
fromAlias From
selectFrom,
                      joinType :: JoinType
joinType = JoinType
OnlessJoin,
                      joinFieldName :: Text
joinFieldName = TableName -> Text
name TableName 'MySQL
TableName
table,
                      joinTop :: Top
joinTop = Top
NoTop,
                      joinOffset :: Maybe Int
joinOffset = Maybe Int
forall a. Maybe a
Nothing
                    },
                unfurledObjectTableAlias :: Maybe (TableName, EntityAlias)
unfurledObjectTableAlias = (TableName, EntityAlias) -> Maybe (TableName, EntityAlias)
forall a. a -> Maybe a
Just (TableName 'MySQL
TableName
table, Text -> EntityAlias
EntityAlias Text
joinAliasEntity)
              }
        )
      (EntityAlias -> EntityAlias)
-> WriterT
     (Seq UnfurledJoin)
     (ReaderT EntityAlias FromIr)
     (FieldName, Maybe ScalarType)
-> WriterT
     (Seq UnfurledJoin)
     (ReaderT EntityAlias FromIr)
     (FieldName, Maybe ScalarType)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
        (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const (Text -> EntityAlias
EntityAlias Text
joinAliasEntity))
        (AnnotatedOrderByElement 'MySQL Expression
-> WriterT
     (Seq UnfurledJoin)
     (ReaderT EntityAlias FromIr)
     (FieldName, Maybe ScalarType)
unfurlAnnOrderByElement AnnotatedOrderByElement 'MySQL Expression
annOrderByElementG)
    IR.AOCArrayAggregation IR.RelInfo {riMapping :: forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping = HashMap (Column 'MySQL) (Column 'MySQL)
mapping, riRTable :: forall (b :: BackendType). RelInfo b -> TableName b
riRTable = TableName 'MySQL
tableName} GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
annBoolExp AnnotatedAggregateOrderBy 'MySQL
annAggregateOrderBy -> do
      From
selectFrom <- ReaderT EntityAlias FromIr From
-> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) From
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FromIr From -> ReaderT EntityAlias FromIr From
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TableName -> FromIr From
fromQualifiedTable TableName 'MySQL
TableName
tableName))
      let alias :: Text
alias = Text
aggFieldName
      Text
joinAliasEntity <-
        ReaderT EntityAlias FromIr Text
-> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FromIr Text -> ReaderT EntityAlias FromIr Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NameTemplate -> FromIr Text
generateEntityAlias (Text -> NameTemplate
ForOrderAlias (TableName -> Text
tableNameText TableName 'MySQL
TableName
tableName))))
      [Expression]
foreignKeyConditions <- ReaderT EntityAlias FromIr [Expression]
-> WriterT
     (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) [Expression]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (From
-> HashMap Column Column -> ReaderT EntityAlias FromIr [Expression]
fromMapping From
selectFrom HashMap (Column 'MySQL) (Column 'MySQL)
HashMap Column Column
mapping)
      Expression
whereExpression <-
        ReaderT EntityAlias FromIr Expression
-> WriterT
     (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) Expression
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((EntityAlias -> EntityAlias)
-> ReaderT EntityAlias FromIr Expression
-> ReaderT EntityAlias FromIr Expression
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const (From -> EntityAlias
fromAlias From
selectFrom)) (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExp GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
annBoolExp))
      Aggregate
aggregate <-
        ReaderT EntityAlias FromIr Aggregate
-> WriterT
     (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) Aggregate
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
          ( (EntityAlias -> EntityAlias)
-> ReaderT EntityAlias FromIr Aggregate
-> ReaderT EntityAlias FromIr Aggregate
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
              (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const (From -> EntityAlias
fromAlias From
selectFrom))
              ( case AnnotatedAggregateOrderBy 'MySQL
annAggregateOrderBy of
                  AnnotatedAggregateOrderBy 'MySQL
IR.AAOCount -> Aggregate -> ReaderT EntityAlias FromIr Aggregate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Countable FieldName -> Aggregate
CountAggregate Countable FieldName
forall name. Countable name
StarCountable)
                  IR.AAOOp Text
text ColumnInfo 'MySQL
columnInfo -> do
                    FieldName
fieldName <- ColumnInfo 'MySQL -> ReaderT EntityAlias FromIr FieldName
fromColumnInfo ColumnInfo 'MySQL
columnInfo
                    Aggregate -> ReaderT EntityAlias FromIr Aggregate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Expression] -> Aggregate
OpAggregate Text
text (Expression -> [Expression]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldName -> Expression
ColumnExpression FieldName
fieldName)))
              )
          )
      Seq UnfurledJoin
-> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
        ( UnfurledJoin -> Seq UnfurledJoin
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( UnfurledJoin :: Join -> Maybe (TableName, EntityAlias) -> UnfurledJoin
UnfurledJoin
                { unfurledJoin :: Join
unfurledJoin =
                    Join :: EntityAlias
-> Select -> JoinType -> Text -> Top -> Maybe Int -> Join
Join
                      { joinSelect :: Select
joinSelect =
                          Select :: InsOrdHashSet Projection
-> From
-> [Join]
-> Where
-> Maybe (NonEmpty OrderBy)
-> Maybe Int
-> Top
-> [FieldName]
-> Maybe [Text]
-> Select
Select
                            { selectProjections :: InsOrdHashSet Projection
selectProjections =
                                [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList
                                  [ Aliased Aggregate -> Projection
AggregateProjection
                                      Aliased :: forall a. a -> Text -> Aliased a
Aliased
                                        { aliasedThing :: Aggregate
aliasedThing = Aggregate
aggregate,
                                          aliasedAlias :: Text
aliasedAlias = Text
alias
                                        }
                                  ],
                              selectSqlTop :: Top
selectSqlTop = Top
NoTop,
                              selectGroupBy :: [FieldName]
selectGroupBy = [],
                              selectFrom :: From
selectFrom = From
selectFrom,
                              selectJoins :: [Join]
selectJoins = [],
                              selectWhere :: Where
selectWhere =
                                [Expression] -> Where
Where
                                  ([Expression]
foreignKeyConditions [Expression] -> [Expression] -> [Expression]
forall a. Semigroup a => a -> a -> a
<> [Expression
whereExpression]),
                              selectOrderBy :: Maybe (NonEmpty OrderBy)
selectOrderBy = Maybe (NonEmpty OrderBy)
forall a. Maybe a
Nothing,
                              selectSqlOffset :: Maybe Int
selectSqlOffset = Maybe Int
forall a. Maybe a
Nothing,
                              selectFinalWantedFields :: Maybe [Text]
selectFinalWantedFields = Maybe [Text]
forall a. Maybe a
Nothing
                            },
                        joinFieldName :: Text
joinFieldName = Text
"",
                        joinRightTable :: EntityAlias
joinRightTable = Text -> EntityAlias
EntityAlias Text
"",
                        joinType :: JoinType
joinType = JoinType
OnlessJoin,
                        joinTop :: Top
joinTop = Top
NoTop,
                        joinOffset :: Maybe Int
joinOffset = Maybe Int
forall a. Maybe a
Nothing
                      },
                  unfurledObjectTableAlias :: Maybe (TableName, EntityAlias)
unfurledObjectTableAlias = Maybe (TableName, EntityAlias)
forall a. Maybe a
Nothing
                }
            )
        )
      (FieldName, Maybe ScalarType)
-> WriterT
     (Seq UnfurledJoin)
     (ReaderT EntityAlias FromIr)
     (FieldName, Maybe ScalarType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( FieldName :: Text -> Text -> FieldName
FieldName {fNameEntity :: Text
fNameEntity = Text
joinAliasEntity, fName :: Text
fName = Text
alias},
          Maybe ScalarType
forall a. Maybe a
Nothing
        )

-- | Produce a valid ORDER BY construct, telling about any joins
-- needed on the side.
fromAnnOrderByItemG ::
  IR.AnnotatedOrderByItemG 'MySQL Expression ->
  WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) OrderBy
fromAnnOrderByItemG :: AnnotatedOrderByItemG 'MySQL Expression
-> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) OrderBy
fromAnnOrderByItemG IR.OrderByItemG {Maybe (BasicOrderType 'MySQL)
obiType :: forall (b :: BackendType) a.
OrderByItemG b a -> Maybe (BasicOrderType b)
obiType :: Maybe (BasicOrderType 'MySQL)
obiType, obiColumn :: forall (b :: BackendType) a. OrderByItemG b a -> a
obiColumn = AnnotatedOrderByElement 'MySQL Expression
obiColumn, Maybe (NullsOrderType 'MySQL)
obiNulls :: forall (b :: BackendType) a.
OrderByItemG b a -> Maybe (NullsOrderType b)
obiNulls :: Maybe (NullsOrderType 'MySQL)
obiNulls} = do
  (FieldName
orderByFieldName, Maybe ScalarType
orderByType) <- AnnotatedOrderByElement 'MySQL Expression
-> WriterT
     (Seq UnfurledJoin)
     (ReaderT EntityAlias FromIr)
     (FieldName, Maybe ScalarType)
unfurlAnnOrderByElement AnnotatedOrderByElement 'MySQL Expression
obiColumn
  let orderByNullsOrder :: NullsOrder
orderByNullsOrder = NullsOrder -> Maybe NullsOrder -> NullsOrder
forall a. a -> Maybe a -> a
fromMaybe NullsOrder
NullsAnyOrder Maybe (NullsOrderType 'MySQL)
Maybe NullsOrder
obiNulls
      orderByOrder :: Order
orderByOrder = Order -> Maybe Order -> Order
forall a. a -> Maybe a -> a
fromMaybe Order
Asc Maybe (BasicOrderType 'MySQL)
Maybe Order
obiType
  OrderBy
-> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) OrderBy
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderBy :: FieldName -> Order -> NullsOrder -> Maybe ScalarType -> OrderBy
OrderBy {Maybe ScalarType
NullsOrder
Order
FieldName
orderByType :: Maybe ScalarType
orderByNullsOrder :: NullsOrder
orderByOrder :: Order
orderByFieldName :: FieldName
orderByOrder :: Order
orderByNullsOrder :: NullsOrder
orderByType :: Maybe ScalarType
orderByFieldName :: FieldName
..}

fromSelectArgsG :: IR.SelectArgsG 'MySQL Expression -> ReaderT EntityAlias FromIr Args
fromSelectArgsG :: SelectArgsG 'MySQL Expression -> ReaderT EntityAlias FromIr Args
fromSelectArgsG SelectArgsG 'MySQL Expression
selectArgsG = do
  let argsOffset :: Maybe Int
argsOffset = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Maybe Int64 -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
moffset
  Where
argsWhere <-
    ReaderT EntityAlias FromIr Where
-> (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
    -> ReaderT EntityAlias FromIr Where)
-> Maybe (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression))
-> ReaderT EntityAlias FromIr Where
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Where -> ReaderT EntityAlias FromIr Where
forall (f :: * -> *) a. Applicative f => a -> f a
pure Where
forall a. Monoid a => a
mempty) ((Expression -> Where)
-> ReaderT EntityAlias FromIr Expression
-> ReaderT EntityAlias FromIr Where
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Expression] -> Where
Where ([Expression] -> Where)
-> (Expression -> [Expression]) -> Expression -> Where
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> [Expression]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (ReaderT EntityAlias FromIr Expression
 -> ReaderT EntityAlias FromIr Where)
-> (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
    -> ReaderT EntityAlias FromIr Expression)
-> GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr Where
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExp) Maybe (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression))
mannBoolExp
  Top
argsTop <-
    ReaderT EntityAlias FromIr Top
-> (Int -> ReaderT EntityAlias FromIr Top)
-> Maybe Int
-> ReaderT EntityAlias FromIr Top
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Top -> ReaderT EntityAlias FromIr Top
forall (f :: * -> *) a. Applicative f => a -> f a
pure Top
forall a. Monoid a => a
mempty) (Top -> ReaderT EntityAlias FromIr Top
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Top -> ReaderT EntityAlias FromIr Top)
-> (Int -> Top) -> Int -> ReaderT EntityAlias FromIr Top
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Top
Top) Maybe Int
mlimit
  let argsDistinct :: Proxy t
argsDistinct = Proxy t
forall k (t :: k). Proxy t
Proxy
  ([OrderBy]
argsOrderBy, Seq UnfurledJoin
joins) <-
    WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) [OrderBy]
-> ReaderT EntityAlias FromIr ([OrderBy], Seq UnfurledJoin)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT ((AnnotatedOrderByItemG 'MySQL Expression
 -> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) OrderBy)
-> [AnnotatedOrderByItemG 'MySQL Expression]
-> WriterT
     (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) [OrderBy]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse AnnotatedOrderByItemG 'MySQL Expression
-> WriterT (Seq UnfurledJoin) (ReaderT EntityAlias FromIr) OrderBy
fromAnnOrderByItemG ([AnnotatedOrderByItemG 'MySQL Expression]
-> (NonEmpty (AnnotatedOrderByItemG 'MySQL Expression)
    -> [AnnotatedOrderByItemG 'MySQL Expression])
-> Maybe (NonEmpty (AnnotatedOrderByItemG 'MySQL Expression))
-> [AnnotatedOrderByItemG 'MySQL Expression]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty (AnnotatedOrderByItemG 'MySQL Expression)
-> [AnnotatedOrderByItemG 'MySQL Expression]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (NonEmpty (AnnotatedOrderByItemG 'MySQL Expression))
orders))
  -- Any object-relation joins that we generated, we record their
  -- generated names into a mapping.
  let argsExistingJoins :: Map TableName EntityAlias
argsExistingJoins =
        [(TableName, EntityAlias)] -> Map TableName EntityAlias
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((UnfurledJoin -> Maybe (TableName, EntityAlias))
-> [UnfurledJoin] -> [(TableName, EntityAlias)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe UnfurledJoin -> Maybe (TableName, EntityAlias)
unfurledObjectTableAlias (Seq UnfurledJoin -> [UnfurledJoin]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq UnfurledJoin
joins))
  Args -> ReaderT EntityAlias FromIr Args
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Args :: Where
-> Maybe (NonEmpty OrderBy)
-> [Join]
-> Top
-> Maybe Int
-> Proxy (Maybe (NonEmpty FieldName))
-> Map TableName EntityAlias
-> Args
Args
      { argsJoins :: [Join]
argsJoins = Seq Join -> [Join]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((UnfurledJoin -> Join) -> Seq UnfurledJoin -> Seq Join
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnfurledJoin -> Join
unfurledJoin Seq UnfurledJoin
joins),
        argsOrderBy :: Maybe (NonEmpty OrderBy)
argsOrderBy = [OrderBy] -> Maybe (NonEmpty OrderBy)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [OrderBy]
argsOrderBy,
        Maybe Int
Proxy (Maybe (NonEmpty FieldName))
Map TableName EntityAlias
Where
Top
forall t. Proxy t
argsExistingJoins :: Map TableName EntityAlias
argsDistinct :: forall t. Proxy t
argsTop :: Top
argsWhere :: Where
argsOffset :: Maybe Int
argsExistingJoins :: Map TableName EntityAlias
argsDistinct :: Proxy (Maybe (NonEmpty FieldName))
argsOffset :: Maybe Int
argsTop :: Top
argsWhere :: Where
..
      }
  where
    IR.SelectArgs
      { $sel:_saWhere:SelectArgs :: forall (b :: BackendType) v.
SelectArgsG b v -> Maybe (AnnBoolExp b v)
_saWhere = Maybe (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression))
mannBoolExp,
        $sel:_saLimit:SelectArgs :: forall (b :: BackendType) v. SelectArgsG b v -> Maybe Int
_saLimit = Maybe Int
mlimit,
        $sel:_saOffset:SelectArgs :: forall (b :: BackendType) v. SelectArgsG b v -> Maybe Int64
_saOffset = Maybe Int64
moffset,
        $sel:_saOrderBy:SelectArgs :: forall (b :: BackendType) v.
SelectArgsG b v -> Maybe (NonEmpty (AnnotatedOrderByItemG b v))
_saOrderBy = Maybe (NonEmpty (AnnotatedOrderByItemG 'MySQL Expression))
orders
      } = SelectArgsG 'MySQL Expression
selectArgsG

-- | Here is where we project a field as a column expression. If
-- number stringification is on, then we wrap it in a
-- 'ToStringExpression' so that it's casted when being projected.
fromAnnColumnField ::
  IR.AnnColumnField 'MySQL Expression ->
  ReaderT EntityAlias FromIr Expression
fromAnnColumnField :: AnnColumnField 'MySQL Expression
-> ReaderT EntityAlias FromIr Expression
fromAnnColumnField AnnColumnField 'MySQL Expression
annColumnField = do
  FieldName
fieldName <- Column -> ReaderT EntityAlias FromIr FieldName
fromColumn Column 'MySQL
Column
column
  if ColumnType 'MySQL
typ ColumnType 'MySQL -> ColumnType 'MySQL -> Bool
forall a. Eq a => a -> a -> Bool
== ScalarType 'MySQL -> ColumnType 'MySQL
forall (b :: BackendType). ScalarType b -> ColumnType b
IR.ColumnScalar ScalarType 'MySQL
ScalarType
MySQL.Geometry
    then Expression -> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> ReaderT EntityAlias FromIr Expression)
-> Expression -> ReaderT EntityAlias FromIr Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Text -> [Expression] -> Expression
MethodExpression (FieldName -> Expression
ColumnExpression FieldName
fieldName) Text
"STAsText" []
    else Expression -> ReaderT EntityAlias FromIr Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldName -> Expression
ColumnExpression FieldName
fieldName)
  where
    IR.AnnColumnField
      { $sel:_acfColumn:AnnColumnField :: forall (b :: BackendType) v. AnnColumnField b v -> Column b
_acfColumn = Column 'MySQL
column,
        $sel:_acfType:AnnColumnField :: forall (b :: BackendType) v. AnnColumnField b v -> ColumnType b
_acfType = ColumnType 'MySQL
typ,
        $sel:_acfAsText:AnnColumnField :: forall (b :: BackendType) v. AnnColumnField b v -> Bool
_acfAsText = Bool
_asText :: Bool,
        $sel:_acfArguments:AnnColumnField :: forall (b :: BackendType) v.
AnnColumnField b v -> Maybe (ScalarSelectionArguments b)
_acfArguments = _ :: Maybe Void
      } = AnnColumnField 'MySQL Expression
annColumnField

fromRelName :: IR.RelName -> FromIr Text
fromRelName :: RelName -> FromIr Text
fromRelName RelName
relName =
  Text -> FromIr Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName -> Text
IR.relNameToTxt RelName
relName)

-- fromAggregateField :: IR.AggregateField 'MySQL -> ReaderT EntityAlias FromIr Aggregate
-- fromAggregateField aggregateField =
--   case aggregateField of
--     IR.AFExp text        -> pure (TextAggregate text)
--     IR.AFCount countType -> CountAggregate <$> case countType of
--       StarCountable               -> pure StarCountable
--       NonNullFieldCountable names -> NonNullFieldCountable <$> traverse fromColumn names
--       DistinctCountable     names -> DistinctCountable     <$> traverse fromColumn names
--     IR.AFOp _ -> error "fromAggregatefield: not implemented"

fromTableAggregateFieldG ::
  (IR.FieldName, IR.TableAggregateFieldG 'MySQL Void Expression) -> ReaderT EntityAlias FromIr FieldSource
fromTableAggregateFieldG :: (FieldName, TableAggregateFieldG 'MySQL Void Expression)
-> ReaderT EntityAlias FromIr FieldSource
fromTableAggregateFieldG (IR.FieldName Text
_name, TableAggregateFieldG 'MySQL Void Expression
_field) = String -> ReaderT EntityAlias FromIr FieldSource
forall a. HasCallStack => String -> a
error String
"fromTableAggregateFieldG: not implemented yet"

fieldSourceProjections :: FieldSource -> [Projection]
fieldSourceProjections :: FieldSource -> [Projection]
fieldSourceProjections =
  \case
    ExpressionFieldSource Aliased Expression
aliasedExpression ->
      Projection -> [Projection]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased Expression -> Projection
ExpressionProjection Aliased Expression
aliasedExpression)
    JoinFieldSource Aliased {aliasedThing :: forall a. Aliased a -> a
aliasedThing = Join {Maybe Int
Text
Select
JoinType
EntityAlias
Top
joinOffset :: Maybe Int
joinTop :: Top
joinFieldName :: Text
joinType :: JoinType
joinSelect :: Select
joinRightTable :: EntityAlias
joinOffset :: Join -> Maybe Int
joinTop :: Join -> Top
joinFieldName :: Join -> Text
joinType :: Join -> JoinType
joinRightTable :: Join -> EntityAlias
joinSelect :: Join -> Select
..}} ->
      ((FieldName, FieldName) -> Projection)
-> [(FieldName, FieldName)] -> [Projection]
forall a b. (a -> b) -> [a] -> [b]
map
        ( \(FieldName
_left, right :: FieldName
right@(FieldName {Text
fName :: Text
fName :: FieldName -> Text
fName})) ->
            Aliased Expression -> Projection
ExpressionProjection
              Aliased :: forall a. a -> Text -> Aliased a
Aliased
                { aliasedAlias :: Text
aliasedAlias = Text
fName,
                  aliasedThing :: Expression
aliasedThing = FieldName -> Expression
ColumnExpression FieldName
right
                }
        )
        [(FieldName, FieldName)]
fields
      where
        fields :: [(FieldName, FieldName)]
fields =
          case JoinType
joinType of
            ArrayJoin [(FieldName, FieldName)]
fs -> [(FieldName, FieldName)]
fs
            ObjectJoin [(FieldName, FieldName)]
fs -> [(FieldName, FieldName)]
fs
            ArrayAggregateJoin [(FieldName, FieldName)]
fs -> [(FieldName, FieldName)]
fs
            JoinType
OnlessJoin -> [(FieldName, FieldName)]
forall a. Monoid a => a
mempty
    AggregateFieldSource [Aliased Aggregate]
aggregates -> (Aliased Aggregate -> Projection)
-> [Aliased Aggregate] -> [Projection]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Aliased Aggregate -> Projection
AggregateProjection [Aliased Aggregate]
aggregates

fieldSourceJoin :: FieldSource -> Maybe Join
fieldSourceJoin :: FieldSource -> Maybe Join
fieldSourceJoin =
  \case
    JoinFieldSource Aliased Join
aliasedJoin -> Join -> Maybe Join
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased Join -> Join
forall a. Aliased a -> a
aliasedThing Aliased Join
aliasedJoin)
    ExpressionFieldSource {} -> Maybe Join
forall a. Maybe a
Nothing
    AggregateFieldSource {} -> Maybe Join
forall a. Maybe a
Nothing

fromSelectAggregate ::
  Maybe (EntityAlias, HashMap Column Column) ->
  IR.AnnSelectG 'MySQL (IR.TableAggregateFieldG 'MySQL Void) Expression ->
  FromIr Select
fromSelectAggregate :: Maybe (EntityAlias, HashMap Column Column)
-> AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression
-> FromIr Select
fromSelectAggregate Maybe (EntityAlias, HashMap Column Column)
mparentRelationship AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression
annSelectG = do
  From
selectFrom <-
    case SelectFromG 'MySQL Expression
from of
      IR.FromTable TableName 'MySQL
qualifiedObject -> TableName -> FromIr From
fromQualifiedTable TableName 'MySQL
TableName
qualifiedObject
      IR.FromIdentifier {} -> NonEmpty Error -> FromIr From
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute (NonEmpty Error -> FromIr From) -> NonEmpty Error -> FromIr From
forall a b. (a -> b) -> a -> b
$ Error -> NonEmpty Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
IdentifierNotSupported
      IR.FromFunction {} -> NonEmpty Error -> FromIr From
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute (NonEmpty Error -> FromIr From) -> NonEmpty Error -> FromIr From
forall a b. (a -> b) -> a -> b
$ Error -> NonEmpty Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
FunctionNotSupported
  Where
_mforeignKeyConditions <- (Maybe [Expression] -> Where)
-> FromIr (Maybe [Expression]) -> FromIr Where
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Expression] -> Where
Where ([Expression] -> Where)
-> (Maybe [Expression] -> [Expression])
-> Maybe [Expression]
-> Where
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expression] -> Maybe [Expression] -> [Expression]
forall a. a -> Maybe a -> a
fromMaybe []) (FromIr (Maybe [Expression]) -> FromIr Where)
-> FromIr (Maybe [Expression]) -> FromIr Where
forall a b. (a -> b) -> a -> b
$
    Maybe (EntityAlias, HashMap Column Column)
-> ((EntityAlias, HashMap Column Column) -> FromIr [Expression])
-> FromIr (Maybe [Expression])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (EntityAlias, HashMap Column Column)
mparentRelationship (((EntityAlias, HashMap Column Column) -> FromIr [Expression])
 -> FromIr (Maybe [Expression]))
-> ((EntityAlias, HashMap Column Column) -> FromIr [Expression])
-> FromIr (Maybe [Expression])
forall a b. (a -> b) -> a -> b
$
      \(EntityAlias
entityAlias, HashMap Column Column
mapping) ->
        ReaderT EntityAlias FromIr [Expression]
-> EntityAlias -> FromIr [Expression]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (From
-> HashMap Column Column -> ReaderT EntityAlias FromIr [Expression]
fromMapping From
selectFrom HashMap Column Column
mapping) EntityAlias
entityAlias
  [FieldSource]
fieldSources <-
    ReaderT EntityAlias FromIr [FieldSource]
-> EntityAlias -> FromIr [FieldSource]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (((FieldName, TableAggregateFieldG 'MySQL Void Expression)
 -> ReaderT EntityAlias FromIr FieldSource)
-> [(FieldName, TableAggregateFieldG 'MySQL Void Expression)]
-> ReaderT EntityAlias FromIr [FieldSource]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FieldName, TableAggregateFieldG 'MySQL Void Expression)
-> ReaderT EntityAlias FromIr FieldSource
fromTableAggregateFieldG [(FieldName, TableAggregateFieldG 'MySQL Void Expression)]
fields) (From -> EntityAlias
fromAlias From
selectFrom)
  Expression
filterExpression <-
    ReaderT EntityAlias FromIr Expression
-> EntityAlias -> FromIr Expression
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExp GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
permFilter) (From -> EntityAlias
fromAlias From
selectFrom)
  Args
    { Maybe (NonEmpty OrderBy)
argsOrderBy :: Maybe (NonEmpty OrderBy)
argsOrderBy :: Args -> Maybe (NonEmpty OrderBy)
argsOrderBy,
      Where
argsWhere :: Where
argsWhere :: Args -> Where
argsWhere,
      [Join]
argsJoins :: [Join]
argsJoins :: Args -> [Join]
argsJoins,
      Top
argsTop :: Top
argsTop :: Args -> Top
argsTop,
      argsDistinct :: Args -> Proxy (Maybe (NonEmpty FieldName))
argsDistinct = Proxy (Maybe (NonEmpty FieldName))
Proxy,
      Maybe Int
argsOffset :: Maybe Int
argsOffset :: Args -> Maybe Int
argsOffset
    } <-
    ReaderT EntityAlias FromIr Args -> EntityAlias -> FromIr Args
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SelectArgsG 'MySQL Expression -> ReaderT EntityAlias FromIr Args
fromSelectArgsG SelectArgsG 'MySQL Expression
args) (From -> EntityAlias
fromAlias From
selectFrom)
  let selectProjections :: [Projection]
selectProjections =
        (FieldSource -> [Projection]) -> [FieldSource] -> [Projection]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Projection] -> [Projection]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Projection] -> [Projection])
-> (FieldSource -> [Projection]) -> FieldSource -> [Projection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldSource -> [Projection]
fieldSourceProjections) [FieldSource]
fieldSources
  Select -> FromIr Select
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Select :: InsOrdHashSet Projection
-> From
-> [Join]
-> Where
-> Maybe (NonEmpty OrderBy)
-> Maybe Int
-> Top
-> [FieldName]
-> Maybe [Text]
-> Select
Select
      { selectProjections :: InsOrdHashSet Projection
selectProjections = [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList [Projection]
selectProjections,
        selectFrom :: From
selectFrom = From
selectFrom,
        selectJoins :: [Join]
selectJoins = [Join]
argsJoins [Join] -> [Join] -> [Join]
forall a. Semigroup a => a -> a -> a
<> (FieldSource -> Maybe Join) -> [FieldSource] -> [Join]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe FieldSource -> Maybe Join
fieldSourceJoin [FieldSource]
fieldSources,
        selectWhere :: Where
selectWhere = Where
argsWhere Where -> Where -> Where
forall a. Semigroup a => a -> a -> a
<> [Expression] -> Where
Where [Expression
filterExpression],
        selectOrderBy :: Maybe (NonEmpty OrderBy)
selectOrderBy = Maybe (NonEmpty OrderBy)
argsOrderBy,
        selectSqlOffset :: Maybe Int
selectSqlOffset = Maybe Int
argsOffset,
        selectSqlTop :: Top
selectSqlTop = Top
permissionBasedTop Top -> Top -> Top
forall a. Semigroup a => a -> a -> a
<> Top
argsTop,
        selectFinalWantedFields :: Maybe [Text]
selectFinalWantedFields = Maybe [Text]
forall a. Maybe a
Nothing,
        selectGroupBy :: [FieldName]
selectGroupBy = []
      }
  where
    permissionBasedTop :: Top
permissionBasedTop =
      Top -> (Int -> Top) -> Maybe Int -> Top
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Top
NoTop Int -> Top
Top Maybe Int
mPermLimit
    IR.AnnSelectG
      { $sel:_asnFields:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields = [(FieldName, TableAggregateFieldG 'MySQL Void Expression)]
fields,
        $sel:_asnFrom:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> SelectFromG b v
_asnFrom = SelectFromG 'MySQL Expression
from,
        $sel:_asnPerm:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> TablePermG b v
_asnPerm = TablePermG 'MySQL Expression
perm,
        $sel:_asnArgs:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> SelectArgsG b v
_asnArgs = SelectArgsG 'MySQL Expression
args,
        $sel:_asnStrfyNum:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> StringifyNumbers
_asnStrfyNum = StringifyNumbers
_num,
        $sel:_asnNamingConvention:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Maybe NamingCase
_asnNamingConvention = Maybe NamingCase
_tCase
      } = AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression
annSelectG
    IR.TablePerm {$sel:_tpLimit:TablePerm :: forall (b :: BackendType) v. TablePermG b v -> Maybe Int
_tpLimit = Maybe Int
mPermLimit, $sel:_tpFilter:TablePerm :: forall (b :: BackendType) v. TablePermG b v -> AnnBoolExp b v
_tpFilter = GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
permFilter} = TablePermG 'MySQL Expression
perm

-- _fromTableAggFieldG ::
--   (Int, (IR.FieldName, IR.TableAggregateFieldG 'MySQL Void Expression)) ->
--   Maybe (ReaderT EntityAlias FromIr (Int, (IR.FieldName, [Projection])))
-- _fromTableAggFieldG = \case
--   (index, (fieldName, IR.TAFAgg (aggregateFields :: [(IR.FieldName, IR.AggregateField 'MySQL)]))) -> Just do
--     aggregates <-
--       for aggregateFields \(fieldName', aggregateField) ->
--         fromAggregateField aggregateField <&> \aliasedThing ->
--           Aliased {aliasedAlias = IR.getFieldNameTxt fieldName', ..}
--     pure (index, (fieldName, fieldSourceProjections $ AggregateFieldSource aggregates))
--   _ -> Nothing

-- _fromTableNodesFieldG ::
--   Map TableName EntityAlias ->
--   StringifyNumbers ->
--   (Int, (IR.FieldName, IR.TableAggregateFieldG 'MySQL Void Expression)) ->
--   Maybe (ReaderT EntityAlias FromIr (Int, (IR.FieldName, [Projection])))
-- _fromTableNodesFieldG argsExistingJoins stringifyNumbers = \case
--   (index, (fieldName, IR.TAFNodes () (annFieldsG :: [(IR.FieldName, IR.AnnFieldG 'MySQL Void Expression)]))) -> Just do
--     fieldSources' <- fromAnnFieldsG argsExistingJoins stringifyNumbers `traverse` annFieldsG
--     let nodesProjections' :: [Projection] = concatMap fieldSourceProjections fieldSources'
--     pure (index, (fieldName, nodesProjections'))
--   _ -> Nothing

-- -- | Get FieldSource from a TAFExp type table aggregate field
-- _fromTableExpFieldG ::
--   (Int, (IR.FieldName, IR.TableAggregateFieldG 'MySQL Void Expression)) ->
--   Maybe (ReaderT EntityAlias FromIr (Int, [Projection]))
-- _fromTableExpFieldG = \case
--   (index, (IR.FieldName name, IR.TAFExp text)) -> Just $
--     pure
--       (index, fieldSourceProjections $
--         ExpressionFieldSource
--           Aliased
--             { aliasedThing = ValueExpression (TextValue text)
--             , aliasedAlias = name
--             })
--   _ -> Nothing

fromArrayAggregateSelectG ::
  IR.AnnRelationSelectG 'MySQL (IR.AnnAggregateSelectG 'MySQL Void Expression) ->
  ReaderT EntityAlias FromIr Join
fromArrayAggregateSelectG :: AnnRelationSelectG
  'MySQL
  (AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression)
-> ReaderT EntityAlias FromIr Join
fromArrayAggregateSelectG AnnRelationSelectG
  'MySQL
  (AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression)
annRelationSelectG = do
  Text
fieldName <- FromIr Text -> ReaderT EntityAlias FromIr Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RelName -> FromIr Text
fromRelName RelName
_aarRelationshipName)
  Select
joinSelect' <- do
    EntityAlias
lhsEntityAlias <- ReaderT EntityAlias FromIr EntityAlias
forall r (m :: * -> *). MonadReader r m => m r
ask
    -- With this, the foreign key relations are injected automatically
    -- at the right place by fromSelectAggregate.
    FromIr Select -> ReaderT EntityAlias FromIr Select
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe (EntityAlias, HashMap Column Column)
-> AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression
-> FromIr Select
fromSelectAggregate ((EntityAlias, HashMap Column Column)
-> Maybe (EntityAlias, HashMap Column Column)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EntityAlias
lhsEntityAlias, HashMap Column Column
mapping)) AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression
annSelectG)
  Text
alias <- FromIr Text -> ReaderT EntityAlias FromIr Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NameTemplate -> FromIr Text
generateEntityAlias (Text -> NameTemplate
ArrayAggregateTemplate Text
fieldName))
  [(FieldName, FieldName)]
joinOn <- EntityAlias
-> HashMap Column Column
-> ReaderT EntityAlias FromIr [(FieldName, FieldName)]
fromMappingFieldNames (Text -> EntityAlias
EntityAlias Text
alias) HashMap Column Column
mapping
  Join -> ReaderT EntityAlias FromIr Join
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Join :: EntityAlias
-> Select -> JoinType -> Text -> Top -> Maybe Int -> Join
Join
      { joinSelect :: Select
joinSelect = Select
joinSelect' {selectSqlTop :: Top
selectSqlTop = Top
NoTop, selectSqlOffset :: Maybe Int
selectSqlOffset = Maybe Int
forall a. Maybe a
Nothing},
        joinFieldName :: Text
joinFieldName = Text
"",
        joinRightTable :: EntityAlias
joinRightTable = Text -> EntityAlias
EntityAlias Text
"",
        joinType :: JoinType
joinType = [(FieldName, FieldName)] -> JoinType
ArrayAggregateJoin [(FieldName, FieldName)]
joinOn,
        joinTop :: Top
joinTop = Select -> Top
selectSqlTop Select
joinSelect',
        joinOffset :: Maybe Int
joinOffset = Select -> Maybe Int
selectSqlOffset Select
joinSelect'
      }
  where
    IR.AnnRelationSelectG
      { RelName
$sel:_aarRelationshipName:AnnRelationSelectG :: forall (b :: BackendType) a. AnnRelationSelectG b a -> RelName
_aarRelationshipName :: RelName
_aarRelationshipName,
        $sel:_aarColumnMapping:AnnRelationSelectG :: forall (b :: BackendType) a.
AnnRelationSelectG b a -> HashMap (Column b) (Column b)
_aarColumnMapping = mapping :: HashMap Column Column,
        $sel:_aarAnnSelect:AnnRelationSelectG :: forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect = AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression
annSelectG
      } = AnnRelationSelectG
  'MySQL
  (AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression)
annRelationSelectG

fromArraySelectG :: IR.ArraySelectG 'MySQL Void Expression -> ReaderT EntityAlias FromIr Join
fromArraySelectG :: ArraySelectG 'MySQL Void Expression
-> ReaderT EntityAlias FromIr Join
fromArraySelectG =
  \case
    IR.ASSimple ArrayRelationSelectG 'MySQL Void Expression
arrayRelationSelectG ->
      ArrayRelationSelectG 'MySQL Void Expression
-> ReaderT EntityAlias FromIr Join
fromArrayRelationSelectG ArrayRelationSelectG 'MySQL Void Expression
arrayRelationSelectG
    IR.ASAggregate AnnRelationSelectG
  'MySQL
  (AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression)
arrayAggregateSelectG ->
      AnnRelationSelectG
  'MySQL
  (AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression)
-> ReaderT EntityAlias FromIr Join
fromArrayAggregateSelectG AnnRelationSelectG
  'MySQL
  (AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression)
arrayAggregateSelectG

fromObjectRelationSelectG ::
  IR.ObjectRelationSelectG 'MySQL Void Expression ->
  ReaderT EntityAlias FromIr Join
fromObjectRelationSelectG :: ObjectRelationSelectG 'MySQL Void Expression
-> ReaderT EntityAlias FromIr Join
fromObjectRelationSelectG ObjectRelationSelectG 'MySQL Void Expression
annRelationSelectG = do
  From
from <- FromIr From -> ReaderT EntityAlias FromIr From
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FromIr From -> ReaderT EntityAlias FromIr From)
-> FromIr From -> ReaderT EntityAlias FromIr From
forall a b. (a -> b) -> a -> b
$ TableName -> FromIr From
fromQualifiedTable TableName
tableFrom
  let EntityAlias
entityAlias :: EntityAlias = From -> EntityAlias
fromAlias From
from
  [FieldSource]
fieldSources <-
    (EntityAlias -> EntityAlias)
-> ReaderT EntityAlias FromIr [FieldSource]
-> ReaderT EntityAlias FromIr [FieldSource]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
      (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const EntityAlias
entityAlias)
      (((FieldName, AnnFieldG 'MySQL Void Expression)
 -> ReaderT EntityAlias FromIr FieldSource)
-> [(FieldName, AnnFieldG 'MySQL Void Expression)]
-> ReaderT EntityAlias FromIr [FieldSource]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FieldName, AnnFieldG 'MySQL Void Expression)
-> ReaderT EntityAlias FromIr FieldSource
fromAnnFieldsG [(FieldName, AnnFieldG 'MySQL Void Expression)]
fields)
  let selectProjections :: [Projection]
selectProjections =
        (FieldSource -> [Projection]) -> [FieldSource] -> [Projection]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Projection] -> [Projection]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Projection] -> [Projection])
-> (FieldSource -> [Projection]) -> FieldSource -> [Projection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldSource -> [Projection]
fieldSourceProjections) [FieldSource]
fieldSources
  Expression
filterExpression <- (EntityAlias -> EntityAlias)
-> ReaderT EntityAlias FromIr Expression
-> ReaderT EntityAlias FromIr Expression
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const EntityAlias
entityAlias) (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExp GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
tableFilter)
  [(FieldName, FieldName)]
joinOn <- EntityAlias
-> HashMap Column Column
-> ReaderT EntityAlias FromIr [(FieldName, FieldName)]
fromMappingFieldNames EntityAlias
entityAlias HashMap Column Column
mapping
  let joinFieldProjections :: [Projection]
joinFieldProjections =
        ((FieldName, FieldName) -> Projection)
-> [(FieldName, FieldName)] -> [Projection]
forall a b. (a -> b) -> [a] -> [b]
map
          ( \(FieldName
fieldName', FieldName
_) ->
              Aliased FieldName -> Projection
FieldNameProjection
                Aliased :: forall a. a -> Text -> Aliased a
Aliased
                  { aliasedThing :: FieldName
aliasedThing = FieldName
fieldName',
                    aliasedAlias :: Text
aliasedAlias = FieldName -> Text
fName FieldName
fieldName'
                  }
          )
          [(FieldName, FieldName)]
joinOn
  Text
joinFieldName <- FromIr Text -> ReaderT EntityAlias FromIr Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RelName -> FromIr Text
fromRelName RelName
_aarRelationshipName)
  Join -> ReaderT EntityAlias FromIr Join
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Join :: EntityAlias
-> Select -> JoinType -> Text -> Top -> Maybe Int -> Join
Join
      { joinSelect :: Select
joinSelect =
          Select :: InsOrdHashSet Projection
-> From
-> [Join]
-> Where
-> Maybe (NonEmpty OrderBy)
-> Maybe Int
-> Top
-> [FieldName]
-> Maybe [Text]
-> Select
Select
            { selectOrderBy :: Maybe (NonEmpty OrderBy)
selectOrderBy = Maybe (NonEmpty OrderBy)
forall a. Maybe a
Nothing,
              selectProjections :: InsOrdHashSet Projection
selectProjections =
                [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList [Projection]
joinFieldProjections
                  InsOrdHashSet Projection
-> InsOrdHashSet Projection -> InsOrdHashSet Projection
forall a. Semigroup a => a -> a -> a
<> [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList [Projection]
selectProjections, -- Ordering is right-biased.
              selectGroupBy :: [FieldName]
selectGroupBy = [],
              selectFrom :: From
selectFrom = From
from,
              selectJoins :: [Join]
selectJoins = (FieldSource -> Maybe Join) -> [FieldSource] -> [Join]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe FieldSource -> Maybe Join
fieldSourceJoin [FieldSource]
fieldSources,
              selectWhere :: Where
selectWhere = [Expression] -> Where
Where [Expression
filterExpression],
              selectSqlTop :: Top
selectSqlTop = Top
NoTop,
              selectSqlOffset :: Maybe Int
selectSqlOffset = Maybe Int
forall a. Maybe a
Nothing,
              selectFinalWantedFields :: Maybe [Text]
selectFinalWantedFields = [Text] -> Maybe [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(FieldName, AnnFieldG 'MySQL Void Expression)] -> [Text]
fieldTextNames [(FieldName, AnnFieldG 'MySQL Void Expression)]
fields)
            },
        Text
joinFieldName :: Text
joinFieldName :: Text
joinFieldName,
        joinRightTable :: EntityAlias
joinRightTable = Text -> EntityAlias
EntityAlias Text
"",
        joinType :: JoinType
joinType = [(FieldName, FieldName)] -> JoinType
ObjectJoin [(FieldName, FieldName)]
joinOn,
        joinTop :: Top
joinTop = Top
NoTop,
        joinOffset :: Maybe Int
joinOffset = Maybe Int
forall a. Maybe a
Nothing
      }
  where
    IR.AnnObjectSelectG
      { $sel:_aosFields:AnnObjectSelectG :: forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> AnnFieldsG b r v
_aosFields = [(FieldName, AnnFieldG 'MySQL Void Expression)]
fields :: IR.AnnFieldsG 'MySQL Void Expression,
        $sel:_aosTableFrom:AnnObjectSelectG :: forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> TableName b
_aosTableFrom = tableFrom :: TableName,
        $sel:_aosTableFilter:AnnObjectSelectG :: forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> AnnBoolExp b v
_aosTableFilter = GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
tableFilter :: IR.AnnBoolExp 'MySQL Expression
      } = AnnObjectSelectG 'MySQL Void Expression
annObjectSelectG
    IR.AnnRelationSelectG
      { RelName
_aarRelationshipName :: RelName
$sel:_aarRelationshipName:AnnRelationSelectG :: forall (b :: BackendType) a. AnnRelationSelectG b a -> RelName
_aarRelationshipName,
        $sel:_aarColumnMapping:AnnRelationSelectG :: forall (b :: BackendType) a.
AnnRelationSelectG b a -> HashMap (Column b) (Column b)
_aarColumnMapping = mapping :: HashMap Column Column,
        $sel:_aarAnnSelect:AnnRelationSelectG :: forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect = AnnObjectSelectG 'MySQL Void Expression
annObjectSelectG :: IR.AnnObjectSelectG 'MySQL Void Expression
      } = ObjectRelationSelectG 'MySQL Void Expression
annRelationSelectG

isEmptyExpression :: Expression -> Bool
isEmptyExpression :: Expression -> Bool
isEmptyExpression (AndExpression []) = Bool
True
isEmptyExpression (OrExpression []) = Bool
True
isEmptyExpression Expression
_ = Bool
False

fromSelectRows :: IR.AnnSelectG 'MySQL (IR.AnnFieldG 'MySQL Void) Expression -> FromIr Select
fromSelectRows :: AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
-> FromIr Select
fromSelectRows AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
annSelectG = do
  From
selectFrom <-
    case SelectFromG 'MySQL Expression
from of
      IR.FromTable TableName 'MySQL
qualifiedObject -> TableName -> FromIr From
fromQualifiedTable TableName 'MySQL
TableName
qualifiedObject
      IR.FromIdentifier {} -> NonEmpty Error -> FromIr From
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute (NonEmpty Error -> FromIr From) -> NonEmpty Error -> FromIr From
forall a b. (a -> b) -> a -> b
$ Error -> NonEmpty Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
IdentifierNotSupported
      IR.FromFunction {} -> NonEmpty Error -> FromIr From
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute (NonEmpty Error -> FromIr From) -> NonEmpty Error -> FromIr From
forall a b. (a -> b) -> a -> b
$ Error -> NonEmpty Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
FunctionNotSupported
  Args
    { Maybe (NonEmpty OrderBy)
argsOrderBy :: Maybe (NonEmpty OrderBy)
argsOrderBy :: Args -> Maybe (NonEmpty OrderBy)
argsOrderBy,
      Where
argsWhere :: Where
argsWhere :: Args -> Where
argsWhere,
      [Join]
argsJoins :: [Join]
argsJoins :: Args -> [Join]
argsJoins,
      argsDistinct :: Args -> Proxy (Maybe (NonEmpty FieldName))
argsDistinct = Proxy (Maybe (NonEmpty FieldName))
Proxy,
      Maybe Int
argsOffset :: Maybe Int
argsOffset :: Args -> Maybe Int
argsOffset,
      Top
argsTop :: Top
argsTop :: Args -> Top
argsTop
    } <-
    ReaderT EntityAlias FromIr Args -> EntityAlias -> FromIr Args
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SelectArgsG 'MySQL Expression -> ReaderT EntityAlias FromIr Args
fromSelectArgsG SelectArgsG 'MySQL Expression
args) (From -> EntityAlias
fromAlias From
selectFrom)
  [FieldSource]
fieldSources <-
    ReaderT EntityAlias FromIr [FieldSource]
-> EntityAlias -> FromIr [FieldSource]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
      (((FieldName, AnnFieldG 'MySQL Void Expression)
 -> ReaderT EntityAlias FromIr FieldSource)
-> [(FieldName, AnnFieldG 'MySQL Void Expression)]
-> ReaderT EntityAlias FromIr [FieldSource]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FieldName, AnnFieldG 'MySQL Void Expression)
-> ReaderT EntityAlias FromIr FieldSource
fromAnnFieldsG [(FieldName, AnnFieldG 'MySQL Void Expression)]
fields)
      (From -> EntityAlias
fromAlias From
selectFrom)
  Expression
filterExpression <-
    ReaderT EntityAlias FromIr Expression
-> EntityAlias -> FromIr Expression
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
-> ReaderT EntityAlias FromIr Expression
fromAnnBoolExp GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
permFilter) (From -> EntityAlias
fromAlias From
selectFrom)
  let selectProjections :: [Projection]
selectProjections =
        (FieldSource -> [Projection]) -> [FieldSource] -> [Projection]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Projection] -> [Projection]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Projection] -> [Projection])
-> (FieldSource -> [Projection]) -> FieldSource -> [Projection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldSource -> [Projection]
fieldSourceProjections) [FieldSource]
fieldSources
  Select -> FromIr Select
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Select :: InsOrdHashSet Projection
-> From
-> [Join]
-> Where
-> Maybe (NonEmpty OrderBy)
-> Maybe Int
-> Top
-> [FieldName]
-> Maybe [Text]
-> Select
Select
      { selectOrderBy :: Maybe (NonEmpty OrderBy)
selectOrderBy = Maybe (NonEmpty OrderBy)
argsOrderBy,
        selectGroupBy :: [FieldName]
selectGroupBy = [],
        selectProjections :: InsOrdHashSet Projection
selectProjections = [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList [Projection]
selectProjections,
        selectFrom :: From
selectFrom = From
selectFrom,
        selectJoins :: [Join]
selectJoins = [Join]
argsJoins [Join] -> [Join] -> [Join]
forall a. Semigroup a => a -> a -> a
<> (FieldSource -> Maybe Join) -> [FieldSource] -> [Join]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe FieldSource -> Maybe Join
fieldSourceJoin [FieldSource]
fieldSources,
        selectWhere :: Where
selectWhere = Where
argsWhere Where -> Where -> Where
forall a. Semigroup a => a -> a -> a
<> [Expression] -> Where
Where ([Expression
filterExpression | Bool -> Bool
not (Expression -> Bool
isEmptyExpression Expression
filterExpression)]),
        selectSqlOffset :: Maybe Int
selectSqlOffset = Maybe Int
argsOffset,
        selectSqlTop :: Top
selectSqlTop = Top
permissionBasedTop Top -> Top -> Top
forall a. Semigroup a => a -> a -> a
<> Top
argsTop,
        selectFinalWantedFields :: Maybe [Text]
selectFinalWantedFields = [Text] -> Maybe [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(FieldName, AnnFieldG 'MySQL Void Expression)] -> [Text]
fieldTextNames [(FieldName, AnnFieldG 'MySQL Void Expression)]
fields)
      }
  where
    permissionBasedTop :: Top
permissionBasedTop =
      Top -> (Int -> Top) -> Maybe Int -> Top
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Top
NoTop Int -> Top
Top Maybe Int
mPermLimit
    IR.AnnSelectG
      { $sel:_asnFields:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields = [(FieldName, AnnFieldG 'MySQL Void Expression)]
fields,
        $sel:_asnFrom:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> SelectFromG b v
_asnFrom = SelectFromG 'MySQL Expression
from,
        $sel:_asnPerm:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> TablePermG b v
_asnPerm = TablePermG 'MySQL Expression
perm,
        $sel:_asnArgs:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> SelectArgsG b v
_asnArgs = SelectArgsG 'MySQL Expression
args,
        $sel:_asnNamingConvention:AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Maybe NamingCase
_asnNamingConvention = Maybe NamingCase
_tCase
      } = AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
annSelectG
    IR.TablePerm {$sel:_tpLimit:TablePerm :: forall (b :: BackendType) v. TablePermG b v -> Maybe Int
_tpLimit = Maybe Int
mPermLimit, $sel:_tpFilter:TablePerm :: forall (b :: BackendType) v. TablePermG b v -> AnnBoolExp b v
_tpFilter = GBoolExp 'MySQL (AnnBoolExpFld 'MySQL Expression)
permFilter} = TablePermG 'MySQL Expression
perm

fromArrayRelationSelectG :: IR.ArrayRelationSelectG 'MySQL Void Expression -> ReaderT EntityAlias FromIr Join
fromArrayRelationSelectG :: ArrayRelationSelectG 'MySQL Void Expression
-> ReaderT EntityAlias FromIr Join
fromArrayRelationSelectG ArrayRelationSelectG 'MySQL Void Expression
annRelationSelectG = do
  Text
joinFieldName <- FromIr Text -> ReaderT EntityAlias FromIr Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RelName -> FromIr Text
fromRelName RelName
_aarRelationshipName)
  Select
sel <- FromIr Select -> ReaderT EntityAlias FromIr Select
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
-> FromIr Select
fromSelectRows AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
annSelectG)
  [(FieldName, FieldName)]
joinOn <- EntityAlias
-> HashMap Column Column
-> ReaderT EntityAlias FromIr [(FieldName, FieldName)]
fromMappingFieldNames (From -> EntityAlias
fromAlias (Select -> From
selectFrom Select
sel)) HashMap Column Column
mapping
  let joinFieldProjections :: [Projection]
joinFieldProjections =
        ((FieldName, FieldName) -> Projection)
-> [(FieldName, FieldName)] -> [Projection]
forall a b. (a -> b) -> [a] -> [b]
map
          ( \(FieldName
fieldName', FieldName
_) ->
              Aliased FieldName -> Projection
FieldNameProjection
                Aliased :: forall a. a -> Text -> Aliased a
Aliased
                  { aliasedThing :: FieldName
aliasedThing = FieldName
fieldName',
                    aliasedAlias :: Text
aliasedAlias = FieldName -> Text
fName FieldName
fieldName'
                  }
          )
          [(FieldName, FieldName)]
joinOn
  Join -> ReaderT EntityAlias FromIr Join
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Join :: EntityAlias
-> Select -> JoinType -> Text -> Top -> Maybe Int -> Join
Join
      { joinSelect :: Select
joinSelect =
          Select
sel
            { selectProjections :: InsOrdHashSet Projection
selectProjections =
                [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList [Projection]
joinFieldProjections InsOrdHashSet Projection
-> InsOrdHashSet Projection -> InsOrdHashSet Projection
forall a. Semigroup a => a -> a -> a
<> Select -> InsOrdHashSet Projection
selectProjections Select
sel,
              -- Above: Ordering is right-biased.
              selectSqlTop :: Top
selectSqlTop = Top
NoTop,
              selectSqlOffset :: Maybe Int
selectSqlOffset = Maybe Int
forall a. Maybe a
Nothing
            },
        joinRightTable :: EntityAlias
joinRightTable = From -> EntityAlias
fromAlias (Select -> From
selectFrom Select
sel),
        joinType :: JoinType
joinType = [(FieldName, FieldName)] -> JoinType
ArrayJoin [(FieldName, FieldName)]
joinOn,
        -- Above: Needed by DataLoader to determine the type of
        -- Haskell-native join to perform.
        Text
joinFieldName :: Text
joinFieldName :: Text
joinFieldName,
        joinTop :: Top
joinTop = Select -> Top
selectSqlTop Select
sel,
        joinOffset :: Maybe Int
joinOffset = Select -> Maybe Int
selectSqlOffset Select
sel
      }
  where
    IR.AnnRelationSelectG
      { RelName
_aarRelationshipName :: RelName
$sel:_aarRelationshipName:AnnRelationSelectG :: forall (b :: BackendType) a. AnnRelationSelectG b a -> RelName
_aarRelationshipName,
        $sel:_aarColumnMapping:AnnRelationSelectG :: forall (b :: BackendType) a.
AnnRelationSelectG b a -> HashMap (Column b) (Column b)
_aarColumnMapping = mapping :: HashMap Column Column,
        $sel:_aarAnnSelect:AnnRelationSelectG :: forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect = AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
annSelectG
      } = ArrayRelationSelectG 'MySQL Void Expression
annRelationSelectG

-- | The main sources of fields, either constants, fields or via joins.
fromAnnFieldsG ::
  (IR.FieldName, IR.AnnFieldG 'MySQL Void Expression) ->
  ReaderT EntityAlias FromIr FieldSource
fromAnnFieldsG :: (FieldName, AnnFieldG 'MySQL Void Expression)
-> ReaderT EntityAlias FromIr FieldSource
fromAnnFieldsG (IR.FieldName Text
name, AnnFieldG 'MySQL Void Expression
field) =
  case AnnFieldG 'MySQL Void Expression
field of
    IR.AFColumn AnnColumnField 'MySQL Expression
annColumnField -> do
      Expression
expression <- AnnColumnField 'MySQL Expression
-> ReaderT EntityAlias FromIr Expression
fromAnnColumnField AnnColumnField 'MySQL Expression
annColumnField
      FieldSource -> ReaderT EntityAlias FromIr FieldSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Aliased Expression -> FieldSource
ExpressionFieldSource
            Aliased :: forall a. a -> Text -> Aliased a
Aliased {aliasedThing :: Expression
aliasedThing = Expression
expression, aliasedAlias :: Text
aliasedAlias = Text
name}
        )
    IR.AFExpression Text
text ->
      FieldSource -> ReaderT EntityAlias FromIr FieldSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Aliased Expression -> FieldSource
ExpressionFieldSource
            Aliased :: forall a. a -> Text -> Aliased a
Aliased
              { aliasedThing :: Expression
aliasedThing = ScalarValue -> Expression
ValueExpression (Text -> ScalarValue
TextValue Text
text),
                aliasedAlias :: Text
aliasedAlias = Text
name
              }
        )
    IR.AFObjectRelation ObjectRelationSelectG 'MySQL Void Expression
objectRelationSelectG ->
      (Join -> FieldSource)
-> ReaderT EntityAlias FromIr Join
-> ReaderT EntityAlias FromIr FieldSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \Join
aliasedThing ->
            Aliased Join -> FieldSource
JoinFieldSource (Aliased :: forall a. a -> Text -> Aliased a
Aliased {Join
aliasedThing :: Join
aliasedThing :: Join
aliasedThing, aliasedAlias :: Text
aliasedAlias = Text
name})
        )
        (ObjectRelationSelectG 'MySQL Void Expression
-> ReaderT EntityAlias FromIr Join
fromObjectRelationSelectG ObjectRelationSelectG 'MySQL Void Expression
objectRelationSelectG)
    IR.AFArrayRelation ArraySelectG 'MySQL Void Expression
arraySelectG ->
      (Join -> FieldSource)
-> ReaderT EntityAlias FromIr Join
-> ReaderT EntityAlias FromIr FieldSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \Join
aliasedThing ->
            Aliased Join -> FieldSource
JoinFieldSource (Aliased :: forall a. a -> Text -> Aliased a
Aliased {Join
aliasedThing :: Join
aliasedThing :: Join
aliasedThing, aliasedAlias :: Text
aliasedAlias = Text
name})
        )
        (ArraySelectG 'MySQL Void Expression
-> ReaderT EntityAlias FromIr Join
fromArraySelectG ArraySelectG 'MySQL Void Expression
arraySelectG)

mkSQLSelect ::
  IR.JsonAggSelect ->
  IR.AnnSelectG 'MySQL (IR.AnnFieldG 'MySQL Void) Expression ->
  FromIr Select
mkSQLSelect :: JsonAggSelect
-> AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
-> FromIr Select
mkSQLSelect JsonAggSelect
jsonAggSelect AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
annSimpleSel = do
  case JsonAggSelect
jsonAggSelect of
    JsonAggSelect
IR.JASMultipleRows -> AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
-> FromIr Select
fromSelectRows AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
annSimpleSel
    JsonAggSelect
IR.JASSingleObject ->
      AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
-> FromIr Select
fromSelectRows AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
annSimpleSel FromIr Select -> (Select -> Select) -> FromIr Select
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Select
sel ->
        Select
sel
          { selectSqlTop :: Top
selectSqlTop = Int -> Top
Top Int
1
          }

-- | Convert from the IR database query into a select.
fromRootField :: IR.QueryDB 'MySQL Void Expression -> FromIr Select
fromRootField :: QueryDB 'MySQL Void Expression -> FromIr Select
fromRootField =
  \case
    (IR.QDBSingleRow AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
s) -> JsonAggSelect
-> AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
-> FromIr Select
mkSQLSelect JsonAggSelect
IR.JASSingleObject AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
s
    (IR.QDBMultipleRows AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
s) -> JsonAggSelect
-> AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
-> FromIr Select
mkSQLSelect JsonAggSelect
IR.JASMultipleRows AnnSelectG 'MySQL (AnnFieldG 'MySQL Void) Expression
s
    (IR.QDBAggregation AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression
s) -> Maybe (EntityAlias, HashMap Column Column)
-> AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression
-> FromIr Select
fromSelectAggregate Maybe (EntityAlias, HashMap Column Column)
forall a. Maybe a
Nothing AnnSelectG 'MySQL (TableAggregateFieldG 'MySQL Void) Expression
s

fromMappingFieldNames ::
  EntityAlias ->
  HashMap Column Column ->
  ReaderT EntityAlias FromIr [(FieldName, FieldName)]
fromMappingFieldNames :: EntityAlias
-> HashMap Column Column
-> ReaderT EntityAlias FromIr [(FieldName, FieldName)]
fromMappingFieldNames EntityAlias
localFrom =
  ((Column, Column)
 -> ReaderT EntityAlias FromIr (FieldName, FieldName))
-> [(Column, Column)]
-> ReaderT EntityAlias FromIr [(FieldName, FieldName)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
    ( \(Column
remoteColumn, Column
localColumn) -> do
        FieldName
localFieldName <- (EntityAlias -> EntityAlias)
-> ReaderT EntityAlias FromIr FieldName
-> ReaderT EntityAlias FromIr FieldName
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (EntityAlias -> EntityAlias -> EntityAlias
forall a b. a -> b -> a
const EntityAlias
localFrom) (Column -> ReaderT EntityAlias FromIr FieldName
fromColumn Column
localColumn)
        FieldName
remoteFieldName <- Column -> ReaderT EntityAlias FromIr FieldName
fromColumn Column
remoteColumn
        (FieldName, FieldName)
-> ReaderT EntityAlias FromIr (FieldName, FieldName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( (,)
              (FieldName
localFieldName)
              (FieldName
remoteFieldName)
          )
    )
    ([(Column, Column)]
 -> ReaderT EntityAlias FromIr [(FieldName, FieldName)])
-> (HashMap Column Column -> [(Column, Column)])
-> HashMap Column Column
-> ReaderT EntityAlias FromIr [(FieldName, FieldName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Column Column -> [(Column, Column)]
forall k v. HashMap k v -> [(k, v)]
HM.toList

fieldTextNames :: IR.AnnFieldsG 'MySQL Void Expression -> [Text]
fieldTextNames :: [(FieldName, AnnFieldG 'MySQL Void Expression)] -> [Text]
fieldTextNames = ((FieldName, AnnFieldG 'MySQL Void Expression) -> Text)
-> [(FieldName, AnnFieldG 'MySQL Void Expression)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(IR.FieldName Text
name, AnnFieldG 'MySQL Void Expression
_) -> Text
name)