diff options
Diffstat (limited to 'test/Test/Flattening.hs')
| -rw-r--r-- | test/Test/Flattening.hs | 36 |
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 | |||
| 6 | import Test.Tasty.ExpectedFailure (ignoreTestBecause) | 6 | import Test.Tasty.ExpectedFailure (ignoreTestBecause) |
| 7 | import Test.Tasty.HUnit | 7 | import Test.Tasty.HUnit |
| 8 | 8 | ||
| 9 | import Data.JLD (expand, flatten, toJldErrorCode) | 9 | import Data.JLD (JLDFlatteningParams (..), JLDVersion (..), flatten, toJldErrorCode) |
| 10 | import Data.JLD.Model.URI (parseUri) | ||
| 10 | import Data.Maybe (fromJust) | 11 | import Data.Maybe (fromJust) |
| 11 | import Test.Common (W3CTest (..), W3CTestList (..), W3CTestOption (..), fetchTest, parseExpansionOptions) | 12 | import Test.Common (W3CTest (..), W3CTestList (..), W3CTestOption (..), documentLoader, fetchTest) |
| 12 | import Text.URI (mkURI, relativeTo) | 13 | import Text.URI (URI, mkURI, relativeTo) |
| 14 | |||
| 15 | parseFlatteningOptions :: URI -> URI -> Maybe W3CTestOption -> IO (URI, JLDFlatteningParams () IO -> JLDFlatteningParams Text IO) | ||
| 16 | parseFlatteningOptions 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 | ||
| 14 | flatteningTests :: W3CTestList -> TestTree | 40 | flatteningTests :: W3CTestList -> TestTree |
| 15 | flatteningTests testList = testGroup "Flattening" <| uncurry flatteningTest <$> zip (w3cSequence testList) [1 ..] | 41 | flatteningTests 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 |
