diff options
Diffstat (limited to '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 | ||
