-- | 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,
    runFromIr,
    Error (..),

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

import Control.Monad.Validate
import Control.Monad.Validate qualified as V
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.Text 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.Prelude
import Hasura.RQL.IR qualified as IR
import Hasura.SQL.Backend

-- | 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'.
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))

-- | Run a 'FromIr' action, throwing errors that have been collected using the
-- supplied action.
runFromIr :: MonadError QErr m => FromIr a -> m a
runFromIr :: FromIr a -> m a
runFromIr = (Either (NonEmpty Error) a -> (NonEmpty Error -> m a) -> m a)
-> (NonEmpty Error -> m a) -> Either (NonEmpty Error) a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either (NonEmpty Error) a -> (NonEmpty Error -> m a) -> m a
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft (Text -> m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m a) -> (NonEmpty Error -> Text) -> NonEmpty Error -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Error -> Text
forall a. Show a => a -> Text
tshow) (Either (NonEmpty Error) a -> m a)
-> (FromIr a -> Either (NonEmpty Error) a) -> FromIr a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validate (NonEmpty Error) a -> Either (NonEmpty Error) a
forall e a. Validate e a -> Either e a
V.runValidate (Validate (NonEmpty Error) a -> Either (NonEmpty Error) a)
-> (FromIr a -> Validate (NonEmpty Error) a)
-> FromIr a
-> Either (NonEmpty Error) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (Map Text Int) (Validate (NonEmpty Error)) a
 -> Map Text Int -> Validate (NonEmpty Error) a)
-> Map Text Int
-> StateT (Map Text Int) (Validate (NonEmpty Error)) a
-> Validate (NonEmpty Error) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 Map Text Int
forall a. Monoid a => a
mempty (StateT (Map Text Int) (Validate (NonEmpty Error)) a
 -> Validate (NonEmpty Error) a)
-> (FromIr a
    -> StateT (Map Text Int) (Validate (NonEmpty Error)) a)
-> FromIr a
-> Validate (NonEmpty Error) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromIr a -> StateT (Map Text Int) (Validate (NonEmpty Error)) a
forall a.
FromIr a -> StateT (Map Text Int) (Validate (NonEmpty Error)) a
unFromIr

-- | Errors that may happen during translation.
data Error
  = UnsupportedOpExpG (IR.OpExpG 'MSSQL Expression)
  | FunctionNotSupported
  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)

-- | 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
  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
rendered Int
1))
  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) -> FromIr (Map Text Int) -> FromIr Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
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