{-# 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 Aeson
import Data.ByteString.UTF8 qualified as BSUTF8
import Data.FileEmbed (embedFile, makeRelativeToProject)
import Data.HashMap.Strict qualified as HM
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.Column
import Hasura.RQL.Types.Common (OID (..))
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend

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

-- * Loader

loadDBMetadata :: (MonadIO m) => Tx.TxET QErr m (DBTablesMetadata 'MSSQL)
loadDBMetadata :: 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
Aeson.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 (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
HM.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
showList :: [SysTable] -> String -> String
$cshowList :: [SysTable] -> String -> String
show :: SysTable -> String
$cshow :: SysTable -> String
showsPrec :: Int -> SysTable -> String -> String
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SysTable x -> SysTable
$cfrom :: forall x. SysTable -> Rep SysTable x
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
showList :: [SysPrimaryKeyColumn] -> String -> String
$cshowList :: [SysPrimaryKeyColumn] -> String -> String
show :: SysPrimaryKeyColumn -> String
$cshow :: SysPrimaryKeyColumn -> String
showsPrec :: Int -> SysPrimaryKeyColumn -> String -> String
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SysPrimaryKeyColumn x -> SysPrimaryKeyColumn
$cfrom :: forall x. SysPrimaryKeyColumn -> Rep SysPrimaryKeyColumn x
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
showList :: [SysPrimaryKey] -> String -> String
$cshowList :: [SysPrimaryKey] -> String -> String
show :: SysPrimaryKey -> String
$cshow :: SysPrimaryKey -> String
showsPrec :: Int -> SysPrimaryKey -> String -> String
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SysPrimaryKey x -> SysPrimaryKey
$cfrom :: forall x. SysPrimaryKey -> Rep SysPrimaryKey x
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
showList :: [SysSchema] -> String -> String
$cshowList :: [SysSchema] -> String -> String
show :: SysSchema -> String
$cshow :: SysSchema -> String
showsPrec :: Int -> SysSchema -> String -> String
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SysSchema x -> SysSchema
$cfrom :: forall x. SysSchema -> Rep SysSchema x
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
showList :: [SysColumn] -> String -> String
$cshowList :: [SysColumn] -> String -> String
show :: SysColumn -> String
$cshow :: SysColumn -> String
showsPrec :: Int -> SysColumn -> String -> String
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SysColumn x -> SysColumn
$cfrom :: forall x. SysColumn -> Rep SysColumn x
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
showList :: [SysType] -> String -> String
$cshowList :: [SysType] -> String -> String
show :: SysType -> String
$cshow :: SysType -> String
showsPrec :: Int -> SysType -> String -> String
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SysType x -> SysType
$cfrom :: forall x. SysType -> Rep SysType x
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
showList :: [SysForeignKeyColumn] -> String -> String
$cshowList :: [SysForeignKeyColumn] -> String -> String
show :: SysForeignKeyColumn -> String
$cshow :: SysForeignKeyColumn -> String
showsPrec :: Int -> SysForeignKeyColumn -> String -> String
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep SysForeignKeyColumn x -> SysForeignKeyColumn
$cfrom :: forall x. SysForeignKeyColumn -> Rep SysForeignKeyColumn x
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 (Column 'MSSQL))
primaryKey = SysPrimaryKey -> PrimaryKey 'MSSQL (Column 'MSSQL)
transformPrimaryKey (SysPrimaryKey -> PrimaryKey 'MSSQL (Column 'MSSQL))
-> Maybe SysPrimaryKey -> Maybe (PrimaryKey 'MSSQL (Column 'MSSQL))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SysTable -> Maybe SysPrimaryKey
staJoinedSysPrimaryKey SysTable
tableInfo
      identityColumns :: [Column 'MSSQL]
identityColumns =
        (SysColumn -> Column 'MSSQL) -> [SysColumn] -> [Column 'MSSQL]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Column 'MSSQL
ColumnName (Text -> Column 'MSSQL)
-> (SysColumn -> Text) -> SysColumn -> Column 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SysColumn -> Text
scName) ([SysColumn] -> [Column 'MSSQL]) -> [SysColumn] -> [Column 'MSSQL]
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 (Column 'MSSQL))
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
          [Column 'MSSQL]
ExtraTableMetadata 'MSSQL
identityColumns
      )

transformColumn ::
  SysColumn ->
  (RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])
transformColumn :: SysColumn -> (RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])
transformColumn SysColumn
sysCol =
  let rciName :: Column 'MSSQL
rciName = Text -> Column 'MSSQL
ColumnName (Text -> Column 'MSSQL) -> Text -> Column 'MSSQL
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 :: ScalarType
rciType = 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 (Column 'MSSQL) (Column 'MSSQL)
_fkColumnMapping = Column 'MSSQL
-> Column 'MSSQL -> NEHashMap (Column 'MSSQL) (Column 'MSSQL)
forall k v. Hashable k => k -> v -> NEHashMap k v
NEHashMap.singleton Column 'MSSQL
rciName (Column 'MSSQL -> NEHashMap (Column 'MSSQL) (Column 'MSSQL))
-> Column 'MSSQL -> NEHashMap (Column 'MSSQL) (Column 'MSSQL)
forall a b. (a -> b) -> a -> b
$ Text -> Column 'MSSQL
ColumnName (Text -> Column 'MSSQL) -> Text -> Column 'MSSQL
forall a b. (a -> b) -> a -> b
$ SysForeignKeyColumn -> Text
sfkcJoinedReferencedColumnName SysForeignKeyColumn
foreignKeyColumn
           in ForeignKey :: forall (b :: BackendType).
Constraint b
-> TableName b -> NEHashMap (Column b) (Column b) -> ForeignKey b
ForeignKey {NEHashMap (Column 'MSSQL) (Column 'MSSQL)
NEHashMap (Column 'MSSQL) (Column 'MSSQL)
TableName 'MSSQL
TableName
Constraint 'MSSQL
_fkColumnMapping :: NEHashMap (Column 'MSSQL) (Column 'MSSQL)
_fkForeignTable :: TableName 'MSSQL
_fkConstraint :: Constraint 'MSSQL
_fkColumnMapping :: NEHashMap (Column 'MSSQL) (Column 'MSSQL)
_fkForeignTable :: TableName
_fkConstraint :: Constraint 'MSSQL
..}

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

transformPrimaryKey :: SysPrimaryKey -> PrimaryKey 'MSSQL (Column 'MSSQL)
transformPrimaryKey :: SysPrimaryKey -> PrimaryKey 'MSSQL (Column 'MSSQL)
transformPrimaryKey (SysPrimaryKey {Int
Text
NESeq SysPrimaryKeyColumn
spkColumns :: NESeq SysPrimaryKeyColumn
spkIndexId :: Int
spkName :: Text
spkColumns :: SysPrimaryKey -> NESeq SysPrimaryKeyColumn
spkIndexId :: SysPrimaryKey -> Int
spkName :: SysPrimaryKey -> Text
..}) =
  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 (Column 'MSSQL)
columns = (Text -> Column 'MSSQL
ColumnName (Text -> Column 'MSSQL)
-> (SysPrimaryKeyColumn -> Text)
-> SysPrimaryKeyColumn
-> Column 'MSSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SysPrimaryKeyColumn -> Text
spkcName) (SysPrimaryKeyColumn -> Column 'MSSQL)
-> NESeq SysPrimaryKeyColumn -> NESeq (Column 'MSSQL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NESeq SysPrimaryKeyColumn
spkColumns
   in Constraint 'MSSQL
-> NESeq (Column 'MSSQL) -> PrimaryKey 'MSSQL (Column 'MSSQL)
forall (b :: BackendType) a.
Constraint b -> NESeq a -> PrimaryKey b a
PrimaryKey Constraint 'MSSQL
constraint NESeq (Column 'MSSQL)
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]
HM.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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 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
HM.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
HM.insertWith ForeignKey b -> ForeignKey b -> ForeignKey b
forall (b :: BackendType).
(Eq (Column b), 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.
(Eq k, 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}

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 -> Text -> ScalarType
UnknownType Text
t