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/Expansion.hs | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) (limited to 'test/Test/Expansion.hs') diff --git a/test/Test/Expansion.hs b/test/Test/Expansion.hs index b5b1e07..0d553a7 100644 --- a/test/Test/Expansion.hs +++ b/test/Test/Expansion.hs @@ -6,10 +6,33 @@ import Test.Tasty import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit -import Data.JLD (expand, toJldErrorCode) +import Data.JLD (JLDExpansionParams (..), JLDVersion (..), expand, toJldErrorCode) +import Data.JLD.Model.URI (parseUri) import Data.Maybe (fromJust) -import Test.Common (W3CTest (..), W3CTestList (..), W3CTestOption (..), fetchTest, parseExpansionOptions) -import Text.URI (mkURI, relativeTo) +import Test.Common (W3CTest (..), W3CTestList (..), W3CTestOption (..), documentLoader, fetchTest) +import Text.URI (URI, mkURI, relativeTo) + +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) expansionTests :: W3CTestList -> TestTree expansionTests testList = testGroup "Expansion" <| uncurry expansionTest <$> zip (w3cSequence testList) [1 ..] -- cgit v1.2.3-54-g00ecf