{-# 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 = sortOn API._tiName . 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)) 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, _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 <$> 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, _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 formatTableInfo :: API.TableInfo -> API.TableInfo formatTableInfo = API.tiName %~ formatTableName testConfig >>> API.tiColumns . traverse . API.ciName %~ formatColumnName testConfig >>> API.tiPrimaryKey . traverse %~ formatColumnName testConfig >>> API.tiForeignKeys . API.unForeignKeys . traverse %~ ( API.cForeignTable %~ formatTableName testConfig >>> API.cColumnMapping %~ (HashMap.toList >>> fmap (bimap (formatColumnName testConfig) (formatColumnName testConfig)) >>> HashMap.fromList) ) -- | 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, _ectdColumnInsertSchema :: API.TableName -> Text -> API.ColumnInsertSchema, _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, _ectdColumnInsertSchema = columnInsertSchema schemaResponse testConfig, _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 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' columnInsertSchema :: API.SchemaResponse -> TestConfig -> API.TableName -> Text -> API.ColumnInsertSchema columnInsertSchema schemaResponse testConfig tableName columnName = API.ColumnInsertSchema columnName' scalarType where columnName' = formatColumnName testConfig $ API.ColumnName columnName scalarType = findColumnScalarType 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' findColumnScalarType :: API.SchemaResponse -> API.TableName -> API.ColumnName -> API.ScalarType findColumnScalarType API.SchemaResponse {..} tableName columnName = maybe (error $ "Can't find the scalar type of column " <> show columnName <> " in table " <> show tableName) API._ciType columnInfo where tableInfo = find (\API.TableInfo {..} -> _tiName == tableName) _srTables columnInfo = find (\API.ColumnInfo {..} -> _ciName == columnName) =<< API._tiColumns <$> tableInfo 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)