module Test.Expansion (W3CExpansionTestList, expansionTests) where

import Data.JLD.Prelude

import Data.JLD (DocumentLoader (..), JLDExpandParams (..), JLDVersion (..), expand, mimeType, toJldErrorCode)
import Data.JLD.Model.URI (parseUri)
import Data.JLD.Monad (JLDEnv (..), newEnv)

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

import Data.Aeson (FromJSON, Value (..), (.:), (.:?))
import Data.Aeson.Types (FromJSON (..), prependFailure, typeMismatch)
import Data.Maybe (fromJust)
import Network.HTTP.Req (GET (..), NoReqBody (..), defaultHttpConfig, header, jsonResponse, req, responseBody, runReq, useHttpsURI, useURI)
import Text.URI (URI, mkURI, relativeTo)

data W3CExpansionTestOption = W3CExpansionTestOption
    { w3cExpansionTestOptionSpecVersion :: Maybe Text
    , w3cExpansionTestOptionProcessingMode :: Maybe Text
    , w3cExpansionTestOptionBase :: Maybe Text
    , w3cExpansionTestOptionExpandContext :: Maybe Text
    }
    deriving (Show)

instance FromJSON W3CExpansionTestOption where
    parseJSON (Object v) =
        W3CExpansionTestOption
            <$> (v .:? "specVersion")
            <*> (v .:? "processingMode")
            <*> (v .:? "base")
            <*> (v .:? "expandContext")
    parseJSON invalid = prependFailure "parsing Coord failed, " (typeMismatch "Object" invalid)

data W3CExpansionTest = W3CExpansionTest
    { w3cExpansionTestName :: Text
    , w3cExpansionTestInput :: Text
    , w3cExpansionTestExpect :: Maybe Text
    , w3cExpansionTestExpectErrorCode :: Maybe Text
    , w3cExpansionTestOption :: Maybe W3CExpansionTestOption
    }
    deriving (Show)

instance FromJSON W3CExpansionTest where
    parseJSON (Object v) =
        W3CExpansionTest
            <$> (v .: "name")
            <*> (v .: "input")
            <*> (v .:? "expect")
            <*> (v .:? "expectErrorCode")
            <*> (v .:? "option")
    parseJSON invalid = prependFailure "parsing Coord failed, " (typeMismatch "Object" invalid)

newtype W3CExpansionTestList = W3CExpansionTestList
    { w3cExpansionSequence :: [W3CExpansionTest]
    }
    deriving (Show)

instance FromJSON W3CExpansionTestList where
    parseJSON (Object v) = W3CExpansionTestList <$> (v .: "sequence")
    parseJSON invalid = prependFailure "parsing Coord failed, " (typeMismatch "Object" invalid)

documentLoader :: MonadIO m => DocumentLoader Text m
documentLoader = DocumentLoader \uri ->
    runReq defaultHttpConfig <| case useURI uri of
        Just (Left (httpUri, options)) -> Right <. responseBody <$> req GET httpUri NoReqBody jsonResponse (options <> header "Accept" mimeType)
        Just (Right (httpsUri, options)) -> Right <. responseBody <$> req GET httpsUri NoReqBody jsonResponse (options <> header "Accept" mimeType)
        Nothing -> pure <| Left "Invalid URI"

fetchTest :: URI -> IO Value
fetchTest url = do
    let (reqUrl, reqOptions) = fromJust <| useHttpsURI url
    runReq defaultHttpConfig do
        res <- req GET reqUrl NoReqBody jsonResponse (reqOptions <> header "Accept" mimeType)
        pure <| responseBody res

parseOptions :: URI -> URI -> Maybe W3CExpansionTestOption -> IO (URI, JLDExpandParams () IO -> JLDExpandParams Text IO)
parseOptions baseUrl inputUrl maybeOptions = do
    expandContext <- case maybeOptions >>= w3cExpansionTestOptionExpandContext of
        Just rawUrl -> do
            url <- fromJust <. (`relativeTo` baseUrl) <$> mkURI rawUrl
            Just <$> fetchTest url
        Nothing -> pure Nothing

    let params p =
            p
                { jldExpandParamsEnv = env'
                , jldExpandParamsExpandContext = expandContext <|> jldExpandParamsExpandContext p
                }

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

    env = newEnv \e -> e{jldEnvDocumentLoader = documentLoader}
    env' = case maybeOptions >>= w3cExpansionTestOptionProcessingMode of
        Just "json-ld-1.0" -> env{jldEnvProcessingMode = JLD1_0}
        Just "json-ld-1.1" -> env{jldEnvProcessingMode = JLD1_1}
        _ -> env

expansionTests :: W3CExpansionTestList -> TestTree
expansionTests testList = testGroup "Expansion" <| uncurry expansionTest <$> (take 999 <. drop 0 <| zip (w3cExpansionSequence testList) [1 ..])

expansionTest :: W3CExpansionTest -> Int -> TestTree
expansionTest W3CExpansionTest{..} (show .> (<> ". " <> toString w3cExpansionTestName) -> testName)
    | Just "json-ld-1.0" <- w3cExpansionTestOptionSpecVersion =<< w3cExpansionTestOption =
        ignoreTestBecause "specVersion json-ld-1.0 is not supported"
            <| testCase testName do pure ()
    --
    | Just expectUrlRaw <- w3cExpansionTestExpect =
        testCase testName do
            baseUrl <- mkURI "https://w3c.github.io/json-ld-api/tests/"
            inputUrl <- fromJust <. (`relativeTo` baseUrl) <$> mkURI w3cExpansionTestInput
            expectUrl <- fromJust <. (`relativeTo` baseUrl) <$> mkURI expectUrlRaw

            inputJld <- fetchTest inputUrl
            expectJld <- fetchTest expectUrl

            (expandBaseUrl, params) <- parseOptions baseUrl inputUrl w3cExpansionTestOption
            (result, _) <- expand inputJld expandBaseUrl params

            -- pTraceShowM (expectJLD, result)

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

            inputJld <- fetchTest inputUrl

            (expandBaseUrl, params) <- parseOptions baseUrl inputUrl w3cExpansionTestOption
            (result, _) <- expand inputJld expandBaseUrl params

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