{-# LANGUAGE TemplateHaskell #-}

-- | Metadata related types, functions and helpers.
--
-- Provides a single function which loads the MSSQL database metadata.
-- See the file at src-rsr/mssql/mssql_table_metadata.sql for the SQL we use to build
-- this metadata.
-- See 'Hasura.RQL.Types.Table.DBTableMetadata' for the Haskell type we use forall
-- storing this metadata.
module Hasura.Backends.MSSQL.Meta
  ( loadDBMetadata,
  )
where

import Data.Aeson as J
import Data.ByteString.UTF8 qualified as BSUTF8
import Data.FileEmbed (embedFile, makeRelativeToProject)
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
import Data.HashSet qualified as HS
import Data.String
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Database.MSSQL.Transaction qualified as Tx
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.Instances.Types ()
import Hasura.Backends.MSSQL.SQL.Error
import Hasura.Backends.MSSQL.Types.Internal
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common (OID (..))
import Hasura.Table.Cache

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

-- * Loader

loadDBMetadata :: (MonadIO m) => Tx.TxET QErr m (DBTablesMetadata 'MSSQL)
loadDBMetadata :: forall (m :: * -> *).
MonadIO m =>
TxET QErr m (DBTablesMetadata 'MSSQL)
loadDBMetadata = do
  let queryBytes :: ByteString
queryBytes = $(makeRelativeToProject "src-rsr/mssql/mssql_table_metadata.sql" >>= embedFile)
      Query
odbcQuery :: ODBC.Query = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> (ByteString -> String) -> ByteString -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSUTF8.toString (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ ByteString
queryBytes
  Text
sysTablesText <- Identity Text -> Text
forall a. Identity a -> a
runIdentity (Identity Text -> Text)
-> TxET QErr m (Identity Text) -> TxET QErr m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MSSQLTxError -> QErr) -> Query -> TxET QErr m (Identity Text)
forall (m :: * -> *) a e.
(MonadIO m, FromRow a) =>
(MSSQLTxError -> e) -> Query -> TxET e m a
Tx.singleRowQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler Query
odbcQuery
  case ByteString -> Either String [SysTable]
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict (Text -> ByteString
T.encodeUtf8 Text
sysTablesText) of
    Left String
e -> Text -> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL))
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL)))
-> Text -> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL))
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"error loading sql server database schema: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e
    Right [SysTable]
sysTables -> HashMap TableName (DBTableMetadata 'MSSQL)
-> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL))
forall a. a -> TxET QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap TableName (DBTableMetadata 'MSSQL)
 -> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL)))
-> HashMap TableName (DBTableMetadata 'MSSQL)
-> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL))
forall a b. (a -> b) -> a -> b
$ [(TableName, DBTableMetadata 'MSSQL)]
-> HashMap TableName (DBTableMetadata 'MSSQL)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(TableName, DBTableMetadata 'MSSQL)]
 -> HashMap TableName (DBTableMetadata 'MSSQL))
-> [(TableName, DBTableMetadata 'MSSQL)]
-> HashMap TableName (DBTableMetadata 'MSSQL)
forall a b. (a -> b) -> a -> b
$ (SysTable -> (TableName, DBTableMetadata 'MSSQL))
-> [SysTable] -> [(TableName, DBTableMetadata 'MSSQL)]
forall a b. (a -> b) -> [a] -> [b]
map SysTable -> (TableName, DBTableMetadata 'MSSQL)
transformTable [SysTable]
sysTables

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

-- * Local types

data SysTable = SysTable
  { SysTable -> Text
staName :: Text,
    SysTable -> Int
staObjectId :: Int,
    SysTable -> [SysColumn]
staJoinedSysColumn :: [SysColumn],
    SysTable -> SysSchema
staJoinedSysSchema :: SysSchema,
    SysTable -> Maybe SysPrimaryKey
staJoinedSysPrimaryKey :: Maybe SysPrimaryKey
  }
  deriving (Int -> SysTable -> String -> String
[SysTable] -> String -> String
SysTable -> String
(Int -> SysTable -> String -> String)
-> (SysTable -> String)
-> ([SysTable] -> String -> String)
-> Show SysTable
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SysTable -> String -> String
showsPrec :: Int -> SysTable -> String -> String
$cshow :: SysTable -> String
show :: SysTable -> String
$cshowList :: [SysTable] -> String -> String
showList :: [SysTable] -> String -> String
Show, (forall x. SysTable -> Rep SysTable x)
-> (forall x. Rep SysTable x -> SysTable) -> Generic SysTable
forall x. Rep SysTable x -> SysTable
forall x. SysTable -> Rep SysTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SysTable -> Rep SysTable x
from :: forall x. SysTable -> Rep SysTable x
$cto :: forall x. Rep SysTable x -> SysTable
to :: forall x. Rep SysTable x -> SysTable
Generic)

instance FromJSON SysTable where
  parseJSON :: Value -> Parser SysTable
parseJSON = Options -> Value -> Parser SysTable
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

newtype SysPrimaryKeyColumn = SysPrimaryKeyColumn
  {SysPrimaryKeyColumn -> Text
spkcName :: Text}
  deriving (Int -> SysPrimaryKeyColumn -> String -> String
[SysPrimaryKeyColumn] -> String -> String
SysPrimaryKeyColumn -> String
(Int -> SysPrimaryKeyColumn -> String -> String)
-> (SysPrimaryKeyColumn -> String)
-> ([SysPrimaryKeyColumn] -> String -> String)
-> Show SysPrimaryKeyColumn
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SysPrimaryKeyColumn -> String -> String
showsPrec :: Int -> SysPrimaryKeyColumn -> String -> String
$cshow :: SysPrimaryKeyColumn -> String
show :: SysPrimaryKeyColumn -> String
$cshowList :: [SysPrimaryKeyColumn] -> String -> String
showList :: [SysPrimaryKeyColumn] -> String -> String
Show, (forall x. SysPrimaryKeyColumn -> Rep SysPrimaryKeyColumn x)
-> (forall x. Rep SysPrimaryKeyColumn x -> SysPrimaryKeyColumn)
-> Generic SysPrimaryKeyColumn
forall x. Rep SysPrimaryKeyColumn x -> SysPrimaryKeyColumn
forall x. SysPrimaryKeyColumn -> Rep SysPrimaryKeyColumn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SysPrimaryKeyColumn -> Rep SysPrimaryKeyColumn x
from :: forall x. SysPrimaryKeyColumn -> Rep SysPrimaryKeyColumn x
$cto :: forall x. Rep SysPrimaryKeyColumn x -> SysPrimaryKeyColumn
to :: forall x. Rep SysPrimaryKeyColumn x -> SysPrimaryKeyColumn
Generic)

instance FromJSON SysPrimaryKeyColumn where
  parseJSON :: Value -> Parser SysPrimaryKeyColumn
parseJSON = Options -> Value -> Parser SysPrimaryKeyColumn
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

data SysPrimaryKey = SysPrimaryKey
  { SysPrimaryKey -> Text
spkName :: Text,
    SysPrimaryKey -> Int
spkIndexId :: Int,
    SysPrimaryKey -> NESeq SysPrimaryKeyColumn
spkColumns :: NESeq SysPrimaryKeyColumn
  }
  deriving (Int -> SysPrimaryKey -> String -> String
[SysPrimaryKey] -> String -> String
SysPrimaryKey -> String
(Int -> SysPrimaryKey -> String -> String)
-> (SysPrimaryKey -> String)
-> ([SysPrimaryKey] -> String -> String)
-> Show SysPrimaryKey
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SysPrimaryKey -> String -> String
showsPrec :: Int -> SysPrimaryKey -> String -> String
$cshow :: SysPrimaryKey -> String
show :: SysPrimaryKey -> String
$cshowList :: [SysPrimaryKey] -> String -> String
showList :: [SysPrimaryKey] -> String -> String
Show, (forall x. SysPrimaryKey -> Rep SysPrimaryKey x)
-> (forall x. Rep SysPrimaryKey x -> SysPrimaryKey)
-> Generic SysPrimaryKey
forall x. Rep SysPrimaryKey x -> SysPrimaryKey
forall x. SysPrimaryKey -> Rep SysPrimaryKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SysPrimaryKey -> Rep SysPrimaryKey x
from :: forall x. SysPrimaryKey -> Rep SysPrimaryKey x
$cto :: forall x. Rep SysPrimaryKey x -> SysPrimaryKey
to :: forall x. Rep SysPrimaryKey x -> SysPrimaryKey
Generic)

instance FromJSON SysPrimaryKey where
  parseJSON :: Value -> Parser SysPrimaryKey
parseJSON = Options -> Value -> Parser SysPrimaryKey
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

data SysSchema = SysSchema
  { SysSchema -> Text
ssName :: Text,
    SysSchema -> Int
ssSchemaId :: Int
  }
  deriving (Int -> SysSchema -> String -> String
[SysSchema] -> String -> String
SysSchema -> String
(Int -> SysSchema -> String -> String)
-> (SysSchema -> String)
-> ([SysSchema] -> String -> String)
-> Show SysSchema
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SysSchema -> String -> String
showsPrec :: Int -> SysSchema -> String -> String
$cshow :: SysSchema -> String
show :: SysSchema -> String
$cshowList :: [SysSchema] -> String -> String
showList :: [SysSchema] -> String -> String
Show, (forall x. SysSchema -> Rep SysSchema x)
-> (forall x. Rep SysSchema x -> SysSchema) -> Generic SysSchema
forall x. Rep SysSchema x -> SysSchema
forall x. SysSchema -> Rep SysSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SysSchema -> Rep SysSchema x
from :: forall x. SysSchema -> Rep SysSchema x
$cto :: forall x. Rep SysSchema x -> SysSchema
to :: forall x. Rep SysSchema x -> SysSchema
Generic)

instance FromJSON SysSchema where
  parseJSON :: Value -> Parser SysSchema
parseJSON = Options -> Value -> Parser SysSchema
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

data SysColumn = SysColumn
  { SysColumn -> Text
scName :: Text,
    SysColumn -> Int
scColumnId :: Int,
    SysColumn -> Int
scUserTypeId :: Int,
    SysColumn -> Bool
scIsNullable :: Bool,
    SysColumn -> Bool
scIsIdentity :: Bool,
    SysColumn -> Bool
scIsComputed :: Bool,
    SysColumn -> SysType
scJoinedSysType :: SysType,
    SysColumn -> [SysForeignKeyColumn]
scJoinedForeignKeyColumns :: [SysForeignKeyColumn]
  }
  deriving (Int -> SysColumn -> String -> String
[SysColumn] -> String -> String
SysColumn -> String
(Int -> SysColumn -> String -> String)
-> (SysColumn -> String)
-> ([SysColumn] -> String -> String)
-> Show SysColumn
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SysColumn -> String -> String
showsPrec :: Int -> SysColumn -> String -> String
$cshow :: SysColumn -> String
show :: SysColumn -> String
$cshowList :: [SysColumn] -> String -> String
showList :: [SysColumn] -> String -> String
Show, (forall x. SysColumn -> Rep SysColumn x)
-> (forall x. Rep SysColumn x -> SysColumn) -> Generic SysColumn
forall x. Rep SysColumn x -> SysColumn
forall x. SysColumn -> Rep SysColumn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SysColumn -> Rep SysColumn x
from :: forall x. SysColumn -> Rep SysColumn x
$cto :: forall x. Rep SysColumn x -> SysColumn
to :: forall x. Rep SysColumn x -> SysColumn
Generic)

instance FromJSON SysColumn where
  parseJSON :: Value -> Parser SysColumn
parseJSON = Options -> Value -> Parser SysColumn
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

data SysType = SysType
  { SysType -> Text
styName :: Text,
    SysType -> Int
stySchemaId :: Int,
    SysType -> Int
styUserTypeId :: Int
  }
  deriving (Int -> SysType -> String -> String
[SysType] -> String -> String
SysType -> String
(Int -> SysType -> String -> String)
-> (SysType -> String)
-> ([SysType] -> String -> String)
-> Show SysType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SysType -> String -> String
showsPrec :: Int -> SysType -> String -> String
$cshow :: SysType -> String
show :: SysType -> String
$cshowList :: [SysType] -> String -> String
showList :: [SysType] -> String -> String
Show, (forall x. SysType -> Rep SysType x)
-> (forall x. Rep SysType x -> SysType) -> Generic SysType
forall x. Rep SysType x -> SysType
forall x. SysType -> Rep SysType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SysType -> Rep SysType x
from :: forall x. SysType -> Rep SysType x
$cto :: forall x. Rep SysType x -> SysType
to :: forall x. Rep SysType x -> SysType
Generic)

instance FromJSON SysType where
  parseJSON :: Value -> Parser SysType
parseJSON = Options -> Value -> Parser SysType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

data SysForeignKeyColumn = SysForeignKeyColumn
  { SysForeignKeyColumn -> Int
sfkcConstraintObjectId :: Int,
    SysForeignKeyColumn -> Int
sfkcConstraintColumnId :: Int,
    SysForeignKeyColumn -> Int
sfkcParentObjectId :: Int,
    SysForeignKeyColumn -> Int
sfkcParentColumnId :: Int,
    SysForeignKeyColumn -> Int
sfkcReferencedObjectId :: Int,
    SysForeignKeyColumn -> Int
sfkcReferencedColumnId :: Int,
    SysForeignKeyColumn -> Text
sfkcJoinedReferencedTableName :: Text,
    SysForeignKeyColumn -> Text
sfkcJoinedReferencedColumnName :: Text,
    SysForeignKeyColumn -> SysSchema
sfkcJoinedReferencedSysSchema :: SysSchema
  }
  deriving (Int -> SysForeignKeyColumn -> String -> String
[SysForeignKeyColumn] -> String -> String
SysForeignKeyColumn -> String
(Int -> SysForeignKeyColumn -> String -> String)
-> (SysForeignKeyColumn -> String)
-> ([SysForeignKeyColumn] -> String -> String)
-> Show SysForeignKeyColumn
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SysForeignKeyColumn -> String -> String
showsPrec :: Int -> SysForeignKeyColumn -> String -> String
$cshow :: SysForeignKeyColumn -> String
show :: SysForeignKeyColumn -> String
$cshowList :: [SysForeignKeyColumn] -> String -> String
showList :: [SysForeignKeyColumn] -> String -> String
Show, (forall x. SysForeignKeyColumn -> Rep SysForeignKeyColumn x)
-> (forall x. Rep SysForeignKeyColumn x -> SysForeignKeyColumn)
-> Generic SysForeignKeyColumn
forall x. Rep SysForeignKeyColumn x -> SysForeignKeyColumn
forall x. SysForeignKeyColumn -> Rep SysForeignKeyColumn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SysForeignKeyColumn -> Rep SysForeignKeyColumn x
from :: forall x. SysForeignKeyColumn -> Rep SysForeignKeyColumn x
$cto :: forall x. Rep SysForeignKeyColumn x -> SysForeignKeyColumn
to :: forall x. Rep SysForeignKeyColumn x -> SysForeignKeyColumn
Generic)

instance FromJSON SysForeignKeyColumn where
  parseJSON :: Value -> Parser SysForeignKeyColumn
parseJSON = Options -> Value -> Parser SysForeignKeyColumn
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

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

-- * Transform

transformTable :: SysTable -> (TableName, DBTableMetadata 'MSSQL)
transformTable :: SysTable -> (TableName, DBTableMetadata 'MSSQL)
transformTable SysTable
tableInfo =
  let schemaName :: SchemaName
schemaName = Text -> SchemaName
SchemaName (Text -> SchemaName) -> Text -> SchemaName
forall a b. (a -> b) -> a -> b
$ SysSchema -> Text
ssName (SysSchema -> Text) -> SysSchema -> Text
forall a b. (a -> b) -> a -> b
$ SysTable -> SysSchema
staJoinedSysSchema SysTable
tableInfo
      tableName :: TableName
tableName = Text -> SchemaName -> TableName
TableName (SysTable -> Text
staName SysTable
tableInfo) SchemaName
schemaName
      tableOID :: OID
tableOID = Int -> OID
OID (Int -> OID) -> Int -> OID
forall a b. (a -> b) -> a -> b
$ SysTable -> Int
staObjectId SysTable
tableInfo
      ([RawColumnInfo 'MSSQL]
columns, [[ForeignKey 'MSSQL]]
foreignKeys) = [(RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])]
-> ([RawColumnInfo 'MSSQL], [[ForeignKey 'MSSQL]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])]
 -> ([RawColumnInfo 'MSSQL], [[ForeignKey 'MSSQL]]))
-> [(RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])]
-> ([RawColumnInfo 'MSSQL], [[ForeignKey 'MSSQL]])
forall a b. (a -> b) -> a -> b
$ SysColumn -> (RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])
transformColumn (SysColumn -> (RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL]))
-> [SysColumn] -> [(RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SysTable -> [SysColumn]
staJoinedSysColumn SysTable
tableInfo
      foreignKeysMetadata :: HashSet (ForeignKeyMetadata 'MSSQL)
foreignKeysMetadata = [ForeignKeyMetadata 'MSSQL] -> HashSet (ForeignKeyMetadata 'MSSQL)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([ForeignKeyMetadata 'MSSQL]
 -> HashSet (ForeignKeyMetadata 'MSSQL))
-> [ForeignKeyMetadata 'MSSQL]
-> HashSet (ForeignKeyMetadata 'MSSQL)
forall a b. (a -> b) -> a -> b
$ (ForeignKey 'MSSQL -> ForeignKeyMetadata 'MSSQL)
-> [ForeignKey 'MSSQL] -> [ForeignKeyMetadata 'MSSQL]
forall a b. (a -> b) -> [a] -> [b]
map ForeignKey 'MSSQL -> ForeignKeyMetadata 'MSSQL
forall (b :: BackendType). ForeignKey b -> ForeignKeyMetadata b
ForeignKeyMetadata ([ForeignKey 'MSSQL] -> [ForeignKeyMetadata 'MSSQL])
-> [ForeignKey 'MSSQL] -> [ForeignKeyMetadata 'MSSQL]
forall a b. (a -> b) -> a -> b
$ [ForeignKey 'MSSQL] -> [ForeignKey 'MSSQL]
coalesceKeys ([ForeignKey 'MSSQL] -> [ForeignKey 'MSSQL])
-> [ForeignKey 'MSSQL] -> [ForeignKey 'MSSQL]
forall a b. (a -> b) -> a -> b
$ [[ForeignKey 'MSSQL]] -> [ForeignKey 'MSSQL]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ForeignKey 'MSSQL]]
foreignKeys
      primaryKey :: Maybe (PrimaryKey 'MSSQL ColumnName)
primaryKey = SysPrimaryKey -> PrimaryKey 'MSSQL ColumnName
transformPrimaryKey (SysPrimaryKey -> PrimaryKey 'MSSQL ColumnName)
-> Maybe SysPrimaryKey -> Maybe (PrimaryKey 'MSSQL ColumnName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SysTable -> Maybe SysPrimaryKey
staJoinedSysPrimaryKey SysTable
tableInfo
      identityColumns :: [ColumnName]
identityColumns =
        (SysColumn -> ColumnName) -> [SysColumn] -> [ColumnName]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ColumnName
ColumnName (Text -> ColumnName)
-> (SysColumn -> Text) -> SysColumn -> ColumnName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SysColumn -> Text
scName)
          ([SysColumn] -> [ColumnName]) -> [SysColumn] -> [ColumnName]
forall a b. (a -> b) -> a -> b
$ (SysColumn -> Bool) -> [SysColumn] -> [SysColumn]
forall a. (a -> Bool) -> [a] -> [a]
filter SysColumn -> Bool
scIsIdentity
          ([SysColumn] -> [SysColumn]) -> [SysColumn] -> [SysColumn]
forall a b. (a -> b) -> a -> b
$ SysTable -> [SysColumn]
staJoinedSysColumn SysTable
tableInfo
   in ( TableName
tableName,
        OID
-> [RawColumnInfo 'MSSQL]
-> Maybe (PrimaryKey 'MSSQL (Column 'MSSQL))
-> HashSet (UniqueConstraint 'MSSQL)
-> HashSet (ForeignKeyMetadata 'MSSQL)
-> Maybe ViewInfo
-> Maybe PGDescription
-> ExtraTableMetadata 'MSSQL
-> DBTableMetadata 'MSSQL
forall (b :: BackendType).
OID
-> [RawColumnInfo b]
-> Maybe (PrimaryKey b (Column b))
-> HashSet (UniqueConstraint b)
-> HashSet (ForeignKeyMetadata b)
-> Maybe ViewInfo
-> Maybe PGDescription
-> ExtraTableMetadata b
-> DBTableMetadata b
DBTableMetadata
          OID
tableOID
          [RawColumnInfo 'MSSQL]
columns
          Maybe (PrimaryKey 'MSSQL (Column 'MSSQL))
Maybe (PrimaryKey 'MSSQL ColumnName)
primaryKey
          HashSet (UniqueConstraint 'MSSQL)
forall a. HashSet a
HS.empty -- no unique constraints?
          HashSet (ForeignKeyMetadata 'MSSQL)
foreignKeysMetadata
          Maybe ViewInfo
forall a. Maybe a
Nothing -- no views, only tables
          Maybe PGDescription
forall a. Maybe a
Nothing -- no description
          [ColumnName]
ExtraTableMetadata 'MSSQL
identityColumns
      )

transformColumn ::
  SysColumn ->
  (RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])
transformColumn :: SysColumn -> (RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])
transformColumn SysColumn
sysCol =
  let rciName :: ColumnName
rciName = Text -> ColumnName
ColumnName (Text -> ColumnName) -> Text -> ColumnName
forall a b. (a -> b) -> a -> b
$ SysColumn -> Text
scName SysColumn
sysCol
      rciPosition :: Int
rciPosition = SysColumn -> Int
scColumnId SysColumn
sysCol

      rciIsNullable :: Bool
rciIsNullable = SysColumn -> Bool
scIsNullable SysColumn
sysCol
      rciDescription :: Maybe a
rciDescription = Maybe a
forall a. Maybe a
Nothing
      rciType :: RawColumnType 'MSSQL
rciType = ScalarType 'MSSQL -> RawColumnType 'MSSQL
forall (b :: BackendType). ScalarType b -> RawColumnType b
RawColumnTypeScalar (ScalarType 'MSSQL -> RawColumnType 'MSSQL)
-> ScalarType 'MSSQL -> RawColumnType 'MSSQL
forall a b. (a -> b) -> a -> b
$ Text -> ScalarType
parseScalarType (Text -> ScalarType) -> Text -> ScalarType
forall a b. (a -> b) -> a -> b
$ SysType -> Text
styName (SysType -> Text) -> SysType -> Text
forall a b. (a -> b) -> a -> b
$ SysColumn -> SysType
scJoinedSysType SysColumn
sysCol
      foreignKeys :: [ForeignKey 'MSSQL]
foreignKeys =
        SysColumn -> [SysForeignKeyColumn]
scJoinedForeignKeyColumns SysColumn
sysCol [SysForeignKeyColumn]
-> (SysForeignKeyColumn -> ForeignKey 'MSSQL)
-> [ForeignKey 'MSSQL]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \SysForeignKeyColumn
foreignKeyColumn ->
          let _fkConstraint :: Constraint 'MSSQL
_fkConstraint = ConstraintName 'MSSQL -> OID -> Constraint 'MSSQL
forall (b :: BackendType). ConstraintName b -> OID -> Constraint b
Constraint (Text -> ConstraintName
ConstraintName Text
"fk_mssql") (OID -> Constraint 'MSSQL) -> OID -> Constraint 'MSSQL
forall a b. (a -> b) -> a -> b
$ Int -> OID
OID (Int -> OID) -> Int -> OID
forall a b. (a -> b) -> a -> b
$ SysForeignKeyColumn -> Int
sfkcConstraintObjectId SysForeignKeyColumn
foreignKeyColumn

              schemaName :: SchemaName
schemaName = Text -> SchemaName
SchemaName (Text -> SchemaName) -> Text -> SchemaName
forall a b. (a -> b) -> a -> b
$ SysSchema -> Text
ssName (SysSchema -> Text) -> SysSchema -> Text
forall a b. (a -> b) -> a -> b
$ SysForeignKeyColumn -> SysSchema
sfkcJoinedReferencedSysSchema SysForeignKeyColumn
foreignKeyColumn
              _fkForeignTable :: TableName
_fkForeignTable = Text -> SchemaName -> TableName
TableName (SysForeignKeyColumn -> Text
sfkcJoinedReferencedTableName SysForeignKeyColumn
foreignKeyColumn) SchemaName
schemaName
              _fkColumnMapping :: NEHashMap ColumnName ColumnName
_fkColumnMapping = ColumnName -> ColumnName -> NEHashMap ColumnName ColumnName
forall k v. Hashable k => k -> v -> NEHashMap k v
NEHashMap.singleton ColumnName
rciName (ColumnName -> NEHashMap ColumnName ColumnName)
-> ColumnName -> NEHashMap ColumnName ColumnName
forall a b. (a -> b) -> a -> b
$ Text -> ColumnName
ColumnName (Text -> ColumnName) -> Text -> ColumnName
forall a b. (a -> b) -> a -> b
$ SysForeignKeyColumn -> Text
sfkcJoinedReferencedColumnName SysForeignKeyColumn
foreignKeyColumn
           in ForeignKey {NEHashMap (Column 'MSSQL) (Column 'MSSQL)
NEHashMap ColumnName ColumnName
TableName 'MSSQL
TableName
Constraint 'MSSQL
_fkConstraint :: Constraint 'MSSQL
_fkForeignTable :: TableName
_fkColumnMapping :: NEHashMap ColumnName ColumnName
_fkConstraint :: Constraint 'MSSQL
_fkForeignTable :: TableName 'MSSQL
_fkColumnMapping :: NEHashMap (Column 'MSSQL) (Column 'MSSQL)
..}

      colIsImmutable :: Bool
colIsImmutable = SysColumn -> Bool
scIsComputed SysColumn
sysCol Bool -> Bool -> Bool
|| SysColumn -> Bool
scIsIdentity SysColumn
sysCol
      rciMutability :: ColumnMutability
rciMutability = ColumnMutability {_cmIsInsertable :: Bool
_cmIsInsertable = Bool -> Bool
not Bool
colIsImmutable, _cmIsUpdatable :: Bool
_cmIsUpdatable = Bool -> Bool
not Bool
colIsImmutable}
   in (RawColumnInfo {Bool
Int
Maybe Description
Column 'MSSQL
ColumnMutability
RawColumnType 'MSSQL
ColumnName
forall a. Maybe a
rciName :: ColumnName
rciPosition :: Int
rciIsNullable :: Bool
rciDescription :: forall a. Maybe a
rciType :: RawColumnType 'MSSQL
rciMutability :: ColumnMutability
rciName :: Column 'MSSQL
rciPosition :: Int
rciType :: RawColumnType 'MSSQL
rciIsNullable :: Bool
rciDescription :: Maybe Description
rciMutability :: ColumnMutability
..}, [ForeignKey 'MSSQL]
foreignKeys)

transformPrimaryKey :: SysPrimaryKey -> PrimaryKey 'MSSQL (Column 'MSSQL)
transformPrimaryKey :: SysPrimaryKey -> PrimaryKey 'MSSQL ColumnName
transformPrimaryKey (SysPrimaryKey {Int
Text
NESeq SysPrimaryKeyColumn
spkName :: SysPrimaryKey -> Text
spkIndexId :: SysPrimaryKey -> Int
spkColumns :: SysPrimaryKey -> NESeq SysPrimaryKeyColumn
spkName :: Text
spkIndexId :: Int
spkColumns :: NESeq SysPrimaryKeyColumn
..}) =
  let constraint :: Constraint 'MSSQL
constraint = ConstraintName 'MSSQL -> OID -> Constraint 'MSSQL
forall (b :: BackendType). ConstraintName b -> OID -> Constraint b
Constraint (Text -> ConstraintName
ConstraintName Text
spkName) (OID -> Constraint 'MSSQL) -> OID -> Constraint 'MSSQL
forall a b. (a -> b) -> a -> b
$ Int -> OID
OID Int
spkIndexId
      columns :: NESeq ColumnName
columns = (Text -> ColumnName
ColumnName (Text -> ColumnName)
-> (SysPrimaryKeyColumn -> Text)
-> SysPrimaryKeyColumn
-> ColumnName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SysPrimaryKeyColumn -> Text
spkcName) (SysPrimaryKeyColumn -> ColumnName)
-> NESeq SysPrimaryKeyColumn -> NESeq ColumnName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NESeq SysPrimaryKeyColumn
spkColumns
   in Constraint 'MSSQL
-> NESeq ColumnName -> PrimaryKey 'MSSQL ColumnName
forall (b :: BackendType) a.
Constraint b -> NESeq a -> PrimaryKey b a
PrimaryKey Constraint 'MSSQL
constraint NESeq ColumnName
columns

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

-- * Helpers

coalesceKeys :: [ForeignKey 'MSSQL] -> [ForeignKey 'MSSQL]
coalesceKeys :: [ForeignKey 'MSSQL] -> [ForeignKey 'MSSQL]
coalesceKeys = HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL)
-> [ForeignKey 'MSSQL]
forall k v. HashMap k v -> [v]
HashMap.elems (HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL)
 -> [ForeignKey 'MSSQL])
-> ([ForeignKey 'MSSQL]
    -> HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL))
-> [ForeignKey 'MSSQL]
-> [ForeignKey 'MSSQL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL)
 -> ForeignKey 'MSSQL
 -> HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL))
-> HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL)
-> [ForeignKey 'MSSQL]
-> HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HashMap (Constraint 'MSSQL, TableName 'MSSQL) (ForeignKey 'MSSQL)
-> ForeignKey 'MSSQL
-> HashMap
     (Constraint 'MSSQL, TableName 'MSSQL) (ForeignKey 'MSSQL)
HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL)
-> ForeignKey 'MSSQL
-> HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL)
forall {b :: BackendType}.
Backend b =>
HashMap (Constraint b, TableName b) (ForeignKey b)
-> ForeignKey b
-> HashMap (Constraint b, TableName b) (ForeignKey b)
coalesce HashMap (Constraint 'MSSQL, TableName) (ForeignKey 'MSSQL)
forall k v. HashMap k v
HashMap.empty
  where
    coalesce :: HashMap (Constraint b, TableName b) (ForeignKey b)
-> ForeignKey b
-> HashMap (Constraint b, TableName b) (ForeignKey b)
coalesce HashMap (Constraint b, TableName b) (ForeignKey b)
mapping fk :: ForeignKey b
fk@(ForeignKey Constraint b
constraint TableName b
tableName NEHashMap (Column b) (Column b)
_) = (ForeignKey b -> ForeignKey b -> ForeignKey b)
-> (Constraint b, TableName b)
-> ForeignKey b
-> HashMap (Constraint b, TableName b) (ForeignKey b)
-> HashMap (Constraint b, TableName b) (ForeignKey b)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith ForeignKey b -> ForeignKey b -> ForeignKey b
forall {b :: BackendType}.
Hashable (Column b) =>
ForeignKey b -> ForeignKey b -> ForeignKey b
combine (Constraint b
constraint, TableName b
tableName) ForeignKey b
fk HashMap (Constraint b, TableName b) (ForeignKey b)
mapping
    combine :: ForeignKey b -> ForeignKey b -> ForeignKey b
combine ForeignKey b
oldFK ForeignKey b
newFK = ForeignKey b
oldFK {_fkColumnMapping :: NEHashMap (Column b) (Column b)
_fkColumnMapping = (NEHashMap (Column b) (Column b)
-> NEHashMap (Column b) (Column b)
-> NEHashMap (Column b) (Column b)
forall k v.
Hashable k =>
NEHashMap k v -> NEHashMap k v -> NEHashMap k v
NEHashMap.union (NEHashMap (Column b) (Column b)
 -> NEHashMap (Column b) (Column b)
 -> NEHashMap (Column b) (Column b))
-> (ForeignKey b -> NEHashMap (Column b) (Column b))
-> ForeignKey b
-> ForeignKey b
-> NEHashMap (Column b) (Column b)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ForeignKey b -> NEHashMap (Column b) (Column b)
forall (b :: BackendType).
ForeignKey b -> NEHashMap (Column b) (Column b)
_fkColumnMapping) ForeignKey b
oldFK ForeignKey b
newFK}