From b2c846b0daf9d6e26e1e2a07fecc848b4732baa0 Mon Sep 17 00:00:00 2001 From: Volpeon Date: Sun, 28 May 2023 10:18:49 +0200 Subject: Fixed flattening errors --- test/Test/Common.hs | 35 +++++------------------------------ 1 file changed, 5 insertions(+), 30 deletions(-) (limited to 'test/Test/Common.hs') diff --git a/test/Test/Common.hs b/test/Test/Common.hs index ffc3264..e386551 100644 --- a/test/Test/Common.hs +++ b/test/Test/Common.hs @@ -1,24 +1,20 @@ -module Test.Common (W3CTestList (..), W3CTest (..), W3CTestOption (..), fetchTest, parseExpansionOptions) where +module Test.Common (W3CTestList (..), W3CTest (..), W3CTestOption (..), documentLoader, fetchTest) where import Data.JLD.Prelude -import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTestBecause) -import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) - import Data.Aeson (FromJSON (..), Value (..), (.:), (.:?)) import Data.Aeson.Types (prependFailure, typeMismatch) -import Data.JLD (DocumentLoader (..), JLDExpansionParams (..), JLDVersion (..), mimeType, toJldErrorCode) -import Data.JLD.Model.URI (parseUri) +import Data.JLD (DocumentLoader (..), mimeType) import Data.Maybe (fromJust) import Network.HTTP.Req (GET (..), NoReqBody (..), defaultHttpConfig, header, jsonResponse, req, responseBody, runReq, useHttpsURI, useURI) -import Text.URI (URI, mkURI, relativeTo) +import Text.URI (URI) data W3CTestOption = W3CTestOption { w3cTestOptionSpecVersion :: Maybe Text , w3cTestOptionProcessingMode :: Maybe Text , w3cTestOptionBase :: Maybe Text , w3cTestOptionExpandContext :: Maybe Text + , w3cTestOptionCompactArrays :: Maybe Bool } deriving (Show) @@ -29,6 +25,7 @@ instance FromJSON W3CTestOption where <*> (v .:? "processingMode") <*> (v .:? "base") <*> (v .:? "expandContext") + <*> (v .:? "compactArrays") parseJSON invalid = prependFailure "parsing W3CTestOption failed, " (typeMismatch "Object" invalid) data W3CTest = W3CTest @@ -72,25 +69,3 @@ fetchTest url = do runReq defaultHttpConfig do res <- req GET reqUrl NoReqBody jsonResponse (reqOptions <> header "Accept" mimeType) pure <| responseBody res - -parseExpansionOptions :: URI -> URI -> Maybe W3CTestOption -> IO (URI, JLDExpansionParams () IO -> JLDExpansionParams Text IO) -parseExpansionOptions baseUrl inputUrl maybeOptions = do - expandContext <- case maybeOptions >>= w3cTestOptionExpandContext of - Just rawUrl -> do - url <- fromJust <. (`relativeTo` baseUrl) <$> mkURI rawUrl - Just <$> fetchTest url - Nothing -> pure Nothing - - let params p = - p - { jldExpansionParamsDocumentLoader = documentLoader - , jldExpansionParamsProcessingMode = case maybeOptions >>= w3cTestOptionProcessingMode of - Just "json-ld-1.0" -> JLD1_0 - Just "json-ld-1.1" -> JLD1_1 - _ -> jldExpansionParamsProcessingMode p - , jldExpansionParamsExpandContext = expandContext <|> jldExpansionParamsExpandContext p - } - - pure (expandBaseUrl, params) - where - expandBaseUrl = fromMaybe inputUrl (parseUri =<< w3cTestOptionBase =<< maybeOptions) -- cgit v1.2.3-70-g09d2