diff --git a/Example.hs b/Example.hs
deleted file mode 100644
--- a/Example.hs
+++ /dev/null
@@ -1,103 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main where
-
-import           Control.Applicative
-import           Data.Aeson
-import           Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as H
-import           Data.Monoid
-import           Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Vector as V
-
-import qualified Data.JsonSchema as JS
-
--- Data.JsonSchema is designed to be imported unqualified.
--- We're just being explicit here for example purposes.
-
-main :: IO ()
-main = do
-  simpleExample
-  fullExample
-
---------------------------------------------------
--- * Example Schema and Data
---------------------------------------------------
-
-schemaData :: JS.RawSchema
-schemaData = JS.RawSchema
-  { JS._rsURI  = Nothing
-  -- ^ If your schema has relative references to other schemas
-  -- then you'll need to include this.
-  , JS._rsData = schemaJSON
-  }
-  where
-    schemaJSON :: HashMap Text Value
-    schemaJSON = H.singleton "uniqueItems" (Bool True)
-
-badData :: Value
-badData = Array $ V.fromList ["foo", "foo"]
-
---------------------------------------------------
--- * Simple Example
---------------------------------------------------
-
--- | Since our schema contains no references to other schemas,
--- we can skip the fetchGraph step.
-simpleExample :: IO ()
-simpleExample = do
-  schema <- compileSchema (JS.SchemaGraph schemaData H.empty) schemaData
-  checkResults (JS.validate schema badData)
-
---------------------------------------------------
--- * Full Example
---------------------------------------------------
-
--- | For a schema that might contain references to other schemas.
-fullExample :: IO ()
-fullExample = do
-  let currentSchemaCache = H.empty
-  schemaGraph <- fetchGraph currentSchemaCache schemaData
-
-  -- We aren't going to use it for anything this time, but if we were caching
-  -- remote schemas this would be our new cache.
-  --
-  -- let newSchemaCache = _cachedSchemas schemaData <> currentSchemaGraph
-
-  schema <- compileSchema schemaGraph schemaData
-  checkResults (JS.validate schema badData)
-
-  where
-    fetchGraph :: HashMap Text (HashMap Text Value) -> JS.RawSchema -> IO JS.SchemaGraph
-    fetchGraph graph rs = do
-      eitherGraph <- JS.fetchReferencedSchemas JS.draft4 graph rs
-      case eitherGraph of
-        Left e  -> error $ "Failed to fetch graph with error: " <> T.unpack e
-        Right g -> return g
-
---------------------------------------------------
--- * Helper Functions
---------------------------------------------------
-
-compileSchema :: JS.SchemaGraph -> JS.RawSchema -> IO (JS.Schema JS.Draft4Failure)
-compileSchema graph rs =
-  case JS.compileDraft4 graph rs of
-    Left failure -> error $ "Not a valid schema: " <> show failure
-    Right schema -> return schema
-
-checkResults :: [JS.ValidationFailure JS.Draft4Failure] -> IO ()
-checkResults [] = error "OHNO we validated bad data!"
-checkResults [JS.ValidationFailure JS.UniqueItems (JS.FailureInfo x y)] =
-  putStrLn . unlines $
-    [ ""
-    , "Success. We got a UniqueItems error as expected."
-    , "Here's the relevant part of the bad JSON document:"
-    , ""
-    , "  " <> show y
-    , ""
-    , "And here's the content of the validator that caught it:"
-    , ""
-    , "  " <> show x
-    ]
-checkResults x = error $ "OHNO we got a different failure than we expected: " <> show x
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -4,11 +4,11 @@
 
 [Hackage](https://hackage.haskell.org/package/hjsonschema) / [GitHub](https://github.com/seagreen/hjsonschema) / [Travis CI](https://travis-ci.org/seagreen/hjsonschema)
 
-NOTE: You currently CANNOT use untrusted JSON data to make schemas. Schemas with circular references can cause infinite loops. This is being addressed: see the issue list.
+NOTE: You CANNOT use untrusted JSON data to make schemas. Schemas with circular references can cause infinite loops. See the issue list for more info.
 
 # Example
 
-See [Example.hs on GitHub](https://github.com/seagreen/hjsonschema/blob/master/Example.hs).
+See [here](https://github.com/seagreen/hjsonschema/blob/master/examples/Example.hs).
 
 # Tests
 
diff --git a/changelog.txt b/changelog.txt
--- a/changelog.txt
+++ b/changelog.txt
@@ -1,3 +1,10 @@
+# 0.9
+
++ Partial rewrite. The API of the library has changed, see the examples
+folder for how to use the new one.
+
++ Users of the library can now write schemas in Haskell as well as JSON.
+
 # 0.8
 
 + Improve scope updating and resolving.
diff --git a/examples/CustomSchema.hs b/examples/CustomSchema.hs
new file mode 100644
--- /dev/null
+++ b/examples/CustomSchema.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | A custom schema made up of one validator from 'Data.Validator.Draft4'
+-- and one original validator.
+--
+-- This is a simple example because it doesn't allow references (so it
+-- doesn't need to define an 'embed' function @Schema -> [Schema]@ for use
+-- with 'fetchReferencedSchemas'.
+
+module CustomSchema where
+
+import           Data.Aeson
+import           Data.Maybe             (maybeToList)
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+
+import qualified Data.Validator.Draft4  as VA
+import qualified Data.Validator.Failure as FR
+
+-- | Our custom validator.
+oddLength :: Bool -> Text -> Maybe (FR.Failure () )
+oddLength b t
+  | b == odd (T.length t) = Nothing
+  | otherwise             = Just (FR.Failure () (Bool b) mempty)
+
+data CustomError
+  = MaxLength
+  | OddLength
+
+-- If we were really using the schema we would also need ToJSON and FromJSON
+-- instances.
+data Schema = Schema
+  { _schemaMaxLength :: Maybe Int
+  , _schemaOddLength :: Maybe Bool
+  }
+
+-- | Since every 'Schema' is valid we don't need to bother defining something
+-- like 'Data.JsonSchema.Draft4.checkValidity' for this schema.
+validate :: Schema -> Value -> [FR.Failure CustomError]
+validate s (String x) = concat
+  [ f _schemaMaxLength (FR.setFailure MaxLength) (fmap maybeToList . VA.maxLength)
+  , f _schemaOddLength (FR.setFailure OddLength) (fmap maybeToList . oddLength)
+  ]
+  where
+    -- This pattern is overkill here, but is helpful if you have lots of
+    -- validators (e.g. the Draft 4 schema has 27).
+    f :: (Schema -> Maybe val)
+      -> (err -> FR.Failure CustomError)
+      -> (val -> Text -> [err])
+      -> [FR.Failure CustomError]
+    f field modifyError runVal =
+      maybe mempty (\val -> modifyError <$> runVal val x) (field s)
+validate _ _ = mempty -- Our schema passes everything that isn't a string.
+
+example :: IO ()
+example =
+  case validate schema badData of
+    [] -> error "We validated bad data."
+    [FR.Failure OddLength _ _] -> putStrLn "Success."
+    _ -> error "We got a different failure than expected."
+  where
+    schema :: Schema
+    schema = Schema (Just 100) (Just True)
+
+    badData :: Value
+    badData = String "even"
diff --git a/examples/Main.hs b/examples/Main.hs
new file mode 100644
--- /dev/null
+++ b/examples/Main.hs
@@ -0,0 +1,19 @@
+
+module Main where
+
+import qualified CustomSchema      as C
+import qualified PrettyShowFailure as P
+import qualified Standard          as S
+
+main :: IO ()
+main = do
+  putStrLn "# Standard Example"
+  S.example
+  putStrLn ""
+
+  putStrLn "# PrettyShowFailure Example"
+  P.example
+  putStrLn ""
+
+  putStrLn "# CustomSchema Example"
+  C.example
diff --git a/examples/PrettyShowFailure.hs b/examples/PrettyShowFailure.hs
new file mode 100644
--- /dev/null
+++ b/examples/PrettyShowFailure.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module PrettyShowFailure where
+
+import           Data.Aeson
+import qualified Data.Aeson.Pointer     as AP
+import           Data.Monoid
+
+import qualified Data.JsonSchema.Draft4 as D4
+
+badData :: Value
+badData = toJSON [1, 2 :: Int]
+
+failure :: D4.Failure
+failure = D4.Failure
+  { D4._failureValidatorsCalled = D4.Items D4.MultipleOf
+  , D4._failureFinalValidator   = Number 2
+  , D4._failureOffendingData    = AP.Pointer [AP.Token "0"]
+  }
+
+subsetOfData :: Value
+subsetOfData =
+  -- This is the only really interesting part of this example. To resolve the
+  -- pointer to the part of the data that triggered the validation failure we
+  -- have to have hjsonpointer in our build-depends and use 'AP.resolve'.
+  case AP.resolve (D4._failureOffendingData failure) badData of
+    Left _  -> error "Couldn't resolve pointer."
+    Right v -> v
+
+example :: IO ()
+example = putStrLn . unlines $
+  [ "Invalid data. Here's the sequence of validators that caught it:"
+  , ""
+  , "  " <> show (D4._failureValidatorsCalled failure)
+  , ""
+  , "Here's the contents of the final validator in that sequence:"
+  , ""
+  , "  " <> show (D4._failureFinalValidator failure)
+  , ""
+  , "Here's a JSON Pointer to the invalid part of the data:"
+  , ""
+  , "  " <> show (D4._failureOffendingData failure)
+  , ""
+  , "Here's the invalid part of the data:"
+  , ""
+  , "  " <> show subsetOfData
+  ]
diff --git a/examples/Standard.hs b/examples/Standard.hs
new file mode 100644
--- /dev/null
+++ b/examples/Standard.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Standard where
+
+import           Data.Aeson
+import qualified Data.HashMap.Strict    as H
+import qualified Data.Vector            as V
+
+import qualified Data.JsonSchema.Draft4 as D4
+
+schema :: D4.Schema
+schema = D4.emptySchema { D4._schemaUniqueItems = Just True }
+
+schemaContext :: D4.SchemaContext D4.Schema
+schemaContext = D4.SchemaContext
+  { D4._scURI    = Nothing
+  -- ^ If your schema has relative references to other schemas
+  -- then you'll need to give its URI here.
+  , D4._scSchema = schema
+  }
+
+badData :: Value
+badData = Array (V.fromList ["foo", "foo"])
+
+example :: IO ()
+example = do
+  -- Since we know our schema doesn't reference any other schemas we could
+  -- skip this step and use @SchemaCache schema mempty@ instead.
+  --
+  -- If we make a mistake and out schema does include references to other
+  -- schemas then those references will always return 'D4.RefResolution'
+  -- validation failures.
+  cache <- makeCache
+
+  let validate = case D4.checkSchema cache schemaContext of
+                   Left _  -> error "Not a valid schema."
+                   Right f -> f
+
+  case validate badData of
+    [] -> error "We validated bad data."
+    [D4.Failure D4.UniqueItems _ _] -> putStrLn "Success."
+    _ -> error "We got a different failure than expected."
+
+  where
+    makeCache :: IO (D4.SchemaCache D4.Schema)
+    makeCache = do
+      -- A HashMap of URIs (in the form of Text) to schemas.
+      let currentlyStoredSchemas = H.empty
+      res <- D4.fetchReferencedSchemas currentlyStoredSchemas schemaContext
+      case res of
+        Left _      -> error "Couldn't fetch referenced schemas."
+        Right cache -> return cache
diff --git a/hjsonschema.cabal b/hjsonschema.cabal
--- a/hjsonschema.cabal
+++ b/hjsonschema.cabal
@@ -1,5 +1,5 @@
 name:                   hjsonschema
-version:                0.8.0.1
+version:                0.9.0.0
 synopsis:               JSON Schema library
 homepage:               https://github.com/seagreen/hjsonschema
 license:                MIT
@@ -14,73 +14,80 @@
                         draft4.json
                         JSON-Schema-Test-Suite/tests/draft4/*.json
                         README.md
-                        tests/Lib.hs
+                        tests/Shared.hs
 
 library
   hs-source-dirs:       src
-  exposed-modules:      Data.JsonSchema
-                      , Data.JsonSchema.Draft4.Any
-                      , Data.JsonSchema.Draft4.Arrays
-                      , Data.JsonSchema.Draft4.Numbers
-                      , Data.JsonSchema.Draft4.Objects
-                      , Data.JsonSchema.Draft4.Strings
-                      , Data.JsonSchema.Helpers
-                      , Data.JsonSchema.Reference
-  other-modules:        Data.JsonSchema.Core
-                        Data.JsonSchema.Draft4
-                      , Data.JsonSchema.Draft4.Objects.Properties
+  exposed-modules:      Data.JsonSchema.Draft4
+                      , Data.JsonSchema.Draft4.Internal
+                      , Data.JsonSchema.Fetch
+                      , Data.Validator.Draft4
+                      , Data.Validator.Failure
+                      , Data.Validator.Reference
+                      , Data.Validator.Utils
+
+  other-modules:        Data.JsonSchema.Draft4.Failure
+                      , Data.JsonSchema.Draft4.Schema
+                      , Data.Validator.Draft4.Any
+                      , Data.Validator.Draft4.Array
+                      , Data.Validator.Draft4.Number
+                      , Data.Validator.Draft4.Object
+                      , Data.Validator.Draft4.Object.Properties
+                      , Data.Validator.Draft4.String
                       , Import
   default-language:     Haskell2010
   default-extensions:   ScopedTypeVariables
                         OverloadedStrings
-  other-extensions:     TemplateHaskell
   ghc-options:          -Wall
-  build-depends:        aeson                >= 0.7   && < 0.11
+  build-depends:        aeson                >= 0.7    && < 0.12
                         -- 4.6 doesn't have a Traversable Either instance:
-                      , base                 >= 4.7   && < 4.9
-                      , bytestring           >= 0.10  && < 0.11
-                      , containers           >= 0.5   && < 0.6
-                      , file-embed           >= 0.0.8 && < 0.0.10
-                      , hashable             >= 1.2   && < 1.3
-                      , hjsonpointer         >= 0.2   && < 0.3
-                      , http-client          >= 0.4.9 && < 0.5
-                      , http-types           >= 0.8   && < 0.10
-                      , mtl                  >= 2.2.1 && < 2.3
-                      , regexpr              >= 0.5   && < 0.6
-                      , scientific           >= 0.3   && < 0.4
-                      , transformers         >= 0.4.2 && < 0.5
-                      , unordered-containers >= 0.2   && < 0.3
-                      , text                 >= 1.2   && < 1.3
-                      , vector               >= 0.10  && < 0.12
+                      , base                 >= 4.7    && < 4.9
+                      , bytestring           >= 0.10   && < 0.11
+                      , containers           >= 0.5    && < 0.6
+                      , file-embed           >= 0.0.8  && < 0.0.10
+                      , hjsonpointer         >= 0.3    && < 0.4
+                      , http-client          >= 0.4.9  && < 0.5
+                      , http-types           >= 0.8    && < 0.10
+                      , QuickCheck           >= 2.8.1  && < 2.9
+                      , regexpr              >= 0.5    && < 0.6
+                      , scientific           >= 0.3    && < 0.4
+                      , semigroups           >= 0.18.0 && < 0.19
+                      , unordered-containers >= 0.2    && < 0.3
+                      , text                 >= 1.2    && < 1.3
+                      , vector               >= 0.10   && < 0.12
 
 test-suite local
   type:                 exitcode-stdio-1.0
   hs-source-dirs:       tests
   main-is:              Local.hs
+  other-modules:        Shared
   default-language:     Haskell2010
-  ghc-options:          -Wall
+  ghc-options:          -Wall -fno-warn-orphans
   default-extensions:   OverloadedStrings
-  other-extensions:     TemplateHaskell
   build-depends:        aeson
                       , base
                       , bytestring
+                      , hjsonpointer
                       , hjsonschema
                       , text
+                      , QuickCheck
+                      , unordered-containers
                       , vector
-                      , directory            >= 1.2 && < 1.3
-                      , filepath             >= 1.3 && < 1.5
-                      , HUnit                >= 1.2 && < 1.4
-                      , test-framework       >= 0.8 && < 0.9
-                      , test-framework-hunit >= 0.3 && < 0.4
+                      , directory            >= 1.2  && < 1.3
+                      , filepath             >= 1.3  && < 1.5
+                      , HUnit                >= 1.2  && < 1.4
+                      , tasty                >= 0.11 && < 0.12
+                      , tasty-hunit          >= 0.9  && < 0.10
+                      , tasty-quickcheck     >= 0.8  && < 0.9
 
 test-suite remote
   type:                 exitcode-stdio-1.0
   hs-source-dirs:       tests
   main-is:              Remote.hs
+  other-modules:        Shared
   default-language:     Haskell2010
-  ghc-options:          -Wall
+  ghc-options:          -Wall -fno-warn-orphans
   default-extensions:   OverloadedStrings
-  other-extensions:     TemplateHaskell
   build-depends:        aeson
                       , async
                       , base
@@ -91,17 +98,22 @@
                       , directory
                       , filepath
                       , HUnit
-                      , test-framework
-                      , test-framework-hunit
+                      , tasty
+                      , tasty-hunit
                       , wai-app-static
                       , warp
 
 executable example
-  main-is:              Example.hs
+  hs-source-dirs:       examples
+  main-is:              Main.hs
+  other-modules:        CustomSchema
+                      , PrettyShowFailure
+                      , Standard
   default-language:     Haskell2010
   ghc-options:          -Wall
   build-depends:        aeson
                       , base
+                      , hjsonpointer
                       , hjsonschema
                       , text
                       , unordered-containers
diff --git a/src/Data/JsonSchema.hs b/src/Data/JsonSchema.hs
deleted file mode 100644
--- a/src/Data/JsonSchema.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Data.JsonSchema
-  ( module Data.JsonSchema.Core
-    -- * Schema feching tools
-  , module Data.JsonSchema
-    -- * Draft 4 specific
-  , module Data.JsonSchema.Draft4
-  ) where
-
-import           Control.Monad.Except (MonadError, MonadIO, join, throwError)
-import qualified Data.ByteString.Lazy as LBS
-import           Data.Foldable
-import qualified Data.HashMap.Strict as H
-import           Data.String
-
-import           Data.JsonSchema.Core
-import           Data.JsonSchema.Draft4
-import qualified Data.JsonSchema.Helpers as HE
-import           Data.JsonSchema.Reference
-import           Import
-
--- For GHCs before 7.10:
-import           Prelude hiding (concat, sequence)
-
--- | Take a schema. Retrieve every document either it or its
--- subschemas include via the "$ref" keyword. Load a 'SchemaGraph' out
--- with them.
-fetchReferencedSchemas :: Spec err -> SchemaCache -> RawSchema -> IO (Either Text SchemaGraph)
-fetchReferencedSchemas = fetchReferencedSchemas' HE.defaultFetch
-
--- | A version of fetchReferencedSchemas where the function to make requests
--- is provided by the user. This allows restrictions to be added, e.g. rejecting
--- non-local URIs.
-fetchReferencedSchemas'
-  -- The `Functor m` declaration is for GHCs before 7.10.
-  :: forall m e t err. (MonadIO m, Functor m, MonadError t e, Traversable e, IsString t)
-  => (Text -> m (e LBS.ByteString))
-  -> Spec err
-  -> SchemaCache
-  -> RawSchema
-  -> m (e SchemaGraph)
-fetchReferencedSchemas' fetchRef spec cache rawSchema = do
-  let startingCache = case _rsURI rawSchema of
-                        Nothing  -> cache
-                        Just uri -> H.insert uri (_rsData rawSchema) cache
-  fmap (SchemaGraph rawSchema) <$> foldlM fetch (return startingCache) (includeSubschemas rawSchema)
-
-  where
-    -- TODO: use a fold here
-    includeSubschemas :: RawSchema -> [RawSchema]
-    includeSubschemas r =
-      let scope = _rsURI r `newResolutionScope` _rsData r
-          xs = H.intersectionWith (\(ValSpec f _) x -> f scope x) (_unSpec spec) (_rsData r)
-      in r : (concat . concat . H.elems $ fmap includeSubschemas <$> xs)
-
-    fetch :: e SchemaCache -> RawSchema -> m (e SchemaCache)
-    fetch eg r = join <$> sequence (run <$> eg)
-      where
-        run :: SchemaCache -> m (e SchemaCache)
-        run g = do
-          -- Resolving the new scope is necessary here because of situations like this:
-          --
-          -- {
-          --     "id": "http://localhost:1234/",
-          --     "items": {
-          --         "id": "folder/",
-          --         "items": {"$ref": "folderInteger.json"}
-          --     }
-          -- }
-          let scope = newResolutionScope (_rsURI r) (_rsData r)
-          case resolveReference scope <$> (H.lookup "$ref" (_rsData r) >>= HE.toTxt) of
-            Just (Just uri,_) ->
-              if not (isRemoteReference uri) || H.member uri g
-                then return (return g)
-                else fetchRef uri >>= decodeResponse g uri
-            _ -> return (return g)
-
-        decodeResponse :: SchemaCache -> Text -> e LBS.ByteString -> m (e SchemaCache)
-        decodeResponse g uri eBts = join <$> sequence (runDecode g uri <$> eBts)
-
-        runDecode :: SchemaCache -> Text -> LBS.ByteString -> m (e SchemaCache)
-        runDecode g uri bts =
-          case eitherDecode bts of
-            Left e    -> return $ throwError (fromString e)
-            Right obj -> fmap _cachedSchemas <$> fetchReferencedSchemas' fetchRef spec g (RawSchema (Just uri) obj)
diff --git a/src/Data/JsonSchema/Core.hs b/src/Data/JsonSchema/Core.hs
deleted file mode 100644
--- a/src/Data/JsonSchema/Core.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Data.JsonSchema.Core where
-
-import qualified Data.HashMap.Strict       as H
-import           Data.Maybe
-
-import           Data.JsonSchema.Reference
-import           Import
-
--- For GHCs before 7.10:
-import           Prelude                   hiding (concat, sequence)
-
---------------------------------------------------
--- * Primary API
---------------------------------------------------
-
-compile :: forall err. Spec err -> SchemaGraph -> RawSchema -> Schema err
-compile spec g (RawSchema t o) =
-  let maybeValidators = H.intersectionWith f (_unSpec spec) o
-  in Schema . catMaybes . H.elems $ maybeValidators
-  where
-    f :: ValSpec err -> Value -> Maybe (Value -> [ValidationFailure err])
-    f (ValSpec _ construct) valJSON = construct spec g (RawSchema (newResolutionScope t o) o) valJSON
-
-validate :: Schema err -> Value -> [ValidationFailure err]
-validate schema x = concat . fmap ($ x) . _unSchema $ schema
-
---------------------------------------------------
--- * Schemas
---------------------------------------------------
-
-newtype Spec err = Spec { _unSpec :: HashMap Text (ValSpec err) }
-
-newtype Schema err = Schema { _unSchema :: [Value -> [ValidationFailure err]] }
-
-data RawSchema = RawSchema
-  { _rsURI  :: !(Maybe Text)
-  -- ^ NOTE: Must not include a URI fragment.
-  , _rsData :: !(HashMap Text Value)
-  } deriving (Show)
-
--- | A set of RawSchemas, split into a HashMap.
---
--- Keys correspond to Schema _rsURIs. Values correspond to Schema _rsDatas.
-type SchemaCache = HashMap Text (HashMap Text Value)
-
-data SchemaGraph = SchemaGraph
-  { _startingSchema :: !RawSchema
-  -- ^ The schema initially referenced by '#'.
-  , _cachedSchemas  :: !SchemaCache
-  } deriving (Show)
-
---------------------------------------------------
--- * Validators
---------------------------------------------------
-
-data ValSpec err = ValSpec EmbeddedSchemas (ValidatorConstructor err [ValidationFailure err])
-
--- | Return a schema's immediate subschemas.
---
--- This is used by 'Data.JsonSchema.fetchRefs' to find all the
--- subschemas in a document. This allows it to process only
--- "$ref"s and "id"s that are actual schema keywords.
-type EmbeddedSchemas = Maybe Text -> Value -> [RawSchema]
-
--- | This is what's used to write most validators in practice.
---
--- Its important that particular validators don't know about the error sum type
--- of the Spec they're going to be used in. That way they can be included in
--- other Specs later without encouraging partial functions.
---
--- This means that a properly written ValidatorConstructor will need its error
--- type modified for use in a Spec. Data.JsonSchema.Helpers provides giveName
--- and modifyName for this purpose.
-type ValidatorConstructor schemaErr valErr
-   = Spec schemaErr
-  -> SchemaGraph
-  -> RawSchema
-  -> Value
-  -> Maybe (Value -> valErr)
-
-data ValidationFailure err = ValidationFailure
-  { _failureName :: !err
-  , _failureInfo :: !FailureInfo
-  } deriving (Show)
-
-data FailureInfo = FailureInfo
-  { _validatingData :: !Value
-  , _offendingData  :: !Value
-  } deriving (Show)
diff --git a/src/Data/JsonSchema/Draft4.hs b/src/Data/JsonSchema/Draft4.hs
--- a/src/Data/JsonSchema/Draft4.hs
+++ b/src/Data/JsonSchema/Draft4.hs
@@ -1,142 +1,70 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Data.JsonSchema.Draft4 where
-
-import qualified Data.ByteString.Lazy           as LBS
-import           Data.FileEmbed
-import qualified Data.HashMap.Strict            as H
-
-import           Data.JsonSchema.Core
-import           Data.JsonSchema.Draft4.Any
-import qualified Data.JsonSchema.Draft4.Arrays as AR
-import qualified Data.JsonSchema.Draft4.Numbers as NU
-import qualified Data.JsonSchema.Draft4.Objects as OB
-import           Data.JsonSchema.Draft4.Strings
-import           Data.JsonSchema.Helpers
-import           Import
-
-data Draft4Failure
-  = MultipleOf
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
 
-  | Maximum
-  | ExclusiveMaximum
+module Data.JsonSchema.Draft4
+  ( Schema(..)
+  , emptySchema
+  , checkSchema
 
-  | Minimum
-  | ExclusiveMinimum
+    -- * Fetching tools
+  , SchemaContext(..)
+  , SchemaCache(..)
+  , fetchReferencedSchemas
 
-  | MaxLength
-  | MinLength
-  | Pattern
+    -- * Failure
+  , Failure(..)
+  , ValidatorChain(..)
 
-  | Items Draft4Failure
-  | AdditionalItemsBool
-  | AdditionalItemsObject Draft4Failure
+    -- * Other Draft 4 things exported just in case
+  , schemaValidity
+  , IN.runValidate
+  ) where
 
-  | MaxItems
-  | MinItems
-  | UniqueItems
-  | MaxProperties
-  | MinProperties
-  | Required
+import           Data.Aeson
+import qualified Data.ByteString.Lazy            as LBS
+import           Data.FileEmbed
+import qualified Data.HashMap.Strict             as H
+import           Data.Maybe                      (fromMaybe)
 
-  | Properties Draft4Failure
-  | PatternProperties Draft4Failure
-  | AdditionalPropertiesBool
-  | AdditionalPropertiesObject Draft4Failure
+import           Data.JsonSchema.Draft4.Failure
+import qualified Data.JsonSchema.Draft4.Internal as IN
+import           Data.JsonSchema.Draft4.Schema
+import           Data.JsonSchema.Fetch           (SchemaCache(..),
+                                                  SchemaContext(..),
+                                                  URISchemaMap)
+import qualified Data.JsonSchema.Fetch           as FE
+import           Data.Validator.Reference        (baseAndFragment)
+import           Import
 
-  | SchemaDependency Draft4Failure
-  | PropertyDependency
+-- | Check the validity of a schema and return a function to validate data.
+checkSchema
+  :: SchemaCache Schema
+  -> SchemaContext Schema
+  -> Either [Failure] (Value -> [Failure])
+checkSchema sg sc =
+  case schemaValidity (_scSchema sc) of
+    [] -> Right (IN.runValidate sg sc)
+    es -> Left es
 
-  | Enum
-  | TypeValidator
-  | AllOf Draft4Failure
-  | AnyOf
-  | OneOf
-  | NotValidator
-  | Ref Draft4Failure
-  deriving (Eq, Show, Read)
+fetchReferencedSchemas
+  :: URISchemaMap Schema
+  -> SchemaContext Schema
+  -> IO (Either Text (SchemaCache Schema))
+fetchReferencedSchemas =
+  FE.fetchReferencedSchemas IN.embedded _schemaId _schemaRef
 
-draft4 :: Spec Draft4Failure
-draft4 = Spec $ H.fromList
-  [ ("$ref"                , ValSpec noEm             (modifyName Ref           ref))
-  , ("multipleOf"          , ValSpec noEm             (giveName   MultipleOf    NU.multipleOf))
-  , ("maximum"             , ValSpec noEm             (modifyName fMax          NU.maximumVal))
-  , ("minimum"             , ValSpec noEm             (modifyName fMin          NU.minimumVal))
-  , ("maxLength"           , ValSpec noEm             (giveName   MaxLength     maxLength))
-  , ("minLength"           , ValSpec noEm             (giveName   MinLength     minLength))
-  , ("pattern"             , ValSpec noEm             (giveName   Pattern       pattern))
-  , ("additionalItems"     , ValSpec objEmbed         neverBuild) -- Handled by items.
-  , ("items"               , ValSpec objOrArrayEmbed  (modifyName fItems        AR.items))
-  , ("maxItems"            , ValSpec noEm             (giveName   MaxItems      AR.maxItems))
-  , ("minItems"            , ValSpec noEm             (giveName   MinItems      AR.minItems))
-  , ("uniqueItems"         , ValSpec noEm             (giveName   UniqueItems   AR.uniqueItems))
-  , ("maxProperties"       , ValSpec noEm             (giveName   MaxProperties OB.maxProperties))
-  , ("minProperties"       , ValSpec noEm             (giveName   MinProperties OB.minProperties))
-  , ("required"            , ValSpec noEm             (giveName   Required      OB.required))
-  , ("properties"          , ValSpec objMembersEmbed  (modifyName fProp         OB.properties))
-  , ("patternProperties"   , ValSpec objMembersEmbed  (modifyName fPatProp      OB.patternProperties))
-  , ("additionalProperties", ValSpec objEmbed         (modifyName fAddProp      OB.additionalProperties))
-  , ("dependencies"        , ValSpec objMembersEmbed  (modifyName fDeps         OB.dependencies))
-  , ("enum"                , ValSpec noEm             (giveName   Enum          enum))
-  , ("type"                , ValSpec noEm             (giveName   TypeValidator typeValidator))
-  , ("allOf"               , ValSpec arrayEmbed       (modifyName AllOf         allOf))
-  , ("anyOf"               , ValSpec arrayEmbed       (giveName   AnyOf         anyOf))
-  , ("oneOf"               , ValSpec arrayEmbed       (giveName   OneOf         oneOf))
-  , ("not"                 , ValSpec objEmbed         (giveName   NotValidator  notValidator))
-  , ("definitions"         , ValSpec objMembersEmbed  neverBuild) -- Just contains referenceable schemas.
-  ]
+-- | In normal situations just use 'checkSchema', which is a combination of
+-- 'schemaValidity' and 'runValidate'.
+schemaValidity :: Schema -> [Failure]
+schemaValidity = IN.runValidate cache (SchemaContext Nothing d4) . toJSON
   where
-    fMax NU.Maximum = Maximum
-    fMax NU.ExclusiveMaximum = ExclusiveMaximum
-
-    fMin NU.Minimum = Minimum
-    fMin NU.ExclusiveMinimum = ExclusiveMinimum
-
-    fItems (AR.Items err) = Items err
-    fItems AR.AdditionalItemsBool = AdditionalItemsBool
-    fItems (AR.AdditionalItemsObject err) = AdditionalItemsObject err
-
-    fProp (OB.Properties err) = Properties err
-    fProp (OB.PropPattern err) = PatternProperties err
-    fProp (OB.PropAdditional OB.AdditionalPropertiesBool) = AdditionalPropertiesBool
-    fProp (OB.PropAdditional (OB.AdditionalPropertiesObject err)) = AdditionalPropertiesObject err
-
-    fPatProp (OB.PatternProperties err) = PatternProperties err
-    fPatProp (OB.PatternAdditional OB.AdditionalPropertiesBool) = AdditionalPropertiesBool
-    fPatProp (OB.PatternAdditional (OB.AdditionalPropertiesObject err)) = AdditionalPropertiesObject err
-
-    fAddProp OB.AdditionalPropertiesBool = AdditionalPropertiesBool
-    fAddProp (OB.AdditionalPropertiesObject err) = AdditionalItemsObject err
-
-    fDeps (OB.SchemaDependency err) = SchemaDependency err
-    fDeps OB.PropertyDependency = PropertyDependency
-
--- | Check if a 'RawSchema' is valid Draft 4 schema.
---
--- This is just a convenience function built by preloading 'validate'
--- with the spec schema that describes valid Draft 4 schemas.
---
--- NOTE: It's not actually required to run 'isValidSchema' on
--- prospective draft 4 schemas at all. However, it's a good way to
--- catch unintentional mistakes in schema documents.
-isValidSchema :: RawSchema -> [ValidationFailure Draft4Failure]
-isValidSchema r =
-  case decode . LBS.fromStrict $ $(embedFile "draft4.json") of
-    Nothing -> error "Schema decode failed (this should never happen)"
-    Just s  ->
-      let a = RawSchema Nothing s
-      in validate (compile draft4 (SchemaGraph a mempty) a) $ Object (_rsData r)
+    d4 :: Schema
+    d4 = fromMaybe (error "Schema decode failed (this should never happen)")
+       . decode . LBS.fromStrict $ $(embedFile "draft4.json")
 
--- | Check that a 'RawSchema' conforms to the JSON Schema Draft 4
--- master schema document. Compile it if it does.
---
--- This is just a convenience function built by combining
--- 'isValidSchema' and 'compile'.
---
--- NOTE: It's not actually required to run 'isValidSchema' on
--- prospective draft 4 schemas at all.
-compileDraft4 :: SchemaGraph -> RawSchema -> Either [ValidationFailure Draft4Failure] (Schema Draft4Failure)
-compileDraft4 g r =
-  case isValidSchema r of
-    []   -> Right (compile draft4 g r)
-    errs -> Left errs
+    -- @fst . baseAndFragment@ is necessary to remove the trailing "#",
+    -- otherwise cache lookups to resolve internal references will fail.
+    cache :: SchemaCache Schema
+    cache = SchemaCache d4 $ case _schemaId d4 >>= fst . baseAndFragment of
+                               Nothing  -> mempty
+                               Just uri -> H.singleton uri d4
diff --git a/src/Data/JsonSchema/Draft4/Any.hs b/src/Data/JsonSchema/Draft4/Any.hs
deleted file mode 100644
--- a/src/Data/JsonSchema/Draft4/Any.hs
+++ /dev/null
@@ -1,115 +0,0 @@
-
-module Data.JsonSchema.Draft4.Any where
-
-import           Control.Monad
-import qualified Data.HashMap.Strict       as H
-import           Data.Maybe
-import           Data.Scientific
-import qualified Data.Vector               as V
-
-import           Data.JsonSchema.Core
-import           Data.JsonSchema.Helpers
-import           Data.JsonSchema.Reference
-import           Import
-
--- For GHCs before 7.10:
-import           Prelude                   hiding (any)
-
--- | http://json-schema.org/latest/json-schema-validation.html#anchor76
---
---  > The value of this keyword MUST be an array.
---  > This array MUST have at least one element.
---  > Elements in the array MUST be unique.
---  >
---  > Elements in the array MAY be of any type, including null.
---
--- NOTE: We actually respect this, and don't build the validator
--- if any of the elements aren't unique.
-enum :: ValidatorConstructor err [FailureInfo]
-enum _ _ _ val@(Array vs) = do
-  when (V.null vs || not (allUniqueValues vs)) Nothing
-  Just $ \x ->
-    if V.elem x vs
-      then mempty
-      else pure (FailureInfo val x)
-enum _ _ _ _ = Nothing
-
-typeValidator :: ValidatorConstructor err [FailureInfo]
-typeValidator _ _ _ (String val) = Just $ \x -> isJsonType x (pure val)
-typeValidator _ _ _ (Array vs) = do
-  ts <- traverse toTxt vs
-  unless (allUnique ts) Nothing
-  Just (`isJsonType` ts)
-typeValidator _ _ _ _ = Nothing
-
-isJsonType :: Value -> Vector Text -> [FailureInfo]
-isJsonType x xs =
-  case x of
-    (Null)     -> f "null"    xs
-    (Array _)  -> f "array"   xs
-    (Bool _)   -> f "boolean" xs
-    (Object _) -> f "object"  xs
-    (String _) -> f "string"  xs
-    (Number y) ->
-      case toBoundedInteger y :: Maybe Int of
-        Nothing -> f "number" xs
-        Just _  -> if V.elem "integer" xs
-                     then mempty
-                     else f "number" xs
-  where
-    f :: Text -> Vector Text -> [FailureInfo]
-    f t ts = if V.elem t ts
-               then mempty
-               else pure $ FailureInfo (Array (String <$> xs)) x
-
-allOf :: ValidatorConstructor err [ValidationFailure err]
-allOf spec g s (Array vs) = do
-  os <- traverse toObj vs
-  let subSchemas = compile spec g . RawSchema (_rsURI s) <$> V.toList os
-  Just $ \x -> join $ flip validate x <$> subSchemas
-allOf _ _ _ _ = Nothing
-
-anyOf :: ValidatorConstructor err [FailureInfo]
-anyOf spec g s val@(Array vs) = do
-  os <- traverse toObj vs
-  let subSchemas = compile spec g . RawSchema (_rsURI s) <$> os
-  Just $ \x ->
-    if any null (flip validate x <$> subSchemas)
-      then mempty
-      else pure (FailureInfo val x)
-anyOf _ _ _ _ = Nothing
-
-oneOf :: ValidatorConstructor err [FailureInfo]
-oneOf spec g s val@(Array vs) = do
-  os <- traverse toObj $ V.toList vs
-  let subSchemas = compile spec g . RawSchema (_rsURI s) <$> os
-  Just $ \x ->
-    if (length . filter null $ flip validate x <$> subSchemas) == 1
-      then mempty
-      else pure (FailureInfo val x)
-oneOf _ _ _ _ = Nothing
-
-notValidator :: ValidatorConstructor err [FailureInfo]
-notValidator spec g s val@(Object o) = do
-  let subSchema = compile spec g $ RawSchema (_rsURI s) o
-  Just $ \x ->
-    case validate subSchema x of
-      [] -> pure (FailureInfo val x)
-      _  -> mempty
-notValidator _ _ _ _ = Nothing
-
--- JSON Reference Draft Document:
---
---      http://tools.ietf.org/html/draft-pbryan-zyp-json-ref-03
-ref :: ValidatorConstructor err [ValidationFailure err]
-ref spec g s (String val) = do
-  let (mUri, mFragment) = resolveReference (_rsURI s) val
-  r <- RawSchema mUri <$> getReference mUri
-  let o = resolveFragment mFragment (_rsData r)
-  return . validate . compile spec g $ RawSchema (_rsURI r) o
-  where
-    getReference :: Maybe Text -> Maybe (HashMap Text Value)
-    getReference Nothing  = Just . _rsData . _startingSchema $ g
-    getReference (Just t) = H.lookup t (_cachedSchemas g)
-
-ref _ _ _ _ = Nothing
diff --git a/src/Data/JsonSchema/Draft4/Arrays.hs b/src/Data/JsonSchema/Draft4/Arrays.hs
deleted file mode 100644
--- a/src/Data/JsonSchema/Draft4/Arrays.hs
+++ /dev/null
@@ -1,100 +0,0 @@
-
-module Data.JsonSchema.Draft4.Arrays where
-
-import           Control.Monad
-import qualified Data.HashMap.Strict     as H
-import qualified Data.Vector             as V
-
-import           Data.JsonSchema.Core
-import           Data.JsonSchema.Helpers
-import           Import
-
-data ItemsFailure err
-  = Items err
-  | AdditionalItemsBool
-  | AdditionalItemsObject err
-
-data AdditionalItemsFailure err
-  = AdditionalBool
-  | AdditionalObject err
-
--- | A combination of items and additionalItems.
-items :: ValidatorConstructor err [ValidationFailure (ItemsFailure err)]
-items spec g s (Object o) =
-  let subSchema = compile spec g (RawSchema (_rsURI s) o)
-  in Just $ \x ->
-    case x of
-      Array ys -> V.toList ys >>= fmap (modifyFailureName Items) . validate subSchema
-      _        -> mempty
-items spec g s (Array vs) = do
-  os <- traverse toObj vs
-  let subSchemas = compile spec g . RawSchema (_rsURI s) <$> V.toList os
-      mAdditionalItems = additionalItems spec g s =<< H.lookup "additionalItems" (_rsData s)
-  Just $ \x ->
-    case x of
-      Array ys ->
-        let extras = V.drop (V.length os) ys
-            itemFailures = join $ fmap (modifyFailureName Items) <$> zipWith validate subSchemas (V.toList ys)
-            additionalItemFailures = runMaybeVal mAdditionalItems (Array extras)
-        in itemFailures <> fmap (modifyFailureName f) additionalItemFailures
-      _ -> mempty
-  where
-    f :: AdditionalItemsFailure err -> ItemsFailure err
-    f AdditionalBool         = AdditionalItemsBool
-    f (AdditionalObject err) = AdditionalItemsObject err
-items _ _ _ _ = Nothing
-
--- | Not included directly in the 'draft4' spec hashmap because it always
--- validates data unless 'items' is also present. This is because 'items'
--- defaults to {}.
-additionalItems :: ValidatorConstructor err [ValidationFailure (AdditionalItemsFailure err)]
-additionalItems _ _ _ val@(Bool v) =
-  Just $ \x ->
-    case x of
-      Array ys ->
-        if not v && V.length ys > 0
-          then pure $ ValidationFailure AdditionalBool (FailureInfo val x)
-          else mempty
-      _ -> mempty
-additionalItems spec g s (Object o) =
-  let subSchema = compile spec g (RawSchema (_rsURI s) o)
-  in Just $ \x ->
-    case x of
-      Array ys -> V.toList ys >>= fmap (modifyFailureName AdditionalObject) . validate subSchema
-      _        -> mempty
-additionalItems _ _ _ _ = Nothing
-
-maxItems :: ValidatorConstructor err [FailureInfo]
-maxItems _ _ _ val = do
-  n <- fromJSONInt val
-  greaterThanZero n
-  Just $ \x ->
-    case x of
-      Array ys ->
-        if V.length ys > n
-          then pure (FailureInfo val x)
-          else mempty
-      _ -> mempty
-
-minItems :: ValidatorConstructor err [FailureInfo]
-minItems _ _ _ val = do
-  n <- fromJSONInt val
-  greaterThanZero n
-  Just $ \x ->
-    case x of
-      Array ys ->
-        if V.length ys < n
-          then pure (FailureInfo val x)
-          else mempty
-      _ -> mempty
-
-uniqueItems :: ValidatorConstructor err [FailureInfo]
-uniqueItems _ _ _ val@(Bool v) = do
-  unless v Nothing
-  Just $ \x ->
-    case x of
-      (Array ys) -> if allUniqueValues ys
-        then mempty
-        else pure (FailureInfo val x)
-      _ -> mempty
-uniqueItems _ _ _ _ = Nothing
diff --git a/src/Data/JsonSchema/Draft4/Failure.hs b/src/Data/JsonSchema/Draft4/Failure.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/JsonSchema/Draft4/Failure.hs
@@ -0,0 +1,68 @@
+
+module Data.JsonSchema.Draft4.Failure where
+
+import qualified Data.Aeson.Pointer     as P
+
+import qualified Data.Validator.Failure as FR
+import           Import
+
+-- | A version of 'FR.Failure' specialized for JSON Schema Draft 4.
+data Failure = Failure
+  -- NOTE: We use a data type here instead of a newtype to provide a cleaner
+  -- API for those importing only 'Data.JsonSchema.Draft4' (which should be
+  -- the vast majority of users). Downsides: slower and hacky. I'd appreciate
+  -- feedback on this.
+  { _failureValidatorsCalled :: !ValidatorChain
+  , _failureFinalValidator   :: !Value
+  , _failureOffendingData    :: !P.Pointer
+  } deriving (Eq, Show)
+
+specializeForDraft4 :: FR.Failure ValidatorChain -> Failure
+specializeForDraft4 (FR.Failure a b c) = Failure a b c
+
+data ValidatorChain
+  = MultipleOf
+  | Maximum
+  | ExclusiveMaximum
+  | Minimum
+  | ExclusiveMinimum
+
+  | MaxLength
+  | MinLength
+  | PatternValidator
+
+  | MaxItems
+  | MinItems
+  | UniqueItems
+  | Items ValidatorChain
+  | AdditionalItemsBool
+  | AdditionalItemsObject ValidatorChain
+
+  | MaxProperties
+  | MinProperties
+  | Required
+  | SchemaDependency ValidatorChain
+  | PropertyDependency
+  | Properties ValidatorChain
+  | PatternProperties ValidatorChain
+  | AdditionalPropertiesBool
+  | AdditionalPropertiesObject ValidatorChain
+
+  | RefResolution
+    -- ^ Indicates a reference that failed to resolve.
+    --
+    -- NOTE: The language agnostic test suite doesn't specify if this should
+    -- cause a validation error or should allow data to pass. We choose to
+    -- return a validation error.
+    --
+    -- Also note that ideally we would enforce in the type system that any
+    -- failing references be dealt with before valididation. Then this could
+    -- be removed entirely.
+  | Ref ValidatorChain
+  | Enum
+  | TypeValidator
+  | AllOf ValidatorChain
+  | AnyOf
+  | OneOf
+  | NotValidator
+  deriving (Eq, Show)
diff --git a/src/Data/JsonSchema/Draft4/Internal.hs b/src/Data/JsonSchema/Draft4/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/JsonSchema/Draft4/Internal.hs
@@ -0,0 +1,280 @@
+
+module Data.JsonSchema.Draft4.Internal where
+
+import           Data.Aeson
+import qualified Data.HashMap.Strict            as H
+import qualified Data.List.NonEmpty             as N
+import           Data.Maybe                     (catMaybes, fromMaybe, isJust,
+                                                 maybeToList)
+import           Data.Scientific
+
+import           Data.JsonSchema.Draft4.Failure
+import           Data.JsonSchema.Draft4.Schema
+import           Data.JsonSchema.Fetch          (SchemaCache(..),
+                                                 SchemaContext(..))
+import qualified Data.Validator.Draft4.Any      as AN
+import qualified Data.Validator.Draft4.Array    as AR
+import qualified Data.Validator.Draft4.Number   as NU
+import qualified Data.Validator.Draft4.Object   as OB
+import qualified Data.Validator.Draft4.String   as ST
+import           Data.Validator.Failure         (modFailure, setFailure)
+import qualified Data.Validator.Failure         as FR
+import           Data.Validator.Reference       (newResolutionScope)
+import           Import
+
+-- For GHCs before 7.10:
+import           Prelude                        hiding (concat)
+
+--------------------------------------------------
+-- * Embedded Schemas
+--------------------------------------------------
+
+-- | Return a schema's immediate subschemas.
+--
+-- Pass this to 'fetchReferencedSchemas' so that function can find all the
+-- subschemas in a document. This allows 'fetchReferencedSchemas' to process
+-- only "$ref"s and "id"s that are actual schema keywords. For example,
+-- within a "properties" validator object an "id" key doesn't actually change
+-- any scope, but instead serves a validator-specific function.
+embedded :: Schema -> [Schema]
+embedded schema = concat
+  [ f _schemaItems
+      (\x -> case x of
+               AR.ItemsObject s -> pure s
+               AR.ItemsArray ss -> ss
+      )
+  , f _schemaAdditionalItems
+      (\x -> case x of
+               AR.AdditionalObject s -> pure s
+               _                     -> mempty
+      )
+  , f _schemaDependencies (catMaybes . fmap checkDependency . H.elems)
+  , f _schemaProperties H.elems
+  , f _schemaPatternProperties H.elems
+  , f _schemaAdditionalProperties
+      (\x -> case x of
+               OB.AdditionalPropertiesObject s -> pure s
+               _                               -> mempty
+      )
+  , f _schemaAllOf N.toList
+  , f _schemaAnyOf N.toList
+  , f _schemaOneOf N.toList
+  , f _schemaNot pure
+  , f _schemaDefinitions H.elems
+  ]
+  where
+    f :: (Schema -> Maybe a) -> (a -> [Schema]) -> [Schema]
+    f field nextLevelEmbedded = maybe mempty nextLevelEmbedded (field schema)
+
+    checkDependency :: OB.Dependency Schema -> Maybe Schema
+    checkDependency (OB.PropertyDependency _) = Nothing
+    checkDependency (OB.SchemaDependency s)   = Just s
+
+--------------------------------------------------
+-- * Validation (Exported from 'Data.JsonSchema.Draft4')
+--------------------------------------------------
+
+-- | In normal situations just use 'checkSchema', which is a combination of
+-- 'schemaValidity' and 'runValidate'.
+runValidate
+  :: SchemaCache Schema
+  -> SchemaContext Schema
+  -> Value
+  -> [Failure]
+runValidate = (fmap.fmap.fmap.fmap) specializeForDraft4 validateAny
+
+--------------------------------------------------
+-- * Validation (Main internal functions)
+--------------------------------------------------
+
+validateAny
+  :: SchemaCache Schema
+  -> SchemaContext Schema
+  -> Value
+  -> [FR.Failure ValidatorChain]
+validateAny cache sc x = concat
+  [ f _schemaEnum  (setFailure Enum)          (fmap maybeToList . AN.enumVal)
+  , f _schemaType  (setFailure TypeValidator) (fmap maybeToList . AN.typeVal)
+  , f _schemaAllOf (modFailure AllOf)         (AN.allOf recurse)
+  , f _schemaAnyOf (setFailure AnyOf)         (fmap maybeToList . AN.anyOf recurse)
+  , f _schemaOneOf (setFailure OneOf)         (fmap maybeToList . AN.oneOf recurse)
+  , f _schemaNot   (setFailure NotValidator)  (fmap maybeToList . AN.notVal recurse)
+  , refFailures
+  ] <> specificValidators
+  where
+    specificValidators :: [FR.Failure ValidatorChain]
+    specificValidators =
+      case x of
+        Number y -> validateNumber (_scSchema sc) y
+        String y -> validateString (_scSchema sc) y
+        Array y  -> validateArray cache sc y
+        Object y -> validateObject cache sc y
+        _        -> mempty
+
+    f = runSingle (_scSchema sc) x
+
+    recurse = descendNextLevel cache sc
+
+    -- Since the results of the 'AN.ref' validator are fairly complicated [1]
+    -- it's simpler not to use our 'f' helper function for it.
+    --
+    -- [1] A list of errors wrapped in a 'Maybe' where 'Nothing' represents
+    -- if resolving the reference itself failed.
+    refFailures :: [FR.Failure ValidatorChain]
+    refFailures =
+      case _schemaRef (_scSchema sc) of
+        Nothing        -> mempty
+        Just reference ->
+          maybe [FR.Failure RefResolution (toJSON reference) mempty]
+                (fmap (modFailure Ref))
+                $ AN.ref scope
+                         getReference
+                         (\a b -> validateAny cache (SchemaContext a b))
+                         reference
+                         x
+      where
+        scope :: Maybe Text
+        scope = newResolutionScope (_scURI sc) (_schemaId (_scSchema sc))
+
+        getReference :: Maybe Text -> Maybe Schema
+        getReference Nothing  = Just (_startingSchema cache)
+        getReference (Just t) = H.lookup t (_cachedSchemas cache)
+
+validateString
+  :: Schema
+  -> Text
+  -> [FR.Failure ValidatorChain]
+validateString schema x = concat
+  [ f _schemaMaxLength (setFailure MaxLength)        (fmap maybeToList . ST.maxLength)
+  , f _schemaMinLength (setFailure MinLength)        (fmap maybeToList . ST.minLength)
+  , f _schemaPattern   (setFailure PatternValidator) (fmap maybeToList . ST.patternVal)
+  ]
+  where
+    f = runSingle schema x
+
+validateNumber
+  :: Schema
+  -> Scientific
+  -> [FR.Failure ValidatorChain]
+validateNumber schema x = concat
+  [ f _schemaMultipleOf (setFailure MultipleOf) (fmap maybeToList . NU.multipleOf)
+  , f _schemaMaximum
+      (modFailure fMax)
+      ( fmap maybeToList
+      . NU.maximumVal (fromMaybe False (_schemaExclusiveMaximum schema))
+      )
+  , f _schemaMinimum
+      (modFailure fMin)
+      ( fmap maybeToList
+      . NU.minimumVal (fromMaybe False (_schemaExclusiveMinimum schema))
+      )
+  ]
+  where
+    f = runSingle schema x
+
+    fMax NU.Maximum          = Maximum
+    fMax NU.ExclusiveMaximum = ExclusiveMaximum
+
+    fMin NU.Minimum          = Minimum
+    fMin NU.ExclusiveMinimum = ExclusiveMinimum
+
+validateArray
+  :: SchemaCache Schema
+  -> SchemaContext Schema
+  -> Vector Value
+  -> [FR.Failure ValidatorChain]
+validateArray cache (SchemaContext mUri schema) x = concat
+  [ f _schemaMaxItems    (setFailure MaxItems)    (fmap maybeToList . AR.maxItems)
+  , f _schemaMinItems    (setFailure MinItems)    (fmap maybeToList . AR.minItems)
+  , f _schemaUniqueItems (setFailure UniqueItems) (fmap maybeToList . AR.uniqueItems)
+  , f _schemaItems
+      (modFailure fItems)
+      (AR.items recurse (_schemaAdditionalItems schema))
+  ]
+  where
+    f = runSingle schema x
+
+    recurse = descendNextLevel cache (SchemaContext mUri schema)
+
+    fItems (AR.Items err)                        = Items err
+    fItems AR.AdditionalItemsBoolFailure         = AdditionalItemsBool
+    fItems (AR.AdditionalItemsObjectFailure err) = AdditionalItemsObject err
+
+validateObject
+  :: SchemaCache Schema
+  -> SchemaContext Schema
+  -> HashMap Text Value
+  -> [FR.Failure ValidatorChain]
+validateObject cache (SchemaContext mUri schema) x = concat
+  [ f _schemaMaxProperties (setFailure MaxProperties) (fmap maybeToList . OB.maxProperties)
+  , f _schemaMinProperties (setFailure MinProperties) (fmap maybeToList . OB.minProperties)
+  , f _schemaRequired      (setFailure Required)      (fmap maybeToList . OB.required)
+  , f _schemaDependencies  (modFailure fDeps)         (OB.dependencies recurse)
+
+  , f _schemaProperties
+      (modFailure fProp)
+      (OB.properties recurse
+                     (_schemaPatternProperties schema)
+                     (_schemaAdditionalProperties schema))
+
+  , f _schemaPatternProperties
+      (modFailure fPatProp)
+      (case _schemaProperties schema of
+        Just _  -> const (const mempty)
+        Nothing -> OB.patternProperties recurse (_schemaAdditionalProperties schema))
+
+  , f _schemaAdditionalProperties
+      (modFailure fAddProp)
+      (if isJust (_schemaProperties schema) || isJust (_schemaPatternProperties schema)
+        then const (const mempty)
+        else OB.additionalProperties recurse)
+  ]
+  where
+    f = runSingle schema x
+
+    recurse = descendNextLevel cache (SchemaContext mUri schema)
+
+    fDeps (OB.SchemaDependencyFailure err) = SchemaDependency err
+    fDeps OB.PropertyDependencyFailure     = PropertyDependency
+
+    fProp (OB.PropertiesFailure err)   = Properties err
+    fProp (OB.PropPatternFailure err)  = PatternProperties err
+    fProp (OB.PropAdditionalFailure a) =
+      case a of
+        OB.APBoolFailure       -> AdditionalPropertiesBool
+        OB.APObjectFailure err -> AdditionalPropertiesObject err
+
+    fPatProp (OB.PPFailure err) = PatternProperties err
+    fPatProp (OB.PPAdditionalPropertiesFailure a)   =
+      case a of
+        OB.APBoolFailure       -> AdditionalPropertiesBool
+        OB.APObjectFailure err -> AdditionalPropertiesObject err
+
+    fAddProp OB.APBoolFailure         = AdditionalPropertiesBool
+    fAddProp (OB.APObjectFailure err) = AdditionalItemsObject err
+
+--------------------------------------------------
+-- * Validation (Internal utils)
+--------------------------------------------------
+
+descendNextLevel
+  :: SchemaCache Schema
+  -> SchemaContext Schema
+  -> Schema
+  -> Value
+  -> [FR.Failure ValidatorChain]
+descendNextLevel cache (SchemaContext mUri schema) =
+  validateAny cache . SchemaContext scope
+  where
+    scope :: Maybe Text
+    scope = newResolutionScope mUri (_schemaId schema)
+
+runSingle
+  :: Schema
+  -> dta
+  -> (Schema -> Maybe val)
+  -> (err -> FR.Failure ValidatorChain)
+  -> (val -> dta -> [err])
+  -> [FR.Failure ValidatorChain]
+runSingle schema dta field modifyError validate =
+  maybe mempty (\val -> modifyError <$> validate val dta) (field schema)
diff --git a/src/Data/JsonSchema/Draft4/Numbers.hs b/src/Data/JsonSchema/Draft4/Numbers.hs
deleted file mode 100644
--- a/src/Data/JsonSchema/Draft4/Numbers.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-
-module Data.JsonSchema.Draft4.Numbers where
-
-import           Data.Fixed              (mod')
-import qualified Data.HashMap.Strict     as H
-import           Data.Scientific
-
-import           Data.JsonSchema.Core
-import           Data.JsonSchema.Helpers
-import           Import
-
-data MaximumFailure = Maximum | ExclusiveMaximum
-data MinimumFailure = Minimum | ExclusiveMinimum
-
-multipleOf :: ValidatorConstructor err [FailureInfo]
-multipleOf _ _ _ val@(Number n) = do
-  greaterThanZero n
-  Just $ \x ->
-    case x of
-      Number y ->
-        if y `mod'` n /= 0
-          then pure (FailureInfo val x)
-          else mempty
-      _ -> mempty
-multipleOf _ _ _ _ = Nothing
-
-maximumVal :: ValidatorConstructor err [ValidationFailure MaximumFailure]
-maximumVal _ _ s val@(Number n) =
-  Just $ \x ->
-    case x of
-      Number y ->
-        let (greater, err) = checkExclusive
-        in if y `greater` n
-          then pure $ ValidationFailure err (FailureInfo val x)
-          else mempty
-      _ -> mempty
-  where
-    checkExclusive :: (Scientific -> Scientific -> Bool, MaximumFailure)
-    checkExclusive =
-      case H.lookup "exclusiveMaximum" (_rsData s) of
-        Just (Bool a) -> if a then ((>=), ExclusiveMaximum) else ((>), Maximum)
-        _             -> ((>), Maximum)
-maximumVal _ _ _ _ = Nothing
-
-minimumVal :: ValidatorConstructor err [ValidationFailure MinimumFailure]
-minimumVal _ _ s val@(Number n) =
-  Just $ \x ->
-    case x of
-      Number y ->
-        let (lesser, err) = checkExclusive
-        in if y `lesser` n
-          then pure $ ValidationFailure err (FailureInfo val x)
-          else mempty
-      _ -> mempty
-  where
-    checkExclusive :: (Scientific -> Scientific -> Bool, MinimumFailure)
-    checkExclusive =
-      case H.lookup "exclusiveMinimum" (_rsData s) of
-        Just (Bool a) -> if a then ((<=), ExclusiveMinimum) else ((<), Minimum)
-        _             -> ((<), Minimum)
-minimumVal _ _ _ _ = Nothing
diff --git a/src/Data/JsonSchema/Draft4/Objects.hs b/src/Data/JsonSchema/Draft4/Objects.hs
deleted file mode 100644
--- a/src/Data/JsonSchema/Draft4/Objects.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Data.JsonSchema.Draft4.Objects
-  ( module Data.JsonSchema.Draft4.Objects
-  , module Data.JsonSchema.Draft4.Objects.Properties
-  ) where
-
-import           Control.Monad
-import           Data.Aeson
-import           Data.Hashable
-import qualified Data.HashMap.Strict     as H
-import qualified Data.Vector             as V
-
-import           Data.JsonSchema.Core
-import           Data.JsonSchema.Draft4.Objects.Properties
-import           Data.JsonSchema.Helpers
-import           Import
-
-data DependencyFailure err = SchemaDependency err | PropertyDependency
-
-maxProperties :: ValidatorConstructor err [FailureInfo]
-maxProperties _ _ _ val = do
-  n <- fromJSONInt val
-  greaterThanZero n
-  Just $ \x ->
-    case x of
-      Object o ->
-        if H.size o > n
-          then pure (FailureInfo val x)
-          else mempty
-      _ -> mempty
-
-minProperties :: ValidatorConstructor err [FailureInfo]
-minProperties _ _ _ val = do
-  n <- fromJSONInt val
-  greaterThanZero n
-  Just $ \x ->
-    case x of
-      Object o ->
-        if H.size o < n
-          then pure (FailureInfo val x)
-          else mempty
-      _ -> mempty
-
-required :: ValidatorConstructor err [FailureInfo]
-required _ _ _ val@(Array vs) = do
-  when (V.length vs == 0) Nothing
-  ts <- traverse toTxt vs
-  let a = vectorToMapSet ts
-  when (H.size a /= V.length ts) Nothing
-  Just $ \x ->
-    case x of
-      Object o ->
-        if H.size (H.difference a o) > 0
-          then pure (FailureInfo val x)
-          else mempty
-      _ -> mempty
-  where
-    vectorToMapSet :: (Eq a, Hashable a) => Vector a -> HashMap a Bool
-    vectorToMapSet vec = H.fromList . V.toList $ (\x -> (x, True)) <$> vec -- TODO: use a fold.
-required _ _ _ _ = Nothing
-
--- http://json-schema.org/latest/json-schema-validation.html#anchor70
---
--- > This keyword's value MUST be an object.
--- > Each value of this object MUST be either an object or an array.
--- >
--- > If the value is an object, it MUST be a valid JSON Schema.
--- > This is called a schema dependency.
--- >
--- > If the value is an array, it MUST have at least one element.
--- > Each element MUST be a string, and elements in the array MUST be unique.
--- > This is called a property dependency.
-dependencies :: ValidatorConstructor err [ValidationFailure (DependencyFailure err)]
-dependencies spec g s val@(Object o) = do
-  let vs = H.toList o
-      schemaDeps = vs >>= toSchemaDep spec g
-      propDeps = vs >>= toPropDep
-  when (length schemaDeps + length propDeps /= length vs) Nothing
-  Just $ \x ->
-    case x of
-      Object y ->
-        let schemaFailures = join $ valSD y <$> schemaDeps
-            propertyFailures = join $ valPD y <$> propDeps
-        in schemaFailures <> propertyFailures
-      _ -> mempty
-  where
-    toSchemaDep :: Spec a -> SchemaGraph -> (Text, Value) -> [(Text, Schema a)]
-    toSchemaDep spc gr (t, Object ob) = pure (t, compile spc gr $ RawSchema (_rsURI s) ob)
-    toSchemaDep _ _ _ = mempty
-
-    toPropDep :: (Text, Value) -> [(Text, Vector Text)]
-    toPropDep (t, Array a) =
-      if V.length a <= 0
-        then mempty
-        else case traverse toTxt a of
-          Nothing -> mempty
-          Just ts ->
-            if allUnique ts
-              then pure (t, ts)
-              else mempty
-    toPropDep _ = mempty
-
-    valSD :: HashMap Text Value -> (Text, Schema err) -> [ValidationFailure (DependencyFailure err)]
-    valSD d (k, subSchema) =
-      case H.lookup k d of
-        Nothing -> mempty
-        Just _  -> modifyFailureName SchemaDependency <$> validate subSchema (Object d)
-
-    valPD :: HashMap Text Value -> (Text, Vector Text) -> [ValidationFailure (DependencyFailure err)]
-    valPD d (k, ks) =
-      case H.lookup k d of
-        Nothing -> mempty
-        Just _  ->
-          case traverse (flip H.lookup d) ks of
-            Nothing -> pure $ ValidationFailure PropertyDependency (FailureInfo val (Object d))
-            Just _  -> mempty
-dependencies _ _ _ _ = Nothing
diff --git a/src/Data/JsonSchema/Draft4/Objects/Properties.hs b/src/Data/JsonSchema/Draft4/Objects/Properties.hs
deleted file mode 100644
--- a/src/Data/JsonSchema/Draft4/Objects/Properties.hs
+++ /dev/null
@@ -1,145 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Data.JsonSchema.Draft4.Objects.Properties where
-
-import           Control.Monad
-import           Data.Aeson
-import qualified Data.HashMap.Strict     as H
-import           Data.Maybe
-import qualified Data.Text               as T
-import           Text.RegexPR
-
-import           Data.JsonSchema.Core
-import           Data.JsonSchema.Helpers
-import           Import
-
-data PropertiesFailure err
-  = Properties err
-  | PropPattern err
-  | PropAdditional (AdditionalPropertiesFailure err)
-
-data PatternPropertiesFailure err
-  = PatternProperties err
-  | PatternAdditional (AdditionalPropertiesFailure err)
-
-data AdditionalPropertiesFailure err
-  = AdditionalPropertiesBool
-  | AdditionalPropertiesObject err
-
--- | In order of what's tried: properties, patternProperties, additionalProperties
-properties :: forall err. ValidatorConstructor err [ValidationFailure (PropertiesFailure err)]
-properties spec g s val = do
-  let mProps   = propertiesUnmatched val
-      mPatProp = patternUnmatched spec g s =<< H.lookup "patternProperties" (_rsData s)
-      mAddProp = runAdditionalProperties spec g s =<< H.lookup "additionalProperties" (_rsData s)
-  when (isNothing mProps && isNothing mPatProp && isNothing mAddProp) Nothing
-  Just $ \x ->
-    case x of
-      Object y ->
-        let (propFailures, remaining) = runMaybeVal' mProps (Object y)
-            patternFailures           = fst $ runMaybeVal' mPatProp (Object y)
-            remaining'                = snd $ runMaybeVal' mPatProp remaining
-            additionalFailures        = runMaybeVal mAddProp remaining'
-        in fmap (modifyFailureName Properties) propFailures
-             <> fmap (modifyFailureName PropPattern) patternFailures
-             <> fmap (modifyFailureName PropAdditional) additionalFailures
-      _ -> mempty
-  where
-    propertiesUnmatched :: Value -> Maybe (Value -> ([ValidationFailure err], Value))
-    propertiesUnmatched (Object o) = do
-      os <- traverse toObj o
-      let matchedSchemas = compile spec g . RawSchema (_rsURI s) <$> os
-      Just (\x ->
-        case x of
-          Object y ->
-            let rawFailures = H.intersectionWith validate matchedSchemas y
-                failures = join (H.elems rawFailures)
-                leftovers = Object (H.difference y matchedSchemas)
-            in (failures, leftovers)
-          z -> (mempty, z))
-    propertiesUnmatched _ = Nothing
-
-patternProperties :: ValidatorConstructor err [ValidationFailure (PatternPropertiesFailure err)]
-patternProperties spec g s val = do
-  when (H.member "properties" (_rsData s)) Nothing
-  let mPatternProps = patternUnmatched spec g s val
-  let mAdditionalProps = runAdditionalProperties spec g s =<< H.lookup "additionalProperties" (_rsData s)
-  when (isNothing mPatternProps && isNothing mAdditionalProps) Nothing
-  Just $ \x ->
-    case x of
-      Object y ->
-        let (ppFailures, remaining') = runMaybeVal' mPatternProps (Object y)
-            addFailures              = runMaybeVal mAdditionalProps remaining'
-        in fmap (modifyFailureName PatternProperties) ppFailures <> fmap (modifyFailureName PatternAdditional) addFailures
-      _ -> mempty
-
-patternUnmatched
-  :: Spec err
-  -> SchemaGraph
-  -> RawSchema
-  -> Value
-  -> Maybe (Value -> ([ValidationFailure err], Value))
-patternUnmatched spec g s (Object val) = do
-  os <- traverse toObj val
-  let subSchemas = compile spec g . RawSchema (_rsURI s) <$> os
-  Just (\x ->
-    case x of
-      Object y -> let ms = H.foldlWithKey' (matches subSchemas) mempty y
-                  in (H.foldl' runVals mempty ms, Object (leftovers ms))
-      _        -> (mempty, x))
-  where
-    matches
-      :: HashMap Text (Schema a)
-      -> HashMap Text (Value, [Schema a])
-      -> Text
-      -> Value
-      -> HashMap Text (Value, [Schema a])
-    matches subSchemas acc k v = H.insert k (v, H.foldlWithKey' (match k) mempty subSchemas) acc
-
-    match
-      :: Text
-      -> [Schema a]
-      -> Text
-      -> Schema a
-      -> [Schema a]
-    match k acc r subSchema =
-      case matchRegexPR (T.unpack r) (T.unpack k) of
-        Nothing -> acc
-        Just _  -> pure subSchema <> acc
-
-    runVals
-      :: [ValidationFailure err]
-      -> (Value, [Schema err])
-      -> [ValidationFailure err]
-    runVals acc (v,subSchema) = (subSchema >>= flip validate v) <> acc
-
-    leftovers :: HashMap Text (Value, [Schema a]) -> HashMap Text Value
-    leftovers possiblyMatched = fst <$> H.filter (null . snd) possiblyMatched
-patternUnmatched _ _ _ _ = Nothing
-
-additionalProperties :: ValidatorConstructor err [ValidationFailure (AdditionalPropertiesFailure err)]
-additionalProperties spec g s val = do
-  when (H.member "properties" (_rsData s)) Nothing
-  when (H.member "patternProperties" (_rsData s)) Nothing
-  runAdditionalProperties spec g s val
-
--- | An additionalProperties validator than never disables itself.
---
--- Not meant to be used standalone, but useful inside of the properties
--- and patternProperties validators.
-runAdditionalProperties :: ValidatorConstructor err [ValidationFailure (AdditionalPropertiesFailure err)]
-runAdditionalProperties _ _ _ val@(Bool v) =
-  Just $ \x ->
-    case x of
-      Object y ->
-        if not v && H.size y > 0
-          then pure $ ValidationFailure AdditionalPropertiesBool (FailureInfo val x)
-          else mempty
-      _ -> mempty
-runAdditionalProperties spec g s (Object o) =
-  let sub = compile spec g (RawSchema (_rsURI s) o)
-  in Just $ \x ->
-    case x of
-      Object y -> H.elems y >>= fmap (modifyFailureName AdditionalPropertiesObject) . validate sub
-      _        -> mempty
-runAdditionalProperties _ _ _ _ = Nothing
diff --git a/src/Data/JsonSchema/Draft4/Schema.hs b/src/Data/JsonSchema/Draft4/Schema.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/JsonSchema/Draft4/Schema.hs
@@ -0,0 +1,334 @@
+
+module Data.JsonSchema.Draft4.Schema where
+
+import qualified Data.HashMap.Strict          as H
+import           Data.List.NonEmpty           (NonEmpty)
+import           Data.Maybe                   (fromJust, isJust)
+import           Data.Scientific
+
+import qualified Data.Validator.Draft4.Any    as AN
+import qualified Data.Validator.Draft4.Array  as AR
+import qualified Data.Validator.Draft4.Object as OB
+import           Data.Validator.Utils
+import           Import
+
+data Schema = Schema
+  { _schemaVersion              :: Maybe Text
+  , _schemaId                   :: Maybe Text
+  , _schemaRef                  :: Maybe Text
+  , _schemaDefinitions          :: Maybe (HashMap Text Schema)
+  -- ^ A standardized location for embedding schemas
+  -- to be referenced from elsewhere in the document.
+  , _schemaOther                :: HashMap Text Value
+  -- ^ Since the JSON document this Schema was built from could
+  -- contain schemas anywhere (not just in "definitions" or any
+  -- of the other official keys) we save any leftover key/value
+  -- pairs not covered by them here.
+
+  , _schemaMultipleOf           :: Maybe Scientific
+  , _schemaMaximum              :: Maybe Scientific
+  , _schemaExclusiveMaximum     :: Maybe Bool
+  , _schemaMinimum              :: Maybe Scientific
+  , _schemaExclusiveMinimum     :: Maybe Bool
+
+  , _schemaMaxLength            :: Maybe Int
+  , _schemaMinLength            :: Maybe Int
+  , _schemaPattern              :: Maybe Text
+
+  , _schemaMaxItems             :: Maybe Int
+  , _schemaMinItems             :: Maybe Int
+  , _schemaUniqueItems          :: Maybe Bool
+  , _schemaItems                :: Maybe (AR.Items Schema)
+  -- Note that '_schemaAdditionalItems' is left out of 'runValidate'
+  -- because its functionality is handled by '_schemaItems'. It always
+  -- validates data unless 'Items' is present.
+  , _schemaAdditionalItems      :: Maybe (AR.AdditionalItems Schema)
+
+  , _schemaMaxProperties        :: Maybe Int
+  , _schemaMinProperties        :: Maybe Int
+  , _schemaRequired             :: Maybe OB.Required
+  , _schemaDependencies         :: Maybe (HashMap Text (OB.Dependency Schema))
+  , _schemaProperties           :: Maybe (HashMap Text Schema)
+  , _schemaPatternProperties    :: Maybe (HashMap Text Schema)
+  , _schemaAdditionalProperties :: Maybe (OB.AdditionalProperties Schema)
+
+  , _schemaEnum                 :: Maybe AN.EnumVal
+  , _schemaType                 :: Maybe AN.TypeVal
+  , _schemaAllOf                :: Maybe (NonEmpty Schema)
+  , _schemaAnyOf                :: Maybe (NonEmpty Schema)
+  , _schemaOneOf                :: Maybe (NonEmpty Schema)
+  , _schemaNot                  :: Maybe Schema
+  } deriving (Eq, Show)
+
+emptySchema :: Schema
+emptySchema = Schema
+  { _schemaVersion              = Nothing
+  , _schemaId                   = Nothing
+  , _schemaRef                  = Nothing
+  , _schemaDefinitions          = Nothing
+  , _schemaOther                = mempty
+
+  , _schemaMultipleOf           = Nothing
+  , _schemaMaximum              = Nothing
+  , _schemaExclusiveMaximum     = Nothing
+  , _schemaMinimum              = Nothing
+  , _schemaExclusiveMinimum     = Nothing
+
+  , _schemaMaxLength            = Nothing
+  , _schemaMinLength            = Nothing
+  , _schemaPattern              = Nothing
+
+  , _schemaMaxItems             = Nothing
+  , _schemaMinItems             = Nothing
+  , _schemaUniqueItems          = Nothing
+  , _schemaItems                = Nothing
+  , _schemaAdditionalItems      = Nothing
+
+  , _schemaMaxProperties        = Nothing
+  , _schemaMinProperties        = Nothing
+  , _schemaRequired             = Nothing
+  , _schemaDependencies         = Nothing
+  , _schemaProperties           = Nothing
+  , _schemaPatternProperties    = Nothing
+  , _schemaAdditionalProperties = Nothing
+
+  , _schemaEnum                 = Nothing
+  , _schemaType                 = Nothing
+  , _schemaAllOf                = Nothing
+  , _schemaAnyOf                = Nothing
+  , _schemaOneOf                = Nothing
+  , _schemaNot                  = Nothing
+  }
+
+instance FromJSON Schema where
+  parseJSON = withObject "Schema" $ \o -> do
+    a  <- o .:? "$schema"
+    b  <- o .:? "id"
+    c  <- o .:? "$ref"
+    d  <- o .:? "definitions"
+    e  <- parseJSON (Object (H.difference o internalSchemaHashMap))
+
+    f  <- o .:? "multipleOf"
+    g  <- o .:? "maximum"
+    h  <- o .:? "exclusiveMaximum"
+    i  <- o .:? "minimum"
+    j  <- o .:? "exclusiveMinimum"
+
+    k  <- o .:? "maxLength"
+    l  <- o .:? "minLength"
+    m  <- o .:? "pattern"
+
+    n  <- o .:? "maxItems"
+    o' <- o .:? "minItems"
+    p  <- o .:? "uniqueItems"
+    q  <- o .:? "items"
+    r  <- o .:? "additionalItems"
+
+    s  <- o .:? "maxProperties"
+    t  <- o .:? "minProperties"
+    u  <- o .:? "required"
+    v  <- o .:? "dependencies"
+    w  <- o .:? "properties"
+    x  <- o .:? "patternProperties"
+    y  <- o .:? "additionalProperties"
+
+    z  <- o .:? "enum"
+    a2 <- o .:? "type"
+    b2 <- fmap _unNonEmpty' <$> o .:? "allOf"
+    c2 <- fmap _unNonEmpty' <$> o .:? "anyOf"
+    d2 <- fmap _unNonEmpty' <$> o .:? "oneOf"
+    e2 <- o .:? "not"
+    pure Schema
+      { _schemaVersion              = a
+      , _schemaId                   = b
+      , _schemaRef                  = c
+      , _schemaDefinitions          = d
+      , _schemaOther                = e
+
+      , _schemaMultipleOf           = f
+      , _schemaMaximum              = g
+      , _schemaExclusiveMaximum     = h
+      , _schemaMinimum              = i
+      , _schemaExclusiveMinimum     = j
+
+      , _schemaMaxLength            = k
+      , _schemaMinLength            = l
+      , _schemaPattern              = m
+
+      , _schemaMaxItems             = n
+      , _schemaMinItems             = o'
+      , _schemaUniqueItems          = p
+      , _schemaItems                = q
+      , _schemaAdditionalItems      = r
+
+      , _schemaMaxProperties        = s
+      , _schemaMinProperties        = t
+      , _schemaRequired             = u
+      , _schemaDependencies         = v
+      , _schemaProperties           = w
+      , _schemaPatternProperties    = x
+      , _schemaAdditionalProperties = y
+
+      , _schemaEnum                 = z
+      , _schemaType                 = a2
+      , _schemaAllOf                = b2
+      , _schemaAnyOf                = c2
+      , _schemaOneOf                = d2
+      , _schemaNot                  = e2
+      }
+
+instance ToJSON Schema where
+  -- | The way we resolve JSON Pointers to embedded schemas is by
+  -- serializing the containing schema to a value and then resolving the
+  -- pointer against it. This means that FromJSON and ToJSON must be
+  -- isomorphic.
+  --
+  -- This influences the design choices in the library. E.g. right now
+  -- there are two false values for "exclusiveMaximum" -- Nothing and
+  -- Just False. We could have condensed them down by using () instead
+  -- of Bool for "exclusiveMaximum". This would have made writing schemas
+  -- in haskell easier, but we could no longer round trip through/from
+  -- JSON without losing information.
+  toJSON s = Object $ H.union (mapMaybe ($ s) internalSchemaHashMap) (toJSON <$> _schemaOther s)
+    where
+      -- 'mapMaybe' is provided by unordered-containers after unordered-container-2.6.0.0,
+      -- but until that is a little older (and has time to get into Stackage etc.)
+      -- we use our own implementation.
+      mapMaybe :: (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
+      mapMaybe f = fmap fromJust . H.filter isJust . fmap f
+
+-- | Internal. Separate from ToJSON because it's also used
+-- by FromJSON to determine what keys aren't official schema
+-- keys and therefor should be included in _schemaOther.
+internalSchemaHashMap :: HashMap Text (Schema -> Maybe Value)
+internalSchemaHashMap = H.fromList
+  [ ("$schema"             , f _schemaVersion)
+  , ("id"                  , f _schemaId)
+  , ("$ref"                , f _schemaRef)
+  , ("definitions"         , f _schemaDefinitions)
+
+  , ("multipleOf"          , f _schemaMultipleOf)
+  , ("maximum"             , f _schemaMaximum)
+  , ("exclusiveMaximum"    , f _schemaExclusiveMaximum)
+  , ("minimum"             , f _schemaMinimum)
+  , ("exclusiveMinimum"    , f _schemaExclusiveMinimum)
+
+  , ("maxLength"           , f _schemaMaxLength)
+  , ("minLength"           , f _schemaMinLength)
+  , ("pattern"             , f _schemaPattern)
+
+  , ("maxItems"            , f _schemaMaxItems)
+  , ("minItems"            , f _schemaMinItems)
+  , ("uniqueItems"         , f _schemaUniqueItems)
+  , ("items"               , f _schemaItems)
+  , ("additionalItems"     , f _schemaAdditionalItems)
+
+  , ("maxProperties"       , f _schemaMaxProperties)
+  , ("minProperties"       , f _schemaMinProperties)
+  , ("required"            , f _schemaRequired)
+  , ("dependencies"        , f _schemaDependencies)
+  , ("properties"          , f _schemaProperties)
+  , ("patternProperties"   , f _schemaPatternProperties)
+  , ("additionalProperties", f _schemaAdditionalProperties)
+
+  , ("enum"                , f _schemaEnum)
+  , ("type"                , f _schemaType)
+  , ("allOf"               , f (fmap NonEmpty' . _schemaAllOf))
+  , ("anyOf"               , f (fmap NonEmpty' . _schemaAnyOf))
+  , ("oneOf"               , f (fmap NonEmpty' . _schemaOneOf))
+  , ("not"                 , f _schemaNot)
+  ]
+  where
+    f :: ToJSON a => (Schema -> Maybe a) -> Schema -> Maybe Value
+    f = (fmap.fmap) toJSON
+
+instance Arbitrary Schema where
+  arbitrary = sized f
+    where
+      maybeGen :: Gen a -> Gen (Maybe a)
+      maybeGen a = oneof [pure Nothing, Just <$> a]
+
+      maybeRecurse :: Int -> Gen a -> Gen (Maybe a)
+      maybeRecurse n a
+        | n < 1     = pure Nothing
+        | otherwise = maybeGen $ resize (n `div` 10) a
+
+      f :: Int -> Gen Schema
+      f n = do
+        a  <- maybeGen arbitraryText
+        b  <- maybeGen arbitraryText
+        c  <- maybeGen arbitraryText
+           -- NOTE: The next two fields are empty to generate cleaner schemas,
+           -- but note that this means we don't test e.g. the invertability
+           -- of these fields.
+        d  <- pure Nothing -- _schemaDefinitions
+        e  <- pure mempty -- _otherPairs
+
+        f' <- maybeGen arbitraryPositiveScientific
+        g  <- maybeGen arbitraryScientific
+        h  <- arbitrary
+        i  <- maybeGen arbitraryScientific
+        j  <- arbitrary
+
+        k  <- maybeGen (getPositive <$> arbitrary)
+        l  <- maybeGen (getPositive <$> arbitrary)
+        m  <- maybeGen arbitraryText
+
+        n' <- maybeGen (getPositive <$> arbitrary)
+        o  <- maybeGen (getPositive <$> arbitrary)
+        p  <- arbitrary
+        q  <- maybeRecurse n arbitrary
+        r  <- maybeRecurse n arbitrary
+
+        s  <- maybeGen (getPositive <$> arbitrary)
+        t  <- maybeGen (getPositive <$> arbitrary)
+        u  <- arbitrary
+        v  <- maybeRecurse n arbitraryHashMap
+        w  <- maybeRecurse n arbitraryHashMap
+        x  <- maybeRecurse n arbitraryHashMap
+        y  <- maybeRecurse n arbitrary
+
+        z  <- arbitrary
+        a2 <- arbitrary
+        b2 <- maybeRecurse n (_unNonEmpty' <$> arbitrary)
+        c2 <- maybeRecurse n (_unNonEmpty' <$> arbitrary)
+        d2 <- maybeRecurse n (_unNonEmpty' <$> arbitrary)
+        e2 <- maybeRecurse n arbitrary
+        pure Schema
+          { _schemaVersion              = a
+          , _schemaId                   = b
+          , _schemaRef                  = c
+          , _schemaDefinitions          = d
+          , _schemaOther                = e
+
+          , _schemaMultipleOf           = f'
+          , _schemaMaximum              = g
+          , _schemaExclusiveMaximum     = h
+          , _schemaMinimum              = i
+          , _schemaExclusiveMinimum     = j
+
+          , _schemaMaxLength            = k
+          , _schemaMinLength            = l
+          , _schemaPattern              = m
+
+          , _schemaMaxItems             = n'
+          , _schemaMinItems             = o
+          , _schemaUniqueItems          = p
+          , _schemaItems                = q
+          , _schemaAdditionalItems      = r
+
+          , _schemaMaxProperties        = s
+          , _schemaMinProperties        = t
+          , _schemaRequired             = u
+          , _schemaDependencies         = v
+          , _schemaProperties           = w
+          , _schemaPatternProperties    = x
+          , _schemaAdditionalProperties = y
+
+          , _schemaEnum                 = z
+          , _schemaType                 = a2
+          , _schemaAllOf                = b2
+          , _schemaAnyOf                = c2
+          , _schemaOneOf                = d2
+          , _schemaNot                  = e2
+          }
diff --git a/src/Data/JsonSchema/Draft4/Strings.hs b/src/Data/JsonSchema/Draft4/Strings.hs
deleted file mode 100644
--- a/src/Data/JsonSchema/Draft4/Strings.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-
-module Data.JsonSchema.Draft4.Strings where
-
-import qualified Data.Text               as T
-import           Text.RegexPR
-
-import           Data.JsonSchema.Core
-import           Data.JsonSchema.Helpers
-import           Import
-
-maxLength :: ValidatorConstructor err [FailureInfo]
-maxLength _ _ _ val = do
-  n <- fromJSONInt val
-  greaterThanZero n
-  Just $ \x ->
-    case x of
-      String y ->
-        if T.length y > n
-          then pure (FailureInfo val x)
-          else mempty
-      _ -> mempty
-
-minLength :: ValidatorConstructor err [FailureInfo]
-minLength _ _ _ val = do
-  n <- fromJSONInt val
-  greaterThanZero n
-  Just $ \x ->
-    case x of
-      String y ->
-        if T.length y < n
-          then pure (FailureInfo val x)
-          else mempty
-      _ -> mempty
-
-pattern :: ValidatorConstructor err [FailureInfo]
-pattern _ _ _ val@(String t) =
-  Just $ \x ->
-    case x of
-      String y ->
-        case matchRegexPR (T.unpack t) (T.unpack y) of
-          Nothing -> pure (FailureInfo val x)
-          Just _  -> mempty
-      _ -> mempty
-pattern _ _ _ _ = Nothing
diff --git a/src/Data/JsonSchema/Fetch.hs b/src/Data/JsonSchema/Fetch.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/JsonSchema/Fetch.hs
@@ -0,0 +1,133 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Data.JsonSchema.Fetch where
+
+import           Control.Exception        (SomeException(..), catch)
+import qualified Data.ByteString.Lazy     as LBS
+import qualified Data.HashMap.Strict      as H
+import qualified Data.Text                as T
+import           Network.HTTP.Client
+
+import           Data.Validator.Reference (isRemoteReference,
+                                           newResolutionScope,
+                                           resolveReference)
+import           Import
+
+-- For GHCs before 7.10:
+import           Prelude                  hiding (concat, sequence)
+
+data SchemaContext schema = SchemaContext
+  { _scURI    :: !(Maybe Text)
+  -- ^ Must not include a URI fragment, e.g. use
+  -- "http://example.com/foo" not "http://example.com/foo#bar".
+  --
+  -- This is the URI identifying the document containing the schema.
+  -- It's different than the schema's "id" field, which controls scope
+  -- when resolving references contained in the schema.
+
+  -- TODO: Make the no URI fragment requirement unnecessary.
+
+  , _scSchema :: !schema
+  } deriving (Eq, Show)
+
+-- | Keys are URIs (without URI fragments).
+type URISchemaMap schema = HashMap Text schema
+
+data SchemaCache schema = SchemaCache
+  { _startingSchema :: !schema
+  -- ^ Used to resolve relative references.
+  , _cachedSchemas  :: !(URISchemaMap schema)
+  } deriving (Eq, Show)
+
+-- | Take a schema. Retrieve every document either it or its subschemas
+-- include via the "$ref" keyword. Load a 'SchemaCache' out with them.
+fetchReferencedSchemas
+  :: forall schema. FromJSON schema
+  => (schema -> [schema])
+  -> (schema -> Maybe Text)
+  -> (schema -> Maybe Text)
+  -> URISchemaMap schema
+  -> SchemaContext schema
+  -> IO (Either Text (SchemaCache schema))
+fetchReferencedSchemas embedded getId getRef cache sc = do
+  manager <- newManager defaultManagerSettings
+  catch (Right <$> f manager) handler
+  where
+    f manager = fetchReferencedSchemas' embedded getId getRef
+                                        (simpleGET manager) cache sc
+
+    handler :: SomeException -> IO (Either Text (SchemaCache schema))
+    handler e = pure . Left . T.pack . show $ e
+
+-- | Based on 'Network.Http.Conduit.simpleHttp' from http-conduit.
+simpleGET :: Manager -> Text -> IO LBS.ByteString
+simpleGET man url = do
+  req <- parseUrl (T.unpack url)
+  responseBody <$> httpLbs req { requestHeaders = ("Connection", "close")
+                               : requestHeaders req
+                               } man
+
+-- | A version of 'fetchReferencedSchema's where the function to fetch
+-- schemas is provided by the user. This allows restrictions to be added,
+-- e.g. rejecting non-local URIs.
+fetchReferencedSchemas'
+  :: forall schema. FromJSON schema
+  => (schema -> [schema])
+  -> (schema -> Maybe Text)
+  -> (schema -> Maybe Text)
+  -> (Text -> IO LBS.ByteString)
+  -> URISchemaMap schema
+  -> SchemaContext schema
+  -> IO (SchemaCache schema)
+fetchReferencedSchemas' embedded getId getRef fetchRef cache sc = do
+  let startingCache = case _scURI sc of
+                        Nothing  -> cache
+                        Just uri -> H.insert uri (_scSchema sc) cache
+  SchemaCache (_scSchema sc) <$> foldlM fetchRecursively
+                                        startingCache
+                                        (includeSubschemas embedded getId sc)
+  where
+    fetchRecursively
+      :: URISchemaMap schema
+      -> SchemaContext schema
+      -> IO (URISchemaMap schema)
+    fetchRecursively g (SchemaContext mUri schema) = do
+      -- Resolving the new scope is necessary here because of situations
+      -- like this:
+      --
+      -- {
+      --     "id": "http://localhost:1234/",
+      --     "items": {
+      --         "id": "folder/",
+      --         "items": {"$ref": "folderInteger.json"}
+      --     }
+      -- }
+      let scope = newResolutionScope mUri (getId schema)
+      case resolveReference scope <$> getRef schema of
+        Just (Just uri,_) ->
+          if not (isRemoteReference uri) || H.member uri g
+            then pure g
+            else do
+              bts <- fetchRef uri
+              case eitherDecode bts of
+                Left e     -> ioError (userError e)
+                Right schm -> _cachedSchemas <$>
+                  fetchReferencedSchemas' embedded getId getRef fetchRef
+                                          g (SchemaContext (Just uri) schm)
+        _ -> pure g
+
+-- | Return the schema passed in as an argument, as well as every
+-- subschema contained within it.
+includeSubschemas
+  :: forall schema.
+     (schema -> [schema])
+  -> (schema -> Maybe Text)
+  -> SchemaContext schema
+  -> [SchemaContext schema]
+includeSubschemas embedded getId (SchemaContext mUri schema) =
+  SchemaContext mUri schema
+  : (includeSubschemas embedded getId =<< subSchemas)
+  where
+    subSchemas :: [SchemaContext schema]
+    subSchemas = SchemaContext (newResolutionScope mUri (getId schema))
+             <$> embedded schema
diff --git a/src/Data/JsonSchema/Helpers.hs b/src/Data/JsonSchema/Helpers.hs
deleted file mode 100644
--- a/src/Data/JsonSchema/Helpers.hs
+++ /dev/null
@@ -1,160 +0,0 @@
-
-module Data.JsonSchema.Helpers where
-
-import           Control.Exception
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.HashMap.Strict  as H
-import           Data.Scientific
-import qualified Data.Set as S
-import qualified Data.Text            as T
-import qualified Data.Vector          as V
-import           Network.HTTP.Client
-
-import           Data.JsonSchema.Core
-import           Import
-
---------------------------------------------------
--- * Embedded schemas finders
---------------------------------------------------
-
-noEm :: EmbeddedSchemas
-noEm _ _ = mempty
-
-objEmbed :: EmbeddedSchemas
-objEmbed t (Object o) = pure (RawSchema t o)
-objEmbed _ _ = mempty
-
-arrayEmbed :: EmbeddedSchemas
-arrayEmbed t (Array vs) = objEmbed t =<< V.toList vs
-arrayEmbed _ _ = mempty
-
-objOrArrayEmbed :: EmbeddedSchemas
-objOrArrayEmbed t v@(Object _) = objEmbed t v
-objOrArrayEmbed t v@(Array _) = arrayEmbed t v
-objOrArrayEmbed _ _ = mempty
-
-objMembersEmbed :: EmbeddedSchemas
-objMembersEmbed t (Object o) = objEmbed t =<< H.elems o
-objMembersEmbed _ _ = mempty
-
---------------------------------------------------
--- * Modify Validators for use in Specs
---------------------------------------------------
-
-giveName
-  :: forall err. err
-  -> ValidatorConstructor err [FailureInfo]
-  -> ValidatorConstructor err [ValidationFailure err]
-giveName err f spec g rs v = (fmap.fmap) (ValidationFailure err) <$> f spec g rs v
-
-modifyName
-  :: forall valErr schemaErr. (valErr -> schemaErr)
-  -> ValidatorConstructor schemaErr [ValidationFailure valErr]
-  -> ValidatorConstructor schemaErr [ValidationFailure schemaErr]
-modifyName failureHandler f spec g rs v = (fmap.fmap) modErr <$> f spec g rs v
-  where
-    modErr :: ValidationFailure valErr -> ValidationFailure schemaErr
-    modErr (ValidationFailure a b) = ValidationFailure (failureHandler a) b
-
--- | It's important to know if an object's a validator (even if it will never run,
--- like the definitions validator) because parts of it might be referenced by other
--- validators. If one of those referenced parts is itself a valid reference we
--- need to have fetched the correct value for it. So validators that won't run are
--- different than non-validator objects, because even if a non-validator object has
--- a $ref" keyword it's not a valid reference and shouldn't be fetched.
-neverBuild :: ValidatorConstructor err [ValidationFailure err]
-neverBuild _ _ _ _ = Nothing
-
---------------------------------------------------
--- * Utils
---------------------------------------------------
-
--- | Export the fetch function used by fetchReferencedSchemas
-defaultFetch :: Text -> IO (Either Text LBS.ByteString)
-defaultFetch url = do
-  eResp <- catch (Right <$> simpleHttp') handler
-  case eResp of
-    Left e  -> return $ Left e
-    Right b -> return $ Right b
-
-    where
-      handler :: SomeException -> IO (Either Text LBS.ByteString)
-      handler e = return . Left . T.pack . show $ e
-
-      -- Modeled on Network.Http.Conduit.simpleHttp from http-conduit.
-      -- simpleHttp also sets "Connection: close"
-      simpleHttp' :: IO LBS.ByteString
-      simpleHttp' = do
-        man <- newManager defaultManagerSettings
-        req <- parseUrl (T.unpack url)
-        responseBody <$> httpLbs req { requestHeaders = ("Connection", "close") : requestHeaders req } man
-
-modifyFailureName :: (a -> b) -> ValidationFailure a -> ValidationFailure b
-modifyFailureName f (ValidationFailure a b) = ValidationFailure (f a) b
-
-eitherToMaybe :: Either a b -> Maybe b
-eitherToMaybe (Left _)  = Nothing
-eitherToMaybe (Right a) = Just a
-
-runMaybeVal :: Maybe (Value -> [a]) -> Value -> [a]
-runMaybeVal Nothing _ = mempty
-runMaybeVal (Just val) x = val x
-
-runMaybeVal'
-  :: Maybe (Value -> ([a], Value))
-  -> Value
-  -> ([a], Value)
-runMaybeVal' Nothing x = (mempty, x)
-runMaybeVal' (Just val) x = val x
-
-toObj :: Value -> Maybe (HashMap Text Value)
-toObj (Object a) = Just a
-toObj _ = Nothing
-
-fromJSONInt :: Value -> Maybe Int
-fromJSONInt (Number n) = toBoundedInteger n
-fromJSONInt _ = Nothing
-
-toTxt :: Value -> Maybe Text
-toTxt (String t) = Just t
-toTxt _ = Nothing
-
-greaterThanZero :: (Num a, Ord a) => a -> Maybe ()
-greaterThanZero n = if n <= 0 then Nothing else Just ()
-
-tshow :: Show a => a -> Text
-tshow = T.pack . show
-
-allUnique :: (Ord a) => Vector a -> Bool
-allUnique xs = S.size (S.fromList (V.toList xs)) == V.length xs
-
--- | This needs benchmarking, but it can't be as bad as using O(n^2) nub.
--- (We can't use our allUnique function directly on Values because they're
--- not an instance of Ord).
-allUniqueValues :: Vector Value -> Bool
-allUniqueValues = allUnique . fmap OrdValue
-
-newtype OrdValue = OrdValue Value deriving Eq
-
-instance Ord OrdValue where
-  (OrdValue Null) `compare` (OrdValue Null) = EQ
-  (OrdValue Null) `compare` _               = LT
-  _               `compare` (OrdValue Null) = GT
-
-  (OrdValue (Bool x)) `compare` (OrdValue (Bool y)) = x `compare` y
-  (OrdValue (Bool _)) `compare` _                   = LT
-  _                   `compare` (OrdValue (Bool _)) = GT
-
-  (OrdValue (Number x)) `compare` (OrdValue (Number y)) = x `compare` y
-  (OrdValue (Number _)) `compare` _                     = LT
-  _                     `compare` (OrdValue (Number _)) = GT
-
-  (OrdValue (String x)) `compare` (OrdValue (String y)) = x `compare` y
-  (OrdValue (String _)) `compare` _                     = LT
-  _                     `compare` (OrdValue (String _)) = GT
-
-  (OrdValue (Array xs)) `compare` (OrdValue (Array ys)) = (OrdValue <$> xs) `compare` (OrdValue <$> ys)
-  (OrdValue (Array _))  `compare` _                     = LT
-  _                     `compare` (OrdValue (Array _))  = GT
-
-  (OrdValue (Object x)) `compare` (OrdValue (Object y)) = H.toList (OrdValue <$> x) `compare` H.toList (OrdValue <$> y)
diff --git a/src/Data/JsonSchema/Reference.hs b/src/Data/JsonSchema/Reference.hs
deleted file mode 100644
--- a/src/Data/JsonSchema/Reference.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-
-module Data.JsonSchema.Reference where
-
-import qualified Data.HashMap.Strict    as H
-import           Data.JsonPointer
-import qualified Data.Text              as T
-import           Data.Text.Encoding
-import           Network.HTTP.Types.URI
-
-import           Import
-
-type URIBase = Maybe Text
-type URIBaseAndFragment = (Maybe Text, Maybe Text)
-
-newResolutionScope :: URIBase -> HashMap Text Value -> URIBase
-newResolutionScope mScope o =
-  case H.lookup "id" o of
-    Just (String t) -> fst . baseAndFragment $ resolveScopeAgainst mScope t
-    _               -> mScope
-
-resolveReference :: URIBase -> Text -> URIBaseAndFragment
-resolveReference mScope t = baseAndFragment $ resolveScopeAgainst mScope t
-
-isRemoteReference :: Text -> Bool
-isRemoteReference uri = "://" `T.isInfixOf` uri
-
-resolveFragment :: Maybe Text -> HashMap Text Value -> HashMap Text Value
-resolveFragment Nothing hm        = hm
-resolveFragment (Just pointer) hm =
-  let urlDecoded = decodeUtf8 . urlDecode True . encodeUtf8 $ pointer
-  in case jsonPointer urlDecoded of
-    Left _  -> hm
-    Right p ->
-      case resolvePointer p (Object hm) of
-        Right (Object hm') -> hm'
-        _                  -> hm
-
---------------------------------------------------
--- * Internal
---------------------------------------------------
-
-baseAndFragment :: Text -> URIBaseAndFragment
-baseAndFragment = f . T.splitOn "#"
-  where
-    f :: [Text] -> URIBaseAndFragment
-    f [x]   = (g x, Nothing)
-    f [x,y] = (g x, g y)
-    f _     = (Nothing, Nothing)
-
-    g "" = Nothing
-    g x  = Just x
-
-resolveScopeAgainst :: Maybe Text -> Text -> Text
-resolveScopeAgainst Nothing t = t
-resolveScopeAgainst (Just scope) t
-  | isRemoteReference t = t
-  | otherwise           = smartAppend
-  where
-    -- There shouldn't be a fragment at the end of a scope URI,
-    -- but just in case a user leaves one in we want to be sure
-    -- to cut it off before appending.
-    smartAppend :: Text
-    smartAppend = case baseAndFragment scope of
-                    (Just base,_) -> base <> t
-                    _             -> t
diff --git a/src/Data/Validator/Draft4.hs b/src/Data/Validator/Draft4.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Draft4.hs
@@ -0,0 +1,8 @@
+
+module Data.Validator.Draft4 (module Export) where
+
+import           Data.Validator.Draft4.Any    as Export
+import           Data.Validator.Draft4.Array  as Export
+import           Data.Validator.Draft4.Number as Export
+import           Data.Validator.Draft4.Object as Export
+import           Data.Validator.Draft4.String as Export
diff --git a/src/Data/Validator/Draft4/Any.hs b/src/Data/Validator/Draft4/Any.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Draft4/Any.hs
@@ -0,0 +1,179 @@
+
+module Data.Validator.Draft4.Any where
+
+import           Control.Monad
+import           Data.Aeson.Types         (Parser)
+import           Data.List.NonEmpty       (NonEmpty)
+import qualified Data.List.NonEmpty       as N
+import           Data.Maybe
+import           Data.Scientific
+import           Data.Set                 (Set)
+import qualified Data.Set                 as S
+
+import           Data.Validator.Failure
+import           Data.Validator.Utils
+import           Data.Validator.Reference
+import           Import
+
+-- For GHCs before 7.10:
+import           Prelude hiding           (any)
+
+--------------------------------------------------
+-- * $ref
+--------------------------------------------------
+
+-- | Will return 'Nothing' if the reference can't be resolved.
+ref
+  :: forall err schema. (FromJSON schema, ToJSON schema, Show schema)
+  => Maybe Text
+  -> (Maybe Text -> Maybe schema)
+  -> (Maybe Text -> schema -> Value -> [Failure err])
+  -> Text
+  -> Value
+  -> Maybe [Failure err]
+ref scope getRef f reference x = do
+  let (mUri, mFragment) = resolveReference scope reference
+  schema <- getRef mUri
+  s      <- resolveFragment mFragment schema
+  Just (f mUri s x)
+
+--------------------------------------------------
+-- * enum
+--------------------------------------------------
+
+-- | From the spec:
+-- <http://json-schema.org/latest/json-schema-validation.html#anchor76>
+--
+--  > The value of this keyword MUST be an array.
+--  > This array MUST have at least one element.
+--  > Elements in the array MUST be unique.
+--
+-- NOTE: We don't enforce the uniqueness constraint in the haskell code,
+-- but we do in the 'FromJSON' instance.
+newtype EnumVal
+  = EnumVal { _unEnumVal :: NonEmpty Value }
+  -- Given a choice, we'd prefer to enforce uniqueness through the type
+  -- system over having at least one element. To use a 'Set' though we'd
+  -- have to use 'OrdValue' here (there's no 'Ord' instance for plain Values)
+  -- and we'd rather not make users mess with 'OrdValue'.
+  deriving (Eq, Show)
+
+instance FromJSON EnumVal where
+  parseJSON v = checkUnique . _unNonEmpty' =<< parseJSON v
+    where
+      checkUnique :: NonEmpty Value -> Parser EnumVal
+      checkUnique a
+        | allUniqueValues' a = pure (EnumVal a)
+        | otherwise = fail "All elements of the Enum validator must be unique."
+
+instance ToJSON EnumVal where
+  toJSON = toJSON . NonEmpty' . _unEnumVal
+
+instance Arbitrary EnumVal where
+  arbitrary = do
+    xs <- traverse (const arbitraryValue) =<< (arbitrary :: Gen [()])
+    case N.nonEmpty (toUnique xs) of
+      Nothing -> EnumVal . pure <$> arbitraryValue
+      Just ne -> pure (EnumVal ne)
+    where
+      toUnique :: [Value] -> [Value]
+      toUnique = fmap _unOrdValue . S.toList . S.fromList . fmap OrdValue
+
+enumVal :: EnumVal -> Value -> Maybe (Failure ())
+enumVal (EnumVal vs) x
+  | null vs                   = Nothing
+  | not (allUniqueValues' vs) = Nothing
+  | x `elem` vs               = Nothing
+  | otherwise                 =
+    Just $ Failure () (toJSON (NonEmpty' vs)) mempty
+
+--------------------------------------------------
+-- * type
+--------------------------------------------------
+
+data TypeVal
+  = TypeValString Text
+  | TypeValArray (Set Text)
+  deriving (Eq, Show)
+
+instance FromJSON TypeVal where
+  parseJSON v = fmap TypeValString (parseJSON v)
+            <|> fmap TypeValArray (parseJSON v)
+
+instance ToJSON TypeVal where
+  toJSON (TypeValString t) = toJSON t
+  toJSON (TypeValArray ts) = toJSON ts
+
+instance Arbitrary TypeVal where
+  arbitrary = oneof [ TypeValString <$> arbitraryText
+                    , TypeValArray <$> arbitrarySetOfText
+                    ]
+
+typeVal :: TypeVal -> Value -> Maybe (Failure ())
+typeVal (TypeValString t) x = isJsonType x (S.singleton t)
+typeVal (TypeValArray ts) x = isJsonType x ts
+
+isJsonType :: Value -> Set Text -> Maybe (Failure ())
+isJsonType x ts
+  | S.null (S.intersection okTypes ts) = Just (Failure () (toJSON ts) mempty)
+  | otherwise                          = Nothing
+  where
+    okTypes :: Set Text
+    okTypes =
+      case x of
+        Null       -> S.singleton "null"
+        (Array _)  -> S.singleton "array"
+        (Bool _)   -> S.singleton "boolean"
+        (Object _) -> S.singleton "object"
+        (String _) -> S.singleton "string"
+        (Number y) ->
+          case toBoundedInteger y :: Maybe Int of
+            Nothing -> S.singleton "number"
+            Just _  -> S.fromList ["number", "integer"]
+
+--------------------------------------------------
+-- * other
+--------------------------------------------------
+
+allOf
+  :: (schema -> Value -> [Failure err])
+  -> NonEmpty schema
+  -> Value
+  -> [Failure err]
+allOf f subSchemas x = N.toList subSchemas >>= flip f x
+
+anyOf
+  :: ToJSON schema
+  => (schema -> Value -> [Failure err])
+  -> NonEmpty schema
+  -> Value
+  -> Maybe (Failure ())
+anyOf f subSchemas x
+  | any null (flip f x <$> subSchemas) = Nothing
+  | otherwise = Just $ Failure () (toJSON (NonEmpty' subSchemas)) mempty
+
+oneOf
+  :: forall err schema. ToJSON schema
+  => (schema -> Value -> [Failure err])
+  -> NonEmpty schema
+  -> Value
+  -> Maybe (Failure ())
+oneOf f subSchemas x
+  | length successes == 1 = Nothing
+  | otherwise             = Just $ Failure ()
+                                           (toJSON (NonEmpty' subSchemas))
+                                           mempty
+  where
+    successes :: [[Failure err]]
+    successes = filter null $ flip f x <$> N.toList subSchemas
+
+notVal
+  :: ToJSON schema
+  => (schema -> Value -> [Failure err])
+  -> schema
+  -> Value
+  -> Maybe (Failure ())
+notVal f schema x =
+  case f schema x of
+    [] -> Just (Failure () (toJSON schema) mempty)
+    _  -> Nothing
diff --git a/src/Data/Validator/Draft4/Array.hs b/src/Data/Validator/Draft4/Array.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Draft4/Array.hs
@@ -0,0 +1,168 @@
+
+module Data.Validator.Draft4.Array where
+
+import           Control.Monad
+import qualified Data.Aeson.Pointer     as P
+import qualified Data.Text              as T
+import qualified Data.Vector            as V
+import           Text.Read              (readMaybe)
+
+import           Data.Validator.Failure
+import           Data.Validator.Utils   (allUniqueValues)
+import           Import
+
+-- | The spec requires "maxItems" to be non-negative.
+maxItems :: Int -> Vector Value -> Maybe (Failure ())
+maxItems n xs
+  | n < 0           = Nothing
+  | V.length xs > n = Just (Failure () (toJSON n) mempty)
+  | otherwise       = Nothing
+
+-- | The spec requires "minItems" to be non-negative.
+minItems :: Int -> Vector Value -> Maybe (Failure ())
+minItems n xs
+  | n < 0           = Nothing
+  | V.length xs < n = Just (Failure () (toJSON n) mempty)
+  | otherwise       = Nothing
+
+uniqueItems :: Bool -> Vector Value -> Maybe (Failure ())
+uniqueItems True xs
+  | allUniqueValues xs = Nothing
+  | otherwise          = Just (Failure () (Bool True) mempty)
+uniqueItems False _ = Nothing
+
+--------------------------------------------------
+-- * items
+--------------------------------------------------
+
+data ItemsFailure err
+  = Items err
+  | AdditionalItemsBoolFailure
+  | AdditionalItemsObjectFailure err
+  deriving (Eq, Show)
+
+data Items schema
+  = ItemsObject schema
+  | ItemsArray [schema]
+  deriving (Eq, Show)
+
+instance FromJSON schema => FromJSON (Items schema) where
+  parseJSON v = fmap ItemsObject (parseJSON v)
+            <|> fmap ItemsArray (parseJSON v)
+
+instance ToJSON schema => ToJSON (Items schema) where
+  toJSON (ItemsObject hm)     = toJSON hm
+  toJSON (ItemsArray schemas) = toJSON schemas
+
+instance Arbitrary schema => Arbitrary (Items schema) where
+  arbitrary = oneof [ ItemsObject <$> arbitrary
+                    , ItemsArray <$> arbitrary
+                    ]
+
+items
+  :: forall err schema.
+     (schema -> Value -> [Failure err])
+  -> Maybe (AdditionalItems schema)
+  -> Items schema
+  -> Vector Value
+  -> [Failure (ItemsFailure err)]
+items f _ (ItemsObject subSchema) xs = zip [0..] (V.toList xs) >>= g
+  where
+    g :: (Int, Value) -> [Failure (ItemsFailure err)]
+    g (index,x) = modFailure Items
+                . addToPath (P.Token (T.pack (show index)))
+              <$> f subSchema x
+
+items f mAdditional (ItemsArray subSchemas) xs = itemFailures
+                                              <> additionalItemFailures
+  where
+    indexedValues :: [(Int, Value)]
+    indexedValues = zip [0..] (V.toList xs)
+
+    itemFailures :: [Failure (ItemsFailure err)]
+    itemFailures = join (zipWith g subSchemas indexedValues)
+      where
+        g :: schema -> (Int, Value) -> [Failure (ItemsFailure err)]
+        g schema (index,x) = modFailure Items
+                           . addToPath (P.Token (T.pack (show index)))
+                         <$> f schema x
+
+    additionalItemFailures :: [Failure (ItemsFailure err)]
+    additionalItemFailures =
+      case mAdditional of
+        Nothing  -> mempty
+        Just adi -> modFailure correctName
+                  . correctIndexes
+                <$> additionalItems f adi extras
+      where
+        -- It's not great that we convert back to Vector again.
+        extras :: Vector Value
+        extras =
+          V.fromList . fmap snd . drop (length subSchemas) $ indexedValues
+
+        -- Since 'additionalItems' only sees part of the array, but starts
+        -- indexing from zero, we need to modify the paths it reports to
+        -- represent invalid data so they actually represent the correct
+        -- offsets.
+        correctIndexes
+          :: Failure (AdditionalItemsFailure err)
+          -> Failure (AdditionalItemsFailure err)
+        correctIndexes (Failure a b c) = Failure a b (fixIndex c)
+          where
+            fixIndex :: P.Pointer -> P.Pointer
+            fixIndex (P.Pointer (tok:toks)) =
+              case readMaybe . T.unpack . P._unToken $ tok of
+                Nothing -> P.Pointer $ tok:toks
+                Just n  -> P.Pointer $
+                  (P.Token . T.pack . show $ n + length subSchemas):toks
+            fixIndex (P.Pointer []) = P.Pointer []
+
+        correctName :: AdditionalItemsFailure err -> ItemsFailure err
+        correctName AdditionalBoolFailure = AdditionalItemsBoolFailure
+        correctName (AdditionalObjectFailure err) =
+          AdditionalItemsObjectFailure err
+
+--------------------------------------------------
+-- * additionalItems
+--------------------------------------------------
+
+data AdditionalItemsFailure err
+  = AdditionalBoolFailure
+  | AdditionalObjectFailure err
+  deriving (Eq, Show)
+
+data AdditionalItems schema
+  = AdditionalBool Bool
+  | AdditionalObject schema
+  deriving (Eq, Show)
+
+instance FromJSON schema => FromJSON (AdditionalItems schema) where
+  parseJSON v = fmap AdditionalBool (parseJSON v)
+            <|> fmap AdditionalObject (parseJSON v)
+
+instance ToJSON schema => ToJSON (AdditionalItems schema) where
+  toJSON (AdditionalBool b)    = toJSON b
+  toJSON (AdditionalObject hm) = toJSON hm
+
+instance Arbitrary schema => Arbitrary (AdditionalItems schema) where
+  arbitrary = oneof [ AdditionalBool <$> arbitrary
+                    , AdditionalObject <$> arbitrary
+                    ]
+
+additionalItems
+  :: forall err schema.
+     (schema -> Value -> [Failure err])
+  -> AdditionalItems schema
+  -> Vector Value
+  -> [Failure (AdditionalItemsFailure err)]
+additionalItems _ (AdditionalBool b) xs
+  | b               = mempty
+  | V.length xs > 0 = pure (Failure AdditionalBoolFailure (Bool b) mempty)
+  | otherwise       = mempty
+additionalItems f (AdditionalObject subSchema) xs =
+  zip [0..] (V.toList xs) >>= g
+  where
+    g :: (Int, Value) -> [Failure (AdditionalItemsFailure err)]
+    g (index,x) = modFailure AdditionalObjectFailure
+                . addToPath (P.Token (T.pack (show index)))
+              <$> f subSchema x
diff --git a/src/Data/Validator/Draft4/Number.hs b/src/Data/Validator/Draft4/Number.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Draft4/Number.hs
@@ -0,0 +1,51 @@
+
+module Data.Validator.Draft4.Number where
+
+import           Data.Fixed             (mod')
+import           Data.Scientific
+
+import           Data.Validator.Failure
+import           Import
+
+-- | The spec requires "multipleOf" to be positive.
+multipleOf :: Scientific -> Scientific -> Maybe (Failure ())
+multipleOf n x
+  | n <= 0          = Nothing
+  | x `mod'` n /= 0 = Just (Failure () (toJSON n) mempty)
+  | otherwise       = Nothing
+
+data MaximumFailure
+  = Maximum
+  | ExclusiveMaximum
+  deriving (Eq, Show)
+
+maximumVal
+  :: Bool
+  -> Scientific
+  -> Scientific
+  -> Maybe (Failure MaximumFailure)
+maximumVal exclusiveMaximum n x
+  | x `greaterThan` n = Just (Failure err (toJSON n) mempty)
+  | otherwise         = Nothing
+  where
+    (greaterThan, err) = if exclusiveMaximum
+                           then ((>=), ExclusiveMaximum)
+                           else ((>), Maximum)
+
+data MinimumFailure
+  = Minimum
+  | ExclusiveMinimum
+  deriving (Eq, Show)
+
+minimumVal
+  :: Bool
+  -> Scientific
+  -> Scientific
+  -> Maybe (Failure MinimumFailure)
+minimumVal exclusiveMinimum n x
+  | x `lessThan` n = Just (Failure err (toJSON n) mempty)
+  | otherwise      = Nothing
+  where
+    (lessThan, err) = if exclusiveMinimum
+                        then ((<=), ExclusiveMinimum)
+                        else ((<), Minimum)
diff --git a/src/Data/Validator/Draft4/Object.hs b/src/Data/Validator/Draft4/Object.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Draft4/Object.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+
+module Data.Validator.Draft4.Object
+  ( module Data.Validator.Draft4.Object
+  , module Data.Validator.Draft4.Object.Properties
+  ) where
+
+import           Data.Aeson.Types                        (Parser)
+import qualified Data.HashMap.Strict                     as H
+import           Data.Set                                (Set)
+import qualified Data.Set                                as S
+import qualified Data.Text                               as T
+
+import           Data.Validator.Draft4.Object.Properties
+import           Data.Validator.Failure
+import           Data.Validator.Utils
+import           Import
+
+-- For GHCs before 7.10:
+import           Prelude                                 hiding (all, concat,
+                                                          foldl)
+
+-- | The spec requires "maxProperties" to be non-negative.
+maxProperties :: Int -> HashMap Text Value -> Maybe (Failure ())
+maxProperties n x
+  | n < 0        = Nothing
+  | H.size x > n = Just (Failure () (toJSON n) mempty)
+  | otherwise    = Nothing
+
+-- | The spec requires "minProperties" to be non-negative.
+minProperties :: Int -> HashMap Text Value -> Maybe (Failure ())
+minProperties n x
+  | n < 0        = Nothing
+  | H.size x < n = Just (Failure () (toJSON n) mempty)
+  | otherwise    = Nothing
+
+--------------------------------------------------
+-- * required
+--------------------------------------------------
+
+-- | From the spec:
+--
+-- > The value of this keyword MUST be an array.
+-- > This array MUST have at least one element.
+-- > Elements of this array MUST be strings, and MUST be unique.
+--
+-- We don't enfore that 'Required' has at least one element in the
+-- haskell code, but we do in the 'FromJSON' instance.
+newtype Required
+  = Required { _unRequired :: Set Text }
+  deriving (Eq, Show, ToJSON)
+
+instance FromJSON Required where
+  parseJSON v = checkUnique =<< checkSize =<< parseJSON v
+    where
+      checkSize :: [Text] -> Parser [Text]
+      checkSize a
+        | null a    = fail "Required validator must not be empty."
+        | otherwise = pure a
+
+      checkUnique :: [Text] -> Parser Required
+      checkUnique a =
+        let b = S.fromList a
+        -- NOTE: Can use length instead of S.size in GHC 7.10 or later.
+        in if length a == S.size b
+          then pure (Required b)
+          else fail "All elements of the Required validator must be unique."
+
+instance Arbitrary Required where
+  arbitrary = do
+    x  <- arbitraryText -- Guarantee at least one element.
+    xs <- (fmap.fmap) T.pack arbitrary
+    pure . Required . S.fromList $ x:xs
+
+required :: Required -> HashMap Text Value -> Maybe (Failure ())
+required (Required ts) x
+  -- NOTE: When we no longer need to support GHCs before 7.10
+  -- we can use null from Prelude throughout the library
+  -- instead of specialized versions.
+  | S.null ts                  = Nothing
+  | H.null (H.difference hm x) = Nothing
+  | otherwise                  = Just (Failure () (toJSON ts) mempty)
+  where
+    hm :: HashMap Text Bool
+    hm = foldl (\b a -> H.insert a True b) mempty ts
+
+--------------------------------------------------
+-- * dependencies
+--------------------------------------------------
+
+data DependencyFailure err
+  = SchemaDependencyFailure err
+  | PropertyDependencyFailure
+  deriving (Eq, Show)
+
+data Dependency schema
+  = SchemaDependency schema
+  | PropertyDependency (Set Text)
+  deriving (Eq, Show)
+
+instance FromJSON schema => FromJSON (Dependency schema) where
+  parseJSON v = fmap SchemaDependency (parseJSON v)
+            <|> fmap PropertyDependency (parseJSON v)
+
+instance ToJSON schema => ToJSON (Dependency schema) where
+  toJSON (SchemaDependency schema) = toJSON schema
+  toJSON (PropertyDependency ts)   = toJSON ts
+
+instance Arbitrary schema => Arbitrary (Dependency schema) where
+  arbitrary = oneof [ SchemaDependency <$> arbitrary
+                    , PropertyDependency <$> arbitrarySetOfText
+                    ]
+
+-- | From the spec:
+-- <http://json-schema.org/latest/json-schema-validation.html#anchor70>
+--
+-- > This keyword's value MUST be an object.
+-- > Each value of this object MUST be either an object or an array.
+-- >
+-- > If the value is an object, it MUST be a valid JSON Schema.
+-- > This is called a schema dependency.
+-- >
+-- > If the value is an array, it MUST have at least one element.
+-- > Each element MUST be a string, and elements in the array MUST be unique.
+-- > This is called a property dependency.
+dependencies
+  :: forall err schema. (schema -> Value -> [Failure err])
+  -> HashMap Text (Dependency schema)
+  -> HashMap Text Value
+  -> [Failure (DependencyFailure err)]
+dependencies f hm x = concat . fmap (uncurry g) . H.toList $ hm
+  where
+    g :: Text -> Dependency schema -> [Failure (DependencyFailure err)]
+    g k (SchemaDependency schema)
+      | H.member k x =
+        modFailure SchemaDependencyFailure <$> f schema (Object x)
+      | otherwise    = mempty
+    g k (PropertyDependency ts)
+      | H.member k x && not allPresent =
+        pure $ Failure PropertyDependencyFailure
+                       (toJSON (H.singleton k ts))
+                       mempty
+      | otherwise = mempty
+      where
+        allPresent :: Bool
+        allPresent = all (`H.member` x) ts
diff --git a/src/Data/Validator/Draft4/Object/Properties.hs b/src/Data/Validator/Draft4/Object/Properties.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Draft4/Object/Properties.hs
@@ -0,0 +1,187 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Data.Validator.Draft4.Object.Properties where
+
+import           Control.Monad
+import           Data.Aeson
+import qualified Data.Aeson.Pointer     as P
+import qualified Data.HashMap.Strict    as H
+import qualified Data.Text              as T
+import           Text.RegexPR
+
+import           Data.Validator.Failure
+import           Import
+
+newtype Remaining = Remaining { _unRemaining :: HashMap Text Value }
+
+--------------------------------------------------
+-- * properties
+--------------------------------------------------
+
+data PropertiesFailure err
+  = PropertiesFailure err
+  | PropPatternFailure err
+  | PropAdditionalFailure (AdditionalPropertiesFailure err)
+  deriving (Eq, Show)
+
+-- | In order of what's tried: "properties", "patternProperties",
+-- "additionalProperties".
+properties
+  :: forall err schema.
+     (schema -> Value -> [Failure err])
+  -> Maybe (HashMap Text schema)
+  -> Maybe (AdditionalProperties schema)
+  -> HashMap Text schema
+  -> HashMap Text Value
+  -> [Failure (PropertiesFailure err)]
+properties f mPat mAdd propertiesHm x =
+     fmap (modFailure PropertiesFailure) propFailures
+  <> fmap (modFailure PropPatternFailure) patternFailures
+  <> fmap (modFailure PropAdditionalFailure) additionalFailures
+  where
+    propertiesAndUnmatched :: ([Failure err], Remaining)
+    propertiesAndUnmatched = ( failures
+                             , Remaining (H.difference x propertiesHm)
+                             )
+      where
+        failures :: [Failure err]
+        failures = H.toList (H.intersectionWith f propertiesHm x)
+               >>= (\(k,vs) -> fmap (addToPath (P.Token k)) vs)
+
+    (propFailures, remaining1) = propertiesAndUnmatched
+
+    mPatProp :: Maybe (HashMap Text Value -> ([Failure err], Remaining))
+    mPatProp = patternAndUnmatched f <$> mPat
+
+    patternFailures :: [Failure err]
+    patternFailures = case mPatProp of
+                        Nothing  -> mempty
+                        Just val -> fst (val x)
+
+    remaining2 :: Remaining
+    remaining2 = case mPatProp of
+                   Nothing  -> remaining1
+                   Just val -> snd . val . _unRemaining $ remaining1
+
+    additionalFailures :: [Failure (AdditionalPropertiesFailure err)]
+    additionalFailures = case additionalProperties f <$> mAdd of
+                           Nothing  -> mempty
+                           Just val -> val (_unRemaining remaining2)
+
+--------------------------------------------------
+-- * patternProperties
+--------------------------------------------------
+
+data PatternPropertiesFailure err
+  = PPFailure err
+  | PPAdditionalPropertiesFailure (AdditionalPropertiesFailure err)
+  deriving (Eq, Show)
+
+patternProperties
+  :: forall err schema.
+     (schema -> Value -> [Failure err])
+  -> Maybe (AdditionalProperties schema)
+  -> HashMap Text schema
+  -> HashMap Text Value
+  -> [Failure (PatternPropertiesFailure err)]
+patternProperties f mAdd patternPropertiesHm x =
+     fmap (modFailure PPFailure) ppFailures
+  <> fmap (modFailure PPAdditionalPropertiesFailure) addFailures
+  where
+    patternProps :: ([Failure err], Remaining)
+    patternProps = patternAndUnmatched f patternPropertiesHm x
+
+    (ppFailures, remaining) = patternProps
+
+    addFailures :: [Failure (AdditionalPropertiesFailure err)]
+    addFailures = case additionalProperties f <$> mAdd of
+                    Nothing  -> mempty
+                    Just val -> val (_unRemaining remaining)
+
+patternAndUnmatched
+  :: forall err schema.
+     (schema -> Value -> [Failure err])
+  -> HashMap Text schema
+  -> HashMap Text Value
+  -> ([Failure err], Remaining)
+patternAndUnmatched f patPropertiesHm x =
+  (H.foldlWithKey' runVals mempty perhapsMatches, remaining)
+  where
+    perhapsMatches :: HashMap Text (Value, [schema])
+    perhapsMatches = H.foldlWithKey' (matchingSchemas patPropertiesHm) mempty x
+      where
+        matchingSchemas
+          :: HashMap Text schema
+          -> HashMap Text (Value, [schema])
+          -> Text
+          -> Value
+          -> HashMap Text (Value, [schema])
+        matchingSchemas subSchemas acc k v =
+          H.insert k (v, H.foldlWithKey' (checkKey k) mempty subSchemas) acc
+
+        checkKey
+          :: Text
+          -> [schema]
+          -> Text
+          -> schema
+          -> [schema]
+        checkKey k acc r subSchema =
+          case matchRegexPR (T.unpack r) (T.unpack k) of
+            Nothing -> acc
+            Just _  -> pure subSchema <> acc
+
+    runVals
+      :: [Failure err]
+      -> Text
+      -> (Value, [schema])
+      -> [Failure err]
+    runVals acc k (v,subSchemas) =
+      (subSchemas >>= (\schema -> addToPath (P.Token k) <$> f schema v))
+      <> acc
+
+    remaining :: Remaining
+    remaining = Remaining . fmap fst . H.filter (null . snd) $ perhapsMatches
+
+--------------------------------------------------
+-- * additionalProperties
+--------------------------------------------------
+
+data AdditionalPropertiesFailure err
+  = APBoolFailure
+  | APObjectFailure err
+  deriving (Eq, Show)
+
+data AdditionalProperties schema
+  = AdditionalPropertiesBool Bool
+  | AdditionalPropertiesObject schema
+  deriving (Eq, Show)
+
+instance FromJSON schema => FromJSON (AdditionalProperties schema) where
+  parseJSON v = fmap AdditionalPropertiesBool (parseJSON v)
+            <|> fmap AdditionalPropertiesObject (parseJSON v)
+
+instance ToJSON schema => ToJSON (AdditionalProperties schema) where
+  toJSON (AdditionalPropertiesBool b)    = toJSON b
+  toJSON (AdditionalPropertiesObject hm) = toJSON hm
+
+instance Arbitrary schema => Arbitrary (AdditionalProperties schema) where
+  arbitrary = oneof [ AdditionalPropertiesBool <$> arbitrary
+                    , AdditionalPropertiesObject <$> arbitrary
+                    ]
+
+additionalProperties
+  :: forall err schema.
+     (schema -> Value -> [Failure err])
+  -> AdditionalProperties schema
+  -> HashMap Text Value
+  -> [Failure (AdditionalPropertiesFailure err)]
+additionalProperties _ (AdditionalPropertiesBool False) x
+  | H.size x > 0 = pure $ Failure APBoolFailure (Bool False) mempty
+  | otherwise    = mempty
+additionalProperties _ (AdditionalPropertiesBool True) _ = mempty
+additionalProperties f (AdditionalPropertiesObject schema) x = H.toList x >>= g
+  where
+    g :: (Text, Value) -> [Failure (AdditionalPropertiesFailure err)]
+    g (k,v) = modFailure APObjectFailure
+            . addToPath (P.Token k)
+          <$> f schema v
diff --git a/src/Data/Validator/Draft4/String.hs b/src/Data/Validator/Draft4/String.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Draft4/String.hs
@@ -0,0 +1,29 @@
+
+module Data.Validator.Draft4.String where
+
+import           Data.Aeson
+import qualified Data.Text              as T
+import           Text.RegexPR
+
+import           Data.Validator.Failure
+import           Import
+
+-- | The spec requires "maxLength" to be non-negative.
+maxLength :: Int -> Text -> Maybe (Failure ())
+maxLength n x
+  | n <= 0         = Nothing
+  | T.length x > n = Just (Failure () (toJSON n) mempty)
+  | otherwise      = Nothing
+
+-- | The spec requires "minLength" to be non-negative.
+minLength :: Int -> Text -> Maybe (Failure ())
+minLength n x
+  | n <= 0         = Nothing
+  | T.length x < n = Just (Failure () (toJSON n) mempty)
+  | otherwise      = Nothing
+
+patternVal :: Text -> Text -> Maybe (Failure ())
+patternVal t x =
+  case matchRegexPR (T.unpack t) (T.unpack x) of
+    Nothing -> Just (Failure () (toJSON t) mempty)
+    Just _  -> Nothing
diff --git a/src/Data/Validator/Failure.hs b/src/Data/Validator/Failure.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Failure.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Data.Validator.Failure where
+
+import qualified Data.Aeson.Pointer as P
+
+import           Import
+
+-- For GHCs before 7.10:
+import           Prelude            hiding (concat, sequence)
+
+-- | Validators shouldn't know more about the schema they're going to
+-- be used with than necessary. If a validator throws errors using the
+-- error sum type of a particular schema, then it can't be used with
+-- other schemas later that have different error sum types (at least not
+-- without writing partial functions).
+--
+-- Thus validators that can only fail in one way return 'FailureInfo's.
+-- Validators that can fail in multiple ways return 'ValidationFailure's
+-- along with an custom error sum type for that particular validator.
+--
+-- It's the job of a schema's validate function to unify the errors produced
+-- by the validators it uses into a single error sum type for that schema.
+-- The schema's validate function will return a 'ValidationFailure' with
+-- that sum type as its type argument.
+data Failure err = Failure
+  { _failureValidatorsCalled :: !err
+  , _failureFinalValidator   :: !Value
+  , _failureOffendingData    :: !P.Pointer
+  } deriving (Eq, Show)
+
+setFailure :: b -> Failure a -> Failure b
+setFailure e (Failure _ a b) = Failure e a b
+
+modFailure :: (a -> b) -> Failure a -> Failure b
+modFailure f v@(Failure a _ _) = v { _failureValidatorsCalled = f a }
+
+addToPath :: P.Token -> Failure a -> Failure a
+addToPath tok v@(Failure _ _ a) = v { _failureOffendingData = addToken a }
+  where
+    addToken :: P.Pointer -> P.Pointer
+    addToken (P.Pointer ts) = P.Pointer (ts <> pure tok)
diff --git a/src/Data/Validator/Reference.hs b/src/Data/Validator/Reference.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Reference.hs
@@ -0,0 +1,67 @@
+
+module Data.Validator.Reference where
+
+import qualified Data.Aeson.Pointer     as P
+import qualified Data.Text              as T
+import           Data.Text.Encoding
+import           Network.HTTP.Types.URI
+
+import           Import
+
+type URIBase = Maybe Text
+type URIBaseAndFragment = (Maybe Text, Maybe Text)
+
+newResolutionScope :: URIBase -> Maybe Text -> URIBase
+newResolutionScope mScope idKeyword =
+  case idKeyword of
+    Just t -> fst . baseAndFragment $ resolveScopeAgainst mScope t
+    _      -> mScope
+
+resolveReference :: URIBase -> Text -> URIBaseAndFragment
+resolveReference mScope t = baseAndFragment $ resolveScopeAgainst mScope t
+
+isRemoteReference :: Text -> Bool
+isRemoteReference uri = "://" `T.isInfixOf` uri
+
+resolveFragment
+  :: (FromJSON schema, ToJSON schema, Show schema)
+  => Maybe Text
+  -> schema
+  -> Maybe schema
+resolveFragment Nothing schema        = Just schema
+resolveFragment (Just pointer) schema = do
+  let urlDecoded = decodeUtf8 . urlDecode True . encodeUtf8 $ pointer
+  p <- either (const Nothing) Just (P.unescape urlDecoded)
+  x <- either (const Nothing) Just (P.resolve p (toJSON schema))
+  case fromJSON x of
+    Error _         -> Nothing
+    Success schema' -> Just schema'
+
+--------------------------------------------------
+-- * Internal
+--------------------------------------------------
+
+baseAndFragment :: Text -> URIBaseAndFragment
+baseAndFragment = f . T.splitOn "#"
+  where
+    f :: [Text] -> URIBaseAndFragment
+    f [x]   = (g x, Nothing)
+    f [x,y] = (g x, g y)
+    f _     = (Nothing, Nothing)
+
+    g "" = Nothing
+    g x  = Just x
+
+resolveScopeAgainst :: Maybe Text -> Text -> Text
+resolveScopeAgainst Nothing t = t
+resolveScopeAgainst (Just scope) t
+  | isRemoteReference t = t
+  | otherwise           = smartAppend
+  where
+    -- There shouldn't be a fragment at the end of a scope URI,
+    -- but just in case a user leaves one in we want to be sure
+    -- to cut it off before appending.
+    smartAppend :: Text
+    smartAppend = case baseAndFragment scope of
+                    (Just base,_) -> base <> t
+                    _             -> t
diff --git a/src/Data/Validator/Utils.hs b/src/Data/Validator/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Validator/Utils.hs
@@ -0,0 +1,122 @@
+
+module Data.Validator.Utils where
+
+import           Control.Arrow
+import qualified Data.HashMap.Strict  as H
+import           Data.List.NonEmpty   (NonEmpty)
+import qualified Data.List.NonEmpty   as N
+import           Data.Scientific      (Scientific, fromFloatDigits)
+import           Data.Set             (Set)
+import qualified Data.Set             as S
+import qualified Data.Text            as T
+import qualified Data.Vector          as V
+
+import           Import
+
+--------------------------------------------------
+-- * QuickCheck
+--------------------------------------------------
+
+arbitraryText :: Gen Text
+arbitraryText = T.pack <$> arbitrary
+
+arbitraryScientific :: Gen Scientific
+arbitraryScientific = (fromFloatDigits :: Double -> Scientific) <$> arbitrary
+
+arbitraryPositiveScientific :: Gen Scientific
+arbitraryPositiveScientific = (fromFloatDigits :: Double -> Scientific)
+                            . getPositive
+                          <$> arbitrary
+
+arbitraryValue :: Gen Value
+arbitraryValue = sized f
+  where
+    f :: Int -> Gen Value
+    f n | n <= 1    = oneof nonRecursive
+        | otherwise = oneof $
+            fmap (Array . V.fromList) (traverse (const (f (n `div` 10)))
+              =<< (arbitrary :: Gen [()]))
+          : fmap (Object . H.fromList) (traverse (const (g (n `div` 10)))
+              =<< (arbitrary :: Gen [()]))
+          : nonRecursive
+
+    g :: Int -> Gen (Text, Value)
+    g n = (,) <$> arbitraryText <*> f n
+
+    nonRecursive :: [Gen Value]
+    nonRecursive =
+      [ pure Null
+      , Bool <$> arbitrary
+      , String <$> arbitraryText
+      , Number <$> arbitraryScientific
+      ]
+
+arbitraryHashMap :: Arbitrary a => Gen (HashMap Text a)
+arbitraryHashMap = H.fromList . fmap (first T.pack) <$> arbitrary
+
+arbitrarySetOfText :: Gen (Set Text)
+arbitrarySetOfText = S.fromList . fmap T.pack <$> arbitrary
+
+newtype NonEmpty' a = NonEmpty' { _unNonEmpty' :: NonEmpty a }
+
+instance FromJSON a => FromJSON (NonEmpty' a) where
+  parseJSON v = do
+    xs <- parseJSON v
+    case N.nonEmpty xs of
+      Nothing -> fail "Must have at least one item."
+      Just ne -> pure (NonEmpty' ne)
+
+instance ToJSON a => ToJSON (NonEmpty' a) where
+  toJSON = toJSON . N.toList . _unNonEmpty'
+
+instance Arbitrary a => Arbitrary (NonEmpty' a) where
+  arbitrary = do
+    xs <- arbitrary
+    case N.nonEmpty xs of
+      Nothing -> NonEmpty' . pure <$> arbitrary
+      Just ne -> pure (NonEmpty' ne)
+
+--------------------------------------------------
+-- * allUniqueValues
+--------------------------------------------------
+
+allUniqueValues :: Vector Value -> Bool
+allUniqueValues = allUnique . fmap OrdValue . V.toList
+
+-- NOTE: When we no longer support GHC 7.8 we can generalize
+-- allUnique to work on any Foldable and remove this function.
+allUniqueValues' :: NonEmpty Value -> Bool
+allUniqueValues' = allUnique . fmap OrdValue . N.toList
+
+allUnique :: (Ord a) => [a] -> Bool
+allUnique xs = S.size (S.fromList xs) == length xs
+
+-- | OrdValue's Ord instance needs benchmarking, but it allows us to
+-- use our 'allUnique' function instead of O(n^2) nub, so it's probably
+-- worth it.
+newtype OrdValue = OrdValue { _unOrdValue :: Value } deriving Eq
+
+instance Ord OrdValue where
+  (OrdValue Null) `compare` (OrdValue Null) = EQ
+  (OrdValue Null) `compare` _               = LT
+  _               `compare` (OrdValue Null) = GT
+
+  (OrdValue (Bool x)) `compare` (OrdValue (Bool y)) = x `compare` y
+  (OrdValue (Bool _)) `compare` _                   = LT
+  _                   `compare` (OrdValue (Bool _)) = GT
+
+  (OrdValue (Number x)) `compare` (OrdValue (Number y)) = x `compare` y
+  (OrdValue (Number _)) `compare` _                     = LT
+  _                     `compare` (OrdValue (Number _)) = GT
+
+  (OrdValue (String x)) `compare` (OrdValue (String y)) = x `compare` y
+  (OrdValue (String _)) `compare` _                     = LT
+  _                     `compare` (OrdValue (String _)) = GT
+
+  (OrdValue (Array xs)) `compare` (OrdValue (Array ys)) =
+    (OrdValue <$> xs) `compare` (OrdValue <$> ys)
+  (OrdValue (Array _))  `compare` _                     = LT
+  _                     `compare` (OrdValue (Array _))  = GT
+
+  (OrdValue (Object x)) `compare` (OrdValue (Object y)) =
+    H.toList (OrdValue <$> x) `compare` H.toList (OrdValue <$> y)
diff --git a/src/Import.hs b/src/Import.hs
--- a/src/Import.hs
+++ b/src/Import.hs
@@ -9,3 +9,4 @@
 import           Data.Text           as Export (Text)
 import           Data.Traversable    as Export
 import           Data.Vector         as Export (Vector)
+import           Test.QuickCheck     as Export hiding (Failure, Result, Success)
diff --git a/tests/Lib.hs b/tests/Lib.hs
deleted file mode 100644
--- a/tests/Lib.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Lib where
-
-import           Control.Applicative
-import           Control.Monad
-import           Data.Aeson
-import           Data.Aeson.TH
-import qualified Data.ByteString.Lazy           as LBS
-import           Data.Char                      (toLower)
-import           Data.JsonSchema
-import           Data.Monoid
-import           Data.Text                      (Text)
-import qualified Data.Text                      as T
-import           System.FilePath                ((</>))
-import           Test.Framework                 (Test)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     hiding (Test)
-
-isLocal :: String -> Bool
-isLocal file = (file /= "definitions.json")
-            && (file /= "ref.json")
-            && (file /= "refRemote.json")
-
-data SchemaTest = SchemaTest
-  { _stDescription :: Text
-  , _stSchema      :: RawSchema
-  , _stCases       :: [SchemaTestCase]
-  }
-
-data SchemaTestCase = SchemaTestCase
-  { _scDescription :: Text
-  , _scData        :: Value
-  , _scValid       :: Bool
-  }
-
-instance FromJSON RawSchema where
-  parseJSON = withObject "Schema" $ return . RawSchema Nothing
-
-instance FromJSON SchemaTest where
-  parseJSON = withObject "SchemaTest" $ \o -> SchemaTest
-    <$> o .: "description"
-    <*> o .: "schema"
-    <*> o .: "tests" -- I wish this were "cases"
-
-readSchemaTests :: String -> [String] -> IO [SchemaTest]
-readSchemaTests dir jsonFiles = concatMapM fileToCases jsonFiles
-  where
-    -- Each file contains an array of SchemaTests, not just one.
-    fileToCases :: String -> IO [SchemaTest]
-    fileToCases name = do
-      let fullPath = dir </> name
-      jsonBS <- LBS.readFile fullPath
-      case eitherDecode jsonBS of
-        Left e -> fail $ "couldn't parse file '" <> fullPath <> "': " <> e
-        Right schemaTests -> return $ prependFileName name <$> schemaTests
-
-    prependFileName :: String -> SchemaTest -> SchemaTest
-    prependFileName fileName s = s
-      { _stDescription = T.pack fileName <> ": " <> _stDescription s
-      }
-
-    concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
-    concatMapM f xs = liftM concat (mapM f xs)
-
-toTest :: SchemaTest -> Test
-toTest st =
-  testCase (T.unpack $ _stDescription st) $ do
-    sanityCheckTest (_stSchema st)
-    forM_ (_stCases st) $ \sc -> do
-      g <- assertRight =<< fetchReferencedSchemas draft4 mempty (_stSchema st)
-      let res = validate (compile draft4 g $ _stSchema st) (_scData sc)
-      if _scValid sc
-        then assertValid   sc res
-        else assertInvalid sc res
-  where
-    sanityCheckTest :: RawSchema -> IO ()
-    sanityCheckTest rs =
-      case isValidSchema rs of
-        []   -> return ()
-        errs -> error $ unlines
-                  [ "One of the test cases has a problem! "
-                  , "Description: "         <> T.unpack (_stDescription st)
-                  , "Validation failures: " <> show errs
-                  ]
-
-assertValid :: SchemaTestCase -> [ValidationFailure Draft4Failure] -> Assertion
-assertValid _ [] = return ()
-assertValid sc errs =
-  assertFailure $ unlines
-    [ "    Failed to validate data"
-    , "    Description: "         <> T.unpack (_scDescription sc)
-    , "    Data: "                <> show (_scData sc)
-    , "    Validation failures: " <> show errs
-    ]
-
-assertInvalid :: SchemaTestCase -> [ValidationFailure Draft4Failure] -> Assertion
-assertInvalid sc [] =
-  assertFailure $ unlines
-    [ "    Validated invalid data"
-    , "    Description: " <> T.unpack (_scDescription sc)
-    , "    Data: "        <> show (_scData sc)
-    ]
-assertInvalid _ _ = return ()
-
-assertRight :: (Show a) => Either a b -> IO b
-assertRight a =
-  case a of
-    Left e  -> assertFailure (show e) >> fail "assertRight failed"
-    Right b -> return b
-
-$(deriveFromJSON defaultOptions { fieldLabelModifier = map toLower . drop 3 } ''SchemaTestCase)
diff --git a/tests/Local.hs b/tests/Local.hs
--- a/tests/Local.hs
+++ b/tests/Local.hs
@@ -1,18 +1,76 @@
+
 module Main where
 
 import           Control.Applicative
-import           Data.List           (isSuffixOf)
-import           Lib
-import           System.Directory    (getDirectoryContents)
-import           Test.Framework
+import           Control.Monad          (unless)
+import           Data.Aeson
+import qualified Data.Aeson.Pointer     as P
+import           Data.List              (isSuffixOf)
+import           Data.Monoid
+import           System.Directory       (getDirectoryContents)
+import           Test.Tasty             (TestTree, defaultMain, testGroup)
+import qualified Test.Tasty.HUnit       as HU
+import           Test.Tasty.QuickCheck  (testProperty)
 
+import           Data.JsonSchema.Draft4 (Failure(..), Schema(..),
+                                         SchemaCache(..), SchemaContext(..),
+                                         emptySchema, runValidate)
+import qualified Data.Validator.Draft4  as VA
+import           Shared                 (isLocal, readSchemaTests, toTest)
+
+dir :: String
+dir = "JSON-Schema-Test-Suite/tests/draft4"
+
 main :: IO ()
 main = do
-  filenames <- filter isLocal . filter (".json" `isSuffixOf`)
-                 <$> getDirectoryContents dir
+  filenames <- filter isLocal . filter (".json" `isSuffixOf`) <$> getDirectoryContents dir
   ts <- readSchemaTests dir filenames
-  defaultMain (toTest <$> ts)
+  defaultMain . testGroup "Tests not requiring an HTTP server" $
+      testProperty "Invert schemas through JSON without change" invertSchema
+    : testGroup "Make paths to invalid data correctly" correctPaths
+    : fmap toTest ts
 
+invertSchema :: Schema -> Bool
+invertSchema a = Just a == decode (encode a)
+
+correctPaths :: [TestTree]
+correctPaths =
+  [ HU.testCase "Items object" itemsObject
+  , HU.testCase "Items array" itemsArray
+  ]
+
+itemsObject :: IO ()
+itemsObject = HU.assertEqual "Path to invalid data"
+                             (P.Pointer [P.Token "0"])
+                             (_failureOffendingData failure)
   where
-    dir :: String
-    dir = "JSON-Schema-Test-Suite/tests/draft4"
+    [failure] = runValidate (SchemaCache schema mempty) sc (toJSON [[True, True]])
+
+    schema :: Schema
+    schema = emptySchema
+      { _schemaItems = Just (VA.ItemsObject (emptySchema { _schemaUniqueItems = Just True }))
+      }
+
+    sc :: SchemaContext Schema
+    sc = SchemaContext
+      { _scURI    = Nothing
+      , _scSchema = schema
+      }
+
+itemsArray :: IO ()
+itemsArray = HU.assertEqual "Path to invalid data"
+                            (P.Pointer [P.Token "0"])
+                            (_failureOffendingData failure)
+  where
+    [failure] = runValidate (SchemaCache schema mempty) sc (toJSON [[True, True]])
+
+    schema :: Schema
+    schema = emptySchema
+      { _schemaItems = Just (VA.ItemsArray [emptySchema { _schemaUniqueItems = Just True }])
+      }
+
+    sc :: SchemaContext Schema
+    sc = SchemaContext
+      { _scURI    = Nothing
+      , _scSchema = schema
+      }
diff --git a/tests/Remote.hs b/tests/Remote.hs
--- a/tests/Remote.hs
+++ b/tests/Remote.hs
@@ -3,21 +3,24 @@
 import           Control.Applicative
 import           Control.Concurrent.Async       (withAsync)
 import           Data.List                      (isSuffixOf)
-import           Lib
 import           Network.Wai.Application.Static (defaultFileServerSettings,
                                                  staticApp)
 import           Network.Wai.Handler.Warp       (run)
 import           System.Directory               (getDirectoryContents)
-import           Test.Framework
+import           Test.Tasty                     (defaultMain, testGroup)
 
+import           Shared                         (isLocal, readSchemaTests,
+                                                 toTest)
+
+dir :: String
+dir = "JSON-Schema-Test-Suite/tests/draft4"
+
 main :: IO ()
-main =
-  withAsync (run 1234 $ staticApp $ defaultFileServerSettings "JSON-Schema-Test-Suite/remotes") $ \_ -> do
-    filenames <- filter (not . isLocal) . filter (".json" `isSuffixOf`)
+main = withAsync serve $ \_ -> do
+  filenames <- filter (not . isLocal) . filter (".json" `isSuffixOf`)
                  <$> getDirectoryContents dir
-    ts <- readSchemaTests dir filenames
-    defaultMain (toTest <$> ts)
+  ts <- readSchemaTests dir filenames
+  defaultMain . testGroup "Tests that run an HTTP server" $ toTest <$> ts
 
-  where
-    dir :: String
-    dir = "JSON-Schema-Test-Suite/tests/draft4"
+serve :: IO ()
+serve = run 1234 . staticApp . defaultFileServerSettings $ "JSON-Schema-Test-Suite/remotes"
diff --git a/tests/Shared.hs b/tests/Shared.hs
new file mode 100644
--- /dev/null
+++ b/tests/Shared.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Shared where
+
+import           Control.Applicative
+import           Control.Monad
+import           Data.Aeson
+import           Data.Aeson.TH
+import qualified Data.ByteString.Lazy   as LBS
+import           Data.Char              (toLower)
+import           Data.Monoid
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import           GHC.Generics
+import           System.FilePath        ((</>))
+import           Test.Tasty             (TestTree)
+import qualified Test.Tasty.HUnit       as HU
+
+import qualified Data.JsonSchema.Draft4 as D4
+
+isLocal :: String -> Bool
+isLocal file = (file /= "definitions.json")
+            && (file /= "ref.json")
+            && (file /= "refRemote.json")
+
+data SchemaTest = SchemaTest
+  { _stDescription :: Text
+  , _stSchema      :: D4.Schema
+  , _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 :: String -> [String] -> IO [SchemaTest]
+readSchemaTests dir jsonFiles = concatMapM fileToCases jsonFiles
+  where
+    -- Each file contains an array of SchemaTests, not just one.
+    fileToCases :: String -> IO [SchemaTest]
+    fileToCases name = do
+      let fullPath = dir </> name
+      jsonBS <- LBS.readFile fullPath
+      case eitherDecode jsonBS of
+        Left e -> fail $ "couldn't parse file '" <> fullPath <> "': " <> e
+        Right schemaTests -> pure $ prependFileName name <$> schemaTests
+
+    prependFileName :: String -> SchemaTest -> SchemaTest
+    prependFileName fileName s = s
+      { _stDescription = T.pack fileName <> ": " <> _stDescription s
+      }
+
+    concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
+    concatMapM f xs = liftM concat (mapM f xs)
+
+toTest :: SchemaTest -> TestTree
+toTest st =
+  HU.testCase (T.unpack (_stDescription st)) $ do
+    forM_ (_stCases st) $ \sc -> do
+      g <- assertRight =<< D4.fetchReferencedSchemas mempty (D4.SchemaContext Nothing (_stSchema st))
+      validate <- assertRight . D4.checkSchema g $ D4.SchemaContext Nothing (_stSchema st)
+      let res = validate (_scData sc)
+      if _scValid sc
+        then assertValid   sc res
+        else assertInvalid sc res
+
+assertValid :: SchemaTestCase -> [D4.Failure] -> HU.Assertion
+assertValid _ [] = pure ()
+assertValid sc errs =
+  HU.assertFailure $ unlines
+    [ "    Failed to validate data"
+    , "    Description: "         <> T.unpack (_scDescription sc)
+    , "    Data: "                <> show (_scData sc)
+    , "    Validation failures: " <> show errs
+    ]
+
+assertInvalid :: SchemaTestCase -> [D4.Failure] -> HU.Assertion
+assertInvalid sc [] =
+  HU.assertFailure $ unlines
+    [ "    Validated invalid data"
+    , "    Description: " <> T.unpack (_scDescription sc)
+    , "    Data: "        <> show (_scData sc)
+    ]
+assertInvalid _ _ = pure ()
+
+assertRight :: (Show a) => Either a b -> IO b
+assertRight (Left e)  = HU.assertFailure (show e) >> fail "assertRight failed"
+assertRight (Right b) = pure b