{-# LANGUAGE DuplicateRecordFields #-}

-- | MSSQL Types Internal
--
-- Types for Transact-SQL aka T-SQL; the language of SQL Server.
--
-- In this module we define various MS SQL Server specific data types used for T-SQL generation.
--
-- These types are also used as underlying types in the @Backend 'MSSQL@ instance
-- which is defined in "Hasura.Backends.MSSQL.Instances.Types".
--
-- We convert RQL IR ASTs to types defined here in the "Hasura.Backends.MSSQL.FromIr" module,
-- and we implement pretty-printing for these types in the "Hasura.Backends.MSSQL.ToQuery" module.
--
-- NOTE: Various type class instances (including simple once such as Eq and Show) are implemented
-- in the "Hasura.Backends.MSSQL.Types.Instances" module.
module Hasura.Backends.MSSQL.Types.Internal
  ( Aggregate (..),
    Aliased (..),
    BooleanOperators (..),
    Column,
    Declare (..),
    ColumnName (..),
    columnNameToFieldName,
    ColumnType,
    Comment (..),
    ConstraintName (..),
    Countable (..),
    DataLength (..),
    Delete (..),
    DeleteOutput,
    EntityAlias (..),
    fromAlias,
    Expression (..),
    FieldName (..),
    For (..),
    ForJson (..),
    From (..),
    FunctionApplicationExpression (..),
    FunctionName (..),
    MergeUsing (..),
    MergeOn (..),
    MergeWhenMatched (..),
    MergeWhenNotMatched (..),
    Merge (..),
    Insert (..),
    InsertOutput,
    Join (..),
    JoinAlias (..),
    JoinSource (..),
    JsonCardinality (..),
    JsonFieldSpec (..),
    JsonPath (..),
    MethodApplicationExpression (..),
    NullsOrder (..),
    Op (..),
    OpenJson (..),
    Order (..),
    OrderBy (..),
    OutputColumn (..),
    Inserted (..),
    Deleted (..),
    Output (..),
    Projection (..),
    QueryWithDDL (..),
    Reselect (..),
    Root (..),
    ScalarType (..),
    SchemaName (..),
    Select (..),
    SetIdentityInsert (..),
    TempTableDDL (..),
    TempTableName (..),
    SomeTableName (..),
    TempTable (..),
    SetValue (..),
    SelectIntoTempTable (..),
    SITTConstraints (..),
    InsertValuesIntoTempTable (..),
    SpatialOp (..),
    TableName (..),
    Top (..),
    UnifiedArrayRelationship (..),
    UnifiedColumn (..),
    UnifiedObjectRelationship (..),
    UnifiedOn (..),
    UnifiedTableName (..),
    UnifiedUsing (..),
    Value,
    Values (..),
    Where (..),
    With (..),
    CTEBody (..),
    emptySelect,
    geoTypes,
    getGQLTableName,
    getGQLFunctionName,
    getTableIdentifier,
    isComparableType,
    isNumType,
    mkMSSQLScalarTypeName,
    parseScalarValue,
    parseScalarType,
    scalarTypeDBName,
    snakeCaseName,
    stringTypes,
    namingConventionSupport,
  )
where

import Data.Aeson qualified as J
import Data.Text qualified as T
import Data.Text.Casing (GQLNameIdentifier)
import Data.Text.Casing qualified as C
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Base.Error
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.NativeQuery.Metadata (InterpolatedQuery)
import Hasura.Prelude
import Hasura.RQL.Types.Backend (SupportedNamingCase (..))
import Hasura.RQL.Types.BackendType
import Hasura.SQL.GeoJSON qualified as Geo
import Hasura.SQL.WKT qualified as WKT
import Language.GraphQL.Draft.Syntax qualified as G
import Language.Haskell.TH.Syntax (Lift)

--------------------------------------------------------------------------------
-- Phantom pretend-generic types that are actually specific

type Column (b :: BackendType) = ColumnName

type ColumnType (b :: BackendType) = ScalarType

type Value = ODBC.Value

--------------------------------------------------------------------------------

data UnifiedColumn = UnifiedColumn
  { UnifiedColumn -> ColumnName
name :: ColumnName,
    UnifiedColumn -> ScalarType
type' :: ScalarType
  }

data UnifiedTableName = UnifiedTableName
  { UnifiedTableName -> Text
schema :: Text,
    UnifiedTableName -> Text
name :: Text
  }

data UnifiedObjectRelationship = UnifiedObjectRelationship
  { UnifiedObjectRelationship -> UnifiedUsing
using :: UnifiedUsing,
    UnifiedObjectRelationship -> Text
name :: Text
  }

data UnifiedArrayRelationship = UnifiedArrayRelationship
  { UnifiedArrayRelationship -> UnifiedUsing
using :: UnifiedUsing,
    UnifiedArrayRelationship -> Text
name :: Text
  }

newtype UnifiedUsing = UnifiedUsing
  { UnifiedUsing -> UnifiedOn
foreign_key_constraint_on :: UnifiedOn
  }

data UnifiedOn = UnifiedOn
  { UnifiedOn -> UnifiedTableName
table :: UnifiedTableName,
    UnifiedOn -> Text
column :: Text
  }

-------------------------------------------------------------------------------
-- AST types

data BooleanOperators a
  = ASTContains a
  | ASTCrosses a
  | ASTEquals a
  | ASTIntersects a
  | ASTOverlaps a
  | ASTTouches a
  | ASTWithin a

data Select = Select
  { Select -> Maybe With
selectWith :: (Maybe With),
    Select -> Top
selectTop :: Top,
    Select -> [Projection]
selectProjections :: [Projection],
    Select -> Maybe From
selectFrom :: (Maybe From),
    Select -> [Join]
selectJoins :: [Join],
    Select -> Where
selectWhere :: Where,
    Select -> For
selectFor :: For,
    Select -> Maybe (NonEmpty OrderBy)
selectOrderBy :: (Maybe (NonEmpty OrderBy)),
    Select -> Maybe Expression
selectOffset :: (Maybe Expression)
  }

emptySelect :: Select
emptySelect :: Select
emptySelect =
  Select
    { $sel:selectWith:Select :: Maybe With
selectWith = Maybe With
forall a. Maybe a
Nothing,
      $sel:selectFrom:Select :: Maybe From
selectFrom = Maybe From
forall a. Maybe a
Nothing,
      $sel:selectTop:Select :: Top
selectTop = Top
NoTop,
      $sel:selectProjections:Select :: [Projection]
selectProjections = [],
      $sel:selectJoins:Select :: [Join]
selectJoins = [],
      $sel:selectWhere:Select :: Where
selectWhere = [Expression] -> Where
Where [],
      $sel:selectOrderBy:Select :: Maybe (NonEmpty OrderBy)
selectOrderBy = Maybe (NonEmpty OrderBy)
forall a. Maybe a
Nothing,
      $sel:selectFor:Select :: For
selectFor = For
NoFor,
      $sel:selectOffset:Select :: Maybe Expression
selectOffset = Maybe Expression
forall a. Maybe a
Nothing
    }

newtype OutputColumn = OutputColumn {OutputColumn -> ColumnName
unOutputColumn :: ColumnName}

data Inserted = Inserted

data Deleted = Deleted

data Output t = Output
  { forall t. Output t -> t
outputType :: t,
    forall t. Output t -> [OutputColumn]
outputColumns :: [OutputColumn]
  }

type InsertOutput = Output Inserted

newtype Values = Values [Expression]

data Insert = Insert
  { Insert -> TableName
insertTable :: TableName,
    Insert -> [ColumnName]
insertColumns :: [ColumnName],
    Insert -> InsertOutput
insertOutput :: InsertOutput,
    Insert -> TempTable
insertTempTable :: TempTable,
    Insert -> [Values]
insertValues :: [Values]
  }

data SetValue
  = SetON
  | SetOFF

data SetIdentityInsert = SetIdentityInsert
  { SetIdentityInsert -> SomeTableName
setTable :: SomeTableName,
    SetIdentityInsert -> SetValue
setValue :: SetValue
  }

type DeleteOutput = Output Deleted

data Delete = Delete
  { Delete -> Aliased TableName
deleteTable :: (Aliased TableName),
    Delete -> DeleteOutput
deleteOutput :: DeleteOutput,
    Delete -> TempTable
deleteTempTable :: TempTable,
    Delete -> Where
deleteWhere :: Where
  }

-- | MERGE statement.
-- Used for upserts and is responsible for actually inserting or updating the data in the table.
data Merge = Merge
  { Merge -> TableName
mergeTargetTable :: TableName,
    Merge -> MergeUsing
mergeUsing :: MergeUsing,
    Merge -> MergeOn
mergeOn :: MergeOn,
    Merge -> MergeWhenMatched
mergeWhenMatched :: MergeWhenMatched,
    Merge -> MergeWhenNotMatched
mergeWhenNotMatched :: MergeWhenNotMatched,
    Merge -> InsertOutput
mergeInsertOutput :: InsertOutput,
    Merge -> TempTable
mergeOutputTempTable :: TempTable
  }

-- | The @USING@ section of a @MERGE@ statement.
--   Specifies the temp table schema where the input values are.
data MergeUsing = MergeUsing
  { MergeUsing -> TempTableName
mergeUsingTempTable :: TempTableName,
    MergeUsing -> [ColumnName]
mergeUsingColumns :: [ColumnName]
  }

-- | The @ON@ section of a @MERGE@ statement.
--   Which columns to match on?
data MergeOn = MergeOn
  { MergeOn -> [ColumnName]
mergeOnColumns :: [ColumnName]
  }

-- | The @WHEN MATCHED@ section of a @MERGE@ statement.
--   Which columns to update when @match_columns@ match (including presets),
--   and on which condition to actually update the values.
data MergeWhenMatched = MergeWhenMatched
  { MergeWhenMatched -> [ColumnName]
mwmUpdateColumns :: [ColumnName],
    MergeWhenMatched -> Expression
mwmCondition :: Expression,
    MergeWhenMatched -> HashMap ColumnName Expression
mwmUpdatePreset :: HashMap ColumnName Expression
  }

-- | The @WHEN MATCHED@ section of a @MERGE@ statement.
--   Which columns to insert?
newtype MergeWhenNotMatched = MergeWhenNotMatched
  { MergeWhenNotMatched -> [ColumnName]
mergeWhenNotMatchedInsertColumns :: [ColumnName]
  }

-- | SELECT INTO temporary table statement without values.
--   Used to create a temporary table with the same schema as an existing table.
data SelectIntoTempTable = SelectIntoTempTable
  { SelectIntoTempTable -> TempTableName
sittTempTableName :: TempTableName,
    SelectIntoTempTable -> [UnifiedColumn]
sittColumns :: [UnifiedColumn],
    SelectIntoTempTable -> TableName
sittFromTableName :: TableName,
    SelectIntoTempTable -> SITTConstraints
sittConstraints :: SITTConstraints
  }

-- | When creating a temporary table from an existing table schema,
--   what should we do with the constraints (such as @IDENTITY@?)
data SITTConstraints
  = KeepConstraints
  | RemoveConstraints

-- | Simple insert into a temporary table.
data InsertValuesIntoTempTable = InsertValuesIntoTempTable
  { InsertValuesIntoTempTable -> TempTableName
ivittTempTableName :: TempTableName,
    InsertValuesIntoTempTable -> [ColumnName]
ivittColumns :: [ColumnName],
    InsertValuesIntoTempTable -> [Values]
ivittValues :: [Values]
  }

-- | A temporary table name is prepended by a hash-sign
newtype TempTableName = TempTableName Text

-- | A name of a regular table or temporary table
data SomeTableName
  = RegularTableName TableName
  | TemporaryTableName TempTableName

data TempTable = TempTable
  { TempTable -> TempTableName
ttName :: TempTableName,
    TempTable -> [ColumnName]
ttColumns :: [ColumnName]
  }

-- | A version of `Select` without a `FROM` clause. This means it can only project expressions already selected in adjacent join clauses, hence the name @reselect@.
data Reselect = Reselect
  { Reselect -> [Projection]
reselectProjections :: [Projection],
    Reselect -> For
reselectFor :: For,
    Reselect -> Where
reselectWhere :: Where
  }

data OrderBy = OrderBy
  { OrderBy -> FieldName
orderByFieldName :: FieldName,
    OrderBy -> Order
orderByOrder :: Order,
    OrderBy -> NullsOrder
orderByNullsOrder :: NullsOrder,
    OrderBy -> Maybe ScalarType
orderByType :: Maybe ScalarType
  }

data Order
  = AscOrder
  | DescOrder

data NullsOrder
  = NullsFirst
  | NullsLast
  | NullsAnyOrder

data For
  = JsonFor ForJson
  | NoFor

data ForJson = ForJson
  { ForJson -> JsonCardinality
jsonCardinality :: JsonCardinality,
    ForJson -> Root
jsonRoot :: Root
  }

data Root
  = NoRoot
  | Root Text

data JsonCardinality
  = JsonArray
  | JsonSingleton

data Projection
  = ExpressionProjection (Aliased Expression)
  | FieldNameProjection (Aliased FieldName)
  | AggregateProjection (Aliased Aggregate)
  | StarProjection

data Join = Join
  { Join -> JoinSource
joinSource :: JoinSource,
    Join -> JoinAlias
joinJoinAlias :: JoinAlias,
    Join -> Where
joinWhere :: Where
  }

data JoinSource
  = JoinSelect Select
  | JoinReselect Reselect

data JoinAlias = JoinAlias
  { JoinAlias -> Text
joinAliasEntity :: Text,
    JoinAlias -> Maybe Text
joinAliasField :: Maybe Text
  }

newtype Where
  = Where [Expression]

newtype With
  = With (NonEmpty (Aliased CTEBody))
  deriving (NonEmpty With -> With
With -> With -> With
(With -> With -> With)
-> (NonEmpty With -> With)
-> (forall b. Integral b => b -> With -> With)
-> Semigroup With
forall b. Integral b => b -> With -> With
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: With -> With -> With
<> :: With -> With -> With
$csconcat :: NonEmpty With -> With
sconcat :: NonEmpty With -> With
$cstimes :: forall b. Integral b => b -> With -> With
stimes :: forall b. Integral b => b -> With -> With
Semigroup)

-- | Something that can appear in a CTE body.
data CTEBody
  = CTESelect Select
  | CTEUnsafeRawSQL (InterpolatedQuery Expression)

-- | Extra query steps that can be emitted from the main
-- query to do things like setup temp tables
data TempTableDDL
  = -- | create a temp table
    CreateTemp
      { TempTableDDL -> TempTableName
stcTempTableName :: TempTableName,
        TempTableDDL -> [UnifiedColumn]
stcColumns :: [UnifiedColumn]
      }
  | -- | insert output of a statement into a temp table
    InsertTemp
      { TempTableDDL -> [Declare]
stiDeclares :: [Declare],
        TempTableDDL -> TempTableName
stiTempTableName :: TempTableName,
        TempTableDDL -> InterpolatedQuery Expression
stiExpression :: InterpolatedQuery Expression
      }
  | -- | Drop a temp table
    DropTemp
      {TempTableDDL -> TempTableName
stdTempTableName :: TempTableName}

data Declare = Declare
  { Declare -> Text
dName :: Text,
    Declare -> ScalarType
dType :: ScalarType,
    Declare -> Expression
dValue :: Expression
  }

data Top
  = NoTop
  | Top Int

data Expression
  = ValueExpression ODBC.Value
  | AndExpression [Expression]
  | OrExpression [Expression]
  | NotExpression Expression
  | ExistsExpression Select
  | SelectExpression Select
  | IsNullExpression Expression
  | IsNotNullExpression Expression
  | ColumnExpression FieldName
  | -- | This one acts like a "cast to JSON" and makes SQL Server
    -- behave like it knows your field is JSON and not double-encode
    -- it.
    JsonQueryExpression Expression
  | ToStringExpression Expression
  | MethodApplicationExpression Expression MethodApplicationExpression
  | FunctionApplicationExpression FunctionApplicationExpression
  | -- | This is for getting actual atomic values out of a JSON
    -- string.
    JsonValueExpression Expression JsonPath
  | OpExpression Op Expression Expression
  | ListExpression [Expression]
  | STOpExpression SpatialOp Expression Expression
  | CastExpression Expression ScalarType DataLength
  | -- | "CASE WHEN (expression) THEN (expression) ELSE (expression) END"
    ConditionalExpression Expression Expression Expression
  | -- | The 'DEFAULT' value. TODO: Make this as a part of @'ODBC.Value'.
    DefaultExpression

-- | Data type describing the length of a datatype. Used in 'CastExpression's.
data DataLength = DataLengthUnspecified | DataLengthInt Int | DataLengthMax

-- | SQL functions application: @some_function(e1, e2, ..)@.
data FunctionApplicationExpression
  = FunExpISNULL Expression Expression -- ISNULL

-- | Object expression method application: @(expression).text(e1, e2, ..)@
data MethodApplicationExpression
  = MethExpSTAsText -- STAsText

data JsonPath
  = RootPath
  | FieldPath JsonPath Text
  | IndexPath JsonPath Integer

data Aggregate
  = CountAggregate (Countable FieldName)
  | OpAggregate Text [Expression]
  | TextAggregate Text

data Countable name
  = StarCountable
  | NonNullFieldCountable name
  | DistinctCountable name

deriving instance Functor Countable

data From
  = FromQualifiedTable (Aliased TableName)
  | FromOpenJson (Aliased OpenJson)
  | FromSelect (Aliased Select)
  | FromIdentifier Text
  | FromTempTable (Aliased TempTableName)

-- | Extract the name bound in a 'From' clause as an 'EntityAlias'.
fromAlias :: From -> EntityAlias
fromAlias :: From -> EntityAlias
fromAlias (FromQualifiedTable Aliased {Text
aliasedAlias :: Text
$sel:aliasedAlias:Aliased :: forall a. Aliased a -> Text
aliasedAlias}) = Text -> EntityAlias
EntityAlias Text
aliasedAlias
fromAlias (FromOpenJson Aliased {Text
$sel:aliasedAlias:Aliased :: forall a. Aliased a -> Text
aliasedAlias :: Text
aliasedAlias}) = Text -> EntityAlias
EntityAlias Text
aliasedAlias
fromAlias (FromSelect Aliased {Text
$sel:aliasedAlias:Aliased :: forall a. Aliased a -> Text
aliasedAlias :: Text
aliasedAlias}) = Text -> EntityAlias
EntityAlias Text
aliasedAlias
fromAlias (FromIdentifier Text
identifier) = Text -> EntityAlias
EntityAlias Text
identifier
fromAlias (FromTempTable Aliased {Text
$sel:aliasedAlias:Aliased :: forall a. Aliased a -> Text
aliasedAlias :: Text
aliasedAlias}) = Text -> EntityAlias
EntityAlias Text
aliasedAlias

data OpenJson = OpenJson
  { OpenJson -> Expression
openJsonExpression :: Expression,
    OpenJson -> Maybe (NonEmpty JsonFieldSpec)
openJsonWith :: Maybe (NonEmpty JsonFieldSpec)
  }

data JsonFieldSpec
  = ScalarField ScalarType DataLength Text (Maybe JsonPath)
  | JsonField Text (Maybe JsonPath)
  | StringField Text (Maybe JsonPath)

data Aliased a = Aliased
  { forall a. Aliased a -> a
aliasedThing :: a,
    forall a. Aliased a -> Text
aliasedAlias :: Text
  }

newtype SchemaName = SchemaName {SchemaName -> Text
_unSchemaName :: Text}
  deriving (Int -> SchemaName -> ShowS
[SchemaName] -> ShowS
SchemaName -> String
(Int -> SchemaName -> ShowS)
-> (SchemaName -> String)
-> ([SchemaName] -> ShowS)
-> Show SchemaName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaName -> ShowS
showsPrec :: Int -> SchemaName -> ShowS
$cshow :: SchemaName -> String
show :: SchemaName -> String
$cshowList :: [SchemaName] -> ShowS
showList :: [SchemaName] -> ShowS
Show, SchemaName -> SchemaName -> Bool
(SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool) -> Eq SchemaName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaName -> SchemaName -> Bool
== :: SchemaName -> SchemaName -> Bool
$c/= :: SchemaName -> SchemaName -> Bool
/= :: SchemaName -> SchemaName -> Bool
Eq, Eq SchemaName
Eq SchemaName
-> (SchemaName -> SchemaName -> Ordering)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> SchemaName)
-> (SchemaName -> SchemaName -> SchemaName)
-> Ord SchemaName
SchemaName -> SchemaName -> Bool
SchemaName -> SchemaName -> Ordering
SchemaName -> SchemaName -> SchemaName
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
$ccompare :: SchemaName -> SchemaName -> Ordering
compare :: SchemaName -> SchemaName -> Ordering
$c< :: SchemaName -> SchemaName -> Bool
< :: SchemaName -> SchemaName -> Bool
$c<= :: SchemaName -> SchemaName -> Bool
<= :: SchemaName -> SchemaName -> Bool
$c> :: SchemaName -> SchemaName -> Bool
> :: SchemaName -> SchemaName -> Bool
$c>= :: SchemaName -> SchemaName -> Bool
>= :: SchemaName -> SchemaName -> Bool
$cmax :: SchemaName -> SchemaName -> SchemaName
max :: SchemaName -> SchemaName -> SchemaName
$cmin :: SchemaName -> SchemaName -> SchemaName
min :: SchemaName -> SchemaName -> SchemaName
Ord, Typeable SchemaName
Typeable SchemaName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SchemaName -> c SchemaName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SchemaName)
-> (SchemaName -> Constr)
-> (SchemaName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SchemaName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SchemaName))
-> ((forall b. Data b => b -> b) -> SchemaName -> SchemaName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SchemaName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SchemaName -> r)
-> (forall u. (forall d. Data d => d -> u) -> SchemaName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SchemaName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SchemaName -> m SchemaName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SchemaName -> m SchemaName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SchemaName -> m SchemaName)
-> Data SchemaName
SchemaName -> Constr
SchemaName -> DataType
(forall b. Data b => b -> b) -> SchemaName -> SchemaName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SchemaName -> u
forall u. (forall d. Data d => d -> u) -> SchemaName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemaName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemaName -> c SchemaName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemaName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SchemaName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemaName -> c SchemaName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemaName -> c SchemaName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemaName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemaName
$ctoConstr :: SchemaName -> Constr
toConstr :: SchemaName -> Constr
$cdataTypeOf :: SchemaName -> DataType
dataTypeOf :: SchemaName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemaName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemaName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SchemaName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SchemaName)
$cgmapT :: (forall b. Data b => b -> b) -> SchemaName -> SchemaName
gmapT :: (forall b. Data b => b -> b) -> SchemaName -> SchemaName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemaName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SchemaName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SchemaName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SchemaName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SchemaName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemaName -> m SchemaName
Data, [SchemaName] -> Value
[SchemaName] -> Encoding
SchemaName -> Value
SchemaName -> Encoding
(SchemaName -> Value)
-> (SchemaName -> Encoding)
-> ([SchemaName] -> Value)
-> ([SchemaName] -> Encoding)
-> ToJSON SchemaName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SchemaName -> Value
toJSON :: SchemaName -> Value
$ctoEncoding :: SchemaName -> Encoding
toEncoding :: SchemaName -> Encoding
$ctoJSONList :: [SchemaName] -> Value
toJSONList :: [SchemaName] -> Value
$ctoEncodingList :: [SchemaName] -> Encoding
toEncodingList :: [SchemaName] -> Encoding
J.ToJSON, Value -> Parser [SchemaName]
Value -> Parser SchemaName
(Value -> Parser SchemaName)
-> (Value -> Parser [SchemaName]) -> FromJSON SchemaName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SchemaName
parseJSON :: Value -> Parser SchemaName
$cparseJSONList :: Value -> Parser [SchemaName]
parseJSONList :: Value -> Parser [SchemaName]
J.FromJSON, SchemaName -> ()
(SchemaName -> ()) -> NFData SchemaName
forall a. (a -> ()) -> NFData a
$crnf :: SchemaName -> ()
rnf :: SchemaName -> ()
NFData, (forall x. SchemaName -> Rep SchemaName x)
-> (forall x. Rep SchemaName x -> SchemaName) -> Generic SchemaName
forall x. Rep SchemaName x -> SchemaName
forall x. SchemaName -> Rep SchemaName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaName -> Rep SchemaName x
from :: forall x. SchemaName -> Rep SchemaName x
$cto :: forall x. Rep SchemaName x -> SchemaName
to :: forall x. Rep SchemaName x -> SchemaName
Generic, String -> SchemaName
(String -> SchemaName) -> IsString SchemaName
forall a. (String -> a) -> IsString a
$cfromString :: String -> SchemaName
fromString :: String -> SchemaName
IsString, Eq SchemaName
Eq SchemaName
-> (Int -> SchemaName -> Int)
-> (SchemaName -> Int)
-> Hashable SchemaName
Int -> SchemaName -> Int
SchemaName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SchemaName -> Int
hashWithSalt :: Int -> SchemaName -> Int
$chash :: SchemaName -> Int
hash :: SchemaName -> Int
Hashable, (forall (m :: * -> *). Quote m => SchemaName -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    SchemaName -> Code m SchemaName)
-> Lift SchemaName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SchemaName -> m Exp
forall (m :: * -> *). Quote m => SchemaName -> Code m SchemaName
$clift :: forall (m :: * -> *). Quote m => SchemaName -> m Exp
lift :: forall (m :: * -> *). Quote m => SchemaName -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => SchemaName -> Code m SchemaName
liftTyped :: forall (m :: * -> *). Quote m => SchemaName -> Code m SchemaName
Lift)

data TableName = TableName
  { TableName -> Text
tableName :: Text,
    TableName -> SchemaName
tableSchema :: SchemaName
  }

data FieldName = FieldName
  { FieldName -> Text
fieldName :: Text,
    FieldName -> Text
fieldNameEntity :: Text
  }

data Comment = DueToPermission | RequestedSingleObject

newtype EntityAlias = EntityAlias
  { EntityAlias -> Text
entityAliasText :: Text
  }

columnNameToFieldName :: ColumnName -> EntityAlias -> FieldName
columnNameToFieldName :: ColumnName -> EntityAlias -> FieldName
columnNameToFieldName (ColumnName Text
fieldName) EntityAlias {$sel:entityAliasText:EntityAlias :: EntityAlias -> Text
entityAliasText = Text
fieldNameEntity} =
  FieldName {Text
$sel:fieldName:FieldName :: Text
fieldName :: Text
fieldName, Text
$sel:fieldNameEntity:FieldName :: Text
fieldNameEntity :: Text
fieldNameEntity}

data Op
  = LT
  | LTE
  | GT
  | GTE
  | IN
  | LIKE
  | NLIKE
  | NIN
  | EQ'
  | NEQ'

-- | Supported operations for spatial data types
data SpatialOp
  = STEquals
  | STContains
  | STCrosses
  | STIntersects
  | STOverlaps
  | STWithin
  | STTouches

-- | Column name of some database table -- this differs to FieldName
-- that is used for referring to things within a query.
newtype ColumnName = ColumnName {ColumnName -> Text
columnNameText :: Text}

newtype ConstraintName = ConstraintName {ConstraintName -> Text
constraintNameText :: Text}
  deriving newtype (FromJSONKeyFunction [ConstraintName]
FromJSONKeyFunction ConstraintName
FromJSONKeyFunction ConstraintName
-> FromJSONKeyFunction [ConstraintName]
-> FromJSONKey ConstraintName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction ConstraintName
fromJSONKey :: FromJSONKeyFunction ConstraintName
$cfromJSONKeyList :: FromJSONKeyFunction [ConstraintName]
fromJSONKeyList :: FromJSONKeyFunction [ConstraintName]
J.FromJSONKey, ToJSONKeyFunction [ConstraintName]
ToJSONKeyFunction ConstraintName
ToJSONKeyFunction ConstraintName
-> ToJSONKeyFunction [ConstraintName] -> ToJSONKey ConstraintName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction ConstraintName
toJSONKey :: ToJSONKeyFunction ConstraintName
$ctoJSONKeyList :: ToJSONKeyFunction [ConstraintName]
toJSONKeyList :: ToJSONKeyFunction [ConstraintName]
J.ToJSONKey)

data FunctionName = FunctionName
  { FunctionName -> Text
functionName :: Text,
    FunctionName -> SchemaName
functionSchema :: SchemaName
  }

-- | type for a query generated from IR along with any DDL actions
data QueryWithDDL a = QueryWithDDL
  { forall a. QueryWithDDL a -> [TempTableDDL]
qwdBeforeSteps :: [TempTableDDL],
    forall a. QueryWithDDL a -> a
qwdQuery :: a,
    forall a. QueryWithDDL a -> [TempTableDDL]
qwdAfterSteps :: [TempTableDDL]
  }

-- | Derived from the odbc package.
data ScalarType
  = CharType
  | NumericType
  | DecimalType
  | IntegerType
  | SmallintType
  | FloatType
  | RealType
  | DateType
  | Ss_time2Type
  | VarcharType
  | WcharType
  | WvarcharType
  | WtextType
  | TimestampType
  | TextType
  | BinaryType
  | VarbinaryType
  | BigintType
  | TinyintType
  | BitType
  | GuidType
  | GeographyType
  | GeometryType
  | UnknownType Text

scalarTypeDBName :: DataLength -> ScalarType -> Text
scalarTypeDBName :: DataLength -> ScalarType -> Text
scalarTypeDBName DataLength
dataLength = \case
  ScalarType
CharType -> Text
"char"
  ScalarType
NumericType -> Text
"numeric"
  ScalarType
DecimalType -> Text
"decimal"
  ScalarType
IntegerType -> Text
"int"
  ScalarType
SmallintType -> Text
"smallint"
  ScalarType
FloatType -> Text
"float"
  ScalarType
RealType -> Text
"real"
  ScalarType
DateType -> Text
"date"
  ScalarType
Ss_time2Type -> Text
"time"
  ScalarType
VarcharType -> Text
"varchar" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataLength -> Text
fromDataLength DataLength
dataLength
  ScalarType
WcharType -> Text
"nchar"
  ScalarType
WvarcharType -> Text
"nvarchar" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataLength -> Text
fromDataLength DataLength
dataLength
  ScalarType
WtextType -> Text
"ntext"
  ScalarType
TextType -> Text
"text"
  ScalarType
TimestampType -> Text
"timestamp"
  ScalarType
BinaryType -> Text
"binary"
  ScalarType
VarbinaryType -> Text
"varbinary" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataLength -> Text
fromDataLength DataLength
dataLength
  ScalarType
BigintType -> Text
"bigint"
  ScalarType
TinyintType -> Text
"tinyint"
  ScalarType
BitType -> Text
"bit"
  ScalarType
GuidType -> Text
"uniqueidentifier"
  ScalarType
GeographyType -> Text
"geography"
  ScalarType
GeometryType -> Text
"geometry"
  -- the input form for types that aren't explicitly supported is a string
  UnknownType Text
t -> Text
t

fromDataLength :: DataLength -> Text
fromDataLength :: DataLength -> Text
fromDataLength = \case
  DataLength
DataLengthUnspecified -> Text
""
  DataLengthInt Int
len -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
len Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  DataLength
DataLengthMax -> Text
"(max)"

mkMSSQLScalarTypeName :: (MonadError QErr m) => ScalarType -> m G.Name
mkMSSQLScalarTypeName :: forall (m :: * -> *). MonadError QErr m => ScalarType -> m Name
mkMSSQLScalarTypeName = \case
  ScalarType
CharType -> Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._String
  ScalarType
WcharType -> Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._String
  ScalarType
WvarcharType -> Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._String
  ScalarType
VarcharType -> Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._String
  ScalarType
WtextType -> Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._String
  ScalarType
TextType -> Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._String
  ScalarType
FloatType -> Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._Float
  -- integer types
  ScalarType
IntegerType -> Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._Int
  -- boolean type
  ScalarType
BitType -> Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
GName._Boolean
  ScalarType
scalarType ->
    Text -> Maybe Name
G.mkName (DataLength -> ScalarType -> Text
scalarTypeDBName DataLength
DataLengthUnspecified ScalarType
scalarType)
      Maybe Name -> m Name -> m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
        Code
ValidationFailed
        ( Text
"cannot use SQL type "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataLength -> ScalarType -> Text
scalarTypeDBName DataLength
DataLengthUnspecified ScalarType
scalarType
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in the GraphQL schema because its name is not a "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"valid GraphQL identifier"
        )

parseScalarType :: Text -> ScalarType
parseScalarType :: Text -> ScalarType
parseScalarType = \case
  Text
"char" -> ScalarType
CharType
  Text
"numeric" -> ScalarType
NumericType
  Text
"decimal" -> ScalarType
DecimalType
  Text
"money" -> ScalarType
DecimalType
  Text
"smallmoney" -> ScalarType
DecimalType
  Text
"int" -> ScalarType
IntegerType
  Text
"smallint" -> ScalarType
SmallintType
  Text
"float" -> ScalarType
FloatType
  Text
"real" -> ScalarType
RealType
  Text
"date" -> ScalarType
DateType
  Text
"time" -> ScalarType
Ss_time2Type
  Text
"varchar" -> ScalarType
VarcharType
  Text
"nchar" -> ScalarType
WcharType
  Text
"nvarchar" -> ScalarType
WvarcharType
  Text
"ntext" -> ScalarType
WtextType
  Text
"timestamp" -> ScalarType
TimestampType
  Text
"text" -> ScalarType
TextType
  Text
"binary" -> ScalarType
BinaryType
  Text
"bigint" -> ScalarType
BigintType
  Text
"tinyint" -> ScalarType
TinyintType
  Text
"varbinary" -> ScalarType
VarbinaryType
  Text
"bit" -> ScalarType
BitType
  Text
"uniqueidentifier" -> ScalarType
GuidType
  Text
"geography" -> ScalarType
GeographyType
  Text
"geometry" -> ScalarType
GeometryType
  Text
t ->
    -- if the type is something like `varchar(127)`, try stripping off the data length
    if Text -> Text -> Bool
T.isInfixOf Text
"(" Text
t
      then Text -> ScalarType
parseScalarType ((Char -> Bool) -> Text -> Text
T.takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'(') Text
t)
      else Text -> ScalarType
UnknownType Text
t

parseScalarValue :: ScalarType -> J.Value -> Either QErr Value
parseScalarValue :: ScalarType -> Value -> Either QErr Value
parseScalarValue ScalarType
scalarType Value
jValue = case ScalarType
scalarType of
  -- text
  ScalarType
CharType -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
VarcharType -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
TextType -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
WcharType -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
WvarcharType -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
WtextType -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  -- integer
  ScalarType
IntegerType -> Int -> Value
ODBC.IntValue (Int -> Value) -> Either QErr Int -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Int
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
SmallintType -> Int -> Value
ODBC.IntValue (Int -> Value) -> Either QErr Int -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Int
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
BigintType -> Int -> Value
ODBC.IntValue (Int -> Value) -> Either QErr Int -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Int
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
TinyintType -> Int -> Value
ODBC.IntValue (Int -> Value) -> Either QErr Int -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Int
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  -- float
  ScalarType
NumericType -> Float -> Value
ODBC.FloatValue (Float -> Value) -> Either QErr Float -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Float
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
DecimalType -> Float -> Value
ODBC.FloatValue (Float -> Value) -> Either QErr Float -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Float
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
FloatType -> Float -> Value
ODBC.FloatValue (Float -> Value) -> Either QErr Float -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Float
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
RealType -> Float -> Value
ODBC.FloatValue (Float -> Value) -> Either QErr Float -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Float
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  -- boolean
  ScalarType
BitType -> Word8 -> Value
ODBC.ByteValue (Word8 -> Value) -> Either QErr Word8 -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Word8
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  -- geo
  ScalarType
GeographyType -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
parseGeoTypes Value
jValue
  ScalarType
GeometryType -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
parseGeoTypes Value
jValue
  -- misc
  ScalarType
BinaryType -> Binary -> Value
ODBC.BinaryValue (Binary -> Value) -> (Text -> Binary) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
ODBC.Binary (ByteString -> Binary) -> (Text -> ByteString) -> Text -> Binary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
txtToBs (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
VarbinaryType -> Binary -> Value
ODBC.BinaryValue (Binary -> Value) -> (Text -> Binary) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Binary
ODBC.Binary (ByteString -> Binary) -> (Text -> ByteString) -> Text -> Binary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
txtToBs (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
Ss_time2Type -> TimeOfDay -> Value
ODBC.TimeOfDayValue (TimeOfDay -> Value) -> Either QErr TimeOfDay -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr TimeOfDay
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
TimestampType -> LocalTime -> Value
ODBC.LocalTimeValue (LocalTime -> Value) -> Either QErr LocalTime -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr LocalTime
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
DateType -> Day -> Value
ODBC.DayValue (Day -> Value) -> Either QErr Day -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Day
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  ScalarType
GuidType -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  -- the input format for types that aren't explicitly supported is a string
  UnknownType Text
_ -> Text -> Value
ODBC.TextValue (Text -> Value) -> Either QErr Text -> Either QErr Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either QErr Text
forall a. FromJSON a => Value -> Either QErr a
parseJValue Value
jValue
  where
    parseJValue :: (J.FromJSON a) => J.Value -> Either QErr a
    parseJValue :: forall a. FromJSON a => Value -> Either QErr a
parseJValue = (Value -> Parser a) -> Value -> Either QErr a
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser Value -> Parser a
forall a. FromJSON a => Value -> Parser a
J.parseJSON

    parseGeoTypes :: J.Value -> Either QErr Text
    parseGeoTypes :: Value -> Either QErr Text
parseGeoTypes Value
jv =
      (Value -> Parser Text) -> Value -> Either QErr Text
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser (forall a. FromJSON a => Value -> Parser a
J.parseJSON @Text) Value
jv Either QErr Text -> Either QErr Text -> Either QErr Text
forall a. Semigroup a => a -> a -> a
<> Value -> Either QErr Text
parseGeoJSONAsWKT Value
jValue

    parseGeoJSONAsWKT :: J.Value -> Either QErr Text
    parseGeoJSONAsWKT :: Value -> Either QErr Text
parseGeoJSONAsWKT Value
jv =
      (Value -> Parser GeometryWithCRS)
-> Value -> Either QErr GeometryWithCRS
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser (forall a. FromJSON a => Value -> Parser a
J.parseJSON @Geo.GeometryWithCRS) Value
jv
        Either QErr GeometryWithCRS
-> (GeometryWithCRS -> Either QErr Text) -> Either QErr Text
forall a b. Either QErr a -> (a -> Either QErr b) -> Either QErr b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WKT -> Text) -> Either QErr WKT -> Either QErr Text
forall a b. (a -> b) -> Either QErr a -> Either QErr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WKT -> Text
WKT.getWKT
        (Either QErr WKT -> Either QErr Text)
-> (GeometryWithCRS -> Either QErr WKT)
-> GeometryWithCRS
-> Either QErr Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeometryWithCRS -> Either QErr WKT
forall a. ToWKT a => a -> Either QErr WKT
WKT.toWKT

isComparableType, isNumType :: ScalarType -> Bool
isComparableType :: ScalarType -> Bool
isComparableType = \case
  ScalarType
BinaryType -> Bool
False
  ScalarType
VarbinaryType -> Bool
False
  ScalarType
BitType -> Bool
False
  ScalarType
GuidType -> Bool
False
  ScalarType
_ -> Bool
True
isNumType :: ScalarType -> Bool
isNumType = \case
  ScalarType
NumericType -> Bool
True
  ScalarType
DecimalType -> Bool
True
  ScalarType
IntegerType -> Bool
True
  ScalarType
SmallintType -> Bool
True
  ScalarType
FloatType -> Bool
True
  ScalarType
RealType -> Bool
True
  ScalarType
BigintType -> Bool
True
  ScalarType
TinyintType -> Bool
True
  ScalarType
_ -> Bool
False

getGQLTableName :: TableName -> Either QErr G.Name
getGQLTableName :: TableName -> Either QErr Name
getGQLTableName TableName
tn = do
  let textName :: Text
textName = Text -> SchemaName -> Text
snakeCaseName (TableName -> Text
tableName TableName
tn) (TableName -> SchemaName
tableSchema TableName
tn)
  Maybe Name -> Either QErr Name -> Either QErr Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Text -> Maybe Name
G.mkName Text
textName)
    (Either QErr Name -> Either QErr Name)
-> Either QErr Name -> Either QErr Name
forall a b. (a -> b) -> a -> b
$ Code -> Text -> Either QErr Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed
    (Text -> Either QErr Name) -> Text -> Either QErr Name
forall a b. (a -> b) -> a -> b
$ Text
"cannot include "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textName
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in the GraphQL schema because it is not a valid GraphQL identifier"

getGQLFunctionName :: FunctionName -> Either QErr G.Name
getGQLFunctionName :: FunctionName -> Either QErr Name
getGQLFunctionName FunctionName
fn = do
  let textName :: Text
textName = Text -> SchemaName -> Text
snakeCaseName (FunctionName -> Text
functionName FunctionName
fn) (FunctionName -> SchemaName
functionSchema FunctionName
fn)
  Maybe Name -> Either QErr Name -> Either QErr Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Text -> Maybe Name
G.mkName Text
textName)
    (Either QErr Name -> Either QErr Name)
-> Either QErr Name -> Either QErr Name
forall a b. (a -> b) -> a -> b
$ Code -> Text -> Either QErr Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed
    (Text -> Either QErr Name) -> Text -> Either QErr Name
forall a b. (a -> b) -> a -> b
$ Text
"cannot include "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textName
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in the GraphQL schema because it is not a valid GraphQL identifier"

snakeCaseName :: Text -> SchemaName -> Text
snakeCaseName :: Text -> SchemaName -> Text
snakeCaseName Text
tableName (SchemaName Text
tableSchema) =
  if Text
tableSchema Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dbo"
    then Text
tableName
    else Text
tableSchema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName

getTableIdentifier :: TableName -> Either QErr GQLNameIdentifier
getTableIdentifier :: TableName -> Either QErr GQLNameIdentifier
getTableIdentifier TableName
tName = do
  Name
gqlTableName <- TableName -> Either QErr Name
getGQLTableName TableName
tName
  GQLNameIdentifier -> Either QErr GQLNameIdentifier
forall a. a -> Either QErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GQLNameIdentifier -> Either QErr GQLNameIdentifier)
-> GQLNameIdentifier -> Either QErr GQLNameIdentifier
forall a b. (a -> b) -> a -> b
$ Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
gqlTableName

namingConventionSupport :: SupportedNamingCase
namingConventionSupport :: SupportedNamingCase
namingConventionSupport = SupportedNamingCase
OnlyHasuraCase

stringTypes :: [ScalarType]
stringTypes :: [ScalarType]
stringTypes =
  [ ScalarType
CharType,
    ScalarType
VarcharType,
    ScalarType
TextType,
    ScalarType
WcharType,
    ScalarType
WvarcharType,
    ScalarType
WtextType
  ]

geoTypes :: [ScalarType]
geoTypes :: [ScalarType]
geoTypes = [ScalarType
GeometryType, ScalarType
GeographyType]