diff options
Diffstat (limited to 'test/Test/Common.hs')
-rw-r--r-- | test/Test/Common.hs | 35 |
1 files changed, 5 insertions, 30 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 @@ | |||
1 | module Test.Common (W3CTestList (..), W3CTest (..), W3CTestOption (..), fetchTest, parseExpansionOptions) where | 1 | module Test.Common (W3CTestList (..), W3CTest (..), W3CTestOption (..), documentLoader, fetchTest) where |
2 | 2 | ||
3 | import Data.JLD.Prelude | 3 | import Data.JLD.Prelude |
4 | 4 | ||
5 | import Test.Tasty | ||
6 | import Test.Tasty.ExpectedFailure (ignoreTestBecause) | ||
7 | import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) | ||
8 | |||
9 | import Data.Aeson (FromJSON (..), Value (..), (.:), (.:?)) | 5 | import Data.Aeson (FromJSON (..), Value (..), (.:), (.:?)) |
10 | import Data.Aeson.Types (prependFailure, typeMismatch) | 6 | import Data.Aeson.Types (prependFailure, typeMismatch) |
11 | import Data.JLD (DocumentLoader (..), JLDExpansionParams (..), JLDVersion (..), mimeType, toJldErrorCode) | 7 | import Data.JLD (DocumentLoader (..), mimeType) |
12 | import Data.JLD.Model.URI (parseUri) | ||
13 | import Data.Maybe (fromJust) | 8 | import Data.Maybe (fromJust) |
14 | import Network.HTTP.Req (GET (..), NoReqBody (..), defaultHttpConfig, header, jsonResponse, req, responseBody, runReq, useHttpsURI, useURI) | 9 | import Network.HTTP.Req (GET (..), NoReqBody (..), defaultHttpConfig, header, jsonResponse, req, responseBody, runReq, useHttpsURI, useURI) |
15 | import Text.URI (URI, mkURI, relativeTo) | 10 | import Text.URI (URI) |
16 | 11 | ||
17 | data W3CTestOption = W3CTestOption | 12 | data 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 | ||
34 | data W3CTest = W3CTest | 31 | data 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 | |||
76 | parseExpansionOptions :: URI -> URI -> Maybe W3CTestOption -> IO (URI, JLDExpansionParams () IO -> JLDExpansionParams Text IO) | ||
77 | parseExpansionOptions 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) | ||