{-# LANGUAGE TupleSections #-}

-- | Test examples from RFC 6902 sections A.1 to A.16.

module Main (main) where

import           Control.Exception          (AssertionFailed(AssertionFailed), IOException, catch, try, throw)
import           Control.Monad              (when)
import           Data.Aeson                 (Result(Success, Error), Value, decodeStrict, eitherDecodeStrict, encode)
import           Data.Aeson.Diff            (Patch, patch)
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Char8      as BC
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.Char                  (isSpace)
import           Data.List                  (isInfixOf, nub)
import           Data.Maybe                 (isJust)
import           System.Directory           (getDirectoryContents)
import           System.Environment         (getArgs)
import           System.Exit                (exitFailure)
import           System.FilePath            ((</>))
import           System.FilePath.Glob       (compile, match, simplify)

roots :: [FilePath]
roots = ["test/data/rfc6902", "test/data/cases"]

globPattern :: FilePath
globPattern = "*.*"

derp :: String -> a
derp msg = throw (AssertionFailed $ " " <> msg)

readDocument :: FilePath -> FilePath -> IO Value
readDocument root name = do
    let file = root </> name <> "-original.json"
    doc <- eitherDecodeStrict <$> BS.readFile file

    return $ either (\e -> derp $ "Could not decode document: " <> e) id doc


readPatch :: FilePath -> FilePath -> IO (Either String Patch)
readPatch root name = do
    let file = root </> name <> "-patch.json"

    eitherDecodeStrict <$> BS.readFile file

readResult :: FilePath -> FilePath -> IO (Either String Value)
readResult root name = do
    let err_path = root </> name <> "-error.txt"
    let doc_path = root </> name <> "-result.json"

    err <- catch (Just . BC.unpack . BC.dropWhile isSpace . fst . BC.spanEnd isSpace
                 <$> BS.readFile err_path) handle

    doc <- catch (decodeStrict <$> BS.readFile doc_path) handle

    case (err, doc) of
      (Nothing, Just d)  -> return (Right d)
      (Just er, Nothing) -> return (Left er)
      (Just _er, Just _) -> derp "Expecting both error and success"
      (Nothing, Nothing) -> derp "No result defined; add `*-error.txt' or `*-result.json'"
  where
    handle :: IOException -> IO (Maybe a)
    handle _ = return Nothing

readExample :: FilePath -> FilePath -> IO (Value, Either String Patch, Either String Value)
readExample root name =
    (,,) <$> readDocument root name
         <*> readPatch root name
         <*> readResult root name

-- | Check example and, if it fails, return an error message.
runExample :: (Value, Either String Patch, Either String Value) -> Maybe String
runExample (doc, diff, res) =
    case (diff, res) of
        (Left perr, Left err)
            | err `isInfixOf` perr -> success "Patch has expected error."
            | perr `isInfixOf` err -> success "Patch has expected error."
            | otherwise   -> failure ("Unexpected error `" <> perr <> "' was not '" <> err <> "'.")
        (Left err, Right _) ->
            failure ("Couldn't load patch: " <> err)
        (Right diff, Right res) ->
            case patch diff doc of
              Success dest
                  | dest == res -> success "Result matches target"
                  | otherwise -> failure ("Result document did not match: " <> BL.unpack (encode dest))
              Error dest -> failure ("Couldn't apply patch " <> dest)
        (Right diff, Left err) ->
            case patch diff doc of
              Success _ -> Just "Test Fails - Expected a failure but patch succeeded."
              Error msg
                  | msg /= err -> Just $ "Test Fails - Got: " <> msg <> "\nExpected: " <> err
                  | otherwise  -> Nothing
  where
    success _ = Nothing
    failure n = Just ("Test Fails - " <> n)

testExample :: FilePath -> FilePath -> IO (Maybe String)
testExample root name = do
    r <- try (runExample <$> readExample root name)
    return $ either err id r
  where
    err :: AssertionFailed -> Maybe String
    err e = Just ("Error: " <> show e)

runSuite :: FilePath -> IO [(FilePath, Maybe String)]
runSuite root = do
    -- Gather directories in test/data
    let p = simplify (compile globPattern)
    examples <- nub . fmap (takeWhile (/= '-')) . filter (match p) <$> getDirectoryContents root
    -- Test each of them
    mapM (\nom -> (nom,) <$> testExample root nom) examples

main :: IO ()
main = do
    args <- getArgs
    results <- concat <$> mapM runSuite (if null args then roots else args)
    mapM_ display results
    -- Failure.
    when (any (isJust . snd) results)
        exitFailure
  where
    display :: (FilePath, Maybe String) -> IO ()
    display (name, Nothing) =
        putStrLn $ "SUCCESS: " <> name
    display (name, Just err) =
        putStrLn $ "FAILURE: " <> name <> ": " <> err
