diff options
Diffstat (limited to 'test/Test')
-rw-r--r-- | test/Test/Expansion.hs | 25 |
1 files changed, 11 insertions, 14 deletions
diff --git a/test/Test/Expansion.hs b/test/Test/Expansion.hs index 33397f4..89024c6 100644 --- a/test/Test/Expansion.hs +++ b/test/Test/Expansion.hs | |||
@@ -2,9 +2,8 @@ module Test.Expansion (W3CExpansionTestList, expansionTests) where | |||
2 | 2 | ||
3 | import Data.JLD.Prelude | 3 | import Data.JLD.Prelude |
4 | 4 | ||
5 | import Data.JLD (DocumentLoader (..), JLDExpandParams (..), JLDVersion (..), expand, mimeType, toJldErrorCode) | 5 | import Data.JLD (DocumentLoader (..), JLDExpansionParams (..), JLDVersion (..), expand, mimeType, toJldErrorCode) |
6 | import Data.JLD.Model.URI (parseUri) | 6 | import Data.JLD.Model.URI (parseUri) |
7 | import Data.JLD.Monad (JLDEnv (..), newEnv) | ||
8 | 7 | ||
9 | import Test.Tasty | 8 | import Test.Tasty |
10 | import Test.Tasty.ExpectedFailure (ignoreTestBecause) | 9 | import Test.Tasty.ExpectedFailure (ignoreTestBecause) |
@@ -31,7 +30,7 @@ instance FromJSON W3CExpansionTestOption where | |||
31 | <*> (v .:? "processingMode") | 30 | <*> (v .:? "processingMode") |
32 | <*> (v .:? "base") | 31 | <*> (v .:? "base") |
33 | <*> (v .:? "expandContext") | 32 | <*> (v .:? "expandContext") |
34 | parseJSON invalid = prependFailure "parsing Coord failed, " (typeMismatch "Object" invalid) | 33 | parseJSON invalid = prependFailure "parsing W3CExpansionTestOption failed, " (typeMismatch "Object" invalid) |
35 | 34 | ||
36 | data W3CExpansionTest = W3CExpansionTest | 35 | data W3CExpansionTest = W3CExpansionTest |
37 | { w3cExpansionTestName :: Text | 36 | { w3cExpansionTestName :: Text |
@@ -50,7 +49,7 @@ instance FromJSON W3CExpansionTest where | |||
50 | <*> (v .:? "expect") | 49 | <*> (v .:? "expect") |
51 | <*> (v .:? "expectErrorCode") | 50 | <*> (v .:? "expectErrorCode") |
52 | <*> (v .:? "option") | 51 | <*> (v .:? "option") |
53 | parseJSON invalid = prependFailure "parsing Coord failed, " (typeMismatch "Object" invalid) | 52 | parseJSON invalid = prependFailure "parsing W3CExpansionTest failed, " (typeMismatch "Object" invalid) |
54 | 53 | ||
55 | newtype W3CExpansionTestList = W3CExpansionTestList | 54 | newtype W3CExpansionTestList = W3CExpansionTestList |
56 | { w3cExpansionSequence :: [W3CExpansionTest] | 55 | { w3cExpansionSequence :: [W3CExpansionTest] |
@@ -59,7 +58,7 @@ newtype W3CExpansionTestList = W3CExpansionTestList | |||
59 | 58 | ||
60 | instance FromJSON W3CExpansionTestList where | 59 | instance FromJSON W3CExpansionTestList where |
61 | parseJSON (Object v) = W3CExpansionTestList <$> (v .: "sequence") | 60 | parseJSON (Object v) = W3CExpansionTestList <$> (v .: "sequence") |
62 | parseJSON invalid = prependFailure "parsing Coord failed, " (typeMismatch "Object" invalid) | 61 | parseJSON invalid = prependFailure "parsing W3CExpansionTestList failed, " (typeMismatch "Object" invalid) |
63 | 62 | ||
64 | documentLoader :: MonadIO m => DocumentLoader Text m | 63 | documentLoader :: MonadIO m => DocumentLoader Text m |
65 | documentLoader = DocumentLoader \uri -> | 64 | documentLoader = DocumentLoader \uri -> |
@@ -75,7 +74,7 @@ fetchTest url = do | |||
75 | res <- req GET reqUrl NoReqBody jsonResponse (reqOptions <> header "Accept" mimeType) | 74 | res <- req GET reqUrl NoReqBody jsonResponse (reqOptions <> header "Accept" mimeType) |
76 | pure <| responseBody res | 75 | pure <| responseBody res |
77 | 76 | ||
78 | parseOptions :: URI -> URI -> Maybe W3CExpansionTestOption -> IO (URI, JLDExpandParams () IO -> JLDExpandParams Text IO) | 77 | parseOptions :: URI -> URI -> Maybe W3CExpansionTestOption -> IO (URI, JLDExpansionParams () IO -> JLDExpansionParams Text IO) |
79 | parseOptions baseUrl inputUrl maybeOptions = do | 78 | parseOptions baseUrl inputUrl maybeOptions = do |
80 | expandContext <- case maybeOptions >>= w3cExpansionTestOptionExpandContext of | 79 | expandContext <- case maybeOptions >>= w3cExpansionTestOptionExpandContext of |
81 | Just rawUrl -> do | 80 | Just rawUrl -> do |
@@ -85,20 +84,18 @@ parseOptions baseUrl inputUrl maybeOptions = do | |||
85 | 84 | ||
86 | let params p = | 85 | let params p = |
87 | p | 86 | p |
88 | { jldExpandParamsEnv = env' | 87 | { jldExpansionParamsDocumentLoader = documentLoader |
89 | , jldExpandParamsExpandContext = expandContext <|> jldExpandParamsExpandContext p | 88 | , jldExpansionParamsProcessingMode = case maybeOptions >>= w3cExpansionTestOptionProcessingMode of |
89 | Just "json-ld-1.0" -> JLD1_0 | ||
90 | Just "json-ld-1.1" -> JLD1_1 | ||
91 | _ -> jldExpansionParamsProcessingMode p | ||
92 | , jldExpansionParamsExpandContext = expandContext <|> jldExpansionParamsExpandContext p | ||
90 | } | 93 | } |
91 | 94 | ||
92 | pure (expandBaseUrl, params) | 95 | pure (expandBaseUrl, params) |
93 | where | 96 | where |
94 | expandBaseUrl = fromMaybe inputUrl (parseUri =<< w3cExpansionTestOptionBase =<< maybeOptions) | 97 | expandBaseUrl = fromMaybe inputUrl (parseUri =<< w3cExpansionTestOptionBase =<< maybeOptions) |
95 | 98 | ||
96 | env = newEnv \e -> e{jldEnvDocumentLoader = documentLoader} | ||
97 | env' = case maybeOptions >>= w3cExpansionTestOptionProcessingMode of | ||
98 | Just "json-ld-1.0" -> env{jldEnvProcessingMode = JLD1_0} | ||
99 | Just "json-ld-1.1" -> env{jldEnvProcessingMode = JLD1_1} | ||
100 | _ -> env | ||
101 | |||
102 | expansionTests :: W3CExpansionTestList -> TestTree | 99 | expansionTests :: W3CExpansionTestList -> TestTree |
103 | expansionTests testList = testGroup "Expansion" <| uncurry expansionTest <$> (take 999 <. drop 0 <| zip (w3cExpansionSequence testList) [1 ..]) | 100 | expansionTests testList = testGroup "Expansion" <| uncurry expansionTest <$> (take 999 <. drop 0 <| zip (w3cExpansionSequence testList) [1 ..]) |
104 | 101 | ||