2022-04-10 07:47:15 +03:00
|
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
|
|
|
|
module Test.Data
|
2022-06-13 23:58:44 +03:00
|
|
|
( schemaTables,
|
2022-04-10 07:47:15 +03:00
|
|
|
artistsAsJson,
|
|
|
|
artistsAsJsonById,
|
|
|
|
albumsAsJson,
|
|
|
|
sortBy,
|
|
|
|
)
|
|
|
|
where
|
|
|
|
|
2022-06-13 23:58:44 +03:00
|
|
|
import Codec.Compression.GZip qualified as GZip
|
|
|
|
import Control.Lens (ix, (^.), (^..), (^?))
|
|
|
|
import Data.Aeson (Object, Value (..), eitherDecodeStrict)
|
2022-06-08 18:31:28 +03:00
|
|
|
import Data.Aeson.Key qualified as K
|
2022-06-13 23:58:44 +03:00
|
|
|
import Data.Aeson.KeyMap qualified as KM
|
2022-04-10 07:47:15 +03:00
|
|
|
import Data.Aeson.Lens (_Number)
|
|
|
|
import Data.ByteString (ByteString)
|
2022-06-13 23:58:44 +03:00
|
|
|
import Data.ByteString.Lazy qualified as BSL
|
|
|
|
import Data.CaseInsensitive qualified as CI
|
2022-04-10 07:47:15 +03:00
|
|
|
import Data.FileEmbed (embedFile, makeRelativeToProject)
|
|
|
|
import Data.HashMap.Strict (HashMap)
|
|
|
|
import Data.HashMap.Strict qualified as HashMap
|
|
|
|
import Data.List (sortOn)
|
|
|
|
import Data.Maybe (mapMaybe)
|
|
|
|
import Data.Scientific (Scientific)
|
|
|
|
import Data.Text (Text)
|
2022-06-13 23:58:44 +03:00
|
|
|
import Data.Text qualified as Text
|
|
|
|
import Data.Text.Encoding qualified as Text
|
2022-05-02 08:03:12 +03:00
|
|
|
import Hasura.Backends.DataConnector.API (TableInfo (..))
|
2022-06-13 23:58:44 +03:00
|
|
|
import Text.XML qualified as XML
|
|
|
|
import Text.XML.Lens qualified as XML
|
2022-04-10 07:47:15 +03:00
|
|
|
import Prelude
|
|
|
|
|
|
|
|
schemaBS :: ByteString
|
2022-05-02 08:03:12 +03:00
|
|
|
schemaBS = $(makeRelativeToProject "tests-dc-api/Test/Data/schema-tables.json" >>= embedFile)
|
2022-04-10 07:47:15 +03:00
|
|
|
|
|
|
|
schemaTables :: [TableInfo]
|
|
|
|
schemaTables = sortOn dtiName . either error id . eitherDecodeStrict $ schemaBS
|
|
|
|
|
2022-06-13 23:58:44 +03:00
|
|
|
chinookXmlBS :: ByteString
|
|
|
|
chinookXmlBS = $(makeRelativeToProject "tests-dc-api/Test/Data/ChinookData.xml.gz" >>= embedFile)
|
|
|
|
|
|
|
|
chinookXml :: XML.Document
|
|
|
|
chinookXml = XML.parseLBS_ XML.def . GZip.decompress $ BSL.fromStrict chinookXmlBS
|
|
|
|
|
|
|
|
readTableFromXmlIntoJson :: Text -> [Object]
|
|
|
|
readTableFromXmlIntoJson tableName =
|
|
|
|
rowToJsonObject <$> tableRows
|
|
|
|
where
|
|
|
|
tableRows :: [XML.Element]
|
|
|
|
tableRows = chinookXml ^.. XML.root . XML.nodes . traverse . XML._Element . XML.named (CI.mk tableName)
|
|
|
|
|
|
|
|
rowToJsonObject :: XML.Element -> Object
|
|
|
|
rowToJsonObject element =
|
|
|
|
let columnElements = element ^.. XML.nodes . traverse . XML._Element
|
|
|
|
keyValuePairs = columnElementToProperty <$> columnElements
|
|
|
|
in KM.fromList keyValuePairs
|
|
|
|
|
|
|
|
columnElementToProperty :: XML.Element -> (K.Key, Value)
|
|
|
|
columnElementToProperty columnElement =
|
|
|
|
let name = K.fromText $ columnElement ^. XML.localName
|
|
|
|
textValue = Text.concat $ columnElement ^.. XML.text
|
|
|
|
value =
|
|
|
|
case eitherDecodeStrict $ Text.encodeUtf8 textValue of
|
|
|
|
Left _ -> String textValue
|
|
|
|
Right scientific -> Number scientific
|
|
|
|
in (name, value)
|
2022-04-10 07:47:15 +03:00
|
|
|
|
|
|
|
artistsAsJson :: [Object]
|
2022-06-13 23:58:44 +03:00
|
|
|
artistsAsJson = sortBy "ArtistId" $ readTableFromXmlIntoJson "Artist"
|
2022-04-10 07:47:15 +03:00
|
|
|
|
|
|
|
artistsAsJsonById :: HashMap Scientific Object
|
|
|
|
artistsAsJsonById =
|
2022-06-13 23:58:44 +03:00
|
|
|
HashMap.fromList $ mapMaybe (\artist -> (,artist) <$> artist ^? ix "ArtistId" . _Number) artistsAsJson
|
2022-04-10 07:47:15 +03:00
|
|
|
|
|
|
|
albumsAsJson :: [Object]
|
2022-06-13 23:58:44 +03:00
|
|
|
albumsAsJson = sortBy "AlbumId" $ readTableFromXmlIntoJson "Album"
|
2022-04-10 07:47:15 +03:00
|
|
|
|
2022-06-08 18:31:28 +03:00
|
|
|
sortBy :: K.Key -> [Object] -> [Object]
|
2022-04-10 07:47:15 +03:00
|
|
|
sortBy propName = sortOn (^? ix propName)
|