module Shared where

import           Protolude

import           Control.Monad    (fail)
import           Data.Aeson
import           Data.Aeson.TH    (fieldLabelModifier)
import qualified Data.ByteString  as BS
import           Data.Char        (toLower)
import           Data.List        (stripPrefix, unlines)
import qualified Data.Text        as T
import qualified System.Directory as SD
import           System.FilePath  ((</>))
import           Test.Hspec

-- Recursively return the contents of a directory
-- (or return itself if given a file as an argument).
--
-- Return paths are relative to that directory.
listFiles :: FilePath -> IO [FilePath]
listFiles path = fmap ( fromMaybe "stripPrefix failed"
                      . stripPrefix (path <> "/")
                      ) <$> listFilesFullPath path

-- Recursively return the contents of a directory
-- (or return itself if given a file as an argument).
--
-- All return paths start with the 'FilePath' argument.
listFilesFullPath :: FilePath -> IO [FilePath]
listFilesFullPath path = do
    -- Check if it's a file or directory:
    res <- SD.doesFileExist path
    if res
        then pure [path]
        else do
            fs <- fmap (path </>) <$> SD.listDirectory path
            concat <$> traverse listFilesFullPath fs

isHTTPTest :: FilePath -> Bool
isHTTPTest file = (file == "definitions.json")
               || (file == "ref.json")
               || (file == "refRemote.json")

-- | We may never support the @"format"@ keywords
-- and are currently failing the others listed here.
skipOptional :: FilePath -> Bool
skipOptional file = (file == "optional/format.json")
                 || (file == "optional/zeroTerminatedFloats.json")
                 || (file == "optional/ecmascript-regex.json")

data SchemaTest = SchemaTest
    { _stDescription :: Text
    , _stSchema      :: Value
    , _stCases       :: [SchemaTestCase]
    }

data SchemaTestCase = SchemaTestCase
    { _scDescription :: Text
    , _scData        :: Value
    , _scValid       :: Bool
    } deriving Generic

instance FromJSON SchemaTest where
    parseJSON = withObject "SchemaTest" $ \o -> SchemaTest
        <$> o .: "description"
        <*> o .: "schema"
        <*> o .: "tests" -- Perhaps "cases" would have been
                         -- a more descriptive key.

instance FromJSON SchemaTestCase where
    parseJSON = genericParseJSON
                    defaultOptions
                    { fieldLabelModifier = fmap toLower . drop 3 }

readSchemaTests
    :: FilePath
    -- ^ The path to a directory.
    -> (FilePath -> Bool)
    -- ^ A function to decide what we're interested in within that directory.
    -> IO [SchemaTest]
readSchemaTests dir filterFunc = do
    files <- filter filterFunc <$> listFiles dir
    concat <$> traverse fileToCases files
  where
    -- Each file contains an array of SchemaTests, not just one.
    fileToCases :: FilePath -> IO [SchemaTest]
    fileToCases name = do
        let fullPath = dir </> name
        jsonBS <- BS.readFile fullPath
        case eitherDecodeStrict jsonBS of
            Left e -> fail $ "couldn't parse file '" <> fullPath <> "': " <> e
            Right schemaTests -> pure $ prependFileName name <$> schemaTests

    prependFileName :: FilePath -> SchemaTest -> SchemaTest
    prependFileName fileName s = s
        { _stDescription = T.pack fileName <> ": " <> _stDescription s
        }

toTest
  :: forall schema. FromJSON schema
  => (schema -> SchemaTestCase -> Expectation)
  -> SchemaTest
  -> Spec
toTest validate st =
    it (T.unpack (_stDescription st)) $
        forM_ (_stCases st) (validate schema)
  where
    schema :: schema
    schema = case fromJSON (_stSchema st) of
                 Error e   -> panic ("Couldn't parse schema: " <> show e)
                 Success a -> a

assertResult :: Show err => SchemaTestCase -> [err] -> Expectation
assertResult sc failures
    | _scValid sc = assertValid sc failures
    | otherwise   = assertInvalid sc failures

assertValid :: Show err => SchemaTestCase -> [err] -> Expectation
assertValid _ [] = pure ()
assertValid sc failures =
    expectationFailure $ unlines
        [ "    Failed to validate data"
        , "    Description: "         <> T.unpack (_scDescription sc)
        , "    Data: "                <> show (_scData sc)
        , "    Validation failures: " <> show failures
        ]

assertInvalid :: SchemaTestCase -> [err] -> Expectation
assertInvalid sc [] =
    expectationFailure $ unlines
        [ "    Validated invalid data"
        , "    Description: " <> T.unpack (_scDescription sc)
        , "    Data: "        <> show (_scData sc)
        ]
assertInvalid _ _ = pure ()