graphql-engine/server/lib/dc-api/test/Test/Data.hs
David Overton 346804fc67 Support nested object fields in DC API and use this to implement nest…
## Description

This change adds support for nested object fields in HGE IR and Schema Cache, the Data Connectors backend and API, and the MongoDB agent.

### Data Connector API changes

- The `/schema` endpoint response now includes an optional set of GraphQL type definitions. Table column types can refer to these definitions by name.
- Queries can now include a new field type `object` which contains a column name and a nested query. This allows querying into a nested object within a field.

### MongoDB agent changes

- Add support for querying into nested documents using the new `object` field type.

### HGE changes

- The `Backend` type class has a new type family `XNestedObjects b` which controls whether or not a backend supports querying into nested objects. This is currently enabled only for the `DataConnector` backend.
- For backends that support nested objects, the `FieldInfo` type gets a new constructor `FINestedObject`, and the `AnnFieldG` type gets a new constructor `AFNestedObject`.
- If the DC `/schema` endpoint returns any custom GraphQL type definitions they are stored in the `TableInfo` for each table in the source.
- During schema cache building, the function `addNonColumnFields` will check whether any column types match custom GraphQL object types stored in the `TableInfo`. If so, they are converted into `FINestedObject` instead of `FIColumn` in the `FieldInfoMap`.
- When building the `FieldParser`s from `FieldInfo` (function `fieldSelection`) any `FINestedObject` fields are converted into nested object parsers returning `AFNestedObject`.
- The `DataConnector` query planner converts `AFNestedObject` fields into `object` field types in the query sent to the agent.

## Limitations

### HGE not yet implemented:
- Support for nested arrays
- Support for nested objects/arrays in mutations
- Support for nested objects/arrays in order-by
- Support for filters (`where`) in nested objects/arrays
- Support for adding custom GraphQL types via track table metadata API
- Support for interface and union types
- Tests for nested objects

### Mongo agent not yet implemented:

- Generate nested object types from validation schema
- Support for aggregates
- Support for order-by
- Configure agent port
- Build agent in CI
- Agent tests for nested objects and MongoDB agent

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7844
GitOrigin-RevId: aec9ec1e4216293286a68f9b1af6f3f5317db423
2023-04-11 01:30:37 +00:00

753 lines
35 KiB
Haskell

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.Data
( -- = Chinook Test Data
TestData (..),
mkTestData,
schemaTables,
allTableRows,
-- = TestingEdgeCases Test Data
EdgeCasesTestData (..),
mkEdgeCasesTestData,
-- = Utilities
emptyQuery,
emptyMutationRequest,
sortBy,
filterColumnsByQueryFields,
filterColumns,
renameColumns,
onlyKeepRelationships,
queryFields,
responseRows,
sortResponseRowsBy,
responseAggregates,
mkFieldsMap,
insertField,
deleteField,
field,
fieldAt,
_ColumnFieldNumber,
_ColumnFieldString,
_ColumnFieldBoolean,
_ColumnFieldNull,
_RelationshipFieldRows,
scalarValueComparison,
orderByColumn,
insertAutoIncPk,
autoIncPks,
mkSubqueryFieldValue,
mkSubqueryRowsFieldValue,
mkSubqueryAggregatesFieldValue,
)
where
import Codec.Compression.GZip qualified as GZip
import Command (NameCasing (..), TestConfig (..))
import Control.Arrow (first, (>>>))
import Control.Lens (At, Index, IxValue, Ixed, Traversal', at, ix, (%~), (&), (?~), (^.), (^..), (^?), _Just)
import Data.Aeson (eitherDecodeStrict)
import Data.Aeson qualified as J
import Data.Aeson.Lens (_Bool, _Null, _Number, _String)
import Data.Bifunctor (bimap)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as BSL
import Data.CaseInsensitive (CI)
import Data.CaseInsensitive qualified as CI
import Data.FileEmbed (embedFile, makeRelativeToProject)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.List (find, sortOn)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Scientific (Scientific)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Hasura.Backends.DataConnector.API qualified as API
import Text.XML qualified as XML
import Text.XML.Lens qualified as XML
import Prelude
schemaBS :: ByteString
schemaBS = $(makeRelativeToProject "test/Test/Data/schema-tables.json" >>= embedFile)
schemaTables :: [API.TableInfo]
schemaTables = either error id . eitherDecodeStrict $ schemaBS
numericColumns :: [API.ColumnName]
numericColumns =
schemaTables
>>= ( API._tiColumns
>>> mapMaybe
( \API.ColumnInfo {..} ->
if _ciType == API.ScalarType "number"
then Just _ciName
else Nothing
)
)
edgeCasesSchemaBS :: ByteString
edgeCasesSchemaBS = $(makeRelativeToProject "test/Test/Data/edge-cases-schema-tables.json" >>= embedFile)
edgeCasesSchemaTables :: [API.TableInfo]
edgeCasesSchemaTables = either error id . eitherDecodeStrict $ edgeCasesSchemaBS
chinookXmlBS :: ByteString
chinookXmlBS = $(makeRelativeToProject "test/Test/Data/Chinook.xml.gz" >>= embedFile)
chinookXml :: XML.Document
chinookXml = XML.parseLBS_ XML.def . GZip.decompress $ BSL.fromStrict chinookXmlBS
readTableFromXmlIntoRows :: API.TableName -> [HashMap API.FieldName API.FieldValue]
readTableFromXmlIntoRows tableName =
rowToJsonObject <$> tableRows
where
tableNameToXmlTag :: API.TableName -> CI Text
tableNameToXmlTag (API.TableName names) = CI.mk . Text.intercalate "_" $ NonEmpty.toList names
tableRows :: [XML.Element]
tableRows = chinookXml ^.. XML.root . XML.nodes . traverse . XML._Element . XML.named (tableNameToXmlTag tableName)
rowToJsonObject :: XML.Element -> HashMap API.FieldName API.FieldValue
rowToJsonObject element =
let columnElements = element ^.. XML.nodes . traverse . XML._Element
keyValuePairs = columnElementToProperty <$> columnElements
in HashMap.fromList keyValuePairs
columnElementToProperty :: XML.Element -> (API.FieldName, API.FieldValue)
columnElementToProperty columnElement =
let name = columnElement ^. XML.localName
value = case columnElement ^. XML.nodes of
[] -> API.mkColumnFieldValue $ J.Null
_ ->
let textValue = Text.concat $ columnElement ^.. XML.text
in if API.ColumnName name `elem` numericColumns
then case eitherDecodeStrict $ Text.encodeUtf8 textValue of
Left _ -> API.mkColumnFieldValue $ J.String textValue
Right scientific -> API.mkColumnFieldValue $ J.Number scientific
else API.mkColumnFieldValue $ J.String textValue
in (API.FieldName name, value)
mkTableName :: Text -> API.TableName
mkTableName = API.TableName . (:| [])
artistsTableName :: API.TableName
artistsTableName = mkTableName "Artist"
artistsRows :: [HashMap API.FieldName API.FieldValue]
artistsRows = sortBy (API.FieldName "ArtistId") $ readTableFromXmlIntoRows artistsTableName
artistsRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
artistsRowsById =
HashMap.fromList $ mapMaybe (\artist -> (,artist) <$> artist ^? field "ArtistId" . _ColumnFieldNumber) artistsRows
albumsRelationshipName :: API.RelationshipName
albumsRelationshipName = API.RelationshipName "Albums"
artistsTableRelationships :: API.TableRelationships
artistsTableRelationships =
let joinFieldMapping = HashMap.fromList [(API.ColumnName "ArtistId", API.ColumnName "ArtistId")]
in API.TableRelationships
artistsTableName
( HashMap.fromList
[ (albumsRelationshipName, API.Relationship albumsTableName API.ArrayRelationship joinFieldMapping)
]
)
albumsTableName :: API.TableName
albumsTableName = mkTableName "Album"
albumsRows :: [HashMap API.FieldName API.FieldValue]
albumsRows = sortBy (API.FieldName "AlbumId") $ readTableFromXmlIntoRows albumsTableName
albumsRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
albumsRowsById =
HashMap.fromList $ mapMaybe (\album -> (,album) <$> album ^? field "AlbumId" . _ColumnFieldNumber) albumsRows
albumsTableRelationships :: API.TableRelationships
albumsTableRelationships =
let artistsJoinFieldMapping = HashMap.fromList [(API.ColumnName "ArtistId", API.ColumnName "ArtistId")]
tracksJoinFieldMapping = HashMap.fromList [(API.ColumnName "AlbumId", API.ColumnName "AlbumId")]
in API.TableRelationships
albumsTableName
( HashMap.fromList
[ (artistRelationshipName, API.Relationship artistsTableName API.ObjectRelationship artistsJoinFieldMapping),
(tracksRelationshipName, API.Relationship tracksTableName API.ArrayRelationship tracksJoinFieldMapping)
]
)
artistRelationshipName :: API.RelationshipName
artistRelationshipName = API.RelationshipName "Artist"
tracksRelationshipName :: API.RelationshipName
tracksRelationshipName = API.RelationshipName "Tracks"
customersTableName :: API.TableName
customersTableName = mkTableName "Customer"
customersRows :: [HashMap API.FieldName API.FieldValue]
customersRows = sortBy (API.FieldName "CustomerId") $ readTableFromXmlIntoRows customersTableName
customersTableRelationships :: API.TableRelationships
customersTableRelationships =
let joinFieldMapping = HashMap.fromList [(API.ColumnName "SupportRepId", API.ColumnName "EmployeeId")]
in API.TableRelationships
customersTableName
( HashMap.fromList
[ (supportRepRelationshipName, API.Relationship employeesTableName API.ObjectRelationship joinFieldMapping)
]
)
supportRepRelationshipName :: API.RelationshipName
supportRepRelationshipName = API.RelationshipName "SupportRep"
employeesTableName :: API.TableName
employeesTableName = mkTableName "Employee"
employeesRows :: [HashMap API.FieldName API.FieldValue]
employeesRows = sortBy (API.FieldName "EmployeeId") $ readTableFromXmlIntoRows employeesTableName
employeesRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
employeesRowsById =
HashMap.fromList $ mapMaybe (\employee -> (,employee) <$> employee ^? field "EmployeeId" . _ColumnFieldNumber) employeesRows
employeesTableRelationships :: API.TableRelationships
employeesTableRelationships =
let supportRepJoinFieldMapping = HashMap.fromList [(API.ColumnName "EmployeeId", API.ColumnName "SupportRepId")]
reportsToEmployeeJoinFieldMapping = HashMap.fromList [(API.ColumnName "ReportsTo", API.ColumnName "EmployeeId")]
in API.TableRelationships
employeesTableName
( HashMap.fromList
[ (supportRepForCustomersRelationshipName, API.Relationship customersTableName API.ArrayRelationship supportRepJoinFieldMapping),
(reportsToEmployeeRelationshipName, API.Relationship employeesTableName API.ObjectRelationship reportsToEmployeeJoinFieldMapping)
]
)
supportRepForCustomersRelationshipName :: API.RelationshipName
supportRepForCustomersRelationshipName = API.RelationshipName "SupportRepForCustomers"
reportsToEmployeeRelationshipName :: API.RelationshipName
reportsToEmployeeRelationshipName = API.RelationshipName "ReportsToEmployee"
invoicesTableName :: API.TableName
invoicesTableName = mkTableName "Invoice"
invoicesRows :: [HashMap API.FieldName API.FieldValue]
invoicesRows = sortBy (API.FieldName "InvoiceId") $ readTableFromXmlIntoRows invoicesTableName
invoicesRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
invoicesRowsById =
HashMap.fromList $ mapMaybe (\invoice -> (,invoice) <$> invoice ^? field "InvoiceId" . _ColumnFieldNumber) invoicesRows
invoicesTableRelationships :: API.TableRelationships
invoicesTableRelationships =
let invoiceLinesJoinFieldMapping = HashMap.fromList [(API.ColumnName "InvoiceId", API.ColumnName "InvoiceId")]
customersJoinFieldMapping = HashMap.fromList [(API.ColumnName "CustomerId", API.ColumnName "CustomerId")]
in API.TableRelationships
invoicesTableName
( HashMap.fromList
[ (invoiceLinesRelationshipName, API.Relationship invoiceLinesTableName API.ArrayRelationship invoiceLinesJoinFieldMapping),
(customerRelationshipName, API.Relationship customersTableName API.ObjectRelationship customersJoinFieldMapping)
]
)
customerRelationshipName :: API.RelationshipName
customerRelationshipName = API.RelationshipName "Customer"
invoiceLinesTableName :: API.TableName
invoiceLinesTableName = mkTableName "InvoiceLine"
invoiceLinesRows :: [HashMap API.FieldName API.FieldValue]
invoiceLinesRows = sortBy (API.FieldName "InvoiceLineId") $ readTableFromXmlIntoRows invoiceLinesTableName
invoiceLinesTableRelationships :: API.TableRelationships
invoiceLinesTableRelationships =
let invoiceJoinFieldMapping = HashMap.fromList [(API.ColumnName "InvoiceId", API.ColumnName "InvoiceId")]
tracksJoinFieldMapping = HashMap.fromList [(API.ColumnName "TrackId", API.ColumnName "TrackId")]
in API.TableRelationships
invoiceLinesTableName
( HashMap.fromList
[ (invoiceRelationshipName, API.Relationship invoicesTableName API.ObjectRelationship invoiceJoinFieldMapping),
(trackRelationshipName, API.Relationship tracksTableName API.ObjectRelationship tracksJoinFieldMapping)
]
)
invoiceRelationshipName :: API.RelationshipName
invoiceRelationshipName = API.RelationshipName "Invoice"
trackRelationshipName :: API.RelationshipName
trackRelationshipName = API.RelationshipName "Track"
mediaTypesTableName :: API.TableName
mediaTypesTableName = mkTableName "MediaType"
mediaTypesRows :: [HashMap API.FieldName API.FieldValue]
mediaTypesRows = sortBy (API.FieldName "MediaTypeId") $ readTableFromXmlIntoRows mediaTypesTableName
tracksTableName :: API.TableName
tracksTableName = mkTableName "Track"
tracksRows :: [HashMap API.FieldName API.FieldValue]
tracksRows = sortBy (API.FieldName "TrackId") $ readTableFromXmlIntoRows tracksTableName
tracksRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
tracksRowsById =
HashMap.fromList $ mapMaybe (\track -> (,track) <$> track ^? field "TrackId" . _ColumnFieldNumber) tracksRows
tracksTableRelationships :: API.TableRelationships
tracksTableRelationships =
let invoiceLinesJoinFieldMapping = HashMap.fromList [(API.ColumnName "TrackId", API.ColumnName "TrackId")]
mediaTypeJoinFieldMapping = HashMap.fromList [(API.ColumnName "MediaTypeId", API.ColumnName "MediaTypeId")]
albumJoinFieldMapping = HashMap.fromList [(API.ColumnName "AlbumId", API.ColumnName "AlbumId")]
genreJoinFieldMapping = HashMap.fromList [(API.ColumnName "GenreId", API.ColumnName "GenreId")]
playlistTracksJoinFieldMapping = HashMap.fromList [(API.ColumnName "TrackId", API.ColumnName "TrackId")]
in API.TableRelationships
tracksTableName
( HashMap.fromList
[ (invoiceLinesRelationshipName, API.Relationship invoiceLinesTableName API.ArrayRelationship invoiceLinesJoinFieldMapping),
(mediaTypeRelationshipName, API.Relationship mediaTypesTableName API.ObjectRelationship mediaTypeJoinFieldMapping),
(albumRelationshipName, API.Relationship albumsTableName API.ObjectRelationship albumJoinFieldMapping),
(genreRelationshipName, API.Relationship genresTableName API.ObjectRelationship genreJoinFieldMapping),
(playlistTracksRelationshipName, API.Relationship playlistTracksTableName API.ArrayRelationship playlistTracksJoinFieldMapping)
]
)
invoiceLinesRelationshipName :: API.RelationshipName
invoiceLinesRelationshipName = API.RelationshipName "InvoiceLines"
mediaTypeRelationshipName :: API.RelationshipName
mediaTypeRelationshipName = API.RelationshipName "MediaType"
albumRelationshipName :: API.RelationshipName
albumRelationshipName = API.RelationshipName "Album"
genreRelationshipName :: API.RelationshipName
genreRelationshipName = API.RelationshipName "Genre"
playlistTracksRelationshipName :: API.RelationshipName
playlistTracksRelationshipName = API.RelationshipName "PlaylistTracks"
genresTableName :: API.TableName
genresTableName = mkTableName "Genre"
genresRows :: [HashMap API.FieldName API.FieldValue]
genresRows = sortBy (API.FieldName "GenreId") $ readTableFromXmlIntoRows genresTableName
genresTableRelationships :: API.TableRelationships
genresTableRelationships =
let joinFieldMapping = HashMap.fromList [(API.ColumnName "GenreId", API.ColumnName "GenreId")]
in API.TableRelationships
genresTableName
( HashMap.fromList
[ (tracksRelationshipName, API.Relationship tracksTableName API.ArrayRelationship joinFieldMapping)
]
)
playlistsTableName :: API.TableName
playlistsTableName = mkTableName "Playlist"
playlistsRows :: [HashMap API.FieldName API.FieldValue]
playlistsRows = sortBy (API.FieldName "PlaylistId") $ readTableFromXmlIntoRows playlistsTableName
playlistTracksTableName :: API.TableName
playlistTracksTableName = mkTableName "PlaylistTrack"
playlistTracksRows :: [HashMap API.FieldName API.FieldValue]
playlistTracksRows = sortOn (\r -> (r ^? ix (API.FieldName "PlaylistId"), r ^? ix (API.FieldName "TrackId"))) $ readTableFromXmlIntoRows playlistTracksTableName
allTableRows :: HashMap API.TableName ([HashMap API.FieldName API.FieldValue])
allTableRows =
HashMap.fromList
[ (artistsTableName, artistsRows),
(albumsTableName, albumsRows),
(customersTableName, customersRows),
(employeesTableName, employeesRows),
(genresTableName, genresRows),
(invoicesTableName, invoicesRows),
(invoiceLinesTableName, invoiceLinesRows),
(mediaTypesTableName, mediaTypesRows),
(playlistsTableName, playlistsRows),
(playlistTracksTableName, playlistTracksRows),
(tracksTableName, tracksRows)
]
data TestData = TestData
{ -- = Schema
_tdSchemaTables :: [API.TableInfo],
-- = Artists table
_tdArtistsTableName :: API.TableName,
_tdArtistsRows :: [HashMap API.FieldName API.FieldValue],
_tdArtistsRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
_tdArtistsTableRelationships :: API.TableRelationships,
_tdAlbumsRelationshipName :: API.RelationshipName,
-- = Albums table
_tdAlbumsTableName :: API.TableName,
_tdAlbumsRows :: [HashMap API.FieldName API.FieldValue],
_tdAlbumsRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
_tdAlbumsTableRelationships :: API.TableRelationships,
_tdArtistRelationshipName :: API.RelationshipName,
_tdTracksRelationshipName :: API.RelationshipName,
-- = Customers table
_tdCustomersTableName :: API.TableName,
_tdCustomersRows :: [HashMap API.FieldName API.FieldValue],
_tdCustomersTableRelationships :: API.TableRelationships,
_tdSupportRepRelationshipName :: API.RelationshipName,
-- = Employees table
_tdEmployeesTableName :: API.TableName,
_tdEmployeesRows :: [HashMap API.FieldName API.FieldValue],
_tdEmployeesRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
_tdEmployeesTableRelationships :: API.TableRelationships,
_tdSupportRepForCustomersRelationshipName :: API.RelationshipName,
_tdReportsToEmployeeRelationshipName :: API.RelationshipName,
-- = Invoices table
_tdInvoicesTableName :: API.TableName,
_tdInvoicesRows :: [HashMap API.FieldName API.FieldValue],
_tdInvoicesRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
_tdInvoicesTableRelationships :: API.TableRelationships,
_tdCustomerRelationshipName :: API.RelationshipName,
-- = InvoiceLines table
_tdInvoiceLinesTableName :: API.TableName,
_tdInvoiceLinesRows :: [HashMap API.FieldName API.FieldValue],
_tdInvoiceLinesTableRelationships :: API.TableRelationships,
_tdInvoiceRelationshipName :: API.RelationshipName,
_tdTrackRelationshipName :: API.RelationshipName,
-- = MediaTypes table
_tdMediaTypesTableName :: API.TableName,
_tdMediaTypesRows :: [HashMap API.FieldName API.FieldValue],
-- = Tracks table
_tdTracksTableName :: API.TableName,
_tdTracksRows :: [HashMap API.FieldName API.FieldValue],
_tdTracksRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
_tdTracksTableRelationships :: API.TableRelationships,
_tdInvoiceLinesRelationshipName :: API.RelationshipName,
_tdMediaTypeRelationshipName :: API.RelationshipName,
_tdAlbumRelationshipName :: API.RelationshipName,
_tdGenreRelationshipName :: API.RelationshipName,
_tdPlaylistTracksRelationshipName :: API.RelationshipName,
-- = PlaylistTracks table
_tdPlaylistTracksTableName :: API.TableName,
_tdPlaylistTracksRows :: [HashMap API.FieldName API.FieldValue],
-- = Genres table
_tdGenresTableName :: API.TableName,
_tdGenresRows :: [HashMap API.FieldName API.FieldValue],
_tdGenresTableRelationships :: API.TableRelationships,
-- = Scalar Types
_tdFindColumnScalarType :: API.TableName -> Text -> API.ScalarType,
-- = Utility functions
_tdColumnName :: Text -> API.ColumnName,
_tdColumnField :: API.TableName -> Text -> API.Field,
_tdMkDefaultTableInsertSchema :: API.TableName -> API.TableInsertSchema,
_tdColumnInsertSchema :: API.TableName -> Text -> API.ColumnInsertSchema,
_tdRowColumnOperatorValue :: API.TableName -> Text -> J.Value -> API.RowColumnOperatorValue,
_tdQueryComparisonColumn :: Text -> API.ScalarType -> API.ComparisonColumn,
_tdCurrentComparisonColumn :: Text -> API.ScalarType -> API.ComparisonColumn,
_tdOrderByColumn :: [API.RelationshipName] -> Text -> API.OrderDirection -> API.OrderByElement
}
-- | Test data from the Chinook dataset template
mkTestData :: API.SchemaResponse -> TestConfig -> TestData
mkTestData schemaResponse testConfig =
TestData
{ _tdSchemaTables = formatTableInfo testConfig <$> schemaTables,
_tdArtistsTableName = formatTableName testConfig artistsTableName,
_tdArtistsRows = artistsRows,
_tdArtistsRowsById = artistsRowsById,
_tdArtistsTableRelationships = formatTableRelationships artistsTableRelationships,
_tdAlbumsRelationshipName = albumsRelationshipName,
_tdAlbumsTableName = formatTableName testConfig albumsTableName,
_tdAlbumsRows = albumsRows,
_tdAlbumsRowsById = albumsRowsById,
_tdAlbumsTableRelationships = formatTableRelationships albumsTableRelationships,
_tdArtistRelationshipName = artistRelationshipName,
_tdTracksRelationshipName = tracksRelationshipName,
_tdCustomersTableName = formatTableName testConfig customersTableName,
_tdCustomersRows = customersRows,
_tdCustomersTableRelationships = formatTableRelationships customersTableRelationships,
_tdSupportRepRelationshipName = supportRepRelationshipName,
_tdEmployeesTableName = formatTableName testConfig employeesTableName,
_tdEmployeesRows = employeesRows,
_tdEmployeesRowsById = employeesRowsById,
_tdEmployeesTableRelationships = formatTableRelationships employeesTableRelationships,
_tdSupportRepForCustomersRelationshipName = supportRepForCustomersRelationshipName,
_tdReportsToEmployeeRelationshipName = reportsToEmployeeRelationshipName,
_tdInvoicesTableName = formatTableName testConfig invoicesTableName,
_tdInvoicesRows = invoicesRows,
_tdInvoicesRowsById = invoicesRowsById,
_tdInvoicesTableRelationships = formatTableRelationships invoicesTableRelationships,
_tdCustomerRelationshipName = customerRelationshipName,
_tdInvoiceLinesTableName = formatTableName testConfig invoiceLinesTableName,
_tdInvoiceLinesRows = invoiceLinesRows,
_tdInvoiceLinesTableRelationships = formatTableRelationships invoiceLinesTableRelationships,
_tdInvoiceRelationshipName = invoiceRelationshipName,
_tdTrackRelationshipName = trackRelationshipName,
_tdMediaTypesTableName = formatTableName testConfig mediaTypesTableName,
_tdMediaTypesRows = mediaTypesRows,
_tdTracksTableName = formatTableName testConfig tracksTableName,
_tdTracksRows = tracksRows,
_tdTracksRowsById = tracksRowsById,
_tdTracksTableRelationships = formatTableRelationships tracksTableRelationships,
_tdInvoiceLinesRelationshipName = invoiceLinesRelationshipName,
_tdMediaTypeRelationshipName = mediaTypeRelationshipName,
_tdAlbumRelationshipName = albumRelationshipName,
_tdGenreRelationshipName = genreRelationshipName,
_tdPlaylistTracksRelationshipName = playlistTracksRelationshipName,
_tdPlaylistTracksTableName = formatTableName testConfig playlistTracksTableName,
_tdPlaylistTracksRows = playlistTracksRows,
_tdGenresTableName = formatTableName testConfig genresTableName,
_tdGenresRows = genresRows,
_tdGenresTableRelationships = formatTableRelationships genresTableRelationships,
_tdColumnName = formatColumnName testConfig . API.ColumnName,
_tdColumnField = columnField schemaResponse testConfig,
_tdMkDefaultTableInsertSchema = mkDefaultTableInsertSchema schemaResponse testConfig schemaTables,
_tdColumnInsertSchema = columnInsertSchema schemaResponse testConfig,
_tdRowColumnOperatorValue = rowColumnOperatorValue schemaResponse testConfig,
_tdFindColumnScalarType = \tableName name -> findColumnScalarType schemaResponse tableName (formatColumnName testConfig $ API.ColumnName name),
_tdQueryComparisonColumn = API.ComparisonColumn API.QueryTable . formatColumnName testConfig . API.ColumnName,
_tdCurrentComparisonColumn = API.ComparisonColumn API.CurrentTable . formatColumnName testConfig . API.ColumnName,
_tdOrderByColumn = \targetPath name -> orderByColumn targetPath (formatColumnName testConfig $ API.ColumnName name)
}
where
formatTableRelationships :: API.TableRelationships -> API.TableRelationships
formatTableRelationships =
prefixTableRelationships
>>> API.trRelationships . traverse . API.rColumnMapping %~ (HashMap.toList >>> fmap (bimap (formatColumnName testConfig) (formatColumnName testConfig)) >>> HashMap.fromList)
prefixTableRelationships :: API.TableRelationships -> API.TableRelationships
prefixTableRelationships =
API.trSourceTable %~ formatTableName testConfig
>>> API.trRelationships . traverse . API.rTargetTable %~ formatTableName testConfig
-- | Test data from the TestingEdgeCases dataset template
data EdgeCasesTestData = EdgeCasesTestData
{ -- = NoPrimaryKey table
_ectdNoPrimaryKeyTableName :: API.TableName,
-- = DefaultedPrimaryKey table
_ectdDefaultedPrimaryKeyTableName :: API.TableName,
-- = AllColumnsDefaultable table
_ectdAllColumnsDefaultableTableName :: API.TableName,
-- = Scalar Types
_ectdFindColumnScalarType :: API.TableName -> Text -> API.ScalarType,
-- = Utility functions
_ectdTableExists :: API.TableName -> Bool,
_ectdColumnField :: API.TableName -> Text -> API.Field,
_ectdMkDefaultTableInsertSchema :: API.TableName -> API.TableInsertSchema,
_ectdRowColumnOperatorValue :: API.TableName -> Text -> J.Value -> API.RowColumnOperatorValue,
_ectdCurrentComparisonColumn :: Text -> API.ScalarType -> API.ComparisonColumn
}
mkEdgeCasesTestData :: TestConfig -> API.SchemaResponse -> EdgeCasesTestData
mkEdgeCasesTestData testConfig schemaResponse =
EdgeCasesTestData
{ _ectdNoPrimaryKeyTableName = noPrimaryKeyTableName,
_ectdDefaultedPrimaryKeyTableName = defaultedPrimaryKeyTableName,
_ectdAllColumnsDefaultableTableName = allColumnsDefaultableTableName,
_ectdFindColumnScalarType = \tableName name -> findColumnScalarType schemaResponse tableName (formatColumnName testConfig $ API.ColumnName name),
_ectdTableExists = tableExists,
_ectdColumnField = columnField schemaResponse testConfig,
_ectdMkDefaultTableInsertSchema = mkDefaultTableInsertSchema schemaResponse testConfig edgeCasesSchemaTables,
_ectdRowColumnOperatorValue = rowColumnOperatorValue schemaResponse testConfig,
_ectdCurrentComparisonColumn = API.ComparisonColumn API.CurrentTable . formatColumnName testConfig . API.ColumnName
}
where
tableExists :: API.TableName -> Bool
tableExists tableName = tableName `elem` (API._tiName <$> API._srTables schemaResponse)
noPrimaryKeyTableName = formatTableName testConfig (API.TableName $ "NoPrimaryKey" :| [])
defaultedPrimaryKeyTableName = formatTableName testConfig (API.TableName $ "DefaultedPrimaryKey" :| [])
allColumnsDefaultableTableName = formatTableName testConfig (API.TableName $ "AllColumnsDefaultable" :| [])
formatTableName :: TestConfig -> API.TableName -> API.TableName
formatTableName TestConfig {..} = applyTableNamePrefix _tcTableNamePrefix . API.TableName . fmap (applyNameCasing _tcTableNameCasing) . API.unTableName
formatTableInfo :: TestConfig -> API.TableInfo -> API.TableInfo
formatTableInfo testConfig =
API.tiName %~ formatTableName testConfig
>>> API.tiColumns . traverse . API.ciName %~ formatColumnName testConfig
>>> API.tiPrimaryKey . _Just . traverse %~ formatColumnName testConfig
>>> API.tiForeignKeys . API.unForeignKeys . traverse
%~ ( API.cForeignTable %~ formatTableName testConfig
>>> API.cColumnMapping %~ (HashMap.toList >>> fmap (bimap (formatColumnName testConfig) (formatColumnName testConfig)) >>> HashMap.fromList)
)
applyTableNamePrefix :: [Text] -> API.TableName -> API.TableName
applyTableNamePrefix prefix tableName@(API.TableName rawTableName) =
case NonEmpty.nonEmpty prefix of
Just prefix' -> API.TableName (prefix' <> rawTableName)
Nothing -> tableName
applyNameCasing :: NameCasing -> Text -> Text
applyNameCasing casing text = case casing of
PascalCase -> text
Lowercase -> Text.toLower text
Uppercase -> Text.toUpper text
formatColumnName :: TestConfig -> API.ColumnName -> API.ColumnName
formatColumnName TestConfig {..} = API.ColumnName . applyNameCasing _tcColumnNameCasing . API.unColumnName
columnField :: API.SchemaResponse -> TestConfig -> API.TableName -> Text -> API.Field
columnField schemaResponse testConfig tableName columnName =
API.ColumnField columnName' scalarType
where
columnName' = formatColumnName testConfig $ API.ColumnName columnName
scalarType = findColumnScalarType schemaResponse tableName columnName'
mkDefaultTableInsertSchema :: API.SchemaResponse -> TestConfig -> [API.TableInfo] -> API.TableName -> API.TableInsertSchema
mkDefaultTableInsertSchema schemaResponse testConfig expectedSchemaTables tableName =
API.TableInsertSchema
{ _tisTable = tableName,
_tisPrimaryKey = fmap (formatColumnName testConfig) <$> API._tiPrimaryKey tableInfo,
_tisFields = mkFieldsMap insertFields
}
where
tableInfo =
expectedSchemaTables
& find (\API.TableInfo {..} -> formatTableName testConfig _tiName == tableName)
& fromMaybe (error $ "Can't find table " <> show tableName <> " in schema")
columnNames =
tableInfo
& API._tiColumns
& fmap API._ciName
insertFields =
columnNames
& fmap
( \columnName ->
let formattedColumnName = formatColumnName testConfig columnName
API.ColumnInfo {..} = findColumnInfo schemaResponse tableName formattedColumnName
columnNameText = API.unColumnName columnName
in (columnNameText, API.ColumnInsert $ API.ColumnInsertSchema _ciName _ciType _ciNullable _ciValueGenerated)
)
columnInsertSchema :: API.SchemaResponse -> TestConfig -> API.TableName -> Text -> API.ColumnInsertSchema
columnInsertSchema schemaResponse testConfig tableName columnName =
API.ColumnInsertSchema columnName' (API._ciType columnInfo) (API._ciNullable columnInfo) (API._ciValueGenerated columnInfo)
where
columnName' = formatColumnName testConfig $ API.ColumnName columnName
columnInfo = findColumnInfo schemaResponse tableName columnName'
rowColumnOperatorValue :: API.SchemaResponse -> TestConfig -> API.TableName -> Text -> J.Value -> API.RowColumnOperatorValue
rowColumnOperatorValue schemaResponse testConfig tableName columnName value =
API.RowColumnOperatorValue columnName' value scalarType
where
columnName' = formatColumnName testConfig $ API.ColumnName columnName
scalarType = findColumnScalarType schemaResponse tableName columnName'
findColumnInfo :: API.SchemaResponse -> API.TableName -> API.ColumnName -> API.ColumnInfo
findColumnInfo API.SchemaResponse {..} tableName columnName =
fromMaybe (error $ "Can't find the scalar type of column " <> show columnName <> " in table " <> show tableName) columnInfo
where
tableInfo = find (\API.TableInfo {..} -> _tiName == tableName) _srTables
columnInfo = find (\API.ColumnInfo {..} -> _ciName == columnName) =<< API._tiColumns <$> tableInfo
findColumnScalarType :: API.SchemaResponse -> API.TableName -> API.ColumnName -> API.ScalarType
findColumnScalarType schemaResponse tableName columnName =
API._ciType $ findColumnInfo schemaResponse tableName columnName
emptyQuery :: API.Query
emptyQuery = API.Query Nothing Nothing Nothing Nothing Nothing Nothing Nothing
emptyMutationRequest :: API.MutationRequest
emptyMutationRequest = API.MutationRequest mempty mempty mempty
sortBy :: (Ixed m, Ord (IxValue m)) => Index m -> [m] -> [m]
sortBy propName = sortOn (^? ix propName)
filterColumnsByQueryFields :: API.Query -> HashMap API.FieldName API.FieldValue -> HashMap API.FieldName API.FieldValue
filterColumnsByQueryFields query =
HashMap.filterWithKey (\key _value -> key `elem` columns)
where
columns = HashMap.keys $ queryFields query
filterColumns :: [Text] -> [HashMap API.FieldName API.FieldValue] -> [HashMap API.FieldName API.FieldValue]
filterColumns columns =
fmap (HashMap.filterWithKey (\key _value -> key `elem` columns'))
where
columns' = API.FieldName <$> columns
renameColumns :: [(Text, Text)] -> [HashMap API.FieldName API.FieldValue] -> [HashMap API.FieldName API.FieldValue]
renameColumns columns =
fmap (HashMap.fromList . fmap rename . HashMap.toList)
where
columns' = bimap API.FieldName API.FieldName <$> columns
rename original@(key, value) =
case find (\(k, _) -> k == key) columns' of
Just (_, renamedKey) -> (renamedKey, value)
Nothing -> original
onlyKeepRelationships :: [API.RelationshipName] -> API.TableRelationships -> API.TableRelationships
onlyKeepRelationships names tableRels =
tableRels & API.trRelationships %~ HashMap.filterWithKey (\relName _ -> relName `elem` names)
queryFields :: API.Query -> HashMap API.FieldName API.Field
queryFields = fromMaybe mempty . API._qFields
responseRows :: API.QueryResponse -> [HashMap API.FieldName API.FieldValue]
responseRows = fromMaybe [] . API._qrRows
sortResponseRowsBy :: Text -> API.QueryResponse -> API.QueryResponse
sortResponseRowsBy columnName response = response & API.qrRows %~ (fmap (sortBy (API.FieldName columnName)))
responseAggregates :: API.QueryResponse -> HashMap API.FieldName J.Value
responseAggregates = fromMaybe mempty . API._qrAggregates
mkFieldsMap :: [(Text, v)] -> HashMap API.FieldName v
mkFieldsMap = HashMap.fromList . fmap (first API.FieldName)
insertField :: Text -> v -> HashMap API.FieldName v -> HashMap API.FieldName v
insertField fieldName = HashMap.insert (API.FieldName fieldName)
deleteField :: Text -> HashMap API.FieldName v -> HashMap API.FieldName v
deleteField fieldName = HashMap.delete (API.FieldName fieldName)
field :: (Ixed m, Index m ~ API.FieldName) => Text -> Traversal' m (IxValue m)
field fieldName = ix (API.FieldName fieldName)
fieldAt :: (At m, Index m ~ API.FieldName) => Text -> Traversal' m (Maybe (IxValue m))
fieldAt fieldName = at (API.FieldName fieldName)
_ColumnFieldNumber :: Traversal' API.FieldValue Scientific
_ColumnFieldNumber = API._ColumnFieldValue . _Number
_ColumnFieldString :: Traversal' API.FieldValue Text
_ColumnFieldString = API._ColumnFieldValue . _String
_ColumnFieldBoolean :: Traversal' API.FieldValue Bool
_ColumnFieldBoolean = API._ColumnFieldValue . _Bool
_ColumnFieldNull :: Traversal' API.FieldValue ()
_ColumnFieldNull = API._ColumnFieldValue . _Null
_RelationshipFieldRows :: Traversal' API.FieldValue [HashMap API.FieldName API.FieldValue]
_RelationshipFieldRows = API._RelationshipFieldValue . API.qrRows . _Just
scalarValueComparison :: J.Value -> API.ScalarType -> API.ComparisonValue
scalarValueComparison value valueType = API.ScalarValueComparison $ API.ScalarValue value valueType
orderByColumn :: [API.RelationshipName] -> API.ColumnName -> API.OrderDirection -> API.OrderByElement
orderByColumn targetPath columnName orderDirection =
API.OrderByElement targetPath (API.OrderByColumn columnName) orderDirection
insertAutoIncPk :: Text -> Integer -> [HashMap API.FieldName API.FieldValue] -> [HashMap API.FieldName API.FieldValue]
insertAutoIncPk pkFieldName startingPkId rows =
zip [startingPkId ..] rows
& fmap
( \(albumId, albumRow) ->
albumRow & at (API.FieldName pkFieldName) ?~ API.mkColumnFieldValue (J.Number $ fromInteger albumId)
)
autoIncPks :: Integer -> [a] -> [Integer]
autoIncPks startingPkId rows = fst <$> zip [startingPkId ..] rows
mkSubqueryFieldValue :: Maybe [HashMap API.FieldName API.FieldValue] -> Maybe (HashMap API.FieldName J.Value) -> API.FieldValue
mkSubqueryFieldValue rows aggregates =
API.mkRelationshipFieldValue $ API.QueryResponse rows aggregates
mkSubqueryRowsFieldValue :: [HashMap API.FieldName API.FieldValue] -> API.FieldValue
mkSubqueryRowsFieldValue rows =
API.mkRelationshipFieldValue $ API.QueryResponse (Just rows) Nothing
mkSubqueryAggregatesFieldValue :: HashMap API.FieldName J.Value -> API.FieldValue
mkSubqueryAggregatesFieldValue aggregates =
API.mkRelationshipFieldValue $ API.QueryResponse Nothing (Just aggregates)