{-# LANGUAGE DuplicateRecordFields #-}

-- | Make a plan for the data loader to execute (.Execute).
--
-- It will produce a graph of actions, to be executed by .Execute.
module Hasura.Backends.MySQL.DataLoader.Plan
  ( Ref,
    PlannedAction (..),
    Action (..),
    Select (..),
    Join (..),
    Relationship (..),
    FieldName (..),
    HeadAndTail (..),
    toFieldName,
    runPlan,
    planSelectHeadAndTail,
    actionsForest,
    selectQuery,
  )
where

import Data.Aeson
import Data.Bifunctor
import Data.Graph
import Data.HashSet.InsOrd qualified as OSet
import Data.Sequence qualified as Seq
import Data.String
import Hasura.Backends.MySQL.Types qualified as MySQL
import Hasura.Prelude hiding (head, second, tail, tell)

--------------------------------------------------------------------------------
-- Types

-- | A reference to a result of loading a recordset from the database.
data Ref = Ref
  { -- | This index will be generated by the planner.
    Ref -> Int
idx :: Int,
    -- | A display name. The idx gives us uniqueness.
    Ref -> Text
text :: Text
  }
  deriving (Int -> Ref -> ShowS
[Ref] -> ShowS
Ref -> String
(Int -> Ref -> ShowS)
-> (Ref -> String) -> ([Ref] -> ShowS) -> Show Ref
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ref] -> ShowS
$cshowList :: [Ref] -> ShowS
show :: Ref -> String
$cshow :: Ref -> String
showsPrec :: Int -> Ref -> ShowS
$cshowsPrec :: Int -> Ref -> ShowS
Show, Ref -> Ref -> Bool
(Ref -> Ref -> Bool) -> (Ref -> Ref -> Bool) -> Eq Ref
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ref -> Ref -> Bool
$c/= :: Ref -> Ref -> Bool
== :: Ref -> Ref -> Bool
$c== :: Ref -> Ref -> Bool
Eq, (forall x. Ref -> Rep Ref x)
-> (forall x. Rep Ref x -> Ref) -> Generic Ref
forall x. Rep Ref x -> Ref
forall x. Ref -> Rep Ref x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ref x -> Ref
$cfrom :: forall x. Ref -> Rep Ref x
Generic, Eq Ref
Eq Ref
-> (Ref -> Ref -> Ordering)
-> (Ref -> Ref -> Bool)
-> (Ref -> Ref -> Bool)
-> (Ref -> Ref -> Bool)
-> (Ref -> Ref -> Bool)
-> (Ref -> Ref -> Ref)
-> (Ref -> Ref -> Ref)
-> Ord Ref
Ref -> Ref -> Bool
Ref -> Ref -> Ordering
Ref -> Ref -> Ref
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ref -> Ref -> Ref
$cmin :: Ref -> Ref -> Ref
max :: Ref -> Ref -> Ref
$cmax :: Ref -> Ref -> Ref
>= :: Ref -> Ref -> Bool
$c>= :: Ref -> Ref -> Bool
> :: Ref -> Ref -> Bool
$c> :: Ref -> Ref -> Bool
<= :: Ref -> Ref -> Bool
$c<= :: Ref -> Ref -> Bool
< :: Ref -> Ref -> Bool
$c< :: Ref -> Ref -> Bool
compare :: Ref -> Ref -> Ordering
$ccompare :: Ref -> Ref -> Ordering
$cp1Ord :: Eq Ref
Ord)

instance Hashable Ref

-- | A almost-the-same version of Select from Types.Internal, except
-- with some fields used for planning and executing.
data Select = Select
  { Select -> Maybe Text
selectAggUnwrap :: Maybe Text,
    Select -> From
selectFrom :: MySQL.From,
    Select -> [FieldName]
selectGroupBy :: [MySQL.FieldName],
    Select -> [Join]
selectHaskellJoins :: [MySQL.Join],
    Select -> Maybe (NonEmpty OrderBy)
selectOrderBy :: Maybe (NonEmpty MySQL.OrderBy),
    Select -> [Projection]
selectProjections :: [MySQL.Projection],
    Select -> Maybe Relationship
selectRelationship :: Maybe Relationship,
    Select -> Where
selectWhere :: MySQL.Where,
    Select -> Maybe [Text]
selectWantedFields :: Maybe [Text],
    Select -> Maybe Int
selectSqlOffset :: Maybe Int,
    Select -> Top
selectSqlTop :: MySQL.Top
  }
  deriving (Int -> Select -> ShowS
[Select] -> ShowS
Select -> String
(Int -> Select -> ShowS)
-> (Select -> String) -> ([Select] -> ShowS) -> Show Select
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Select] -> ShowS
$cshowList :: [Select] -> ShowS
show :: Select -> String
$cshow :: Select -> String
showsPrec :: Int -> Select -> ShowS
$cshowsPrec :: Int -> Select -> ShowS
Show)

-- | An join action.
data Join = Join
  { -- | Join this side...
    Join -> Ref
leftRecordSet :: Ref,
    -- | with this side.
    Join -> Ref
rightRecordSet :: Ref,
    -- | Join only the top N results. It's important that we do this
    -- IN HASKELL, therefore this is not part of the generated SQL.
    Join -> Top
joinRhsTop :: MySQL.Top,
    -- | Offset applied to the right-hand-side table.
    Join -> Maybe Int
joinRhsOffset :: Maybe Int,
    -- | Type of relational join to do.
    Join -> JoinType
joinType :: MySQL.JoinType,
    -- | Field name to return the join result as; e.g. "albums" for an
    -- artist with an array relation of albums.
    Join -> Text
joinFieldName :: Text,
    -- | The SQL queries may achieve the data using joining fields,
    -- but those fields aren't supposed to be returned back to the
    -- user. To avoid that, we explicitly specify which fields are
    -- wanted from this join. E.g. "title" and "year", but not
    -- artist_id which was used to Haskell-join the row with an
    -- album_artist_id, or whatever.
    Join -> Maybe [Text]
wantedFields :: Maybe [Text]
  }
  deriving (Int -> Join -> ShowS
[Join] -> ShowS
Join -> String
(Int -> Join -> ShowS)
-> (Join -> String) -> ([Join] -> ShowS) -> Show Join
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Join] -> ShowS
$cshowList :: [Join] -> ShowS
show :: Join -> String
$cshow :: Join -> String
showsPrec :: Int -> Join -> ShowS
$cshowsPrec :: Int -> Join -> ShowS
Show)

-- | An action that the executor will perform. Either pull data from
-- the database directly via a select, or join two other actions'
-- record sets together.
data Action
  = SelectAction Select
  | JoinAction Join
  deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show)

-- | An action planned, with a unique reference. I.e. the @action@
-- performed yields a result stored at reference @ref@.
data PlannedAction = PlannedAction
  { PlannedAction -> Ref
ref :: Ref,
    PlannedAction -> Action
action :: Action
  }
  deriving (Int -> PlannedAction -> ShowS
[PlannedAction] -> ShowS
PlannedAction -> String
(Int -> PlannedAction -> ShowS)
-> (PlannedAction -> String)
-> ([PlannedAction] -> ShowS)
-> Show PlannedAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlannedAction] -> ShowS
$cshowList :: [PlannedAction] -> ShowS
show :: PlannedAction -> String
$cshow :: PlannedAction -> String
showsPrec :: Int -> PlannedAction -> ShowS
$cshowsPrec :: Int -> PlannedAction -> ShowS
Show)

-- | A relationship lets the executor insert on-the-fly WHERE
-- fkey1=fkey2 for relationships. These can only be inserted
-- on-the-fly and aren't known at the time of planning, because the
-- keys come from the left-hand-side table for a join.
data Relationship = Relationship
  { Relationship -> Ref
leftRecordSet :: Ref,
    Relationship -> EntityAlias
rightTable :: MySQL.EntityAlias,
    Relationship -> JoinType
joinType :: MySQL.JoinType
  }
  deriving (Int -> Relationship -> ShowS
[Relationship] -> ShowS
Relationship -> String
(Int -> Relationship -> ShowS)
-> (Relationship -> String)
-> ([Relationship] -> ShowS)
-> Show Relationship
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relationship] -> ShowS
$cshowList :: [Relationship] -> ShowS
show :: Relationship -> String
$cshow :: Relationship -> String
showsPrec :: Int -> Relationship -> ShowS
$cshowsPrec :: Int -> Relationship -> ShowS
Show)

-- | Just a wrapper to clarify some types. It's different from the
-- MySQL.FieldName because it doesn't care about schemas: schemas
-- aren't returned in recordsets from the database.
newtype FieldName
  = FieldName Text
  deriving (Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
(Int -> FieldName -> ShowS)
-> (FieldName -> String)
-> ([FieldName] -> ShowS)
-> Show FieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldName] -> ShowS
$cshowList :: [FieldName] -> ShowS
show :: FieldName -> String
$cshow :: FieldName -> String
showsPrec :: Int -> FieldName -> ShowS
$cshowsPrec :: Int -> FieldName -> ShowS
Show, Eq FieldName
Eq FieldName
-> (FieldName -> FieldName -> Ordering)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> FieldName)
-> (FieldName -> FieldName -> FieldName)
-> Ord FieldName
FieldName -> FieldName -> Bool
FieldName -> FieldName -> Ordering
FieldName -> FieldName -> FieldName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldName -> FieldName -> FieldName
$cmin :: FieldName -> FieldName -> FieldName
max :: FieldName -> FieldName -> FieldName
$cmax :: FieldName -> FieldName -> FieldName
>= :: FieldName -> FieldName -> Bool
$c>= :: FieldName -> FieldName -> Bool
> :: FieldName -> FieldName -> Bool
$c> :: FieldName -> FieldName -> Bool
<= :: FieldName -> FieldName -> Bool
$c<= :: FieldName -> FieldName -> Bool
< :: FieldName -> FieldName -> Bool
$c< :: FieldName -> FieldName -> Bool
compare :: FieldName -> FieldName -> Ordering
$ccompare :: FieldName -> FieldName -> Ordering
$cp1Ord :: Eq FieldName
Ord, FieldName -> FieldName -> Bool
(FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool) -> Eq FieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c== :: FieldName -> FieldName -> Bool
Eq, Int -> FieldName -> Int
FieldName -> Int
(Int -> FieldName -> Int)
-> (FieldName -> Int) -> Hashable FieldName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FieldName -> Int
$chash :: FieldName -> Int
hashWithSalt :: Int -> FieldName -> Int
$chashWithSalt :: Int -> FieldName -> Int
Hashable, Value -> Parser [FieldName]
Value -> Parser FieldName
(Value -> Parser FieldName)
-> (Value -> Parser [FieldName]) -> FromJSON FieldName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FieldName]
$cparseJSONList :: Value -> Parser [FieldName]
parseJSON :: Value -> Parser FieldName
$cparseJSON :: Value -> Parser FieldName
FromJSON, ToJSONKeyFunction [FieldName]
ToJSONKeyFunction FieldName
ToJSONKeyFunction FieldName
-> ToJSONKeyFunction [FieldName] -> ToJSONKey FieldName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [FieldName]
$ctoJSONKeyList :: ToJSONKeyFunction [FieldName]
toJSONKey :: ToJSONKeyFunction FieldName
$ctoJSONKey :: ToJSONKeyFunction FieldName
ToJSONKey, String -> FieldName
(String -> FieldName) -> IsString FieldName
forall a. (String -> a) -> IsString a
fromString :: String -> FieldName
$cfromString :: String -> FieldName
IsString)

-- | The reason for this is subtle. Read this documentation. For each
-- join on a select (see above, there is a list), we split that out
-- into three jobs:
--
-- 1. One job for the left hand side (i.e. the select).
-- 2. One job for the right hand side (i.e. the join).
-- 3. One job to join them (And in the darkness bind them...)
--
-- This is performed as a fold, like: @foldM planJoin head joins@. A
-- nice linked-list or tree-like structure arises. The planner code
-- produces a graph out of this; so it's possible that some
-- parallelism can be achieved by running multiple jobs at once.
--
-- The "head" is the first, original select. The "tail" is the
-- (indirectly) linked list of joins. That list may also be empty. In
-- that case, the tail is simply the same as the head.
--
-- If the tail is different to the head, then we choose the tail, as
-- it represents the joined up version of both. If they're the same,
-- we take whichever.
data HeadAndTail = HeadAndTail
  { HeadAndTail -> Ref
head :: Ref,
    HeadAndTail -> Ref
tail :: Ref
  }

-- | We're simply accumulating a set of actions with this. The counter
-- lets us generate unique refs.
data PlanState = PlanState
  { PlanState -> Seq PlannedAction
actions :: Seq PlannedAction,
    PlanState -> Int
counter :: Int
  }

-- | Simple monad to collect actions.
newtype Plan a = Plan
  { Plan a -> State PlanState a
unPlan :: State PlanState a
  }
  deriving (a -> Plan b -> Plan a
(a -> b) -> Plan a -> Plan b
(forall a b. (a -> b) -> Plan a -> Plan b)
-> (forall a b. a -> Plan b -> Plan a) -> Functor Plan
forall a b. a -> Plan b -> Plan a
forall a b. (a -> b) -> Plan a -> Plan b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Plan b -> Plan a
$c<$ :: forall a b. a -> Plan b -> Plan a
fmap :: (a -> b) -> Plan a -> Plan b
$cfmap :: forall a b. (a -> b) -> Plan a -> Plan b
Functor, Functor Plan
a -> Plan a
Functor Plan
-> (forall a. a -> Plan a)
-> (forall a b. Plan (a -> b) -> Plan a -> Plan b)
-> (forall a b c. (a -> b -> c) -> Plan a -> Plan b -> Plan c)
-> (forall a b. Plan a -> Plan b -> Plan b)
-> (forall a b. Plan a -> Plan b -> Plan a)
-> Applicative Plan
Plan a -> Plan b -> Plan b
Plan a -> Plan b -> Plan a
Plan (a -> b) -> Plan a -> Plan b
(a -> b -> c) -> Plan a -> Plan b -> Plan c
forall a. a -> Plan a
forall a b. Plan a -> Plan b -> Plan a
forall a b. Plan a -> Plan b -> Plan b
forall a b. Plan (a -> b) -> Plan a -> Plan b
forall a b c. (a -> b -> c) -> Plan a -> Plan b -> Plan 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
<* :: Plan a -> Plan b -> Plan a
$c<* :: forall a b. Plan a -> Plan b -> Plan a
*> :: Plan a -> Plan b -> Plan b
$c*> :: forall a b. Plan a -> Plan b -> Plan b
liftA2 :: (a -> b -> c) -> Plan a -> Plan b -> Plan c
$cliftA2 :: forall a b c. (a -> b -> c) -> Plan a -> Plan b -> Plan c
<*> :: Plan (a -> b) -> Plan a -> Plan b
$c<*> :: forall a b. Plan (a -> b) -> Plan a -> Plan b
pure :: a -> Plan a
$cpure :: forall a. a -> Plan a
$cp1Applicative :: Functor Plan
Applicative, Applicative Plan
a -> Plan a
Applicative Plan
-> (forall a b. Plan a -> (a -> Plan b) -> Plan b)
-> (forall a b. Plan a -> Plan b -> Plan b)
-> (forall a. a -> Plan a)
-> Monad Plan
Plan a -> (a -> Plan b) -> Plan b
Plan a -> Plan b -> Plan b
forall a. a -> Plan a
forall a b. Plan a -> Plan b -> Plan b
forall a b. Plan a -> (a -> Plan b) -> Plan 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 -> Plan a
$creturn :: forall a. a -> Plan a
>> :: Plan a -> Plan b -> Plan b
$c>> :: forall a b. Plan a -> Plan b -> Plan b
>>= :: Plan a -> (a -> Plan b) -> Plan b
$c>>= :: forall a b. Plan a -> (a -> Plan b) -> Plan b
$cp1Monad :: Applicative Plan
Monad, MonadState PlanState)

--------------------------------------------------------------------------------
-- Conversions

-- | Note that we're intentionally discarding the table qualification.
toFieldName :: MySQL.FieldName -> FieldName
toFieldName :: FieldName -> FieldName
toFieldName (MySQL.FieldName {fName :: FieldName -> Text
fName = Text
t}) = Text -> FieldName
FieldName Text
t

joinAliasName :: MySQL.EntityAlias -> Text
joinAliasName :: EntityAlias -> Text
joinAliasName (MySQL.EntityAlias {Text
entityAliasText :: EntityAlias -> Text
entityAliasText :: Text
entityAliasText}) = Text
entityAliasText

-- | Used for display purposes, not semantic content.
selectFromName :: MySQL.From -> Text
selectFromName :: From -> Text
selectFromName =
  \case
    MySQL.FromQualifiedTable (MySQL.Aliased {aliasedThing :: forall a. Aliased a -> a
aliasedThing = MySQL.TableName {Text
name :: TableName -> Text
name :: Text
name}}) ->
      Text
name
    MySQL.FromSelect (MySQL.Aliased {aliasedThing :: forall a. Aliased a -> a
aliasedThing = MySQL.Select {From
selectFrom :: Select -> From
selectFrom :: From
selectFrom}}) ->
      From -> Text
selectFromName From
selectFrom

--------------------------------------------------------------------------------
-- Run planner

runPlan :: Plan r -> (r, [PlannedAction])
runPlan :: Plan r -> (r, [PlannedAction])
runPlan =
  (PlanState -> [PlannedAction])
-> (r, PlanState) -> (r, [PlannedAction])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Seq PlannedAction -> [PlannedAction]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq PlannedAction -> [PlannedAction])
-> (PlanState -> Seq PlannedAction) -> PlanState -> [PlannedAction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanState -> Seq PlannedAction
actions)
    ((r, PlanState) -> (r, [PlannedAction]))
-> (Plan r -> (r, PlanState)) -> Plan r -> (r, [PlannedAction])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State PlanState r -> PlanState -> (r, PlanState))
-> PlanState -> State PlanState r -> (r, PlanState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State PlanState r -> PlanState -> (r, PlanState)
forall s a. State s a -> s -> (a, s)
runState (PlanState :: Seq PlannedAction -> Int -> PlanState
PlanState {$sel:actions:PlanState :: Seq PlannedAction
actions = Seq PlannedAction
forall a. Monoid a => a
mempty, $sel:counter:PlanState :: Int
counter = Int
0})
    (State PlanState r -> (r, PlanState))
-> (Plan r -> State PlanState r) -> Plan r -> (r, PlanState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plan r -> State PlanState r
forall a. Plan a -> State PlanState a
unPlan

--------------------------------------------------------------------------------
-- Planners

-- | See the documentation for 'HeadAndTail'.
planSelectHeadAndTail :: Maybe Relationship -> Maybe Text -> MySQL.Select -> Plan HeadAndTail
planSelectHeadAndTail :: Maybe Relationship -> Maybe Text -> Select -> Plan HeadAndTail
planSelectHeadAndTail Maybe Relationship
relationship Maybe Text
joinExtractPath Select
select0 = do
  Ref
ref <- Text -> Plan Ref
generate (From -> Text
selectFromName (Select -> From
MySQL.selectFrom Select
select0))
  let select :: Select
select = Maybe Relationship -> Maybe Text -> Select -> Select
fromSelect Maybe Relationship
relationship Maybe Text
joinExtractPath Select
select0
      action :: Action
action = Select -> Action
SelectAction Select
select
  PlannedAction -> Plan ()
tell PlannedAction :: Ref -> Action -> PlannedAction
PlannedAction {Ref
ref :: Ref
$sel:ref:PlannedAction :: Ref
ref, Action
action :: Action
$sel:action:PlannedAction :: Action
action}
  Ref
joinsFinalRef <- (Ref -> Join -> Plan Ref) -> Ref -> [Join] -> Plan Ref
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Ref -> Join -> Plan Ref
planJoin Ref
ref (Select -> [Join]
selectHaskellJoins Select
select)
  HeadAndTail -> Plan HeadAndTail
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( let head :: Ref
head = Ref
ref
          tail :: Ref
tail = case Select -> [Join]
selectHaskellJoins Select
select of
            [] -> Ref
ref
            [Join]
_ -> Ref
joinsFinalRef
       in HeadAndTail :: Ref -> Ref -> HeadAndTail
HeadAndTail {Ref
head :: Ref
$sel:head:HeadAndTail :: Ref
head, Ref
tail :: Ref
$sel:tail:HeadAndTail :: Ref
tail}
    )

-- | Given a left-hand-side table and a join spec, produce a single
-- reference that refers to the composition of the two.
planJoin :: Ref -> MySQL.Join -> Plan Ref
planJoin :: Ref -> Join -> Plan Ref
planJoin Ref
leftRecordSet Join
join' = do
  Ref
ref <- Text -> Plan Ref
generate (EntityAlias -> Text
joinAliasName (Join -> EntityAlias
MySQL.joinRightTable Join
join'))
  Ref
rightRecordSet <-
    (HeadAndTail -> Ref) -> Plan HeadAndTail -> Plan Ref
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\HeadAndTail {Ref
tail :: Ref
head :: Ref
$sel:tail:HeadAndTail :: HeadAndTail -> Ref
$sel:head:HeadAndTail :: HeadAndTail -> Ref
..} -> Ref
tail)
      ( Maybe Relationship -> Maybe Text -> Select -> Plan HeadAndTail
planSelectHeadAndTail
          ( Relationship -> Maybe Relationship
forall a. a -> Maybe a
Just
              ( Relationship :: Ref -> EntityAlias -> JoinType -> Relationship
Relationship
                  { Ref
leftRecordSet :: Ref
$sel:leftRecordSet:Relationship :: Ref
leftRecordSet,
                    $sel:joinType:Relationship :: JoinType
joinType = Join -> JoinType
MySQL.joinType Join
join',
                    $sel:rightTable:Relationship :: EntityAlias
rightTable = Join -> EntityAlias
MySQL.joinRightTable Join
join'
                  }
              )
          )
          Maybe Text
forall a. Maybe a
Nothing
          (Join -> Select
MySQL.joinSelect Join
join')
      )
  let action :: Action
action =
        Join -> Action
JoinAction
          Join :: Ref
-> Ref
-> Top
-> Maybe Int
-> JoinType
-> Text
-> Maybe [Text]
-> Join
Join
            { Ref
leftRecordSet :: Ref
$sel:leftRecordSet:Join :: Ref
leftRecordSet,
              Ref
rightRecordSet :: Ref
$sel:rightRecordSet:Join :: Ref
rightRecordSet,
              $sel:wantedFields:Join :: Maybe [Text]
wantedFields = Select -> Maybe [Text]
MySQL.selectFinalWantedFields (Join -> Select
MySQL.joinSelect Join
join'),
              $sel:joinRhsTop:Join :: Top
joinRhsTop = Join -> Top
MySQL.joinTop Join
join',
              $sel:joinRhsOffset:Join :: Maybe Int
joinRhsOffset = Join -> Maybe Int
MySQL.joinOffset Join
join',
              $sel:joinFieldName:Join :: Text
joinFieldName = Join -> Text
MySQL.joinFieldName Join
join',
              $sel:joinType:Join :: JoinType
joinType = Join -> JoinType
MySQL.joinType Join
join',
              ..
            }
  PlannedAction -> Plan ()
tell PlannedAction :: Ref -> Action -> PlannedAction
PlannedAction {Ref
ref :: Ref
$sel:ref:PlannedAction :: Ref
ref, Action
action :: Action
$sel:action:PlannedAction :: Action
action}
  Ref -> Plan Ref
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ref
ref

--------------------------------------------------------------------------------
-- Monad helpers

-- | Write the planned action to the state, like a writer's @tell@.
tell :: PlannedAction -> Plan ()
tell :: PlannedAction -> Plan ()
tell PlannedAction
action = (PlanState -> PlanState) -> Plan ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\PlanState
s -> PlanState
s {$sel:actions:PlanState :: Seq PlannedAction
actions = PlanState -> Seq PlannedAction
actions PlanState
s Seq PlannedAction -> PlannedAction -> Seq PlannedAction
forall a. Seq a -> a -> Seq a
Seq.:|> PlannedAction
action})

-- | Generate a unique reference with a label for debugging.
generate :: Text -> Plan Ref
generate :: Text -> Plan Ref
generate Text
text = do
  Int
idx <- (PlanState -> Int) -> Plan Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PlanState -> Int
counter
  (PlanState -> PlanState) -> Plan ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\PlanState
s -> PlanState
s {$sel:counter:PlanState :: Int
counter = PlanState -> Int
counter PlanState
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1})
  Ref -> Plan Ref
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ref :: Int -> Text -> Ref
Ref {Int
idx :: Int
$sel:idx:Ref :: Int
idx, Text
text :: Text
$sel:text:Ref :: Text
text})

--------------------------------------------------------------------------------
-- Graphing the plan to a forest

-- | Graph the set of planned actions ready for execution in the correct order.
actionsForest :: (Graph -> Graph) -> [PlannedAction] -> Forest PlannedAction
actionsForest :: (Graph -> Graph) -> [PlannedAction] -> Forest PlannedAction
actionsForest Graph -> Graph
transform [PlannedAction]
actions =
  let (Graph
graph, Int -> (Action, Ref, [Ref])
vertex2Node, Ref -> Maybe Int
_key2Vertex) =
        [(Action, Ref, [Ref])]
-> (Graph, Int -> (Action, Ref, [Ref]), Ref -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
graphFromEdges
          ( (PlannedAction -> (Action, Ref, [Ref]))
-> [PlannedAction] -> [(Action, Ref, [Ref])]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \PlannedAction {Ref
ref :: Ref
$sel:ref:PlannedAction :: PlannedAction -> Ref
ref, Action
action :: Action
$sel:action:PlannedAction :: PlannedAction -> Action
action} ->
                  ( Action
action,
                    Ref
ref,
                    (PlannedAction -> Ref) -> [PlannedAction] -> [Ref]
forall a b. (a -> b) -> [a] -> [b]
map
                      (\PlannedAction {$sel:ref:PlannedAction :: PlannedAction -> Ref
ref = Ref
r} -> Ref
r)
                      ((PlannedAction -> Bool) -> [PlannedAction] -> [PlannedAction]
forall a. (a -> Bool) -> [a] -> [a]
filter (Ref -> [Ref] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Ref
ref ([Ref] -> Bool)
-> (PlannedAction -> [Ref]) -> PlannedAction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlannedAction -> [Ref]
plannedActionRefs) [PlannedAction]
actions)
                  )
              )
              [PlannedAction]
actions
          )
   in (Tree Int -> Tree PlannedAction)
-> [Tree Int] -> Forest PlannedAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( (Int -> PlannedAction) -> Tree Int -> Tree PlannedAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ((\(Action
action, Ref
ref, [Ref]
_refs) -> PlannedAction :: Ref -> Action -> PlannedAction
PlannedAction {Ref
ref :: Ref
$sel:ref:PlannedAction :: Ref
ref, Action
action :: Action
$sel:action:PlannedAction :: Action
action}) ((Action, Ref, [Ref]) -> PlannedAction)
-> (Int -> (Action, Ref, [Ref])) -> Int -> PlannedAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Action, Ref, [Ref])
vertex2Node)
        )
        (Graph -> [Tree Int]
dff (Graph -> Graph
transform Graph
graph))
  where
    plannedActionRefs :: PlannedAction -> [Ref]
plannedActionRefs PlannedAction {Action
action :: Action
$sel:action:PlannedAction :: PlannedAction -> Action
action} =
      case Action
action of
        SelectAction Select {Maybe Relationship
selectRelationship :: Maybe Relationship
$sel:selectRelationship:Select :: Select -> Maybe Relationship
selectRelationship} ->
          case Maybe Relationship
selectRelationship of
            Just Relationship {Ref
leftRecordSet :: Ref
$sel:leftRecordSet:Relationship :: Relationship -> Ref
leftRecordSet} -> [Ref
leftRecordSet]
            Maybe Relationship
Nothing -> [Ref]
forall a. Monoid a => a
mempty
        JoinAction Join {Ref
leftRecordSet :: Ref
$sel:leftRecordSet:Join :: Join -> Ref
leftRecordSet, Ref
rightRecordSet :: Ref
$sel:rightRecordSet:Join :: Join -> Ref
rightRecordSet} ->
          [Ref
leftRecordSet, Ref
rightRecordSet]

--------------------------------------------------------------------------------
-- Build a query

-- | Used by the executor to produce a plain old select that can be
-- sent to the MySQL server.
selectQuery :: Select -> MySQL.Select
selectQuery :: Select -> Select
selectQuery Select {[Join]
[Projection]
[FieldName]
Maybe Int
Maybe [Text]
Maybe (NonEmpty OrderBy)
Maybe Text
Maybe Relationship
Where
From
Top
selectSqlTop :: Top
selectSqlOffset :: Maybe Int
selectWantedFields :: Maybe [Text]
selectWhere :: Where
selectRelationship :: Maybe Relationship
selectProjections :: [Projection]
selectOrderBy :: Maybe (NonEmpty OrderBy)
selectHaskellJoins :: [Join]
selectGroupBy :: [FieldName]
selectFrom :: From
selectAggUnwrap :: Maybe Text
$sel:selectSqlTop:Select :: Select -> Top
$sel:selectSqlOffset:Select :: Select -> Maybe Int
$sel:selectWantedFields:Select :: Select -> Maybe [Text]
$sel:selectWhere:Select :: Select -> Where
$sel:selectRelationship:Select :: Select -> Maybe Relationship
$sel:selectProjections:Select :: Select -> [Projection]
$sel:selectOrderBy:Select :: Select -> Maybe (NonEmpty OrderBy)
$sel:selectHaskellJoins:Select :: Select -> [Join]
$sel:selectGroupBy:Select :: Select -> [FieldName]
$sel:selectFrom:Select :: Select -> From
$sel:selectAggUnwrap:Select :: Select -> Maybe Text
..} =
  Select :: InsOrdHashSet Projection
-> From
-> [Join]
-> Where
-> Maybe (NonEmpty OrderBy)
-> Maybe Int
-> Top
-> [FieldName]
-> Maybe [Text]
-> Select
MySQL.Select
    { selectJoins :: [Join]
selectJoins = [Join]
selectHaskellJoins,
      selectProjections :: InsOrdHashSet Projection
selectProjections = [Projection] -> InsOrdHashSet Projection
forall k. (Eq k, Hashable k) => [k] -> InsOrdHashSet k
OSet.fromList [Projection]
selectProjections,
      selectFinalWantedFields :: Maybe [Text]
selectFinalWantedFields = Maybe [Text]
selectWantedFields,
      [FieldName]
Maybe Int
Maybe (NonEmpty OrderBy)
Where
From
Top
selectGroupBy :: [FieldName]
selectSqlTop :: Top
selectSqlOffset :: Maybe Int
selectOrderBy :: Maybe (NonEmpty OrderBy)
selectWhere :: Where
selectSqlTop :: Top
selectSqlOffset :: Maybe Int
selectWhere :: Where
selectOrderBy :: Maybe (NonEmpty OrderBy)
selectGroupBy :: [FieldName]
selectFrom :: From
selectFrom :: From
..
    }

-- | From a plain select, and possibly a parent/left-hand-side
-- relationship, produce a select that is useful for execution.
fromSelect :: Maybe Relationship -> Maybe Text -> MySQL.Select -> Select
fromSelect :: Maybe Relationship -> Maybe Text -> Select -> Select
fromSelect Maybe Relationship
selectRelationship Maybe Text
selectAggUnwrap select :: Select
select@MySQL.Select {[Join]
[FieldName]
Maybe Int
Maybe [Text]
Maybe (NonEmpty OrderBy)
InsOrdHashSet Projection
Where
From
Top
selectFinalWantedFields :: Maybe [Text]
selectGroupBy :: [FieldName]
selectSqlTop :: Top
selectSqlOffset :: Maybe Int
selectOrderBy :: Maybe (NonEmpty OrderBy)
selectWhere :: Where
selectJoins :: [Join]
selectFrom :: From
selectProjections :: InsOrdHashSet Projection
selectGroupBy :: Select -> [FieldName]
selectSqlTop :: Select -> Top
selectSqlOffset :: Select -> Maybe Int
selectOrderBy :: Select -> Maybe (NonEmpty OrderBy)
selectWhere :: Select -> Where
selectProjections :: Select -> InsOrdHashSet Projection
selectJoins :: Select -> [Join]
selectFinalWantedFields :: Select -> Maybe [Text]
selectFrom :: Select -> From
..} =
  Select :: Maybe Text
-> From
-> [FieldName]
-> [Join]
-> Maybe (NonEmpty OrderBy)
-> [Projection]
-> Maybe Relationship
-> Where
-> Maybe [Text]
-> Maybe Int
-> Top
-> Select
Select
    { $sel:selectHaskellJoins:Select :: [Join]
selectHaskellJoins = [Join]
selectJoins,
      $sel:selectWantedFields:Select :: Maybe [Text]
selectWantedFields = Select -> Maybe [Text]
MySQL.selectFinalWantedFields Select
select,
      $sel:selectGroupBy:Select :: [FieldName]
selectGroupBy = [],
      $sel:selectProjections:Select :: [Projection]
selectProjections = InsOrdHashSet Projection -> [Projection]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList InsOrdHashSet Projection
selectProjections,
      Maybe Int
Maybe (NonEmpty OrderBy)
Maybe Text
Maybe Relationship
Where
From
Top
selectSqlTop :: Top
selectSqlOffset :: Maybe Int
selectOrderBy :: Maybe (NonEmpty OrderBy)
selectWhere :: Where
selectFrom :: From
selectAggUnwrap :: Maybe Text
selectRelationship :: Maybe Relationship
$sel:selectSqlTop:Select :: Top
$sel:selectSqlOffset:Select :: Maybe Int
$sel:selectWhere:Select :: Where
$sel:selectRelationship:Select :: Maybe Relationship
$sel:selectOrderBy:Select :: Maybe (NonEmpty OrderBy)
$sel:selectFrom:Select :: From
$sel:selectAggUnwrap:Select :: Maybe Text
..
    }