graphql-engine/server/lib/dc-api/test/Test/Data.hs

706 lines
33 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 = 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
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)