diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+The MIT License (MIT)
+Copyright © 2012 Tim Baumann, http://timbaumann.info
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the “Software”), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/aeson-schema.cabal b/aeson-schema.cabal
new file mode 100644
--- /dev/null
+++ b/aeson-schema.cabal
@@ -0,0 +1,78 @@
+name:                aeson-schema
+version:             0.1.0.0
+synopsis:            Haskell JSON schema validator and parser generator
+-- description:         
+homepage:            https://github.com/timjb/aeson-schema
+license:             MIT
+license-file:        LICENSE
+author:              Tim Baumann <tim@timbaumann.info>
+maintainer:          Tim Baumann <tim@timbaumann.info>
+category:            Data
+build-type:          Simple
+cabal-version:       >=1.8
+
+source-repository head
+  type:                git
+  location:            git://github.com/timjb/haskell-aeson-schema.git
+
+library
+  ghc-options:         -Wall
+  hs-source-dirs:      src
+  exposed-modules:     Data.Aeson.Schema, Data.Aeson.Schema.Validator, Data.Aeson.Schema.CodeGen, Data.Aeson.Schema.Choice, Data.Aeson.Schema.Helpers, Data.Aeson.Schema.Types
+  other-modules:       Data.Aeson.Schema.Choice.TH, Data.Aeson.TH.Lift
+  extensions:          OverloadedStrings
+  build-depends:       base == 4.5.*,
+                       aeson >= 0.6.0.2,
+                       vector >= 0.7.1,
+                       text >= 0.11.1.0,
+                       regex-pcre >= 0.94.4,
+                       unordered-containers >= 0.1.3.0,
+                       containers,
+                       attoparsec >= 0.8.6.1,
+                       template-haskell,
+                       th-lift >= 0.5.5 && < 0.6,
+                       mtl >= 2 && < 3,
+                       transformers >= 0.3.0.0,
+                       QuickCheck >= 2.4.2 && < 2.5,
+                       syb >= 0.3.6.1,
+                       bytestring
+
+executable generate-aeson-schema
+  ghc-options:         -Wall
+  main-is:             generate-aeson-schema.hs
+  hs-source-dirs:      .
+  build-depends:       base == 4.5.*,
+                       aeson-schema,
+                       cmdargs,
+                       containers,
+                       text,
+                       aeson,
+                       template-haskell,
+                       attoparsec,
+                       bytestring
+
+test-suite tests
+  ghc-options:         -Wall
+  hs-source-dirs:      test
+  type:                exitcode-stdio-1.0
+  main-is:             TestSuite.hs
+  extensions:          OverloadedStrings
+  build-depends:       base == 4.5.*,
+                       aeson,
+                       text,
+                       vector,
+                       containers,
+                       hashable,
+                       unordered-containers,
+                       aeson-schema,
+                       attoparsec,
+                       template-haskell,
+                       test-framework >= 0.6 && < 0.7,
+                       test-framework-hunit >= 0.2.7,
+                       HUnit >= 1.2.4.3,
+                       test-framework-quickcheck2 >= 0.2.12.2 && < 0.3,
+                       QuickCheck >= 2.4.2 && < 2.5,
+                       bytestring,
+                       hint,
+                       temporary,
+                       mtl
diff --git a/generate-aeson-schema.hs b/generate-aeson-schema.hs
new file mode 100644
--- /dev/null
+++ b/generate-aeson-schema.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Main where
+
+import Prelude hiding (readFile)
+import Data.Version (showVersion)
+import System.Console.CmdArgs
+import Data.Aeson.Parser (json)
+import Data.ByteString (readFile)
+import Data.Attoparsec.ByteString (parse, Result, IResult (..))
+import Data.Aeson.Schema.CodeGen (generateModule)
+import Language.Haskell.TH.Syntax (runQ)
+import Data.Aeson (fromJSON)
+import qualified Data.Aeson as A
+import Data.Text (Text, pack)
+import qualified Data.Text.IO as TIO
+import qualified Data.Map as M
+
+import Paths_aeson_schema (version)
+import Data.Aeson.Schema (Schema (..))
+
+data GenerateArgs = GenerateArgs
+  { modName :: String
+  , inputSchema :: FilePath
+  } deriving (Data, Show, Typeable)
+
+generateArgs :: GenerateArgs
+generateArgs = GenerateArgs
+  { modName = "Schema" &= name "module-name" &= opt "Schema" &= help "Name of the generated module"
+  , inputSchema = "" &= typFile &= argPos 0
+  } &= summary ("generate-aeson-schema-" ++ showVersion version)
+
+main :: IO ()
+main = do
+  args <- cmdArgs generateArgs
+  contents <- readFile $ inputSchema args
+  value <- iResultM $ parse json contents
+  case fromJSON value :: A.Result (Schema Text) of
+    A.Error str -> fail str
+    A.Success schema -> do
+      let m = M.fromList [(pack "A", schema)]
+      (code, _) <- runQ $ generateModule (pack $ modName args) m
+      TIO.putStrLn code
+  where
+    iResultM :: (Monad m) => Result a -> m a
+    iResultM (Fail _ _ err) = fail err
+    iResultM (Partial _) = fail "unexpected end of file"
+    iResultM (Done _ r) = return r
diff --git a/src/Data/Aeson/Schema.hs b/src/Data/Aeson/Schema.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Schema.hs
@@ -0,0 +1,18 @@
+-- | Validate all positive numbers:
+-- 
+-- >>> :set -XQuasiQuotes
+-- >>> :m +Data.Aeson Data.Aeson.Schema Data.Map Data.Text
+-- >>> let positiveNumbers = [schemaQQ| { "type": "number", "minimum": 0, "exclusiveMinimum": true } |]
+-- >>> validate Data.Map.empty positiveNumbers (Number $ fromInteger 1)
+-- []
+-- >>> validate Data.Map.empty positiveNumbers (Number $ fromInteger 0)
+-- ["number must be greater than 0"]
+-- >>> validate Data.Map.empty positiveNumbers (String $ pack "lorem")
+-- ["type mismatch: expected NumberType but got string"]
+module Data.Aeson.Schema
+  ( module Data.Aeson.Schema.Types
+  , module Data.Aeson.Schema.Validator
+  ) where
+
+import Data.Aeson.Schema.Types
+import Data.Aeson.Schema.Validator
diff --git a/src/Data/Aeson/Schema/Choice.hs b/src/Data/Aeson/Schema/Choice.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Schema/Choice.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | This module implements generalized sum types. In theory, you could use
+-- a type representing a choice between different options by nesting the Either
+-- type. In practice, however, pattern matching against such a type can quickly
+-- become unwieldy. This module defines data types and functions for any number
+-- of choices from 2 to 20. The naming schema is based on Data.Either.
+-- For example:
+-- 
+-- @
+-- data Choice3 a b c = Choice1of3 a | Choice2of3 b | Choice3of3 c deriving (...)
+-- choice3 :: (a -> x) -> (b -> x) -> (c -> x) -> Choice3 a b c -> x
+-- mapChoice3 :: (a1 -> a2) -> (b1 -> b2) -> (c1 -> c2) -> Choice a1 b1 c1 -> Choice a2 b2 c2
+-- choice1of3s :: [Choice3 a b c] -> [a]
+-- choice2of3s :: [Choice3 a b c] -> [b]
+-- choice3of3s :: [Choice3 a b c] -> [c]
+-- @
+module Data.Aeson.Schema.Choice where
+
+import           Data.Aeson.Schema.Choice.TH (generateChoice)
+import           Language.Haskell.TH         (mkName)
+import           Language.Haskell.TH.Lift    (deriveLiftMany)
+
+$(fmap concat (mapM generateChoice [2..20]))
+
+$(deriveLiftMany $ map (mkName . ("Choice" ++) . show) ([2..20] :: [Int]))
diff --git a/src/Data/Aeson/Schema/Choice/TH.hs b/src/Data/Aeson/Schema/Choice/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Schema/Choice/TH.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Data.Aeson.Schema.Choice.TH
+  ( generateChoice
+  ) where
+
+import           Control.Applicative (Alternative (..), (<$>))
+import           Control.Monad       (forM)
+import           Data.Aeson          (FromJSON (..), ToJSON (..))
+import           Language.Haskell.TH
+import           Test.QuickCheck     (Arbitrary (..), oneof)
+
+generateChoice :: Int -> Q [Dec]
+generateChoice n | n < 2 = return []
+generateChoice n = do
+  tyName <- newName $ "Choice" ++ show n
+  let tyParamNames = map (mkName . singleton) $ take n ['a'..]
+  let tyParams = map varT tyParamNames
+  conNames <- mapM (newName . \i -> "Choice" ++ show i ++ "of" ++ show n) [1..n]
+  let cons = zipWith normalC conNames $ map ((:[]) . strictType notStrict) tyParams
+  dataDec <- dataD (cxt []) tyName (map PlainTV tyParamNames) cons [''Eq, ''Ord, ''Show, ''Read]
+  let tyCon = appConT tyName tyParams
+  let genClassConstraints c = cxt $ map (classP c . singleton) tyParams
+  instToJSON <- instanceD (genClassConstraints ''ToJSON)
+                          (conT ''ToJSON `appT` tyCon)
+                          [ funD 'toJSON $ zipWith genToJSONClause conNames tyParamNames ]
+  instFromJSON <- instanceD (genClassConstraints ''FromJSON)
+                            (conT ''FromJSON `appT` tyCon)
+                            [ let v = mkName "v" in
+                              funD 'parseJSON [clause [varP v]
+                                                      (normalB $ foldl (\a b -> [| $a <|> $b |]) [| empty |]
+                                                               $ map (\con -> [| $(conE con) <$> parseJSON $(varE v) |]) conNames)
+                                                      []
+                                              ]
+                            ]
+  instArbitrary <- instanceD (genClassConstraints ''Arbitrary)
+                             (conT ''Arbitrary `appT` tyCon)
+                             [ valD (varP 'arbitrary)
+                                    (normalB $ varE 'oneof `appE` listE (map (\con -> [| $(conE con) <$> arbitrary |]) conNames))
+                                    []
+                             ]
+  let choiceN = mkName $ "choice" ++ show n
+  let resultT = mkName "res"
+  choiceFunDec <- sigD choiceN
+                     $ forallT (map PlainTV $ tyParamNames ++ [resultT])
+                               (cxt [])
+                             $ functionT (map (`arrT` varT resultT) tyParams)
+                                       $ appConT tyName tyParams `arrT` varT resultT
+  choiceFun <- funD choiceN
+                  $ let f = mkName "f"
+                        v = mkName "v"
+                    in zipWith (\i con -> clause (replicate i wildP ++ [varP f] ++ replicate (n-i-1) wildP ++ [conP con [varP v]])
+                                                 (normalB $ varE f `appE` varE v)
+                                                 []) [0..] conNames
+
+  let mapChoiceN = mkName $ "mapChoice" ++ show n
+  let typeAs = mkNames 'a'
+  let typeBs = mkNames 'b'
+  mapChoiceFunDec <- sigD mapChoiceN
+                        $ forallT (map PlainTV $ typeAs ++ typeBs)
+                                  (cxt [])
+                                $ functionT (zipWith arrT (map varT typeAs) (map varT typeBs))
+                                          $ appConT tyName (map varT typeAs) `arrT` appConT tyName (map varT typeBs)
+  mapChoiceFun <- funD mapChoiceN
+                     $ let f = mkName "f"
+                           v = mkName "v"
+                       in zipWith (\i con -> clause (replicate i wildP ++ [varP f] ++ replicate (n-i-1) wildP ++ [conP con [varP v]])
+                                                    (normalB $ conE con `appE` (varE f `appE` varE v))
+                                                    []) [0..] conNames
+  choiceIofNFuns <- fmap concat $ forM (zip [1..n] conNames) $ \(i, con) -> do
+    let choiceIofN = mkName $ "choice" ++ show i ++ "of" ++ show n ++ "s"
+    typeDec <- sigD choiceIofN
+                  $ forallT (map PlainTV tyParamNames)
+                            (cxt [])
+                          $ appT listT (appConT tyName (map varT tyParamNames)) `arrT` appT listT (tyParams !! (i-1))
+    let cs = mkName "cs"
+        c  = mkName "c"
+    funDef <- funD choiceIofN
+                   [clause [varP cs] (normalB $ compE [ bindS (conP con [varP c]) (varE cs)
+                                                      , noBindS (varE c)
+                                                      ]) []]
+    return [typeDec, funDef]
+  return $ [dataDec, instToJSON, instFromJSON, instArbitrary, choiceFunDec, choiceFun, mapChoiceFunDec, mapChoiceFun] ++ choiceIofNFuns
+  where
+    singleton :: a -> [a]
+    singleton = (:[])
+    genToJSONClause :: Name -> Name -> ClauseQ
+    genToJSONClause con param = clause [conP con [varP param]] (normalB . appE (varE 'toJSON) . varE $ param) []
+    mkNames :: Char -> [Name]
+    mkNames ch = map (mkName . (ch:) . show) [1..n]
+    arrT :: TypeQ -> TypeQ -> TypeQ
+    arrT a b = arrowT `appT` a `appT` b
+    functionT :: [TypeQ] -> TypeQ -> TypeQ
+    functionT ins out = foldr arrT out ins
+    appConT :: Name -> [TypeQ] -> TypeQ
+    appConT con = foldl appT (conT con)
diff --git a/src/Data/Aeson/Schema/CodeGen.hs b/src/Data/Aeson/Schema/CodeGen.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Schema/CodeGen.hs
@@ -0,0 +1,460 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TupleSections              #-}
+
+module Data.Aeson.Schema.CodeGen
+  ( Declaration (..)
+  , Code
+  , generate
+  , generateTH
+  , generateModule
+  ) where
+
+import           Control.Applicative         (Applicative (..), (<$>), (<*>),
+                                              (<|>))
+import           Control.Arrow               (first, second)
+import           Control.Monad               (forM_, unless, when, zipWithM)
+import           Control.Monad.RWS.Lazy      (MonadReader (..), MonadState (..),
+                                              MonadWriter (..), RWST (..),
+                                              evalRWST)
+import qualified Control.Monad.Trans.Class   as MT
+import           Data.Aeson
+import           Data.Aeson.Types            (parse)
+import           Data.Attoparsec.Number      (Number (..))
+import           Data.Char                   (isAlphaNum, isLetter, toLower,
+                                              toUpper)
+import           Data.Data                   (Data, Typeable)
+import           Data.Function               (on)
+import qualified Data.HashMap.Lazy           as HM
+import qualified Data.HashSet                as HS
+import           Data.List                   (mapAccumL, sort, unzip4)
+import qualified Data.Map                    as M
+import           Data.Maybe                  (catMaybes, isNothing, maybeToList)
+import           Data.Monoid                 ((<>))
+import           Data.Text                   (Text, pack, unpack)
+import qualified Data.Text                   as T
+import           Data.Traversable            (forM, traverse)
+import           Data.Tuple                  (swap)
+import qualified Data.Vector                 as V
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax
+import qualified Text.Regex.PCRE             as PCRE
+import           Text.Regex.PCRE.String      (Regex)
+
+import           Data.Aeson.Schema.Choice
+import           Data.Aeson.Schema.Helpers
+import           Data.Aeson.Schema.Types
+import           Data.Aeson.Schema.Validator
+import           Data.Aeson.TH.Lift          ()
+
+-- | A top-level declaration.
+data Declaration = Declaration Dec (Maybe Text) -- ^ Optional textual declaration. This can be used for information (e.g. inline comments) that are not representable in TH.
+                 | Comment Text -- ^ Comment text
+                 deriving (Show, Eq, Typeable, Data)
+
+-- | Haskell code (without module declaration and imports)
+type Code = [Declaration]
+
+type StringSet = HS.HashSet String
+type SchemaTypes = M.Map Text Name
+
+-- Code generation monad: Keeps a set of used names, writes out the code and
+-- has a readonly map from schema identifiers to the names of the corresponding
+-- types in the generated code.
+newtype CodeGenM a = CodeGenM
+  { unCodeGenM :: RWST SchemaTypes Code StringSet Q a
+  } deriving (Monad, Applicative, Functor, MonadReader SchemaTypes, MonadWriter Code, MonadState StringSet)
+
+-- | Generates a fresh name
+codeGenNewName :: String -> StringSet -> (Name, StringSet)
+codeGenNewName s used = (Name (mkOccName free) NameS, HS.insert free used)
+  where
+    free = head $ dropWhile (`HS.member` used) $ (if validName s then (s:) else id) $ map (\i -> s ++ "_" ++ show i) ([1..] :: [Int])
+    -- taken from http://www.haskell.org/haskellwiki/Keywords
+    haskellKeywords = HS.fromList
+      [ "as", "case", "of", "class", "data", "data family", "data instance"
+      , "default", "deriving", "deriving instance", "do", "forall", "foreign"
+      , "hiding", "if", "then", "else", "import", "infix", "infixl", "infixr"
+      , "instance", "let", "in", "mdo", "module", "newtype", "proc"
+      , "qualified", "rec", "type", "type family", "type instance", "where"
+      ]
+    validName n = not (n `elem` ["", "_"] || n `HS.member` haskellKeywords)
+
+instance Quasi CodeGenM where
+  qNewName = state . codeGenNewName
+  qReport b = CodeGenM . MT.lift . report b
+  qRecover (CodeGenM handler) (CodeGenM action) = do
+    graph <- ask
+    currState <- get
+    (a, s, w) <- CodeGenM $ MT.lift $ (recover `on` \m -> runRWST m graph currState) handler action
+    put s
+    tell w
+    return a
+  qLookupName b = CodeGenM . MT.lift . (if b then lookupTypeName else lookupValueName)
+  qReify = CodeGenM . MT.lift . reify
+  qReifyInstances name = CodeGenM . MT.lift . reifyInstances name
+  qLocation = CodeGenM . MT.lift $ location
+  qRunIO = CodeGenM . MT.lift . runIO
+  qAddDependentFile = CodeGenM . MT.lift . addDependentFile
+
+instance (Lift k, Lift v) => Lift (M.Map k v) where
+  lift m = [| M.fromList $(lift $ M.toList m) |]
+
+-- | Needed modules that are not found by "getUsedModules".
+extraModules :: [String]
+extraModules =
+  [ "Text.Regex" -- provides RegexMaker instances
+  , "Text.Regex.PCRE.String" -- provides RegexLike instances, Regex type
+  , "Data.Aeson.Types" -- Parser type
+  , "Data.Ratio"
+  ]
+
+-- | Extracts all TH declarations
+getDecs :: Code -> [Dec]
+getDecs code = [ dec | Declaration dec _ <- code ]
+
+-- | Generate data-types and FromJSON instances for all schemas
+generateTH :: Graph Schema Text -- ^ Set of schemas
+           -> Q ([Dec], M.Map Text Name) -- ^ Generated code and mapping from schema identifiers to type names
+generateTH = fmap (first getDecs) . generate
+
+-- | Generated a self-contained module that parses and validates values of
+-- a set of given schemas.
+generateModule :: Text -- ^ Name of the generated module
+               -> Graph Schema Text -- ^ Set of schemas
+               -> Q (Text, M.Map Text Name) -- ^ Module code and mapping from schema identifiers to type names
+generateModule modName = fmap (first $ renderCode . map rewrite) . generate
+  where
+    renderCode :: Code -> Text
+    renderCode code = T.unlines $ [modDec] ++ imprts ++ map renderDeclaration code
+      where
+        mods = sort $ extraModules ++ getUsedModules (getDecs code)
+        imprts = map (\m -> "import " <> pack m) mods
+        modDec = "module " <> modName <> " where"
+    rewrite :: Declaration -> Declaration
+    rewrite (Declaration dec text) = Declaration (replaceHiddenModules $ cleanPatterns dec) text
+    rewrite a = a
+    renderDeclaration :: Declaration -> Text
+    renderDeclaration (Declaration _ (Just text)) = text
+    renderDeclaration (Declaration dec Nothing)   = pack (pprint dec)
+    renderDeclaration (Comment comment)           = T.unlines $ map (\line -> "-- " <> line) $ T.lines comment
+
+-- | Generate a generalized representation of the code in a Haskell module
+generate :: Graph Schema Text -> Q (Code, M.Map Text Name)
+generate graph = swap <$> evalRWST (unCodeGenM $ generateTopLevel graph >> return typeMap) typeMap used
+  where
+    (used, typeMap) = second M.fromList $ mapAccumL nameAccum HS.empty (M.keys graph)
+    nameAccum usedNames schemaName = second (schemaName,) $ swap $ codeGenNewName (firstUpper $ unpack schemaName) usedNames
+
+generateTopLevel :: Graph Schema Text -> CodeGenM ()
+generateTopLevel graph = do
+  typeMap <- ask
+  graphN <- qNewName "graph"
+  when (nameBase graphN /= "graph") $ fail "name graph is already taken"
+  graphDecType <- runQ $ sigD graphN [t| Graph Schema Text |]
+  graphDec <- runQ $ valD (varP graphN) (normalB $ lift graph) []
+  tell [Declaration graphDecType Nothing, Declaration graphDec Nothing]
+  forM_ (M.toList graph) $ \(name, schema) -> do
+    let typeName = typeMap M.! name
+    ((typeQ, exprQ), defNewtype) <- generateSchema (Just typeName) name schema
+    when defNewtype $ do
+      let newtypeCon = normalC typeName [strictType notStrict typeQ]
+      newtypeDec <- runQ $ newtypeD (cxt []) typeName [] newtypeCon []
+      fromJSONInst <- runQ $ instanceD (cxt []) (conT ''FromJSON `appT` conT typeName)
+        [ valD (varP $ mkName "parseJSON") (normalB [| fmap $(conE typeName) . $exprQ |]) []
+        ]
+      tell [Declaration newtypeDec Nothing, Declaration fromJSONInst Nothing]
+
+generateSchema :: Maybe Name -- ^ Name to be used by type declarations
+               -> Text -- ^ Describes the position in the schema
+               -> Schema Text
+               -> CodeGenM ((TypeQ, ExpQ), Bool) -- ^ ((type of the generated representation (a), function :: Value -> Parser a), whether a newtype wrapper is necessary)
+generateSchema decName name schema = case schemaDRef schema of
+  Just ref -> ask >>= \typesMap -> case M.lookup ref typesMap of
+    Nothing -> fail "couldn't find referenced schema"
+    Just referencedSchema -> return ((conT referencedSchema, [| parseJSON |]), True)
+  Nothing -> first (second wrap) <$> case schemaType schema of
+    [] -> fail "empty type"
+    [Choice1of2 typ] -> generateSimpleType decName name typ
+    [Choice2of2 sch] -> generateSchema decName name sch
+    unionType -> do
+      let l = pack . show $ length unionType
+      let names = map (\i -> name <> "Choice" <> pack (show i) <> "of" <> l) ([1..] :: [Int])
+      subs <- fmap (map fst) $ zipWithM (choice2 (flip $ generateSimpleType Nothing) (flip $ generateSchema Nothing)) unionType names
+      (,True) <$> generateUnionType subs
+  where
+    generateSimpleType :: Maybe Name -> Text -> SchemaType -> CodeGenM ((TypeQ, ExpQ), Bool)
+    generateSimpleType decName' name' typ = case typ of
+      StringType  -> (,True) <$> generateString schema
+      NumberType  -> (,True) <$> generateNumber schema
+      IntegerType -> (,True) <$> generateInteger schema
+      BooleanType -> (,True) <$> generateBoolean
+      ObjectType  -> case checkers of
+        [] -> (,False) <$> generateObject decName' name' schema
+        _  -> (,True)  <$> generateObject Nothing name' schema
+      ArrayType   -> (,True) <$> generateArray name' schema
+      NullType    -> (,True) <$> generateNull
+      AnyType     -> (,True) <$> generateAny schema
+    generateUnionType :: [(TypeQ, ExpQ)] -> CodeGenM (TypeQ, ExpQ)
+    generateUnionType union = return (typ, lamE [varP val] code)
+      where
+        n = length union
+        unionParsers = zipWith (\i parser -> [| $(choiceConE i n) <$> $parser $(varE val) |]) [1..] (map snd union)
+        choiceConE :: Int -> Int -> ExpQ
+        choiceConE i j = conE $ mkName $ "Data.Aeson.Schema.Choice.Choice" ++ show i ++ "of" ++ show j
+        choiceT i = conT $ mkName $ "Data.Aeson.Schema.Choice.Choice" ++ show i
+        typ = foldl appT (choiceT n) $ map fst union
+        code = foldr (\choiceParser unionParser -> [| $choiceParser <|> $unionParser |]) [| fail "no type in union" |] unionParsers
+    val = mkName "val"
+    checkEnum xs = assertStmt [| $(varE val) `elem` xs |] "not one of the values in enum"
+    checkDisallow dis = noBindS $ doE $ map (noBindS . choice2 disallowType disallowSchema) dis
+    disallowType StringType  = disallowPattern (conP 'String [wildP]) "strings are disallowed"
+    disallowType NumberType  = disallowPattern (conP 'Number [wildP]) "numbers are disallowed"
+    disallowType IntegerType = disallowPattern (conP 'Number [conP 'I [wildP]]) "integers are disallowed"
+    disallowType BooleanType = disallowPattern (conP 'Bool [wildP]) "booleans are disallowed"
+    disallowType ObjectType  = disallowPattern (conP 'Object [wildP]) "objects are disallowed"
+    disallowType ArrayType   = disallowPattern (conP 'Array [wildP]) "arrays are disallowed"
+    disallowType NullType    = disallowPattern (conP 'Null []) "null is disallowed"
+    disallowType AnyType     = [| fail "Nothing is allowed here. Sorry." |]
+    disallowPattern pat err = caseE (varE val)
+      [ match pat (normalB [| fail err |])[]
+      , match wildP (normalB [| return () |]) []
+      ]
+    disallowSchema sch =
+      [| case validate $(varE $ mkName "graph") $(lift sch) $(varE val) of
+           [] -> fail "disallowed"
+           _  -> return ()
+      |]
+    checkExtends exts = noBindS $ doE $ flip map exts $ noBindS . \sch ->
+      [| case validate $(varE $ mkName "graph") $(lift sch) $(varE val) of
+           [] -> return ()
+           es -> fail $ unlines es
+      |]
+    checkers = catMaybes
+      [ checkEnum <$> schemaEnum schema
+      , if null (schemaDisallow schema) then Nothing else Just (checkDisallow $ schemaDisallow schema)
+      , if null (schemaExtends schema) then Nothing else Just (checkExtends $ schemaExtends schema)
+      ]
+    wrap parser = if null checkers
+      then parser
+      else lamE [varP val] $ doE $ checkers ++ [noBindS $ parser `appE` varE val]
+
+assertStmt :: ExpQ -> String -> StmtQ
+assertStmt expr err = noBindS [| unless $(expr) (fail err) |]
+
+lambdaPattern :: PatQ -> ExpQ -> ExpQ -> ExpQ
+lambdaPattern pat body err = lamE [varP val] $ caseE (varE val)
+  [ match pat (normalB body) []
+  , match wildP (normalB err) []
+  ]
+  where val = mkName "val"
+
+generateString :: Schema Text -> CodeGenM (TypeQ, ExpQ)
+generateString schema = return (conT ''Text, code)
+  where
+    str = mkName "str"
+    checkMinLength l = assertStmt [| T.length $(varE str) >= l |] $ "string must have at least " ++ show l ++ " characters"
+    checkMaxLength l = assertStmt [| T.length $(varE str) <= l |] $ "string must have at most " ++ show l ++ " characters"
+    checkPattern (Pattern p _) = noBindS $ doE
+      [ bindS (varP $ mkName "regex") [| PCRE.makeRegexM $(lift (T.unpack p)) |]
+      , assertStmt [| PCRE.match ($(varE $ mkName "regex") :: Regex) (unpack $(varE str)) |] $ "string must match pattern " ++ show p
+      ]
+    checkFormat format = noBindS [| maybe (return ()) fail (validateFormat $(lift format) $(varE str)) |]
+    checkers = catMaybes
+      [ if schemaMinLength schema > 0 then Just (checkMinLength $ schemaMinLength schema) else Nothing
+      , checkMaxLength <$> schemaMaxLength schema
+      , checkPattern <$> schemaPattern schema
+      , checkFormat <$> schemaFormat schema
+      ]
+    code = lambdaPattern (conP 'String [varP str])
+                         (doE $ checkers ++ [noBindS [| return $(varE str) |]])
+                         [| fail "not a string" |]
+
+generateNumber :: Schema Text -> CodeGenM (TypeQ, ExpQ)
+generateNumber schema = return (conT ''Number, code)
+  where
+    num = mkName "num"
+    code = lambdaPattern (conP 'Number [varP num])
+                         (doE $ numberCheckers num schema ++ [noBindS [| return $(varE num) |]])
+                         [| fail "not a number" |]
+
+generateInteger :: Schema Text -> CodeGenM (TypeQ, ExpQ)
+generateInteger schema = return (conT ''Integer, code)
+  where
+    num = mkName "num"
+    code = lambdaPattern (conP 'Number [asP num $ conP 'I [varP $ mkName "i"]])
+                         (doE $ numberCheckers num schema ++ [noBindS [| return $(varE $ mkName "i") |]])
+                         [| fail "not an integer" |]
+
+numberCheckers :: Name -> Schema Text -> [StmtQ]
+numberCheckers num schema = catMaybes
+  [ checkMinimum (schemaExclusiveMinimum schema) <$> schemaMinimum schema
+  , checkMaximum (schemaExclusiveMaximum schema) <$> schemaMaximum schema
+  , checkDivisibleBy <$> schemaDivisibleBy schema
+  ]
+  where
+    checkMinimum, checkMaximum :: Bool -> Number -> StmtQ
+    checkMinimum excl m = if excl
+      then assertStmt [| $(varE num) >  m |] $ "number must be greater than " ++ show m
+      else assertStmt [| $(varE num) >= m |] $ "number must be greater than or equal " ++ show m
+    checkMaximum excl m = if excl
+      then assertStmt [| $(varE num) <  m |] $ "number must be less than " ++ show m
+      else assertStmt [| $(varE num) <= m |] $ "number must be less than or equal " ++ show m
+    checkDivisibleBy devisor = assertStmt [| $(varE num) `isDivisibleBy` devisor |] $ "number must be devisible by " ++ show devisor
+
+generateBoolean :: CodeGenM (TypeQ, ExpQ)
+generateBoolean = return (conT ''Bool, varE 'parseJSON)
+
+generateNull :: CodeGenM (TypeQ, ExpQ)
+generateNull = return (tupleT 0, code)
+  where
+    code = lambdaPattern (conP 'Null [])
+                         [| return () |]
+                         [| fail "not null" |]
+
+cleanName :: String -> String
+cleanName str = charFirst
+  where
+    isAllowed c = isAlphaNum c || c `elem` "'_"
+    cleaned = filter isAllowed str
+    charFirst = case cleaned of
+      (chr:_) | not (isLetter chr || chr == '_') -> '_':cleaned
+      _ -> cleaned
+firstUpper, firstLower :: String -> String
+firstUpper "" = ""
+firstUpper (c:cs) = toUpper c : cs
+firstLower "" = ""
+firstLower (c:cs) = toLower c : cs
+
+generateObject :: Maybe Name -- ^ Name to be used by data declaration
+               -> Text
+               -> Schema Text
+               -> CodeGenM (TypeQ, ExpQ)
+generateObject decName name schema = do
+  let propertiesList = HM.toList $ schemaProperties schema
+  (propertyNames, propertyTypes, propertyParsers, defaultParsers) <- fmap unzip4 $ forM propertiesList $ \(fieldName, propertySchema) -> do
+    let cleanedFieldName = cleanName $ unpack fieldName
+    propertyName <- qNewName $ firstLower cleanedFieldName
+    ((typ, expr), _) <- generateSchema Nothing (name <> pack (firstUpper cleanedFieldName)) propertySchema
+    let lookupProperty = [| HM.lookup $(lift fieldName) $(varE obj) |]
+    case schemaDefault propertySchema of
+      Just defaultValue -> do
+        defaultName <- qNewName $ "default" <> firstUpper cleanedFieldName
+        return (propertyName, typ, [| maybe (return $(varE defaultName)) $expr $lookupProperty |], Just $ valD (conP 'Success [varP defaultName]) (normalB [| parse $expr $(lift defaultValue) |]) [])
+      Nothing -> return $ if schemaRequired propertySchema
+        then (propertyName, typ, [| maybe (fail $(lift $ "required property " ++ unpack fieldName ++ " missing")) $expr $lookupProperty |], Nothing)
+        else (propertyName, conT ''Maybe `appT` typ, [| traverse $expr $lookupProperty |], Nothing)
+  conName <- maybe (qNewName $ firstUpper $ unpack name) return decName
+  let typ = conT conName
+  let dataCon = recC conName $ zipWith (\pname ptyp -> (pname,NotStrict,) <$> ptyp) propertyNames propertyTypes
+  dataDec <- runQ $ dataD (cxt []) conName [] [dataCon] []
+  let parser = foldl (\oparser propertyParser -> [| $oparser <*> $propertyParser |]) [| pure $(conE conName) |] propertyParsers
+  fromJSONInst <- runQ $ instanceD (cxt []) (conT ''FromJSON `appT` typ)
+    [ funD (mkName "parseJSON") -- cannot use a qualified name here
+        [ clause [conP 'Object [varP obj]] (normalB $ doE $ checkers ++ [noBindS parser]) (catMaybes defaultParsers)
+        , clause [wildP] (normalB [| fail "not an object" |]) []
+        ]
+    ]
+  tell [Declaration dataDec Nothing, Declaration fromJSONInst Nothing]
+  return (typ, [| parseJSON |])
+  where
+    obj = mkName "obj"
+    checkDependencies deps = noBindS
+      [| let items = HM.toList $(varE obj) in forM_ items $ \(pname, _) -> case HM.lookup pname $(lift deps) of
+           Nothing -> return ()
+           Just (Choice1of2 props) -> forM_ props $ \prop -> when (isNothing (HM.lookup prop $(varE obj))) $
+             fail $ unpack pname ++ " requires property " ++ unpack prop
+           Just (Choice2of2 depSchema) -> case validate $(varE $ mkName "graph") depSchema (Object $(varE obj)) of
+             [] -> return ()
+             es -> fail $ unlines es
+      |]
+    checkAdditionalProperties _ (Choice1of2 True) = [| return () |]
+    checkAdditionalProperties _ (Choice1of2 False) = [| fail "additional properties are not allowed" |]
+    checkAdditionalProperties value (Choice2of2 sch) =
+      [| case validate $(varE $ mkName "graph") $(lift sch) $(value) of
+           [] -> return ()
+           es -> fail $ unlines es
+      |]
+    checkPatternAndAdditionalProperties patterns additional = noBindS
+      [| let items = HM.toList $(varE obj) in forM_ items $ \(pname, value) -> do
+           let matchingPatterns = filter (flip PCRE.match (unpack pname) . patternCompiled . fst) $(lift patterns)
+           forM_ matchingPatterns $ \(_, sch) -> case validate $(varE $ mkName "graph") sch value of
+             [] -> return ()
+             es -> fail $ unlines es
+           let isAdditionalProperty = null matchingPatterns && pname `notElem` $(lift $ map fst $ HM.toList $ schemaProperties schema)
+           when isAdditionalProperty $(checkAdditionalProperties [| value |] additional)
+      |]
+    additionalPropertiesAllowed (Choice1of2 True) = True
+    additionalPropertiesAllowed _ = False
+    checkers = catMaybes
+      [ if HM.null (schemaDependencies schema) then Nothing else Just (checkDependencies $ schemaDependencies schema)
+      , if null (schemaPatternProperties schema) && additionalPropertiesAllowed (schemaAdditionalProperties schema)
+        then Nothing
+        else Just (checkPatternAndAdditionalProperties (schemaPatternProperties schema) (schemaAdditionalProperties schema))
+      ]
+
+generateArray :: Text -> Schema Text -> CodeGenM (TypeQ, ExpQ)
+generateArray name schema = case schemaItems schema of
+  Nothing -> monomorphicArray (conT ''Value) (varE 'parseJSON)
+  Just (Choice1of2 itemsSchema) -> do
+    ((itemType, itemCode), _) <- generateSchema Nothing (name <> "Item") itemsSchema
+    monomorphicArray itemType itemCode
+  Just (Choice2of2 itemSchemas) -> do
+    let names = map (\i -> name <> "Item" <> pack (show i)) ([0..] :: [Int])
+    items <- fmap (map fst) $ zipWithM (generateSchema Nothing) names itemSchemas
+    additionalItems <- case schemaAdditionalItems schema of
+      Choice1of2 b -> return $ Choice1of2 b
+      Choice2of2 sch -> Choice2of2 . fst <$> generateSchema Nothing (name <> "AdditionalItems") sch
+    tupleArray items additionalItems
+  where
+    tupleArray :: [(TypeQ, ExpQ)] -> Choice2 Bool (TypeQ, ExpQ) -> CodeGenM (TypeQ, ExpQ)
+    tupleArray items additionalItems = return (tupleType, code $ additionalCheckers ++ [noBindS tupleParser])
+      where
+        items' = flip map (zip [0..] items) $ \(i, (itemType, itemParser)) ->
+          let simpleParser = [| $(itemParser) (V.unsafeIndex $(varE arr) i) |]
+          in if i < schemaMinItems schema
+             then (itemType, simpleParser)
+             else (conT ''Maybe `appT` itemType, [| if V.length $(varE arr) > i then Just <$> $(simpleParser) else return Nothing|])
+        (additionalCheckers, maybeAdditionalTypeAndParser) = case additionalItems of
+          Choice1of2 b -> if b
+            then ([], Nothing)
+            else ([assertStmt [| V.length $(varE arr) <= $(lift $ length items') |] "no additional items allowed"], Nothing)
+          Choice2of2 (additionalType, additionalParser) ->
+            ( []
+            , Just (listT `appT` additionalType, [| mapM $(additionalParser) (V.toList $ V.drop $(lift $ length items') $(varE arr)) |])
+            )
+        items'' = items' ++ maybeToList maybeAdditionalTypeAndParser
+        (itemTypes, itemParsers) = unzip items''
+        (tupleType, tupleParser) = case items'' of
+          [(itemType, itemParser)] -> (itemType, itemParser)
+          _ -> foldl (\(typ, parser) (itemType, itemParser) -> (typ `appT` itemType, [| $(parser) <*> $(itemParser) |]))
+                     (tupleT $ length items'', [| pure $(conE $ tupleDataName $ length items'') |])
+                     items''
+
+    monomorphicArray :: TypeQ -> ExpQ -> CodeGenM (TypeQ, ExpQ)
+    monomorphicArray itemType itemCode = return (listT `appT` itemType, code [noBindS [| mapM $(itemCode) (V.toList $(varE arr)) |]])
+
+    arr = mkName "arr"
+    code parser = lambdaPattern (conP ''Array [varP arr])
+                                (doE $ checkers ++ parser)
+                                [| fail "not an array" |]
+    checkMinItems m = assertStmt [| V.length $(varE arr) >= m |] $ "array must have at least " ++ show m ++ " items"
+    checkMaxItems m = assertStmt [| V.length $(varE arr) <= m |] $ "array must have at most " ++ show m ++ " items"
+    checkUnique = assertStmt [| vectorUnique $(varE arr) |] "array items must be unique"
+    checkers = catMaybes
+      [ if schemaMinItems schema > 0 then Just (checkMinItems $ schemaMinItems schema) else Nothing
+      , checkMaxItems <$> schemaMaxItems schema
+      , if schemaUniqueItems schema then Just checkUnique else Nothing
+      ]
+
+generateAny :: Schema Text -> CodeGenM (TypeQ, ExpQ)
+generateAny schema = return (conT ''Value, code)
+  where
+    code =
+      [| \val -> case validate $(varE $ mkName "graph") $(lift schema) val of
+           [] -> return val
+           es -> fail $ unlines es
+      |]
diff --git a/src/Data/Aeson/Schema/Helpers.hs b/src/Data/Aeson/Schema/Helpers.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Schema/Helpers.hs
@@ -0,0 +1,106 @@
+module Data.Aeson.Schema.Helpers
+  ( vectorUnique
+  , formatValidators
+  , validateFormat
+  , isDivisibleBy
+  , replaceHiddenModules
+  , cleanPatterns
+  , getUsedModules
+  ) where
+
+import           Control.Monad          (join)
+import           Data.Attoparsec.Number (Number (..))
+import           Data.Generics          (Data, everything, everywhere, mkQ, mkT)
+import           Data.List              (nub)
+import           Data.Maybe             (maybeToList)
+import           Data.Ratio             (approxRational, denominator)
+import           Data.Text              (Text, unpack)
+import qualified Data.Vector            as V
+import           Language.Haskell.TH    (Name, Pat (..), mkName, nameBase,
+                                         nameModule)
+import           Text.Regex.PCRE        (makeRegexM)
+import           Text.Regex.PCRE.String (Regex)
+
+-- | Tests whether all items in a vector are different from each other.
+vectorUnique :: (Eq a) => V.Vector a -> Bool
+vectorUnique v = length (nub $ V.toList v) == V.length v
+
+-- | List of format validators. Some validators haven't been implemented yet.
+-- Those which are implemented take a Text value and return an error in case the
+-- input is invalid.
+formatValidators :: [(Text, Maybe (Text -> Maybe String))]
+formatValidators =
+  [ ("date-time", Nothing)
+  , ("data", Nothing)
+  , ("time", Nothing)
+  , ("utc-millisec", Nothing)
+  , ( "regex"
+    , Just $ \str -> case makeRegexM (unpack str) :: Maybe Regex of
+        Nothing -> Just $ "not a regex: " ++ show str
+        Just _ -> Nothing
+    )
+  , ("color", Nothing) -- not going to implement this
+  , ("style", Nothing) -- not going to implement this
+  , ("phone", Nothing)
+  , ("uri", Nothing)
+  , ("email", Nothing)
+  , ("ip-address", Nothing)
+  , ("ipv6", Nothing)
+  , ("host-name", Nothing)
+  ]
+
+-- | Validates a Text value against a format.
+validateFormat :: Text -- ^ format
+               -> Text -- ^ input
+               -> Maybe String -- ^ message in case of an error
+validateFormat format str = ($ str) =<< join (lookup format formatValidators)
+
+-- | Tests whether the first number is divisible by the second with no remainder.
+isDivisibleBy :: Number -> Number -> Bool
+isDivisibleBy (I i) (I j) = i `mod` j == 0
+isDivisibleBy a b = a == 0 || denominator (approxRational (a / b) epsilon) `elem` [-1,1]
+  where epsilon = D $ 10 ** (-10)
+
+-- | Workaround for an issue in Template Haskell: when you quote a name in TH
+-- like 'Text (Data.Text.Text) then TH searches for the module where Text is
+-- defined, even if that module is not exported by its package (in this case
+-- Text is defined in Data.Text.Internal). This works when we use TH to insert
+-- some code in a module but not when we use the TH code for pretty-printing.
+replaceHiddenModules :: Data a
+                     => a -- ^ Dec or Exp
+                     -> a
+replaceHiddenModules = everywhere $ mkT replaceModule
+  where
+    replacements =
+      [ ("Data.HashMap.Base", "Data.HashMap.Lazy")
+      , ("Data.Aeson.Types.Class", "Data.Aeson")
+      , ("Data.Aeson.Types.Internal", "Data.Aeson.Types")
+      , ("GHC.Integer.Type", "Prelude") -- "Could not find module `GHC.Integer.Type'; it is a hidden module in the package `integer-gmp'"
+      , ("GHC.Types", "Prelude")
+      , ("GHC.Real", "Prelude")
+      , ("Data.Text.Internal", "Data.Text")
+      ]
+    replaceModule :: Name -> Name
+    replaceModule n = case nameModule n of
+      Just "Data.Aeson.Types.Internal" | nameBase n `elem` ["I", "D"] ->
+        mkName $ "Data.Attoparsec.Number." ++ nameBase n
+      Just "GHC.Tuple" -> mkName $ nameBase n
+      Just m -> case lookup m replacements of
+        Just r -> mkName $ r ++ ('.' : nameBase n)
+        Nothing -> n
+      _ -> n
+
+-- | Workaround for a bug in Template Haskell: TH parses the empty list
+-- constructor in patterns as @ConP (mkName \"Prelude.[]\") []@ instead of @ListP []@
+cleanPatterns :: Data a => a -> a
+cleanPatterns = everywhere $ mkT replacePattern
+  where
+    replacePattern (ConP n []) | nameBase n == "[]" = ListP []
+    replacePattern p = p
+
+-- | Extracts a list of used modules from a TH code tree.
+getUsedModules :: Data a => a -> [String]
+getUsedModules = nub . everything (++) ([] `mkQ` extractModule)
+  where
+    extractModule :: Name -> [String]
+    extractModule = maybeToList . nameModule
diff --git a/src/Data/Aeson/Schema/Types.hs b/src/Data/Aeson/Schema/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Schema/Types.hs
@@ -0,0 +1,309 @@
+{-# OPTIONS_GHC -fno-warn-missing-fields #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TupleSections     #-}
+
+module Data.Aeson.Schema.Types
+  ( Pattern (..)
+  , mkPattern
+  , SchemaType (..)
+  , Schema (..)
+  , Graph
+  , empty
+  , schemaQQ
+  ) where
+
+import           Control.Applicative        ((<*>), (*>), (<*))
+import           Control.Arrow              (second)
+import           Control.Monad              (liftM)
+import           Data.Aeson                 (FromJSON (..), Value (..), (.!=),
+                                             (.:?))
+import           Data.Aeson.Parser          (value')
+import           Data.Aeson.Schema.Choice
+import           Data.Aeson.Types           (Parser, emptyArray, emptyObject,
+                                             parseEither)
+import           Data.Attoparsec.Char8      (skipSpace)
+import           Data.Attoparsec.Lazy       (Result (..), parse)
+import           Data.Attoparsec.Number     (Number (..))
+import           Data.ByteString.Lazy.Char8 (pack)
+import           Data.Foldable              (Foldable (..), toList)
+import           Data.Function              (on)
+import           Data.Functor               ((<$>))
+import           Data.HashMap.Strict        (HashMap)
+import qualified Data.HashMap.Strict        as H
+import qualified Data.Map                   as M
+import           Data.Maybe                 (catMaybes)
+import           Data.Text                  (Text, unpack)
+import           Data.Traversable           (traverse)
+import qualified Data.Vector                as V
+import           Language.Haskell.TH.Quote  (QuasiQuoter (..))
+import           Language.Haskell.TH        (varE, recUpdE)
+import           Language.Haskell.TH.Syntax (Lift (..))
+import           Prelude                    hiding (foldr, length)
+import           Text.Regex.PCRE            (makeRegexM)
+import           Text.Regex.PCRE.String     (Regex)
+import           Data.Aeson.TH.Lift         ()
+
+-- | Compiled regex and its source
+data Pattern = Pattern { patternSource :: Text, patternCompiled :: Regex }
+
+instance Eq Pattern where
+  (==) = (==) `on` patternSource
+
+instance Show Pattern where
+  show pattern = "let Right p = mkPattern (" ++ show (patternSource pattern) ++ ") in p"
+
+instance FromJSON Pattern where
+  parseJSON (String s) = mkPattern s
+  parseJSON _ = fail "only strings can be parsed as patterns"
+
+instance Lift Pattern where
+  lift (Pattern src _) = [| let Right p = mkPattern src in p |]
+
+-- | Compile a regex to a pattern, reporting errors with fail
+mkPattern :: (Monad m) => Text -> m Pattern
+mkPattern t = liftM (Pattern t) $ makeRegexM (unpack t)
+
+-- | Primitive JSON types
+data SchemaType = StringType
+                | NumberType
+                | IntegerType
+                | BooleanType
+                | ObjectType
+                | ArrayType
+                | NullType
+                | AnyType -- ^ any of the above
+                deriving (Eq, Ord, Enum, Bounded, Show, Read)
+
+instance FromJSON SchemaType where
+  parseJSON (String t) = case t of
+    "string"  -> return StringType
+    "number"  -> return NumberType
+    "integer" -> return IntegerType
+    "boolean" -> return BooleanType
+    "object"  -> return ObjectType
+    "array"   -> return ArrayType
+    "null"    -> return NullType
+    "any"     -> return AnyType
+    _         -> fail $ "not a valid type: " ++ unpack t
+  parseJSON _ = fail "not a string"
+
+instance Lift SchemaType where
+  lift StringType  = [| StringType |]
+  lift NumberType  = [| NumberType |]
+  lift IntegerType = [| IntegerType |]
+  lift BooleanType = [| BooleanType |]
+  lift ObjectType  = [| ObjectType |]
+  lift ArrayType   = [| ArrayType |]
+  lift NullType    = [| NullType |]
+  lift AnyType     = [| AnyType |]
+
+-- | JSON Schema (Draft 3) Core Schema Definition
+data Schema ref = Schema
+  { schemaType                 :: [Choice2 SchemaType (Schema ref)]          -- ^ List of allowed schema types
+  , schemaProperties           :: HashMap Text (Schema ref)                  -- ^ Subschemas for properties
+  , schemaPatternProperties    :: [(Pattern, Schema ref)]                    -- ^ All properties that match one of the regexes must validate against the associated schema
+  , schemaAdditionalProperties :: Choice2 Bool (Schema ref)                  -- ^ Whether additional properties are allowed when the instance is an object, and if so, a schema that they have to validate against
+  , schemaItems                :: Maybe (Choice2 (Schema ref) [Schema ref])  -- ^ Either a schema for all array items or a different schema for each position in the array
+  , schemaAdditionalItems      :: Choice2 Bool (Schema ref)                  -- ^ Whether additional items are allowed
+  , schemaRequired             :: Bool                                       -- ^ When this schema is used in a property of another schema, this means that the property must have a value and not be undefined
+  , schemaDependencies         :: HashMap Text (Choice2 [Text] (Schema ref)) -- ^ Map of dependencies (property a requires properties b and c, property a requires the instance to validate against another schema, etc.)
+  , schemaMinimum              :: Maybe Number                               -- ^ Minimum value when the instance is a number
+  , schemaMaximum              :: Maybe Number                               -- ^ Maximum value when the instance is a number
+  , schemaExclusiveMinimum     :: Bool                                       -- ^ Whether the minimum value is exclusive (only numbers greater than the minimum are allowed)
+  , schemaExclusiveMaximum     :: Bool                                       -- ^ Whether the maximum value is exclusive (only numbers less than the maximum are allowed)
+  , schemaMinItems             :: Int                                        -- ^ Minimum length for arrays
+  , schemaMaxItems             :: Maybe Int                                  -- ^ Maximum length for arrays
+  , schemaUniqueItems          :: Bool                                       -- ^ Whether all array items must be distinct from each other
+  , schemaPattern              :: Maybe Pattern                              -- ^ Regex for validating strings
+  , schemaMinLength            :: Int                                        -- ^ Minimum length for strings
+  , schemaMaxLength            :: Maybe Int                                  -- ^ Maximum length for strings
+  , schemaEnum                 :: Maybe [Value]                              -- ^ Allowed values for this schema
+  , schemaEnumDescriptions     :: Maybe [Text]                               -- ^ Extension by Google: description for the values in schemaEnum
+  , schemaDefault              :: Maybe Value                                -- ^ Default value if this schema is used in a property of another schema and the value is undefined
+  , schemaTitle                :: Maybe Text                                 -- ^ Short description of the instance property
+  , schemaDescription          :: Maybe Text                                 -- ^ Full description of the purpose of the instance property
+  , schemaFormat               :: Maybe Text                                 -- ^ Format of strings, e.g. 'data-time', 'regex' or 'email'
+  , schemaDivisibleBy          :: Maybe Number                               -- ^ When the instance is a number, it must be divisible by this number with no remainder
+  , schemaDisallow             :: [Choice2 SchemaType (Schema ref)]          -- ^ List of disallowed types
+  , schemaExtends              :: [Schema ref]                               -- ^ Base schema that the current schema inherits from
+  , schemaId                   :: Maybe Text                                 -- ^ Identifier of the current schema
+  , schemaDRef                 :: Maybe ref                                  -- ^ $ref: reference to another schema
+  , schemaDSchema              :: Maybe Text                                 -- ^ $schema: URI of a schema that defines the format of the current schema
+  } deriving (Eq, Show)
+
+-- | Set of potentially mutually recursive schemas
+type Graph f ref = M.Map ref (f ref)
+
+instance Functor Schema where
+  fmap f s = s
+    { schemaType = mapChoice2 id (fmap f) <$> schemaType s
+    , schemaProperties = fmap f <$> schemaProperties s
+    , schemaPatternProperties = second (fmap f) <$> schemaPatternProperties s
+    , schemaAdditionalProperties = mapChoice2 id (fmap f) (schemaAdditionalProperties s)
+    , schemaItems = mapChoice2 (fmap f) (fmap $ fmap f) <$> schemaItems s
+    , schemaAdditionalItems = mapChoice2 id (fmap f) (schemaAdditionalItems s)
+    , schemaDependencies = mapChoice2 id (fmap f) <$> schemaDependencies s
+    , schemaDisallow = mapChoice2 id (fmap f) <$> schemaDisallow s
+    , schemaExtends = fmap f <$> schemaExtends s
+    , schemaDRef = f <$> schemaDRef s
+    }
+
+instance Foldable Schema where
+  foldr f start s = ffoldr (ffoldr f) (choice2of2s $ schemaType s)
+                  . ffoldr (ffoldr f) (schemaProperties s)
+                  . ffoldr (ffoldr f) (map snd $ schemaPatternProperties s)
+                  . foldChoice2of2 (ffoldr f) (schemaAdditionalProperties s)
+                  . ffoldr (\items -> foldChoice1of2 (ffoldr f) items . foldChoice2of2 (ffoldr $ ffoldr f) items) (schemaItems s)
+                  . foldChoice2of2 (ffoldr f) (schemaAdditionalItems s)
+                  . ffoldr (ffoldr f) (choice2of2s $ toList $ schemaDependencies s)
+                  . ffoldr (ffoldr f) (choice2of2s $ schemaDisallow s)
+                  . ffoldr (ffoldr f) (schemaExtends s)
+                  . ffoldr f (schemaDRef s)
+                  $ start
+    where
+      ffoldr :: (Foldable t) => (a -> b -> b) -> t a -> b -> b
+      ffoldr g = flip $ foldr g
+      foldChoice1of2 :: (a -> b -> b) -> Choice2 a x -> b -> b
+      foldChoice1of2 g (Choice1of2 c) = g c
+      foldChoice1of2 _ _ = id
+      foldChoice2of2 :: (a -> b -> b) -> Choice2 x a -> b -> b
+      foldChoice2of2 g (Choice2of2 c) = g c
+      foldChoice2of2 _ _ = id
+
+instance FromJSON ref => FromJSON (Schema ref) where
+  parseJSON (Object o) = Schema
+    <$> (parseSingleOrArray =<< parseFieldDefault "type" "any")
+    <*> parseFieldDefault "properties" emptyObject
+    <*> (parseFieldDefault "patternProperties" emptyObject >>= mapM (\(k, v) -> fmap (,v) (mkPattern k)) . H.toList)
+    <*> (parseField "additionalProperties" .!= Choice1of2 True)
+    <*> parseField "items"
+    <*> (parseField "additionalItems" .!= Choice1of2 True)
+    <*> parseFieldDefault "required" (Bool False)
+    <*> (traverse parseDependency =<< parseFieldDefault "dependencies" emptyObject)
+    <*> parseField "minimum"
+    <*> parseField "maximum"
+    <*> parseFieldDefault "exclusiveMinimum" (Bool False)
+    <*> parseFieldDefault "exclusiveMaximum" (Bool False)
+    <*> parseFieldDefault "minItems" (Number 0)
+    <*> parseField "maxItems"
+    <*> parseFieldDefault "uniqueItems" (Bool False)
+    <*> parseField "pattern"
+    <*> parseFieldDefault "minLength" (Number 0)
+    <*> parseField "maxLength"
+    <*> parseField "enum"
+    <*> parseField "enumDescriptions"
+    <*> parseField "default"
+    <*> parseField "title"
+    <*> parseField "description"
+    <*> parseField "format"
+    <*> parseField "divisibleBy"
+    <*> (parseSingleOrArray =<< parseFieldDefault "disallow" emptyArray)
+    <*> ((maybe (return Nothing) (fmap Just . parseSingleOrArray) =<< parseField "extends") .!= [])
+    <*> parseField "id"
+    <*> parseField "$ref"
+    <*> parseField "$schema"
+    where
+      parseField :: (FromJSON a) => Text -> Parser (Maybe a)
+      parseField name = o .:? name
+
+      parseFieldDefault :: (FromJSON a) => Text -> Value -> Parser a
+      parseFieldDefault name value = parseJSON =<< parseField name .!= value
+
+      singleOrArray :: (Value -> Parser a) -> Value -> Parser [a]
+      singleOrArray p (Array a) = mapM p (V.toList a)
+      singleOrArray p v = (:[]) <$> p v
+
+      parseSingleOrArray :: (FromJSON a) => Value -> Parser [a]
+      parseSingleOrArray = singleOrArray parseJSON
+
+      parseDependency :: FromJSON ref => Value -> Parser (Choice2 [Text] (Schema ref))
+      parseDependency (String s) = return $ Choice1of2 [s]
+      parseDependency val = parseJSON val
+  parseJSON _ = fail "a schema must be a JSON object"
+
+instance (Eq ref, Lift ref) => Lift (Schema ref) where
+  lift schema = case updates of
+    [] -> varE 'empty
+    _  -> recUpdE (varE 'empty) updates
+    where
+      updates = catMaybes
+        [ field 'schemaType schemaType
+        , field 'schemaProperties schemaProperties
+        , field 'schemaPatternProperties schemaPatternProperties
+        , field 'schemaAdditionalProperties schemaAdditionalProperties
+        , field 'schemaItems schemaItems
+        , field 'schemaAdditionalItems schemaAdditionalItems
+        , field 'schemaRequired schemaRequired
+        , field 'schemaDependencies schemaDependencies
+        , field 'schemaMinimum schemaMinimum
+        , field 'schemaMaximum schemaMaximum
+        , field 'schemaExclusiveMinimum schemaExclusiveMinimum
+        , field 'schemaExclusiveMaximum schemaExclusiveMaximum
+        , field 'schemaMinItems schemaMinItems
+        , field 'schemaMaxItems schemaMaxItems
+        , field 'schemaUniqueItems schemaUniqueItems
+        , field 'schemaPattern schemaPattern
+        , field 'schemaMinLength schemaMinLength
+        , field 'schemaMaxLength schemaMaxLength
+        , field 'schemaEnum schemaEnum
+        , field 'schemaEnumDescriptions schemaEnumDescriptions
+        , field 'schemaDefault schemaDefault
+        , field 'schemaTitle schemaTitle
+        , field 'schemaDescription schemaDescription
+        , field 'schemaFormat schemaFormat
+        , field 'schemaDivisibleBy schemaDivisibleBy
+        , field 'schemaDisallow schemaDisallow
+        , field 'schemaExtends schemaExtends
+        , field 'schemaId schemaId
+        , fmap ('schemaDRef,) . lift . Just <$> schemaDRef schema
+        , field 'schemaDSchema schemaDSchema
+        ]
+      field name accessor = if accessor schema == accessor empty
+        then Nothing
+        else Just $ (name,) <$> lift (accessor schema)
+
+-- | The empty schema accepts any JSON value.
+empty :: Schema ref
+empty = Schema
+  { schemaType = [Choice1of2 AnyType]
+  , schemaProperties = H.empty
+  , schemaPatternProperties = []
+  , schemaAdditionalProperties = Choice1of2 True
+  , schemaItems = Nothing
+  , schemaAdditionalItems = Choice1of2 True
+  , schemaRequired = False
+  , schemaDependencies = H.empty
+  , schemaMinimum = Nothing
+  , schemaMaximum = Nothing
+  , schemaExclusiveMinimum = False
+  , schemaExclusiveMaximum = False
+  , schemaMinItems = 0
+  , schemaMaxItems = Nothing
+  , schemaUniqueItems = False
+  , schemaPattern = Nothing
+  , schemaMinLength = 0
+  , schemaMaxLength = Nothing
+  , schemaEnum = Nothing
+  , schemaEnumDescriptions = Nothing
+  , schemaDefault = Nothing
+  , schemaTitle = Nothing
+  , schemaDescription = Nothing
+  , schemaFormat = Nothing
+  , schemaDivisibleBy = Nothing
+  , schemaDisallow = []
+  , schemaExtends = []
+  , schemaId = Nothing
+  , schemaDRef = Nothing
+  , schemaDSchema = Nothing
+  }
+
+-- | QuasiQuoter for schemas in JSON (e.g. @[schemaQQ| { \"type\": \"number\", \"minimum\": 0 } |]@)
+schemaQQ :: QuasiQuoter
+schemaQQ = QuasiQuoter { quoteExp = quote }
+  where
+    quote jsonStr = case parse (skipSpace *> value' <* skipSpace) (pack jsonStr) of
+      Done _ json -> case parseEither parseJSON json :: Either String (Schema Text) of
+        Left e -> fail e
+        Right s -> lift s
+      _ -> fail "not a valid JSON value"
diff --git a/src/Data/Aeson/Schema/Validator.hs b/src/Data/Aeson/Schema/Validator.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Schema/Validator.hs
@@ -0,0 +1,181 @@
+{-# LANGUAGE RankNTypes #-}
+
+module Data.Aeson.Schema.Validator
+  ( ValidationError
+  , validate
+  ) where
+
+import           Data.Aeson                (Value (..))
+import qualified Data.Aeson                as A
+import           Data.Attoparsec.Number    (Number (..))
+import qualified Data.HashMap.Strict       as H
+import qualified Data.List                 as L
+import qualified Data.Map                  as M
+import           Data.Maybe                (isNothing)
+import           Data.Text                 (Text, length, unpack)
+import qualified Data.Vector               as V
+import           Prelude                   hiding (foldr, length)
+import           Text.Regex.PCRE           (match)
+
+import           Data.Aeson.Schema.Types
+import           Data.Aeson.Schema.Choice
+import           Data.Aeson.Schema.Helpers
+
+-- | Errors encountered during validation
+type ValidationError = String
+
+validationError :: ValidationError -> [ValidationError]
+validationError e = [e]
+
+valid :: [ValidationError]
+valid = []
+
+-- | Validates a JSON value against a schema.
+validate :: Ord ref
+         => Graph Schema ref -- ^ referenced schemas
+         -> Schema ref
+         -> Value
+         -> [ValidationError]
+validate graph schema val = case schemaDRef schema of
+  Just ref -> case M.lookup ref graph of
+    Nothing -> validationError "referenced schema is not in map"
+    Just referencedSchema -> validate graph referencedSchema val
+  Nothing -> L.concat
+    [ case schemaType schema of
+        [t] -> validateType t
+        ts  -> if L.any L.null (map validateType ts) then [] else validationError "no type matched"
+    , maybeCheck checkEnum $ schemaEnum schema
+    , concatMap validateTypeDisallowed (schemaDisallow schema)
+    , concatMap (flip (validate graph) val) (schemaExtends schema)
+    ]
+  where
+    validateType (Choice1of2 t) = case (t, val) of
+      (StringType, String str) -> validateString schema str
+      (NumberType, Number num) -> validateNumber schema num
+      (IntegerType, Number num@(I _)) -> validateNumber schema num
+      (BooleanType, Bool _) -> valid
+      (ObjectType, Object obj) -> validateObject graph schema obj
+      (ArrayType, Array arr) -> validateArray graph schema arr
+      (NullType, Null) -> valid
+      (AnyType, _) -> case val of
+        String str -> validateString schema str
+        Number num -> validateNumber schema num
+        Object obj -> validateObject graph schema obj
+        Array arr  -> validateArray graph schema arr
+        _ -> valid
+      (typ, _) -> validationError $ "type mismatch: expected " ++ show typ ++ " but got " ++ getType val
+    validateType (Choice2of2 s) = validate graph s val
+
+    getType :: A.Value -> String
+    getType (String _) = "string"
+    getType (Number _) = "number"
+    getType (Bool _)   = "boolean"
+    getType (Object _) = "object"
+    getType (Array _)  = "array"
+    getType Null       = "null"
+
+    checkEnum e = assert (val `elem` e) "value has to be one of the values in enum"
+
+    isType :: Value -> SchemaType -> Bool
+    isType (String _) StringType = True
+    isType (Number (I _)) IntegerType = True
+    isType (Number _) NumberType = True
+    isType (Bool _) BooleanType = True
+    isType (Object _) ObjectType = True
+    isType (Array _) ArrayType = True
+    isType _ AnyType = True
+    isType _ _ = False
+
+    validateTypeDisallowed (Choice1of2 t) = if isType val t
+        then validationError $ "values of type " ++ show t ++ " are not allowed here"
+        else valid
+    validateTypeDisallowed (Choice2of2 s) = assert (not . L.null $ validate graph s val) "value disallowed"
+
+assert :: Bool -> String -> [ValidationError]
+assert True _ = valid
+assert False e = validationError e
+
+maybeCheck :: (a -> [ValidationError]) -> Maybe a -> [ValidationError]
+maybeCheck p (Just a) = p a
+maybeCheck _ _ = valid
+
+validateString :: Schema ref -> Text -> [ValidationError]
+validateString schema str = L.concat
+  [ checkMinLength $ schemaMinLength schema
+  , maybeCheck checkMaxLength (schemaMaxLength schema)
+  , maybeCheck checkPattern $ schemaPattern schema
+  , maybeCheck checkFormat $ schemaFormat schema
+  ]
+  where
+    checkMinLength l = assert (length str >= l) $ "length of string must be at least " ++ show l
+    checkMaxLength l = assert (length str <= l) $ "length of string must be at most " ++ show l
+    checkPattern (Pattern source compiled) = assert (match compiled $ unpack str) $ "string must match pattern " ++ show source
+    checkFormat format = maybe valid validationError $ validateFormat format str
+
+validateNumber :: Schema ref -> Number -> [ValidationError]
+validateNumber schema num = L.concat
+  [ maybeCheck (checkMinimum $ schemaExclusiveMinimum schema) $ schemaMinimum schema
+  , maybeCheck (checkMaximum $ schemaExclusiveMaximum schema) $ schemaMaximum schema
+  , maybeCheck checkDivisibleBy $ schemaDivisibleBy schema
+  ]
+  where
+    checkMinimum excl m = if excl
+      then assert (num > m)  $ "number must be greater than " ++ show m
+      else assert (num >= m) $ "number must be greater than or equal " ++ show m
+    checkMaximum excl m = if excl
+      then assert (num < m)  $ "number must be less than " ++ show m
+      else assert (num <= m) $ "number must be less than or equal " ++ show m
+    checkDivisibleBy devisor = assert (num `isDivisibleBy` devisor) $ "number must be devisible by " ++ show devisor
+
+validateObject :: Ord ref => Graph Schema ref -> Schema ref -> A.Object -> [ValidationError]
+validateObject graph schema obj =
+  concatMap (uncurry checkKeyValue) (H.toList obj) ++
+  concatMap checkRequiredProperty requiredProperties
+  where
+    checkKeyValue k v = L.concat
+      [ maybeCheck (flip (validate graph) v) property
+      , concatMap (flip (validate graph) v . snd) matchingPatternsProperties
+      , if isNothing property && L.null matchingPatternsProperties
+        then checkAdditionalProperties (schemaAdditionalProperties schema)
+        else valid
+      , maybeCheck checkDependencies $ H.lookup k (schemaDependencies schema)
+      ]
+      where
+        property = H.lookup k (schemaProperties schema)
+        matchingPatternsProperties = filter (flip match (unpack k) . patternCompiled . fst) $ schemaPatternProperties schema
+        checkAdditionalProperties ap = case ap of
+          Choice1of2 b -> assert b $ "additional property " ++ unpack k ++ " is not allowed"
+          Choice2of2 s -> validate graph s v
+        checkDependencies deps = case deps of
+          Choice1of2 props -> L.concat $ flip map props $ \prop -> case H.lookup prop obj of
+            Nothing -> validationError $ "property " ++ unpack k ++ " depends on property " ++ show prop
+            Just _ -> valid
+          Choice2of2 depSchema -> validate graph depSchema (Object obj)
+    requiredProperties = map fst . filter (schemaRequired . snd) . H.toList $ schemaProperties schema
+    checkRequiredProperty key = case H.lookup key obj of
+      Nothing -> validationError $ "required property " ++ unpack key ++ " is missing"
+      Just _ -> valid
+
+validateArray :: Ord ref => Graph Schema ref -> Schema ref -> A.Array -> [ValidationError]
+validateArray graph schema arr = L.concat
+  [ checkMinItems $ schemaMinItems schema
+  , maybeCheck checkMaxItems $ schemaMaxItems schema
+  , if schemaUniqueItems schema then checkUnique else valid
+  , maybeCheck checkItems $ schemaItems schema
+  ]
+  where
+    len = V.length arr
+    list = V.toList arr
+    checkMinItems m = assert (len >= m) $ "array must have at least " ++ show m ++ " items"
+    checkMaxItems m = assert (len <= m) $ "array must have at most " ++ show m ++ " items"
+    checkUnique = assert (vectorUnique arr) "all array items must be unique"
+    checkItems items = case items of
+      Choice1of2 s -> assert (V.all (L.null . validate graph s) arr) "all items in the array must validate against the schema given in 'items'"
+      Choice2of2 ss ->
+        let additionalItems = drop (L.length ss) list
+            checkAdditionalItems ai = case ai of
+              Choice1of2 b -> assert (b || L.null additionalItems) "no additional items allowed"
+              Choice2of2 additionalSchema -> concatMap (validate graph additionalSchema) additionalItems
+        in L.concat (zipWith (validate graph) ss list) ++
+           checkAdditionalItems (schemaAdditionalItems schema)
+
diff --git a/src/Data/Aeson/TH/Lift.hs b/src/Data/Aeson/TH/Lift.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/TH/Lift.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Data.Aeson.TH.Lift () where
+
+import           Data.Aeson                 (Value (..))
+import           Data.Attoparsec.Number     (Number (..))
+import qualified Data.HashMap.Lazy          as HM
+import           Data.Text                  (Text, pack, unpack)
+import qualified Data.Vector                as V
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax (Lift (..))
+
+instance Lift Text where
+  lift txt = [| pack $(lift (unpack txt)) |]
+
+instance Lift Double where
+  lift d = [| fromRational $(litE . rationalL . toRational $ d) :: Double |]
+
+instance Lift Number where
+  lift (I i) = [| I i |]
+  lift (D d) = [| D d |]
+
+instance (Lift k, Lift v) => Lift (HM.HashMap k v) where
+  lift hm = [| HM.fromList $(lift (HM.toList hm)) |]
+
+instance (Lift a) => Lift (V.Vector a) where
+  lift vec = [| V.fromList $(lift (V.toList vec)) |]
+
+instance Lift Value where
+  lift (Object o) = [| Object o |]
+  lift (Array a)  = [| Array a |]
+  lift (String t) = [| String t |]
+  lift (Number n) = [| Number n |]
+  lift (Bool b)   = [| Bool b |]
+  lift Null       = [| Null |]
diff --git a/test/TestSuite.hs b/test/TestSuite.hs
new file mode 100644
--- /dev/null
+++ b/test/TestSuite.hs
@@ -0,0 +1,14 @@
+import           Test.Framework
+
+import qualified Data.Aeson.Schema.Choice.Tests
+import qualified Data.Aeson.Schema.CodeGen.Tests
+import qualified Data.Aeson.Schema.Types.Tests
+import qualified Data.Aeson.Schema.Validator.Tests
+
+main :: IO ()
+main = defaultMain
+  [ testGroup "Data.Aeson.Schema.Types" Data.Aeson.Schema.Types.Tests.tests
+  , testGroup "Data.Aeson.Schema.Validator" Data.Aeson.Schema.Validator.Tests.tests
+  , buildTest $ fmap (testGroup "Data.Aeson.Schema.CodeGen") Data.Aeson.Schema.CodeGen.Tests.tests
+  , testGroup "Data.Aeson.Schema.Choice" Data.Aeson.Schema.Choice.Tests.tests
+  ]