diff --git a/src/Language/Json/Type.hs b/src/Language/Json/Type.hs index 8205b6c..5489898 100644 --- a/src/Language/Json/Type.hs +++ b/src/Language/Json/Type.hs @@ -31,6 +31,8 @@ import qualified Data.Traversable as Traversable import qualified Test.QuickCheck.Gen as Gen import qualified Data.Map as Map +-- | Types a 'Json.Value' can have. + data Type = Null | All -- the inverse of any, supertype of all types @@ -112,14 +114,18 @@ infer = \case Value.Object fields -> Object $ infer <$> fields +-- | Documents the differences found when checking conformity. + data Mismatch = Mismatch - { expected :: Type - , inferred :: Type - , value :: Value - , path :: [Path] + { expected :: Type -- ^ type expected in the layout + , inferred :: Type -- ^ type inferred from the input + , value :: Value -- ^ value present in the input + , path :: [Path] -- ^ path to get to the value } deriving stock (Show, Eq, Ord) +-- | Virtual Field alias + instance HasField "actual" Mismatch Type where getField :: Mismatch -> Type getField = (.inferred) @@ -130,6 +136,8 @@ conforms :: Type -> Json.Value -> [Mismatch] conforms = conforms' [] +-- | Annotate found nonconformities with the value path. + conforms' :: [Path] -> Type -> Value -> [Mismatch] conforms' path layout value = case (value, layout) of (_, All) -> mempty -- matches all the types