aboutsummaryrefslogtreecommitdiffstats
path: root/test/Test
diff options
context:
space:
mode:
Diffstat (limited to 'test/Test')
-rw-r--r--test/Test/Common.hs35
-rw-r--r--test/Test/Expansion.hs29
-rw-r--r--test/Test/Flattening.hs36
3 files changed, 62 insertions, 38 deletions
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 @@
1module Test.Common (W3CTestList (..), W3CTest (..), W3CTestOption (..), fetchTest, parseExpansionOptions) where 1module Test.Common (W3CTestList (..), W3CTest (..), W3CTestOption (..), documentLoader, fetchTest) where
2 2
3import Data.JLD.Prelude 3import Data.JLD.Prelude
4 4
5import Test.Tasty
6import Test.Tasty.ExpectedFailure (ignoreTestBecause)
7import Test.Tasty.HUnit (assertFailure, testCase, (@?=))
8
9import Data.Aeson (FromJSON (..), Value (..), (.:), (.:?)) 5import Data.Aeson (FromJSON (..), Value (..), (.:), (.:?))
10import Data.Aeson.Types (prependFailure, typeMismatch) 6import Data.Aeson.Types (prependFailure, typeMismatch)
11import Data.JLD (DocumentLoader (..), JLDExpansionParams (..), JLDVersion (..), mimeType, toJldErrorCode) 7import Data.JLD (DocumentLoader (..), mimeType)
12import Data.JLD.Model.URI (parseUri)
13import Data.Maybe (fromJust) 8import Data.Maybe (fromJust)
14import Network.HTTP.Req (GET (..), NoReqBody (..), defaultHttpConfig, header, jsonResponse, req, responseBody, runReq, useHttpsURI, useURI) 9import Network.HTTP.Req (GET (..), NoReqBody (..), defaultHttpConfig, header, jsonResponse, req, responseBody, runReq, useHttpsURI, useURI)
15import Text.URI (URI, mkURI, relativeTo) 10import Text.URI (URI)
16 11
17data W3CTestOption = W3CTestOption 12data W3CTestOption = W3CTestOption
18 { w3cTestOptionSpecVersion :: Maybe Text 13 { w3cTestOptionSpecVersion :: Maybe Text
19 , w3cTestOptionProcessingMode :: Maybe Text 14 , w3cTestOptionProcessingMode :: Maybe Text
20 , w3cTestOptionBase :: Maybe Text 15 , w3cTestOptionBase :: Maybe Text
21 , w3cTestOptionExpandContext :: Maybe Text 16 , w3cTestOptionExpandContext :: Maybe Text
17 , w3cTestOptionCompactArrays :: Maybe Bool
22 } 18 }
23 deriving (Show) 19 deriving (Show)
24 20
@@ -29,6 +25,7 @@ instance FromJSON W3CTestOption where
29 <*> (v .:? "processingMode") 25 <*> (v .:? "processingMode")
30 <*> (v .:? "base") 26 <*> (v .:? "base")
31 <*> (v .:? "expandContext") 27 <*> (v .:? "expandContext")
28 <*> (v .:? "compactArrays")
32 parseJSON invalid = prependFailure "parsing W3CTestOption failed, " (typeMismatch "Object" invalid) 29 parseJSON invalid = prependFailure "parsing W3CTestOption failed, " (typeMismatch "Object" invalid)
33 30
34data W3CTest = W3CTest 31data W3CTest = W3CTest
@@ -72,25 +69,3 @@ fetchTest url = do
72 runReq defaultHttpConfig do 69 runReq defaultHttpConfig do
73 res <- req GET reqUrl NoReqBody jsonResponse (reqOptions <> header "Accept" mimeType) 70 res <- req GET reqUrl NoReqBody jsonResponse (reqOptions <> header "Accept" mimeType)
74 pure <| responseBody res 71 pure <| responseBody res
75
76parseExpansionOptions :: URI -> URI -> Maybe W3CTestOption -> IO (URI, JLDExpansionParams () IO -> JLDExpansionParams Text IO)
77parseExpansionOptions baseUrl inputUrl maybeOptions = do
78 expandContext <- case maybeOptions >>= w3cTestOptionExpandContext of
79 Just rawUrl -> do
80 url <- fromJust <. (`relativeTo` baseUrl) <$> mkURI rawUrl
81 Just <$> fetchTest url
82 Nothing -> pure Nothing
83
84 let params p =
85 p
86 { jldExpansionParamsDocumentLoader = documentLoader
87 , jldExpansionParamsProcessingMode = case maybeOptions >>= w3cTestOptionProcessingMode of
88 Just "json-ld-1.0" -> JLD1_0
89 Just "json-ld-1.1" -> JLD1_1
90 _ -> jldExpansionParamsProcessingMode p
91 , jldExpansionParamsExpandContext = expandContext <|> jldExpansionParamsExpandContext p
92 }
93
94 pure (expandBaseUrl, params)
95 where
96 expandBaseUrl = fromMaybe inputUrl (parseUri =<< w3cTestOptionBase =<< maybeOptions)
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
6import Test.Tasty.ExpectedFailure (ignoreTestBecause) 6import Test.Tasty.ExpectedFailure (ignoreTestBecause)
7import Test.Tasty.HUnit 7import Test.Tasty.HUnit
8 8
9import Data.JLD (expand, toJldErrorCode) 9import Data.JLD (JLDExpansionParams (..), JLDVersion (..), expand, 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
15parseExpansionOptions :: URI -> URI -> Maybe W3CTestOption -> IO (URI, JLDExpansionParams () IO -> JLDExpansionParams Text IO)
16parseExpansionOptions 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 { jldExpansionParamsDocumentLoader = documentLoader
26 , jldExpansionParamsProcessingMode = case maybeOptions >>= w3cTestOptionProcessingMode of
27 Just "json-ld-1.0" -> JLD1_0
28 Just "json-ld-1.1" -> JLD1_1
29 _ -> jldExpansionParamsProcessingMode p
30 , jldExpansionParamsExpandContext = expandContext <|> jldExpansionParamsExpandContext p
31 }
32
33 pure (expandBaseUrl, params)
34 where
35 expandBaseUrl = fromMaybe inputUrl (parseUri =<< w3cTestOptionBase =<< maybeOptions)
13 36
14expansionTests :: W3CTestList -> TestTree 37expansionTests :: W3CTestList -> TestTree
15expansionTests testList = testGroup "Expansion" <| uncurry expansionTest <$> zip (w3cSequence testList) [1 ..] 38expansionTests testList = testGroup "Expansion" <| uncurry expansionTest <$> zip (w3cSequence testList) [1 ..]
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