aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/Test/Expansion.hs25
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
3import Data.JLD.Prelude 3import Data.JLD.Prelude
4 4
5import Data.JLD (DocumentLoader (..), JLDExpandParams (..), JLDVersion (..), expand, mimeType, toJldErrorCode) 5import Data.JLD (DocumentLoader (..), JLDExpansionParams (..), JLDVersion (..), expand, mimeType, toJldErrorCode)
6import Data.JLD.Model.URI (parseUri) 6import Data.JLD.Model.URI (parseUri)
7import Data.JLD.Monad (JLDEnv (..), newEnv)
8 7
9import Test.Tasty 8import Test.Tasty
10import Test.Tasty.ExpectedFailure (ignoreTestBecause) 9import 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
36data W3CExpansionTest = W3CExpansionTest 35data 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
55newtype W3CExpansionTestList = W3CExpansionTestList 54newtype W3CExpansionTestList = W3CExpansionTestList
56 { w3cExpansionSequence :: [W3CExpansionTest] 55 { w3cExpansionSequence :: [W3CExpansionTest]
@@ -59,7 +58,7 @@ newtype W3CExpansionTestList = W3CExpansionTestList
59 58
60instance FromJSON W3CExpansionTestList where 59instance 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
64documentLoader :: MonadIO m => DocumentLoader Text m 63documentLoader :: MonadIO m => DocumentLoader Text m
65documentLoader = DocumentLoader \uri -> 64documentLoader = 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
78parseOptions :: URI -> URI -> Maybe W3CExpansionTestOption -> IO (URI, JLDExpandParams () IO -> JLDExpandParams Text IO) 77parseOptions :: URI -> URI -> Maybe W3CExpansionTestOption -> IO (URI, JLDExpansionParams () IO -> JLDExpansionParams Text IO)
79parseOptions baseUrl inputUrl maybeOptions = do 78parseOptions 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
102expansionTests :: W3CExpansionTestList -> TestTree 99expansionTests :: W3CExpansionTestList -> TestTree
103expansionTests testList = testGroup "Expansion" <| uncurry expansionTest <$> (take 999 <. drop 0 <| zip (w3cExpansionSequence testList) [1 ..]) 100expansionTests testList = testGroup "Expansion" <| uncurry expansionTest <$> (take 999 <. drop 0 <| zip (w3cExpansionSequence testList) [1 ..])
104 101