mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
d54bb30d3b
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6061 Co-authored-by: Vishnu Bharathi <4211715+scriptnull@users.noreply.github.com> GitOrigin-RevId: 855d96378030f4e01b0c74b00e20e592e51e7a49
524 lines
23 KiB
Haskell
524 lines
23 KiB
Haskell
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Test.Data
|
|
( -- = Test Data
|
|
TestData (..),
|
|
mkTestData,
|
|
-- = Utilities
|
|
emptyQuery,
|
|
sortBy,
|
|
filterColumnsByQueryFields,
|
|
filterColumns,
|
|
renameColumns,
|
|
onlyKeepRelationships,
|
|
queryFields,
|
|
responseRows,
|
|
sortResponseRowsBy,
|
|
responseAggregates,
|
|
mkFieldsMap,
|
|
insertField,
|
|
deleteField,
|
|
field,
|
|
_ColumnFieldNumber,
|
|
_ColumnFieldString,
|
|
_ColumnFieldBoolean,
|
|
orderByColumn,
|
|
guardQueryResponse,
|
|
guardedQuery,
|
|
guardErrorResponse,
|
|
guardedCapabilities,
|
|
guardCapabilitiesResponse,
|
|
errorQuery,
|
|
)
|
|
where
|
|
|
|
import Codec.Compression.GZip qualified as GZip
|
|
import Command (NameCasing (..), TestConfig (..))
|
|
import Control.Arrow (first, (>>>))
|
|
import Control.Lens (Index, IxValue, Ixed, Traversal', ix, lens, (%~), (&), (^.), (^..), (^?))
|
|
import Data.Aeson (eitherDecodeStrict)
|
|
import Data.Aeson qualified as J
|
|
import Data.Aeson.Lens (_Bool, _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 (capabilitiesCase, queryCase)
|
|
import Hasura.Backends.DataConnector.API qualified as API
|
|
import Servant.API qualified as Servant
|
|
import Servant.Client ((//))
|
|
import Servant.Client qualified as Servant
|
|
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.NumberTy then Just _ciName else Nothing))
|
|
|
|
chinookXmlBS :: ByteString
|
|
chinookXmlBS = $(makeRelativeToProject "test/Test/Data/ChinookData.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 joinFieldMapping = HashMap.fromList [(API.ColumnName "EmployeeId", API.ColumnName "SupportRepId")]
|
|
in API.TableRelationships
|
|
employeesTableName
|
|
( HashMap.fromList
|
|
[ (supportRepForCustomersRelationshipName, API.Relationship customersTableName API.ArrayRelationship joinFieldMapping)
|
|
]
|
|
)
|
|
|
|
supportRepForCustomersRelationshipName :: API.RelationshipName
|
|
supportRepForCustomersRelationshipName = API.RelationshipName "SupportRepForCustomers"
|
|
|
|
invoicesTableName :: API.TableName
|
|
invoicesTableName = mkTableName "Invoice"
|
|
|
|
invoicesRows :: [HashMap API.FieldName API.FieldValue]
|
|
invoicesRows = sortBy (API.FieldName "InvoiceId") $ readTableFromXmlIntoRows invoicesTableName
|
|
|
|
invoiceLinesTableName :: API.TableName
|
|
invoiceLinesTableName = mkTableName "InvoiceLine"
|
|
|
|
invoiceLinesRows :: [HashMap API.FieldName API.FieldValue]
|
|
invoiceLinesRows = sortBy (API.FieldName "InvoiceLineId") $ readTableFromXmlIntoRows invoiceLinesTableName
|
|
|
|
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
|
|
|
|
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")]
|
|
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)
|
|
]
|
|
)
|
|
|
|
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"
|
|
|
|
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)
|
|
]
|
|
)
|
|
|
|
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,
|
|
-- = Invoices table
|
|
_tdInvoicesTableName :: API.TableName,
|
|
_tdInvoicesRows :: [HashMap API.FieldName API.FieldValue],
|
|
-- = InvoiceLines table
|
|
_tdInvoiceLinesTableName :: API.TableName,
|
|
_tdInvoiceLinesRows :: [HashMap API.FieldName API.FieldValue],
|
|
-- = MediaTypes table
|
|
_tdMediaTypesTableName :: API.TableName,
|
|
_tdMediaTypesRows :: [HashMap API.FieldName API.FieldValue],
|
|
-- = Tracks table
|
|
_tdTracksTableName :: API.TableName,
|
|
_tdTracksRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdTracksTableRelationships :: API.TableRelationships,
|
|
_tdInvoiceLinesRelationshipName :: API.RelationshipName,
|
|
_tdMediaTypeRelationshipName :: API.RelationshipName,
|
|
_tdAlbumRelationshipName :: API.RelationshipName,
|
|
_tdGenreRelationshipName :: API.RelationshipName,
|
|
-- = Genres table
|
|
_tdGenresTableName :: API.TableName,
|
|
_tdGenresRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdGenresTableRelationships :: API.TableRelationships,
|
|
-- = Utility functions
|
|
_tdColumnName :: Text -> API.ColumnName,
|
|
_tdColumnField :: Text -> API.Field,
|
|
_tdQueryComparisonColumn :: Text -> API.ComparisonColumn,
|
|
_tdCurrentComparisonColumn :: Text -> API.ComparisonColumn,
|
|
_tdOrderByColumn :: [API.RelationshipName] -> Text -> API.OrderDirection -> API.OrderByElement
|
|
}
|
|
|
|
mkTestData :: TestConfig -> TestData
|
|
mkTestData TestConfig {..} =
|
|
TestData
|
|
{ _tdSchemaTables = formatTableInfo <$> schemaTables,
|
|
_tdArtistsTableName = formatTableName artistsTableName,
|
|
_tdArtistsRows = artistsRows,
|
|
_tdArtistsRowsById = artistsRowsById,
|
|
_tdArtistsTableRelationships = formatTableRelationships artistsTableRelationships,
|
|
_tdAlbumsRelationshipName = albumsRelationshipName,
|
|
_tdAlbumsTableName = formatTableName albumsTableName,
|
|
_tdAlbumsRows = albumsRows,
|
|
_tdAlbumsRowsById = albumsRowsById,
|
|
_tdAlbumsTableRelationships = formatTableRelationships albumsTableRelationships,
|
|
_tdArtistRelationshipName = artistRelationshipName,
|
|
_tdTracksRelationshipName = tracksRelationshipName,
|
|
_tdCustomersTableName = formatTableName customersTableName,
|
|
_tdCustomersRows = customersRows,
|
|
_tdCustomersTableRelationships = formatTableRelationships customersTableRelationships,
|
|
_tdSupportRepRelationshipName = supportRepRelationshipName,
|
|
_tdEmployeesTableName = formatTableName employeesTableName,
|
|
_tdEmployeesRows = employeesRows,
|
|
_tdEmployeesRowsById = employeesRowsById,
|
|
_tdEmployeesTableRelationships = formatTableRelationships employeesTableRelationships,
|
|
_tdSupportRepForCustomersRelationshipName = supportRepForCustomersRelationshipName,
|
|
_tdInvoicesTableName = formatTableName invoicesTableName,
|
|
_tdInvoicesRows = invoicesRows,
|
|
_tdInvoiceLinesTableName = formatTableName invoiceLinesTableName,
|
|
_tdInvoiceLinesRows = invoiceLinesRows,
|
|
_tdMediaTypesTableName = formatTableName mediaTypesTableName,
|
|
_tdMediaTypesRows = mediaTypesRows,
|
|
_tdTracksTableName = formatTableName tracksTableName,
|
|
_tdTracksRows = tracksRows,
|
|
_tdTracksTableRelationships = formatTableRelationships tracksTableRelationships,
|
|
_tdInvoiceLinesRelationshipName = invoiceLinesRelationshipName,
|
|
_tdMediaTypeRelationshipName = mediaTypeRelationshipName,
|
|
_tdAlbumRelationshipName = albumRelationshipName,
|
|
_tdGenreRelationshipName = genreRelationshipName,
|
|
_tdGenresTableName = formatTableName genresTableName,
|
|
_tdGenresRows = genresRows,
|
|
_tdGenresTableRelationships = formatTableRelationships genresTableRelationships,
|
|
_tdColumnName = API.ColumnName . applyNameCasing _tcColumnNameCasing,
|
|
_tdColumnField = columnField . applyNameCasing _tcColumnNameCasing,
|
|
_tdQueryComparisonColumn = queryComparisonColumn . applyNameCasing _tcColumnNameCasing,
|
|
_tdCurrentComparisonColumn = currentComparisonColumn . applyNameCasing _tcColumnNameCasing,
|
|
_tdOrderByColumn = \targetPath name -> orderByColumn targetPath (applyNameCasing _tcColumnNameCasing name)
|
|
}
|
|
where
|
|
formatTableName :: API.TableName -> API.TableName
|
|
formatTableName = applyTableNamePrefix _tcTableNamePrefix . API.TableName . fmap (applyNameCasing _tcTableNameCasing) . API.unTableName
|
|
|
|
formatTableRelationships :: API.TableRelationships -> API.TableRelationships
|
|
formatTableRelationships =
|
|
prefixTableRelationships
|
|
>>> API.trRelationships . traverse . API.rColumnMapping %~ (HashMap.toList >>> fmap (bimap formatColumnName formatColumnName) >>> HashMap.fromList)
|
|
|
|
formatColumnName :: API.ColumnName -> API.ColumnName
|
|
formatColumnName = API.ColumnName . applyNameCasing _tcColumnNameCasing . API.unColumnName
|
|
|
|
prefixTableRelationships :: API.TableRelationships -> API.TableRelationships
|
|
prefixTableRelationships =
|
|
API.trSourceTable %~ formatTableName
|
|
>>> API.trRelationships . traverse . API.rTargetTable %~ formatTableName
|
|
|
|
formatTableInfo :: API.TableInfo -> API.TableInfo
|
|
formatTableInfo =
|
|
API.tiName %~ formatTableName
|
|
>>> API.tiColumns . traverse . API.ciName %~ formatColumnName
|
|
>>> API.tiPrimaryKey . traverse %~ formatColumnName
|
|
>>> API.tiForeignKeys . lens API.unForeignKeys (const API.ForeignKeys) . traverse
|
|
%~ ( API.cForeignTable %~ formatTableName
|
|
>>> API.cColumnMapping %~ (HashMap.toList >>> fmap (bimap formatColumnName formatColumnName) >>> 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
|
|
|
|
emptyQuery :: API.Query
|
|
emptyQuery = API.Query Nothing Nothing Nothing Nothing Nothing Nothing
|
|
|
|
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)
|
|
|
|
_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
|
|
|
|
columnField :: Text -> API.Field
|
|
columnField = API.ColumnField . API.ColumnName
|
|
|
|
queryComparisonColumn :: Text -> API.ComparisonColumn
|
|
queryComparisonColumn columnName = API.ComparisonColumn API.QueryTable $ API.ColumnName columnName
|
|
|
|
currentComparisonColumn :: Text -> API.ComparisonColumn
|
|
currentComparisonColumn columnName = API.ComparisonColumn API.CurrentTable $ API.ColumnName columnName
|
|
|
|
orderByColumn :: [API.RelationshipName] -> Text -> API.OrderDirection -> API.OrderByElement
|
|
orderByColumn targetPath columnName orderDirection =
|
|
API.OrderByElement targetPath (API.OrderByColumn $ API.ColumnName columnName) orderDirection
|
|
|
|
guardQueryResponse :: Servant.Union API.QueryResponses -> IO API.QueryResponse
|
|
guardQueryResponse = queryCase defaultAction successAction errorAction
|
|
where
|
|
defaultAction = fail "Expected QueryResponse"
|
|
successAction q = pure q
|
|
errorAction e = fail $ "Expected QueryResponse, got " <> show e
|
|
|
|
guardedQuery :: Servant.Client IO (Servant.NamedRoutes API.Routes) -> API.SourceName -> API.Config -> API.QueryRequest -> IO API.QueryResponse
|
|
guardedQuery api sourceName config queryRequest = guardQueryResponse =<< (api // API._query) sourceName config queryRequest
|
|
|
|
guardedCapabilities :: Servant.Client IO (Servant.NamedRoutes API.Routes) -> IO API.CapabilitiesResponse
|
|
guardedCapabilities api = guardCapabilitiesResponse =<< (api // API._capabilities)
|
|
|
|
guardCapabilitiesResponse :: Servant.Union API.CapabilitiesResponses -> IO API.CapabilitiesResponse
|
|
guardCapabilitiesResponse = capabilitiesCase defaultAction successAction errorAction
|
|
where
|
|
defaultAction = fail "Expected QueryResponse"
|
|
successAction c = pure c
|
|
errorAction e = fail $ "Expected QueryResponse, got " <> show e
|
|
|
|
guardErrorResponse :: Servant.Union API.QueryResponses -> IO API.ErrorResponse
|
|
guardErrorResponse = queryCase defaultAction successAction errorAction
|
|
where
|
|
defaultAction = fail "Expected ErrorResponse"
|
|
successAction q = fail $ "Expected ErrorResponse, got " <> show q
|
|
errorAction e = pure e
|
|
|
|
errorQuery :: Servant.Client IO (Servant.NamedRoutes API.Routes) -> API.SourceName -> API.Config -> API.QueryRequest -> IO API.ErrorResponse
|
|
errorQuery api sourceName config queryRequest = guardErrorResponse =<< (api // API._query) sourceName config queryRequest
|