test/Test/Expansion.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

module Test.Expansion (expansionTests) where

import Data.JLD.Prelude

import Test.Tasty
import Test.Tasty.ExpectedFailure (ignoreTestBecause)
import Test.Tasty.HUnit

import Data.JLD (expand, toJldErrorCode)
import Data.Maybe (fromJust)
import Test.Common (W3CTest (..), W3CTestList (..), W3CTestOption (..), fetchTest, parseExpansionOptions)
import Text.URI (mkURI, relativeTo)

expansionTests :: W3CTestList -> TestTree
expansionTests testList = testGroup "Expansion" <| uncurry expansionTest <$> zip (w3cSequence testList) [1 ..]

expansionTest :: W3CTest -> Int -> TestTree
expansionTest W3CTest{..} (show .> (<> ". " <> toString w3cTestName) -> testName)
    | Just "json-ld-1.0" <- w3cTestOptionSpecVersion =<< w3cTestOption =
        ignoreTestBecause "specVersion json-ld-1.0 is not supported"
            <| testCase testName do pure ()
    --
    | Just expectUrlRaw <- w3cTestExpect =
        testCase testName do
            baseUrl <- mkURI "https://w3c.github.io/json-ld-api/tests/"
            inputUrl <- fromJust <. (`relativeTo` baseUrl) <$> mkURI w3cTestInput
            expectUrl <- fromJust <. (`relativeTo` baseUrl) <$> mkURI expectUrlRaw

            inputJld <- fetchTest inputUrl
            expectJld <- fetchTest expectUrl

            (expandBaseUrl, params) <- parseExpansionOptions baseUrl inputUrl w3cTestOption
            (result, _) <- expand inputJld expandBaseUrl params

            result @?= Right expectJld
    --
    | Just expectErrorRaw <- w3cTestExpectErrorCode =
        testCase testName do
            baseUrl <- mkURI "https://w3c.github.io/json-ld-api/tests/"
            inputUrl <- fromJust <. (`relativeTo` baseUrl) <$> mkURI w3cTestInput

            inputJld <- fetchTest inputUrl

            (expandBaseUrl, params) <- parseExpansionOptions baseUrl inputUrl w3cTestOption
            (result, _) <- expand inputJld expandBaseUrl params

            (result |> first toJldErrorCode) @?= Left expectErrorRaw
    --
    | otherwise =
        testCase testName do
            assertFailure <| "Unhandled test type"