-- | The modules in the @Hasura.Backends.MSSQL.FromIr@ namespace translates the
-- RQL IR into TSQL, the SQL dialect of MSSQL, as defined in abstract syntax in
-- "Hasura.Backends.MSSQL.Types".
--
-- The translation happens in the @FromIr@ monad, which manages identifier
-- scoping and error collection.
--
-- The actual rendering of this AST into TSQL text happens in
-- "Hasura.Backends.MSSQL.ToQuery".
module Hasura.Backends.MSSQL.FromIr
  ( -- * The central Monad
    FromIr,
    runFromIrErrorOnCTEs,
    runFromIrUseCTEs,
    runFromIrUseCTEsT,
    Error (..),
    tellBefore,
    tellAfter,
    tellCTE,

    -- * Name generation
    NameTemplate (..),
    generateAlias,
  )
where

import Control.Monad.Validate
import Control.Monad.Validate qualified as V
import Control.Monad.Writer.Strict
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.Text qualified as T
import Data.Text.Extended qualified as T
import Hasura.Backends.MSSQL.Instances.Types ()
import Hasura.Backends.MSSQL.Types.Internal as TSQL
import Hasura.Base.Error (QErr, throw500)
import Hasura.NativeQuery.Metadata (InterpolatedQuery, NativeQueryName (getNativeQueryName))
import Hasura.Prelude
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.Types.BackendType

-- | Allow the query process to emit extra setup / teardown steps
data IRWriter = IRWriter
  { IRWriter -> [TempTableDDL]
irwBefore :: [TempTableDDL],
    IRWriter -> [TempTableDDL]
irwAfter :: [TempTableDDL],
    IRWriter -> Maybe With
irwCTEs :: Maybe With
  }

-- | Unique name counter
data IRState = IRState
  { IRState -> Int
irsCounter :: Int,
    IRState -> Map Text Int
irsMap :: Map Text Int
  }

instance Semigroup IRWriter where
  (IRWriter [TempTableDDL]
a [TempTableDDL]
b Maybe With
c) <> :: IRWriter -> IRWriter -> IRWriter
<> (IRWriter [TempTableDDL]
a' [TempTableDDL]
b' Maybe With
c') = [TempTableDDL] -> [TempTableDDL] -> Maybe With -> IRWriter
IRWriter ([TempTableDDL]
a [TempTableDDL] -> [TempTableDDL] -> [TempTableDDL]
forall a. Semigroup a => a -> a -> a
<> [TempTableDDL]
a') ([TempTableDDL]
b' [TempTableDDL] -> [TempTableDDL] -> [TempTableDDL]
forall a. Semigroup a => a -> a -> a
<> [TempTableDDL]
b) (Maybe With
c Maybe With -> Maybe With -> Maybe With
forall a. Semigroup a => a -> a -> a
<> Maybe With
c')

instance Monoid IRWriter where
  mempty :: IRWriter
mempty = [TempTableDDL] -> [TempTableDDL] -> Maybe With -> IRWriter
IRWriter [TempTableDDL]
forall a. Monoid a => a
mempty [TempTableDDL]
forall a. Monoid a => a
mempty Maybe With
forall a. Maybe a
Nothing

-- | add a step to be run before the main query
tellBefore :: TempTableDDL -> FromIr ()
tellBefore :: TempTableDDL -> FromIr ()
tellBefore TempTableDDL
step =
  IRWriter -> FromIr ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (IRWriter {irwBefore :: [TempTableDDL]
irwBefore = [TempTableDDL
step], irwAfter :: [TempTableDDL]
irwAfter = [TempTableDDL]
forall a. Monoid a => a
mempty, irwCTEs :: Maybe With
irwCTEs = Maybe With
forall a. Maybe a
Nothing})

-- | add a step to be run after the main query
tellAfter :: TempTableDDL -> FromIr ()
tellAfter :: TempTableDDL -> FromIr ()
tellAfter TempTableDDL
step =
  IRWriter -> FromIr ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (IRWriter {irwBefore :: [TempTableDDL]
irwBefore = [TempTableDDL]
forall a. Monoid a => a
mempty, irwAfter :: [TempTableDDL]
irwAfter = [TempTableDDL
step], irwCTEs :: Maybe With
irwCTEs = Maybe With
forall a. Maybe a
Nothing})

tellCTE :: NativeQueryName -> InterpolatedQuery Expression -> FromIr Text
tellCTE :: NativeQueryName -> InterpolatedQuery Expression -> FromIr Text
tellCTE NativeQueryName
name InterpolatedQuery Expression
cte = do
  Int
counter <- IRState -> Int
irsCounter (IRState -> Int) -> FromIr IRState -> FromIr Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromIr IRState
forall s (m :: * -> *). MonadState s m => m s
get
  (IRState -> IRState) -> FromIr ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' \IRState
s -> IRState
s {irsCounter :: Int
irsCounter = (Int
counter Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)}
  let alias :: Text
alias = Name -> Text
forall a. ToTxt a => a -> Text
T.toTxt (NativeQueryName -> Name
getNativeQueryName NativeQueryName
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
counter
  IRWriter -> FromIr ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    IRWriter
      { irwBefore :: [TempTableDDL]
irwBefore = [TempTableDDL]
forall a. Monoid a => a
mempty,
        irwAfter :: [TempTableDDL]
irwAfter = [TempTableDDL]
forall a. Monoid a => a
mempty,
        irwCTEs :: Maybe With
irwCTEs = With -> Maybe With
forall a. a -> Maybe a
Just (NonEmpty (Aliased CTEBody) -> With
With (NonEmpty (Aliased CTEBody) -> With)
-> NonEmpty (Aliased CTEBody) -> With
forall a b. (a -> b) -> a -> b
$ Aliased CTEBody -> NonEmpty (Aliased CTEBody)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased CTEBody -> NonEmpty (Aliased CTEBody))
-> Aliased CTEBody -> NonEmpty (Aliased CTEBody)
forall a b. (a -> b) -> a -> b
$ InterpolatedQuery Expression -> CTEBody
CTEUnsafeRawSQL (InterpolatedQuery Expression -> CTEBody)
-> Aliased (InterpolatedQuery Expression) -> Aliased CTEBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InterpolatedQuery Expression
-> Text -> Aliased (InterpolatedQuery Expression)
forall a. a -> Text -> Aliased a
Aliased InterpolatedQuery Expression
cte Text
alias)
      }
  Text -> FromIr Text
forall a. a -> FromIr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
alias

-- | The central Monad used throughout for all conversion functions.
--
-- It has the following features:
--
-- * It's a 'MonadValidate', so it'll continue going when it encounters 'Error's
--   to accumulate as many as possible.
--
-- * It has a facility for generating fresh, unique aliases, which lets the
--   translation output retain a resemblance with source names without the
--   translation process needing to be bothered about potential name shadowing.
--   See 'generateAlias'.
--
-- * It has a writer part for reporting native queries that need to be wrapped in a CTE
--
-- The Inner part 'FromIrInner' containing the state and validate are extracted to a different
-- type so we can peel the writer for queries and report errors in the process if needed.
newtype FromIr a = FromIr
  { forall a. FromIr a -> WriterT IRWriter FromIrInner a
unFromIr :: WriterT IRWriter FromIrInner a
  }
  deriving
    ( (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
$cfmap :: forall a b. (a -> b) -> FromIr a -> FromIr b
fmap :: forall a b. (a -> b) -> FromIr a -> FromIr b
$c<$ :: forall a b. a -> FromIr b -> FromIr a
<$ :: forall a b. a -> FromIr b -> FromIr a
Functor,
      Functor FromIr
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
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
$cpure :: forall a. a -> FromIr a
pure :: forall a. a -> FromIr a
$c<*> :: forall a b. FromIr (a -> b) -> FromIr a -> FromIr b
<*> :: forall a b. FromIr (a -> b) -> FromIr a -> FromIr b
$cliftA2 :: forall a b c. (a -> b -> c) -> FromIr a -> FromIr b -> FromIr c
liftA2 :: forall a b c. (a -> b -> c) -> FromIr a -> FromIr b -> FromIr c
$c*> :: forall a b. FromIr a -> FromIr b -> FromIr b
*> :: forall a b. FromIr a -> FromIr b -> FromIr b
$c<* :: forall a b. FromIr a -> FromIr b -> FromIr a
<* :: forall a b. FromIr a -> FromIr b -> FromIr a
Applicative,
      Applicative FromIr
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
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
$c>>= :: forall a b. FromIr a -> (a -> FromIr b) -> FromIr b
>>= :: forall a b. FromIr a -> (a -> FromIr b) -> FromIr b
$c>> :: forall a b. FromIr a -> FromIr b -> FromIr b
>> :: forall a b. FromIr a -> FromIr b -> FromIr b
$creturn :: forall a. a -> FromIr a
return :: forall a. a -> FromIr a
Monad,
      MonadValidate (NonEmpty Error),
      MonadWriter IRWriter,
      MonadState IRState
    )

-- | We extract the state and validate parts of FromIr so we can peel off
--   the writer part of 'FromIr' for queries and report errors in the process if needed.
type FromIrInner = StateT IRState (Validate (NonEmpty Error))

-- | Run a 'FromIr' action, throwing errors that have been collected using the
-- supplied action, and attach CTEs created from native queries to the select query.
runFromIrUseCTEs :: (MonadError QErr m) => FromIr Select -> m (QueryWithDDL Select)
runFromIrUseCTEs :: forall (m :: * -> *).
MonadError QErr m =>
FromIr Select -> m (QueryWithDDL Select)
runFromIrUseCTEs FromIr Select
fromir = Identity (QueryWithDDL Select) -> QueryWithDDL Select
forall a. Identity a -> a
runIdentity (Identity (QueryWithDDL Select) -> QueryWithDDL Select)
-> m (Identity (QueryWithDDL Select)) -> m (QueryWithDDL Select)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Select, IRWriter) -> FromIrInner (QueryWithDDL Select))
-> Identity (FromIr Select) -> m (Identity (QueryWithDDL Select))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, MonadError QErr m) =>
((a, IRWriter) -> FromIrInner (QueryWithDDL a))
-> t (FromIr a) -> m (t (QueryWithDDL a))
runFromIr (Select, IRWriter) -> FromIrInner (QueryWithDDL Select)
forall (m :: * -> *).
MonadValidate (NonEmpty Error) m =>
(Select, IRWriter) -> m (QueryWithDDL Select)
attachCTEs (FromIr Select -> Identity (FromIr Select)
forall a. a -> Identity a
Identity FromIr Select
fromir)

-- | Run a 'FromIr' action, throwing errors that have been collected using the
-- supplied action, and attach CTEs created from native queries to the select query.
runFromIrUseCTEsT :: (Traversable t, MonadError QErr m) => t (FromIr Select) -> m (t (QueryWithDDL Select))
runFromIrUseCTEsT :: forall (t :: * -> *) (m :: * -> *).
(Traversable t, MonadError QErr m) =>
t (FromIr Select) -> m (t (QueryWithDDL Select))
runFromIrUseCTEsT = ((Select, IRWriter) -> FromIrInner (QueryWithDDL Select))
-> t (FromIr Select) -> m (t (QueryWithDDL Select))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, MonadError QErr m) =>
((a, IRWriter) -> FromIrInner (QueryWithDDL a))
-> t (FromIr a) -> m (t (QueryWithDDL a))
runFromIr (Select, IRWriter) -> FromIrInner (QueryWithDDL Select)
forall (m :: * -> *).
MonadValidate (NonEmpty Error) m =>
(Select, IRWriter) -> m (QueryWithDDL Select)
attachCTEs

-- | Run a 'FromIr' action, throwing errors that have been collected using the
-- supplied action, and discard CTEs created from native queries to the select query.
--
-- If CTEs were reported, we throw an error, since we don't support native queries
-- in this context yet.
runFromIrErrorOnCTEs :: (MonadError QErr m) => FromIr a -> m (QueryWithDDL a)
runFromIrErrorOnCTEs :: forall (m :: * -> *) a.
MonadError QErr m =>
FromIr a -> m (QueryWithDDL a)
runFromIrErrorOnCTEs FromIr a
fromir = Identity (QueryWithDDL a) -> QueryWithDDL a
forall a. Identity a -> a
runIdentity (Identity (QueryWithDDL a) -> QueryWithDDL a)
-> m (Identity (QueryWithDDL a)) -> m (QueryWithDDL a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, IRWriter) -> FromIrInner (QueryWithDDL a))
-> Identity (FromIr a) -> m (Identity (QueryWithDDL a))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, MonadError QErr m) =>
((a, IRWriter) -> FromIrInner (QueryWithDDL a))
-> t (FromIr a) -> m (t (QueryWithDDL a))
runFromIr (a, IRWriter) -> FromIrInner (QueryWithDDL a)
forall (m :: * -> *) a.
MonadValidate (NonEmpty Error) m =>
(a, IRWriter) -> m (QueryWithDDL a)
errorOnCTEs (FromIr a -> Identity (FromIr a)
forall a. a -> Identity a
Identity FromIr a
fromir)

-- | Run a 'FromIr' action, throwing errors that have been collected using the supplied action.
runFromIr :: (Traversable t, MonadError QErr m) => ((a, IRWriter) -> FromIrInner (QueryWithDDL a)) -> t (FromIr a) -> m (t (QueryWithDDL a))
runFromIr :: forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, MonadError QErr m) =>
((a, IRWriter) -> FromIrInner (QueryWithDDL a))
-> t (FromIr a) -> m (t (QueryWithDDL a))
runFromIr (a, IRWriter) -> FromIrInner (QueryWithDDL a)
toResult =
  (Either (NonEmpty Error) (t (QueryWithDDL a))
 -> (NonEmpty Error -> m (t (QueryWithDDL a)))
 -> m (t (QueryWithDDL a)))
-> (NonEmpty Error -> m (t (QueryWithDDL a)))
-> Either (NonEmpty Error) (t (QueryWithDDL a))
-> m (t (QueryWithDDL a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either (NonEmpty Error) (t (QueryWithDDL a))
-> (NonEmpty Error -> m (t (QueryWithDDL a)))
-> m (t (QueryWithDDL a))
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft (Text -> m (t (QueryWithDDL a))
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m (t (QueryWithDDL a)))
-> (NonEmpty Error -> Text)
-> NonEmpty Error
-> m (t (QueryWithDDL a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Error -> Text
forall a. Show a => a -> Text
tshow)
    (Either (NonEmpty Error) (t (QueryWithDDL a))
 -> m (t (QueryWithDDL a)))
-> (t (FromIr a) -> Either (NonEmpty Error) (t (QueryWithDDL a)))
-> t (FromIr a)
-> m (t (QueryWithDDL a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validate (NonEmpty Error) (t (QueryWithDDL a))
-> Either (NonEmpty Error) (t (QueryWithDDL a))
forall e a. Validate e a -> Either e a
V.runValidate
    (Validate (NonEmpty Error) (t (QueryWithDDL a))
 -> Either (NonEmpty Error) (t (QueryWithDDL a)))
-> (t (FromIr a) -> Validate (NonEmpty Error) (t (QueryWithDDL a)))
-> t (FromIr a)
-> Either (NonEmpty Error) (t (QueryWithDDL a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
   IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a))
 -> IRState -> Validate (NonEmpty Error) (t (QueryWithDDL a)))
-> IRState
-> StateT
     IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a))
-> Validate (NonEmpty Error) (t (QueryWithDDL a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a))
-> IRState -> Validate (NonEmpty Error) (t (QueryWithDDL a))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Int -> Map Text Int -> IRState
IRState Int
0 Map Text Int
forall a. Monoid a => a
mempty)
    (StateT
   IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a))
 -> Validate (NonEmpty Error) (t (QueryWithDDL a)))
-> (t (FromIr a)
    -> StateT
         IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a)))
-> t (FromIr a)
-> Validate (NonEmpty Error) (t (QueryWithDDL a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((a, IRWriter) -> FromIrInner (QueryWithDDL a))
-> t (a, IRWriter)
-> StateT
     IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse (a, IRWriter) -> FromIrInner (QueryWithDDL a)
toResult (t (a, IRWriter)
 -> StateT
      IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a)))
-> StateT
     IRState (ValidateT (NonEmpty Error) Identity) (t (a, IRWriter))
-> StateT
     IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
    (StateT
   IRState (ValidateT (NonEmpty Error) Identity) (t (a, IRWriter))
 -> StateT
      IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a)))
-> (t (FromIr a)
    -> StateT
         IRState (ValidateT (NonEmpty Error) Identity) (t (a, IRWriter)))
-> t (FromIr a)
-> StateT
     IRState (ValidateT (NonEmpty Error) Identity) (t (QueryWithDDL a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FromIr a
 -> StateT
      IRState (ValidateT (NonEmpty Error) Identity) (a, IRWriter))
-> t (FromIr a)
-> StateT
     IRState (ValidateT (NonEmpty Error) Identity) (t (a, IRWriter))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse (WriterT IRWriter FromIrInner a
-> StateT
     IRState (ValidateT (NonEmpty Error) Identity) (a, IRWriter)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT IRWriter FromIrInner a
 -> StateT
      IRState (ValidateT (NonEmpty Error) Identity) (a, IRWriter))
-> (FromIr a -> WriterT IRWriter FromIrInner a)
-> FromIr a
-> StateT
     IRState (ValidateT (NonEmpty Error) Identity) (a, IRWriter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromIr a -> WriterT IRWriter FromIrInner a
forall a. FromIr a -> WriterT IRWriter FromIrInner a
unFromIr)

-- | attach CTEs created from native queries to the select query.
attachCTEs :: (MonadValidate (NonEmpty Error) m) => (Select, IRWriter) -> m (QueryWithDDL Select)
attachCTEs :: forall (m :: * -> *).
MonadValidate (NonEmpty Error) m =>
(Select, IRWriter) -> m (QueryWithDDL Select)
attachCTEs (Select
select, IRWriter [TempTableDDL]
before [TempTableDDL]
after Maybe With
ctes) =
  QueryWithDDL Select -> m (QueryWithDDL Select)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (QueryWithDDL Select -> m (QueryWithDDL Select))
-> QueryWithDDL Select -> m (QueryWithDDL Select)
forall a b. (a -> b) -> a -> b
$ QueryWithDDL
      { $sel:qwdBeforeSteps:QueryWithDDL :: [TempTableDDL]
qwdBeforeSteps = [TempTableDDL]
before,
        $sel:qwdQuery:QueryWithDDL :: Select
qwdQuery = Select
select {$sel:selectWith:Select :: Maybe With
selectWith = Maybe With
ctes Maybe With -> Maybe With -> Maybe With
forall a. Semigroup a => a -> a -> a
<> Select -> Maybe With
selectWith Select
select},
        $sel:qwdAfterSteps:QueryWithDDL :: [TempTableDDL]
qwdAfterSteps = [TempTableDDL]
after
      }

-- | If CTEs were reported, we throw an error, since we don't support native queries
--   in this context yet.
errorOnCTEs :: (MonadValidate (NonEmpty Error) m) => (a, IRWriter) -> m (QueryWithDDL a)
errorOnCTEs :: forall (m :: * -> *) a.
MonadValidate (NonEmpty Error) m =>
(a, IRWriter) -> m (QueryWithDDL a)
errorOnCTEs (a
result, IRWriter {[TempTableDDL]
irwBefore :: IRWriter -> [TempTableDDL]
irwBefore :: [TempTableDDL]
irwBefore, [TempTableDDL]
irwAfter :: IRWriter -> [TempTableDDL]
irwAfter :: [TempTableDDL]
irwAfter, Maybe With
irwCTEs :: IRWriter -> Maybe With
irwCTEs :: Maybe With
irwCTEs}) =
  case Maybe With
irwCTEs of
    Maybe With
Nothing ->
      QueryWithDDL a -> m (QueryWithDDL a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (QueryWithDDL a -> m (QueryWithDDL a))
-> QueryWithDDL a -> m (QueryWithDDL a)
forall a b. (a -> b) -> a -> b
$ QueryWithDDL
          { $sel:qwdBeforeSteps:QueryWithDDL :: [TempTableDDL]
qwdBeforeSteps = [TempTableDDL]
irwBefore,
            $sel:qwdQuery:QueryWithDDL :: a
qwdQuery = a
result,
            $sel:qwdAfterSteps:QueryWithDDL :: [TempTableDDL]
qwdAfterSteps = [TempTableDDL]
irwAfter
          }
    Just With
_ -> NonEmpty Error -> m (QueryWithDDL a)
forall a. NonEmpty Error -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute (NonEmpty Error -> m (QueryWithDDL a))
-> NonEmpty Error -> m (QueryWithDDL a)
forall a b. (a -> b) -> a -> b
$ Error -> NonEmpty Error
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
NativeQueriesNotSupported

-- | Errors that may happen during translation.
data Error
  = UnsupportedOpExpG (IR.OpExpG 'MSSQL Expression)
  | FunctionNotSupported
  | NativeQueriesNotSupported
  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
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq)

-- | Hints about the type of entity that 'generateAlias' is producing an alias
-- for.
data NameTemplate
  = ArrayRelationTemplate Text
  | ArrayAggregateTemplate Text
  | ObjectRelationTemplate Text
  | TableTemplate Text
  | ForOrderAlias Text

-- | Generate a fresh alias for a given entity to remove ambiguity and naming
-- conflicts between scopes at the TSQL level.
--
-- Names are generated in the form @type_name_occurrence@, where:
--
--  * @type@ hints at the type of entity,
--  * @name@ refers to the source name being aliased, and
--  * @occurrence@ is an integer counter that distinguishes each occurrence of @type_name@.
--
-- Example outputs:
--
-- > do
-- >   "ar_articles_1" <- generateAlias (ArrayRelationTemplate "articles")
-- >   "ar_articles_2" <- generateAlias (ArrayRelationTemplate "articles")
-- >   "t_users_1"     <- generateAlias (TableTemplate "users")
generateAlias :: NameTemplate -> FromIr Text
generateAlias :: NameTemplate -> FromIr Text
generateAlias NameTemplate
template = do
  WriterT IRWriter FromIrInner () -> FromIr ()
forall a. WriterT IRWriter FromIrInner a -> FromIr a
FromIr ((IRState -> IRState) -> WriterT IRWriter FromIrInner ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\IRState
s -> IRState
s {irsMap :: Map Text Int
irsMap = (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
rendered Int
1 (IRState -> Map Text Int
irsMap IRState
s)}))
  Int
occurrence <- Int -> Text -> Map Text Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Int
1 Text
rendered (Map Text Int -> Int)
-> (IRState -> Map Text Int) -> IRState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IRState -> Map Text Int
irsMap (IRState -> Int) -> FromIr IRState -> FromIr Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT IRWriter FromIrInner IRState -> FromIr IRState
forall a. WriterT IRWriter FromIrInner a -> FromIr a
FromIr WriterT IRWriter FromIrInner IRState
forall s (m :: * -> *). MonadState s m => m s
get
  Text -> FromIr Text
forall a. a -> FromIr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
rendered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
occurrence)
  where
    rendered :: Text
rendered = Int -> Text -> Text
T.take Int
20
      (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ 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