diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2013-2014, Iris Connect
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Iris Connect nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
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/api-tools.cabal b/api-tools.cabal
new file mode 100644
--- /dev/null
+++ b/api-tools.cabal
@@ -0,0 +1,173 @@
+Name:                api-tools
+Version:             0.2
+Synopsis:            DSL for generating API boilerplate and docs
+Description:         api-tools provides a compact DSL for describing an API.
+                     It uses Template Haskell to generate the
+                     corresponding data types and assorted tools for
+                     working with it, including Aeson and QuickCheck
+                     instances for converting between JSON and the
+                     generated types and writing unit tests.
+Homepage:            http://github.com/iconnect/api-tools
+License:             BSD3
+License-file:        LICENSE
+Author:              Chris Dornan <chrisd@irisconnect.co.uk> and Adam Gundry <adam@well-typed.com>
+Maintainer:          Chris Dornan <chrisd@irisconnect.co.uk>
+Copyright:           (c) Iris Connect 2013-2014
+Category:            Network, Web, Cloud, Distributed Computing
+Build-type:          Simple
+
+Cabal-version:       >=1.10
+
+Library
+  Hs-Source-Dirs:    src
+
+  Exposed-modules:
+        Data.API.API
+        Data.API.API.Gen
+        Data.API.Changes
+        Data.API.Doc
+        Data.API.Doc.Subst
+        Data.API.JSON
+        Data.API.Markdown
+        Data.API.Parse
+        Data.API.PP
+        Data.API.Tools
+        Data.API.Tools.Combinators
+        Data.API.Tools.Datatypes
+        Data.API.Tools.Enum
+        Data.API.Tools.Example
+        Data.API.Tools.JSON
+        Data.API.Tools.JSONTests
+        Data.API.Tools.Lens
+        Data.API.Tools.QuickCheck
+        Data.API.Tools.SafeCopy
+        Data.API.Tutorial
+        Data.API.Types
+        Data.API.Utils
+
+  Other-modules:
+        Data.API.API.DSL
+        Data.API.Doc.Call
+        Data.API.Doc.Dir
+        Data.API.Doc.Types
+        Data.API.Scan
+        Data.API.TH
+
+  Build-depends:
+        Cabal                >= 1.9.2       ,
+        QuickCheck           >= 2.5.1,
+        aeson                >= 0.6.2 && < 0.7,
+        aeson-pretty         <= 0.7         ,
+        array                >= 0.4,
+        attoparsec           >= 0.10.4,
+        base                 == 4.*,
+        base64-bytestring    == 1.0.*,
+        bytestring           >= 0.9     && < 0.11,
+        case-insensitive     >= 1.0,
+        containers           >= 0.5,
+        lens                 >= 3.8.7,
+        old-locale           >= 1.0.0.4,
+        regex-compat-tdfa    >= 0.95.1,
+        safe                 >= 0.3.3,
+        safecopy             >= 0.8.1,
+        time                 >= 1.4,
+        template-haskell     >= 2.7,
+        text                 >= 0.11,
+        unordered-containers >= 0.2.3.0     ,
+        vector               >= 0.10.0.1
+
+  Build-tools:
+        alex,
+        happy
+
+  GHC-Options:
+        -Wall
+        -fwarn-tabs
+
+  Default-Language: Haskell2010
+
+
+Executable migration-tool
+  Hs-Source-Dirs:    main
+
+  Main-is:    Data/API/MigrationTool.hs
+
+  Build-depends:
+        api-tools            == 0.2,
+        Cabal                >= 1.9.2       ,
+        QuickCheck           >= 2.5.1,
+        aeson                >= 0.6.2 && < 0.7,
+        aeson-pretty         <= 0.7         ,
+        array                >= 0.4,
+        attoparsec           >= 0.10.4,
+        base                 == 4.*,
+        base64-bytestring    == 1.0.*,
+        bytestring           >= 0.9     && < 0.11,
+        case-insensitive     >= 1.0,
+        containers           >= 0.5,
+        lens                 >= 3.8.7,
+        old-locale           >= 1.0.0.4,
+        regex-compat-tdfa    >= 0.95.1,
+        safe                 >= 0.3.3,
+        safecopy             >= 0.8.1,
+        time                 >= 1.4,
+        template-haskell     >= 2.7,
+        text                 >= 0.11,
+        unordered-containers >= 0.2.3.0     ,
+        vector               >= 0.10.0.1
+
+  GHC-Options:
+        -main-is Data.API.MigrationTool
+        -Wall
+        -fwarn-tabs
+
+  Default-Language: Haskell2010
+
+
+Test-Suite test-api-tools
+  Hs-Source-Dirs:    tests
+
+  Type:       exitcode-stdio-1.0
+
+  Main-is:    Data/API/Test/Main.hs
+
+  Other-modules:
+        Data.API.Test.DSL
+        Data.API.Test.Gen
+        Data.API.Test.JSON
+        Data.API.Test.Migration
+        Data.API.Test.MigrationData
+
+  Build-depends:
+        api-tools            == 0.2,
+        Cabal                >= 1.9.2       ,
+        QuickCheck           >= 2.5.1,
+        aeson                >= 0.6.2 && < 0.7,
+        aeson-pretty         <= 0.7         ,
+        array                >= 0.4,
+        attoparsec           >= 0.10.4,
+        base                 == 4.*,
+        base64-bytestring    == 1.0.*,
+        bytestring           >= 0.9     && < 0.11,
+        case-insensitive     >= 1.0,
+        containers           >= 0.5,
+        lens                 >= 3.8.7,
+        old-locale           >= 1.0.0.4,
+        regex-compat-tdfa    >= 0.95.1,
+        safe                 >= 0.3.3,
+        safecopy             >= 0.8.1,
+        tasty                >= 0.3         ,
+        tasty-hunit          >= 0.2         ,
+        tasty-quickcheck     >= 0.3         ,
+        time                 >= 1.4,
+        template-haskell     >= 2.7,
+        text                 >= 0.11,
+        unordered-containers >= 0.2.3.0     ,
+        vector               >= 0.10.0.1
+
+  GHC-Options:
+        -main-is Data.API.Test.Main
+        -Wall
+        -fwarn-tabs
+
+  Default-Language: Haskell2010
diff --git a/main/Data/API/MigrationTool.hs b/main/Data/API/MigrationTool.hs
new file mode 100644
--- /dev/null
+++ b/main/Data/API/MigrationTool.hs
@@ -0,0 +1,98 @@
+module Data.API.MigrationTool
+    ( main
+    ) where
+
+import           Data.API.Changes
+import           Data.API.JSON
+import           Data.API.Parse
+import           Data.API.Types
+
+import qualified Data.Aeson as JS
+import qualified Data.Aeson.Encode.Pretty as JS
+import qualified Data.ByteString.Lazy as BS
+import           System.Environment
+import           System.Exit
+import           System.IO
+
+
+----------------------------
+-- Main, prototype testing
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+      ["migrate", startApiFile, endApiFile, inDataFile, outDataFile] ->
+       migrate startApiFile endApiFile inDataFile outDataFile
+
+      ["compare", file1, file2] ->
+       compareJSON file1 file2
+
+      ["reformat", file1, file2] ->
+       reformatJSON file1 file2
+
+      ["parse", file] ->
+       parse file
+
+      _ -> do putStrLn "Usage: migration-tool migrate  start.api end.api start.json end.json"
+              putStrLn "       migration-tool compare  file1.json file2.json"
+              putStrLn "       migration-tool reformat input.json output.json"
+              putStrLn "       migration-tool parse    schema.api"
+              return ()
+
+migrate :: FilePath -> FilePath -> FilePath -> FilePath -> IO ()
+migrate startApiFile endApiFile
+        inDataFile outDataFile = do
+
+    (startApi, startChangelog) <- readApiFile startApiFile
+    (endApi, endChangelog)     <- readApiFile endApiFile
+    inData                     <- readJsonFile inDataFile
+    let Release startApiVer = changelogVersion startChangelog
+    case migrateDataDump (startApi, startApiVer) (endApi, DevVersion)
+                         endChangelog customMigrations root CheckAll inData of
+      Left err                  -> do
+        hPutStrLn stderr (prettyMigrateFailure err)
+        exitFailure
+      Right (outData, warnings) -> do
+        putStrLn . unlines . map show $ warnings
+        writeJsonFile outDataFile outData
+
+root :: TypeName
+root = TypeName "DatabaseSnapshot"
+
+readJsonFile :: FromJSONWithErrs b => FilePath -> IO b
+readJsonFile  file = either (fail . prettyJSONErrorPositions) return
+                   . decodeWithErrs =<< BS.readFile file
+
+writeJsonFile :: JS.ToJSON a => FilePath -> a -> IO ()
+writeJsonFile file = BS.writeFile file . JS.encodePretty
+
+readApiFile :: FilePath -> IO APIWithChangelog
+readApiFile file = fmap parseAPIWithChangelog (readFile file)
+
+data ChangeTag = None
+    deriving (Read, Show)
+
+customMigrations :: CustomMigrations ChangeTag ChangeTag ChangeTag
+customMigrations = CustomMigrations nope (\ _ _ -> Nothing)
+                                    nope (\ _ _ -> Nothing)
+                                    nofld
+  where
+    nope  _ v = Left (CustomMigrationError "No custom migrations defined" (JS.Object v))
+    nofld _ v = Left (CustomMigrationError "No field custom migrations defined" v)
+
+compareJSON :: FilePath -> FilePath -> IO ()
+compareJSON file1 file2 = do
+  js1 <- readJsonFile file1
+  js2 <- readJsonFile file2
+  print (js1 == (js2 :: JS.Value))
+
+reformatJSON :: FilePath -> FilePath -> IO ()
+reformatJSON file1 file2 = do
+  js <- readJsonFile file1
+  writeJsonFile file2 (js :: JS.Value)
+
+parse :: FilePath -> IO ()
+parse file = do
+  s <- readFile file
+  print (parseAPIWithChangelog s)
diff --git a/src/Data/API/API.hs b/src/Data/API/API.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/API.hs
@@ -0,0 +1,219 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | This module converts an API specified with the DSL into a
+-- JSON-encoded object so that it can be used in clients.
+module Data.API.API
+    ( apiAPI
+    , extractAPI
+    ) where
+
+import           Data.API.API.DSL
+import qualified Data.API.API.Gen               as D
+import           Data.API.Types
+import           Data.API.JSON
+
+import           Data.Aeson
+import qualified Data.CaseInsensitive           as CI
+import qualified Data.Text                      as T
+import           Control.Applicative
+import           Text.Regex
+
+
+-- | Take an API spec and generate a JSON description of the API
+
+extractAPI :: API -> Value
+extractAPI api = toJSON $ map convert [ an | ThNode an <- api ]
+
+convert :: APINode -> D.APINode
+convert (APINode{..}) =
+    D.APINode
+        { D._an_name    = T.pack $ _TypeName      anName
+        , D._an_comment = T.pack                  anComment
+        , D._an_prefix  = T.pack $ CI.original    anPrefix
+        , D._an_spec    = convert_spec            anSpec
+        , D._an_convert = fmap convert_conversion anConvert
+        }
+
+convert_spec :: Spec -> D.Spec
+convert_spec sp =
+    case sp of
+      SpNewtype sn -> D.SP_newtype $ convert_specnt            sn
+      SpRecord  sr -> D.SP_record  $ convert_fields $ srFields sr
+      SpUnion   su -> D.SP_union   $ convert_union  $ suFields su
+      SpEnum    se -> D.SP_enum    $ convert_alts   $ seAlts   se
+      SpSynonym ty -> D.SP_synonym $ convert_type              ty
+
+convert_conversion :: (FieldName,FieldName) -> D.Conversion
+convert_conversion (i,p) =
+    D.Conversion
+        { D._cv_injection  = T.pack $ _FieldName p
+        , D._cv_projection = T.pack $ _FieldName i
+        }
+
+convert_specnt :: SpecNewtype -> D.SpecNewtype
+convert_specnt sn =
+    D.SpecNewtype
+        { D._sn_type   = convert_basic   $  snType   sn
+        , D._sn_filter = convert_filter <$> snFilter sn
+        }
+
+convert_filter :: Filter -> D.Filter
+convert_filter ftr =
+    case ftr of
+      FtrStrg RegEx{..}    -> D.FT_string  $ D.RegularExpression re_text
+      FtrIntg IntRange{..} -> D.FT_integer $ D.IntRange  ir_lo ir_hi
+      FtrUTC  UTCRange{..} -> D.FT_utc     $ D.UTCRange  ur_lo ur_hi
+
+convert_fields :: [(FieldName, FieldType)] -> [D.Field]
+convert_fields al = map f al
+  where
+    f (fn,fty) =
+        D.Field
+            { D._fd_name     = T.pack $ _FieldName fn
+            , D._fd_type     = convert_type $ ftType fty
+            , D._fd_readonly = ftReadOnly fty
+            , D._fd_default  = convert_default <$> ftDefault fty
+            , D._fd_comment  = T.pack $ ftComment fty
+            }
+
+convert_union :: [(FieldName, (APIType, MDComment))] -> [D.Field]
+convert_union al = map f al
+  where
+    f (fn,(ty,co)) =
+        D.Field
+            { D._fd_name     = T.pack $ _FieldName fn
+            , D._fd_type     = convert_type ty
+            , D._fd_readonly = False
+            , D._fd_default  = Nothing
+            , D._fd_comment  = T.pack co
+            }
+
+convert_alts :: [(FieldName,MDComment)] -> [T.Text]
+convert_alts fns = map (T.pack . _FieldName . fst) fns
+
+convert_type :: APIType -> D.APIType
+convert_type ty0 =
+    case ty0 of
+      TyList  ty    -> D.TY_list  $ convert_type     ty
+      TyMaybe ty    -> D.TY_maybe $ convert_type     ty
+      TyName  tn    -> D.TY_ref   $ convert_ref      tn
+      TyBasic bt    -> D.TY_basic $ convert_basic    bt
+      TyJSON        -> D.TY_json    0
+
+convert_ref :: TypeName -> D.TypeRef
+convert_ref (TypeName tn) = D.TypeRef (T.pack tn)
+
+convert_basic :: BasicType -> D.BasicType
+convert_basic bt =
+    case bt of
+      BTstring -> D.BT_string
+      BTbinary -> D.BT_binary
+      BTbool   -> D.BT_boolean
+      BTint    -> D.BT_integer
+      BTutc    -> D.BT_utc
+
+convert_default :: DefaultValue -> D.DefaultValue
+convert_default DefValList       = D.DV_list    0
+convert_default DefValMaybe      = D.DV_maybe   0
+convert_default (DefValString s) = D.DV_string  s
+convert_default (DefValBool   b) = D.DV_boolean b
+convert_default (DefValInt    i) = D.DV_integer i
+convert_default (DefValUtc    u) = D.DV_utc     u
+
+
+
+-- | Generate an API spec from the JSON
+
+instance FromJSONWithErrs Thing where
+    parseJSONWithErrs v = (ThNode . unconvert) <$> parseJSONWithErrs v
+
+unconvert :: D.APINode -> APINode
+unconvert (D.APINode{..}) =
+    APINode
+        { anName    = TypeName $ T.unpack       _an_name
+        , anComment = T.unpack                  _an_comment
+        , anPrefix  = CI.mk $ T.unpack          _an_prefix
+        , anSpec    = unconvert_spec            _an_spec
+        , anConvert = fmap unconvert_conversion _an_convert
+        }
+
+unconvert_spec :: D.Spec -> Spec
+unconvert_spec sp =
+    case sp of
+      D.SP_newtype sn -> SpNewtype $ unconvert_specnt sn
+      D.SP_record  sr -> SpRecord  $ SpecRecord $ unconvert_fields sr
+      D.SP_union   su -> SpUnion   $ SpecUnion  $ unconvert_union su
+      D.SP_enum    se -> SpEnum    $ SpecEnum   $ unconvert_alts   se
+      D.SP_synonym ty -> SpSynonym $ unconvert_type   ty
+
+unconvert_conversion :: D.Conversion -> (FieldName, FieldName)
+unconvert_conversion c =
+    ( FieldName $ T.unpack $ D._cv_injection  c
+    , FieldName $ T.unpack $ D._cv_projection c
+    )
+
+unconvert_specnt :: D.SpecNewtype -> SpecNewtype
+unconvert_specnt sn =
+    SpecNewtype
+        { snType   = unconvert_basic $    D._sn_type   sn
+        , snFilter = unconvert_filter <$> D._sn_filter sn
+        }
+
+unconvert_filter :: D.Filter -> Filter
+unconvert_filter ftr =
+    case ftr of
+      D.FT_string (D.RegularExpression re_text) -> FtrStrg $ RegEx re_text (mkRegexWithOpts (T.unpack re_text) False True)
+      D.FT_integer (D.IntRange ir_lo ir_hi)     -> FtrIntg $ IntRange ir_lo ir_hi
+      D.FT_utc (D.UTCRange ur_lo ur_hi)         -> FtrUTC $ UTCRange ur_lo ur_hi
+
+unconvert_fields :: [D.Field] -> [(FieldName, FieldType)]
+unconvert_fields al = map f al
+  where
+    f fld = ( FieldName $ T.unpack $ D._fd_name fld
+            , FieldType { ftType     = unconvert_type $ D._fd_type fld
+                        , ftReadOnly = D._fd_readonly fld
+                        , ftDefault  = unconvert_default <$> D._fd_default fld
+                        , ftComment  = T.unpack $ D._fd_comment fld
+                        }
+            )
+
+unconvert_union :: [D.Field] -> [(FieldName, (APIType, MDComment))]
+unconvert_union al = map f al
+  where
+    f fld = ( FieldName $ T.unpack $ D._fd_name fld
+            , ( unconvert_type $ D._fd_type fld
+              , T.unpack $ D._fd_comment fld
+            ))
+
+unconvert_alts :: [T.Text] -> [(FieldName,MDComment)]
+unconvert_alts fns = map ((\x -> (x, "")) . FieldName . T.unpack) fns
+
+unconvert_type :: D.APIType -> APIType
+unconvert_type ty0 =
+    case ty0 of
+      D.TY_list  ty   -> TyList  $ unconvert_type  ty
+      D.TY_maybe ty   -> TyMaybe $ unconvert_type  ty
+      D.TY_ref   r    -> TyName  $ unconvert_ref r
+      D.TY_basic bt   -> TyBasic $ unconvert_basic bt
+      D.TY_json _     -> TyJSON
+
+unconvert_ref :: D.TypeRef -> TypeName
+unconvert_ref (D.TypeRef tn) = TypeName $ T.unpack tn
+
+unconvert_basic :: D.BasicType -> BasicType
+unconvert_basic bt =
+    case bt of
+      D.BT_string  -> BTstring
+      D.BT_binary  -> BTbinary
+      D.BT_boolean -> BTbool
+      D.BT_integer -> BTint
+      D.BT_utc     -> BTutc
+
+unconvert_default :: D.DefaultValue -> DefaultValue
+unconvert_default (D.DV_list    _) = DefValList
+unconvert_default (D.DV_maybe   _) = DefValMaybe
+unconvert_default (D.DV_string  s) = DefValString s
+unconvert_default (D.DV_boolean b) = DefValBool   b
+unconvert_default (D.DV_integer i) = DefValInt    i
+unconvert_default (D.DV_utc     u) = DefValUtc    u
diff --git a/src/Data/API/API/DSL.hs b/src/Data/API/API/DSL.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/API/DSL.hs
@@ -0,0 +1,163 @@
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE QuasiQuotes                #-}
+{-# OPTIONS_GHC -XNoCPP                 #-}
+
+module Data.API.API.DSL
+    ( apiAPI
+    ) where
+
+import           Data.API.Parse
+import           Data.API.Types
+
+
+-- | API description of the api-tools API itself
+apiAPI :: API
+apiAPI = [api|
+
+//
+// #The api-tools API
+//
+// Here we make the DSP specs available in JSON so that clients
+// working in non-Haskell frameworks can integrate API
+// specs into their own environments.
+
+ans :: APISpec
+    // an API specification consists of a list of nodes,
+    // each describing a named JSON thing which can be
+    // referenced in other (object) nodes.
+    = [APINode]
+
+an :: APINode
+    // Each node is named (with a name that conforms to Haskell's
+    // Type identifier rules, starting with a capital letter) and some
+    // comment text (like this comment). The JSON spec is all contained
+    // in the {Spec}, the other fields being used behind the scenes
+    // to manage the Haskell name space and migrations.
+    = record
+        name      :: string         // the name must start with a big letter
+                                    // and conform to Haskell rules for type
+                                    // identifiers
+        comment   :: string         // natural language description of the node
+        prefix    :: string         // (Haskell side only) this prefix used to
+                                    // structure the Haskell name space
+                                    // (which is uncomfortably flat where
+                                    // record field names are concerned);
+                                    // it has no effect on the JSON representation
+        spec      :: Spec           // here we specify the JSON representation
+        convert   :: ? Conversion   // (Haskell side only) sometimes we may
+                                    // choose to not use the default internal
+                                    // representation for the JSON
+                                    // but instead supply a couple of functions
+                                    // for injecting the default representation
+                                    // into the actual type we will use and the
+                                    // and project it back again; here we can check
+                                    // some properties (which must be explained
+                                    // in the comments) and reject a request
+                                    // with a 400 error; has no effect on the
+                                    // JSON representation
+
+sp :: Spec
+    // the JSON representation is specified as a simple 'newtype', a record
+    // type, a union type, an enumerated type or a (mere) type synonym.
+    = union
+      | newtype   :: SpecNewtype    // here we have a basic string or number type
+      | 'record'  :: [Field]        // an object representing a record
+      | 'union'   :: [Field]        // an object representing a number of alternatives
+      | 'enum'    :: [string]       // a string type which must contain a number of
+                                    // discrete values
+      | synonym   :: APIType        // is just an alias for another type
+
+sn :: SpecNewtype
+    // 'newtype' specs are a basic type and an optional filter specification
+    = record
+        type      :: BasicType
+        filter    :: ? Filter
+
+ft :: Filter
+    = union
+      | 'string'  :: RegularExpression
+      | 'integer' :: IntRange
+      | 'utc'     :: UTCRange
+
+re :: RegularExpression
+    // regular expressions are represented by simple strings
+    = basic string
+
+ir :: IntRange
+    // integer ranges are specified with their bounds and may open at
+    // the bottom and top
+    = record
+        lo :: ? integer
+        hi :: ? integer
+
+ur :: UTCRange
+    // UTC ranges are specified with their bounds and may open at
+    // the bottom and top
+    = record
+        lo :: ? utc
+        hi :: ? utc
+
+cv :: Conversion
+    // Conversions are just used on the Haskell side to map the concrete JSON
+    // representation into an internal type and back again
+    = record
+        injection :: string         // the injection function for injecting
+                                    // representations into the internal
+                                    // representation; may return a failure
+                                    // indicating that some API precondition
+                                    // was not met
+        projection:: string         // the projection function converts the
+                                    // internal type back into the JSON
+                                    // representation for communication
+                                    // back to the client
+
+fd :: Field
+    // a field represent both a field in a record object and an alternative in
+    // a union object (in which exactly one of the 'fields' is ever present in
+    // the object)
+    = record
+        name     :: string          // the name of the method
+        type     :: APIType         // the JSON type of the field
+        readonly :: boolean         // read-only status
+        default  :: ? DefaultValue  // the default value of the field
+        comment  :: string          // a comment describing the field (like
+                                    // this one)
+
+ty :: APIType
+    // this is used to represent JSON types in fields (or synonyms) and is one
+    // one of the following:
+    = union
+      | list   :: APIType           // a JSON list of the given type
+      | maybe  :: APIType           // either the given type or the null value
+      | ref    :: TypeRef           // a named type (node) with possible example
+      | 'basic':: BasicType         // a basic JSON type
+      | 'json' :: integer           // a generic JSON value
+
+tr :: TypeRef
+    // reference to a type name
+    = basic string
+
+bt :: BasicType
+    // finally we get down to the basic JSON types ('binary' is a string
+    // in which the byte string has been encoded with base-64, safe for
+    // embedding in a UTF-8-encoded JSON string
+    = enum
+        | 'string'
+        | 'binary'
+        | 'boolean'
+        | 'integer'
+        | 'utc'
+
+dv :: DefaultValue
+    // a default value
+    = union
+        | 'list'    :: integer
+        | 'maybe'   :: integer
+        | 'string'  :: string
+        | 'boolean' :: boolean
+        | 'integer' :: integer
+        | 'utc'     :: utc
+|]
+
+{-
+-}
diff --git a/src/Data/API/API/Gen.hs b/src/Data/API/API/Gen.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/API/Gen.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+
+-- | This module contains datatypes generated from the DSL description
+-- of the api-tools API; they thus correspond to the types in
+-- "Data.API.Types".
+module Data.API.API.Gen where
+
+import           Data.API.API.DSL
+import           Data.API.Tools
+
+import           Language.Haskell.TH
+
+$(generate         apiAPI)
+
+$(generateAPITools apiAPI
+                   [ enumTool
+                   , jsonTool
+                   , quickCheckTool
+                   , lensTool
+                   , safeCopyTool
+                   , exampleTool
+                   , samplesTool   (mkName "apiAPISamples")
+                   , jsonTestsTool (mkName "apiAPISimpleTests")
+                   ])
diff --git a/src/Data/API/Changes.hs b/src/Data/API/Changes.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Changes.hs
@@ -0,0 +1,1262 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+{-# LANGUAGE TemplateHaskell   #-}
+
+-- | This module deals with validating API changelogs and migrating
+-- JSON data between different versions of a schema.
+module Data.API.Changes
+    ( migrateDataDump
+
+      -- * Validating changelogs
+    , validateChanges
+    , dataMatchesAPI
+    , DataChecks(..)
+
+      -- * Changelog representation
+    , APIChangelog(..)
+    , APIWithChangelog
+    , APIChange(..)
+    , VersionExtra(..)
+    , showVersionExtra
+    , changelogStartVersion
+    , changelogVersion
+
+      -- * Custom migrations
+    , CustomMigrations(..)
+    , generateMigrationKinds
+    , MigrationTag
+
+      -- * API normal forms
+    , NormAPI
+    , NormTypeDecl(..)
+    , NormRecordType
+    , NormUnionType
+    , NormEnumType
+    , apiNormalForm
+    , declNF
+
+      -- * Migration errors
+    , MigrateFailure(..)
+    , MigrateWarning
+    , ValidateFailure(..)
+    , ValidateWarning
+    , ApplyFailure(..)
+    , TypeKind(..)
+    , MergeResult(..)
+    , ValueError(..)
+    , prettyMigrateFailure
+    , prettyValidateFailure
+    , prettyValueError
+    , prettyValueErrorPosition
+    ) where
+
+import           Data.API.JSON
+import           Data.API.PP
+import           Data.API.Types
+import           Data.API.Utils
+
+import           Control.Applicative
+import           Control.Monad
+import qualified Data.Aeson as JS
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Base64 as B64
+import           Data.Map (Map)
+import qualified Data.Map as Map
+import           Data.Maybe
+import           Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.HashMap.Strict as HMap
+import qualified Data.Vector as V
+import qualified Data.Text as T
+import           Data.Version
+import           Data.Time
+import           Data.List
+import           Language.Haskell.TH
+import           Safe
+
+
+-------------------------
+-- Top level: do it all
+--
+
+-- | Migrate a dataset from one version of an API schema to another.
+-- The data must be described by a named type, the name of which is
+-- assumed not to change.
+--
+-- The @db@, @rec@ and @fld@ types must be enumerations of all the
+-- custom migration tags in the changelog, as generated by
+-- 'generateMigrationKind'.
+
+migrateDataDump :: (Read db, Read rec, Read fld)
+                => (API, Version)               -- ^ Starting schema and version
+                -> (API, VersionExtra)          -- ^ Ending schema and version
+                -> APIChangelog                 -- ^ Log of changes, containing both versions
+                -> CustomMigrations db rec fld  -- ^ Custom migration functions
+                -> TypeName                     -- ^ Name of the dataset's type
+                -> DataChecks                   -- ^ How thoroughly to validate changes
+                -> JS.Value                     -- ^ Dataset to be migrated
+                -> Either MigrateFailure (JS.Value, [MigrateWarning])
+migrateDataDump startApi endApi changelog custom root chks db = do
+    let custom' = readCustomMigrations custom
+    (changes, warnings) <- validateChanges' startApi endApi changelog custom' root chks
+                                                           ?!? ValidateFailure
+    db' <- applyChangesToDatabase root custom' db changes  ?!? uncurry ValueError
+    return (db', warnings)
+
+data MigrateFailure
+    = ValidateFailure ValidateFailure
+    | ValueError ValueError Position
+    deriving (Eq, Show)
+
+type MigrateWarning = ValidateWarning
+
+------------------
+-- The key types
+--
+
+type APIWithChangelog = (API, APIChangelog)
+
+-- | An API changelog, consisting of a list of versions with the
+-- changes from one version to the next.  The versions must be in
+-- descending order (according to the 'Ord' 'Version' instance).
+data APIChangelog =
+     -- | The changes from the previous version up to this version.
+     ChangesUpTo VersionExtra [APIChange] APIChangelog
+     -- | The initial version
+   | ChangesStart Version
+    deriving (Eq, Show)
+
+-- | A single change within a changelog
+data APIChange
+    = ChAddType       TypeName NormTypeDecl
+    | ChDeleteType    TypeName
+    | ChRenameType    TypeName TypeName
+
+      -- Specific changes for record types
+    | ChAddField      TypeName FieldName APIType (Maybe DefaultValue)
+    | ChDeleteField   TypeName FieldName
+    | ChRenameField   TypeName FieldName FieldName
+    | ChChangeField   TypeName FieldName APIType MigrationTag
+
+      -- Changes for union types
+    | ChAddUnionAlt    TypeName FieldName APIType
+    | ChDeleteUnionAlt TypeName FieldName
+    | ChRenameUnionAlt TypeName FieldName FieldName
+
+      -- Changes for enum types
+    | ChAddEnumVal    TypeName FieldName
+    | ChDeleteEnumVal TypeName FieldName
+    | ChRenameEnumVal TypeName FieldName FieldName
+
+      -- Custom value (not type) changes
+    | ChCustomRecord  TypeName MigrationTag
+    | ChCustomAll     MigrationTag
+    deriving (Eq, Show)
+
+-- | Within the changelog, custom migrations are represented as
+-- strings, so we have less type-safety.
+type MigrationTag = String
+
+-- | Custom migrations used in the changelog must be implemented in
+-- Haskell, and supplied in this record.  There are three kinds:
+--
+-- * Whole-database migrations, which may arbitrarily change the API
+-- schema and the data to match;
+--
+-- * Record migrations, which may change the schema of a single
+-- record; and
+--
+-- * Single field migrations, which may change only the type of the
+-- field (with the new type specified in the changelog).
+--
+-- For database and record migrations, if the schema is unchanged, the
+-- corresponding function should return 'Nothing'.
+--
+-- The @db@, @rec@ and @fld@ parameters should be instantiated with
+-- the enumeration types generated by 'generateMigrationKinds', which
+-- correspond to the exact set of custom migration tags used in the
+-- changelog.
+data CustomMigrations db rec fld = CustomMigrations
+    { databaseMigration       :: db -> JS.Object -> Either ValueError JS.Object
+    , databaseMigrationSchema :: db -> NormAPI -> Maybe NormAPI
+    , recordMigration         :: rec -> JS.Object -> Either ValueError JS.Object
+    , recordMigrationSchema   :: rec -> NormRecordType -> Maybe NormRecordType
+    , fieldMigration          :: fld -> JS.Value -> Either ValueError JS.Value }
+
+type CustomMigrationsTagged = CustomMigrations MigrationTag MigrationTag MigrationTag
+
+readCustomMigrations :: (Read db, Read rec, Read fld)
+                     => CustomMigrations db rec fld -> CustomMigrationsTagged
+readCustomMigrations (CustomMigrations db dbs r rs f) =
+    CustomMigrations (db . read) (dbs . read) (r . read) (rs . read) (f . read)
+
+
+-- | When to validate the data against the schema (each level implies
+-- the preceding levels):
+data DataChecks = NoChecks         -- ^ Not at all
+                | CheckStartAndEnd -- ^ At start and end of the migration
+                | CheckCustom      -- ^ After custom migrations
+                | CheckAll         -- ^ After every change
+  deriving (Eq, Ord)
+
+-- | Whether to validate the dataset after this change
+validateAfter :: DataChecks -> APIChange -> Bool
+validateAfter chks (ChChangeField{})  = chks >= CheckCustom
+validateAfter chks (ChCustomRecord{}) = chks >= CheckCustom
+validateAfter chks (ChCustomAll{})    = chks >= CheckCustom
+validateAfter chks _                  = chks >= CheckAll
+
+
+--------------------
+-- Changelog utils
+--
+
+-- | Represents either a released version (with a version number) or
+-- the version under development, which is newer than any release
+data VersionExtra = Release Version
+                  | DevVersion
+  deriving (Eq, Ord, Show)
+
+showVersionExtra :: VersionExtra -> String
+showVersionExtra (Release v) = showVersion v
+showVersionExtra DevVersion  = "development"
+
+instance PP VersionExtra where
+  pp = showVersionExtra
+
+
+-- | The earliest version in the changelog
+changelogStartVersion :: APIChangelog -> Version
+changelogStartVersion (ChangesStart v) = v
+changelogStartVersion (ChangesUpTo _ _ clog) = changelogStartVersion clog
+
+-- | The latest version in the changelog
+changelogVersion :: APIChangelog -> VersionExtra
+changelogVersion (ChangesStart v)     = Release v
+changelogVersion (ChangesUpTo  v _ _) = v
+
+-- | Changelog in order starting from oldest version up to newest.
+-- Entries are @(from, to, changes-oldest-first)@.
+viewChangelogReverse :: APIChangelog -> [(VersionExtra, VersionExtra, [APIChange])]
+viewChangelogReverse clog =
+  reverse [ (v,v',reverse cs) | (v',v,cs) <- viewChangelog clog ]
+
+-- | Changelog in order as written, with latest version at the beginning, going
+-- back to older versions. Entries are @(to, from, changes-latest-first)@.
+viewChangelog :: APIChangelog -> [(VersionExtra, VersionExtra, [APIChange])]
+viewChangelog (ChangesStart _)          = []
+viewChangelog (ChangesUpTo v' cs older) = (v', v, cs) : viewChangelog older
+                                           where v = changelogVersion older
+
+-- | Is the changelog in the correct order? If not, return a pair of
+-- out-of-order versions.
+isChangelogOrdered :: APIChangelog -> Either (VersionExtra, VersionExtra) ()
+isChangelogOrdered changelog =
+    case find (\ (v', v, _) -> v' <= v) (viewChangelog changelog) of
+      Nothing         -> return ()
+      Just (v', v, _) -> Left (v', v)
+
+
+-- | Sets of custom migration tags in the changelog for
+-- whole-database, single-record and single-field migrations
+changelogTags :: APIChangelog -> (Set MigrationTag, Set MigrationTag, Set MigrationTag)
+changelogTags (ChangesStart _) = (Set.empty, Set.empty, Set.empty)
+changelogTags (ChangesUpTo _ cs older) =
+    unions3 (map changeTags cs) `union3` changelogTags older
+  where
+    union3 (a, b, c) (x, y, z) = (a `Set.union` x, b `Set.union` y, c `Set.union` z)
+    unions3 xyzs = (Set.unions xs, Set.unions ys, Set.unions zs)
+      where (xs, ys, zs) = unzip3 xyzs
+
+-- | Sets of custom migration tags in a single change
+changeTags :: APIChange -> (Set MigrationTag, Set MigrationTag, Set MigrationTag)
+changeTags (ChChangeField _ _ _ t) = (Set.empty, Set.empty, Set.singleton t)
+changeTags (ChCustomRecord _ t)    = (Set.empty, Set.singleton t, Set.empty)
+changeTags (ChCustomAll t)         = (Set.singleton t, Set.empty, Set.empty)
+changeTags _                       = (Set.empty, Set.empty, Set.empty)
+
+
+------------------------------------------
+-- Comparing APIs: canonical/normal form
+--
+
+-- | The API type has too much extra info for us to be able to simply compare
+-- them with @(==)@. Our strategy is to strip out ancillary information and
+-- normalise into a canonical form, and then we can use a simple @(==)@ compare.
+--
+-- Our normalised API discards most of the details of each type, keeping
+-- just essential information about each type. We discard order of types and
+-- fields, so we can use just associative maps.
+--
+type NormAPI = Map TypeName NormTypeDecl
+
+-- | The normal or canonical form for a type declaration, an 'APINode'.
+-- Equality of the normal form indicates equivalence of APIs.
+--
+-- We track all types.
+--
+data NormTypeDecl
+    = NRecordType  NormRecordType
+    | NUnionType   NormUnionType
+    | NEnumType    NormEnumType
+    | NTypeSynonym APIType
+    | NNewtype     BasicType
+  deriving (Eq, Show)
+
+-- | The canonical form of a record type is a map from fields to
+-- values; similarly a union is a map from fields to alternatives and
+-- an enum is a set of values.
+type NormRecordType = Map FieldName APIType
+type NormUnionType  = Map FieldName APIType
+type NormEnumType   = Set FieldName
+
+
+-- | Compute the normal form of an API, discarding extraneous information.
+apiNormalForm :: API -> NormAPI
+apiNormalForm api =
+    Map.fromList
+      [ (name, declNF spec)
+      | ThNode (APINode {anName = name, anSpec = spec}) <- api ]
+
+-- | Compute the normal form of a single type declaration.
+declNF :: Spec -> NormTypeDecl
+declNF (SpRecord (SpecRecord fields)) = NRecordType $ Map.fromList
+                                          [ (fname, ftType ftype)
+                                          | (fname, ftype) <- fields ]
+declNF (SpUnion (SpecUnion alts))     = NUnionType $ Map.fromList
+                                          [ (fname, ftype)
+                                          | (fname, (ftype, _)) <- alts ]
+declNF (SpEnum (SpecEnum elems))      = NEnumType $ Set.fromList
+                                          [ fname | (fname, _) <- elems ]
+declNF (SpSynonym t)                  = NTypeSynonym t
+declNF (SpNewtype (SpecNewtype bt _)) = NNewtype bt
+
+
+-------------------------
+-- Type decl/expr utils
+--
+
+typeDelcsFreeVars :: NormAPI -> Set TypeName
+typeDelcsFreeVars = Set.unions . map typeDelcFreeVars . Map.elems
+
+typeDelcFreeVars :: NormTypeDecl -> Set TypeName
+typeDelcFreeVars (NRecordType fields) = Set.unions . map typeFreeVars
+                                                   . Map.elems $ fields
+typeDelcFreeVars (NUnionType  alts)   = Set.unions . map typeFreeVars
+                                                   . Map.elems $ alts
+typeDelcFreeVars (NEnumType _)        = Set.empty
+typeDelcFreeVars (NTypeSynonym t)     = typeFreeVars t
+typeDelcFreeVars (NNewtype _)         = Set.empty
+
+typeFreeVars :: APIType -> Set TypeName
+typeFreeVars (TyList  t) = typeFreeVars t
+typeFreeVars (TyMaybe t) = typeFreeVars t
+typeFreeVars (TyName  n) = Set.singleton n
+typeFreeVars (TyBasic _) = Set.empty
+typeFreeVars  TyJSON     = Set.empty
+
+mapTypeDeclFreeVars :: (TypeName -> APIType) -> NormTypeDecl -> NormTypeDecl
+mapTypeDeclFreeVars f   (NRecordType fields) = NRecordType (Map.map (mapTypeFreeVars f) fields)
+mapTypeDeclFreeVars f   (NUnionType  alts)   = NUnionType (Map.map (mapTypeFreeVars f) alts)
+mapTypeDeclFreeVars _ d@(NEnumType _)        = d
+mapTypeDeclFreeVars f   (NTypeSynonym t)     = NTypeSynonym (mapTypeFreeVars f t)
+mapTypeDeclFreeVars _ d@(NNewtype _)         = d
+
+mapTypeFreeVars :: (TypeName -> APIType) -> APIType -> APIType
+mapTypeFreeVars f (TyList  t)   = TyList (mapTypeFreeVars f t)
+mapTypeFreeVars f (TyMaybe t)   = TyMaybe (mapTypeFreeVars f t)
+mapTypeFreeVars f (TyName  n)   = f n
+mapTypeFreeVars _ t@(TyBasic _) = t
+mapTypeFreeVars _ t@TyJSON      = t
+
+
+typeDeclaredInApi :: TypeName -> NormAPI -> Bool
+typeDeclaredInApi tname api = Map.member tname api
+
+-- | Check if a type is used anywhere in the API
+typeUsedInApi :: TypeName -> NormAPI -> Bool
+typeUsedInApi tname api = tname `Set.member` typeDelcsFreeVars api
+
+-- | Check if a type is used anywhere in the database (possibly in a
+-- transitive dependency of the root).
+typeUsedInApiTable :: TypeName -> TypeName -> NormAPI -> Bool
+typeUsedInApiTable root tname api =
+    tname == root || tname `Set.member` transitiveDeps api (Set.singleton root)
+
+-- | Compute the transitive dependencies of a set of types
+transitiveDeps :: NormAPI -> Set TypeName -> Set TypeName
+transitiveDeps api = transitiveClosure $ \ s ->
+                         typeDelcsFreeVars $
+                         Map.filterWithKey (\ x _ -> x `Set.member` s) api
+
+-- | Compute the set of types that depend (transitively) on the given types
+transitiveSped :: NormAPI -> Set TypeName -> Set TypeName
+transitiveSped api = transitiveClosure $ \ s ->
+                         Map.keysSet $
+                         Map.filter (intersects s . typeDelcFreeVars) api
+  where
+    intersects s1 s2 = not $ Set.null $ s1 `Set.intersection` s2
+
+-- | Compute the transitive closure of a relation.  Relations are
+-- represented as functions that takes a set of elements to the set of
+-- related elements.
+transitiveClosure :: Ord a => (Set a -> Set a) -> Set a -> Set a
+transitiveClosure rel x = findUsed x0 x0
+  where
+    x0 = rel x
+
+    findUsed seen old
+      | Set.null new = seen
+      | otherwise    = findUsed (seen `Set.union` new) new
+      where
+        new = rel old `Set.difference` seen
+
+renameTypeUses :: TypeName -> TypeName -> NormAPI -> NormAPI
+renameTypeUses tname tname' = Map.map (mapTypeDeclFreeVars rename)
+  where
+    rename tn | tn == tname = TyName tname'
+              | otherwise   = TyName tn
+
+typeIsValid :: APIType -> NormAPI -> Either (Set TypeName) ()
+typeIsValid t api
+    | typeVars `Set.isSubsetOf` declaredTypes = return ()
+    | otherwise = Left (typeVars Set.\\ declaredTypes)
+  where
+    typeVars      = typeFreeVars t
+    declaredTypes = Map.keysSet api
+
+declIsValid :: NormTypeDecl -> NormAPI -> Either (Set TypeName) ()
+declIsValid decl api
+    | declVars `Set.isSubsetOf` declaredTypes = return ()
+    | otherwise = Left (declVars Set.\\ declaredTypes)
+  where
+    declVars      = typeDelcFreeVars decl
+    declaredTypes = Map.keysSet api
+
+apiInvariant :: NormAPI -> Either (Set TypeName) ()
+apiInvariant api
+  | usedTypes `Set.isSubsetOf` declaredTypes = return ()
+  | otherwise = Left (usedTypes Set.\\ declaredTypes)
+  where
+    usedTypes     = typeDelcsFreeVars api
+    declaredTypes = Map.keysSet api
+
+
+--------------------------------
+-- Representing update positions
+--
+
+-- | Represents the positions in a declaration to apply an update
+data UpdateDeclPos
+    = UpdateHere   (Maybe UpdateDeclPos)
+    | UpdateRecord (Map FieldName (Maybe UpdateTypePos))
+    | UpdateUnion  (Map FieldName (Maybe UpdateTypePos))
+    | UpdateType   UpdateTypePos
+    deriving (Eq, Show)
+
+-- | Represents the positions in a type to apply an update
+data UpdateTypePos
+    = UpdateList UpdateTypePos
+    | UpdateMaybe UpdateTypePos
+    | UpdateNamed TypeName
+    deriving (Eq, Show)
+
+data APITableChange
+      -- | The pair of an APIChange and the positions in which to apply it
+    = APIChange APIChange (Map TypeName UpdateDeclPos)
+      -- | Request to validate the dataset against the given API
+    | ValidateData NormAPI
+    deriving (Eq, Show)
+
+-- | Given a type to be modified, find the positions in which each
+-- type in the API must be updated
+findUpdatePos :: TypeName -> NormAPI -> Map TypeName UpdateDeclPos
+findUpdatePos tname api = Map.alter (Just . UpdateHere) tname $
+                          Map.fromSet findDecl deps
+  where
+    -- The set of types that depend on the type being updated
+    deps :: Set TypeName
+    deps = transitiveSped api (Set.singleton tname)
+
+    findDecl :: TypeName -> UpdateDeclPos
+    findDecl tname' = findDecl' $
+                      fromMaybe (error "findUpdatePos: missing type") $
+                      Map.lookup tname' api
+
+    findDecl' :: NormTypeDecl -> UpdateDeclPos
+    findDecl' (NRecordType flds) = UpdateRecord $ fmap findType flds
+    findDecl' (NUnionType alts)  = UpdateUnion  $ fmap findType alts
+    findDecl' (NEnumType _)      = error "findDecl': unexpected enum"
+    findDecl' (NTypeSynonym ty)  = UpdateType $ fromMaybe (error "findDecl': missing") $
+                                                findType ty
+    findDecl' (NNewtype _)       = error "findDecl': unexpected newtype"
+
+    findType :: APIType -> Maybe UpdateTypePos
+    findType (TyList ty)      = UpdateList <$> findType ty
+    findType (TyMaybe ty)     = UpdateMaybe <$> findType ty
+    findType (TyName tname')
+        | tname' == tname || tname' `Set.member` deps = Just $ UpdateNamed tname'
+        | otherwise                                   = Nothing
+    findType (TyBasic _)      = Nothing
+    findType TyJSON           = Nothing
+
+
+---------------------------
+-- Validating API changes
+--
+
+-- | Errors that may be discovered when validating a changelog
+data ValidateFailure
+        -- | the changelog must be in descending order of versions
+    = ChangelogOutOfOrder { vfLaterVersion   :: VersionExtra
+                          , vfEarlierVersion :: VersionExtra }
+        -- | forbid migrating from one version to an earlier version
+    | CannotDowngrade { vfFromVersion :: VersionExtra
+                      , vfToVersion   :: VersionExtra }
+        -- | an API uses types that are not declared
+    | ApiInvalid { vfInvalidVersion      :: VersionExtra
+                 , vfMissingDeclarations :: Set TypeName }
+        -- | changelog entry does not apply
+    | ChangelogEntryInvalid { vfSuccessfullyApplied :: [APITableChange]
+                            , vfFailedToApply       :: APIChange
+                            , vfApplyFailure        :: ApplyFailure }
+        -- | changelog is incomplete
+        --   (ie all entries apply ok but result isn't the target api)
+    | ChangelogIncomplete { vfChangelogVersion :: VersionExtra
+                          , vfTargetVersion    :: VersionExtra
+                          , vfDifferences      :: Map TypeName (MergeResult NormTypeDecl NormTypeDecl) }
+  deriving (Eq, Show)
+
+data ValidateWarning = ValidateWarning -- add warnings about bits we cannot check (opaque custom)
+  deriving Show
+
+-- | Errors that may occur applying a single API change
+data ApplyFailure
+    = TypeExists           { afExistingType  :: TypeName }     -- ^ for adding or renaming type
+    | TypeDoesNotExist     { afMissingType   :: TypeName }     -- ^ for deleting or renaming a type
+    | TypeWrongKind        { afTypeName      :: TypeName
+                           , afExpectedKind  :: TypeKind }     -- ^ e.g. it's not a record type
+    | TypeInUse            { afTypeName      :: TypeName }     -- ^ cannot delete/modify types that are still used
+    | TypeMalformed        { afType          :: APIType
+                           , afMissingTypes  :: Set TypeName } -- ^ type refers to a non-existent type
+    | DeclMalformed        { afTypeName      :: TypeName
+                           , afDecl          :: NormTypeDecl
+                           , afMissingTypes  :: Set TypeName } -- ^ decl refers to a non-existent type
+    | FieldExists          { afTypeName      :: TypeName
+                           , afTypeKind      :: TypeKind
+                           , afExistingField :: FieldName }    -- ^ for adding or renaming a field
+    | FieldDoesNotExist    { afTypeName      :: TypeName
+                           , afTypeKind      :: TypeKind
+                           , afMissingField  :: FieldName }    -- ^ for deleting or renaming a field
+    | FieldBadDefaultValue { afTypeName      :: TypeName
+                           , afFieldName     :: FieldName
+                           , afFieldType     :: APIType
+                           , afBadDefault    :: DefaultValue } -- ^ for adding a field, must be a default
+                                                               --   value compatible with the type
+    | DefaultMissing       { afTypeName      :: TypeName
+                           , afFieldName     :: FieldName }    -- ^ for adding a field to a table
+    | TableChangeError     { afCustomMessage :: String }       -- ^ custom error in tableChange
+  deriving (Eq, Show)
+
+data TypeKind = TKRecord | TKUnion | TKEnum
+  deriving (Eq, Show)
+
+
+-- | Check that a changelog adequately describes how to migrate from
+-- one version to another.
+validateChanges :: (Read db, Read rec, Read fld)
+                => (API, Version)              -- ^ Starting schema and version
+                -> (API, VersionExtra)         -- ^ Ending schema and version
+                -> APIChangelog                -- ^ Changelog to be validated
+                -> CustomMigrations db rec fld -- ^ Custom migration functions
+                -> TypeName                    -- ^ Name of the dataset's type
+                -> DataChecks                  -- ^ How thoroughly to validate changes
+                -> Either ValidateFailure [ValidateWarning]
+validateChanges (api,ver) (api',ver') clog custom root chks = snd <$>
+  validateChanges' (api,ver) (api',ver') clog (readCustomMigrations custom) root chks
+
+-- | Internal version of 'validateChanges', which works on unsafe
+-- migration tags and returns the list of 'APITableChange's to apply
+-- to the dataset.
+validateChanges' :: (API, Version)         -- ^ Starting schema and version
+                 -> (API, VersionExtra)    -- ^ Ending schema and version
+                 -> APIChangelog           -- ^ Changelog to be validated
+                 -> CustomMigrationsTagged -- ^ Custom migration functions
+                 -> TypeName               -- ^ Name of the dataset's type
+                 -> DataChecks             -- ^ How thoroughly to validate changes
+                 -> Either ValidateFailure ([APITableChange], [ValidateWarning])
+validateChanges' (api,ver) (api',ver') clog custom root chks = do
+  -- select changes by version from log
+  (changes, verEnd) <- selectChanges clog (Release ver) ver'
+  -- take norm of start and end api,
+  let apiStart  = apiNormalForm api
+      apiTarget = apiNormalForm api'
+  -- check start and end APIs are well formed.
+  apiInvariant apiStart  ?!? ApiInvalid (Release ver)
+  apiInvariant apiTarget ?!? ApiInvalid ver'
+   -- check expected end api
+  (apiEnd, changes') <- applyAPIChangesToAPI root custom chks changes apiStart
+  -- check expected end api
+  guard (apiEnd == apiTarget) ?! ChangelogIncomplete verEnd ver' (diffMaps apiEnd apiTarget)
+  return (changes', [])
+
+selectChanges :: APIChangelog -> VersionExtra -> VersionExtra
+              -> Either ValidateFailure ([APIChange], VersionExtra)
+selectChanges clog ver ver'
+  | ver' == ver = return ([], ver')
+  | ver' >  ver = do
+      isChangelogOrdered clog ?!? uncurry ChangelogOutOfOrder
+      let withinRange = takeWhile (\ (_, v, _) -> v <= ver') $
+                            dropWhile (\ (_, v, _) -> v <= ver) $
+                                viewChangelogReverse clog
+          endVer = case lastMay withinRange of
+                     Nothing        -> ver
+                     Just (_, v, _) -> v
+      return ([ c | (_,_, cs) <- withinRange, c <- cs ], endVer)
+
+  | otherwise = Left (CannotDowngrade ver ver')
+
+-- | Apply a list of changes to an API, returning the updated API and
+-- a list of the changes with appropriate TableChanges interspersed.
+-- On failure, return the list of successfully applied changes, the
+-- change that failed and the reason for the failure.
+applyAPIChangesToAPI :: TypeName -> CustomMigrationsTagged -> DataChecks
+                     -> [APIChange] -> NormAPI
+                     -> Either ValidateFailure (NormAPI, [APITableChange])
+applyAPIChangesToAPI root custom chks changes api = do
+    (api', changes') <- foldM (doChangeAPI root custom chks) (api, []) changes
+    let changes'' | chks >= CheckStartAndEnd = addV api $ reverse $ addV api' changes'
+                  | otherwise                = reverse changes'
+    return (api', changes'')
+  where
+    addV _ cs@(ValidateData _ : _) = cs
+    addV a cs                      = ValidateData a : cs
+
+-- | Apply the API change
+doChangeAPI :: TypeName -> CustomMigrationsTagged -> DataChecks
+            -> (NormAPI, [APITableChange]) -> APIChange
+            -> Either ValidateFailure (NormAPI, [APITableChange])
+doChangeAPI root custom chks (api, changes) change = do
+    (api', pos) <- applyAPIChangeToAPI root custom change api
+                       ?!? ChangelogEntryInvalid changes change
+    let changes' = APIChange change pos : changes
+        changes'' | validateAfter chks change = ValidateData api' : changes'
+                  | otherwise                 = changes'
+    return (api', changes'')
+
+-- Checks and and performs an API change. If it works then we get back the new
+-- overall api. This is used for two purposes, (1) validating that we can apply
+-- each change in that context, and that we end up with the API we expect
+-- and (2) getting the intermediate APIs during data migration, because we need
+-- the schema of the intermediate data as part of applying the migration.
+applyAPIChangeToAPI :: TypeName -> CustomMigrationsTagged -> APIChange -> NormAPI
+                    -> Either ApplyFailure (NormAPI, Map TypeName UpdateDeclPos)
+
+applyAPIChangeToAPI _ _ (ChAddType tname tdecl) api = do
+  -- to add a new type, that type must not yet exist
+  guard (not (tname `typeDeclaredInApi` api))   ?! TypeExists tname
+  declIsValid tdecl api                         ?!? DeclMalformed tname tdecl
+  return (Map.insert tname tdecl api, Map.empty)
+
+applyAPIChangeToAPI _ _ (ChDeleteType tname) api = do
+  -- to delete a type, that type must exist
+  guard (tname `typeDeclaredInApi` api)         ?! TypeDoesNotExist tname
+  -- it must also not be used anywhere else in the API
+  guard (not (tname `typeUsedInApi` api))       ?! TypeInUse tname
+  return (Map.delete tname api, Map.empty)
+
+applyAPIChangeToAPI _ _ (ChRenameType tname tname') api = do
+  -- to rename a type, the original type name must exist
+  -- and the new one must not yet exist
+  tinfo <- lookupType tname api
+  guard (not (tname' `typeDeclaredInApi` api))  ?! TypeExists tname'
+  return ( (renameTypeUses tname tname'
+            . Map.insert tname' tinfo . Map.delete tname) api
+         , Map.empty )
+
+applyAPIChangeToAPI _ custom (ChCustomRecord tname tag) api = do
+  -- to make some change to values of a type, the type name must exist
+  tinfo   <- lookupType tname api
+  recinfo <- expectRecordType tinfo               ?! TypeWrongKind tname TKRecord
+  let api' = case recordMigrationSchema custom tag recinfo of
+                 Just recinfo' -> Map.insert tname (NRecordType recinfo') api
+                 Nothing       -> api
+  return (api', findUpdatePos tname api)
+
+applyAPIChangeToAPI root _ (ChAddField tname fname ftype mb_defval) api = do
+  tinfo   <- lookupType tname api
+  recinfo <- expectRecordType tinfo                ?! TypeWrongKind tname TKRecord
+  guard (not (Map.member fname recinfo))           ?! FieldExists tname TKRecord fname
+  typeIsValid ftype api                            ?!? TypeMalformed ftype
+  case mb_defval <|> defaultValueForType ftype of
+    Just defval -> guard (compatibleDefaultValue api ftype defval)
+                                                   ?! FieldBadDefaultValue tname fname ftype defval
+    Nothing     -> guard (not (typeUsedInApiTable root tname api))
+                                                   ?! DefaultMissing tname fname
+  let tinfo' = NRecordType (Map.insert fname ftype recinfo)
+  return (Map.insert tname tinfo' api, findUpdatePos tname api)
+
+applyAPIChangeToAPI _ _ (ChDeleteField tname fname) api = do
+  tinfo   <- lookupType tname api
+  recinfo <- expectRecordType tinfo        ?! TypeWrongKind tname TKRecord
+  guard (Map.member fname recinfo)         ?! FieldDoesNotExist tname TKRecord fname
+  let tinfo' = NRecordType (Map.delete fname recinfo)
+  return (Map.insert tname tinfo' api, findUpdatePos tname api)
+
+applyAPIChangeToAPI _ _ (ChRenameField tname fname fname') api = do
+  tinfo   <- lookupType tname api
+  recinfo <- expectRecordType tinfo        ?! TypeWrongKind tname TKRecord
+  ftype   <- Map.lookup fname recinfo      ?! FieldDoesNotExist tname TKRecord fname
+  guard (not (Map.member fname' recinfo))  ?! FieldExists tname TKRecord fname'
+  let tinfo' = (NRecordType . Map.insert fname' ftype
+                            . Map.delete fname) recinfo
+  return (Map.insert tname tinfo' api, findUpdatePos tname api)
+
+applyAPIChangeToAPI _ _ (ChChangeField tname fname ftype _) api = do
+  tinfo   <- lookupType tname api
+  recinfo <- expectRecordType tinfo        ?! TypeWrongKind tname TKRecord
+  guard (Map.member fname recinfo)         ?! FieldDoesNotExist tname TKRecord fname
+  let tinfo' = (NRecordType . Map.insert fname ftype) recinfo
+  return (Map.insert tname tinfo' api, findUpdatePos tname api)
+
+applyAPIChangeToAPI _ _ (ChAddUnionAlt tname fname ftype) api = do
+  tinfo     <- lookupType tname api
+  unioninfo <- expectUnionType tinfo               ?! TypeWrongKind tname TKUnion
+  guard (not (Map.member fname unioninfo))         ?! FieldExists tname TKUnion fname
+  typeIsValid ftype api                            ?!? TypeMalformed ftype
+  let tinfo' = NUnionType (Map.insert fname ftype unioninfo)
+  return (Map.insert tname tinfo' api, Map.empty)
+
+applyAPIChangeToAPI root _ (ChDeleteUnionAlt tname fname) api = do
+  tinfo     <- lookupType tname api
+  unioninfo <- expectUnionType tinfo         ?! TypeWrongKind tname TKUnion
+  guard (not (typeUsedInApiTable root tname api)) ?! TypeInUse tname
+  guard (Map.member fname unioninfo)         ?! FieldDoesNotExist tname TKUnion fname
+  let tinfo' = NUnionType (Map.delete fname unioninfo)
+  return (Map.insert tname tinfo' api, Map.empty)
+
+applyAPIChangeToAPI _ _ (ChRenameUnionAlt tname fname fname') api = do
+  tinfo     <- lookupType tname api
+  unioninfo <- expectUnionType tinfo        ?! TypeWrongKind tname TKUnion
+  ftype     <- Map.lookup fname unioninfo   ?! FieldDoesNotExist tname TKUnion fname
+  guard (not (Map.member fname' unioninfo)) ?! FieldExists tname TKUnion fname'
+  let tinfo' = (NUnionType . Map.insert fname' ftype
+                           . Map.delete fname) unioninfo
+  return (Map.insert tname tinfo' api, findUpdatePos tname api)
+
+applyAPIChangeToAPI _ _ (ChAddEnumVal tname fname) api = do
+  tinfo    <- lookupType tname api
+  enuminfo <- expectEnumType tinfo                 ?! TypeWrongKind tname TKEnum
+  guard (not (Set.member fname enuminfo))          ?! FieldExists tname TKEnum fname
+  let tinfo' = NEnumType (Set.insert fname enuminfo)
+  return (Map.insert tname tinfo' api, Map.empty)
+
+applyAPIChangeToAPI root _ (ChDeleteEnumVal tname fname) api = do
+  tinfo    <- lookupType tname api
+  enuminfo <- expectEnumType tinfo          ?! TypeWrongKind tname TKEnum
+  guard (not (typeUsedInApiTable root tname api)) ?! TypeInUse tname
+  guard (Set.member fname enuminfo)         ?! FieldDoesNotExist tname TKEnum fname
+  let tinfo' = NEnumType (Set.delete fname enuminfo)
+  return (Map.insert tname tinfo' api, Map.empty)
+
+applyAPIChangeToAPI _ _ (ChRenameEnumVal tname fname fname') api = do
+  tinfo     <- lookupType tname api
+  enuminfo <- expectEnumType tinfo         ?! TypeWrongKind tname TKEnum
+  guard (Set.member fname enuminfo)        ?! FieldDoesNotExist tname TKEnum fname
+  guard (not (Set.member fname' enuminfo)) ?! FieldExists tname TKEnum fname'
+  let tinfo' = (NEnumType . Set.insert fname'
+                          . Set.delete fname) enuminfo
+  return (Map.insert tname tinfo' api, findUpdatePos tname api)
+
+applyAPIChangeToAPI root custom (ChCustomAll tag) api =
+  return ( fromMaybe api (databaseMigrationSchema custom tag api)
+         , Map.singleton root (UpdateHere Nothing))
+
+
+lookupType :: TypeName -> NormAPI -> Either ApplyFailure NormTypeDecl
+lookupType tname api = Map.lookup tname api ?! TypeDoesNotExist tname
+
+expectRecordType :: NormTypeDecl -> Maybe (Map FieldName APIType)
+expectRecordType (NRecordType rinfo) = Just rinfo
+expectRecordType _                   = Nothing
+
+expectUnionType :: NormTypeDecl -> Maybe (Map FieldName APIType)
+expectUnionType (NUnionType rinfo) = Just rinfo
+expectUnionType _                  = Nothing
+
+expectEnumType :: NormTypeDecl -> Maybe (Set FieldName)
+expectEnumType (NEnumType rinfo) = Just rinfo
+expectEnumType _                 = Nothing
+
+
+-----------------------------------
+-- Performing data transformation
+--
+
+-- | This is the low level one that just does the changes.
+--
+-- We assume the changes have already been validated, and that the data
+-- matches the API.
+--
+applyChangesToDatabase :: TypeName -> CustomMigrationsTagged
+                       -> JS.Value -> [APITableChange]
+                       -> Either (ValueError, Position) JS.Value
+applyChangesToDatabase root custom = foldM (applyChangeToDatabase root custom)
+  -- just apply each of the individual changes in sequence to the whole dataset
+
+applyChangeToDatabase :: TypeName -> CustomMigrationsTagged
+                      -> JS.Value -> APITableChange
+                      -> Either (ValueError, Position) JS.Value
+applyChangeToDatabase root custom v (APIChange c upds) =
+    updateTypeAt upds (applyChangeToData c custom) (UpdateNamed root) v []
+applyChangeToDatabase root _      v (ValidateData api) = do
+    dataMatchesNormAPI root api v
+    return v
+
+
+-- | Apply an update at the given position in a declaration's value
+updateDeclAt :: Map TypeName UpdateDeclPos
+             -> (JS.Value -> Position -> Either (ValueError, Position) JS.Value)
+             -> UpdateDeclPos
+             -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+updateDeclAt _    alter (UpdateHere Nothing)    v p = alter v p
+updateDeclAt upds alter (UpdateHere (Just upd)) v p = flip alter p =<< updateDeclAt upds alter upd v p
+updateDeclAt upds alter (UpdateRecord upd_flds) v p = withObjectMatchingFields upd_flds
+                                                        (maybe (pure . pure) (updateTypeAt upds alter)) v p
+updateDeclAt upds alter (UpdateUnion upd_alts)  v p = withObjectMatchingUnion upd_alts
+                                                        (maybe (pure . pure) (updateTypeAt upds alter)) v p
+updateDeclAt upds alter (UpdateType upd)        v p = updateTypeAt upds alter upd v p
+
+-- | Apply an upate at the given position in a type's value
+updateTypeAt :: Map TypeName UpdateDeclPos
+             -> (JS.Value -> Position -> Either (ValueError, Position) JS.Value)
+             -> UpdateTypePos
+             -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+updateTypeAt upds alter (UpdateList upd)    v p = withArrayElems (updateTypeAt upds alter upd) v p
+updateTypeAt upds alter (UpdateMaybe upd)   v p = withMaybe (updateTypeAt upds alter upd) v p
+updateTypeAt upds alter (UpdateNamed tname) v p = case Map.lookup tname upds of
+    Just upd -> updateDeclAt upds alter upd v p
+    Nothing  -> pure v
+
+
+-- | This actually applies the change to the data value, assuming it
+-- is already in the correct place
+applyChangeToData :: APIChange -> CustomMigrationsTagged
+                  -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+
+applyChangeToData (ChAddField tname fname ftype mb_defval) _ =
+  case mb_defval <|> defaultValueForType ftype of
+    Just defval -> let newFieldValue = defaultValueAsJsValue defval
+                   in withObject (\ v _ -> pure $ HMap.insert (fieldKey fname) newFieldValue v)
+    Nothing     -> \ _ p -> Left (InvalidAPI (DefaultMissing tname fname), p)
+
+applyChangeToData (ChDeleteField _ fname) _ =
+    withObject (\ v _ -> pure $ HMap.delete (fieldKey fname) v)
+
+applyChangeToData (ChRenameField _ fname fname') _ =
+    withObject $ \rec p -> case HMap.lookup k_fname rec of
+                           Just field -> renameField field rec
+                           Nothing    -> Left (JSONError MissingField, InField k_fname : p)
+  where
+    k_fname       = fieldKey fname
+    k_fname'      = fieldKey fname'
+    renameField x = pure . HMap.insert k_fname' x . HMap.delete k_fname
+
+applyChangeToData (ChChangeField _ fname _ftype tag) custom =
+    withObjectField (fieldKey fname) (liftMigration $ fieldMigration custom tag)
+
+applyChangeToData (ChRenameUnionAlt _ fname fname') _ = withObject $ \un p ->
+    case HMap.toList un of
+        [(k, r)] | k == fieldKey fname -> return $ HMap.singleton (fieldKey fname') r
+                 | otherwise           -> return un
+        _ -> Left (JSONError $ SyntaxError "Not singleton", p)
+
+applyChangeToData (ChRenameEnumVal _ fname fname') _ = withString $ \s _ ->
+    if s == fieldKey fname then return (fieldKey fname')
+                           else return s
+
+applyChangeToData (ChCustomRecord _ tag) custom = withObject (liftMigration $ recordMigration custom tag)
+applyChangeToData (ChCustomAll tag)      custom = withObject (liftMigration $ databaseMigration custom tag)
+
+applyChangeToData (ChAddType _ _)        _ = pure . pure
+applyChangeToData (ChDeleteType _)       _ = pure . pure
+applyChangeToData (ChRenameType _ _)     _ = pure . pure
+applyChangeToData (ChAddUnionAlt _ _ _)  _ = pure . pure
+applyChangeToData (ChDeleteUnionAlt _ _) _ = pure . pure
+applyChangeToData (ChAddEnumVal _ _)     _ = pure . pure
+applyChangeToData (ChDeleteEnumVal _ _)  _ = pure . pure
+
+
+liftMigration :: (a -> Either ValueError b)
+                 -> (a -> Position -> Either (ValueError, Position) b)
+liftMigration f v p = f v ?!? flip (,) p
+
+-------------------------------------
+-- Utils for manipulating JS.Values
+--
+
+-- | Errors that can be discovered when migrating data values
+data ValueError
+    = JSONError JSONError                  -- ^ Data doesn't match schema
+    | CustomMigrationError String JS.Value -- ^ Error generated during custom migration
+    | InvalidAPI ApplyFailure              -- ^ An API change was invalid
+    deriving (Eq, Show)
+
+withObject :: (JS.Object -> Position -> Either (ValueError, Position) JS.Object)
+           -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+withObject alter (JS.Object obj) p = JS.Object <$> alter obj p
+withObject _     v               p = Left (JSONError $ expectedObject v, p)
+
+withObjectField :: T.Text -> (JS.Value -> Position -> Either (ValueError, Position) JS.Value)
+                -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+withObjectField field alter (JS.Object obj) p =
+    case HMap.lookup field obj of
+      Nothing     -> Left (JSONError MissingField, InField field : p)
+      Just fvalue -> JS.Object <$> (HMap.insert field
+                                       <$> (alter fvalue (InField field : p))
+                                       <*> pure obj)
+withObjectField _ _ v p = Left (JSONError $ expectedObject v, p)
+
+withObjectMatchingFields :: Map FieldName a
+                         -> (a -> JS.Value -> Position -> Either (ValueError, Position) JS.Value)
+                         -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+withObjectMatchingFields m f (JS.Object obj) p = do
+    zs <- matchMaps (Map.mapKeys fieldKey m) (hmapToMap obj) ?!? toErr
+    obj' <- Map.traverseWithKey (\ k (ty, val) -> (f ty val (InField k : p))) zs
+    return $ JS.Object $ mapToHMap obj'
+  where
+    toErr (k, Left _)  = (JSONError MissingField, InField k : p)
+    toErr (k, Right _) = (JSONError UnexpectedField, InField k : p)
+
+    hmapToMap = Map.fromList . HMap.toList
+
+    mapToHMap = HMap.fromList . Map.toList
+
+withObjectMatchingFields _ _ v p = Left (JSONError $ expectedObject v, p)
+
+withObjectMatchingUnion :: Map FieldName a
+                         -> (a -> JS.Value -> Position -> Either (ValueError, Position) JS.Value)
+                         -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+withObjectMatchingUnion m f (JS.Object obj) p
+  | [(k, r)] <- HMap.toList obj
+  = do x  <- Map.lookup (fromFieldKey k) m ?! (JSONError UnexpectedField, InField k : p)
+       r' <- f x r (InField k : p)
+       return $ JS.Object $ HMap.singleton k r'
+withObjectMatchingUnion _ _ _ p = Left (JSONError $ SyntaxError "Not singleton", p)
+
+withArrayElems :: (JS.Value -> Position -> Either (ValueError, Position) JS.Value)
+               -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+withArrayElems alter (JS.Array arr) p = JS.Array <$> V.mapM alterAt (V.indexed arr)
+  where
+    alterAt (i, v) = alter v (InElem i : p)
+withArrayElems _     v              p = Left (JSONError $ expectedArray v, p)
+
+withMaybe :: (JS.Value -> Position -> Either (ValueError, Position) JS.Value)
+          -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+withMaybe _ JS.Null _ = return JS.Null
+withMaybe f v       p = f v p
+
+withString :: (T.Text -> Position -> Either (ValueError, Position) T.Text)
+           -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+withString alter (JS.String s) p = JS.String <$> alter s p
+withString _     v             p = Left (JSONError $ expectedString v, p)
+
+fieldKey :: FieldName -> T.Text
+fieldKey (FieldName fname) = T.pack fname
+
+fromFieldKey :: T.Text -> FieldName
+fromFieldKey = FieldName . T.unpack
+
+compatibleDefaultValue :: NormAPI -> APIType -> DefaultValue -> Bool
+compatibleDefaultValue _   (TyList  _) DefValList  = True
+compatibleDefaultValue _   (TyMaybe _) DefValMaybe = True
+compatibleDefaultValue api (TyMaybe ty)    defval  = compatibleDefaultValue api ty defval
+compatibleDefaultValue _   (TyBasic bt)    defval  =
+    compatibleBasicDefaultValue bt defval
+compatibleDefaultValue _   TyJSON          _       = True
+compatibleDefaultValue env (TyName tname)  defval  =
+    case Map.lookup tname env of
+      Just (NTypeSynonym t) -> compatibleDefaultValue env t defval
+      Just (NNewtype    bt) -> compatibleBasicDefaultValue bt defval
+      Just (NEnumType vals) -> case defval of
+                                 DefValString s -> fromFieldKey s `Set.member` vals
+                                 _              -> False
+      _                     -> False
+compatibleDefaultValue _ _ _ = False
+
+compatibleBasicDefaultValue :: BasicType -> DefaultValue -> Bool
+compatibleBasicDefaultValue BTstring (DefValString _) = True
+compatibleBasicDefaultValue BTbinary (DefValString v) = case B64.decode (B.pack (T.unpack v)) of
+                                                           Left _  -> False
+                                                           Right _ -> True
+compatibleBasicDefaultValue BTbool   (DefValBool _)   = True
+compatibleBasicDefaultValue BTint    (DefValInt _)    = True
+compatibleBasicDefaultValue BTutc    (DefValUtc _)    = True
+compatibleBasicDefaultValue _         _                = False
+
+-- | Check if there is a "default" default value for a field of the
+-- given type: list and maybe have @[]@ and @nothing@ respectively.
+-- Note that type synonyms do not preserve defaults, since we do not
+-- have access to the entire API.
+defaultValueForType :: APIType -> Maybe DefaultValue
+defaultValueForType (TyList  _) = Just DefValList
+defaultValueForType (TyMaybe _) = Just DefValMaybe
+defaultValueForType _           = Nothing
+
+
+-------------------------------------------
+-- Validation that a dataset matches an API
+--
+
+-- | Check that a dataset matches an API, which is necessary for
+-- succesful migration.  The name of the dataset's type must be
+-- specified.
+dataMatchesAPI :: TypeName -> API -> JS.Value -> Either (ValueError, Position) ()
+dataMatchesAPI root = dataMatchesNormAPI root . apiNormalForm
+
+dataMatchesNormAPI :: TypeName -> NormAPI -> JS.Value -> Either (ValueError, Position) ()
+dataMatchesNormAPI root api db = void $ valueMatches (TyName root) db []
+  where
+    declMatches :: NormTypeDecl -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+    declMatches (NRecordType flds) = withObjectMatchingFields flds valueMatches
+    declMatches (NUnionType alts)  = withObjectMatchingUnion  alts valueMatches
+    declMatches (NEnumType vals)   = withString $ \ s p ->
+        if fromFieldKey s `Set.member` vals
+           then return s
+           else Left (JSONError UnexpectedField, InField s : p)
+    declMatches (NTypeSynonym t)   = valueMatches t
+    declMatches (NNewtype bt)      = valueMatchesBasic bt
+
+    valueMatches :: APIType -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+    valueMatches (TyList t)      = withArrayElems (valueMatches t)
+    valueMatches (TyMaybe t)     = withMaybe (valueMatches t)
+    valueMatches (TyName tname)  = \ v p -> do
+        d <- lookupType tname api ?!? (\ f -> (InvalidAPI f, p))
+        declMatches d v p
+    valueMatches (TyBasic bt)    = valueMatchesBasic bt
+    valueMatches TyJSON          = \ v _ -> return v
+
+    valueMatchesBasic :: BasicType -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+    valueMatchesBasic BTstring = expectDecodes (fromJSONWithErrs :: Decode T.Text)
+    valueMatchesBasic BTbinary = expectDecodes (fromJSONWithErrs :: Decode Binary)
+    valueMatchesBasic BTbool   = expectDecodes (fromJSONWithErrs :: Decode Bool)
+    valueMatchesBasic BTint    = expectDecodes (fromJSONWithErrs :: Decode Int)
+    valueMatchesBasic BTutc    = expectDecodes (fromJSONWithErrs :: Decode UTCTime)
+
+    expectDecodes :: Decode t -> JS.Value -> Position -> Either (ValueError, Position) JS.Value
+    expectDecodes f v p = case f v of
+                            Right _          -> return v
+                            Left ((je, _):_) -> Left (JSONError je, p)
+                            Left []          -> Left (JSONError $ SyntaxError "expectDecodes", p)
+
+type Decode t = JS.Value -> Either [(JSONError, Position)] t
+
+-------------------------------------
+-- Utils for merging and diffing maps
+--
+
+data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b
+  deriving (Eq, Show)
+
+mergeMaps :: Ord k => Map k a -> Map k b -> Map k (MergeResult a b)
+mergeMaps m1 m2 = Map.unionWith (\(OnlyInLeft a) (OnlyInRight b) -> InBoth a b)
+                      (fmap OnlyInLeft m1) (fmap OnlyInRight m2)
+
+diffMaps :: (Eq a, Ord k) => Map k a -> Map k a -> Map k (MergeResult a a)
+diffMaps m1 m2 = Map.filter different $ mergeMaps m1 m2
+  where
+    different (InBoth a b) = a /= b
+    different _            = True
+
+-- Attempts to match the keys of the maps to produce a map from keys
+-- to pairs.
+matchMaps :: Ord k => Map k a -> Map k b -> Either (k, Either a b) (Map k (a, b))
+matchMaps m1 m2 = Map.traverseWithKey win $ mergeMaps m1 m2
+  where
+    win _ (InBoth x y)    = return (x, y)
+    win k (OnlyInLeft x)  = Left (k, Left x)
+    win k (OnlyInRight x) = Left (k, Right x)
+
+
+-------------------------------------
+-- Pretty-printing
+--
+
+prettyMigrateFailure :: MigrateFailure -> String
+prettyMigrateFailure = unlines . ppLines
+
+prettyValidateFailure :: ValidateFailure -> String
+prettyValidateFailure = unlines . ppLines
+
+prettyValueError :: ValueError -> String
+prettyValueError = unlines . ppLines
+
+prettyValueErrorPosition :: (ValueError, Position) -> String
+prettyValueErrorPosition = unlines . ppLines
+
+
+instance PP TypeKind where
+  pp TKRecord = "record"
+  pp TKUnion  = "union"
+  pp TKEnum   = "enum"
+
+ppATypeKind :: TypeKind -> String
+ppATypeKind TKRecord = "a record"
+ppATypeKind TKUnion  = "a union"
+ppATypeKind TKEnum   = "an enum"
+
+ppMemberWord :: TypeKind -> String
+ppMemberWord TKRecord = "field"
+ppMemberWord TKUnion  = "alternative"
+ppMemberWord TKEnum   = "value"
+
+
+instance PPLines APIChange where
+  ppLines (ChAddType t d)           = ("added " ++ pp t ++ " ") `inFrontOf` ppLines d
+  ppLines (ChDeleteType t)          = ["removed " ++ pp t]
+  ppLines (ChRenameType t t')       = ["renamed " ++ pp t ++ " to " ++ pp t']
+  ppLines (ChAddField t f ty mb_v)  = [ "changed record " ++ pp t
+                                      , "  field added " ++ pp f ++ " :: " ++ pp ty
+                                        ++ maybe "" (\ v -> " default " ++ pp v) mb_v]
+  ppLines (ChDeleteField t f)       = ["changed record " ++ pp t, "  field removed " ++ pp f]
+  ppLines (ChRenameField t f f')    = [ "changed record " ++ pp t
+                                      , "  field renamed " ++ pp f ++ " to " ++ pp f']
+  ppLines (ChChangeField t f ty c)  = [ "changed record " ++ pp t
+                                      , "  field changed " ++ pp f ++ " :: " ++ pp ty
+                                        ++ " migration " ++ pp c]
+  ppLines (ChAddUnionAlt t f ty)    = [ "changed union " ++ pp t
+                                      , "  alternative added " ++ pp f ++ " :: " ++ pp ty]
+  ppLines (ChDeleteUnionAlt t f)    = [ "changed union " ++ pp t
+                                      , "  alternative removed " ++ pp f]
+  ppLines (ChRenameUnionAlt t f f') = [ "changed union " ++ pp t
+                                      , "  alternative renamed " ++ pp f ++ " to " ++ pp f']
+  ppLines (ChAddEnumVal t f)        = [ "changed enum " ++ pp t
+                                      , "  alternative added " ++ pp f]
+  ppLines (ChDeleteEnumVal t f)     = [ "changed enum " ++ pp t
+                                      , "  alternative removed " ++ pp f]
+  ppLines (ChRenameEnumVal t f f')  = [ "changed enum " ++ pp t
+                                      , "  alternative renamed " ++ pp f ++ " to " ++ pp f']
+  ppLines (ChCustomRecord t c)      = ["changed record " ++ pp t ++ " migration " ++ pp c]
+  ppLines (ChCustomAll c)           = ["migration " ++ pp c]
+
+instance PPLines NormTypeDecl where
+  ppLines (NRecordType flds) = "record" : map (\ (f, ty) -> "  " ++ pp f
+                                                            ++ " :: " ++ pp ty)
+                                              (Map.toList flds)
+  ppLines (NUnionType alts)  = "union"  : map (\ (f, ty) -> "  " ++ pp f
+                                                            ++ " :: " ++ pp ty)
+                                              (Map.toList alts)
+  ppLines (NEnumType vals)   = "enum"   : map (\ v -> "  " ++ pp v)
+                                              (Set.toList vals)
+  ppLines (NTypeSynonym t)   = [pp t]
+  ppLines (NNewtype b)       = ["basic " ++ pp b]
+
+instance PPLines MigrateFailure where
+  ppLines (ValidateFailure x) = ppLines x
+  ppLines (ValueError x ps)   = ppLines x ++ map prettyStep ps
+
+instance PPLines ValidateFailure where
+  ppLines (ChangelogOutOfOrder later earlier) =
+      ["Changelog out of order: version " ++ pp later
+           ++ " appears after version " ++ pp earlier]
+  ppLines (CannotDowngrade from to) =
+      ["Cannot downgrade from version " ++ pp from
+           ++ " to version " ++ pp to]
+  ppLines (ApiInvalid ver missing) =
+      ["Missing declarations in API version " ++ pp ver ++ ": " ++ pp missing]
+  ppLines (ChangelogEntryInvalid succs change af) =
+      ppLines af ++ ("when applying the change" : indent (ppLines change))
+          ++ if not (null succs)
+             then "after successfully applying the changes:"
+                  : indent (ppLines succs)
+             else []
+  ppLines (ChangelogIncomplete ver ver' diffs) =
+      ("Changelog incomplete! Differences between log version ("
+           ++ showVersionExtra ver ++ ") and latest version (" ++ showVersionExtra ver' ++ "):")
+      : indent (concatMap (uncurry ppDiff) $ Map.toList diffs)
+
+instance PPLines APITableChange where
+  ppLines (APIChange c _)  = ppLines c
+  ppLines (ValidateData _) = []
+
+ppDiff :: TypeName -> MergeResult NormTypeDecl NormTypeDecl -> [String]
+ppDiff t (OnlyInLeft _)  = ["removed " ++ pp t]
+ppDiff t (OnlyInRight d) = ("added " ++ pp t ++ " ") `inFrontOf` ppLines d
+ppDiff t (InBoth (NRecordType flds) (NRecordType flds')) =
+    ("changed record " ++ pp t)
+    : (concatMap (uncurry (ppDiffFields "field")) $ Map.toList $ diffMaps flds flds')
+ppDiff t (InBoth (NUnionType alts) (NUnionType alts')) =
+    ("changed union " ++ pp t)
+    : (concatMap (uncurry (ppDiffFields "alternative")) $ Map.toList $ diffMaps alts alts')
+ppDiff t (InBoth (NEnumType vals) (NEnumType vals')) =
+    ("changed enum " ++ pp t)
+    :  (map (\ x -> "  alternative removed " ++ pp x) $ Set.toList $ vals  Set.\\ vals')
+    ++ (map (\ x -> "  alternative added " ++ pp x)   $ Set.toList $ vals' Set.\\ vals)
+ppDiff t (InBoth _ _) = ["incompatible definitions of " ++ pp t]
+
+ppDiffFields :: String -> FieldName -> MergeResult APIType APIType -> [String]
+ppDiffFields s f (OnlyInLeft _)   = ["  " ++ s ++ " removed " ++ pp f]
+ppDiffFields s f (OnlyInRight ty) = ["  " ++ s ++ " added " ++ pp f ++ " :: " ++ pp ty]
+ppDiffFields s f (InBoth ty ty')   = [ "  incompatible types for " ++ s ++ " " ++ pp f
+                                     , "    changelog type:      " ++ pp ty
+                                     , "    latest version type: " ++ pp ty' ]
+
+
+instance PPLines ApplyFailure where
+  ppLines (TypeExists t)                  = ["Type " ++ pp t ++ " already exists"]
+  ppLines (TypeDoesNotExist t)            = ["Type " ++ pp t ++ " does not exist"]
+  ppLines (TypeWrongKind t k)             = ["Type " ++ pp t ++ " is not " ++ ppATypeKind k]
+  ppLines (TypeInUse t)                   = ["Type " ++ pp t ++ " is in use, so it cannot be modified"]
+  ppLines (TypeMalformed ty xs)           = ["Type " ++ pp ty
+                                             ++ " is malformed, missing declarations:"
+                                            , "  " ++ pp xs]
+  ppLines (DeclMalformed t _ xs)          = [ "Declaration of " ++ pp t
+                                              ++ " is malformed, missing declarations:"
+                                            , "  " ++ pp xs]
+  ppLines (FieldExists t k f)             = ["Type " ++ pp t ++ " already has the "
+                                             ++ ppMemberWord k ++ " " ++ pp f]
+  ppLines (FieldDoesNotExist t k f)       = ["Type " ++ pp t ++ " does not have the "
+                                             ++ ppMemberWord k ++ " " ++ pp f]
+  ppLines (FieldBadDefaultValue _ _ ty v) = ["Default value " ++ pp v
+                                             ++ " is not compatible with the type " ++ pp ty]
+  ppLines (DefaultMissing t f)            = ["Field " ++ pp f ++ " does not have a default value, but "
+                                             ++ pp t ++ " occurs in the database"]
+  ppLines (TableChangeError s)            = ["Error when detecting changed tables:", "  " ++ s]
+
+
+instance PPLines ValueError where
+  ppLines (JSONError e)              = [prettyJSONError e]
+  ppLines (CustomMigrationError e v) = [ "Custom migration error:", "  " ++ e
+                                       , "when migrating value"] ++ indent (ppLines v)
+  ppLines (InvalidAPI af)            = "Invalid API detected during value migration:"
+                                       : indent (ppLines af)
+
+
+-------------------------------------
+-- Template Haskell
+--
+
+-- | Generate enumeration datatypes corresponding to the custom
+-- migrations used in an API migration changelog.
+generateMigrationKinds :: APIChangelog -> String -> String -> String -> Q [Dec]
+generateMigrationKinds changes all_nm rec_nm fld_nm = do
+    guardNoDups (all_tags `Set.intersection` rec_tags)
+    guardNoDups (all_tags `Set.intersection` fld_tags)
+    guardNoDups (rec_tags `Set.intersection` fld_tags)
+
+    return [ DataD [] (mkName all_nm) [] (cons all_nm all_tags) derivs
+           , DataD [] (mkName rec_nm) [] (cons rec_nm rec_tags) derivs
+           , DataD [] (mkName fld_nm) [] (cons fld_nm fld_tags) derivs ]
+  where
+    (all_tags, rec_tags, fld_tags) = changelogTags changes
+
+    guardNoDups xs
+      | Set.null xs = return ()
+      | otherwise   = fail $ "generateMigrationKinds: duplicate custom migrations in changelog: "
+                             ++ show (Set.toList xs)
+
+    -- List of constructors must not be empty, otherwise GHC can't
+    -- derive Read/Show instances (see GHC Trac #7401)
+    cons s xs | not (Set.null xs) = map (\ x -> NormalC (mkName x) []) (Set.toList xs)
+              | otherwise         = [NormalC (mkName $ "No" ++ s) []]
+
+    derivs = [''Read, ''Show]
diff --git a/src/Data/API/Doc.hs b/src/Data/API/Doc.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Doc.hs
@@ -0,0 +1,21 @@
+module Data.API.Doc
+    ( callHtml
+    , dirHtml
+    , Call(..)
+    , Header(..)
+    , Param(..)
+    , View(..)
+    , Sample(..)
+    , Body(..)
+    , DocInfo(..)
+    , URL
+    , HTTPMethod
+    , StatusCode
+    , renderAPIType
+    , renderBodyType
+    , mk_link
+    ) where
+
+import           Data.API.Doc.Call
+import           Data.API.Doc.Dir
+import           Data.API.Doc.Types
diff --git a/src/Data/API/Doc/Call.hs b/src/Data/API/Doc/Call.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Doc/Call.hs
@@ -0,0 +1,297 @@
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
+
+module Data.API.Doc.Call
+    ( callHtml
+    ) where
+
+import           Data.API.Doc.Subst
+import           Data.API.Doc.Types
+
+import           Data.List
+import           Data.Ord
+
+
+-- | Generate a web page documenting a 'Call'
+callHtml :: DocInfo -> Dict -> Call -> String
+callHtml di dct0 call@Call{..} = concat
+    [ container_open            dct
+    , headersHtml       di call dct
+    , paramsHtml        di call dct
+    , bodyHtml          di call dct
+    , viewsHtml         di call dct
+    , samplesHtml       di call dct
+    ]
+  where
+    dct = flip extDict dct0
+            [ (,) "HTTP-METHOD"    $ call_http_method
+            , (,) "PATH"           $ ('/' :) $ concat $ intersperse "/" call_path
+            , (,) "CALL-DESCRIPTION" call_description
+            , (,) "AUTH-REQUIRED"  $ if call_auth_required then "yes" else "no"
+            ]
+
+headersHtml :: DocInfo -> Call -> Dict -> String
+headersHtml di Call{..} c_dct =
+    case call_headers of
+      [] -> ""
+      _  -> concat
+                [ headers_head
+                , concatMap mk_header $ sortBy (comparing header_name) call_headers
+                , headers_foot
+                ]
+  where
+    mk_header hdr = header_content $ call_dict_header di c_dct hdr
+
+
+paramsHtml :: DocInfo -> Call -> Dict -> String
+paramsHtml di Call{..} c_dct =
+    case call_params of
+      [] -> no_params c_dct
+      _  -> concat
+                [ params_head c_dct
+                , paramsRows di c_dct call_params
+                , params_foot c_dct
+                ]
+
+paramsRows :: DocInfo -> Dict -> [Param] -> String
+paramsRows di c_dct = concatMap mk_param . sortBy (comparing param_name)
+  where
+    mk_param param = parameter_row $ call_dict_param di c_dct param
+
+bodyHtml :: DocInfo -> Call -> Dict -> String
+bodyHtml di Call{..} c_dct =
+    case call_body of
+      Nothing        -> ""
+      Just (typ,spl) ->
+            body_sample $
+                flip extDict c_dct
+                    [ (,) "BODY-TYPE"   (renderAPIType di typ)
+                    , (,) "BODY-SAMPLE" spl
+                    ]
+
+viewsHtml :: DocInfo -> Call -> Dict -> String
+viewsHtml di Call{..} c_dct
+  | null call_views = ""
+  | otherwise = concat [ views_head
+                       , concatMap (view_content . view_dict) call_views
+                       , views_foot
+                       , concatMap view_detailed call_views
+                       ]
+  where
+    view_dict vw = flip extDict c_dct
+                            [ (,) "VIEW-ID"   $ view_id vw
+                            , (,) "VIEW-TYPE" $ renderAPIType di $ view_type vw
+                            , (,) "VIEW-DOC"  $ view_doc vw
+                            ]
+
+    view_detailed vw
+      | null (view_params vw) = ""
+      | otherwise = concat [ view_detail_head v_dct
+                           , paramsRows di v_dct $ view_params vw
+                           , view_detail_foot
+                           ]
+      where v_dct = view_dict vw
+
+samplesHtml :: DocInfo -> Call -> Dict -> String
+samplesHtml di Call{..} c_dct = concat
+    [ sample_heading    c_dct
+    , concat $ map mk_sample call_samples
+    ]
+  where
+    mk_sample spl = sample s_dct
+      where
+        s_dct = call_dict_sample di c_dct spl
+
+call_dict_header :: DocInfo -> Dict -> Header -> Dict
+call_dict_header di dct Header{..} = flip extDict dct
+    [ (,) "HEADER-NAME"        header_name
+    , (,) "HEADER-OR"        $ if header_required then "Required" else "Optional"
+    , (,) "HEADER-EXAMPLE"     header_expl
+    , (,) "HEADER-DESC"        header_desc
+    , (,) "HEADER-TYPE"      $ renderAPIType di header_type
+    ]
+
+call_dict_param :: DocInfo -> Dict -> Param -> Dict
+call_dict_param di dct Param{..} = flip extDict dct
+    [ (,) "PARAMETER-NAME"        param_name
+    , (,) "PARAMETER-OR"        $ if param_required then "Required" else "Optional"
+    , (,) "PARAMETER-EXAMPLE"     param_expl
+    , (,) "PARAMETER-DESC"        param_desc
+    , (,) "PARAMETER-TYPE"      $ either id (renderAPIType di) param_type
+    ]
+
+call_dict_sample :: DocInfo -> Dict -> Sample -> Dict
+call_dict_sample di dct Sample{..} = flip extDict dct
+    [ (,) "HTTP-STATUS"         $ show sample_status
+    , (,) "SAMPLE-TYPE"         $ renderBodyType di sample_type
+    , (,) "SAMPLE-RESPONSE"     $ maybe "" id sample_response
+    ]
+
+
+container_open :: Dict -> String
+container_open dct = prep dct
+    [ "    <nav class='breadcrumbs'>"
+    , "        <a href='<<BC-HOME-URL>>'><<BC-HOME-TEXT>></a> &raquo; <<HTTP-METHOD>> <<PATH>>"
+    , "    </nav>"
+    , "    <h2>"
+    , "        <<HTTP-METHOD>> <<PATH>>"
+    , "    </h2>"
+    , "    <br>"
+    , "    <div class='description'>"
+    , "        <p><<CALL-DESCRIPTION>></p>"
+    , "    </div>"
+    , "    <table border='0' cellspacing='3' cellpadding='0' class='details-table'>"
+    , "        <tr>"
+    , "            <td width='180'><strong>Request Method</strong></td>"
+    , "            <td><code><<HTTP-METHOD>></code>&nbsp;</td>"
+    , "        </tr>"
+    , "        <tr>"
+    , "            <td width='180'><strong>Resource URI</strong></td>"
+    , "            <td><code><<ENDPOINT>><<PATH>></code>&nbsp;</td>"
+    , "        </tr>"
+    , "        <tr>"
+    , "            <td width='180'><strong>Authentication Required</strong></td>"
+    , "            <td><code>"
+    , "                <<AUTH-REQUIRED>>"
+    , "                </code>&nbsp;"
+    , "            </td>"
+    , "        </tr>"
+--  , "        <tr>"
+--  , "            <td width='180'><strong>Request Body</strong></td>"
+--  , "            <td><b>" ++ mkLink dct "POST-NODE-URL"  "POST-NODE" ++ "</b></td>"
+--  , "        </tr>"
+    , "    </table>"
+    , "    <br>"
+    , "    <hr/>"
+    ]
+
+headers_head :: String
+headers_head = unlines
+    [ "    <br>"
+    , "    <h3>Headers</h3>"
+    , "    <br>"
+    , "    <table border='0' cellspacing='0' cellpadding='0' width='100%' id='headers'>"
+    ]
+
+header_content :: Dict -> String
+header_content dct = prep dct
+    [ "        <tr>"
+    , "            <td><code><<HEADER-NAME>></code></td>"
+    , "            <td><em><<HEADER-OR>></em></td>"
+    , "            <td class='details'><p><<HEADER-TYPE>></p></td>"
+    , "            <td class='details'><p><tt><<HEADER-EXAMPLE>></tt></p></td>"
+    , "            <td class='details'><p><<HEADER-DESC>></p></td>"
+    , "        </tr>"
+    ]
+
+headers_foot :: String
+headers_foot = "</table><br>"
+
+
+no_params :: Dict -> String
+no_params dct = prep dct
+    [ "    <br>"
+    , "    <h3>Parameters</h3>"
+    , "    <br>"
+    , "    <em>There are no parameters for this resource.</em>"
+    , "    <br>"
+    ]
+
+params_head :: Dict -> String
+params_head dct = prep dct
+    [ "    <br>"
+    , "    <h3>Parameters</h3>"
+    , "    <br>"
+    , "    <table border='0' cellspacing='0' cellpadding='0' width='100%' id='params' class='params'>"
+    ]
+
+
+
+parameter_row :: Dict -> String
+parameter_row dct = prep dct
+    [ "        <tr>"
+    , "            <td width='130'><code><<PARAMETER-NAME>></code></td>"
+    , "            <td width='75'>"
+    , "                <em>"
+    , "                <<PARAMETER-OR>>"
+    , "                </em>"
+    , "            </td>"
+    , "            <td class='details'>"
+    , "                <p><<PARAMETER-TYPE>></p>"
+    , "            </td>"
+    , "            <td class='details'>"
+    , "                <p><tt><<PARAMETER-EXAMPLE>></tt></p>"
+    , "            </td>"
+    , "            <td class='details'>"
+    , "                <p><<PARAMETER-DESC>></p>"
+    , "            </td>"
+    , "        </tr>"
+    ]
+
+
+params_foot :: Dict -> String
+params_foot dct = prep dct
+    [ "    </table>"
+    ]
+
+body_sample :: Dict -> String
+body_sample dct = prep dct
+    [ "    <br>"
+    , "    <h3>Sample Body</h3>"
+    , "    <br>"
+    , "    <div class='response-format'>"
+    , "        <<BODY-TYPE>>"
+    , "    </div>"
+    , "    <pre><<BODY-SAMPLE>></pre>"
+    ]
+
+
+views_head :: String
+views_head = unlines
+    [ "    <br>"
+    , "    <h3>Views</h3>"
+    , "    <br>"
+    , "    <table border='0' cellspacing='0' cellpadding='0' width='100%' id='views'>"
+    ]
+
+view_content :: Dict -> String
+view_content dct = prep dct
+    [ "        <tr>"
+    , "            <td width='130'><code><<VIEW-ID>></code></td>"
+    , "            <td class='details'><p><<VIEW-TYPE>></p></td>"
+    , "            <td class='details'><p><<VIEW-DOC>></p></td>"
+    , "        </tr>"
+    ]
+
+views_foot :: String
+views_foot = "</table><br>"
+
+
+view_detail_head :: Dict -> String
+view_detail_head dct = prep dct
+    [ "    <br>"
+    , "    <h3>Parameters for <code><<VIEW-ID>></code> view :: <<VIEW-TYPE>></h3>"
+    , "    <br>"
+    , "    <table border='0' cellspacing='0' cellpadding='0' width='100%' class='params view-detail' id='view-<<VIEW-ID>>'>"
+    ]
+
+view_detail_foot :: String
+view_detail_foot = "</table>"
+
+
+
+sample_heading :: Dict -> String
+sample_heading dct = prep dct
+    [ "    <br>"
+    , "    <h3>Sample Responses</h3>"
+    , "    <br>"
+    ]
+
+sample :: Dict -> String
+sample dct = prep dct
+    [ "    <div class='response-format'>"
+    , "        <<SAMPLE-TYPE>>"
+    , "        <span>HTTP Status: <<HTTP-STATUS>></span>"
+    , "    </div>"
+    , "    <pre><<SAMPLE-RESPONSE>></pre>"
+    ]
diff --git a/src/Data/API/Doc/Dir.hs b/src/Data/API/Doc/Dir.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Doc/Dir.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
+
+module Data.API.Doc.Dir
+    ( dirHtml
+    ) where
+
+import           Data.API.Doc.Types
+import           Data.API.Doc.Subst
+import           Data.List
+import           Data.Ord
+import           Data.Char
+
+
+-- | Generate a web page documenting all the 'Call's in a web
+-- application
+dirHtml :: DocInfo -> Dict -> [Call] -> String
+dirHtml di dct cls = concat
+    [ container_open                 dct
+    , concat $ map (resourceHtml di  dct) $ aggregate cls
+    ]
+
+aggregate :: [Call] -> [(String,[Call])]
+aggregate = map f . groupBy eq . sortBy (comparing fst) . map x_r
+  where
+    x_r cl@Call{..} =
+        case call_path of
+          []     -> ("/" ,cl)
+          rsrc:_ -> (rsrc,cl)
+
+    eq (x,_) (y,_)   = x==y
+
+    f []             = error "Data.API.Doc.Dir.aggregate"
+    f ((rsrc,cl):ps) = (rsrc,cl:map snd ps)
+
+
+resourceHtml :: DocInfo -> Dict -> (String,[Call]) -> String
+resourceHtml di dct (rsc,cls) = concat
+    [ resource_heading      r_dct
+    , ul_open               r_dct
+    , concat [ callHtml di  r_dct cl | cl<-cls ]
+    , ul_close              r_dct
+    ]
+  where
+    r_dct = resource_dict dct rsc
+
+resource_dict :: Dict -> String -> Dict
+resource_dict dct rsc = flip extDict dct
+    [ (,) "RESOURCE-HEADING"    rsc
+    ]
+
+callHtml :: DocInfo -> Dict -> Call -> String
+callHtml di dct cl = call $ call_dict di dct cl
+
+call_dict :: DocInfo -> Dict -> Call -> Dict
+call_dict di dct Call{..} = flip extDict dct
+    -- calls
+    [ (,) "CALL-URL"          $ doc_info_call_url di call_http_method call_path
+    , (,) "METHOD-CLASS"      $ map toLower mth_s
+    , (,) "METHOD"            $ mth_s
+    , (,) "PATH"              $ '/' : concat (intersperse "/" call_path)
+    , (,) "BODY-TYPE"         $ maybe "&mdash;" (renderAPIType di . fst) call_body
+    ]
+  where
+    mth_s = call_http_method
+--    cvt   = T.unpack . _APINodeName
+
+container_open :: Dict -> String
+container_open dct = prep dct
+    [ "<h2>"
+    , "   <<TITLE>>"
+    , "   <span class='tagline'><<TAGLINE>></span>"
+    , "</h2>"
+    , "<strong>Endpoint: </strong><<ENDPOINT>>"
+    , "<br>"
+    , "<div id='toc'>"
+    , "   <div id='app-description'>"
+    , "      <p><<SUMMARY>></p>"
+    , "   </div>"
+    , "   <hr/>"
+    , "   <br>"
+    , "   <h3 class='section-title'>"
+    , "      API Resources for This Application"
+    , "   </h3>"
+    ]
+
+resource_heading :: Dict -> String
+resource_heading dct = prep dct
+    [ "   <h5 class='tag'><<RESOURCE-HEADING>></h5>"
+    ]
+
+ul_open :: Dict -> String
+ul_open dct = prep dct
+    [ "   <ul class='list resource-list'>"
+    ]
+
+call :: Dict -> String
+call dct = prep dct
+    [ "      <li >"
+    , "         <a class='reflink' href='<<CALL-URL>>'>"
+    , "         <span class='<<METHOD-CLASS>>'><<METHOD>></span>"
+    , "         <<PATH>>"
+    , "         </a>"
+    , "         <div class='post-data' ><<BODY-TYPE>></div>"
+    , "      </li>"
+    ]
+
+ul_close :: Dict -> String
+ul_close dct = prep dct
+    [ "   </ul>"
+    ]
diff --git a/src/Data/API/Doc/Subst.hs b/src/Data/API/Doc/Subst.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Doc/Subst.hs
@@ -0,0 +1,40 @@
+module Data.API.Doc.Subst
+    ( Dict
+    , subst
+    , prep
+    , mkDict
+    , extDict
+    )
+    where
+
+import qualified Data.Map               as Map
+import           Text.Regex
+import           Safe
+
+
+type Dict = Map.Map String String
+
+
+subst_re :: Regex
+subst_re = mkRegexWithOpts "<<[a-zA-Z0-9_'-]+>>" True True
+
+subst :: Dict -> String -> String
+subst dct str =
+    case matchRegexAll subst_re str of
+      Nothing               -> str
+      Just (pre,var_,pst,_) -> pre ++ rpl ++ subst dct pst
+          where
+            rpl = maybe ("<<"++var++">>") id $ Map.lookup var dct
+
+            var = chp $ reverse $ chp $ reverse var_
+            
+            chp = tailNote "subst.chp" . tailNote "subst.chp"
+
+prep :: Dict -> [String] -> String
+prep dct = unlines . map (subst dct) 
+
+mkDict :: [(String,String)] -> Dict
+mkDict = Map.fromList
+
+extDict :: [(String,String)] -> Dict -> Dict
+extDict al dct = foldr (uncurry Map.insert) dct al
diff --git a/src/Data/API/Doc/Types.hs b/src/Data/API/Doc/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Doc/Types.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
+
+module Data.API.Doc.Types
+    ( URL
+    , HTTPMethod
+    , StatusCode
+    , Call(..)
+    , Header(..)
+    , Param(..)
+    , View(..)
+    , Sample(..)
+    , Body(..)
+    , DocInfo(..)
+    , renderAPIType
+    , renderBodyType
+    , mk_link
+    ) where
+
+import           Data.API.Types
+
+import           Text.Printf
+
+type URL        = String
+type HTTPMethod = String
+type StatusCode = Int
+
+-- | Documents a single method call on a resource in a web application
+data Call
+    = Call
+        { call_http_method   :: HTTPMethod               -- ^ HTTP method being documented
+        , call_path          :: [String]                 -- ^ Relative URL path of the resource
+        , call_description   :: String                   -- ^ Free-form text description
+        , call_auth_required :: Bool                     -- ^ Does the call require authentication?
+        , call_headers       :: [Header]                 -- ^ HTTP headers relevant to the call
+        , call_body          :: Maybe (APIType, String)  -- ^ Type and example of request body
+        , call_params        :: [Param]                  -- ^ Query parameters relevant to the call
+        , call_views         :: [View]                   -- ^ Available views of the result data
+        , call_samples       :: [Sample]                 -- ^ Example responses
+        }
+    deriving (Show)
+
+-- | Documents a HTTP header that may be supplied to a 'Call'
+data Header
+    = Header
+        { header_name     :: String  -- ^ Header name
+        , header_expl     :: String  -- ^ Example value for header
+        , header_desc     :: String  -- ^ Free-form text description
+        , header_type     :: APIType -- ^ Type of data in header
+        , header_required :: Bool    -- ^ Is including the header with the request mandatory?
+        } deriving (Show)
+
+-- | Documents a URL query parameter that may be included with a 'Call'
+data Param
+    = Param
+        { param_name     :: String                -- ^ Parameter name
+        , param_expl     :: String                -- ^ Example value for parameter
+        , param_desc     :: String                -- ^ Free-form text description
+        , param_type     :: Either String APIType -- ^ Type of data in the parameter
+        , param_required :: Bool                  -- ^ Is including the parameter mandatory?
+        } deriving (Show)
+
+-- | Documents a specific view of the result data available in a 'Call'
+data View
+    = View
+        { view_id     :: String  -- ^ View name
+        , view_type   :: APIType -- ^ Type of result data returned
+        , view_doc    :: String  -- ^ Free-form text description
+        , view_params :: [Param] -- ^ Query parameters that may be supplied for this view
+        } deriving (Show)
+
+-- | Example response data from a 'Call'
+data Sample
+    = Sample
+        { sample_status   :: StatusCode    -- ^ HTTP status code for this example response
+        , sample_type     :: Body APIType  -- ^ Type of example response
+        , sample_response :: Maybe String  -- ^ Content of response, or 'Nothing' for empty response
+        } deriving (Show)
+
+-- | Type for 'Sample' response body, parameterised by possible JSON types
+data Body t = EmptyBody        -- ^ An empty response
+            | JSONBody  t      -- ^ A JSON response of the given type
+            | OtherBody String -- ^ A non-empty, non-JSON response
+  deriving (Functor, Show)
+
+-- | Record of arguments that must be supplied to generate HTML
+-- documentation for a 'Call'
+data DocInfo
+    = DocInfo
+        { doc_info_call_url :: HTTPMethod -> [String] -> URL
+          -- ^ URL for individual call documentation from the index
+        , doc_info_type_url :: TypeName -> URL
+          -- ^ URL for documentation of an API type
+        }
+
+renderBodyType :: DocInfo -> Body APIType -> String
+renderBodyType _  EmptyBody     = "empty"
+renderBodyType di (JSONBody ty) = "json&nbsp;&nbsp;" ++ renderAPIType di ty
+renderBodyType _  (OtherBody s) = s
+
+renderAPIType :: DocInfo -> APIType -> String
+renderAPIType di (TyList  ty  ) = "[" ++ renderAPIType di ty ++ "]"
+renderAPIType di (TyMaybe ty  ) = "?" ++ renderAPIType di ty
+renderAPIType di (TyName  tn  ) = mk_link (doc_info_type_url di tn) (_TypeName tn)
+renderAPIType _  (TyBasic bt  ) = renderBasicType bt
+renderAPIType _  TyJSON         = "json"
+
+renderBasicType :: BasicType -> String
+renderBasicType BTstring{} = "string"
+renderBasicType BTbinary{} = "binary"
+renderBasicType BTbool  {} = "bool"
+renderBasicType BTint   {} = "int"
+renderBasicType BTutc   {} = "utc"
+
+mk_link :: URL -> String -> String
+mk_link = printf "<b><a class='reflink' href='%s' >%s</a></b>"
diff --git a/src/Data/API/JSON.hs b/src/Data/API/JSON.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/JSON.hs
@@ -0,0 +1,415 @@
+{-# LANGUAGE DefaultSignatures          #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+-- | This module defines a JSON parser, like Aeson's 'FromJSON', but
+-- with more detailed error-reporting capabilities.  In particular, it
+-- reports errors in a structured format, and can report multiple
+-- independent errors rather than stopping on the first one
+-- encountered.
+module Data.API.JSON
+    ( -- * Representation of JSON parsing errors
+      JSONError(..)
+    , Expected(..)
+    , FormatExpected(..)
+    , Position
+    , Step(..)
+    , prettyJSONErrorPositions
+    , prettyJSONError
+    , prettyStep
+
+      -- * Parser with multiple error support
+    , ParserWithErrs
+    , runParserWithErrsTop
+
+      -- * FromJSON class with multiple error support
+    , FromJSONWithErrs(..)
+    , fromJSONWithErrs
+    , decodeWithErrs
+
+      -- * ParserWithErrs combinators
+    , failWith
+    , expectedArray
+    , expectedBool
+    , expectedInt
+    , expectedObject
+    , expectedString
+    , badFormat
+    , withInt
+    , withNum
+    , withIntRange
+    , withBinary
+    , withBool
+    , withText
+    , withRegEx
+    , withUTC
+    , withUTCRange
+    , withVersion
+    , withField
+    , (.:.)
+    , (.::)
+    ) where
+
+import           Data.API.Types
+import           Data.API.Utils
+
+import           Control.Applicative
+import qualified Data.Aeson                     as JS
+import           Data.Aeson.TH
+import           Data.Attoparsec.Number
+import           Data.Attoparsec.Text
+import qualified Data.ByteString.Char8          as B
+import qualified Data.ByteString.Base64         as B64
+import qualified Data.ByteString.Lazy           as BL
+import qualified Data.HashMap.Strict            as HMap
+import           Data.List
+import           Data.Maybe
+import qualified Data.SafeCopy                  as SC
+import qualified Data.Text                      as T
+import           Data.Time
+import           Data.Traversable
+import qualified Data.Vector                    as V
+import           Data.Version
+import           Distribution.Text
+import           Text.Regex
+
+----------------------------------------------------------
+-- Representation of JSON parsing errors and positions
+--
+
+-- | Represents an error that can be encountered while parsing
+data JSONError = Expected  Expected       String JS.Value
+               | BadFormat FormatExpected String T.Text
+               | MissingField
+               | MissingAlt [String]
+               | UnexpectedField
+               | UnexpectedEnumVal [T.Text] T.Text
+               | IntRangeError String Int IntRange
+               | UTCRangeError String UTCTime UTCRange
+               | RegexError String T.Text RegEx
+               | SyntaxError String
+  deriving (Eq, Show)
+
+-- | JSON type expected at a particular position, when a value of a
+-- different type was encountered
+data Expected = ExpArray
+              | ExpBool
+              | ExpInt
+              | ExpObject
+              | ExpString
+  deriving (Eq, Show)
+
+-- | Special format expected of a string
+data FormatExpected = FmtBinary
+                    | FmtUTC
+                    | FmtOther
+  deriving (Eq, Show)
+
+expectedArray, expectedBool, expectedInt, expectedObject, expectedString
+  :: JS.Value -> JSONError
+expectedArray  = Expected ExpArray    "Array"
+expectedBool   = Expected ExpBool     "Bool"
+expectedInt    = Expected ExpInt      "Int"
+expectedObject = Expected ExpObject   "Object"
+expectedString = Expected ExpString   "String"
+
+badFormat :: String -> T.Text -> JSONError
+badFormat = BadFormat FmtOther
+
+-- | Human-readable description of a JSON parse error
+prettyJSONError :: JSONError -> String
+prettyJSONError (Expected _ s v)      = "When expecting " ++ s ++ ", encountered "
+                                        ++ x ++ " instead"
+  where
+    x = case v of
+          JS.Object _ -> "Object"
+          JS.Array _  -> "Array"
+          JS.String _ -> "String"
+          JS.Number _ -> "Number"
+          JS.Bool _   -> "Boolean"
+          JS.Null     -> "Null"
+prettyJSONError (BadFormat _ s t)     = "Could not parse as " ++ s ++ " the string " ++ show t
+prettyJSONError MissingField          = "Field missing from Object"
+prettyJSONError (MissingAlt xs)       = "Missing alternative, expecting one of: "
+                                          ++ intercalate ", " xs
+prettyJSONError UnexpectedField       = "Unexpected field in Object"
+prettyJSONError (UnexpectedEnumVal xs t) = "Unexpected enum value " ++ show t
+                                           ++ ", expecting one of: "
+                                           ++ T.unpack (T.intercalate ", " xs)
+prettyJSONError (IntRangeError s i r) = s ++ ": " ++ show i ++ " not in range " ++ show r
+prettyJSONError (UTCRangeError s u r) = s ++ ": " ++ show u ++ " not in range " ++ show r
+prettyJSONError (RegexError s _ t)    = s ++ ": failed to match RE: " ++ show t
+prettyJSONError (SyntaxError e)       = "JSON syntax error: " ++ e
+
+-- | A position inside a JSON value is a list of steps, ordered
+-- innermost first (so going inside an object prepends a step).
+type Position = [Step]
+
+-- | Each step may be into a field of an object, or a specific element
+-- of an array.
+data Step = InField T.Text | InElem Int
+  deriving (Eq, Show)
+
+-- | Human-readable description of a single step in a position
+prettyStep :: Step -> String
+prettyStep (InField f) = "  in the field " ++ show f
+prettyStep (InElem i)  = "  in array index " ++ show i
+
+-- | Human-readable presentation of a list of parse errors with their
+-- positions
+prettyJSONErrorPositions :: [(JSONError, Position)] -> String
+prettyJSONErrorPositions xs = unlines $ concatMap help xs
+  where
+    help (e, pos) = prettyJSONError e : map prettyStep pos
+
+
+----------------------------------------
+-- Parser with multiple error support
+--
+
+-- | Like 'Parser', but keeping track of locations within the JSON
+-- structure and able to report multiple errors.
+--
+-- Careful! The 'Monad' instance does not agree with the 'Applicative'
+-- instance in all circumstances, and you should use the 'Applicative'
+-- instance where possible.  In particular:
+--
+--    * @pf \<*\> ps@ returns errors from both arguments
+--
+--    * @pf \`ap\` ps@  returns errors from @pf@ only
+newtype ParserWithErrs a = ParserWithErrs {
+    runParserWithErrs :: Position -> Either [(JSONError, Position)] a }
+  deriving Functor
+
+instance Applicative ParserWithErrs where
+  pure x    = ParserWithErrs $ const $ Right x
+  pf <*> ps = ParserWithErrs $ \ z ->
+                  case (runParserWithErrs pf z, runParserWithErrs ps z) of
+                      (Right f, Right s)  -> Right $ f s
+                      (Left es, Right _)  -> Left es
+                      (Right _, Left es)  -> Left es
+                      (Left es, Left es') -> Left $ es ++ es'
+
+instance Alternative ParserWithErrs where
+  empty   = failWith $ SyntaxError "No alternative"
+  px <|> py = ParserWithErrs $ \ z -> case runParserWithErrs px z of
+                                        Right v -> Right v
+                                        Left  _ -> runParserWithErrs py z
+
+instance Monad ParserWithErrs where
+  return   = pure
+  px >>= f = ParserWithErrs $ \ z ->
+                  case runParserWithErrs px z of
+                    Right x -> runParserWithErrs (f x) z
+                    Left es -> Left es
+  fail     = failWith . SyntaxError
+
+runParserWithErrsTop :: ParserWithErrs a -> Either [(JSONError, Position)] a
+runParserWithErrsTop p = runParserWithErrs p []
+
+
+--------------------------------------------------
+-- FromJSON class with multiple error support
+--
+
+-- | Like 'FromJSON', but keeping track of multiple errors and their
+-- positions.  Moreover, this class is more liberal in accepting
+-- invalid inputs:
+--
+-- * a string like @\"3\"@ is accepted as an integer; and
+--
+-- * the integers @0@ and @1@ are accepted as booleans.
+
+class FromJSONWithErrs a where
+  -- | Parse a JSON value with structured error-reporting support.  If
+  -- this method is omitted, 'fromJSON' will be used instead: note
+  -- that this will result in less precise errors.
+  parseJSONWithErrs :: JS.Value -> ParserWithErrs a
+  default parseJSONWithErrs :: JS.FromJSON a => JS.Value -> ParserWithErrs a
+  parseJSONWithErrs v = case JS.fromJSON v of
+                      JS.Error e   -> failWith $ SyntaxError e
+                      JS.Success a -> pure a
+
+instance FromJSONWithErrs JS.Value where
+  parseJSONWithErrs = pure
+
+instance FromJSONWithErrs () where
+  parseJSONWithErrs (JS.Array a) | V.null a  = pure ()
+  parseJSONWithErrs _                        = failWith $ SyntaxError "Expected empty array"
+
+instance FromJSONWithErrs a => FromJSONWithErrs (Maybe a) where
+  parseJSONWithErrs JS.Null = pure Nothing
+  parseJSONWithErrs v       = Just <$> parseJSONWithErrs v
+
+instance FromJSONWithErrs a => FromJSONWithErrs [a] where
+  parseJSONWithErrs (JS.Array a) = traverse help $ zip (V.toList a) [0..]
+    where
+      help (x, i) = stepInside (InElem i) $ parseJSONWithErrs x
+  parseJSONWithErrs v            = failWith $ expectedArray v
+
+instance FromJSONWithErrs Int where
+  parseJSONWithErrs = withInt "Int" pure
+
+instance FromJSONWithErrs Integer where
+  parseJSONWithErrs = withNum "Integer" pure
+
+instance FromJSONWithErrs Bool where
+  parseJSONWithErrs = withBool "Bool" pure
+
+instance FromJSONWithErrs Binary where
+  parseJSONWithErrs = withBinary "Binary" pure
+
+instance FromJSONWithErrs T.Text where
+  parseJSONWithErrs = withText "Text" pure
+
+instance FromJSONWithErrs UTCTime where
+  parseJSONWithErrs = withUTC "UTC" pure
+
+instance FromJSONWithErrs Version where
+  parseJSONWithErrs = withVersion "Version" pure
+
+
+-- | Run the JSON parser on a value to produce a result or a list of
+-- errors with their positions.  This should not be used inside an
+-- implementation of 'parseJSONWithErrs' as it will not pass on the
+-- current position.
+fromJSONWithErrs :: FromJSONWithErrs a => JS.Value -> Either [(JSONError, Position)] a
+fromJSONWithErrs = runParserWithErrsTop . parseJSONWithErrs
+
+-- | Decode a 'ByteString' and run the JSON parser
+decodeWithErrs :: FromJSONWithErrs a => BL.ByteString -> Either [(JSONError, Position)] a
+decodeWithErrs x = case JS.eitherDecode x of
+                     Left e  -> Left [(SyntaxError e, [])]
+                     Right v -> fromJSONWithErrs v
+
+
+---------------------------------
+-- ParserWithErrs combinators
+--
+
+failWith :: JSONError -> ParserWithErrs a
+failWith e = ParserWithErrs $ \ z -> Left [(e, z)]
+
+stepInside :: Step -> ParserWithErrs a -> ParserWithErrs a
+stepInside s p = ParserWithErrs $ \ z -> runParserWithErrs p (s:z)
+
+-- | If this parser returns any errors at the current position, modify
+-- them using the supplied function.
+modifyTopError :: (JSONError -> JSONError)
+               -> ParserWithErrs a -> ParserWithErrs a
+modifyTopError f p = ParserWithErrs $ \ z -> case runParserWithErrs p z of
+                                               Left es -> Left $ map (modifyIfAt z) es
+                                               r       -> r
+  where
+    modifyIfAt z x@(e, z') | z == z'   = (f e, z')
+                           | otherwise = x
+
+
+-- It's contrary to my principles, but I'll accept a string containing
+-- a number instead of an actual number...
+withInt :: String -> (Int -> ParserWithErrs a) -> JS.Value -> ParserWithErrs a
+withInt = withNum
+
+withNum :: Num n => String -> (n -> ParserWithErrs a) -> JS.Value -> ParserWithErrs a
+withNum _ f (JS.Number (I n)) = f (fromInteger n)
+withNum _ f (JS.String s)
+  | Right (I n) <- parseOnly (number <* endOfInput) s = f (fromInteger n)
+withNum s _ v = failWith $ Expected ExpInt s v
+
+withIntRange :: IntRange -> String -> (Int -> ParserWithErrs a)
+             -> JS.Value -> ParserWithErrs a
+withIntRange ir dg f = withInt dg g
+  where
+    g i | i `inIntRange` ir = f i
+        | otherwise         = failWith $ IntRangeError dg i ir
+
+    _ `inIntRange` IntRange Nothing   Nothing   = True
+    i `inIntRange` IntRange (Just lo) Nothing   = lo <= i
+    i `inIntRange` IntRange Nothing   (Just hi) = i <= hi
+    i `inIntRange` IntRange (Just lo) (Just hi) = lo <= i && i <= hi
+
+withBinary :: String -> (Binary -> ParserWithErrs a) -> JS.Value -> ParserWithErrs a
+withBinary lab f = withText lab g
+  where
+    g t =
+        case B64.decode $ B.pack $ T.unpack t of
+          Left  _  -> failWith $ BadFormat FmtBinary lab t
+          Right bs -> f $ Binary bs
+
+-- Everyone knows 0 and 1 are booleans really...
+withBool :: String -> (Bool -> ParserWithErrs a)
+         -> JS.Value -> ParserWithErrs a
+withBool _ f (JS.Bool b) = f b
+withBool _ f (JS.Number (I i)) | i == 0 = f False
+                               | i == 1 = f True
+withBool s _ v           = failWith $ Expected ExpBool s v
+
+withText :: String -> (T.Text -> ParserWithErrs a)
+         -> JS.Value -> ParserWithErrs a
+withText _ f (JS.String t) = f t
+withText s _ v             = failWith $ Expected ExpString s v
+
+withRegEx :: RegEx -> String -> (T.Text -> ParserWithErrs a)
+               -> JS.Value -> ParserWithErrs a
+withRegEx re dg f = withText dg g
+  where
+    g txt = case matchRegex (re_regex re) $ T.unpack txt of
+              Just _  -> f txt
+              Nothing -> failWith $ RegexError dg txt re
+
+withUTC :: String -> (UTCTime -> ParserWithErrs a)
+        -> JS.Value -> ParserWithErrs a
+withUTC lab f = withText lab g
+  where
+    g t = maybe (failWith $ BadFormat FmtUTC lab t) f $ parseUTC' t
+
+withUTCRange :: UTCRange -> String -> (UTCTime -> ParserWithErrs a)
+               -> JS.Value -> ParserWithErrs a
+withUTCRange ur dg f = withUTC dg g
+  where
+    g u | u `inUTCRange` ur = f u
+        | otherwise         = failWith $ UTCRangeError dg u ur
+
+    _ `inUTCRange` UTCRange Nothing   Nothing   = True
+    u `inUTCRange` UTCRange (Just lo) Nothing   = lo <= u
+    u `inUTCRange` UTCRange Nothing   (Just hi) = u <= hi
+    u `inUTCRange` UTCRange (Just lo) (Just hi) = lo <= u && u <= hi
+
+withVersion :: String -> (Version -> ParserWithErrs a)
+            -> JS.Value -> ParserWithErrs a
+withVersion lab f (JS.String s) = case simpleParse $ T.unpack s of
+                                    Just ver -> f ver
+                                    Nothing  -> failWith $ badFormat lab s
+withVersion lab _ v             = failWith $ Expected ExpString lab v
+
+-- | Look up the value of a field, treating missing fields as null
+withField :: T.Text -> (JS.Value -> ParserWithErrs a)
+          -> JS.Object -> ParserWithErrs a
+withField k f m = stepInside (InField k) $ modifyTopError treatAsMissing $ f v
+  where
+    v = fromMaybe JS.Null $ HMap.lookup k m
+    treatAsMissing (Expected _ _ JS.Null) = MissingField
+    treatAsMissing e                      = e
+
+-- | Look up the value of a field, failing on missing fields
+withStrictField :: T.Text -> (JS.Value -> ParserWithErrs a)
+          -> JS.Object -> ParserWithErrs a
+withStrictField k f m = stepInside (InField k) $ case HMap.lookup k m of
+                            Nothing -> failWith MissingField
+                            Just r  -> f r
+
+-- | Parse the value of a field, treating missing fields as null
+(.:.) :: FromJSONWithErrs a => JS.Object -> T.Text -> ParserWithErrs a
+m .:. k = withField k parseJSONWithErrs m
+
+-- | Parse the value of a field, failing on missing fields
+(.::) :: FromJSONWithErrs a => JS.Object -> T.Text -> ParserWithErrs a
+m .:: k = withStrictField k parseJSONWithErrs m
+
+
+deriveJSON defaultOptions ''JSONError
+deriveJSON defaultOptions ''Expected
+deriveJSON defaultOptions ''FormatExpected
+deriveJSON defaultOptions ''Step
+$(SC.deriveSafeCopy 1 'SC.base ''Step)
diff --git a/src/Data/API/Markdown.hs b/src/Data/API/Markdown.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Markdown.hs
@@ -0,0 +1,250 @@
+{-# LANGUAGE RecordWildCards            #-}
+
+-- | This module generates Markdown-formatted documentation for an
+-- API, like this:
+--
+-- > ###Foo
+-- >
+-- > a test defn
+-- >
+-- > JSON Type : **union object** (Haskell prefix is 'foo')
+-- >
+-- > | Alternative | Type    | Comment
+-- > | ----------- | ------- | -----------
+-- > | _`Baz`_     | boolean | just a bool
+-- > | _`Qux`_     | integer | just an int
+
+module Data.API.Markdown
+    ( markdown
+    , MarkdownMethods(..)
+    , defaultMarkdownMethods
+    , thing
+    ) where
+
+import           Data.API.Types
+import           Data.API.Utils
+
+import qualified Data.CaseInsensitive       as CI
+import           Data.Char
+import           Text.Printf
+import           Control.Applicative
+import           Control.Lens
+
+
+data MarkdownMethods
+    = MDM
+        { mdmSummaryPostfix :: TypeName -> MDComment
+        , mdmLink           :: TypeName -> MDComment
+        , mdmPp             :: MDComment -> MDComment -> MDComment
+        , mdmFieldDefault   :: FieldName -> APIType -> Maybe DefaultValue
+        }
+
+defaultMarkdownMethods :: MarkdownMethods
+defaultMarkdownMethods =
+    MDM { mdmSummaryPostfix = const ""
+        , mdmLink           = _TypeName
+        , mdmPp             = (++)
+        , mdmFieldDefault   = \ _ _ -> Nothing
+        }
+
+-- | Create human-readable API documentation in Markdown format
+markdown :: MarkdownMethods -> API -> MDComment
+markdown mdm ths = foldr (thing mdm) "" ths
+
+-- | Document a single API comment or node in Markdown format
+thing :: MarkdownMethods -> Thing -> MDComment  -> MDComment
+thing mdm th tl_md =
+    case th of
+      ThComment md -> mdmPp mdm md tl_md
+      ThNode    an -> node  mdm an tl_md
+
+node :: MarkdownMethods -> APINode -> MDComment -> MDComment
+node mdm an tl_md =
+        header mdm an $ body mdm an $ version an $ "\n\n" ++ tl_md
+
+header :: MarkdownMethods -> APINode -> MDComment -> MDComment
+header mdm an tl_md =
+                                printf "###%s\n\n%s\n\n%s" nm_md (mdmPp mdm cm_md "") tl_md
+  where
+    nm_md = type_name_md an
+    cm_md = comment_md   an
+
+body :: MarkdownMethods -> APINode -> MDComment  -> MDComment
+body mdm an tl_md =
+    case anSpec an of
+      SpNewtype sn -> block tl_md $ ntype   mdm an sn
+      SpRecord  sr -> block tl_md $ record  mdm an sr
+      SpUnion   su -> block tl_md $ union_  mdm an su
+      SpEnum    se -> block tl_md $ enum_   mdm an se
+      SpSynonym ty -> block tl_md $ synonym mdm an ty
+
+ntype :: MarkdownMethods -> APINode -> SpecNewtype -> [MDComment]
+ntype mdm an sn =
+    summary_lines mdm an (basic_type_md $ snType sn) ++ [f ftr | Just ftr<-[snFilter sn]]
+  where
+    f (FtrStrg RegEx{..}   ) = "**filter** " ++ show re_text
+    f (FtrIntg IntRange{..}) = "**filter** " ++ rg show   ir_lo ir_hi
+    f (FtrUTC  UTCRange{..}) = "**filter** " ++ rg mkUTC_ ur_lo ur_hi
+
+    rg _  Nothing   Nothing   = "**no restriction**" -- should not happen (not produced by parser)
+    rg sh Nothing   (Just hi) = "x <= " ++ sh hi
+    rg sh (Just lo) Nothing   = sh lo ++ " <= x"
+    rg sh (Just lo) (Just hi) = sh lo ++ " <= x <= " ++ sh hi
+
+record :: MarkdownMethods -> APINode -> SpecRecord -> [MDComment]
+record mdm an sr =
+    summary_lines mdm an "record object" ++ mk_md_record_table mdm (srFields sr)
+
+union_ :: MarkdownMethods -> APINode -> SpecUnion -> [MDComment]
+union_ mdm an su =
+    summary_lines mdm an "union object" ++ mk_md_union_table mdm (suFields su)
+
+enum_ :: MarkdownMethods -> APINode -> SpecEnum -> [MDComment]
+enum_ mdm an SpecEnum{..} =
+    summary_lines mdm an "string enumeration" ++ map f (hdr : dhs : rws)
+  where
+    f (fnm,cmt)  = ljust lnx fnm ++ " | " ++ cmt
+
+    dhs          = (replicate lnx '-',replicate 7 '-')
+
+    lnx          = maximum $ 0 : map (length . _FieldName . fst) seAlts
+
+    rws          = map fmt seAlts
+
+    hdr          = ("Enumeration","Comment")
+
+    fmt (fn0,ct) = (_FieldName fn0,mdmPp mdm "" $ cln ct)
+
+    cln ct       = reverse $ dropWhile isSpace $ reverse $ map tr ct
+      where
+        tr '\n' = ' '
+        tr c    = c
+
+synonym :: MarkdownMethods -> APINode -> APIType -> [MDComment]
+synonym mdm an ty = summary_lines mdm an $ type_md mdm ty
+
+mk_md_record_table :: MarkdownMethods -> [(FieldName, FieldType)] -> [MDComment]
+mk_md_record_table mdm fds = map f $ hdr : dhs : rws
+  where
+    f          = if all (null . view _4) rws then f3 else f4
+
+    f3 (x,y,z,_) = ljust lnx x ++ " | " ++ ljust lny y ++ " | " ++ z
+    f4 (x,y,z,a) = ljust lnx x ++ " | " ++ ljust lny y ++ " | " ++ ljust lnz z ++ " | " ++ a
+
+    dhs  = (replicate lnx '-',replicate lny '-',replicate lnz '-',replicate 7 '-')
+
+    lnx  = maximum $ map (length . view _1) $ hdr : rws
+    lny  = maximum $ map (length . view _2) $ hdr : rws
+    lnz  = maximum $ map (length . view _3) $ hdr : rws
+
+    hdr  = ("Field","Type","Default","Comment")
+
+    rws  = map fmt fds
+
+    fmt (fn0,fty) = ( fn, type_md mdm ty, flg_md, mdmPp mdm "" $ cleanComment ct )
+      where
+        fn  = _FieldName fn0
+        ty  = ftType fty
+        ct  = ftComment fty
+
+        flg_md | ftReadOnly fty = "*read-only*"
+               | otherwise      = default_md $ ftDefault fty
+
+        default_md mb_dv = maybe "" (backticks . default_value)
+                                 (mdmFieldDefault mdm fn0 ty <|> mb_dv)
+        backticks s = "`" ++ s ++ "`"
+
+mk_md_union_table :: MarkdownMethods ->
+                            [(FieldName, (APIType, MDComment))] -> [MDComment]
+mk_md_union_table mdm fds = map f $ hdr : dhs : rws
+  where
+    f          = if all (null . view _3) rws then f2 else f3
+
+    f2 (x,y,_)  = ljust lnx x ++ " | " ++ y
+    f3 (x,y,z)  = ljust lnx x ++ " | " ++ ljust lny y ++ " | " ++ z
+
+    dhs  = (replicate lnx '-',replicate lny '-',replicate 7 '-')
+
+    lnx  = maximum $ map (length . view _1) $ hdr : rws
+    lny  = maximum $ map (length . view _2) $ hdr : rws
+
+    hdr  = ("Alternative","Type","Comment")
+
+    rws  = map fmt fds
+
+    fmt (fn0,(ty,ct)) = ("_" ++ fn ++ "_",type_md mdm ty,mdmPp mdm "" $ cleanComment ct)
+      where
+        fn  = _FieldName fn0
+
+cleanComment :: MDComment -> MDComment
+cleanComment ct = reverse $ dropWhile isSpace $ reverse $ map tr ct
+      where
+        tr '\n' = ' '
+        tr c    = c
+
+summary_lines :: MarkdownMethods -> APINode -> String -> [MDComment]
+summary_lines mdm an smy =
+    [ printf "JSON Type : **%s** [Haskell prefix is `%s`] %s" smy pfx pst
+    , ""
+    ]
+  where
+    pfx = prefix_md         an
+    pst = mdmSummaryPostfix mdm $ anName an
+
+default_value :: DefaultValue -> MDComment
+default_value dv =
+    case dv of
+      DefValList     -> "[]"
+      DefValMaybe    -> "null"
+      DefValString t -> show t
+      DefValBool   b -> map toLower $ show b
+      DefValInt    i -> show i
+      DefValUtc    u -> show $ mkUTC_ u
+
+type_md :: MarkdownMethods -> APIType -> MDComment
+type_md mdm ty =
+    case ty of
+      TyList  ty'  -> "[" ++ type_md mdm ty' ++ "]"
+      TyMaybe ty'  -> "? " ++ type_md mdm ty'
+      TyName  nm   -> mdmLink mdm nm
+      TyBasic bt   -> basic_type_md bt
+      TyJSON       -> "json"
+
+basic_type_md :: BasicType -> MDComment
+basic_type_md bt =
+    case bt of
+      BTstring -> "string"
+      BTbinary -> "base64 string"
+      BTbool   -> "boolean"
+      BTint    -> "integer"
+      BTutc    -> "utc"
+
+type_name_md, prefix_md, comment_md :: APINode -> MDComment
+type_name_md = _TypeName   . anName
+prefix_md    = CI.original . anPrefix
+comment_md   =               anComment
+
+block :: MDComment -> [MDComment] -> MDComment
+block tl_md cmts = unlines cmts ++ tl_md
+
+version :: APINode -> MDComment -> MDComment
+version _ tl_md = tl_md
+
+ljust :: Int -> String -> String
+ljust fw s = s ++ replicate p ' '
+  where
+    p = max 0 $ fw - length s
+
+{-
+pp :: MarkdownMethods -> MDComment -> MDComment -> MDComment
+pp mdm s0 tl_md = pp0 s0
+  where
+    pp0 []    = tl_md
+    pp0 (c:t) =
+        case c of
+          '{' -> pp1 $ break ('}' ==) t
+          _   -> c : pp0 t
+
+    pp1 (nm,[] ) = '{' : nm ++ tl_md
+    pp1 (nm,_:t) = mdmLink mdm (TypeName nm) ++ pp0 t
+-}
diff --git a/src/Data/API/PP.hs b/src/Data/API/PP.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/PP.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+-- | A cheap and cheerful pretty-printing library
+module Data.API.PP
+    ( PP(..)
+    , PPLines(..)
+    , inFrontOf
+    , indent
+    ) where
+
+import           Data.API.JSON
+import           Data.API.Types
+
+import qualified Data.Aeson                     as JS
+import qualified Data.Aeson.Encode.Pretty       as JS
+import qualified Data.ByteString.Lazy.Char8     as BL
+import           Data.List
+import           Data.Set (Set)
+import qualified Data.Set                       as Set
+import qualified Data.Text                      as T
+import           Data.Version
+
+
+class PP t where
+  pp :: t -> String
+
+class PPLines t where
+  ppLines :: t -> [String]
+
+
+inFrontOf :: String -> [String] -> [String]
+inFrontOf x []     = [x]
+inFrontOf x (s:ss) = (x ++ s) : ss
+
+indent :: [String] -> [String]
+indent = map ("  " ++)
+
+
+instance PP [Char] where
+  pp = id
+
+instance PP Version where
+  pp = showVersion
+
+instance PP t => PP (Set t) where
+  pp s = intercalate ", " (map pp $ Set.toList s)
+
+instance PP T.Text where
+  pp = T.unpack
+
+instance PPLines JS.Value where
+  ppLines v = lines $ BL.unpack $ JS.encodePretty v
+
+instance PP TypeName where
+  pp = _TypeName
+
+instance PP FieldName where
+  pp = _FieldName
+
+instance PP APIType where
+  pp (TyList  ty) = "[" ++ pp ty ++ "]"
+  pp (TyMaybe ty) = "? " ++ pp ty
+  pp (TyName  t)  = pp t
+  pp (TyBasic b)  = pp b
+  pp  TyJSON      = "json"
+
+instance PP BasicType where
+  pp BTstring = "string"
+  pp BTbinary = "binary"
+  pp BTbool   = "bool"
+  pp BTint    = "integer"
+  pp BTutc    = "utc"
+
+instance PP DefaultValue where
+  pp DefValList           = "[]"
+  pp DefValMaybe          = "nothing"
+  pp (DefValString t)     = show t
+  pp (DefValBool   True)  = "true"
+  pp (DefValBool   False) = "false"
+  pp (DefValInt    i)     = show i
+  pp (DefValUtc    u)     = show u
+
+
+instance PPLines t => PPLines [t] where
+  ppLines = concatMap ppLines
+
+instance (PPLines s, PPLines t) => PPLines (s, t) where
+  ppLines (s, t) = ppLines s ++ ppLines t
+
+instance PPLines Step where
+  ppLines s = [prettyStep s]
diff --git a/src/Data/API/Parse.y b/src/Data/API/Parse.y
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Parse.y
@@ -0,0 +1,368 @@
+{
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+
+module Data.API.Parse
+    ( parseAPI
+    , parseAPIWithChangelog
+    , api
+    , apiWithChangelog
+    ) where
+
+import           Data.API.Types
+import           Data.API.Scan
+import           Data.API.Changes
+import           Data.Char
+import           Data.String
+import qualified Data.Text                  as T
+import qualified Data.CaseInsensitive       as CI
+import qualified Data.Version               as V
+import           Distribution.Text (simpleParse)
+import           Language.Haskell.TH.Quote
+import           Text.Printf
+import           Text.Regex
+}
+
+%name parse                API
+%name parse_with_changelog APIWithChangelog
+
+%tokentype { PToken }
+
+
+%token
+    ';'                                 { (,) _ Semi            }
+    '|'                                 { (,) _ Bar             }
+    '['                                 { (,) _ Bra             }
+    ']'                                 { (,) _ Ket             }
+    '::'                                { (,) _ ColCol          }
+    '='                                 { (,) _ Equals          }
+    '?'                                 { (,) _ Query           }
+    ','                                 { (,) _ Comma           }
+    '<='                                { (,) _ LtEq            }
+    '>='                                { (,) _ GtEq            }
+    version                             { (,) _ Version         }
+    with                                { (,) _ With            }
+    integer                             { (,) _ Integer         }
+    boolean                             { (,) _ Boolean         }
+    utc                                 { (,) _ UTC             }
+    string                              { (,) _ String          }
+    binary                              { (,) _ BInary          }
+    json                                { (,) _ Json            }
+    record                              { (,) _ Record          }
+    union                               { (,) _ Union           }
+    enum                                { (,) _ Enum            }
+    basic                               { (,) _ Basic           }
+    changes                             { (,) _ Changes         }
+    added                               { (,) _ Added           }
+    removed                             { (,) _ Removed         }
+    renamed                             { (,) _ Renamed         }
+    changed                             { (,) _ Changed         }
+    default                             { (,) _ Default         }
+    field                               { (,) _ Field           }
+    alternative                         { (,) _ Alternative     }
+    migration                           { (,) _ Migration       }
+    to                                  { (,) _ To              }
+    nothing                             { (,) _ NOTHING         }
+    readonly                            { (,) _ Readonly        }
+    comment                             { (,) _ (Comment  $$)   }
+    typeiden                            { (,) _ (TypeIden $$)   }
+    variden                             { (,) _ (VarIden  $$)   }
+    intlit                              { (,) _ (Intg     $$)   }
+    strlit                              { (,) _ (Strg     $$)   }
+    true                                { (,) _ TRUE            }
+    false                               { (,) _ FALSE           }
+    utclit                              { (,) _ (UTCTIME  $$)   }
+
+
+%%
+
+APIWithChangelog :: { APIWithChangelog }
+APIWithChangelog
+    : API changes APIChangelog          { ($1, $3)                          }
+
+API :: { API }
+API : RAPI                              { reverse $1                        }
+
+RAPI :: { [Thing] }
+RAPI
+    : RAPI ';' Thing                    { $3 : $1                           }
+    |                                   { []                                }
+
+Thing :: { Thing }
+Thing
+    : Node                              { ThNode    $1                      }
+    | Comments                          { ThComment $1                      }
+
+Node :: { APINode }
+Node
+    : Prefix '::' typeiden Comments '=' Spec With
+                                        { APINode (TypeName $3) $4 $1 $6 $7 }
+
+Spec :: { Spec }
+Spec
+    : Record                            { SpRecord  $1                      }
+    | Union                             { SpUnion   $1                      }
+    | Enum                              { SpEnum    $1                      }
+    | Basic                             { SpNewtype $1                      }
+    | Type                              { SpSynonym $1                      }
+
+With :: { Conversion }
+With
+    : with FieldName ',' FieldName      { Just ($2,$4)                      }
+    |                                   { Nothing                           }
+
+Comments :: { MDComment }
+Comments
+    : RCommentList                      { unlines $ reverse $1              }
+
+RCommentList :: { [MDComment] }
+RCommentList
+    : RCommentList comment              { $2 : $1                           }
+    |                                   { []                                }
+
+Prefix :: { Prefix }
+Prefix
+    : VarIdentifier                     { CI.mk $1                          }
+
+Record :: { SpecRecord }
+Record
+    : record RRFields                   { SpecRecord $ reverse $2           }
+
+Union :: { SpecUnion }
+Union
+    : union  RUFields                   { SpecUnion  $ reverse $2           }
+
+RRFields :: { [(FieldName, FieldType)] }
+RRFields
+    : RRFields FieldName '::' FieldType {  ($2,$4) : $1                     }
+    |          FieldName '::' FieldType { [($1,$3)]                         }
+
+FieldType :: { FieldType }
+FieldType
+    : Type IsReadOnly MayBasicLit Comments
+                                        { FieldType $1 $2 $3 $4             }
+
+IsReadOnly :: { Bool }
+    : readonly                          { True                              }
+    |                                   { False                             }
+
+RUFields :: { [(FieldName,(APIType,MDComment))] }
+RUFields
+    : RUFields '|' FieldName '::' Type Comments
+                                        {  ($3,($5,$6)) : $1                }
+    |          '|' FieldName '::' Type Comments
+                                        { [($2,($4,$5))]                    }
+
+Enum :: { SpecEnum }
+Enum
+    : enum REnums                       { SpecEnum $ reverse $2             }
+
+REnums :: { [(FieldName,MDComment)] }
+REnums
+    : REnums '|' FieldName Comments     { ($3,$4) : $1                      }
+    |        '|' FieldName Comments     { [($2,$3)]                         }
+
+Basic :: { SpecNewtype }
+    : basic BasicType MbFilter          { SpecNewtype $2 $3                 }
+
+MbFilter :: { Maybe Filter }
+    : '|' Filter                        { Just $2                           }
+    |                                   { Nothing                           }
+
+Filter :: { Filter }
+    : RegEx                        { FtrStrg $1                             }
+    | '>=' intlit                  { FtrIntg $ IntRange (Just $2) Nothing   }
+    | '>=' intlit ',' '<=' intlit  { FtrIntg $ IntRange (Just $2) (Just $5) }
+    | '<=' intlit                  { FtrIntg $ IntRange Nothing   (Just $2) }
+    | '>=' utclit                  { FtrUTC  $ UTCRange (Just $2) Nothing   }
+    | '>=' utclit ',' '<=' utclit  { FtrUTC  $ UTCRange (Just $2) (Just $5) }
+    | '<=' utclit                  { FtrUTC  $ UTCRange Nothing   (Just $2) }
+
+RegEx :: { RegEx }
+    : strlit                            { RegEx (T.pack $1) $ mkRegexWithOpts $1 False True }
+
+Type :: { APIType }
+Type
+    : '?' Type                          { TyMaybe            $2             }
+    | '[' Type ']'                      { TyList             $2             }
+    | typeiden                          { TyName   (TypeName $1)            }
+    | BasicType                         { TyBasic            $1             }
+    | json                              { TyJSON                            }
+
+MayBasicLit :: { Maybe DefaultValue }
+    : DefaultValue                      { Just $1                           }
+    |                                   { Nothing                           }
+
+BasicType :: { BasicType }
+BasicType
+    : string                            { BTstring                          }
+    | binary                            { BTbinary                          }
+    | boolean                           { BTbool                            }
+    | integer                           { BTint                             }
+    | utc                               { BTutc                             }
+
+FieldName :: { FieldName }
+FieldName
+    : VarIdentifier                     { FieldName $1                      }
+
+VarIdentifier :: { String }
+    : variden                           { $1                                }
+    | default                           { "default"                         }
+    | field                             { "field"                           }
+    | alternative                       { "alternative"                     }
+    | to                                { "to"                              }
+
+TypeName :: { TypeName }
+    : typeiden                          { TypeName $1                       }
+
+APIChangelog :: { APIChangelog }
+APIChangelog
+    : version VersionExtra Changes ';' APIChangelog { ChangesUpTo $2 $3 $5  }
+    | version Version                          { ChangesStart $2            }
+    | Comments ';' APIChangelog                { $3                         }
+
+Version :: { V.Version }
+    : strlit                            { parseVer $1                       }
+
+VersionExtra :: { VersionExtra }
+    : strlit                            { parseVersionExtra $1              }
+
+Changes :: { [APIChange] }
+    : RChanges                          { concat (reverse $1)               }
+
+RChanges :: { [[APIChange]] }
+    : RChanges Change                   { $2 : $1                           }
+    |                                   { []                                }
+
+Change :: { [APIChange] }
+    : added TypeName Spec               { [ChAddType $2 (declNF $3)]        }
+    | removed TypeName                  { [ChDeleteType $2]                 }
+    | renamed TypeName to TypeName      { [ChRenameType $2 $4]              }
+    | changed record TypeName RFieldChanges { map (fldChangeToAPIChange $3)   (reverse $4) }
+    | changed union  TypeName RUnionChanges { map (unionChangeToAPIChange $3) (reverse $4) }
+    | changed enum   TypeName REnumChanges  { map (enumChangeToAPIChange $3)  (reverse $4) }
+    | migration record TypeName MigrationTag { [ChCustomRecord $3 $4]       }
+    | migration MigrationTag             { [ChCustomAll $2]                 }
+    | comment                            { []                               }
+
+RFieldChanges :: { [FieldChange] }
+    : RFieldChanges FieldChange         { $2 ++ $1                           }
+    | FieldChange                       { $1                                 }
+
+FieldChange :: { [FieldChange] }
+    : field added FieldName '::' Type MbDefaultValue           { [FldChAdd $3 $5 $6]    }
+    | field removed FieldName                                  { [FldChDelete $3]       }
+    | field renamed FieldName to FieldName                     { [FldChRename $3 $5]    }
+    | field changed FieldName '::' Type migration MigrationTag { [FldChChange $3 $5 $7] }
+    | comment                                                  { []                     }
+
+MbDefaultValue :: { Maybe DefaultValue }
+    : default DefaultValue             { Just $2                            }
+    |                                  { Nothing                            }
+
+DefaultValue :: { DefaultValue }
+    : '[' ']'                          { DefValList                         }
+    | nothing                          { DefValMaybe                        }
+    | strlit                           { DefValString (T.pack $1)           }
+    | true                             { DefValBool True                    }
+    | false                            { DefValBool False                   }
+    | intlit                           { DefValInt $1                       }
+    | utclit                           { DefValUtc $1                       }
+
+RUnionChanges :: { [UnionChange] }
+    : RUnionChanges UnionChange        { $2 ++ $1                           }
+    | UnionChange                      { $1                                 }
+
+UnionChange :: { [UnionChange] }
+    : alternative added FieldName '::' Type      { [UnChAdd $3 $5]          }
+    | alternative removed FieldName              { [UnChDelete $3]          }
+    | alternative renamed FieldName to FieldName { [UnChRename $3 $5]       }
+    | comment                                    { []                       }
+
+REnumChanges :: { [EnumChange] }
+    : REnumChanges EnumChange          { $2 ++ $1                           }
+    | EnumChange                       { $1                                 }
+
+EnumChange :: { [EnumChange] }
+    : alternative added FieldName                { [EnChAdd $3]             }
+    | alternative removed FieldName              { [EnChDelete $3]          }
+    | alternative renamed FieldName to FieldName { [EnChRename $3 $5]       }
+    | comment                                    { []                       }
+
+MigrationTag :: { MigrationTag }
+    : typeiden                         { $1                                 }
+
+{
+happyError :: [PToken] -> a
+happyError tks = error $ printf "Syntax error at %s: %s\n" loc $ show (take 5 tks)
+  where
+    loc = case tks of
+            []                    -> "<EOF>"
+            (AlexPn ad ln cn,_):_ -> printf "line %d, column %d (@%d)" ln cn ad
+
+parseAPI :: String -> API
+parseAPI = parse . scan
+
+parseAPIWithChangelog :: String -> APIWithChangelog
+parseAPIWithChangelog = parse_with_changelog . scan
+
+
+data FieldChange = FldChAdd FieldName APIType (Maybe DefaultValue)
+                 | FldChDelete FieldName
+                 | FldChRename FieldName FieldName
+                 | FldChChange FieldName APIType MigrationTag
+
+fldChangeToAPIChange :: TypeName -> FieldChange -> APIChange
+fldChangeToAPIChange t (FldChAdd f ty def)  = ChAddField t f ty def
+fldChangeToAPIChange t (FldChDelete f)      = ChDeleteField t f
+fldChangeToAPIChange t (FldChRename f f')   = ChRenameField t f f'
+fldChangeToAPIChange t (FldChChange f ty m) = ChChangeField t f ty m
+
+data UnionChange = UnChAdd FieldName APIType
+                 | UnChDelete FieldName
+                 | UnChRename FieldName FieldName
+
+unionChangeToAPIChange :: TypeName -> UnionChange -> APIChange
+unionChangeToAPIChange t (UnChAdd f ty)    = ChAddUnionAlt t f ty
+unionChangeToAPIChange t (UnChDelete f)    = ChDeleteUnionAlt t f
+unionChangeToAPIChange t (UnChRename f f') = ChRenameUnionAlt t f f'
+
+data EnumChange = EnChAdd FieldName
+                | EnChDelete FieldName
+                | EnChRename FieldName FieldName
+
+enumChangeToAPIChange :: TypeName -> EnumChange -> APIChange
+enumChangeToAPIChange t (EnChAdd f)       = ChAddEnumVal t f
+enumChangeToAPIChange t (EnChDelete f)    = ChDeleteEnumVal t f
+enumChangeToAPIChange t (EnChRename f f') = ChRenameEnumVal t f f'
+
+
+parseVer :: String -> V.Version
+parseVer x = case simpleParse x of
+                 Just v -> v
+                 Nothing -> error $ "Syntax error while parsing version " ++ x
+
+parseVersionExtra :: String -> VersionExtra
+parseVersionExtra "development" = DevVersion
+parseVersionExtra s             = Release $ parseVer s
+
+
+api :: QuasiQuoter
+api =
+    QuasiQuoter
+        { quoteExp  = \s -> [| parseAPI s |]
+        , quotePat  = error "api QuasiQuoter used in patten      context"
+        , quoteType = error "api QuasiQuoter used in type        context"
+        , quoteDec  = error "api QuasiQuoter used in declaration context"
+        }
+
+apiWithChangelog :: QuasiQuoter
+apiWithChangelog =
+    QuasiQuoter
+        { quoteExp  = \s -> [| parseAPIWithChangelog s |]
+        , quotePat  = error "apiWithChangelog QuasiQuoter used in patten      context"
+        , quoteType = error "apiWithChangelog QuasiQuoter used in type        context"
+        , quoteDec  = error "apiWithChangelog QuasiQuoter used in declaration context"
+        }
+}
diff --git a/src/Data/API/Scan.x b/src/Data/API/Scan.x
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Scan.x
@@ -0,0 +1,192 @@
+{
+{-# OPTIONS_GHC -w #-}
+
+module Data.API.Scan
+    ( scan
+    , PToken
+    , AlexPosn(..)
+    , Token(..)
+    ) where
+
+import           Data.API.Types
+import           Data.API.Utils
+
+import           Data.Char
+import           Data.Time
+import           Safe
+}
+
+%wrapper "posn"
+
+$digit = 0-9            -- digits
+$lower = [a-z_]         -- lower case & _
+$upper = [A-Z]          -- upper case letters
+
+@d2    = $digit{2}
+@d4    = $digit{4}
+
+
+tokens :-
+    $white+                             ;
+    "--".*                              ;
+    "{-"(\n|[^\-]|\-[^\}])*"-}"         ;
+    ";"                                 { simple    Semi            }
+    "|"                                 { simple    Bar             }
+    "["                                 { simple    Bra             }
+    "]"                                 { simple    Ket             }
+    "::"                                { simple    ColCol          }
+    ":"                                 { simple    Colon           }
+    "="                                 { simple    Equals          }
+    "<="                                { simple    LtEq            }
+    ">="                                { simple    GtEq            }
+    "?"                                 { simple    Query           }
+    ","                                 { simple    Comma           }
+    version                             { simple    Version         }
+    with                                { simple    With            }    
+    integer                             { simple    Integer         }
+    boolean                             { simple    Boolean         }
+    utc                                 { simple    UTC             }
+    string                              { simple    String          }
+    binary                              { simple    BInary          }
+    json                                { simple    Json            }
+    record                              { simple    Record          }
+    union                               { simple    Union           }
+    enum                                { simple    Enum            }
+    basic                               { simple    Basic           }
+    changes                             { simple    Changes         }
+    added                               { simple    Added           }
+    removed                             { simple    Removed         }
+    renamed                             { simple    Renamed         }
+    changed                             { simple    Changed         }
+    default                             { simple    Default         }
+    field                               { simple    Field           }
+    alternative                         { simple    Alternative     }
+    migration                           { simple    Migration       }
+    to                                  { simple    To              }
+    nothing                             { simple    NOTHING         }
+    true                                { simple    TRUE            }
+    false                               { simple    FALSE           }
+    read\-only                          { simple    Readonly        }
+    @d4\-@d2\-(@d2)T@d2\:@d2(:@d2)?Z    { utc_                      }
+      $upper [$lower $upper $digit]*    { mk        TypeIden        }
+    \'$upper [$lower $upper $digit]*\'  { strip_qs  TypeIden        }
+      $lower [$lower $upper $digit]*    { mk        VarIden         }
+    \'$lower [$lower $upper $digit]*\'  { strip_qs  VarIden         }
+    \"([^\\\"]|\\[\\\'\"])*\"           { string                    }
+    \-?$digit+                          { intg                      }
+    "//".*                              { line_comment              }
+    "(*"(\n|[^\*]|\*[^\)])*"*)"         { block_comment             }
+
+{
+
+type PToken = (AlexPosn,Token)
+
+data Token
+    = Semi
+    | Bar
+    | BInary
+    | Bra
+    | Ket
+    | ColCol
+    | Colon
+    | Comma
+    | Equals
+    | LtEq
+    | GtEq
+    | Boolean
+    | Integer
+    | UTC
+    | Query
+    | Record
+    | String
+    | Json
+    | Union
+    | Version
+    | With
+    | Enum
+    | Basic
+    | Changes
+    | Added
+    | Removed
+    | Renamed
+    | Changed
+    | Default
+    | Field
+    | Alternative
+    | Migration
+    | To
+    | NOTHING
+    | TRUE
+    | FALSE
+    | Readonly
+    | UTCTIME  UTCTime
+    | Comment  String
+    | TypeIden String
+    | VarIden  String
+    | Intg     Int
+    | Strg     String
+    | ERROR
+    deriving (Eq,Show)
+
+utc_ :: AlexPosn -> String -> PToken
+utc_ = mk $ \s -> maybe ERROR UTCTIME $ parseUTC_ s
+
+line_comment :: AlexPosn -> String -> PToken
+line_comment = mk $ Comment . munch_ws . tailSafe . tailSafe 
+
+block_comment :: AlexPosn -> String -> PToken
+block_comment p (_:_:str) = 
+    case reverse $ munch_ws str of
+      _:_:rc -> (p,Comment $ reverse $ munch_ws rc)
+      _      -> error "Scan.line_comment"
+block_comment _ _ = error "Scan.line_comment" 
+
+strip_qs :: (String->Token) -> AlexPosn -> String -> PToken
+strip_qs f p (_:s) = (p,f $ initNote "Scan.strip_qs" s)
+strip_qs _ _ _     = error "Scan.strip_qs"
+
+munch_ws :: String -> String
+munch_ws = dropWhile isSpace
+
+simple :: Token -> AlexPosn -> String -> PToken
+simple tk = mk $ const tk
+
+intg :: AlexPosn -> String -> PToken
+intg p s = (p,Intg $ readNote "Data.API.Scan.intg" s)
+
+string :: AlexPosn -> String -> PToken
+string = mk (Strg . f . chop)
+  where
+    f ""    = ""
+    f (c:s) = case c of
+                '\\' -> g s
+                _    -> c : f s
+
+    g ""    = ""
+    g (c:s) = c : f s
+
+chop :: String -> String
+chop ""    = ""
+chop (c:s) =
+    case reverse s of
+      ""   -> ""
+      _:rs -> reverse rs
+
+mk :: (String->Token) -> AlexPosn -> String -> PToken
+mk f p s = (p,f s)
+
+scan :: String -> [PToken]
+scan = pp . alexScanTokens
+
+pp :: [PToken] -> [PToken]
+pp [] = []
+pp (pt@(p@(AlexPn _ _ cn),_):inp) =
+    case cn of
+      1 -> (p,Semi):pt:pp inp
+      _ ->          pt:pp inp
+
+test :: IO ()
+test = 
+ do s <- getContents
+    print (scan s)
+}
diff --git a/src/Data/API/TH.hs b/src/Data/API/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/TH.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Data.API.TH
+    ( applicativeE
+    , optionalInstanceD
+    , funSigD
+    , simpleD
+    , simpleSigD
+    ) where
+
+import           Data.API.Tools.Combinators
+
+import           Control.Applicative
+import           Control.Monad
+import           Language.Haskell.TH
+
+
+-- | Construct an idiomatic expression (an expression in an
+-- Applicative context), i.e.
+--     app ke []             => ke
+--     app ke [e1,e2,...,en] => ke <$> e1 <*> e2 ... <*> en
+applicativeE :: ExpQ -> [ExpQ] -> ExpQ
+applicativeE ke es0 =
+    case es0 of
+      []   -> ke
+      e:es -> app' (ke `dl` e) es
+  where
+    app' e []      = e
+    app' e (e':es) = app' (e `st` e') es
+
+    st e1 e2 = appE (appE (varE '(<*>)) e1) e2
+    dl e1 e2 = appE (appE (varE '(<$>)) e1) e2
+
+
+-- | Add an instance declaration for a class, if such an instance does
+-- not already exist
+optionalInstanceD :: ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
+optionalInstanceD stgs c tqs dqs = do
+    ts <- sequence tqs
+    ds <- sequence dqs
+    exists <- isInstance c ts
+    if exists then do when (warnOnOmittedInstance stgs) $ reportWarning $ msg ts
+                      return []
+              else return [InstanceD [] (foldl AppT (ConT c) ts) ds]
+  where
+    msg ts = "instance " ++ pprint c ++ " " ++ pprint ts ++ " already exists, so it was not generated"
+
+
+-- | Construct a TH function with a type signature
+funSigD :: Name -> TypeQ -> [ClauseQ] -> Q [Dec]
+funSigD n t cs = (\ x y -> [x,y]) <$> sigD n t <*> funD n cs
+
+-- | Construct a simple TH definition
+simpleD :: Name -> ExpQ -> Q Dec
+simpleD n e = funD n [clause [] (normalB e) []]
+
+-- | Construct a simple TH definition with a type signature
+simpleSigD :: Name -> TypeQ -> ExpQ -> Q [Dec]
+simpleSigD n t e = funSigD n t [clause [] (normalB e) []]
diff --git a/src/Data/API/Tools.hs b/src/Data/API/Tools.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools.hs
@@ -0,0 +1,62 @@
+-- | This module provides an interface for generating TH declarations
+-- from an 'API'.  To use it, splice in a call to 'generate' followed
+-- by one or more calls to 'generateAPITools', like so:
+--
+-- > $(generate myAPI)
+-- > $(generateAPITools [enumTool, jsonTool, quickCheckTool] myAPI)
+--
+-- If you wish to override any of the instances generated by the
+-- tools, you can do so by writing instance declarations after the
+-- call to 'generate' but before the call to 'generateAPITools'.
+
+module Data.API.Tools
+    ( generate
+    , generateAPITools
+
+      -- * Tool settings
+    , generateAPIToolsWith
+    , defaultToolSettings
+    , warnOnOmittedInstance
+
+      -- * Individual tools
+    , enumTool
+    , exampleTool
+    , jsonTool
+    , jsonTestsTool
+    , lensTool
+    , quickCheckTool
+    , safeCopyTool
+    , samplesTool
+    ) where
+
+import           Data.API.Tools.Combinators
+import           Data.API.Tools.Datatypes
+import           Data.API.Tools.Enum
+import           Data.API.Tools.Example
+import           Data.API.Tools.JSON
+import           Data.API.Tools.JSONTests
+import           Data.API.Tools.Lens
+import           Data.API.Tools.QuickCheck
+import           Data.API.Tools.SafeCopy
+import           Data.API.Types
+
+import           Data.Monoid
+import           Language.Haskell.TH
+
+
+-- | Generate the datatypes corresponding to an API.
+generate :: API -> Q [Dec]
+generate api = generateAPITools api [datatypesTool]
+
+-- | Apply a list of tools to an 'API', generating TH declarations.
+-- See the individual tool descriptions for details.  Note that
+-- 'generate' must be called first, and some tools have dependencies,
+-- which must be included in the same or a preceding call to
+-- 'generateAPITools'.
+generateAPITools :: API -> [APITool] -> Q [Dec]
+generateAPITools = generateAPIToolsWith defaultToolSettings
+
+-- | Apply a list of tools to an 'API', generating TH declarations.
+-- This form allows the 'ToolSettings' to be overridden.
+generateAPIToolsWith :: ToolSettings -> API -> [APITool] -> Q [Dec]
+generateAPIToolsWith ts api tools = runTool (mconcat tools) ts api
diff --git a/src/Data/API/Tools/Combinators.hs b/src/Data/API/Tools/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools/Combinators.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Data.API.Tools.Combinators
+    ( Tool
+    , APITool
+    , APINodeTool
+    , runTool
+
+      -- * Smart constructors and combinators
+    , simpleTool
+    , mkTool
+    , contramapTool
+    , subTools
+    , apiNodeTool
+    , apiDataTypeTool
+    , apiSpecTool
+
+      -- * Tool settings
+    , ToolSettings
+    , warnOnOmittedInstance
+    , defaultToolSettings
+    ) where
+
+import           Data.API.Types
+
+import           Control.Applicative
+import           Data.Monoid
+import           Language.Haskell.TH
+
+
+-- | Settings to control the behaviour of API tools.  This record may
+-- be extended in the future, so you should construct a value by
+-- overriding individual fields of 'defaultToolSettings'.
+data ToolSettings = ToolSettings
+    { warnOnOmittedInstance :: Bool
+      -- ^ Generate a warning when an instance declaration is omitted
+      -- because it already exists
+    }
+
+-- | Default settings designed to be overridden.
+defaultToolSettings :: ToolSettings
+defaultToolSettings = ToolSettings
+    { warnOnOmittedInstance = False
+    }
+
+-- | A @'Tool' a@ is something that can generate TH declarations from
+-- a value of type @a@.  Tools can be combined using the 'Monoid'
+-- instance.
+newtype Tool a   = Tool
+    { runTool :: ToolSettings -> a -> Q [Dec]
+      -- ^ Execute a tool to generate some TH declarations.
+    }
+
+type APITool     = Tool API
+type APINodeTool = Tool APINode
+
+instance Monoid (Tool a) where
+  mempty                    = Tool $ \ _ _ -> return []
+  Tool t1 `mappend` Tool t2 = Tool $ \ ts x -> (++) <$> t1 ts x <*> t2 ts x
+
+-- | Construct a tool that does not depend on any settings
+simpleTool :: (a -> Q [Dec]) -> Tool a
+simpleTool f = Tool $ const f
+
+-- | Construct a tool that may depend on the settings
+mkTool :: (ToolSettings -> a -> Q [Dec]) -> Tool a
+mkTool = Tool
+
+-- | 'Tool' is a contravariant functor
+contramapTool :: (a -> b) -> Tool b -> Tool a
+contramapTool f t = Tool $ \ ts a -> runTool t ts (f a)
+
+-- | Apply a tool that acts on elements of a list to the entire list
+subTools :: Tool a -> Tool [a]
+subTools t = Tool $ \ ts as -> concat <$> mapM (runTool t ts) as
+
+-- | Apply a tool that acts on nodes to an entire API
+apiNodeTool :: Tool APINode -> Tool API
+apiNodeTool = contramapTool (\ api -> [an | ThNode an <- api ]) . subTools
+
+-- | Apply a tool that acts on datatype nodes (i.e. those that are not
+-- synonyms) to an entire API
+apiDataTypeTool :: Tool APINode -> Tool API
+apiDataTypeTool = contramapTool (\ api -> [an | ThNode an <- api, hasDataType $ anSpec an ]) . subTools
+  where
+    hasDataType (SpSynonym _) = False
+    hasDataType _             = True
+
+-- | Create a tool that acts on nodes from its action on individual
+-- specs.
+apiSpecTool :: Tool (APINode, SpecNewtype)
+            -> Tool (APINode, SpecRecord )
+            -> Tool (APINode, SpecUnion  )
+            -> Tool (APINode, SpecEnum   )
+            -> Tool (APINode, APIType    )
+            -> Tool APINode
+apiSpecTool n r u e s = Tool $ \ ts an -> case anSpec an of
+              SpNewtype sn -> runTool n ts (an, sn)
+              SpRecord  sr -> runTool r ts (an, sr)
+              SpUnion   su -> runTool u ts (an, su)
+              SpEnum    se -> runTool e ts (an, se)
+              SpSynonym ss -> runTool s ts (an, ss)
diff --git a/src/Data/API/Tools/Datatypes.hs b/src/Data/API/Tools/Datatypes.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools/Datatypes.hs
@@ -0,0 +1,207 @@
+{-# LANGUAGE TemplateHaskell            #-}
+module Data.API.Tools.Datatypes
+    ( datatypesTool
+    , type_nm
+    , rep_type_nm
+    , nodeT
+    , nodeRepT
+    , nodeConE
+    , nodeFieldE
+    , nodeAltConE
+    , nodeAltConP
+    , newtypeProjectionE
+    ) where
+
+import           Data.API.Tools.Combinators
+import           Data.API.Types
+
+import           Data.Aeson
+import qualified Data.CaseInsensitive           as CI
+import           Data.Char
+import           Data.String
+import qualified Data.Text                      as T
+import           Data.Time
+import           Data.Typeable
+import           Language.Haskell.TH
+
+
+-- | Tool to generate datatypes and type synonyms corresponding to an API
+datatypesTool :: APITool
+datatypesTool = apiNodeTool $ apiSpecTool (simpleTool $ uncurry gen_sn_dt)
+                                          (simpleTool $ uncurry gen_sr_dt)
+                                          (simpleTool $ uncurry gen_su_dt)
+                                          (simpleTool $ uncurry gen_se_dt)
+                                          (simpleTool $ uncurry gen_sy)
+
+
+-- | Generate a type synonym definition
+gen_sy :: APINode -> APIType -> Q [Dec]
+gen_sy as ty = return [TySynD (type_nm as) [] $ mk_type ty]
+
+
+-- | Generate a newtype definition, like this:
+--
+-- > newtype JobId = JobId { _JobId :: T.Text }
+-- >     deriving (Show,IsString,Eq,Typeable)
+
+gen_sn_dt :: APINode -> SpecNewtype -> Q [Dec]
+gen_sn_dt as sn = return [NewtypeD [] nm [] c $ derive_leaf_nms ++ iss]
+  where
+    c   = RecC nm [(newtype_prj_nm as,NotStrict,mk_type $ TyBasic (snType sn))]
+
+    nm  = rep_type_nm as
+
+    iss = case snType sn of
+            BTstring -> [''IsString]
+            BTbinary -> []
+            BTbool   -> []
+            BTint    -> []
+            BTutc    -> []
+
+
+
+-- | Generate a record type definition, like this:
+--
+-- > data JobSpecId
+-- >     = JobSpecId
+-- >         { _jsi_id         :: JobId
+-- >         , _jsi_input      :: JSInput
+-- >         , _jsi_output     :: JSOutputStatus
+-- >         , _jsi_pipelineId :: PipelineId
+-- >         }
+-- >     deriving (Show,Eq,Typeable)
+
+gen_sr_dt :: APINode -> SpecRecord -> Q [Dec]
+gen_sr_dt as sr = return [DataD [] nm [] cs derive_node_nms] -- [show_nm,eq_nm]
+  where
+    cs = [RecC nm [(pref_field_nm as fnm,IsStrict,mk_type (ftType fty)) |
+                                                (fnm,fty)<-srFields sr]]
+
+    nm = rep_type_nm as
+
+
+-- | Generate a union type definition, like this:
+--
+-- > data Foo = F_Bar Int | F_Baz Bool
+-- >     deriving (Show,Typeable)
+
+gen_su_dt :: APINode -> SpecUnion -> Q [Dec]
+gen_su_dt as su = return [DataD [] nm [] cs derive_node_nms] -- [show_nm,eq_nm]
+  where
+    cs = [NormalC (pref_con_nm as fnm) [(IsStrict,mk_type ty)] |
+                                            (fnm,(ty,_))<-suFields su]
+
+    nm = rep_type_nm as
+
+
+-- | Generate an enum type definition, like this:
+--
+-- > data FrameRate
+-- >     = FR_auto
+-- >     | FR_10
+-- >     | FR_15
+-- >     | FR_23_97
+-- >     | FR_24
+-- >     | FR_25
+-- >     | FR_29_97
+-- >     | FR_30
+-- >     | FR_60
+-- >     deriving (Show,Eq,Ord,Bounded,Enum,Typeable)
+
+gen_se_dt :: APINode -> SpecEnum -> Q [Dec]
+gen_se_dt as se = return [DataD [] nm [] cs $ derive_leaf_nms ++ [''Bounded, ''Enum]]
+  where
+    cs = [NormalC (pref_con_nm as fnm) [] | (fnm,_) <- seAlts se ]
+
+    nm = rep_type_nm as
+
+
+mk_type :: APIType -> Type
+mk_type ty =
+    case ty of
+      TyList  ty'  -> AppT ListT  $ mk_type ty'
+      TyMaybe ty'  -> AppT (ConT ''Maybe) $ mk_type ty'
+      TyName  nm   -> ConT  $ mkName $ _TypeName nm
+      TyBasic bt   -> basic_type bt
+      TyJSON       -> ConT ''Value
+
+basic_type :: BasicType -> Type
+basic_type bt =
+    case bt of
+      BTstring -> ConT ''T.Text
+      BTbinary -> ConT ''Binary
+      BTbool   -> ConT ''Bool
+      BTint    -> ConT ''Int
+      BTutc    -> ConT ''UTCTime
+
+
+derive_leaf_nms :: [Name]
+derive_leaf_nms = [''Show,''Eq,''Ord,''Typeable]
+
+derive_node_nms :: [Name]
+derive_node_nms = [''Show,''Eq,''Typeable]
+
+
+-- | Name of the type corresponding to the API node, e.g. @JobId@
+type_nm :: APINode -> Name
+type_nm an = mkName $ _TypeName $ anName an
+
+-- | Name of the representation type corresponding to the API node,
+-- which differs from the 'type_nm' only if custom conversion
+-- functions are specified.  This is also the name of the sole
+-- constructor for newtypes and records.
+rep_type_nm :: APINode -> Name
+rep_type_nm an = mkName $ rep_type_s an
+
+-- | Name of the single field in a newtype, prefixed by an underscore,
+-- e.g. @_JobId@
+newtype_prj_nm :: APINode -> Name
+newtype_prj_nm an = mkName $ "_" ++ rep_type_s an
+
+rep_type_s :: APINode -> String
+rep_type_s an = f $ _TypeName $ anName an
+  where
+    f s = maybe s (const ("REP__"++s)) $ anConvert an
+
+-- | Construct the name of a record field by attaching the
+-- type-specific prefix, in lowercase, e.g. @_jsi_id@
+pref_field_nm :: APINode -> FieldName -> Name
+pref_field_nm as fnm = mkName $ pre ++ _FieldName fnm
+  where
+    pre = "_" ++ map toLower (CI.original $ anPrefix as) ++ "_"
+
+-- | Construct the name of a union or enum constructor by attaching
+-- the type-specific prefix, in uppercase, e.g. @FR_auto@
+pref_con_nm :: APINode -> FieldName -> Name
+pref_con_nm as fnm = mkName $ pre ++ _FieldName fnm
+  where
+    pre = map toUpper (CI.original $ anPrefix as) ++ "_"
+
+
+-- | The type corresponding to an API node
+nodeT :: APINode -> TypeQ
+nodeT = conT . type_nm
+
+-- | The representation type corresponding to an API node
+nodeRepT :: APINode -> TypeQ
+nodeRepT = conT . rep_type_nm
+
+-- | The constructor for a newtype or record API node
+nodeConE :: APINode -> ExpQ
+nodeConE = conE . rep_type_nm
+
+-- | A record field in an API node, as an expression
+nodeFieldE :: APINode -> FieldName -> ExpQ
+nodeFieldE an fnm = varE $ pref_field_nm an fnm
+
+-- | A prefixed constructor for a union or enum, as an expression
+nodeAltConE :: APINode -> FieldName -> ExpQ
+nodeAltConE an fn = conE $ pref_con_nm an fn
+
+-- | A prefixed constructor for a union or enum, as a pattern
+nodeAltConP :: APINode -> FieldName -> [PatQ] -> PatQ
+nodeAltConP an fn = conP (pref_con_nm an fn)
+
+-- | The projection function from a newtype API node, as an epxression
+newtypeProjectionE :: APINode -> ExpQ
+newtypeProjectionE = varE . newtype_prj_nm
diff --git a/src/Data/API/Tools/Enum.hs b/src/Data/API/Tools/Enum.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools/Enum.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE TemplateHaskell            #-}
+
+-- | A tool to generate maps to and from 'Text' values corresponding
+-- to inhabitants of enumerated types
+module Data.API.Tools.Enum
+    ( enumTool
+    , text_enum_nm
+    , map_enum_nm
+    ) where
+
+import           Data.API.TH
+import           Data.API.Tools.Combinators
+import           Data.API.Tools.Datatypes
+import           Data.API.Types
+
+import qualified Data.Text                      as T
+import qualified Data.Map                       as Map
+import           Data.Monoid
+import           Language.Haskell.TH
+
+
+-- | Tool to generate the maps between enumerations and 'Text' strings
+-- named by 'text_enum_nm' and 'map_enum_nm'.
+enumTool :: APITool
+enumTool = apiNodeTool $ apiSpecTool mempty mempty mempty enum mempty
+  where
+    enum = simpleTool (uncurry gen_se_tx) <> simpleTool (gen_se_mp . fst)
+
+
+-- | For an enum type @E@, name a function @_text_E :: E -> 'Text'@
+-- that gives a string corresponding to the inhabitant of the type.
+-- For example, we generate something like this:
+--
+-- >   _text_FrameRate :: FrameRate -> T.Text
+-- >   _text_FrameRate fr =
+-- >           case fr of
+-- >             FRauto    -> "auto"
+-- >             FR10      -> "10"
+-- >             FR15      -> "15"
+-- >             FR23_97   -> "23.97"
+-- >             FR24      -> "24"
+-- >             FR25      -> "25"
+-- >             FR29_97   -> "29.97"
+-- >             FR30      -> "30"
+-- >             FR60      -> "60"
+
+text_enum_nm :: APINode -> Name
+text_enum_nm an = mkName $ "_text_" ++ (_TypeName $ anName an)
+
+gen_se_tx :: APINode -> SpecEnum -> Q [Dec]
+gen_se_tx as se = simpleSigD (text_enum_nm as)
+                             [t| $tc -> T.Text |]
+                             bdy
+  where
+    tc  = conT $ rep_type_nm as
+
+    bdy  = lamCaseE [ match (pt fnm) (bd fnm) []
+                    | (fnm,_) <- seAlts se ]
+
+    pt fnm = nodeAltConP as fnm []
+
+    bd fnm = normalB $ stringE $ _FieldName fnm
+
+
+
+-- | For an enum type @E@, name a map from 'Text' values to
+-- inhabitants of the type, for example:
+--
+-- > _map_FrameRate :: Map Text FrameRate
+-- > _map_FrameRate = genTextMap _text_FrameRate
+
+map_enum_nm :: APINode -> Name
+map_enum_nm  an = mkName $ "_map_"  ++ (_TypeName $ anName an)
+
+gen_se_mp :: APINode -> Q [Dec]
+gen_se_mp as = simpleSigD (map_enum_nm as)
+                          [t| Map.Map T.Text $tc |]
+                          [e| genTextMap $(varE $ text_enum_nm as) |]
+  where
+    tc  = conT $ rep_type_nm as
+
+genTextMap :: (Ord a,Bounded a,Enum a) => (a->T.Text) -> Map.Map T.Text a
+genTextMap f = Map.fromList [ (f x,x) | x<-[minBound..maxBound] ]
diff --git a/src/Data/API/Tools/Example.hs b/src/Data/API/Tools/Example.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools/Example.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE DefaultSignatures          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TemplateHaskell            #-}
+
+-- | Tool for generating documentation-friendly examples
+module Data.API.Tools.Example
+    ( Example(..)
+    , exampleTool
+    , samplesTool
+    ) where
+
+import           Data.API.TH
+import           Data.API.Tools.Combinators
+import           Data.API.Tools.Datatypes
+import           Data.API.Types
+import           Data.API.Utils
+
+import           Control.Applicative
+import           Data.Aeson
+import qualified Data.ByteString.Char8          as B
+import           Data.Monoid
+import           Data.Time
+import           Language.Haskell.TH
+import           Safe
+import           Test.QuickCheck                as QC
+import qualified Data.Text                      as T
+
+
+-- | The Example class is used to generate a documentation-friendly
+-- example for each type in the model
+
+class Example a where
+    -- | Generator for example values; defaults to 'arbitrary' if not
+    -- specified
+    example :: Gen a
+    default example :: Arbitrary a => Gen a
+    example = arbitrary
+
+instance Example a => Example (Maybe a) where
+    example = oneof [return Nothing, Just <$> example]
+
+instance Example a => Example [a] where
+    example = listOf example
+
+instance Example Int where
+    example = arbitrarySizedBoundedIntegral `suchThat` (> 0)
+
+instance Example Bool where
+    example = choose (False, True)
+
+instance Example T.Text where
+    example = return "Mary had a little lamb"
+
+instance Example Binary where
+    example = return $ Binary $ B.pack "lots of 1s and 0s"
+
+instance Example Value where
+    example = return $ String "an example JSON value"
+
+instance Example UTCTime where
+    example = return $ fromJustNote dg $ parseUTC_ "2013-06-09T15:52:30Z"
+      where
+        dg = "Data.API.Tools.Example-UTCTime"
+
+
+-- | Generate a list of (type name, sample generator) pairs
+-- corresponding to each type in the API, with samples encoded as
+-- JSON.  This depends on the 'Example' instances generated by
+-- 'exampleTool'.  It generates something like this:
+--
+-- > samples :: [(String, Gen Value)]
+-- > samples = [("Foo", fmap toJSON (example :: Gen Foo)), ... ]
+
+samplesTool :: Name -> APITool
+samplesTool nm = simpleTool $ \ api ->
+                     simpleSigD nm [t| [(String, Gen Value)] |]
+                                (listE [ gen_sample nd | ThNode nd <- api ])
+  where
+    gen_sample :: APINode -> ExpQ
+    gen_sample an = [e| ($str, fmap toJSON (example :: Gen $(nodeT an))) |]
+      where
+        str = stringE $ _TypeName $ anName an
+
+
+-- | Tool to generate 'Example' instances for types generated by
+-- 'datatypesTool'.  This depends on 'quickCheckTool'.
+exampleTool :: APITool
+exampleTool = apiNodeTool $ apiSpecTool gen_sn_ex gen_sr_ex gen_su_ex gen_se_ex mempty
+
+
+-- | Generate an 'Example' instance for a newtype.  If there is no
+-- filter, call 'example' on the underlying type; otherwise, use
+-- 'arbitrary'.  Like 'Arbitrary', if a regular expression filter is
+-- applied the instance must be defined manually.
+gen_sn_ex :: Tool (APINode, SpecNewtype)
+gen_sn_ex = mkTool $ \ ts (an, sn) -> case snFilter sn of
+                               Just (FtrStrg _) -> return []
+                               Just _           -> inst ts an [e| QC.arbitrary |]
+                               Nothing          -> inst ts an [e| fmap $(nodeConE an) example |]
+  where
+    inst ts an e = optionalInstanceD ts ''Example [nodeRepT an] [simpleD 'example e]
+
+
+-- | Generate an 'Example' instance for a record:
+--
+-- > instance Example Foo where
+-- >     example = sized $ \ x -> Foo <$> resize (x `div` 2) example <*> ... <*> resize (x `div` 2) example
+
+gen_sr_ex :: Tool (APINode, SpecRecord)
+gen_sr_ex = mkTool $ \ ts (an, sr) -> optionalInstanceD ts ''Example [nodeRepT an] [simpleD 'example (bdy an sr)]
+  where
+    bdy an sr = do x <- newName "x"
+                   appE (varE 'QC.sized) $ lamE [varP x] $
+                       applicativeE (nodeConE an) $
+                       replicate (length $ srFields sr) $
+                       [e| QC.resize ($(varE x) `div` 2) example |]
+
+
+-- | Generate an 'Example' instance for a union:
+--
+-- > instance Example Foo where
+-- >     example = oneOf [ fmap Bar example, fmap Baz example ]
+
+gen_su_ex :: Tool (APINode, SpecUnion)
+gen_su_ex = mkTool $ \ ts (an, su) -> optionalInstanceD ts ''Example [nodeRepT an] [simpleD 'example (bdy an su)]
+  where
+    bdy an su | null (suFields su) = nodeConE an
+              | otherwise          = [e| oneof $(listE (alts an su)) |]
+
+    alts an su = [ [e| fmap $(nodeAltConE an k) example |]
+                 | (k,_) <- suFields su ]
+
+
+-- | Generate an 'Example' instance for an enumeration, with no
+-- definition for the 'example' method, because we can inherit the
+-- behaviour of 'Arbitrary':
+--
+-- > instance Example Foo
+
+gen_se_ex :: Tool (APINode, SpecEnum)
+gen_se_ex = mkTool $ \ ts (an, _) -> optionalInstanceD ts ''Example [nodeRepT an] []
diff --git a/src/Data/API/Tools/JSON.hs b/src/Data/API/Tools/JSON.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools/JSON.hs
@@ -0,0 +1,244 @@
+{-# LANGUAGE TemplateHaskell            #-}
+
+module Data.API.Tools.JSON
+    ( jsonTool
+    , toJsonNodeTool
+    , fromJsonNodeTool
+    ) where
+
+import           Data.API.JSON
+import           Data.API.TH
+import           Data.API.Tools.Combinators
+import           Data.API.Tools.Datatypes
+import           Data.API.Tools.Enum
+import           Data.API.Types
+import           Data.API.Utils
+
+import           Data.Aeson hiding (withText, withBool)
+import           Control.Applicative
+import qualified Data.Map                       as Map
+import           Data.Monoid
+import qualified Data.Text                      as T
+import           Language.Haskell.TH
+
+
+-- | Tool to generate 'ToJSON' and 'FromJSONWithErrs' instances for
+-- types generated by 'datatypesTool'.  This depends on 'enumTool'.
+jsonTool :: APITool
+jsonTool = apiNodeTool $ toJsonNodeTool <> fromJsonNodeTool
+
+
+-- | Tool to generate 'ToJSON' instance for an API node
+toJsonNodeTool :: APINodeTool
+toJsonNodeTool = apiSpecTool gen_sn_to gen_sr_to gen_su_to gen_se_to mempty
+                 <> gen_pr
+
+-- | Tool to generate 'FromJSONWithErrs' instance for an API node
+fromJsonNodeTool :: APINodeTool
+fromJsonNodeTool = apiSpecTool gen_sn_fm gen_sr_fm gen_su_fm gen_se_fm mempty
+                   <> gen_in
+
+
+{-
+instance ToJSON JobId where
+    toJSON = String . _JobId
+-}
+
+gen_sn_to :: Tool (APINode, SpecNewtype)
+gen_sn_to = mkTool $ \ ts (an, sn) -> optionalInstanceD ts ''ToJSON [nodeRepT an]
+                                          [simpleD 'toJSON (bdy an sn)]
+  where
+    bdy an sn = [e| $(ine sn) . $(newtypeProjectionE an) |]
+
+    ine sn = case snType sn of
+            BTstring -> [e| String |]
+            BTbinary -> [e| toJSON |]
+            BTbool   -> [e| Bool   |]
+            BTint    -> [e| mkInt  |]
+            BTutc    -> [e| mkUTC  |]
+
+
+{-
+instance FromJSONWithErrs JobId where
+    parseJSONWithErrs = withText "JobId" (pure . JobId)
+-}
+
+gen_sn_fm :: Tool (APINode, SpecNewtype)
+gen_sn_fm = mkTool $ \ ts (an, sn) -> optionalInstanceD ts ''FromJSONWithErrs [nodeRepT an]
+                                          [simpleD 'parseJSONWithErrs (bdy an sn)]
+  where
+    bdy an sn = [e| $(wth sn) $(typeNameE (anName an)) (pure . $(nodeConE an)) |]
+
+    wth sn    =
+        case (snType sn, snFilter sn) of
+            (BTstring, Just (FtrStrg re)) -> [e| withRegEx re    |]
+            (BTstring, _                ) -> [e| withText        |]
+            (BTbinary, _                ) -> [e| withBinary      |]
+            (BTbool  , _                ) -> [e| withBool        |]
+            (BTint   , Just (FtrIntg ir)) -> [e| withIntRange ir |]
+            (BTint   , _                ) -> [e| withInt         |]
+            (BTutc   , Just (FtrUTC  ur)) -> [e| withUTCRange ur |]
+            (BTutc   , _                ) -> [e| withUTC         |]
+
+
+
+{-
+instance ToJSON JobSpecId where
+     toJSON = \ x ->
+        object
+            [ "Id"         .= jsiId         x
+            , "Input"      .= jsiInput      x
+            , "Output"     .= jsiOutput     x
+            , "PipelineId" .= jsiPipelineId x
+            ]
+-}
+
+gen_sr_to :: Tool (APINode, SpecRecord)
+gen_sr_to = mkTool $ \ ts (an, sr) -> do
+    x <- newName "x"
+    optionalInstanceD ts ''ToJSON [nodeRepT an] [simpleD 'toJSON (bdy an sr x)]
+  where
+    bdy an sr x = lamE [varP x] $
+            varE 'object `appE`
+            listE [ [e| $(fieldNameE fn) .= $(nodeFieldE an fn) $(varE x) |]
+                  | (fn, _) <- srFields sr ]
+
+
+{-
+instance FromJSONWithErrs JobSpecId where
+     parseJSONWithErrs (Object v) =
+        JobSpecId <$>
+            v .: "Id"                               <*>
+            v .: "Input"                            <*>
+            v .: "Output"                           <*>
+            v .: "PipelineId"
+     parseJSONWithErrs v          = failWith $ expectedObject val
+-}
+
+gen_sr_fm :: Tool (APINode, SpecRecord)
+gen_sr_fm = mkTool $ \ ts (an, sr) -> do
+    x <- newName "x"
+    optionalInstanceD ts ''FromJSONWithErrs [nodeRepT an]
+                      [funD 'parseJSONWithErrs [cl an sr x, cl' x]]
+  where
+    cl an sr x  = clause [conP 'Object [varP x]] (normalB bdy) []
+      where bdy = applicativeE (nodeConE an) [ [e| $(varE x) .:. $(fieldNameE fn) |]
+                                             | (fn, _) <- srFields sr ]
+
+    cl'  x = clause [varP x] (normalB (bdy' x)) []
+    bdy' x = [e| failWith (expectedObject $(varE x)) |]
+
+
+{-
+instance ToJSON Foo where
+    toJSON (Bar x) = object [ "x" .= x ]
+    toJSON (Baz x) = object [ "y" .= x ]
+-}
+
+gen_su_to :: Tool (APINode, SpecUnion)
+gen_su_to = mkTool $ \ ts (an, su) -> optionalInstanceD ts ''ToJSON [nodeRepT an] [funD 'toJSON (cls an su)]
+  where
+    cls an su = map (cl an . fst) (suFields su)
+
+    cl an fn = do x <- newName "x"
+                  clause [nodeAltConP an fn [varP x]] (bdy fn x) []
+
+    bdy fn x = normalB [e| object [ $(fieldNameE fn) .= $(varE x) ] |]
+
+
+{-
+instance FromJSONWithErrs Foo where
+    parseJSONWithErrs (Object v) = alternatives (failWith $ MissingAlt ["x", "y"])
+        [ Bar <$> v .:: "x"
+        , Baz <$> v .:: "y"
+        ]
+    parseJSONWithErrs val        = failWith $ expectedObject val
+-}
+
+gen_su_fm :: Tool (APINode, SpecUnion)
+gen_su_fm = mkTool $ \ ts (an, su) -> do
+    x <- newName "x"
+    optionalInstanceD ts ''FromJSONWithErrs [nodeRepT an]
+                      [funD 'parseJSONWithErrs (cls an su x)]
+ where
+  cls an su x = [cl, cl']
+   where
+    cl  = clause [conP 'Object [varP x]] (normalB bdy) []
+    bdy = [e| alternatives (failWith $ MissingAlt $ss) $alts |]
+
+    alt fn = [e| fmap $(nodeAltConE an fn) ($(varE x) .:: $(fieldNameE fn)) |]
+
+    alts = listE $ map alt fns
+    ss   = listE $ map fieldNameE fns
+
+    fns  = map fst $ suFields su
+
+    cl'  = clause [varP x] (normalB bdy') []
+    bdy' = [e| failWith (expectedObject $(varE x)) |]
+
+
+
+{-
+instance ToJSON FrameRate where
+    toJSON    = String . _text_FrameRate
+-}
+
+gen_se_to :: Tool (APINode, SpecEnum)
+gen_se_to = mkTool $ \ ts (an, _se) -> optionalInstanceD ts ''ToJSON [nodeRepT an] [simpleD 'toJSON (bdy an)]
+  where
+    bdy an = [e| String . $(varE (text_enum_nm an)) |]
+
+
+{-
+instance FromJSONWithErrs FrameRate where
+    parseJSONWithErrs = jsonStrMap_p _map_FrameRate
+-}
+
+gen_se_fm :: Tool (APINode, SpecEnum)
+gen_se_fm = mkTool $ \ ts (an, _se) -> optionalInstanceD ts ''FromJSONWithErrs [nodeRepT an]
+                                           [simpleD 'parseJSONWithErrs (bdy an)]
+  where
+    bdy an = [e| jsonStrMap_p $(varE (map_enum_nm an)) |]
+
+
+gen_in :: Tool APINode
+gen_in = mkTool $ \ ts an -> case anConvert an of
+  Nothing          -> return []
+  Just (inj_fn, _) -> optionalInstanceD ts ''FromJSONWithErrs [nodeT an]
+                          [simpleD 'parseJSONWithErrs bdy]
+   where
+    bdy = do x <- newName "x"
+             lamE [varP x] [e| parseJSONWithErrs $(varE x) >>= $inj |]
+    inj = varE $ mkName $ _FieldName inj_fn
+
+
+gen_pr :: Tool APINode
+gen_pr = mkTool $ \ ts an -> case anConvert an of
+  Nothing          -> return []
+  Just (_, prj_fn) -> optionalInstanceD ts ''ToJSON [nodeT an] [simpleD 'toJSON bdy]
+   where
+    bdy = [e| toJSON . $prj |]
+    prj = varE $ mkName $ _FieldName prj_fn
+
+
+alternatives :: Alternative t => t a -> [t a] -> t a
+alternatives none = foldr (<|>) none
+
+mkInt :: Int -> Value
+mkInt = Number . fromInteger . toInteger
+
+
+jsonStrMap_p :: Ord a => Map.Map T.Text a -> Value -> ParserWithErrs a
+jsonStrMap_p mp = json_string_p (Map.keys mp) $ flip Map.lookup mp
+
+json_string_p :: Ord a => [T.Text] -> (T.Text->Maybe a) -> Value -> ParserWithErrs a
+json_string_p xs p (String t) | Just val <- p t = pure val
+                              | otherwise       = failWith $ UnexpectedEnumVal xs t
+json_string_p _  _ v                            = failWith $ expectedString v
+
+
+fieldNameE :: FieldName -> ExpQ
+fieldNameE = stringE . _FieldName
+
+typeNameE :: TypeName -> ExpQ
+typeNameE = stringE . _TypeName
diff --git a/src/Data/API/Tools/JSONTests.hs b/src/Data/API/Tools/JSONTests.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools/JSONTests.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE QuasiQuotes          #-}
+
+-- Here we use Template Haskell to generate a test suite for the Aeson wrappers
+-- from the DSL description of same.
+
+module Data.API.Tools.JSONTests
+    ( jsonTestsTool
+    , prop_decodesTo
+    , prop_resultsMatchRoundtrip
+    ) where
+
+import           Data.API.JSON
+import           Data.API.Tools.Combinators
+import           Data.API.Tools.Datatypes
+import           Data.API.TH
+import           Data.API.Types
+
+import qualified Data.Aeson                     as JS
+import           Language.Haskell.TH
+import           Test.QuickCheck
+
+
+-- | Tool to generate a list of tests of type @[('String', 'Property')]@
+-- with the given name.  This depends on 'jsonTool' and 'quickCheckTool'.
+jsonTestsTool :: Name -> APITool
+jsonTestsTool nm = simpleTool $ \ api -> simpleSigD nm [t| [(String, Property)] |] (props api)
+  where
+    props api = listE $ map generateProp [ an | ThNode an <- api ]
+
+-- | For an APINode, generate a (String, Property) pair giving the
+-- type name and an appropriate instance of the
+-- prop_resultsMatchRoundtrip property
+generateProp :: APINode -> ExpQ
+generateProp an = [e| ($ty, property (prop_resultsMatchRoundtrip :: $(nodeT an) -> Bool)) |]
+  where
+    ty = stringE $ _TypeName $ anName an
+
+
+-- | QuickCheck property that a 'Value' decodes to an expected Haskell
+-- value, using 'fromJSONWithErrs'
+prop_decodesTo :: forall a . (Eq a, FromJSONWithErrs a)
+               => JS.Value -> a -> Bool
+prop_decodesTo v x = case fromJSONWithErrs v :: Either [(JSONError, Position)] a of
+                       Right y | x == y -> True
+                       _                -> False
+
+-- | QuickCheck property that Haskell values can be encoded with
+-- 'toJSON' and decoded with 'fromJSONWithErrs' to get the original
+-- value
+prop_resultsMatchRoundtrip :: forall a . (Eq a, JS.ToJSON a, FromJSONWithErrs a )
+                           => a -> Bool
+prop_resultsMatchRoundtrip x = prop_decodesTo (JS.toJSON x) x
diff --git a/src/Data/API/Tools/Lens.hs b/src/Data/API/Tools/Lens.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools/Lens.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell            #-}
+module Data.API.Tools.Lens
+    ( lensTool
+    , binary
+    ) where
+
+import           Data.API.Tools.Combinators
+import           Data.API.Tools.Datatypes
+import           Data.API.Types
+
+import           Control.Lens
+
+
+-- | Tool to make lenses for fields in generated types.
+lensTool :: APITool
+lensTool = apiDataTypeTool $ simpleTool $ makeLenses . rep_type_nm
+
+
+$(makeLenses ''Binary)
diff --git a/src/Data/API/Tools/QuickCheck.hs b/src/Data/API/Tools/QuickCheck.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools/QuickCheck.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# OPTIONS_GHC -fno-warn-orphans       #-}
+
+module Data.API.Tools.QuickCheck
+    ( quickCheckTool
+    ) where
+
+import           Data.API.TH
+import           Data.API.Tools.Combinators
+import           Data.API.Tools.Datatypes
+import           Data.API.Types
+import           Data.API.Utils
+
+import           Control.Applicative
+import           Data.Monoid
+import           Data.Time
+import           Language.Haskell.TH
+import           Safe
+import           Test.QuickCheck                as QC
+
+
+-- | Tool to generate 'Arbitrary' instances for generated types.
+quickCheckTool :: APITool
+quickCheckTool = apiNodeTool $ apiSpecTool gen_sn_ab gen_sr_ab gen_su_ab gen_se_ab mempty
+
+
+-- | Generate an 'Arbitrary' instance for a newtype that respects its
+-- filter.  We don't try to generate arbitrary data matching a regular
+-- expression, however: instances must be supplied manually.  When
+-- generating arbitrary integers, use 'arbitraryBoundedIntegral'
+-- rather than 'arbitrary' (the latter tends to generate non-unique
+-- values).
+gen_sn_ab :: Tool (APINode, SpecNewtype)
+gen_sn_ab = mkTool $ \ ts (an, sn) -> case snFilter sn of
+    Nothing | snType sn == BTint    -> mk_instance ts an [e| QC.arbitraryBoundedIntegral |]
+            | otherwise             -> mk_instance ts an [e| arbitrary |]
+    Just (FtrIntg ir)               -> mk_instance ts an [e| arbitraryIntRange ir |]
+    Just (FtrUTC ur)                -> mk_instance ts an [e| arbitraryUTCRange ur |]
+    Just (FtrStrg _)                -> return []
+  where
+    mk_instance ts an arb = optionalInstanceD ts ''Arbitrary [nodeRepT an]
+                                [simpleD 'arbitrary [e| fmap $(nodeConE an) $arb |]]
+
+
+-- | Generate an 'Arbitrary' instance for a record:
+--
+-- > instance Arbitrary Foo where
+-- >     arbitrary = sized $ \ x -> Foo <$> resize (x `div` 2) arbitrary <*> ... <*> resize (x `div` 2) arbitrary
+
+gen_sr_ab :: Tool (APINode, SpecRecord)
+gen_sr_ab = mkTool $ \ ts (an, sr) -> optionalInstanceD ts ''QC.Arbitrary [nodeRepT an]
+                                          [simpleD 'arbitrary (bdy an sr)]
+  where
+    -- Reduce size of fields to avoid generating massive test data
+    -- by giving an arbitrary implementation like this:
+    --   sized (\ x -> JobSpecId <$> resize (x `div` 2) arbitrary <*> ...)
+    bdy an sr = do x <- newName "x"
+                   appE (varE 'QC.sized) $ lamE [varP x] $
+                     applicativeE (nodeConE an) $
+                     replicate (length $ srFields sr) $
+                     [e| QC.resize ($(varE x) `div` 2) arbitrary |]
+
+
+-- | Generate an 'Arbitrary' instance for a union:
+--
+-- > instance Arbitrary Foo where
+-- >     arbitrary = oneOf [ fmap Bar arbitrary, fmap Baz arbitrary ]
+
+gen_su_ab :: Tool (APINode, SpecUnion)
+gen_su_ab = mkTool $ \ ts (an, su) -> optionalInstanceD ts ''QC.Arbitrary [nodeRepT an]
+                                          [simpleD 'arbitrary (bdy an su)]
+  where
+    bdy an su | null (suFields su) = nodeConE an
+              | otherwise          = [e| oneof $(listE alts) |]
+      where
+        alts = [ [e| fmap $(nodeAltConE an k) arbitrary |]
+               | (k, _) <- suFields su ]
+
+
+-- | Generate an 'Arbitrary' instance for an enumeration:
+--
+-- > instance Arbitrary Foo where
+-- >     arbitrary = elements [Bar, Baz]
+
+gen_se_ab :: Tool (APINode, SpecEnum)
+gen_se_ab = mkTool $ \ ts (an, se) -> optionalInstanceD ts ''QC.Arbitrary [nodeRepT an]
+                                          [simpleD 'arbitrary (bdy an se)]
+  where
+    bdy an se | null ks   = nodeConE an
+              | otherwise = varE 'elements `appE` listE ks
+      where
+        ks = map (nodeAltConE an . fst) $ seAlts se
+
+
+-- | Generate an arbitrary 'Int' in a given range.
+arbitraryIntRange :: IntRange -> Gen Int
+arbitraryIntRange (IntRange (Just lo) Nothing  ) = QC.choose (lo, maxBound)
+arbitraryIntRange (IntRange Nothing   (Just hi)) = QC.choose (minBound, hi)
+arbitraryIntRange (IntRange (Just lo) (Just hi)) = QC.choose (lo, hi)
+arbitraryIntRange (IntRange Nothing   Nothing  ) = QC.arbitrary
+
+-- | Generate an arbitrary 'UTCTime' in a given range.
+-- TODO: we might want to generate a broader range of sample times,
+-- rather than just the extrema.
+arbitraryUTCRange :: UTCRange -> Gen UTCTime
+arbitraryUTCRange (UTCRange (Just lo) Nothing  ) = pure lo
+arbitraryUTCRange (UTCRange Nothing   (Just hi)) = pure hi
+arbitraryUTCRange (UTCRange (Just lo) (Just hi)) = QC.elements [lo, hi]
+arbitraryUTCRange (UTCRange Nothing   Nothing  ) = QC.arbitrary
+
+-- TODO: use a more arbitrary instance (quickcheck-instances?)
+instance QC.Arbitrary UTCTime where
+    arbitrary = QC.elements
+        [ mk "2010-01-01T00:00:00Z"
+        , mk "2013-05-27T19:13:50Z"
+        , mk "2011-07-20T22:04:00Z"
+        , mk "2012-02-02T15:45:11Z"
+        , mk "2009-11-12T20:57:54Z"
+        , mk "2000-10-28T21:03:24Z"
+        , mk "1965-03-10T09:23:01Z"
+        ]
+      where
+        mk  = fromJustNote lab . parseUTC'
+
+        lab = "Data.API.Tools.QuickCheck.Arbitrary-UTCTime"
diff --git a/src/Data/API/Tools/SafeCopy.hs b/src/Data/API/Tools/SafeCopy.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tools/SafeCopy.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE TemplateHaskell            #-}
+{-# OPTIONS_GHC -fno-warn-orphans       #-}
+
+module Data.API.Tools.SafeCopy
+    ( safeCopyTool
+    ) where
+
+import           Data.API.Tools.Combinators
+import           Data.API.Tools.Datatypes
+import           Data.API.Types
+
+import           Data.SafeCopy
+
+
+-- | Tool to derive 'SafeCopy' instances for generated types.  At
+-- present, this derives only base version instances.
+safeCopyTool :: APITool
+safeCopyTool = apiDataTypeTool $ simpleTool $ deriveSafeCopy 0 'base . rep_type_nm
+
+$(deriveSafeCopy 0 'base ''Binary)
diff --git a/src/Data/API/Tutorial.hs b/src/Data/API/Tutorial.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Tutorial.hs
@@ -0,0 +1,269 @@
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+module Data.API.Tutorial (
+    -- * Introduction
+    -- $introduction
+
+    -- * The api DSL
+    -- $api
+
+    -- ** Generating types for an API
+    -- $generate
+
+    -- * Generating tools for an API
+    -- $tools
+
+    -- * Data migration
+    -- $migration
+
+    -- ** Custom migrations
+    -- $custom
+
+    -- * Documenting a REST-like API
+    -- $docs
+    ) where
+
+import Data.API.Changes
+import Data.API.Doc.Call
+import Data.API.Doc.Dir
+import Data.API.Doc.Types
+import Data.API.JSON
+import Data.API.Parse
+import Data.API.Tools
+import Data.API.Types
+
+import Data.Text
+import Data.Time
+
+{- $introduction
+
+The @api-tools@ library provides a compact DSL for describing an API.
+It uses Template Haskell to generate the corresponding data types and
+assorted tools for working with it, including code for converting
+between JSON and the generated types and writing unit tests.  It
+supports maintaining a log of changes to the API and migrating data
+between different versions.
+
+-}
+
+{- $api
+
+An 'API' is a list of datatypes, which must be in one of five
+simple forms:
+
+ * Records, which have one constructor but many fields
+
+ * Unions, which have many constructors each with a single argument
+
+ * Enumerations, which have many nullary constructors
+
+ * Newtypes, which wrap a built-in basic type
+
+ * Type synonyms
+
+To define an 'API', you can use the 'parseAPI' function or the 'api'
+quasi-quoter, like this:
+
+> example :: API
+> example = [api|
+>
+> rec :: MyRecord
+>    // A record type containing two fields
+>    = record
+>        x :: [integer]   // one field
+>        y :: ? [utc]     // another field
+>
+> chc :: MyChoice
+>     // A disjoint union
+>     = union
+>         | a :: MyRecord
+>         | b :: string
+>
+> enm :: MyEnum
+>     // An enumeration
+>     = enum
+>         | e1
+>         | e2
+>
+> str :: MyString
+>     // A newtype
+>     = basic string
+>
+> flg :: MyFlag
+>     // A type synonym
+>     = boolean
+>
+> |]
+
+The basic types available (and their Haskell representations) are
+@string@ ('Text'), @binary@ ('Binary'), @integer@ ('Int'), @boolean@
+('Bool') and @utc@ ('UTCTime').
+
+The prefix (given before the @::@ on each type declaration) is used to
+name record fields and enumeration/union constructors in the generated
+Haskell code.  It must be unique throughout the API.  It is not a type
+signature, despite the appearance!
+
+-}
+
+{- $generate
+
+Once an API is defined, the 'generate' function can be used in a
+Template Haskell splice to produce the corresponding Haskell datatype
+declarations.  Thus @$(generate example)@ will produce something like:
+
+> data MyRecord = MyRecord { rec_x :: [Int]
+>                          , rec_y :: Maybe [UTCTime]
+>                          }
+>
+> data MyChoice = CHC_a MyRecord | CHC_b String
+>
+> data MyEnum = ENM_e1 | ENM_e2
+>
+> newtype MyString = MyString { _MyString :: String }
+>
+> type MyFlag = Bool
+
+The Template Haskell staging restriction means that @example@ must be
+defined in one module and imported into another to call @generate@.
+
+-}
+
+{- $tools
+
+Once the Haskell datatypes have been created by 'generate', additional
+tools can be created with 'generateAPITools'.  See "Data.API.Tools"
+for a list of tools supplied with the library.  For example, the call
+
+> $(generateAPITools [enumTool, jsonTool, quickCheckTool] example)
+
+will define:
+
+* @_text_MyEnum :: MyEnum -> 'Text'@ and @_map_MyEnum :: Map 'Text' MyEnum@,
+  for converting between enumerations and text representations
+
+* 'ToJSON', 'FromJSONWithErrs' and 'Arbitrary' instances for all the
+  generated types
+
+-}
+
+{- $migration
+
+A key feature of @api-tools@ is support for migrating data between
+different versions of an 'API'. The 'apiWithChangelog' quasi-quoter
+allows an API to be followed by a changelog in a formal syntax,
+providing a record of changes between versions.  For example:
+
+> example :: API
+> exampleChangelog :: APIChangelog
+> (example, exampleChangelog) = [apiWithChangelog|
+>
+> // ...api specification as before...
+>
+> changes
+>
+> version "0.3"
+>   added MyFlag boolean
+>
+> version "0.2"
+>   changed record MyRecord
+>     field added y :: ? [utc]
+>
+> // Initial version
+> version "0.1"
+> |]
+
+The 'migrateDataDump' function can be used to migrate data, encoded
+with JSON, from a previous API version to a more recent version.  The
+old and new 'API's must be supplied, and the changes in the changelog
+must describe how to get from the old to the new 'API'.  The
+'validateChanges' function can be used to check that a changelog is
+sufficient.
+
+A changelog consists of the keyword @changes@ and a list of version
+blocks. A version block consists of the keyword @version@ starting in
+the leftmost column, a version number in double quotes, then a list of
+changes. The following changes are available:
+
+> added <Type name> <Specification>
+> removed <Type name>
+> renamed <Source type> to <Target type>
+> changed record <Type name>
+>   field added <field name> :: <Type> [default <value>]
+>   field removed <field name>
+>   field renamed <source field> to <target field>
+>   field changed <field name> :: <New type> migration <Migration name>
+> changed union <Type name>
+>   alternative added <alternative name> :: <Type>
+>   alternative removed <alternative name>
+>   alternative renamed <source alternative> to <target alternative>
+> changed enum <Type name>
+>   alternative added <value name>
+>   alternative removed <value name>
+>   alternative renamed <source value> to <target value>
+> migration <Migration name>
+> migration record <Type name> <Migration name>
+
+-}
+
+{- $custom
+
+For more extensive changes to the 'API' that cannot be expressed using
+the primitive changes, /custom/ migrations can be used to migrate data
+between versions.
+
+Custom migrations can be applied to the whole dataset, a single record
+or an individual record field, thus:
+
+> version "0.42"
+>   migration MigrateWholeDataset
+>   migration record Widget MigrateWidgetRecord
+>   changed record Widget where
+>     field changed foo :: String migration MigrateFooField
+
+The 'generateMigrationKinds' function creates enumeration types
+corresponding to the custom migration names used in a changelog.
+These types should then be used to create a 'CustomMigrations' record,
+which describes how to transform the data (and 'API', if appropriate)
+for each custom migration.  For example,
+
+> $(generateMigrationKinds myChangelog "DatabaseMigration" "RecordMigration" "FieldMigration")
+
+with the changelog fragment above would give
+
+> data DatabaseMigration = MigrateWholeDatabase | ...
+> data RecordMigration   = MigrateWidgetRecord  | ...
+> data FieldMigration    = MigrateFooField      | ...
+
+Calls to 'migrateDataDump' should include a suitable
+'CustomMigrations' record, which includes functions to perform the
+migrations on the underlying data, represented as an Aeson 'Value'.
+For example, suppose the @foo@ field of the @Widget@ record previously
+contained a boolean: a suitable 'fieldMigration' implementation might be:
+
+> fieldMigration :: FieldMigration -> Value -> Either ValueError Value
+> fieldMigration MigrateFooField (Bool b) = Right $ toJSON $ show b
+> fieldMigration MigrateFooField v        = Left  $ CustomMigrationError "oops" v
+> ...
+
+A field migration may change the type of the field by listing the new
+type in the changelog.  Whole-database and individual-record
+migrations may describe the changes they make to the schema in the
+'databaseMigrationSchema' and 'recordMigrationSchema' fields of the
+'CustomMigrations' record.
+
+In order to check that custom migrations result in data that matches
+the schema, the 'DataChecks' parameter of 'migrateDataDump' can be set
+to 'CheckCustom' or 'CheckAll'.  This will validate the data against
+the schema after calling the custom migration code.
+
+-}
+
+{- $docs
+
+A 'Call' is a description of a web resource, intended to be generated
+in an application-specific way from the code of a web server.  The
+'callHtml' function can be used to generate HTML documentation of
+individual resources, and 'dirHtml' can be used to generate an index
+page for the documentation of a collection of resources.
+
+-}
diff --git a/src/Data/API/Types.hs b/src/Data/API/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Types.hs
@@ -0,0 +1,295 @@
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# OPTIONS_GHC -fno-warn-orphans       #-}
+
+
+module Data.API.Types
+    ( API
+    , Thing(..)
+    , APINode(..)
+    , TypeName(..)
+    , FieldName(..)
+    , MDComment
+    , Prefix
+    , Spec(..)
+    , SpecNewtype(..)
+    , SpecRecord(..)
+    , FieldType(..)
+    , SpecUnion(..)
+    , SpecEnum(..)
+    , Conversion
+    , APIType(..)
+    , DefaultValue(..)
+    , BasicType(..)
+    , Filter(..)
+    , IntRange(..)
+    , UTCRange(..)
+    , RegEx(..)
+    , Binary(..)
+    , defaultValueAsJsValue
+    ) where
+
+import           Data.API.Utils
+
+import qualified Data.CaseInsensitive           as CI
+import           Data.String
+import           Data.Time
+import           Data.Aeson
+import           Data.Aeson.Types
+import           Data.Aeson.TH
+import qualified Data.Text                      as T
+import qualified Data.Text.Encoding             as T
+import qualified Data.ByteString.Char8          as B
+import           Test.QuickCheck                as QC
+import           Control.Applicative
+import qualified Data.ByteString.Base64         as B64
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax
+import           Text.Regex
+
+
+-- | an API spec is made up of a list of type/element specs, each
+--   specifying a Haskell type and JSON wrappers
+
+type API = [Thing]
+
+data Thing
+    = ThComment MDComment
+    | ThNode    APINode
+    deriving (Show)
+
+-- | Specifies an individual element/type of the API
+
+data APINode
+    = APINode
+        { anName    :: TypeName         -- ^ name of Haskell type
+        , anComment :: MDComment        -- ^ comment describing type in Markdown
+        , anPrefix  :: Prefix           -- ^ distinct short prefix (see below)
+        , anSpec    :: Spec             -- ^ the type specification
+        , anConvert :: Conversion       -- ^ optional conversion functions
+        }
+    deriving (Show)
+
+-- | TypeName must contain a valid Haskell type constructor
+
+newtype TypeName = TypeName { _TypeName :: String }
+    deriving (Eq, Ord,Show, IsString)
+
+-- | FieldName identifies recod fields and union alternatives
+--   must contain a valid identifier valid in Haskell and
+--   any API client wrappers (e.g., if Ruby wrappers are to be
+--   generated the names should easily map into Ruby)
+
+newtype FieldName = FieldName { _FieldName :: String }
+    deriving (Show,Eq,Ord,IsString)
+
+-- | Markdown comments are represented by strings
+
+type MDComment = String
+
+-- | a distinct case-insensitive short prefix used to form unique record field
+--   names and data constructors:
+--
+--      * must be a valid Haskell identifier
+--
+--      * must be unique within the API
+
+type Prefix = CI.CI String
+
+-- | type/element specs are either simple type isomorphisms of basic JSON
+--   types, records, unions or enumerated types
+
+data Spec
+    = SpNewtype SpecNewtype
+    | SpRecord  SpecRecord
+    | SpUnion   SpecUnion
+    | SpEnum    SpecEnum
+    | SpSynonym APIType
+    deriving (Show)
+
+-- | SpecNewtype elements are isomorphisms of string, inetgers or booleans
+
+data SpecNewtype =
+    SpecNewtype
+        { snType   :: BasicType
+        , snFilter :: Maybe Filter
+        }
+    deriving (Show)
+
+data Filter
+    = FtrStrg RegEx
+    | FtrIntg IntRange
+    | FtrUTC  UTCRange
+    deriving (Show)
+
+data IntRange
+    = IntRange
+        { ir_lo :: Maybe Int
+        , ir_hi :: Maybe Int
+        }
+    deriving (Eq, Show)
+
+instance Lift IntRange where
+    lift (IntRange lo hi) = [e| IntRange lo hi |]
+
+data UTCRange
+    = UTCRange
+        { ur_lo :: Maybe UTCTime
+        , ur_hi :: Maybe UTCTime
+        }
+    deriving (Eq, Show)
+
+instance Lift UTCRange where
+    lift (UTCRange lo hi) = [e| UTCRange $(liftMaybeUTCTime lo) $(liftMaybeUTCTime hi) |]
+
+liftMaybeUTCTime :: Maybe UTCTime -> ExpQ
+liftMaybeUTCTime Nothing  = [e| Nothing |]
+liftMaybeUTCTime (Just u) = [e| parseUTC_ $(stringE (mkUTC_ u)) |]
+
+
+data RegEx =
+    RegEx
+        { re_text  :: T.Text
+        , re_regex :: Regex
+        }
+
+mkRegEx :: T.Text -> RegEx
+mkRegEx txt = RegEx txt $ mkRegexWithOpts (T.unpack txt) False True
+
+instance ToJSON RegEx where
+    toJSON RegEx{..} = String re_text
+
+instance FromJSON RegEx where
+    parseJSON = withText "RegEx" (return . mkRegEx)
+
+instance Eq RegEx where
+    r == s = re_text r == re_text s
+
+instance Show RegEx where
+    show = T.unpack . re_text
+
+instance Lift RegEx where
+    lift re = [e| mkRegEx $(stringE (T.unpack (re_text re))) |]
+
+-- | SpecRecord is your classsic product type.
+
+data SpecRecord = SpecRecord
+    { srFields :: [(FieldName, FieldType)]
+    }
+    deriving (Show)
+
+-- | In addition to the type and comment, record fields may carry a
+-- flag indicating that they are read-only, and may have a default
+-- value, which must be of a compatible type.
+
+data FieldType = FieldType
+    { ftType     :: APIType
+    , ftReadOnly :: Bool
+    , ftDefault  :: Maybe DefaultValue
+    , ftComment  :: MDComment
+    }
+    deriving (Show)
+
+-- | SpecUnion is your classsic union type
+
+data SpecUnion = SpecUnion
+    { suFields :: [(FieldName,(APIType,MDComment))]
+    }
+    deriving (Show)
+
+-- | SpecEnum is your classic enumerated type
+
+data SpecEnum = SpecEnum
+    { seAlts :: [(FieldName,MDComment)]
+    }
+    deriving (Show)
+
+-- Conversion possibly converts to an internal representation
+
+type Conversion = Maybe (FieldName,FieldName)
+
+-- | Type is either a list, Maybe, a named element of the API or a basic type
+data APIType
+    = TyList  APIType       -- ^ list elements are types
+    | TyMaybe APIType       -- ^ Maybe elements are types
+    | TyName  TypeName      -- ^ the referenced type must be defined by the API
+    | TyBasic BasicType     -- ^ a JSON string, int, bool etc.
+    | TyJSON                -- ^ a generic JSON value
+    deriving (Eq, Show)
+
+-- | the basic JSON types (N.B., no floating point numbers, yet)
+data BasicType
+    = BTstring -- ^ a JSON UTF-8 string
+    | BTbinary -- ^ a base-64-encoded byte string
+    | BTbool   -- ^ a JSON bool
+    | BTint    -- ^ a JSON integral number
+    | BTutc    -- ^ a JSON UTC string
+    deriving (Eq, Show)
+
+-- | A default value for a field
+data DefaultValue
+    = DefValList
+    | DefValMaybe
+    | DefValString T.Text  -- used for binary fields (base64 encoded)
+    | DefValBool   Bool
+    | DefValInt    Int
+    | DefValUtc    UTCTime
+    deriving (Eq, Show)
+
+-- | Convert a default value to an Aeson 'Value'.  This differs from
+-- 'toJSON' as it will not round-trip with 'fromJSON': UTC default
+-- values are turned into strings.
+defaultValueAsJsValue :: DefaultValue -> Value
+defaultValueAsJsValue  DefValList                = toJSON ([] :: [()])
+defaultValueAsJsValue  DefValMaybe               = Null
+defaultValueAsJsValue (DefValString s)           = String s
+defaultValueAsJsValue (DefValBool   b)           = Bool b
+defaultValueAsJsValue (DefValInt    n)           = Number (fromIntegral n)
+defaultValueAsJsValue (DefValUtc    t)           = mkUTC t
+
+
+-- | Binary data is represented in JSON format as a base64-encoded
+-- string
+newtype Binary = Binary { _Binary :: B.ByteString }
+    deriving (Show,Eq,Ord)
+
+instance ToJSON Binary where
+    toJSON = String . T.decodeLatin1 . B64.encode . _Binary
+
+instance FromJSON Binary where
+    parseJSON = withBinary "Binary" return
+
+instance QC.Arbitrary T.Text where
+    arbitrary = T.pack <$> QC.arbitrary
+
+instance QC.Arbitrary Binary where
+    arbitrary = Binary <$> B.pack <$> QC.arbitrary
+
+withBinary :: String -> (Binary->Parser a) -> Value -> Parser a
+withBinary lab f = withText lab g
+  where
+    g t =
+        case B64.decode $ T.encodeUtf8 t of
+          Left  _  -> typeMismatch lab (String t)
+          Right bs -> f $ Binary bs
+
+
+deriveJSON defaultOptions ''Thing
+deriveJSON defaultOptions ''APINode
+deriveJSON defaultOptions ''TypeName
+deriveJSON defaultOptions ''FieldName
+deriveJSON defaultOptions ''Spec
+deriveJSON defaultOptions ''APIType
+deriveJSON defaultOptions ''DefaultValue
+deriveJSON defaultOptions ''SpecEnum
+deriveJSON defaultOptions ''SpecUnion
+deriveJSON defaultOptions ''SpecRecord
+deriveJSON defaultOptions ''FieldType
+deriveJSON defaultOptions ''SpecNewtype
+deriveJSON defaultOptions ''Filter
+deriveJSON defaultOptions ''IntRange
+deriveJSON defaultOptions ''UTCRange
+deriveJSON defaultOptions ''BasicType
+deriveJSON defaultOptions ''CI.CI
diff --git a/src/Data/API/Utils.hs b/src/Data/API/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/API/Utils.hs
@@ -0,0 +1,55 @@
+module Data.API.Utils
+    ( mkUTC
+    , mkUTC'
+    , mkUTC_
+    , parseUTC'
+    , parseUTC_
+    , (?!)
+    , (?!?)
+    ) where
+
+import           Data.Aeson
+import           Data.Maybe
+import qualified Data.Text                      as T
+import           Data.Time
+import           System.Locale
+
+
+mkUTC :: UTCTime -> Value
+mkUTC = String . mkUTC'
+
+utcFormat :: String
+utcFormat =               "%Y-%m-%dT%H:%M:%SZ"
+
+utcFormats :: [String]
+utcFormats =
+                        [ "%Y-%m-%dT%H:%M:%S%z"
+                        , "%Y-%m-%dT%H:%M:%S%Z"
+                        , "%Y-%m-%dT%H:%M%Z"
+                        , "%Y-%m-%dT%H:%M:%S%QZ"
+                        , utcFormat
+                        ]
+
+mkUTC' :: UTCTime -> T.Text
+mkUTC' = T.pack . mkUTC_
+
+mkUTC_ :: UTCTime -> String
+mkUTC_ utct = formatTime defaultTimeLocale utcFormat utct
+
+parseUTC' :: T.Text -> Maybe UTCTime
+parseUTC' t = parseUTC_ $ T.unpack t
+
+parseUTC_ :: String -> Maybe UTCTime
+parseUTC_ s = listToMaybe $ catMaybes $
+            map (\fmt->parseTime defaultTimeLocale fmt s) utcFormats
+
+
+-- | The \"oh noes!\" operator.
+--
+(?!) :: Maybe a -> e -> Either e a
+Nothing ?! e = Left  e
+Just x  ?! _ = Right x
+
+(?!?) :: Either e a -> (e -> e') -> Either e' a
+Left  e ?!? f = Left  (f e)
+Right x ?!? _ = Right x
diff --git a/tests/Data/API/Test/DSL.hs b/tests/Data/API/Test/DSL.hs
new file mode 100644
--- /dev/null
+++ b/tests/Data/API/Test/DSL.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE QuasiQuotes                #-}
+{-# OPTIONS_GHC -XNoCPP                 #-}
+
+module Data.API.Test.DSL where
+
+import           Data.API.Parse
+import           Data.API.Types
+
+
+example :: API
+example = map ThNode 
+    [ APINode "IsoS" "simple String newtype defn" ""
+          (SpNewtype $ SpecNewtype BTstring Nothing) Nothing
+    , APINode "IsoB" "simple Bool   newtype defn" ""
+          (SpNewtype $ SpecNewtype BTbool Nothing) Nothing
+    , APINode "IsoI" "simple Int    newtype defn" ""
+          (SpNewtype $ SpecNewtype BTint Nothing) Nothing
+    , APINode "Foo" "a test defn" "bAr_" (SpRecord $ SpecRecord
+            [ (,) "Baz" (FieldType (TyBasic BTbool) False Nothing "just a bool")
+            , (,) "Qux" (FieldType (TyBasic BTint)  False Nothing "just an int")
+            ]) Nothing
+    , APINode "Wibble" "another test defn" "dro" (SpUnion $ SpecUnion
+            [ (,) "wubble"  (TyList $ TyName "Foo", "list of Foo")
+            , (,) "flubble" (TyBasic BTstring     , "a string"   )
+            ]) Nothing
+    , APINode "Enumer" "enum test defn" "enm" (SpEnum $ SpecEnum
+            [ ("wubble", "")
+            , ("flubble", "")
+            ]) Nothing
+    ]
+
+example2 :: API
+example2 = [api|
+
+ssn :: Ssn
+    = basic integer
+    with inj_ssn, prj_ssn
+
+ide :: Ide
+    (* here is a block comment *)
+    // and a simple comment
+    = string
+
+flg :: Flag
+    = boolean
+
+crt :: Cert
+    = binary
+
+poo :: Poo
+    // A simple test example
+    = record
+        x :: integer
+        y :: Foo
+
+c :: Coord
+    // A simple test example
+    = record
+        x :: integer // the x coordinate
+                    // with a multi-line comment
+        y :: integer (* and here we have a multi-line
+                       block comment 
+                       and this 
+                     *)
+    with inj_coord, prj_coord
+
+twi :: Twiddle
+    // A simple test example
+    = record
+        x :: [integer]   // a field
+        y :: ? [binary]  // another field
+
+chc :: CHOICE
+    = union
+        | a :: integer
+        | b :: string
+    with inj_chc, prj_chc
+
+enm :: ENUM
+    = enum
+        | e1
+        | e2
+    with inj_enum, prj_enum
+
+uv :: MyUTC
+    = utc
+
+urec :: URec
+    = record
+        foo :: utc
+|]
diff --git a/tests/Data/API/Test/Gen.hs b/tests/Data/API/Test/Gen.hs
new file mode 100644
--- /dev/null
+++ b/tests/Data/API/Test/Gen.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+
+module Data.API.Test.Gen where
+
+import           Data.API.JSON
+import           Data.API.Test.DSL hiding (example)
+import qualified Data.API.Test.DSL as DSL
+import           Data.API.Tools
+import           Data.API.Tools.Example
+import           Control.Applicative
+import           Language.Haskell.TH
+import           Test.QuickCheck
+
+$(generate         DSL.example)
+$(generateAPITools DSL.example
+                   [ enumTool
+                   , jsonTool
+                   , quickCheckTool
+                   , lensTool
+                   , safeCopyTool
+                   , exampleTool
+                   , samplesTool   (mkName "exampleSamples")
+                   , jsonTestsTool (mkName "exampleSimpleTests")
+                   ])
+
+$(generate      example2)
+
+data Coord = Coord Int Int
+    deriving (Eq,Show)
+
+instance Arbitrary Coord where
+    arbitrary = Coord <$> arbitrary <*> arbitrary
+
+instance Example Coord
+
+inj_coord :: REP__Coord -> ParserWithErrs Coord
+inj_coord (REP__Coord x y) = pure $ Coord x y
+
+prj_coord :: Coord -> REP__Coord 
+prj_coord (Coord x y) = REP__Coord x y
+
+
+newtype Ssn = Ssn { _Ssn :: Integer }
+    deriving(Eq,Show)
+
+instance Arbitrary Ssn where
+    arbitrary = Ssn <$> arbitrary
+
+instance Example Ssn
+
+inj_ssn :: REP__Ssn -> ParserWithErrs Ssn
+inj_ssn = return . Ssn . fromIntegral . _REP__Ssn
+
+prj_ssn :: Ssn -> REP__Ssn
+prj_ssn = REP__Ssn . fromIntegral . _Ssn
+
+
+data CHOICE = CHOICE { _CHOICE :: Int }
+    deriving(Eq,Show)
+
+instance Arbitrary CHOICE where
+    arbitrary = CHOICE <$> arbitrary
+
+instance Example CHOICE
+
+inj_chc :: REP__CHOICE -> ParserWithErrs CHOICE
+inj_chc (CHC_a i) = return $ CHOICE i
+inj_chc (CHC_b _) = empty
+
+prj_chc :: CHOICE -> REP__CHOICE
+prj_chc (CHOICE i) = CHC_a i
+
+newtype ENUM = ENUM Bool
+    deriving (Show,Eq)
+
+instance Arbitrary ENUM where
+    arbitrary = ENUM <$> arbitrary
+
+instance Example ENUM
+
+inj_enum :: REP__ENUM -> ParserWithErrs ENUM
+inj_enum ENM_e1 = return $ ENUM False
+inj_enum ENM_e2 = return $ ENUM True
+
+prj_enum :: ENUM -> REP__ENUM
+prj_enum (ENUM False) = ENM_e1
+prj_enum (ENUM True ) = ENM_e2
+
+$(generateAPITools example2
+                   [ enumTool
+                   , jsonTool
+                   , quickCheckTool
+                   , lensTool
+                   , safeCopyTool
+                   , exampleTool
+                   , samplesTool   (mkName "example2Samples")
+                   , jsonTestsTool (mkName "example2SimpleTests")
+                   ])
diff --git a/tests/Data/API/Test/JSON.hs b/tests/Data/API/Test/JSON.hs
new file mode 100644
--- /dev/null
+++ b/tests/Data/API/Test/JSON.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+
+module Data.API.Test.JSON
+    ( jsonTests
+    ) where
+
+import           Data.API.API.Gen
+import           Data.API.JSON
+import           Data.API.Tools
+import           Data.API.Tools.JSONTests
+import           Data.API.Test.Gen (exampleSimpleTests, example2SimpleTests)
+import           Data.API.Test.MigrationData
+
+import qualified Data.Aeson               as JS
+import qualified Data.HashMap.Strict      as HMap
+
+import           Test.Tasty
+import           Test.Tasty.HUnit
+import           Test.Tasty.QuickCheck
+
+
+$(generate         startSchema)
+$(generateAPITools startSchema
+                   [ enumTool
+                   , jsonTool
+                   , quickCheckTool
+                   ])
+
+-- | Test that literals are decoded correctly, including the dubious
+-- use of strings for numbers and numbers for booleans, and missing
+-- fields being treated as nulls.
+basicValueDecoding :: Assertion
+basicValueDecoding = sequence_ [ help (JS.String "12")  (12 :: Int) True
+                               , help (JS.String "0")   (0 :: Int)  True
+                               , help (JS.String "-9")  (-9 :: Int) True
+                               , help (JS.String "1a")  (1 :: Int)  False
+                               , help (JS.Number 0)     False       True
+                               , help (JS.Number 1)     True        True
+                               , help (JS.Number 2)     True        False
+                               , help (JS.String "0")   False       False
+                               , help (JS.String "1")   True        False
+                               , help (JS.Object (HMap.singleton "id" (JS.Number 3)))
+                                      (Recursive (Id 3) Nothing)
+                                      True
+                               ]
+  where
+    help v x yes = assertBool ("Failed on " ++ show v ++ " " ++ show x)
+                              (prop_decodesTo v x == yes)
+
+-- | Test that the correct errors are generated for bad JSON data
+errorDecoding :: [TestTree]
+errorDecoding = [ help "not enough bytes" ""         (proxy :: Int)
+                      [(SyntaxError "not enough bytes", [])]
+                , help "object for int"   "{}"       (proxy :: Int)
+                      [(Expected ExpInt "Int" (JS.Object HMap.empty), [])]
+                , help "missing alt"      "{}"       (proxy :: AUnion)
+                      [(MissingAlt ["bar"], [])]
+                , help "unexpected value" "[\"no\"]" (proxy :: [AnEnum])
+                      [(UnexpectedEnumVal ["bar", "foo"] "no", [InElem 0])]
+                , help "missing field"    "{}"       (proxy :: Bar)
+                      [(MissingField, [InField "id"])]
+                ]
+  where
+    proxy = error "proxy"
+
+    help x s v es = testCase x $ case decodeWithErrs s `asTypeOf` Right v of
+                      Right _  -> assertFailure $ "Decode returned value: " ++ show s
+                      Left es' -> assertBool ("Unexpected error when decoding: " ++ show s
+                                              ++ "\n" ++ prettyJSONErrorPositions es'
+                                              ++ "\ninstead of\n" ++ prettyJSONErrorPositions es)
+                                             (es == es')
+
+jsonTests :: TestTree
+jsonTests = testGroup "JSON"
+  [ testCase  "Basic value decoding"  basicValueDecoding
+  , testGroup "Decoding invalid data" errorDecoding
+  , testGroup "Round-trip tests"
+      [ testGroup "example"  $ map (uncurry testProperty) exampleSimpleTests
+      , testGroup "example2" $ map (uncurry testProperty) example2SimpleTests
+      , testGroup "api"      $ map (uncurry testProperty) apiAPISimpleTests
+      ]
+  ]
diff --git a/tests/Data/API/Test/Main.hs b/tests/Data/API/Test/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Data/API/Test/Main.hs
@@ -0,0 +1,16 @@
+module Data.API.Test.Main
+    ( main
+    ) where
+
+import           Data.API.Test.JSON
+import           Data.API.Test.Migration
+
+import           Test.Tasty
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "api-tools" [ migrationTests
+                              , jsonTests
+                              ]
diff --git a/tests/Data/API/Test/Migration.hs b/tests/Data/API/Test/Migration.hs
new file mode 100644
--- /dev/null
+++ b/tests/Data/API/Test/Migration.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# OPTIONS_GHC -XNoCPP -fno-warn-unused-binds  #-}
+
+module Data.API.Test.Migration
+    ( migrationTests
+    ) where
+
+import           Data.API.Changes
+import           Data.API.PP
+import           Data.API.Tools
+import           Data.API.Test.MigrationData
+import           Data.API.Types
+import           Data.API.Utils
+
+import qualified Data.Aeson               as JS
+import qualified Data.Aeson.Encode.Pretty as JS
+import           Data.Attoparsec.Number
+import qualified Data.ByteString.Char8    as B
+import qualified Data.ByteString.Base64   as B64
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.HashMap.Strict      as HMap
+import qualified Data.Map                 as Map
+import qualified Data.Text                as T
+import           Data.Version
+import           Test.Tasty               as Test
+import           Test.Tasty.HUnit
+import           Test.Tasty.QuickCheck
+import           Test.QuickCheck.Property as P
+
+
+$(generateMigrationKinds changelog "TestDatabaseMigration" "TestRecordMigration" "TestFieldMigration")
+
+
+-- Test of a whole-database migration: copy data between tables
+testDatabaseMigration :: TestDatabaseMigration -> JS.Object -> Either ValueError JS.Object
+testDatabaseMigration DuplicateBar x = do
+    bar <- HMap.lookup "bar" x ?! CustomMigrationError "missing bar" (JS.Object x)
+    return $ HMap.insert "bar2" bar x
+testDatabaseMigration DuplicateRecursive x = do
+    recur <- HMap.lookup "recur" x ?! CustomMigrationError "missing recur" (JS.Object x)
+    return $ HMap.insert "recur2" recur x
+
+testDatabaseMigrationSchema :: TestDatabaseMigration -> NormAPI -> Maybe NormAPI
+testDatabaseMigrationSchema DuplicateBar _ = Nothing
+testDatabaseMigrationSchema DuplicateRecursive napi =
+    let Just recur = Map.lookup (TypeName "Recursive") napi
+        Just (NRecordType dbs) = Map.lookup root_ napi
+        dbs' = Map.insert (FieldName "recur2") (TyMaybe (TyList (TyName "DuplicateRecursive"))) dbs
+    in Just $ Map.insert (TypeName "DuplicateRecursive") recur $
+              Map.insert root_ (NRecordType dbs') napi
+
+
+-- Test of a single-record migration: copy the value in the id field
+-- onto the end of the c field
+testRecordMigration :: TestRecordMigration -> JS.Object -> Either ValueError JS.Object
+testRecordMigration CopyIDtoC x = do
+    i <- HMap.lookup "id" x ?! CustomMigrationError "missing id" (JS.Object x)
+    b <- HMap.lookup "c" x  ?! CustomMigrationError "missing b" (JS.Object x)
+    r <- case (i, b) of
+        (JS.Number (I j), JS.String t)
+            -> return $ JS.String $ t `T.append` T.pack (show j)
+        _   -> Left $ CustomMigrationError "bad data" (JS.Object x)
+    return $ HMap.insert "c" r x
+testRecordMigration DuplicateNew x = do
+    new <- HMap.lookup "new" x ?! CustomMigrationError "missing new" (JS.Object x)
+    return $ HMap.insert "newnew" new x
+
+testRecordMigrationSchema :: TestRecordMigration -> NormRecordType -> Maybe NormRecordType
+testRecordMigrationSchema CopyIDtoC _ = Nothing
+testRecordMigrationSchema DuplicateNew r =
+    Just $ Map.insert (FieldName "newnew") (TyBasic BTstring) r
+
+-- Test of a single-field migration: change the type of the field from
+-- binary to string by base64-decoding the contents
+testFieldMigration :: TestFieldMigration -> JS.Value -> Either ValueError JS.Value
+testFieldMigration ConvertBinaryToString v@(JS.String s) =
+    case B64.decode (B.pack (T.unpack s)) of
+        Left err  -> Left (CustomMigrationError err v)
+        Right x -> return (JS.String (T.pack (B.unpack x)))
+testFieldMigration ConvertBinaryToString v = Left $ CustomMigrationError "bad data" v
+
+
+testMigration :: CustomMigrations TestDatabaseMigration TestRecordMigration TestFieldMigration
+testMigration = CustomMigrations testDatabaseMigration testDatabaseMigrationSchema
+                                 testRecordMigration   testRecordMigrationSchema
+                                 testFieldMigration
+
+
+assertMatchesAPI :: String -> API -> JS.Value -> Assertion
+assertMatchesAPI x a v = case dataMatchesAPI root_ a v of
+    Right () -> return ()
+    Left err -> assertFailure (x ++ ": " ++ prettyValueErrorPosition err)
+
+basicMigrationTest :: Assertion
+basicMigrationTest = do
+    assertMatchesAPI "Start data does not match start API" startSchema startData
+    assertMatchesAPI "End data does not match end API"     endSchema   endData
+    case migrateDataDump (startSchema, startVersion) (endSchema, DevVersion)
+                         changelog testMigration root_ CheckAll startData of
+      Right (v, []) | endData == v -> return ()
+                    | otherwise    -> assertFailure $ "expected:\n"
+                                      ++ BL.unpack (JS.encodePretty endData)
+                                      ++ "\nbut got:\n"
+                                      ++ BL.unpack (JS.encodePretty v)
+      Right (_, ws) -> assertFailure $ "Unexpcted warnings: " ++ show ws
+      Left err      -> assertFailure (prettyMigrateFailure err)
+
+applyFailureTest :: (Version, Version, ApplyFailure) -> Test.TestTree
+applyFailureTest (ver, ver', expected) =
+    testCase (showVersion ver ++ " -> " ++ showVersion ver') $
+          case migrateDataDump (startSchema, ver) (endSchema, Release ver')
+                               badChangelog testMigration root_ CheckAll startData of
+            Right _ -> assertFailure $ "Successful migration!"
+            Left (ValidateFailure (ChangelogEntryInvalid _ _ err))
+                | err == expected -> return ()
+            Left err -> assertFailure $ unlines $ ["Unexpected failure:"]
+                        ++ indent (ppLines err) ++ ["Expecting:"]
+                        ++ indent (ppLines expected)
+
+migrateFailureTest :: MigrateFailureTest
+                    -> Test.TestTree
+migrateFailureTest (s, start, end, clog, db, expected) =
+    testCase s $ case migrateDataDump start end clog testMigration root_ CheckAll db of
+        Right _                 -> assertFailure $ "Successful migration!"
+        Left err | expected err -> return ()
+                 | otherwise    -> assertFailure $ unlines $ ["Unexpected failure:"]
+                                                             ++ indent (ppLines err)
+
+
+$(generate         startSchema)
+$(generateAPITools startSchema
+                   [ enumTool
+                   , jsonTool
+                   , quickCheckTool
+                   ])
+
+validMigrationProperty :: DatabaseSnapshot -> P.Result
+validMigrationProperty db =
+    case migrateDataDump (startSchema, startVersion) (endSchema, DevVersion)
+                         changelog testMigration root_ CheckStartAndEnd (JS.toJSON db) of
+    Right (v, []) -> case dataMatchesAPI root_ endSchema v of
+        Right _   -> succeeded
+        Left  err -> failedBecause ("end data does not match API: "
+                                    ++ prettyValueErrorPosition err)
+    Right (_, ws) -> failedBecause ("migration generated warnings: " ++ show ws)
+    Left err      -> failedBecause ("migration failed: " ++ prettyMigrateFailure err)
+  where
+    failedBecause e = P.MkResult (Just False) True e False False [] []
+
+
+migrationTests :: TestTree
+migrationTests = testGroup "Migration"
+  [ testCase     "Basic migration using sample changelog" basicMigrationTest
+  , testGroup    "Invalid changes"    $ map applyFailureTest   expectedApplyFailures
+  , testGroup    "Invalid migrations" $ map migrateFailureTest expectedMigrateFailures
+  , testProperty "Valid migrations"     validMigrationProperty
+  ]
diff --git a/tests/Data/API/Test/MigrationData.hs b/tests/Data/API/Test/MigrationData.hs
new file mode 100644
--- /dev/null
+++ b/tests/Data/API/Test/MigrationData.hs
@@ -0,0 +1,606 @@
+{-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE OverloadedStrings          #-}
+
+-- This module provides data for Data.API.Test.Migration; it is
+-- separated out because of the Template Haskell staging restriction.
+
+module Data.API.Test.MigrationData where
+
+import           Data.API.Changes
+import           Data.API.JSON
+import           Data.API.Parse
+import           Data.API.Types
+
+import qualified Data.Aeson as JS
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import           Data.Version
+import           Distribution.Text (simpleParse)
+
+
+startSchema :: API
+startSchema = [api|
+
+id :: Id
+    = basic integer
+
+idId :: IdId
+    = Id
+
+an_enum :: AnEnum
+    = enum
+      | foo
+      | bar
+
+another_enum :: AnotherEnum
+    = enum
+      | foo
+      | woo
+
+a_union :: AUnion
+    = union
+      | bar :: Bar
+
+another_union :: AnotherUnion
+    = union
+      | foo :: Foo
+      | woo :: Id
+
+dbs :: DatabaseSnapshot
+    = record
+        foo   :: ? [Foo]        nothing
+        bar   :: ? [Bar]        []
+        recur :: ? [Recursive]
+
+fooPrefix :: Foo
+    = record
+        id   :: Id
+        nest :: Nested
+        en   :: AnEnum
+        un   :: AUnion
+        quux :: ? IdId
+
+barPrefix :: Bar
+    = record
+       id :: Id
+
+nestedPrefix :: Nested
+    = record
+       id :: Id
+
+recursive :: Recursive
+    = record
+      id    :: Id
+      recur :: ? Recursive
+
+|]
+
+
+endSchema :: API
+changelog :: APIChangelog
+(endSchema, changelog) = [apiWithChangelog|
+
+id :: Id
+    = basic integer
+
+idId :: IdId
+    = Id
+
+bin :: Binary
+    = basic binary
+
+an_enum :: AnEnum
+    = enum
+      | foofoo
+      | bar
+      | baz
+
+another_enum :: AnotherEnum
+    = enum
+      | foo
+      | woo
+      | barbar
+
+a_union :: AUnion
+    = union
+      | barbar :: RenamedBar
+      | baz :: Baz
+
+another_union :: AnotherUnion
+    = union
+      | foo :: Foo
+      | woo :: Id
+      | barbar :: RenamedBar
+
+dbs :: DatabaseSnapshot
+    = record
+        foo   :: ? [Foo]
+        bar2  :: ? [Bar2]
+        boz   :: ? [Baz]
+        recur :: ? [Recursive]
+        recur2 :: ? [DuplicateRecursive]
+
+fooPrefix :: Foo
+    = record
+        id   :: Id
+        nest :: RenamedNested
+        en   :: AnEnum
+        un   :: AUnion
+        c    :: string
+        nolist  :: [string]
+        nomaybe :: ? string
+
+barPrefix :: RenamedBar
+    = record
+       id :: Id
+
+bar2Prefix :: Bar2
+    = record
+       id :: Id
+
+nestedPrefix :: RenamedNested
+    = record
+       id :: Id
+       new :: string
+
+bazPrefix :: Baz
+    = record
+       id :: Id
+       yy :: string
+
+recursive :: Recursive
+    = record
+        renamed_id :: Id
+        recur      :: ? Recursive
+        new        :: string
+        newnew     :: string
+
+duplicaterecursive :: DuplicateRecursive
+    = record
+        renamed_id :: Id
+        recur      :: ? Recursive
+        new        :: string
+
+new :: New
+    = basic integer
+
+changes
+
+version "development"
+  // changes since last release
+  added New basic integer
+
+version "2.6"
+  // add fields with implicit default values
+  changed record Foo
+    field added nolist  :: [string]
+    field added nomaybe :: ? string
+
+version "2.5"
+  // schema-changing custom record migration
+  migration record Recursive DuplicateNew
+
+version "2.4"
+  // schema-changing custom database migration
+  migration DuplicateRecursive
+
+version "2.3"
+  // changing a recursively defined record
+  changed record Recursive
+    field renamed id to renamed_id
+    field added new :: string default "hello"
+
+version "2.2"
+  // changing a nested union
+  changed union AUnion
+    alternative renamed bar to barbar
+
+version "2.1"
+  // Changing a nested enum
+  changed enum AnEnum
+    alternative renamed foo to foofoo
+
+version "2.0"
+  // Changing a nested record
+  changed record RenamedNested
+    field added new :: string default "hello"
+
+version "1.9"
+  // Deleting a table
+  changed record DatabaseSnapshot
+    field removed bar
+
+version "1.8"
+  // Renaming a table
+  changed record DatabaseSnapshot
+    field renamed baz to boz
+
+version "1.7"
+  // Adding a table
+  changed record DatabaseSnapshot
+    field added baz :: ? [Baz] default []
+
+version "1.6"
+  // Custom change to the whole database
+  migration DuplicateBar
+  changed record DatabaseSnapshot
+    field added bar2 :: ? [Bar2] default nothing
+  added Bar2 record
+    id :: Id
+
+version "1.5"
+  // Custom change to a record
+  migration record Foo CopyIDtoC
+
+version "1.4"
+  // Renaming enum values
+  changed enum AnotherEnum
+    alternative renamed bar to barbar
+
+version "1.3"
+  // Deleting enum values
+  changed enum AnotherEnum
+    alternative removed baz
+
+version "1.2"
+  // Adding enum values
+  changed enum AnEnum
+    alternative added baz
+  changed enum AnotherEnum
+    alternative added bar
+    alternative added baz
+
+version "1.1"
+  // Renaming union alternatives
+  changed union AnotherUnion
+    alternative renamed bar to barbar
+
+version "1.0"
+  // Deleting union alternatives
+  changed union AnotherUnion
+    alternative removed baz
+
+version "0.9"
+  // Adding union alternatives
+  changed union AUnion
+    alternative added baz :: Baz
+  changed union AnotherUnion
+    alternative added bar :: RenamedBar
+    alternative added baz :: Baz
+
+version "0.8"
+  // Custom migration on fields
+  changed record Foo
+    field changed c :: string migration ConvertBinaryToString
+
+version "0.7"
+  // Renaming fields
+  changed record Foo
+    field renamed b to c
+  changed record Baz
+    field renamed y to yy
+
+version "0.6"
+  // Deleting fields
+  changed record Foo
+    field removed quux
+  changed record Baz
+    field removed x
+
+version "0.5"
+  // Adding fields
+  changed record Foo
+    field added b :: Binary default "Zm9vYmFy"
+  changed record Baz
+    field added x :: integer
+    field added y :: string
+
+version "0.4"
+  // Renaming types
+  renamed Nested to RenamedNested
+  renamed Bar to RenamedBar
+
+version "0.3"
+  // Deleting types
+  removed ASynonym
+
+version "0.2"
+  // Adding types
+  added ASynonym Binary
+  added Binary basic binary
+  added Baz record
+    id :: Id
+
+version "0.1"
+  // No changes
+
+version "0"
+
+|]
+
+
+badChangelog :: APIChangelog
+(_, badChangelog) = [apiWithChangelog|
+changes
+
+version "3.1"
+  // Adding a table without a default
+  changed record DatabaseSnapshot
+    field added badtable :: Nested
+
+version "3.0"
+  // Renaming to an existing val
+  changed enum AnotherEnum
+    alternative renamed foo to woo
+
+version "2.9"
+  // Renaming a missing val
+  changed enum AnotherEnum
+    alternative renamed missing to also_missing
+
+version "2.8"
+  // Deleting a missing val
+  changed enum AnotherEnum
+    alternative removed missing
+
+version "2.7"
+  // Adding a val that already exists
+  changed enum AnEnum
+    alternative added bar
+
+version "2.6"
+  // Removing vals from a type in use
+  changed enum AnEnum
+    alternative removed foo
+
+version "2.5"
+  // Adding vals to a non-existent type
+  changed enum NotThere
+    alternative added oops
+
+version "2.4"
+  // Adding vals to a non-enum
+  changed enum Id
+    alternative added oops
+
+version "2.3"
+  // Renaming to an existing alt
+  changed union AnotherUnion
+    alternative renamed foo to woo
+
+version "2.2"
+  // Renaming a missing alt
+  changed union AnotherUnion
+    alternative renamed missing to also_missing
+
+version "2.1"
+  // Deleting a missing alt
+  changed union AnotherUnion
+    alternative removed missing
+
+version "2.0"
+  // Adding an alt that already exists
+  changed union AUnion
+    alternative added bar :: Bar
+
+version "1.9"
+  // Adding an alt with a malformed type
+  changed union AUnion
+    alternative added oops :: Missing
+
+version "1.8"
+  // Removing alts from a type in use
+  changed union AUnion
+    alternative removed foo
+
+version "1.7"
+  // Adding alts to a non-existent type
+  changed union NotThere
+    alternative added oops :: Id
+
+version "1.6"
+  // Adding alts to a non-union
+  changed union Id
+    alternative added oops :: Id
+
+version "1.5"
+  // Renaming to an existing field
+  changed record Foo
+    field renamed en to un
+
+version "1.4"
+  // Renaming a missing field
+  changed record Foo
+    field renamed missing to also_missing
+
+version "1.3"
+  // Deleting a missing field
+  changed record Foo
+    field removed missing
+
+version "1.2"
+  // Adding a field with an ill-typed default value
+  changed record Foo
+    field added oops :: Id default "hello"
+
+version "1.1"
+  // Adding a field without a default value
+  changed record Foo
+    field added oops :: Id
+
+version "1.0"
+  // Adding a field that already exists
+  changed record Foo
+    field added id :: Id
+
+version "0.9"
+  // Adding a field with a malformed type
+  changed record Foo
+    field added oops :: Missing
+
+// // This is now legal:
+// version "0.8"
+//  // Adding fields to a type in use
+//  changed record Nested
+//    field added oops :: Id
+
+version "0.7"
+  // Adding fields to a non-existent type
+  changed record NotThere
+    field added oops :: Id
+
+version "0.6"
+  // Adding fields to a non-record
+  changed record Id
+    field added oops :: Id
+
+version "0.5"
+  // Renaming to an existing type
+  renamed Id to AnEnum
+
+version "0.4"
+  // Renaming a missing type
+  renamed NotThere to SomethingElse
+
+version "0.3"
+  // Deleting a missing type
+  removed NotThere
+
+version "0.2"
+  // Adding an ill-formed type
+  added New Missing
+
+version "0.1"
+  // Adding a type that already exists
+  added Id basic binary
+
+version "0"
+|]
+
+expectedApplyFailures :: [(Version, Version, ApplyFailure)]
+expectedApplyFailures = map toVersions $
+  [ ("0",   "0.1", TypeExists (TypeName "Id"))
+  , ("0.1", "0.2", DeclMalformed (TypeName "New")
+                       (NTypeSynonym (TyName (TypeName "Missing")))
+                       (Set.singleton (TypeName "Missing")))
+  , ("0.2", "0.3", TypeDoesNotExist (TypeName "NotThere"))
+  , ("0.3", "0.4", TypeDoesNotExist (TypeName "NotThere"))
+  , ("0.4", "0.5", TypeExists (TypeName "AnEnum"))
+  , ("0.5", "0.6", TypeWrongKind (TypeName "Id") TKRecord)
+  , ("0.6", "0.7", TypeDoesNotExist (TypeName "NotThere"))
+--  , ("0.7", "0.8", TypeInUse (TypeName "Nested"))
+  , ("0.8", "0.9", TypeMalformed
+                       (TyName (TypeName "Missing"))
+                       (Set.singleton (TypeName "Missing")))
+  , ("0.9", "1.0", FieldExists (TypeName "Foo") TKRecord (FieldName "id"))
+  , ("1.0", "1.1", DefaultMissing (TypeName "Foo") (FieldName "oops"))
+  , ("1.1", "1.2", FieldBadDefaultValue (TypeName "Foo") (FieldName "oops")
+                       (TyName (TypeName "Id")) (DefValString (T.pack "hello")))
+  , ("1.2", "1.3", FieldDoesNotExist (TypeName "Foo") TKRecord (FieldName "missing"))
+  , ("1.3", "1.4", FieldDoesNotExist (TypeName "Foo") TKRecord (FieldName "missing"))
+  , ("1.4", "1.5", FieldExists (TypeName "Foo") TKRecord (FieldName "un"))
+  , ("1.5", "1.6", TypeWrongKind (TypeName "Id") TKUnion)
+  , ("1.6", "1.7", TypeDoesNotExist (TypeName "NotThere"))
+  , ("1.7", "1.8", TypeInUse (TypeName "AUnion"))
+  , ("1.8", "1.9", TypeMalformed
+                       (TyName (TypeName "Missing"))
+                       (Set.singleton (TypeName "Missing")))
+  , ("1.9", "2.0", FieldExists (TypeName "AUnion") TKUnion (FieldName "bar"))
+  , ("2.0", "2.1", FieldDoesNotExist (TypeName "AnotherUnion") TKUnion (FieldName "missing"))
+  , ("2.1", "2.2", FieldDoesNotExist (TypeName "AnotherUnion") TKUnion (FieldName "missing"))
+  , ("2.2", "2.3", FieldExists (TypeName "AnotherUnion") TKUnion (FieldName "woo"))
+  , ("2.3", "2.4", TypeWrongKind (TypeName "Id") TKEnum)
+  , ("2.4", "2.5", TypeDoesNotExist (TypeName "NotThere"))
+  , ("2.5", "2.6", TypeInUse (TypeName "AnEnum"))
+  , ("2.6", "2.7", FieldExists (TypeName "AnEnum") TKEnum (FieldName "bar"))
+  , ("2.7", "2.8", FieldDoesNotExist (TypeName "AnotherEnum") TKEnum (FieldName "missing"))
+  , ("2.8", "2.9", FieldDoesNotExist (TypeName "AnotherEnum") TKEnum (FieldName "missing"))
+  , ("2.9", "3.0", FieldExists (TypeName "AnotherEnum") TKEnum (FieldName "woo"))
+  , ("3.0", "3.1", DefaultMissing (TypeName "DatabaseSnapshot") (FieldName "badtable"))
+  ]
+  where
+    toVersions (s, s', x)
+      | Just v  <- simpleParse s
+      , Just v' <- simpleParse s'
+      , v < v'                    = (v, v', x)
+      | otherwise = error $ "expectedApplyFailures: bad versions "
+                            ++ show s ++ " and " ++ show s'
+
+type MigrateFailureTest = ( String
+                          , (API, Version)  -- Start version
+                          , (API, VersionExtra)  -- End version
+                          , APIChangelog
+                          , JS.Value
+                          , MigrateFailure -> Bool )
+
+expectedMigrateFailures :: [MigrateFailureTest]
+expectedMigrateFailures =
+  [ ( "Out of order"
+    , (startSchema, ver "0.1")
+    , (endSchema, verRelease "0.2")
+    , outOfOrder
+    , startData
+    , (== ValidateFailure (ChangelogOutOfOrder (verRelease "0.1") (verRelease "0.2")))
+    )
+
+  , ("Incomplete"
+    , (startSchema, ver "0.1")
+    , (endSchema, verRelease "2.5")
+    , incomplete
+    , startData
+    , \ err -> case err of
+                 ValidateFailure (ChangelogIncomplete _ _ _) -> True
+                 _                                           -> False
+    )
+
+  , ( "Downgrade"
+    , (startSchema, ver "0.2")
+    , (startSchema, verRelease "0.1")
+    , changelog
+    , startData
+    , (== ValidateFailure (CannotDowngrade (verRelease "0.2") (verRelease "0.1")))
+    )
+
+  , ("Bad custom migration"
+    , (startSchema, ver "0.1")
+    , (startSchema, verRelease "0.2")
+    , badCustomMigration
+    , startData
+    , \ err -> case err of
+                 ValueError (JSONError UnexpectedField) [InField t] -> t == "bar2"
+                 _                                                  -> False
+    )
+  ]
+  where
+    ver s | Just v <- simpleParse s = v
+          | otherwise = error $ "expectedValidateFailures: bad version " ++ show s
+    verRelease s = Release $ ver s
+
+    outOfOrder = snd [apiWithChangelog|
+changes
+version "0.1"
+version "0.2"
+|]
+
+    incomplete = snd [apiWithChangelog|
+changes
+version "0.1"
+|]
+
+    badCustomMigration = snd [apiWithChangelog|
+changes
+version "0.2"
+  migration DuplicateBar
+version "0.1"
+|]
+
+
+startData, endData :: JS.Value
+Just startData = JS.decode "{ \"foo\": [ {\"id\": 42, \"nest\": { \"id\": 3 }, \"en\": \"foo\", \"un\": { \"bar\": { \"id\": 43 } }, \"quux\": null } ], \"bar\": [ { \"id\": 4 } ], \"recur\": [{ \"id\": 9, \"recur\": { \"id\": 8, \"recur\": null} }] }"
+Just endData = JS.decode "{ \"foo\": [ {\"id\":42, \"nest\": { \"id\": 3, \"new\": \"hello\" }, \"c\": \"foobar42\", \"en\": \"foofoo\", \"un\": { \"barbar\": { \"id\": 43 } }, \"nolist\": [], \"nomaybe\": null } ], \"boz\": [], \"bar2\": [ {\"id\": 4 } ], \"recur\": [{ \"renamed_id\": 9, \"new\": \"hello\", \"newnew\": \"hello\", \"recur\": { \"renamed_id\": 8, \"new\": \"hello\", \"newnew\": \"hello\", \"recur\": null} }], \"recur2\": [{ \"renamed_id\": 9, \"new\": \"hello\", \"recur\": { \"renamed_id\": 8, \"new\": \"hello\", \"newnew\": \"hello\", \"recur\": null} }] }"
+
+startVersion :: Version
+startVersion = changelogStartVersion changelog
+
+root_ :: TypeName
+root_ = TypeName "DatabaseSnapshot"