jsons-to-schema-0.1.0.0: test/TestUtils.hs

module TestUtils
  ( testJsonToSchema
  , testJsonsToSchema
  , testJsonsToSchemaWithConfig
  , testJsonsToSchemaPretty
  , testJsonsToSchemaPrettyWithConfig
  , shouldValidate
  , shouldNotValidate
  , shouldNotValidateTexts
  , validatesAll
  , testUnifySchemas
  , testUnifySchemaTexts
  , printJson
  , printJsonToString
  , printSchemaToString
  ) where

import           Protolude

import qualified Data.Aeson                        as AE
import qualified Data.Aeson.Encode.Pretty          as AEEP
import qualified Data.ByteString.Lazy              as BSL
import qualified Data.ByteString.Char8 as BSC
import qualified Data.HashMap.Lazy                 as HM
import qualified Data.Text.Encoding                as TE
import qualified JSONSchema.Draft4                 as D4

import           JSONSchema.Draft4.SchemaGeneration
import           JSONSchema.Draft4.SchemaGenerationConfig
import           Test.Hspec

import qualified GHC.Base

parseSchema :: Text -> D4.Schema
parseSchema s =
  fromMaybe (panic $ "Failed to parse schema " <> s) .
  AE.decode .
  BSL.fromStrict .
  TE.encodeUtf8 $ s

printSchema :: D4.Schema -> BSL.ByteString
printSchema = AEEP.encodePretty . AE.toJSON

printJson :: AE.Value -> BSL.ByteString
printJson = AEEP.encodePretty

printJsonToString :: AE.Value -> GHC.Base.String
printJsonToString = BSC.unpack . BSL.toStrict . printJson

printSchemaToString :: D4.Schema -> GHC.Base.String
printSchemaToString = BSC.unpack . BSL.toStrict . printSchema


parseJson :: Text -> AE.Value
parseJson json =
  (fromMaybe (panic $ "Could not parse JSON " <> json) .
   AE.decode . BSL.fromStrict . TE.encodeUtf8)
    json

validatesAll :: D4.Schema -> [AE.Value] -> Bool
validatesAll schema jsons = and $ validator <$> jsons
  where validatableSchema = D4.SchemaWithURI schema Nothing
        possibleValidator = D4.checkSchema (D4.URISchemaMap HM.empty) validatableSchema
        validator :: AE.Value -> Bool
        validator = either (\err value -> False) (null .) possibleValidator

shouldValidate :: D4.Schema -> [AE.Value] -> IO ()
shouldValidate schema jsons = do
  let validatableSchema = D4.SchemaWithURI schema Nothing
  results <- sequence $ fmap (D4.fetchFilesystemAndValidate validatableSchema) jsons
  results `shouldBe` replicate (length jsons) (Right ())

shouldNotValidateTexts :: Text -> [Text] -> IO ()
shouldNotValidateTexts expectedSchema jsonTexts = do
  let jsonInstances = fmap parseJson jsonTexts
  let schema = parseSchema expectedSchema

  schema `shouldNotValidate` jsonInstances

shouldNotValidate :: D4.Schema -> [AE.Value] -> IO ()
shouldNotValidate schema jsons = do
  let validatableSchema = D4.SchemaWithURI schema Nothing
  results <- sequence $ fmap (D4.fetchFilesystemAndValidate validatableSchema) jsons

  all isLeft results `shouldBe` True


testJsonToSchema :: Text -> Text -> IO ()
testJsonToSchema jsonText = testJsonsToSchema [jsonText]

testJsonsToSchemaWithConfig :: SchemaGenerationConfig -> [Text] -> Text -> IO ()
testJsonsToSchemaWithConfig c jsonTexts expectedSchema = do
  let jsonInstances = fmap parseJson jsonTexts
  let computedSchema = fromMaybe
                   (panic "Could not unify multiple schemas")
                   (jsonsToSchemaWithConfig c jsonInstances)

  -- Check schema is as expected
  computedSchema `shouldBe` parseSchema expectedSchema

  -- Check all provided instances validate against the computed schema
  let validatableSchema = D4.SchemaWithURI computedSchema Nothing
  results <- sequence $ fmap (D4.fetchFilesystemAndValidate validatableSchema) jsonInstances

  results `shouldBe` replicate (length jsonInstances) (Right ())

testJsonsToSchema :: [Text] -> Text -> IO ()
testJsonsToSchema = testJsonsToSchemaWithConfig defaultSchemaGenerationConfig

testJsonsToSchemaPrettyWithConfig :: SchemaGenerationConfig -> [Text] -> Text -> IO ()
testJsonsToSchemaPrettyWithConfig c jsonTexts expectedSchema =
  maybe
    (panic "Could not unify multiple schemas")
    printSchema
    (jsonsToSchemaWithConfig c $ fmap parseJson jsonTexts) `shouldBe`
  printSchema (parseSchema expectedSchema)

testJsonsToSchemaPretty :: [Text] -> Text -> IO ()
testJsonsToSchemaPretty = testJsonsToSchemaPrettyWithConfig defaultSchemaGenerationConfig

testUnifySchemaTexts :: Text -> Text -> Text -> IO ()
testUnifySchemaTexts s1 s2 expected = testUnifySchemas (parseSchema s1) (parseSchema s2) (parseSchema expected)

testUnifySchemas :: D4.Schema -> D4.Schema -> D4.Schema -> IO ()
testUnifySchemas s1 s2 expected = unifySchemas s1 s2 `shouldBe` expected