aboutsummaryrefslogtreecommitdiffstats
path: root/test/Test/Flattening.hs
diff options
context:
space:
mode:
Diffstat (limited to 'test/Test/Flattening.hs')
-rw-r--r--test/Test/Flattening.hs36
1 files changed, 31 insertions, 5 deletions
diff --git a/test/Test/Flattening.hs b/test/Test/Flattening.hs
index bc64b88..76f5434 100644
--- a/test/Test/Flattening.hs
+++ b/test/Test/Flattening.hs
@@ -6,10 +6,36 @@ import Test.Tasty
6import Test.Tasty.ExpectedFailure (ignoreTestBecause) 6import Test.Tasty.ExpectedFailure (ignoreTestBecause)
7import Test.Tasty.HUnit 7import Test.Tasty.HUnit
8 8
9import Data.JLD (expand, flatten, toJldErrorCode) 9import Data.JLD (JLDFlatteningParams (..), JLDVersion (..), flatten, toJldErrorCode)
10import Data.JLD.Model.URI (parseUri)
10import Data.Maybe (fromJust) 11import Data.Maybe (fromJust)
11import Test.Common (W3CTest (..), W3CTestList (..), W3CTestOption (..), fetchTest, parseExpansionOptions) 12import Test.Common (W3CTest (..), W3CTestList (..), W3CTestOption (..), documentLoader, fetchTest)
12import Text.URI (mkURI, relativeTo) 13import Text.URI (URI, mkURI, relativeTo)
14
15parseFlatteningOptions :: URI -> URI -> Maybe W3CTestOption -> IO (URI, JLDFlatteningParams () IO -> JLDFlatteningParams Text IO)
16parseFlatteningOptions baseUrl inputUrl maybeOptions = do
17 expandContext <- case maybeOptions >>= w3cTestOptionExpandContext of
18 Just rawUrl -> do
19 url <- fromJust <. (`relativeTo` baseUrl) <$> mkURI rawUrl
20 Just <$> fetchTest url
21 Nothing -> pure Nothing
22
23 let params p =
24 p
25 { jldFlatteningParamsDocumentLoader = documentLoader
26 , jldFlatteningParamsProcessingMode = case maybeOptions >>= w3cTestOptionProcessingMode of
27 Just "json-ld-1.0" -> JLD1_0
28 Just "json-ld-1.1" -> JLD1_1
29 _ -> jldFlatteningParamsProcessingMode p
30 , jldFlatteningParamsExpandContext = expandContext <|> jldFlatteningParamsExpandContext p
31 , jldFlatteningParamsCompactArrays = case maybeOptions >>= w3cTestOptionCompactArrays of
32 Just b -> b
33 _ -> jldFlatteningParamsCompactArrays p
34 }
35
36 pure (expandBaseUrl, params)
37 where
38 expandBaseUrl = fromMaybe inputUrl (parseUri =<< w3cTestOptionBase =<< maybeOptions)
13 39
14flatteningTests :: W3CTestList -> TestTree 40flatteningTests :: W3CTestList -> TestTree
15flatteningTests testList = testGroup "Flattening" <| uncurry flatteningTest <$> zip (w3cSequence testList) [1 ..] 41flatteningTests testList = testGroup "Flattening" <| uncurry flatteningTest <$> zip (w3cSequence testList) [1 ..]
@@ -29,7 +55,7 @@ flatteningTest W3CTest{..} (show .> (<> ". " <> toString w3cTestName) -> testNam
29 inputJld <- fetchTest inputUrl 55 inputJld <- fetchTest inputUrl
30 expectJld <- fetchTest expectUrl 56 expectJld <- fetchTest expectUrl
31 57
32 (expandBaseUrl, params) <- parseExpansionOptions baseUrl inputUrl w3cTestOption 58 (expandBaseUrl, params) <- parseFlatteningOptions baseUrl inputUrl w3cTestOption
33 (result, _) <- flatten inputJld expandBaseUrl params 59 (result, _) <- flatten inputJld expandBaseUrl params
34 60
35 result @?= Right expectJld 61 result @?= Right expectJld
@@ -41,7 +67,7 @@ flatteningTest W3CTest{..} (show .> (<> ". " <> toString w3cTestName) -> testNam
41 67
42 inputJld <- fetchTest inputUrl 68 inputJld <- fetchTest inputUrl
43 69
44 (expandBaseUrl, params) <- parseExpansionOptions baseUrl inputUrl w3cTestOption 70 (expandBaseUrl, params) <- parseFlatteningOptions baseUrl inputUrl w3cTestOption
45 (result, _) <- flatten inputJld expandBaseUrl params 71 (result, _) <- flatten inputJld expandBaseUrl params
46 72
47 (result |> first toJldErrorCode) @?= Left expectErrorRaw 73 (result |> first toJldErrorCode) @?= Left expectErrorRaw