module Test.Flattening (flatteningTests) where

import Data.JLD.Prelude

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

import Data.JLD (JLDFlatteningParams (..), JLDVersion (..), flatten, toJldErrorCode)
import Data.JLD.Model.URI (parseUri)
import Data.Maybe (fromJust)
import Test.Common (W3CTest (..), W3CTestList (..), W3CTestOption (..), documentLoader, fetchTest)
import Text.URI (URI, mkURI, relativeTo)

parseFlatteningOptions :: URI -> URI -> Maybe W3CTestOption -> IO (URI, JLDFlatteningParams () IO -> JLDFlatteningParams Text IO)
parseFlatteningOptions baseUrl inputUrl maybeOptions = do
    expandContext <- case maybeOptions >>= w3cTestOptionExpandContext of
        Just rawUrl -> do
            url <- fromJust <. (`relativeTo` baseUrl) <$> mkURI rawUrl
            Just <$> fetchTest url
        Nothing -> pure Nothing

    let params p =
            p
                { jldFlatteningParamsDocumentLoader = documentLoader
                , jldFlatteningParamsProcessingMode = case maybeOptions >>= w3cTestOptionProcessingMode of
                    Just "json-ld-1.0" -> JLD1_0
                    Just "json-ld-1.1" -> JLD1_1
                    _ -> jldFlatteningParamsProcessingMode p
                , jldFlatteningParamsExpandContext = expandContext <|> jldFlatteningParamsExpandContext p
                , jldFlatteningParamsCompactArrays = case maybeOptions >>= w3cTestOptionCompactArrays of
                    Just b -> b
                    _ -> jldFlatteningParamsCompactArrays p
                }

    pure (expandBaseUrl, params)
  where
    expandBaseUrl = fromMaybe inputUrl (parseUri =<< w3cTestOptionBase =<< maybeOptions)

flatteningTests :: W3CTestList -> TestTree
flatteningTests testList = testGroup "Flattening" <| uncurry flatteningTest <$> zip (w3cSequence testList) [1 ..]

flatteningTest :: W3CTest -> Int -> TestTree
flatteningTest 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

            (flatteningBaseUrl, params) <- parseFlatteningOptions baseUrl inputUrl w3cTestOption
            (result, _) <- flatten inputJld flatteningBaseUrl 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) <- parseFlatteningOptions baseUrl inputUrl w3cTestOption
            (result, _) <- flatten inputJld expandBaseUrl params

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