diff --git a/Data/Aeson.hs b/Data/Aeson.hs
--- a/Data/Aeson.hs
+++ b/Data/Aeson.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- |
 -- Module:      Data.Aeson
 -- Copyright:   (c) 2011, 2012 Bryan O'Sullivan
@@ -38,6 +40,11 @@
     , eitherDecode
     , eitherDecode'
     , encode
+    -- ** Variants for strict bytestrings
+    , decodeStrict
+    , decodeStrict'
+    , eitherDecodeStrict
+    , eitherDecodeStrict'
     -- * Core JSON types
     , Value(..)
     , Array
@@ -49,6 +56,13 @@
     , Result(..)
     , fromJSON
     , ToJSON(..)
+#ifdef GENERICS
+    -- ** Generic JSON classes
+    , GFromJSON(..)
+    , GToJSON(..)
+    , genericToJSON
+    , genericParseJSON
+#endif
     -- * Inspecting @'Value's@
     , withObject
     , withText
@@ -67,40 +81,91 @@
     ) where
 
 import Data.Aeson.Encode (encode)
-import Data.Aeson.Parser.Internal (decodeWith, eitherDecodeWith, json, json')
+import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith,
+                                   eitherDecodeWith, eitherDecodeStrictWith,
+                                   jsonEOF, json, jsonEOF', json')
 import Data.Aeson.Types
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 
 -- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
 -- If this fails due to incomplete or invalid input, 'Nothing' is
 -- returned.
 --
+-- The input must consist solely of a JSON document, with no trailing
+-- data except for whitespace. This restriction is necessary to ensure
+-- that if data is being lazily read from a file handle, the file
+-- handle will be closed in a timely fashion once the document has
+-- been parsed.
+--
 -- This function parses immediately, but defers conversion.  See
 -- 'json' for details.
 decode :: (FromJSON a) => L.ByteString -> Maybe a
-decode = decodeWith json fromJSON
+decode = decodeWith jsonEOF fromJSON
 {-# INLINE decode #-}
 
+-- | Efficiently deserialize a JSON value from a strict 'B.ByteString'.
+-- If this fails due to incomplete or invalid input, 'Nothing' is
+-- returned.
+--
+-- The input must consist solely of a JSON document, with no trailing
+-- data except for whitespace.
+--
+-- This function parses immediately, but defers conversion.  See
+-- 'json' for details.
+decodeStrict :: (FromJSON a) => B.ByteString -> Maybe a
+decodeStrict = decodeStrictWith jsonEOF fromJSON
+{-# INLINE decodeStrict #-}
+
 -- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
 -- If this fails due to incomplete or invalid input, 'Nothing' is
 -- returned.
 --
+-- The input must consist solely of a JSON document, with no trailing
+-- data except for whitespace. This restriction is necessary to ensure
+-- that if data is being lazily read from a file handle, the file
+-- handle will be closed in a timely fashion once the document has
+-- been parsed.
+--
 -- This function parses and performs conversion immediately.  See
 -- 'json'' for details.
 decode' :: (FromJSON a) => L.ByteString -> Maybe a
-decode' = decodeWith json' fromJSON
+decode' = decodeWith jsonEOF' fromJSON
 {-# INLINE decode' #-}
 
+-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
+-- If this fails due to incomplete or invalid input, 'Nothing' is
+-- returned.
+--
+-- The input must consist solely of a JSON document, with no trailing
+-- data except for whitespace.
+--
+-- This function parses and performs conversion immediately.  See
+-- 'json'' for details.
+decodeStrict' :: (FromJSON a) => B.ByteString -> Maybe a
+decodeStrict' = decodeStrictWith jsonEOF' fromJSON
+{-# INLINE decodeStrict' #-}
+
 -- | Like 'decode' but returns an error message when decoding fails.
 eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
-eitherDecode = eitherDecodeWith json fromJSON
+eitherDecode = eitherDecodeWith jsonEOF fromJSON
 {-# INLINE eitherDecode #-}
 
+-- | Like 'decodeStrict' but returns an error message when decoding fails.
+eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a
+eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON
+{-# INLINE eitherDecodeStrict #-}
+
 -- | Like 'decode'' but returns an error message when decoding fails.
 eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a
-eitherDecode' = eitherDecodeWith json' fromJSON
+eitherDecode' = eitherDecodeWith jsonEOF' fromJSON
 {-# INLINE eitherDecode' #-}
 
+-- | Like 'decodeStrict'' but returns an error message when decoding fails.
+eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a
+eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON
+{-# INLINE eitherDecodeStrict' #-}
+
 -- $use
 --
 -- This section contains basic information on the different ways to
@@ -119,13 +184,13 @@
 -- > data Person = Person
 -- >     { name :: Text
 -- >     , age  :: Int
--- >     } deriving Show-
+-- >     } deriving Show
 --
 -- To decode data, we need to define a 'FromJSON' instance:
 --
 -- > {-# LANGUAGE OverloadedStrings #-}
 -- >
--- > instance FromJSON Coord where
+-- > instance FromJSON Person where
 -- >     parseJSON (Object v) = Person <$>
 -- >                            v .: "name" <*>
 -- >                            v .: "age"
@@ -269,10 +334,11 @@
 -- $pitfalls
 -- #pitfalls#
 --
--- Note that the JSON standard only allows arrays or objects of things
--- at the top-level. Since this library follows the standard, calling
--- 'decode' on an unsupported result type will typecheck, but will
--- always \"fail\":
+-- Note that the JSON standard requires that the top-level value be
+-- either an array or an object. If you try to use 'decode' with a
+-- result type that is /not/ represented in JSON as an array or
+-- object, your code will typecheck, but it will always \"fail\" at
+-- runtime:
 --
 -- > >>> decode "1" :: Maybe Int
 -- > Nothing
@@ -314,5 +380,5 @@
 --   converted to an AST, then the 'FromJSON' class is used to convert
 --   to the desired type.
 --
--- For convenience, the 'encode' and
--- 'decode' functions combine both steps for convenience.
+-- For convenience, the 'encode' and 'decode' functions combine both
+-- steps.
diff --git a/Data/Aeson/Generic.hs b/Data/Aeson/Generic.hs
--- a/Data/Aeson/Generic.hs
+++ b/Data/Aeson/Generic.hs
@@ -1,13 +1,13 @@
-{-# LANGUAGE PatternGuards, Rank2Types, ScopedTypeVariables #-}
+{-# LANGUAGE PatternGuards, Rank2Types, ScopedTypeVariables, CPP #-}
 
 -- |
 -- Module:      Data.Aeson.Generic
--- Copyright:   (c) 2011, 2012 Bryan O'Sullivan
+-- Copyright:   (c) 2011, 2012, 2013 Bryan O'Sullivan
 --              (c) 2011 MailRank, Inc.
 --              (c) 2008, 2009 Lennart Augustsson
 -- License:     BSD3
 -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
--- Stability:   experimental
+-- Stability:   DEPRECATED
 -- Portability: portable
 --
 -- JSON handling using 'Data.Generics'.
@@ -16,6 +16,7 @@
 -- by Lennart Augustsson.
 
 module Data.Aeson.Generic
+{-# DEPRECATED "This module will be /REMOVED/ in version 0.7.0.0. Please switch to GHC generics or Data.Aeson.TH instead. These alternatives are less buggy, faster, and more configurable." #-}
     (
     -- * Decoding and encoding
       decode
@@ -84,6 +85,7 @@
 
 toJSON :: (Data a) => a -> Value
 toJSON = toJSON_generic
+         `ext1Q` maybe Null toJSON
          `ext1Q` list
          `ext1Q` vector
          `ext1Q` set
@@ -187,6 +189,7 @@
 
 parseJSON :: (Data a) => Value -> Parser a
 parseJSON j = parseJSON_generic j
+             `ext1R` maybeP
              `ext1R` list
              `ext1R` vector
              `ext2R'` mapAny
@@ -222,6 +225,8 @@
   where
     value :: (T.FromJSON a) => Parser a
     value = T.parseJSON j
+    maybeP :: (Data a) => Parser (Maybe a)
+    maybeP = if j == Null then return Nothing else Just <$> parseJSON j
     list :: (Data a) => Parser [a]
     list = V.toList <$> parseJSON j
     vector :: (Data a) => Parser (V.Vector a)
@@ -334,21 +339,33 @@
 -- Type extension for binary type constructors.
 
 -- | Flexible type extension
+#if MIN_VERSION_base(4,7,0)
+ext2' :: (Data a, Typeable t)
+#else
 ext2' :: (Data a, Typeable2 t)
+#endif
      => c a
      -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))
      -> c a
 ext2' def ext = maybe def id (dataCast2 ext)
 
 -- | Type extension of queries for type constructors
+#if MIN_VERSION_base(4,7,0)
+ext2Q' :: (Data d, Typeable t)
+#else
 ext2Q' :: (Data d, Typeable2 t)
+#endif
       => (d -> q)
       -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)
       -> d -> q
 ext2Q' def ext = unQ ((Q def) `ext2'` (Q ext))
 
 -- | Type extension of readers for type constructors
+#if MIN_VERSION_base(4,7,0)
+ext2R' :: (Monad m, Data d, Typeable t)
+#else
 ext2R' :: (Monad m, Data d, Typeable2 t)
+#endif
       => m d
       -> (forall d1 d2. (Data d1, Data d2) => m (t d1 d2))
       -> m d
diff --git a/Data/Aeson/Parser/Internal.hs b/Data/Aeson/Parser/Internal.hs
--- a/Data/Aeson/Parser/Internal.hs
+++ b/Data/Aeson/Parser/Internal.hs
@@ -15,15 +15,17 @@
 module Data.Aeson.Parser.Internal
     (
     -- * Lazy parsers
-      json
+      json, jsonEOF
     , value
     , jstring
     -- * Strict parsers
-    , json'
+    , json', jsonEOF'
     , value'
     -- * Helpers
     , decodeWith
+    , decodeStrictWith
     , eitherDecodeWith
+    , eitherDecodeStrictWith
     ) where
 
 import Blaze.ByteString.Builder (fromByteString, toByteString)
@@ -37,7 +39,7 @@
 import Data.Char (chr)
 import Data.Monoid (mappend, mempty)
 import Data.Text as T
-import Data.Text.Encoding (decodeUtf8)
+import Data.Text.Encoding (decodeUtf8')
 import Data.Vector as Vector hiding ((++))
 import Data.Word (Word8)
 import qualified Data.Attoparsec as A
@@ -175,11 +177,16 @@
                                         then Nothing
                                         else Just (c == backslash)
   _ <- A.word8 doubleQuote
-  if backslash `B.elem` s
-    then case Z.parse unescape s of
-           Right r  -> return (decodeUtf8 r)
-           Left err -> fail err
-    else return (decodeUtf8 s)
+  s' <- if backslash `B.elem` s
+        then case Z.parse unescape s of
+            Right r  -> return r
+            Left err -> fail err
+         else return s
+
+  case decodeUtf8' s' of
+      Right r  -> return r
+      Left err -> fail $ show err
+
 {-# INLINE jstring_ #-}
 
 unescape :: Z.Parser ByteString
@@ -239,7 +246,18 @@
       _          -> Nothing
 {-# INLINE decodeWith #-}
 
-eitherDecodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Either String a
+decodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
+                 -> Maybe a
+decodeStrictWith p to s =
+    case A.parse p s of
+      A.Done _ v -> case to v of
+                      Success a -> Just a
+                      _         -> Nothing
+      _          -> Nothing
+{-# INLINE decodeStrictWith #-}
+
+eitherDecodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString
+                 -> Either String a
 eitherDecodeWith p to s =
     case L.parse p s of
       L.Done _ v -> case to v of
@@ -248,6 +266,17 @@
       L.Fail _ _ msg -> Left msg
 {-# INLINE eitherDecodeWith #-}
 
+eitherDecodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
+                       -> Either String a
+eitherDecodeStrictWith p to s =
+    case A.parse p s of
+      A.Done _ v -> case to v of
+                      Success a -> Right a
+                      Error msg -> Left msg
+      A.Fail _ _ msg -> Left msg
+      A.Partial _    -> Left "incomplete input"
+{-# INLINE eitherDecodeStrictWith #-}
+
 -- $lazy
 --
 -- The 'json' and 'value' parsers decouple identification from
@@ -266,3 +295,13 @@
 -- The 'json'' and 'value'' parsers combine identification with
 -- conversion.  They consume more CPU cycles up front, but have a
 -- smaller memory footprint.
+
+-- | Parse a top-level JSON value followed by optional whitespace and
+-- end-of-input.  See also: 'json'.
+jsonEOF :: Parser Value
+jsonEOF = json <* skipSpace <* endOfInput
+
+-- | Parse a top-level JSON value followed by optional whitespace and
+-- end-of-input.  See also: 'json''.
+jsonEOF' :: Parser Value
+jsonEOF' = json' <* skipSpace <* endOfInput
diff --git a/Data/Aeson/TH.hs b/Data/Aeson/TH.hs
--- a/Data/Aeson/TH.hs
+++ b/Data/Aeson/TH.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE CPP, NoImplicitPrelude, TemplateHaskell #-}
+{-# LANGUAGE CPP, FlexibleInstances, NamedFieldPuns, NoImplicitPrelude,
+    OverlappingInstances, TemplateHaskell, UndecidableInstances, IncoherentInstances
+  #-}
 
 {-|
 Module:      Data.Aeson.TH
@@ -25,96 +27,15 @@
                   } deriving Eq
 @
 
-Next we derive the necessary instances. Note that we make use of the feature to
-change record field names. In this case we drop the first 4 characters of every
-field name.
-
-@
-$('deriveJSON' ('drop' 4) ''D)
-@
-
-This will result in the following (simplified) code to be spliced in your program:
-
-@
-import Control.Applicative
-import Control.Monad
-import Data.Aeson
-import Data.Aeson.TH
-import qualified Data.HashMap.Strict as H
-import qualified Data.Text as T
-import qualified Data.Vector as V
-
-instance 'ToJSON' a => 'ToJSON' (D a) where
-    'toJSON' =
-      \\value ->
-        case value of
-          Nullary ->
-              'object' [T.pack \"Nullary\" .= 'toJSON' ([] :: [()])]
-          Unary arg1 ->
-              'object' [T.pack \"Unary\" .= 'toJSON' arg1]
-          Product arg1 arg2 arg3 ->
-              'object' [ T.pack \"Product\"
-                       .= ('Array' $ 'V.create' $ do
-                             mv <- 'VM.unsafeNew' 3
-                             'VM.unsafeWrite' mv 0 ('toJSON' arg1)
-                             'VM.unsafeWrite' mv 1 ('toJSON' arg2)
-                             'VM.unsafeWrite' mv 2 ('toJSON' arg3)
-                             return mv)
-                     ]
-          Record arg1 arg2 arg3 ->
-              'object' [ T.pack \"Record\"
-                       .= 'object' [ T.pack \"One\"   '.=' arg1
-                                 , T.pack \"Two\"   '.=' arg2
-                                 , T.pack \"Three\" '.=' arg3
-                                 ]
-                     ]
-@
+Next we derive the necessary instances. Note that we make use of the
+feature to change record field names. In this case we drop the first 4
+characters of every field name. We also modify constructor names by
+lower-casing them:
 
 @
-instance 'FromJSON' a => 'FromJSON' (D a) where
-    'parseJSON' =
-      \\value ->
-        case value of
-          'Object' obj ->
-            case H.toList obj of
-              [(conKey, conVal)] ->
-                case conKey of
-                  _ | conKey == T.pack \"Nullary\" ->
-                        case conVal of
-                          'Array' arr ->
-                            if V.null arr
-                            then pure Nullary
-                            else fail \"\<error message\>\"
-                          _ -> fail \"\<error message\>\"
-                    | conKey == T.pack \"Unary\" ->
-                        case conVal of
-                          arg -> Unary \<$\> parseJSON arg
-                    | conKey == T.pack \"Product\" ->
-                        case conVal of
-                          'Array' arr ->
-                            if V.length arr == 3
-                            then Product \<$\> 'parseJSON' (arr `V.unsafeIndex` 0)
-                                         \<*\> 'parseJSON' (arr `V.unsafeIndex` 1)
-                                         \<*\> 'parseJSON' (arr `V.unsafeIndex` 2)
-                            else fail \"\<error message\>\"
-                          _ -> fail \"\<error message\>\"
-                    | conKey == T.pack \"Record\" ->
-                        case conVal of
-                          'Object' recObj ->
-                            if H.size recObj == 3
-                            then Record \<$\> recObj '.:' T.pack \"One\"
-                                        \<*\> recObj '.:' T.pack \"Two\"
-                                        \<*\> recObj '.:' T.pack \"Three\"
-                            else fail \"\<error message\>\"
-                          _ -> fail \"\<error message\>\"
-                    | otherwise -> fail \"\<error message\>\"
-              _ -> fail \"\<error message\>\"
-          _ -> fail \"\<error message\>\"
+$('deriveJSON' 'defaultOptions'{'fieldLabelModifier' = 'drop' 4, 'constructorTagModifier' = map toLower} ''D)
 @
 
-Note that every \"\<error message\>\" is in fact a descriptive message which
-provides as much information as is reasonable about the failed parse.
-
 Now we can use the newly created instances.
 
 @
@@ -132,14 +53,18 @@
 
 @
 -- FromJSON and ToJSON instances for 4-tuples.
-$('deriveJSON' id ''(,,,))
+$('deriveJSON' 'defaultOptions' ''(,,,))
 @
 
 -}
 
 module Data.Aeson.TH
-    ( deriveJSON
+    ( -- * Encoding configuration
+      Options(..), SumEncoding(..), defaultOptions, defaultTaggedObject
 
+     -- * FromJSON and ToJSON derivation
+    , deriveJSON
+
     , deriveToJSON
     , deriveFromJSON
 
@@ -152,37 +77,45 @@
 --------------------------------------------------------------------------------
 
 -- from aeson:
-import Data.Aeson ( toJSON, Object, object, (.=)
+import Data.Aeson ( toJSON, Object, object, (.=), (.:), (.:?)
                   , ToJSON, toJSON
                   , FromJSON, parseJSON
                   )
-import Data.Aeson.Types ( Value(..), Parser )
+import Data.Aeson.Types ( Value(..), Parser
+                        , Options(..)
+                        , SumEncoding(..)
+                        , defaultOptions
+                        , defaultTaggedObject
+                        )
 -- from base:
 import Control.Applicative ( pure, (<$>), (<*>) )
 import Control.Monad       ( return, mapM, liftM2, fail )
-import Data.Bool           ( otherwise )
+import Data.Bool           ( Bool(False, True), otherwise, (&&) )
 import Data.Eq             ( (==) )
-import Data.Function       ( ($), (.), id )
+import Data.Function       ( ($), (.) )
 import Data.Functor        ( fmap )
+import Data.Int            ( Int )
+import Data.Either         ( Either(Left, Right) )
 import Data.List           ( (++), foldl, foldl', intercalate
-                           , length, map, zip, genericLength
+                           , length, map, zip, genericLength, all, partition
                            )
-import Data.Maybe          ( Maybe(Nothing, Just) )
+import Data.Maybe          ( Maybe(Nothing, Just), catMaybes )
 import Prelude             ( String, (-), Integer, fromIntegral, error )
 import Text.Printf         ( printf )
 import Text.Show           ( show )
 #if __GLASGOW_HASKELL__ < 700
-import Control.Monad       ( (>>=) )
+import Control.Monad       ( (>>=), (>>) )
 import Prelude             ( fromInteger )
 #endif
 -- from unordered-containers:
-import qualified Data.HashMap.Strict as H ( lookup, toList, size )
+import qualified Data.HashMap.Strict as H ( lookup, toList )
 -- from template-haskell:
 import Language.Haskell.TH
+import Language.Haskell.TH.Syntax ( VarStrictType )
 -- from text:
 import qualified Data.Text as T ( Text, pack, unpack )
 -- from vector:
-import qualified Data.Vector as V ( unsafeIndex, null, length, create )
+import qualified Data.Vector as V ( unsafeIndex, null, length, create, fromList )
 import qualified Data.Vector.Mutable as VM ( unsafeNew, unsafeWrite )
 
 
@@ -195,16 +128,16 @@
 --
 -- This is a convienience function which is equivalent to calling both
 -- 'deriveToJSON' and 'deriveFromJSON'.
-deriveJSON :: (String -> String)
-           -- ^ Function to change field names.
+deriveJSON :: Options
+           -- ^ Encoding options.
            -> Name
            -- ^ Name of the type for which to generate 'ToJSON' and 'FromJSON'
            -- instances.
            -> Q [Dec]
-deriveJSON withField name =
+deriveJSON opts name =
     liftM2 (++)
-           (deriveToJSON   withField name)
-           (deriveFromJSON withField name)
+           (deriveToJSON   opts name)
+           (deriveFromJSON opts name)
 
 
 --------------------------------------------------------------------------------
@@ -221,33 +154,13 @@
 -}
 
 -- | Generates a 'ToJSON' instance declaration for the given data type.
---
--- Example:
---
--- @
--- data Foo = Foo 'Char' 'Int'
--- $('deriveToJSON' 'id' ''Foo)
--- @
---
--- This will splice in the following code:
---
--- @
--- instance 'ToJSON' Foo where
---      'toJSON' =
---          \\value -> case value of
---                      Foo arg1 arg2 -> 'Array' $ 'V.create' $ do
---                        mv <- 'VM.unsafeNew' 2
---                        'VM.unsafeWrite' mv 0 ('toJSON' arg1)
---                        'VM.unsafeWrite' mv 1 ('toJSON' arg2)
---                        return mv
--- @
-deriveToJSON :: (String -> String)
-             -- ^ Function to change field names.
+deriveToJSON :: Options
+             -- ^ Encoding options.
              -> Name
              -- ^ Name of the type for which to generate a 'ToJSON' instance
              -- declaration.
              -> Q [Dec]
-deriveToJSON withField name =
+deriveToJSON opts name =
     withType name $ \tvbs cons -> fmap (:[]) $ fromCons tvbs cons
   where
     fromCons :: [TyVarBndr] -> [Con] -> Q Dec
@@ -256,7 +169,7 @@
                   (classType `appT` instanceType)
                   [ funD 'toJSON
                          [ clause []
-                                  (normalB $ consToJSON withField cons)
+                                  (normalB $ consToJSON opts cons)
                                   []
                          ]
                   ]
@@ -266,126 +179,181 @@
         instanceType = foldl' appT (conT name) $ map varT typeNames
 
 -- | Generates a lambda expression which encodes the given data type as JSON.
---
--- Example:
---
--- @
--- data Foo = Foo Int
--- @
---
--- @
--- encodeFoo :: Foo -> 'Value'
--- encodeFoo = $('mkToJSON' id ''Foo)
--- @
---
--- This will splice in the following code:
---
--- @
--- \\value -> case value of Foo arg1 -> 'toJSON' arg1
--- @
-mkToJSON :: (String -> String) -- ^ Function to change field names.
+mkToJSON :: Options -- ^ Encoding options.
          -> Name -- ^ Name of the type to encode.
          -> Q Exp
-mkToJSON withField name = withType name (\_ cons -> consToJSON withField cons)
+mkToJSON opts name = withType name (\_ cons -> consToJSON opts cons)
 
 -- | Helper function used by both 'deriveToJSON' and 'mkToJSON'. Generates code
 -- to generate the JSON encoding of a number of constructors. All constructors
 -- must be from the same type.
-consToJSON :: (String -> String)
-           -- ^ Function to change field names.
+consToJSON :: Options
+           -- ^ Encoding options.
            -> [Con]
            -- ^ Constructors for which to generate JSON generating code.
            -> Q Exp
+
 consToJSON _ [] = error $ "Data.Aeson.TH.consToJSON: "
                           ++ "Not a single constructor given!"
+
 -- A single constructor is directly encoded. The constructor itself may be
 -- forgotten.
-consToJSON withField [con] = do
+consToJSON opts [con] = do
     value <- newName "value"
-    lam1E (varP value)
-          $ caseE (varE value)
-                  [encodeArgs id withField con]
--- With multiple constructors we need to remember which constructor is
--- encoded. This is done by generating a JSON object which maps to constructor's
--- name to the JSON encoding of its contents.
-consToJSON withField cons = do
+    lam1E (varP value) $ caseE (varE value) [encodeArgs opts False con]
+
+consToJSON opts cons = do
     value <- newName "value"
-    lam1E (varP value)
-          $ caseE (varE value)
-                  [ encodeArgs (wrap $ getConName con) withField con
-                  | con <- cons
-                  ]
+    lam1E (varP value) $ caseE (varE value) matches
   where
-    wrap :: Name -> Q Exp -> Q Exp
-    wrap name exp =
-        let fieldName = [e|T.pack|] `appE` litE (stringL $ nameBase name)
-        in [e|object|] `appE` listE [ infixApp fieldName
-                                               [e|(.=)|]
-                                               exp
-                                    ]
+    matches
+        | allNullaryToStringTag opts && all isNullary cons =
+              [ match (conP conName []) (normalB $ conStr opts conName) []
+              | con <- cons
+              , let conName = getConName con
+              ]
+        | otherwise = [encodeArgs opts True con | con <- cons]
 
+conStr :: Options -> Name -> Q Exp
+conStr opts = appE [|String|] . conTxt opts
+
+conTxt :: Options -> Name -> Q Exp
+conTxt opts = appE [|T.pack|] . conStringE opts
+
+conStringE :: Options -> Name -> Q Exp
+conStringE opts = stringE . constructorTagModifier opts . nameBase
+
+-- | If constructor is nullary.
+isNullary :: Con -> Bool
+isNullary (NormalC _ []) = True
+isNullary _ = False
+
+encodeSum :: Options -> Bool -> Name -> Q Exp -> Q Exp
+encodeSum opts multiCons conName exp
+    | multiCons =
+        case sumEncoding opts of
+          TwoElemArray ->
+              [|Array|] `appE` ([|V.fromList|] `appE` listE [conStr opts conName, exp])
+          TaggedObject{tagFieldName, contentsFieldName} ->
+              [|object|] `appE` listE
+                [ infixApp [|T.pack tagFieldName|]     [|(.=)|] (conStr opts conName)
+                , infixApp [|T.pack contentsFieldName|] [|(.=)|] exp
+                ]
+          ObjectWithSingleField ->
+              [|object|] `appE` listE
+                [ infixApp (conTxt opts conName) [|(.=)|] exp
+                ]
+
+    | otherwise = exp
+
 -- | Generates code to generate the JSON encoding of a single constructor.
-encodeArgs :: (Q Exp -> Q Exp) -> (String -> String) -> Con -> Q Match
+encodeArgs :: Options -> Bool -> Con -> Q Match
 -- Nullary constructors. Generates code that explicitly matches against the
 -- constructor even though it doesn't contain data. This is useful to prevent
 -- type errors.
-encodeArgs withExp _ (NormalC conName []) =
+encodeArgs  opts multiCons (NormalC conName []) =
     match (conP conName [])
-          (normalB $ withExp [e|toJSON ([] :: [()])|])
+          (normalB (encodeSum opts multiCons conName [e|toJSON ([] :: [()])|]))
           []
+
 -- Polyadic constructors with special case for unary constructors.
-encodeArgs withExp _ (NormalC conName ts) = do
+encodeArgs opts multiCons (NormalC conName ts) = do
     let len = length ts
     args <- mapM newName ["arg" ++ show n | n <- [1..len]]
-    js <- case [[e|toJSON|] `appE` varE arg | arg <- args] of
+    js <- case [[|toJSON|] `appE` varE arg | arg <- args] of
             -- Single argument is directly converted.
             [e] -> return e
             -- Multiple arguments are converted to a JSON array.
             es  -> do
               mv <- newName "mv"
               let newMV = bindS (varP mv)
-                                ([e|VM.unsafeNew|] `appE`
+                                ([|VM.unsafeNew|] `appE`
                                   litE (integerL $ fromIntegral len))
                   stmts = [ noBindS $
-                              [e|VM.unsafeWrite|] `appE`
+                              [|VM.unsafeWrite|] `appE`
                                 (varE mv) `appE`
                                   litE (integerL ix) `appE`
                                     e
                           | (ix, e) <- zip [(0::Integer)..] es
                           ]
-                  ret = noBindS $ [e|return|] `appE` varE mv
-              return $ [e|Array|] `appE`
+                  ret = noBindS $ [|return|] `appE` varE mv
+              return $ [|Array|] `appE`
                          (varE 'V.create `appE`
                            doE (newMV:stmts++[ret]))
     match (conP conName $ map varP args)
-          (normalB $ withExp js)
+          (normalB $ encodeSum opts multiCons conName js)
           []
+
 -- Records.
-encodeArgs withExp withField (RecC conName ts) = do
+encodeArgs opts multiCons (RecC conName ts) = do
     args <- mapM newName ["arg" ++ show n | (_, n) <- zip ts [1 :: Integer ..]]
-    let js = [ infixApp ([e|T.pack|] `appE` fieldNameExp withField field)
-                        [e|(.=)|]
-                        (varE arg)
-             | (arg, (field, _, _)) <- zip args ts
-             ]
+    let exp = [|object|] `appE` pairs
+
+        pairs | omitNothingFields opts = infixApp maybeFields
+                                                  [|(++)|]
+                                                  restFields
+              | otherwise = listE $ map toPair argCons
+
+        argCons = zip args ts
+
+        maybeFields = [|catMaybes|] `appE` listE (map maybeToPair maybes)
+
+        restFields = listE $ map toPair rest
+
+        (maybes, rest) = partition isMaybe argCons
+
+        isMaybe (_, (_, _, AppT (ConT t) _)) = t == ''Maybe
+        isMaybe _ = False
+
+        maybeToPair (arg, (field, _, _)) =
+            infixApp (infixE (Just $ toFieldName field)
+                             [|(.=)|]
+                             Nothing)
+                     [|(<$>)|]
+                     (varE arg)
+
+        toPair (arg, (field, _, _)) =
+            infixApp (toFieldName field)
+                     [|(.=)|]
+                     (varE arg)
+
+        toFieldName field = [|T.pack|] `appE` fieldLabelExp opts field
+
     match (conP conName $ map varP args)
-          (normalB $ withExp $ [e|object|] `appE` listE js)
-          []
+          ( normalB
+          $ if multiCons
+            then case sumEncoding opts of
+                   TwoElemArray -> [|toJSON|] `appE` tupE [conStr opts conName, exp]
+                   TaggedObject{tagFieldName} ->
+                       [|object|] `appE`
+                         -- TODO: Maybe throw an error in case
+                         -- tagFieldName overwrites a field in pairs.
+                         infixApp (infixApp [|T.pack tagFieldName|]
+                                            [|(.=)|]
+                                            (conStr opts conName))
+                                  [|(:)|]
+                                  pairs
+                   ObjectWithSingleField ->
+                       [|object|] `appE` listE
+                         [ infixApp (conTxt opts conName) [|(.=)|] exp ]
+            else exp
+          ) []
+
 -- Infix constructors.
-encodeArgs withExp _ (InfixC _ conName _) = do
+encodeArgs opts multiCons (InfixC _ conName _) = do
     al <- newName "argL"
     ar <- newName "argR"
     match (infixP (varP al) conName (varP ar))
           ( normalB
-          $ withExp
-          $ [e|toJSON|] `appE` listE [ [e|toJSON|] `appE` varE a
-                                     | a <- [al,ar]
-                                     ]
+          $ encodeSum opts multiCons conName
+          $ [|toJSON|] `appE` listE [ [|toJSON|] `appE` varE a
+                                    | a <- [al,ar]
+                                    ]
           )
           []
 -- Existentially quantified constructors.
-encodeArgs withExp withField (ForallC _ _ con) =
-    encodeArgs withExp withField con
+encodeArgs opts multiCons (ForallC _ _ con) =
+    encodeArgs opts multiCons con
 
 
 --------------------------------------------------------------------------------
@@ -393,34 +361,13 @@
 --------------------------------------------------------------------------------
 
 -- | Generates a 'FromJSON' instance declaration for the given data type.
---
--- Example:
---
--- @
--- data Foo = Foo Char Int
--- $('deriveFromJSON' id ''Foo)
--- @
---
--- This will splice in the following code:
---
--- @
--- instance 'FromJSON' Foo where
---     'parseJSON' =
---         \\value -> case value of
---                     'Array' arr ->
---                       if (V.length arr == 2)
---                       then Foo \<$\> 'parseJSON' (arr `V.unsafeIndex` 0)
---                                \<*\> 'parseJSON' (arr `V.unsafeIndex` 1)
---                       else fail \"\<error message\>\"
---                     other -> fail \"\<error message\>\"
--- @
-deriveFromJSON :: (String -> String)
-               -- ^ Function to change field names.
+deriveFromJSON :: Options
+               -- ^ Encoding options.
                -> Name
                -- ^ Name of the type for which to generate a 'FromJSON' instance
                -- declaration.
                -> Q [Dec]
-deriveFromJSON withField name =
+deriveFromJSON opts name =
     withType name $ \tvbs cons -> fmap (:[]) $ fromCons tvbs cons
   where
     fromCons :: [TyVarBndr] -> [Con] -> Q Dec
@@ -429,7 +376,7 @@
                   (classType `appT` instanceType)
                   [ funD 'parseJSON
                          [ clause []
-                                  (normalB $ consFromJSON name withField cons)
+                                  (normalB $ consFromJSON name opts cons)
                                   []
                          ]
                   ]
@@ -440,181 +387,305 @@
 
 -- | Generates a lambda expression which parses the JSON encoding of the given
 -- data type.
---
--- Example:
---
--- @
--- data Foo = Foo 'Int'
--- @
---
--- @
--- parseFoo :: 'Value' -> 'Parser' Foo
--- parseFoo = $('mkParseJSON' id ''Foo)
--- @
---
--- This will splice in the following code:
---
--- @
--- \\value -> case value of arg -> Foo \<$\> 'parseJSON' arg
--- @
-mkParseJSON :: (String -> String) -- ^ Function to change field names.
+mkParseJSON :: Options -- ^ Encoding options.
             -> Name -- ^ Name of the encoded type.
             -> Q Exp
-mkParseJSON withField name =
-    withType name (\_ cons -> consFromJSON name withField cons)
+mkParseJSON opts name =
+    withType name (\_ cons -> consFromJSON name opts cons)
 
 -- | Helper function used by both 'deriveFromJSON' and 'mkParseJSON'. Generates
 -- code to parse the JSON encoding of a number of constructors. All constructors
 -- must be from the same type.
 consFromJSON :: Name
              -- ^ Name of the type to which the constructors belong.
-             -> (String -> String)
-             -- ^ Function to change field names.
+             -> Options
+             -- ^ Encoding options
              -> [Con]
              -- ^ Constructors for which to generate JSON parsing code.
              -> Q Exp
+
 consFromJSON _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
                               ++ "Not a single constructor given!"
-consFromJSON tName withField [con] = do
+
+consFromJSON tName opts [con] = do
   value <- newName "value"
-  lam1E (varP value)
-        $ caseE (varE value)
-                (parseArgs tName withField con)
-consFromJSON tName withField cons = do
-  value  <- newName "value"
-  obj    <- newName "obj"
-  conKey <- newName "conKey"
-  conVal <- newName "conVal"
+  lam1E (varP value) (parseArgs tName opts con (Right value))
 
-  let -- Convert the Data.Map inside the Object to a list and pattern match
-      -- against it. It must contain a single element otherwise the parse will
-      -- fail.
-      caseLst = caseE ([e|H.toList|] `appE` varE obj)
-                      [ match (listP [tupP [varP conKey, varP conVal]])
-                              (normalB caseKey)
-                              []
-                      , do other <- newName "other"
-                           match (varP other)
-                                 (normalB $ [|wrongPairCountFail|]
-                                            `appE` (litE $ stringL $ show tName)
-                                            `appE` ([|show . length|] `appE` varE other)
-                                 )
-                                 []
-                      ]
+consFromJSON tName opts cons = do
+  value <- newName "value"
+  lam1E (varP value) $ caseE (varE value) $
+    if allNullaryToStringTag opts && all isNullary cons
+    then allNullaryMatches
+    else mixedMatches
 
-      caseKey = caseE (varE conKey)
-                      [match wildP (guardedB guards) []]
-      guards = [ do g <- normalG $ infixApp (varE conKey)
-                                            [|(==)|]
-                                            ( [|T.pack|]
-                                              `appE` conNameExp con
-                                            )
-                    e <- caseE (varE conVal)
-                               (parseArgs tName withField con)
-                    return (g, e)
-               | con <- cons
-               ]
-               ++
-               [ liftM2 (,)
-                        (normalG [e|otherwise|])
-                        ( [|conNotFoundFail|]
-                          `appE` (litE $ stringL $ show tName)
-                          `appE` listE (map (litE . stringL . nameBase . getConName) cons)
-                          `appE` ([|T.unpack|] `appE` varE conKey)
-                        )
-               ]
+  where
+    allNullaryMatches =
+      [ do txt <- newName "txt"
+           match (conP 'String [varP txt])
+                 (guardedB $
+                  [ liftM2 (,) (normalG $
+                                  infixApp (varE txt)
+                                           [|(==)|]
+                                           ([|T.pack|] `appE`
+                                              conStringE opts conName)
+                               )
+                               ([|pure|] `appE` conE conName)
+                  | con <- cons
+                  , let conName = getConName con
+                  ]
+                  ++
+                  [ liftM2 (,)
+                      (normalG [|otherwise|])
+                      ( [|noMatchFail|]
+                        `appE` (litE $ stringL $ show tName)
+                        `appE` ([|T.unpack|] `appE` varE txt)
+                      )
+                  ]
+                 )
+                 []
+      , do other <- newName "other"
+           match (varP other)
+                 (normalB $ [|noStringFail|]
+                    `appE` (litE $ stringL $ show tName)
+                    `appE` ([|valueConName|] `appE` varE other)
+                 )
+                 []
+      ]
 
-  lam1E (varP value)
-        $ caseE (varE value)
-                [ match (conP 'Object [varP obj])
-                        (normalB caseLst)
-                        []
-                , do other <- newName "other"
-                     match (varP other)
-                           ( normalB
-                           $ [|noObjectFail|]
+    mixedMatches =
+        case sumEncoding opts of
+          TaggedObject {tagFieldName, contentsFieldName} ->
+            parseObject $ parseTaggedObject tagFieldName contentsFieldName
+          ObjectWithSingleField ->
+            parseObject $ parseObjectWithSingleField
+          TwoElemArray ->
+            [ do arr <- newName "array"
+                 match (conP 'Array [varP arr])
+                       (guardedB $
+                        [ liftM2 (,) (normalG $ infixApp ([|V.length|] `appE` varE arr)
+                                                         [|(==)|]
+                                                         (litE $ integerL 2))
+                                     (parse2ElemArray arr)
+                        , liftM2 (,) (normalG [|otherwise|])
+                                     (([|not2ElemArray|]
+                                       `appE` (litE $ stringL $ show tName)
+                                       `appE` ([|V.length|] `appE` varE arr)))
+                        ]
+                       )
+                       []
+            , do other <- newName "other"
+                 match (varP other)
+                       ( normalB
+                         $ [|noArrayFail|]
                              `appE` (litE $ stringL $ show tName)
                              `appE` ([|valueConName|] `appE` varE other)
-                           )
-                           []
-                ]
+                       )
+                       []
+            ]
 
--- | Generates code to parse the JSON encoding of a single constructor.
-parseArgs :: Name -- ^ Name of the type to which the constructor belongs.
-          -> (String -> String) -- ^ Function to change field names.
-          -> Con -- ^ Constructor for which to generate JSON parsing code.
-          -> [Q Match]
--- Nullary constructors.
-parseArgs tName _ (NormalC conName []) =
+    parseObject f =
+        [ do obj <- newName "obj"
+             match (conP 'Object [varP obj]) (normalB $ f obj) []
+        , do other <- newName "other"
+             match (varP other)
+                   ( normalB
+                     $ [|noObjectFail|]
+                         `appE` (litE $ stringL $ show tName)
+                         `appE` ([|valueConName|] `appE` varE other)
+                   )
+                   []
+        ]
+
+    parseTaggedObject typFieldName valFieldName obj = do
+      conKey <- newName "conKey"
+      doE [ bindS (varP conKey)
+                  (infixApp (varE obj)
+                            [|(.:)|]
+                            ([|T.pack|] `appE` stringE typFieldName))
+          , noBindS $ parseContents conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject
+          ]
+
+    parse2ElemArray arr = do
+      conKey <- newName "conKey"
+      conVal <- newName "conVal"
+      let letIx n ix =
+              valD (varP n)
+                   (normalB ([|V.unsafeIndex|] `appE`
+                               varE arr `appE`
+                               litE (integerL ix)))
+                   []
+      letE [ letIx conKey 0
+           , letIx conVal 1
+           ]
+           (caseE (varE conKey)
+                  [ do txt <- newName "txt"
+                       match (conP 'String [varP txt])
+                             (normalB $ parseContents txt
+                                                      (Right conVal)
+                                                      'conNotFoundFail2ElemArray
+                             )
+                             []
+                  , do other <- newName "other"
+                       match (varP other)
+                             ( normalB
+                               $ [|firstElemNoStringFail|]
+                                     `appE` (litE $ stringL $ show tName)
+                                     `appE` ([|valueConName|] `appE` varE other)
+                             )
+                             []
+                  ]
+           )
+
+    parseObjectWithSingleField obj = do
+      conKey <- newName "conKey"
+      conVal <- newName "conVal"
+      caseE ([e|H.toList|] `appE` varE obj)
+            [ match (listP [tupP [varP conKey, varP conVal]])
+                    (normalB $ parseContents conKey (Right conVal) 'conNotFoundFailObjectSingleField)
+                    []
+            , do other <- newName "other"
+                 match (varP other)
+                       (normalB $ [|wrongPairCountFail|]
+                                  `appE` (litE $ stringL $ show tName)
+                                  `appE` ([|show . length|] `appE` varE other)
+                       )
+                       []
+            ]
+
+    parseContents conKey contents errorFun =
+        caseE (varE conKey)
+              [ match wildP
+                      ( guardedB $
+                        [ do g <- normalG $ infixApp (varE conKey)
+                                                     [|(==)|]
+                                                     ([|T.pack|] `appE`
+                                                        conNameExp opts con)
+                             e <- parseArgs tName opts con contents
+                             return (g, e)
+                        | con <- cons
+                        ]
+                        ++
+                        [ liftM2 (,)
+                                 (normalG [e|otherwise|])
+                                 ( varE errorFun
+                                   `appE` (litE $ stringL $ show tName)
+                                   `appE` listE (map ( litE
+                                                     . stringL
+                                                     . constructorTagModifier opts
+                                                     . nameBase
+                                                     . getConName
+                                                     ) cons
+                                                )
+                                   `appE` ([|T.unpack|] `appE` varE conKey)
+                                 )
+                        ]
+                      )
+                      []
+              ]
+
+parseNullaryMatches :: Name -> Name -> [Q Match]
+parseNullaryMatches tName conName =
     [ do arr <- newName "arr"
          match (conP 'Array [varP arr])
-               ( normalB $ condE ([|V.null|] `appE` varE arr)
-                                 ([e|pure|] `appE` conE conName)
-                                 ( parseTypeMismatch tName conName
-                                     (litE $ stringL "an empty Array")
-                                     ( infixApp (litE $ stringL $ "Array of length ")
-                                                [|(++)|]
-                                                ([|show . V.length|] `appE` varE arr)
-                                     )
-                                 )
+               (guardedB $
+                [ liftM2 (,) (normalG $ [|V.null|] `appE` varE arr)
+                             ([|pure|] `appE` conE conName)
+                , liftM2 (,) (normalG [|otherwise|])
+                             (parseTypeMismatch tName conName
+                                (litE $ stringL "an empty Array")
+                                (infixApp (litE $ stringL $ "Array of length ")
+                                          [|(++)|]
+                                          ([|show . V.length|] `appE` varE arr)
+                                )
+                             )
+                ]
                )
                []
     , matchFailed tName conName "Array"
     ]
--- Unary constructors.
-parseArgs _ _ (NormalC conName [_]) =
+
+parseUnaryMatches :: Name -> [Q Match]
+parseUnaryMatches conName =
     [ do arg <- newName "arg"
          match (varP arg)
                ( normalB $ infixApp (conE conName)
-                                    [e|(<$>)|]
-                                    ([e|parseJSON|] `appE` varE arg)
+                                    [|(<$>)|]
+                                    ([|parseJSON|] `appE` varE arg)
                )
                []
     ]
+
+parseRecord :: Options -> Name -> Name -> [VarStrictType] -> Name -> ExpQ
+parseRecord opts tName conName ts obj =
+    foldl' (\a b -> infixApp a [|(<*>)|] b)
+           (infixApp (conE conName) [|(<$>)|] x)
+           xs
+    where
+      x:xs = [ [|lookupField|]
+               `appE` (litE $ stringL $ show tName)
+               `appE` (litE $ stringL $ constructorTagModifier opts $ nameBase conName)
+               `appE` (varE obj)
+               `appE` ( [|T.pack|] `appE` fieldLabelExp opts field
+                      )
+             | (field, _, _) <- ts
+             ]
+
+getValField :: Name -> String -> [MatchQ] -> Q Exp
+getValField obj valFieldName matches = do
+  val <- newName "val"
+  doE [ bindS (varP val) $ infixApp (varE obj)
+                                    [|(.:)|]
+                                    ([|T.pack|] `appE`
+                                       (litE $ stringL valFieldName))
+      , noBindS $ caseE (varE val) matches
+      ]
+
+-- | Generates code to parse the JSON encoding of a single constructor.
+parseArgs :: Name -- ^ Name of the type to which the constructor belongs.
+          -> Options -- ^ Encoding options.
+          -> Con -- ^ Constructor for which to generate JSON parsing code.
+          -> Either (String, Name) Name -- ^ Left (valFieldName, objName) or
+                                        --   Right valName
+          -> Q Exp
+-- Nullary constructors.
+parseArgs tName _ (NormalC conName []) (Left (valFieldName, obj)) =
+  getValField obj valFieldName $ parseNullaryMatches tName conName
+parseArgs tName _ (NormalC conName []) (Right valName) =
+  caseE (varE valName) $ parseNullaryMatches tName conName
+
+-- Unary constructors.
+parseArgs _ _ (NormalC conName [_]) (Left (valFieldName, obj)) =
+  getValField obj valFieldName $ parseUnaryMatches conName
+parseArgs _ _ (NormalC conName [_]) (Right valName) =
+  caseE (varE valName) $ parseUnaryMatches conName
+
 -- Polyadic constructors.
-parseArgs tName _ (NormalC conName ts) = parseProduct tName conName $ genericLength ts
+parseArgs tName _ (NormalC conName ts) (Left (valFieldName, obj)) =
+    getValField obj valFieldName $ parseProduct tName conName $ genericLength ts
+parseArgs tName _ (NormalC conName ts) (Right valName) =
+    caseE (varE valName) $ parseProduct tName conName $ genericLength ts
+
 -- Records.
-parseArgs tName withField (RecC conName ts) =
-    [ do obj <- newName "recObj"
-         let x:xs = [ [|lookupField|]
-                      `appE` (litE $ stringL $ show tName)
-                      `appE` (litE $ stringL $ nameBase conName)
-                      `appE` (varE obj)
-                      `appE` ( [e|T.pack|]
-                               `appE`
-                               fieldNameExp withField field
-                             )
-                    | (field, _, _) <- ts
-                    ]
-         match (conP 'Object [varP obj])
-               ( normalB $ condE ( infixApp ([|H.size|] `appE` varE obj)
-                                            [|(==)|]
-                                            (litE $ integerL $ genericLength ts)
-                                 )
-                                 ( foldl' (\a b -> infixApp a [|(<*>)|] b)
-                                          (infixApp (conE conName) [|(<$>)|] x)
-                                          xs
-                                 )
-                                 ( parseTypeMismatch tName conName
-                                     ( litE $ stringL $ "Object with "
-                                                        ++ show (length ts)
-                                                        ++ " name/value pairs"
-                                     )
-                                     ( infixApp ([|show . H.size|] `appE` varE obj)
-                                                [|(++)|]
-                                                (litE $ stringL $ " name/value pairs")
-                                     )
-                                 )
-               )
-               []
+parseArgs tName opts (RecC conName ts) (Left (_, obj)) =
+    parseRecord opts tName conName ts obj
+parseArgs tName opts (RecC conName ts) (Right valName) = do
+  obj <- newName "recObj"
+  caseE (varE valName)
+    [ match (conP 'Object [varP obj]) (normalB $ parseRecord opts tName conName ts obj) []
     , matchFailed tName conName "Object"
     ]
+
 -- Infix constructors. Apart from syntax these are the same as
 -- polyadic constructors.
-parseArgs tName _ (InfixC _ conName _) = parseProduct tName conName 2
+parseArgs tName _ (InfixC _ conName _) (Left (valFieldName, obj)) =
+    getValField obj valFieldName $ parseProduct tName conName 2
+parseArgs tName _ (InfixC _ conName _) (Right valName) =
+    caseE (varE valName) $ parseProduct tName conName 2
+
 -- Existentially quantified constructors. We ignore the quantifiers
 -- and proceed with the contained constructor.
-parseArgs tName withField (ForallC _ _ con) = parseArgs tName withField con
+parseArgs tName opts (ForallC _ _ con) contents =
+    parseArgs tName opts con contents
 
 -- | Generates code to parse the JSON encoding of an n-ary
 -- constructor.
@@ -678,31 +749,62 @@
           , actual
           ]
 
-lookupField :: (FromJSON a) => String -> String -> Object -> T.Text -> Parser a
-lookupField tName rec obj key =
-    case H.lookup key obj of
-      Nothing -> unknownFieldFail tName rec (T.unpack key)
-      Just v  -> parseJSON v
+class (FromJSON a) => LookupField a where
+    lookupField :: String -> String -> Object -> T.Text -> Parser a
 
+instance (FromJSON a) => LookupField a where
+    lookupField tName rec obj key =
+        case H.lookup key obj of
+          Nothing -> unknownFieldFail tName rec (T.unpack key)
+          Just v  -> parseJSON v
+
+instance (FromJSON a) => LookupField (Maybe a) where
+    lookupField _ _ = (.:?)
+
 unknownFieldFail :: String -> String -> String -> Parser fail
 unknownFieldFail tName rec key =
     fail $ printf "When parsing the record %s of type %s the key %s was not present."
                   rec tName key
 
+noArrayFail :: String -> String -> Parser fail
+noArrayFail t o = fail $ printf "When parsing %s expected Array but got %s." t o
+
 noObjectFail :: String -> String -> Parser fail
-noObjectFail t o =
-    fail $ printf "When parsing %s expected Object but got %s." t o
+noObjectFail t o = fail $ printf "When parsing %s expected Object but got %s." t o
 
+firstElemNoStringFail :: String -> String -> Parser fail
+firstElemNoStringFail t o = fail $ printf "When parsing %s expected an Array of 2 elements where the first element is a String but got %s at the first element." t o
+
 wrongPairCountFail :: String -> String -> Parser fail
 wrongPairCountFail t n =
-    fail $ printf "When parsing %s expected an Object with a single name/value pair but got %s pairs."
+    fail $ printf "When parsing %s expected an Object with a single tag/contents pair but got %s pairs."
                   t n
 
-conNotFoundFail :: String -> [String] -> String -> Parser fail
-conNotFoundFail t cs o =
-    fail $ printf "When parsing %s expected an Object with a name/value pair where the name is one of [%s], but got %s."
+noStringFail :: String -> String -> Parser fail
+noStringFail t o = fail $ printf "When parsing %s expected String but got %s." t o
+
+noMatchFail :: String -> String -> Parser fail
+noMatchFail t o =
+    fail $ printf "When parsing %s expected a String with the tag of a constructor but got %s." t o
+
+not2ElemArray :: String -> Int -> Parser fail
+not2ElemArray t i = fail $ printf "When parsing %s expected an Array of 2 elements but got %i elements" t i
+
+conNotFoundFail2ElemArray :: String -> [String] -> String -> Parser fail
+conNotFoundFail2ElemArray t cs o =
+    fail $ printf "When parsing %s expected a 2-element Array with a tag and contents element where the tag is one of [%s], but got %s."
                   t (intercalate ", " cs) o
 
+conNotFoundFailObjectSingleField :: String -> [String] -> String -> Parser fail
+conNotFoundFailObjectSingleField t cs o =
+    fail $ printf "When parsing %s expected an Object with a single tag/contents pair where the tag is one of [%s], but got %s."
+                  t (intercalate ", " cs) o
+
+conNotFoundFailTaggedObject :: String -> [String] -> String -> Parser fail
+conNotFoundFailTaggedObject t cs o =
+    fail $ printf "When parsing %s expected an Object with a tag field where the value is one of [%s], but got %s."
+                  t (intercalate ", " cs) o
+
 parseTypeMismatch' :: String -> String -> String -> String -> Parser fail
 parseTypeMismatch' tName conName expected actual =
     fail $ printf "When parsing the constructor %s of type %s expected %s but got %s."
@@ -749,14 +851,18 @@
 tvbName (KindedTV name _) = name
 
 -- | Makes a string literal expression from a constructor's name.
-conNameExp :: Con -> Q Exp
-conNameExp = litE . stringL . nameBase . getConName
+conNameExp :: Options -> Con -> Q Exp
+conNameExp opts = litE
+                . stringL
+                . constructorTagModifier opts
+                . nameBase
+                . getConName
 
--- | Creates a string literal expression from a record field name.
-fieldNameExp :: (String -> String) -- ^ Function to change the field name.
-             -> Name
-             -> Q Exp
-fieldNameExp f = litE . stringL . f . nameBase
+-- | Creates a string literal expression from a record field label.
+fieldLabelExp :: Options -- ^ Encoding options
+              -> Name
+              -> Q Exp
+fieldLabelExp opts = litE . stringL . fieldLabelModifier opts . nameBase
 
 -- | The name of the outermost 'Value' constructor.
 valueConName :: Value -> String
diff --git a/Data/Aeson/Types.hs b/Data/Aeson/Types.hs
--- a/Data/Aeson/Types.hs
+++ b/Data/Aeson/Types.hs
@@ -32,7 +32,16 @@
     , parseEither
     , parseMaybe
     , ToJSON(..)
+    , modifyFailure
 
+#ifdef GENERICS
+    -- ** Generic JSON classes
+    , GFromJSON(..)
+    , GToJSON(..)
+    , genericToJSON
+    , genericParseJSON
+#endif
+
     -- * Inspecting @'Value's@
     , withObject
     , withText
@@ -46,6 +55,12 @@
     , (.:?)
     , (.!=)
     , object
+
+    -- * Generic and TH encoding configuration
+    , Options(..)
+    , SumEncoding(..)
+    , defaultOptions
+    , defaultTaggedObject
     ) where
 
 import Data.Aeson.Types.Class
diff --git a/Data/Aeson/Types/Class.hs b/Data/Aeson/Types/Class.hs
--- a/Data/Aeson/Types/Class.hs
+++ b/Data/Aeson/Types/Class.hs
@@ -28,6 +28,8 @@
     -- ** Generic JSON classes
     , GFromJSON(..)
     , GToJSON(..)
+    , genericToJSON
+    , genericParseJSON
 #endif
     -- * Types
     , DotNetTime(..)
@@ -67,7 +69,7 @@
 import Data.Vector (Vector)
 import Data.Word (Word, Word8, Word16, Word32, Word64)
 import Foreign.Storable (Storable)
-import System.Locale (defaultTimeLocale)
+import System.Locale (defaultTimeLocale, dateTimeFmt)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
 import qualified Data.HashMap.Strict as H
@@ -88,11 +90,29 @@
 #ifdef GENERICS
 import GHC.Generics
 
+-- | Class of generic representation types ('Rep') that can be converted to JSON.
 class GToJSON f where
-    gToJSON :: f a -> Value
+    -- | This method (applied to 'defaultOptions') is used as the
+    -- default generic implementation of 'toJSON'.
+    gToJSON :: Options -> f a -> Value
 
+-- | Class of generic representation types ('Rep') that can be converted from JSON.
 class GFromJSON f where
-    gParseJSON :: Value -> Parser (f a)
+    -- | This method (applied to 'defaultOptions') is used as the
+    -- default generic implementation of 'parseJSON'.
+    gParseJSON :: Options -> Value -> Parser (f a)
+
+-- | A configurable generic JSON encoder. This function applied to
+-- 'defaultOptions' is used as the default for 'toJSON' when the type
+-- is an instance of 'Generic'.
+genericToJSON :: (Generic a, GToJSON (Rep a)) => Options -> a -> Value
+genericToJSON opts = gToJSON opts . from
+
+-- | A configurable generic JSON decoder. This function applied to
+-- 'defaultOptions' is used as the default for 'parseJSON' when the
+-- type is an instance of 'Generic'.
+genericParseJSON :: (Generic a, GFromJSON (Rep a)) => Options -> Value -> Parser a
+genericParseJSON opts = fmap to . gParseJSON opts
 #endif
 
 -- | A type that can be converted to JSON.
@@ -138,12 +158,21 @@
 --
 -- instance ToJSON Coord
 -- @
+--
+-- Note that, instead of using @DefaultSignatures@, it's also possible
+-- to parameterize the generic encoding using 'genericToJSON' applied
+-- to your encoding/decoding 'Options':
+--
+-- @
+-- instance ToJSON Coord where
+--     toJSON = 'genericToJSON' 'defaultOptions'
+-- @
 class ToJSON a where
     toJSON   :: a -> Value
 
 #ifdef GENERICS
     default toJSON :: (Generic a, GToJSON (Rep a)) => a -> Value
-    toJSON = gToJSON . from
+    toJSON = genericToJSON defaultOptions
 #endif
 
 -- | A type that can be converted from JSON, with the possibility of
@@ -199,12 +228,22 @@
 --
 -- instance FromJSON Coord
 -- @
+--
+-- Note that, instead of using @DefaultSignatures@, it's also possible
+-- to parameterize the generic decoding using 'genericParseJSON' applied
+-- to your encoding/decoding 'Options':
+--
+-- @
+-- instance FromJSON Coord where
+--     parseJSON = 'genericParseJSON' 'defaultOptions'
+-- @
+
 class FromJSON a where
     parseJSON :: Value -> Parser a
 
 #ifdef GENERICS
     default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a
-    parseJSON = fmap to . gParseJSON
+    parseJSON = genericParseJSON defaultOptions
 #endif
 
 instance (ToJSON a) => ToJSON (Maybe a) where
@@ -643,6 +682,7 @@
             Nothing -> empty
         tryFormats = foldr1 (<|>) . map tryFormat
         alternateFormats =
+          dateTimeFmt defaultTimeLocale :
           distributeList ["%Y", "%Y-%m", "%F"]
                          ["T%R", "T%T", "T%T%Q", "T%T%QZ", "T%T%Q%z"]
 
diff --git a/Data/Aeson/Types/Generic.hs b/Data/Aeson/Types/Generic.hs
--- a/Data/Aeson/Types/Generic.hs
+++ b/Data/Aeson/Types/Generic.hs
@@ -1,6 +1,8 @@
-{-# LANGUAGE DefaultSignatures, EmptyDataDecls, FlexibleInstances,
+{-# LANGUAGE CPP, DefaultSignatures, EmptyDataDecls, FlexibleInstances,
     FunctionalDependencies, KindSignatures, OverlappingInstances,
-    ScopedTypeVariables, TypeOperators, UndecidableInstances, ViewPatterns #-}
+    ScopedTypeVariables, TypeOperators, UndecidableInstances,
+    ViewPatterns, NamedFieldPuns, FlexibleContexts, PatternGuards,
+    RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- |
@@ -18,16 +20,17 @@
 module Data.Aeson.Types.Generic ( ) where
 
 import Control.Applicative ((<*>), (<$>), (<|>), pure)
+import Control.Monad ((<=<))
 import Control.Monad.ST (ST)
 import Data.Aeson.Types.Class
 import Data.Aeson.Types.Internal
-import Data.Bits (shiftR)
-import Data.DList (DList, toList)
+import Data.Bits
+import Data.DList (DList, toList, empty)
+import Data.Maybe (fromMaybe)
 import Data.Monoid (mappend)
-import Data.Text (pack, unpack)
+import Data.Text (Text, pack, unpack)
 import GHC.Generics
 import qualified Data.HashMap.Strict as H
-import qualified Data.Text as T
 import qualified Data.Vector as V
 import qualified Data.Vector.Mutable as VM
 
@@ -35,242 +38,570 @@
 -- Generic toJSON
 
 instance (GToJSON a) => GToJSON (M1 i c a) where
-    gToJSON = gToJSON . unM1
+    -- Meta-information, which is not handled elsewhere, is ignored:
+    gToJSON opts = gToJSON opts . unM1
     {-# INLINE gToJSON #-}
 
 instance (ToJSON a) => GToJSON (K1 i a) where
-    gToJSON = toJSON . unK1
+    -- Constant values are encoded using their ToJSON instance:
+    gToJSON _opts = toJSON . unK1
     {-# INLINE gToJSON #-}
 
 instance GToJSON U1 where
-    gToJSON _ = emptyArray
+    -- Empty constructors are encoded to an empty array:
+    gToJSON _opts _ = emptyArray
     {-# INLINE gToJSON #-}
 
 instance (ConsToJSON a) => GToJSON (C1 c a) where
-    gToJSON = consToJSON . unM1
+    -- Constructors need to be encoded differently depending on whether they're
+    -- a record or not. This distinction is made by 'constToJSON':
+    gToJSON opts = consToJSON opts . unM1
     {-# INLINE gToJSON #-}
 
-instance ( GProductToValues a, GProductToValues b
-         , ProductSize      a, ProductSize      b) => GToJSON (a :*: b) where
-    gToJSON p = Array $ V.create $ do
-                  mv <- VM.unsafeNew lenProduct
-                  gProductToValues mv 0 lenProduct p
-                  return mv
+instance ( WriteProduct a, WriteProduct b
+         , ProductSize  a, ProductSize  b ) => GToJSON (a :*: b) where
+    -- Products are encoded to an array. Here we allocate a mutable vector of
+    -- the same size as the product and write the product's elements to it using
+    -- 'writeProduct':
+    gToJSON opts p =
+        Array $ V.create $ do
+          mv <- VM.unsafeNew lenProduct
+          writeProduct opts mv 0 lenProduct p
+          return mv
         where
-          lenProduct = unTagged2 (productSize :: Tagged2 (a :*: b) Int)
+          lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
+                       productSize
     {-# INLINE gToJSON #-}
 
-instance (GObject a, GObject b) => GToJSON (a :+: b) where
-    gToJSON (L1 x) = Object $ gObject x
-    gToJSON (R1 x) = Object $ gObject x
+instance ( AllNullary (a :+: b) allNullary
+         , SumToJSON  (a :+: b) allNullary ) => GToJSON (a :+: b) where
+    -- If all constructors of a sum datatype are nullary and the
+    -- 'allNullaryToStringTag' option is set they are encoded to
+    -- strings.  This distinction is made by 'sumToJSON':
+    gToJSON opts = (unTagged :: Tagged allNullary Value -> Value)
+                 . sumToJSON opts
     {-# INLINE gToJSON #-}
 
 --------------------------------------------------------------------------------
 
-class ConsToJSON    f where consToJSON  ::           f a -> Value
-class ConsToJSON' b f where consToJSON' :: Tagged b (f a -> Value)
+class SumToJSON f allNullary where
+    sumToJSON :: Options -> f a -> Tagged allNullary Value
 
-newtype Tagged s b = Tagged {unTagged :: b}
+instance ( GetConName            f
+         , TaggedObject          f
+         , ObjectWithSingleField f
+         , TwoElemArray          f ) => SumToJSON f True where
+    sumToJSON opts
+        | allNullaryToStringTag opts = Tagged . String . pack
+                                     . constructorTagModifier opts . getConName
+        | otherwise = Tagged . nonAllNullarySumToJSON opts
+    {-# INLINE sumToJSON #-}
 
-instance (IsRecord f b, ConsToJSON' b f) => ConsToJSON f where
-    consToJSON = unTagged (consToJSON' :: Tagged b (f a -> Value))
+instance ( TwoElemArray          f
+         , TaggedObject          f
+         , ObjectWithSingleField f ) => SumToJSON f False where
+    sumToJSON opts = Tagged . nonAllNullarySumToJSON opts
+    {-# INLINE sumToJSON #-}
+
+nonAllNullarySumToJSON :: ( TwoElemArray          f
+                          , TaggedObject          f
+                          , ObjectWithSingleField f
+                          ) => Options -> f a -> Value
+nonAllNullarySumToJSON opts =
+    case sumEncoding opts of
+      TaggedObject{..}      -> object . taggedObject opts tagFieldName
+                                                          contentsFieldName
+      ObjectWithSingleField -> Object . objectWithSingleField opts
+      TwoElemArray          -> Array  . twoElemArray opts
+{-# INLINE nonAllNullarySumToJSON #-}
+
+--------------------------------------------------------------------------------
+
+class TaggedObject f where
+    taggedObject :: Options -> String -> String -> f a -> [Pair]
+
+instance ( TaggedObject a
+         , TaggedObject b ) => TaggedObject (a :+: b) where
+    taggedObject     opts tagFieldName contentsFieldName (L1 x) =
+        taggedObject opts tagFieldName contentsFieldName     x
+    taggedObject     opts tagFieldName contentsFieldName (R1 x) =
+        taggedObject opts tagFieldName contentsFieldName     x
+    {-# INLINE taggedObject #-}
+
+instance ( IsRecord      a isRecord
+         , TaggedObject' a isRecord
+         , Constructor c ) => TaggedObject (C1 c a) where
+    taggedObject opts tagFieldName contentsFieldName =
+        (pack tagFieldName .= constructorTagModifier opts
+                                 (conName (undefined :: t c a p)) :) .
+        (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
+          taggedObject' opts contentsFieldName . unM1
+    {-# INLINE taggedObject #-}
+
+class TaggedObject' f isRecord where
+    taggedObject' :: Options -> String -> f a -> Tagged isRecord [Pair]
+
+instance (RecordToPairs f) => TaggedObject' f True where
+    taggedObject' opts _ = Tagged . toList . recordToPairs opts
+    {-# INLINE taggedObject' #-}
+
+instance (GToJSON f) => TaggedObject' f False where
+    taggedObject' opts contentsFieldName =
+        Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts
+    {-# INLINE taggedObject' #-}
+
+--------------------------------------------------------------------------------
+
+-- | Get the name of the constructor of a sum datatype.
+class GetConName f where
+    getConName :: f a -> String
+
+instance (GetConName a, GetConName b) => GetConName (a :+: b) where
+    getConName (L1 x) = getConName x
+    getConName (R1 x) = getConName x
+    {-# INLINE getConName #-}
+
+instance (Constructor c, GToJSON a, ConsToJSON a) => GetConName (C1 c a) where
+    getConName = conName
+    {-# INLINE getConName #-}
+
+--------------------------------------------------------------------------------
+
+class TwoElemArray f where
+    twoElemArray :: Options -> f a -> V.Vector Value
+
+instance (TwoElemArray a, TwoElemArray b) => TwoElemArray (a :+: b) where
+    twoElemArray opts (L1 x) = twoElemArray opts x
+    twoElemArray opts (R1 x) = twoElemArray opts x
+    {-# INLINE twoElemArray #-}
+
+instance ( GToJSON a, ConsToJSON a
+         , Constructor c ) => TwoElemArray (C1 c a) where
+    twoElemArray opts x = V.create $ do
+      mv <- VM.unsafeNew 2
+      VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
+                                   $ conName (undefined :: t c a p)
+      VM.unsafeWrite mv 1 $ gToJSON opts x
+      return mv
+    {-# INLINE twoElemArray #-}
+
+--------------------------------------------------------------------------------
+
+class ConsToJSON f where
+    consToJSON  :: Options -> f a -> Value
+
+class ConsToJSON' f isRecord where
+    consToJSON' :: Options -> f a -> Tagged isRecord Value
+
+instance ( IsRecord    f isRecord
+         , ConsToJSON' f isRecord ) => ConsToJSON f where
+    consToJSON opts = (unTagged :: Tagged isRecord Value -> Value)
+                    . consToJSON' opts
     {-# INLINE consToJSON #-}
 
-instance (GRecordToPairs f) => ConsToJSON' True f where
-    consToJSON' = Tagged (object . toList . gRecordToPairs)
+instance (RecordToPairs f) => ConsToJSON' f True where
+    consToJSON' opts = Tagged . object . toList . recordToPairs opts
     {-# INLINE consToJSON' #-}
 
-instance GToJSON f => ConsToJSON' False f where
-    consToJSON' = Tagged gToJSON
+instance GToJSON f => ConsToJSON' f False where
+    consToJSON' opts = Tagged . gToJSON opts
     {-# INLINE consToJSON' #-}
 
 --------------------------------------------------------------------------------
 
-class GRecordToPairs f where
-    gRecordToPairs :: f a -> DList Pair
+class RecordToPairs f where
+    recordToPairs :: Options -> f a -> DList Pair
 
-instance (GRecordToPairs a, GRecordToPairs b) => GRecordToPairs (a :*: b) where
-    gRecordToPairs (a :*: b) = gRecordToPairs a `mappend` gRecordToPairs b
-    {-# INLINE gRecordToPairs #-}
+instance (RecordToPairs a, RecordToPairs b) => RecordToPairs (a :*: b) where
+    recordToPairs opts (a :*: b) = recordToPairs opts a `mappend`
+                                   recordToPairs opts b
+    {-# INLINE recordToPairs #-}
 
-instance (Selector s, GToJSON a) => GRecordToPairs (S1 s a) where
-    gRecordToPairs m1 = pure (pack (selName m1), gToJSON (unM1 m1))
-    {-# INLINE gRecordToPairs #-}
+instance (Selector s, GToJSON a) => RecordToPairs (S1 s a) where
+    recordToPairs = fieldToPair
+    {-# INLINE recordToPairs #-}
 
+instance (Selector s, ToJSON a) => RecordToPairs (S1 s (K1 i (Maybe a))) where
+    recordToPairs opts (M1 k1) | omitNothingFields opts
+                               , K1 Nothing <- k1 = empty
+    recordToPairs opts m1 = fieldToPair opts m1
+    {-# INLINE recordToPairs #-}
+
+fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair
+fieldToPair opts m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
+                           , gToJSON opts (unM1 m1)
+                           )
+{-# INLINE fieldToPair #-}
+
 --------------------------------------------------------------------------------
 
-class GProductToValues f where
-    gProductToValues :: VM.MVector s Value -> Int -> Int -> f a -> ST s ()
+class WriteProduct f where
+    writeProduct :: Options
+                 -> VM.MVector s Value
+                 -> Int -- ^ index
+                 -> Int -- ^ length
+                 -> f a
+                 -> ST s ()
 
-instance (GProductToValues a, GProductToValues b) => GProductToValues (a :*: b) where
-    gProductToValues mv ix len (a :*: b) = do gProductToValues mv ix  lenL a
-                                              gProductToValues mv ixR lenR b
+instance ( WriteProduct a
+         , WriteProduct b ) => WriteProduct (a :*: b) where
+    writeProduct opts mv ix len (a :*: b) = do
+      writeProduct opts mv ix  lenL a
+      writeProduct opts mv ixR lenR b
         where
+#if MIN_VERSION_base(4,5,0)
+          lenL = len `unsafeShiftR` 1
+#else
           lenL = len `shiftR` 1
-          ixR  = ix + lenL
+#endif
           lenR = len - lenL
-    {-# INLINE gProductToValues #-}
+          ixR  = ix  + lenL
+    {-# INLINE writeProduct #-}
 
-instance (GToJSON a) => GProductToValues a where
-    gProductToValues mv ix _ = VM.unsafeWrite mv ix . gToJSON
-    {-# INLINE gProductToValues #-}
+instance (GToJSON a) => WriteProduct a where
+    writeProduct opts mv ix _ = VM.unsafeWrite mv ix . gToJSON opts
+    {-# INLINE writeProduct #-}
 
 --------------------------------------------------------------------------------
 
-class GObject f where
-    gObject :: f a -> Object
+class ObjectWithSingleField f where
+    objectWithSingleField :: Options -> f a -> Object
 
-instance (GObject a, GObject b) => GObject (a :+: b) where
-    gObject (L1 x) = gObject x
-    gObject (R1 x) = gObject x
-    {-# INLINE gObject #-}
+instance ( ObjectWithSingleField a
+         , ObjectWithSingleField b ) => ObjectWithSingleField (a :+: b) where
+    objectWithSingleField opts (L1 x) = objectWithSingleField opts x
+    objectWithSingleField opts (R1 x) = objectWithSingleField opts x
+    {-# INLINE objectWithSingleField #-}
 
-instance (Constructor c, GToJSON a, ConsToJSON a) => GObject (C1 c a) where
-    gObject = H.singleton (pack $ conName (undefined :: t c a p)) . gToJSON
-    {-# INLINE gObject #-}
+instance ( GToJSON a, ConsToJSON a
+         , Constructor c ) => ObjectWithSingleField (C1 c a) where
+    objectWithSingleField opts = H.singleton typ . gToJSON opts
+        where
+          typ = pack $ constructorTagModifier opts $
+                         conName (undefined :: t c a p)
+    {-# INLINE objectWithSingleField #-}
 
 --------------------------------------------------------------------------------
 -- Generic parseJSON
 
 instance (GFromJSON a) => GFromJSON (M1 i c a) where
-    gParseJSON = fmap M1 . gParseJSON
+    -- Meta-information, which is not handled elsewhere, is just added to the
+    -- parsed value:
+    gParseJSON opts = fmap M1 . gParseJSON opts
     {-# INLINE gParseJSON #-}
 
 instance (FromJSON a) => GFromJSON (K1 i a) where
-    gParseJSON = fmap K1 . parseJSON
+    -- Constant values are decoded using their FromJSON instance:
+    gParseJSON _opts = fmap K1 . parseJSON
     {-# INLINE gParseJSON #-}
 
 instance GFromJSON U1 where
-    gParseJSON v
+    -- Empty constructors are expected to be encoded as an empty array:
+    gParseJSON _opts v
         | isEmptyArray v = pure U1
         | otherwise      = typeMismatch "unit constructor (U1)" v
     {-# INLINE gParseJSON #-}
 
 instance (ConsFromJSON a) => GFromJSON (C1 c a) where
-    gParseJSON = fmap M1 . consParseJSON
+    -- Constructors need to be decoded differently depending on whether they're
+    -- a record or not. This distinction is made by consParseJSON:
+    gParseJSON opts = fmap M1 . consParseJSON opts
     {-# INLINE gParseJSON #-}
 
-instance ( GFromProduct a, GFromProduct b
-         , ProductSize a, ProductSize b) => GFromJSON (a :*: b) where
-    gParseJSON (Array arr)
-        | lenArray == lenProduct = gParseProduct arr 0 lenProduct
-        | otherwise =
-            fail $ "When expecting a product of " ++ show lenProduct ++
-                   " values, encountered an Array of " ++ show lenArray ++
-                   " elements instead"
-        where
-          lenArray = V.length arr
-          lenProduct = unTagged2 (productSize :: Tagged2 (a :*: b) Int)
-
-    gParseJSON v = typeMismatch "product (:*:)" v
+instance ( FromProduct a, FromProduct b
+         , ProductSize a, ProductSize b ) => GFromJSON (a :*: b) where
+    -- Products are expected to be encoded to an array. Here we check whether we
+    -- got an array of the same size as the product, then parse each of the
+    -- product's elements using parseProduct:
+    gParseJSON opts = withArray "product (:*:)" $ \arr ->
+      let lenArray = V.length arr
+          lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
+                       productSize in
+      if lenArray == lenProduct
+      then parseProduct opts arr 0 lenProduct
+      else fail $ "When expecting a product of " ++ show lenProduct ++
+                  " values, encountered an Array of " ++ show lenArray ++
+                  " elements instead"
     {-# INLINE gParseJSON #-}
 
-instance (GFromSum a, GFromSum b) => GFromJSON (a :+: b) where
-    gParseJSON (Object (H.toList -> [keyVal@(key, _)])) =
-        case gParseSum keyVal of
-          Nothing -> notFound $ unpack key
-          Just p  -> p
-    gParseJSON v = typeMismatch "sum (:+:)" v
+instance ( AllNullary (a :+: b) allNullary
+         , ParseSum   (a :+: b) allNullary ) => GFromJSON   (a :+: b) where
+    -- If all constructors of a sum datatype are nullary and the
+    -- 'allNullaryToStringTag' option is set they are expected to be
+    -- encoded as strings.  This distinction is made by 'parseSum':
+    gParseJSON opts = (unTagged :: Tagged allNullary (Parser ((a :+: b) d)) ->
+                                                     (Parser ((a :+: b) d)))
+                    . parseSum opts
     {-# INLINE gParseJSON #-}
 
-notFound :: String -> Parser a
-notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
-{-# INLINE notFound #-}
+--------------------------------------------------------------------------------
 
+class ParseSum f allNullary where
+    parseSum :: Options -> Value -> Tagged allNullary (Parser (f a))
+
+instance ( SumFromString    (a :+: b)
+         , FromPair         (a :+: b)
+         , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) True where
+    parseSum opts
+        | allNullaryToStringTag opts = Tagged . parseAllNullarySum    opts
+        | otherwise                  = Tagged . parseNonAllNullarySum opts
+    {-# INLINE parseSum #-}
+
+instance ( FromPair         (a :+: b)
+         , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) False where
+    parseSum opts = Tagged . parseNonAllNullarySum opts
+    {-# INLINE parseSum #-}
+
 --------------------------------------------------------------------------------
 
-class ConsFromJSON    f where consParseJSON  ::           Value -> Parser (f a)
-class ConsFromJSON' b f where consParseJSON' :: Tagged b (Value -> Parser (f a))
+parseAllNullarySum :: SumFromString f => Options -> Value -> Parser (f a)
+parseAllNullarySum opts = withText "Text" $ \key ->
+                            maybe (notFound $ unpack key) return $
+                              parseSumFromString opts key
+{-# INLINE parseAllNullarySum #-}
 
-instance (IsRecord f b, ConsFromJSON' b f) => ConsFromJSON f where
-    consParseJSON = unTagged (consParseJSON' :: Tagged b (Value -> Parser (f a)))
-    {-# INLINE consParseJSON #-}
+class SumFromString f where
+    parseSumFromString :: Options -> Text -> Maybe (f a)
 
-instance (GFromRecord f) => ConsFromJSON' True f where
-    consParseJSON' = Tagged parseRecord
+instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where
+    parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>
+                                  (R1 <$> parseSumFromString opts key)
+    {-# INLINE parseSumFromString #-}
+
+instance (Constructor c) => SumFromString (C1 c U1) where
+    parseSumFromString opts key | key == name = Just $ M1 U1
+                                | otherwise   = Nothing
         where
-          parseRecord (Object obj) = gParseRecord obj
-          parseRecord v = typeMismatch "record (:*:)" v
+          name = pack $ constructorTagModifier opts $
+                          conName (undefined :: t c U1 p)
+    {-# INLINE parseSumFromString #-}
+
+--------------------------------------------------------------------------------
+
+parseNonAllNullarySum :: ( FromPair                       (a :+: b)
+                         , FromTaggedObject               (a :+: b)
+                         ) => Options -> Value -> Parser ((a :+: b) c)
+parseNonAllNullarySum opts =
+    case sumEncoding opts of
+      TaggedObject{..} ->
+          withObject "Object" $ \obj -> do
+            tag <- obj .: pack tagFieldName
+            fromMaybe (notFound $ unpack tag) $
+              parseFromTaggedObject opts contentsFieldName obj tag
+
+      ObjectWithSingleField ->
+          withObject "Object" $ \obj ->
+            case H.toList obj of
+              [pair@(tag, _)] -> fromMaybe (notFound $ unpack tag) $
+                                   parsePair opts pair
+              _ -> fail "Object doesn't have a single field"
+
+      TwoElemArray ->
+          withArray "Array" $ \arr ->
+            if V.length arr == 2
+            then case V.unsafeIndex arr 0 of
+                   String tag -> fromMaybe (notFound $ unpack tag) $
+                                   parsePair opts (tag, V.unsafeIndex arr 1)
+                   _ -> fail "First element is not a String"
+            else fail "Array doesn't have 2 elements"
+{-# INLINE parseNonAllNullarySum #-}
+
+--------------------------------------------------------------------------------
+
+class FromTaggedObject f where
+    parseFromTaggedObject :: Options -> String -> Object -> Text
+                          -> Maybe (Parser (f a))
+
+instance (FromTaggedObject a, FromTaggedObject b) =>
+    FromTaggedObject (a :+: b) where
+        parseFromTaggedObject opts contentsFieldName obj tag =
+            (fmap L1 <$> parseFromTaggedObject opts contentsFieldName obj tag) <|>
+            (fmap R1 <$> parseFromTaggedObject opts contentsFieldName obj tag)
+        {-# INLINE parseFromTaggedObject #-}
+
+instance ( FromTaggedObject' f
+         , Constructor c ) => FromTaggedObject (C1 c f) where
+    parseFromTaggedObject opts contentsFieldName obj tag
+        | tag == name = Just $ M1 <$> parseFromTaggedObject'
+                                        opts contentsFieldName obj
+        | otherwise = Nothing
+        where
+          name = pack $ constructorTagModifier opts $
+                          conName (undefined :: t c f p)
+    {-# INLINE parseFromTaggedObject #-}
+
+--------------------------------------------------------------------------------
+
+class FromTaggedObject' f where
+    parseFromTaggedObject' :: Options -> String -> Object -> Parser (f a)
+
+class FromTaggedObject'' f isRecord where
+    parseFromTaggedObject'' :: Options -> String -> Object
+                            -> Tagged isRecord (Parser (f a))
+
+instance ( IsRecord             f isRecord
+         , FromTaggedObject''   f isRecord
+         ) => FromTaggedObject' f where
+    parseFromTaggedObject' opts contentsFieldName =
+        (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .
+        parseFromTaggedObject'' opts contentsFieldName
+    {-# INLINE parseFromTaggedObject' #-}
+
+instance (FromRecord f) => FromTaggedObject'' f True where
+    parseFromTaggedObject'' opts _ = Tagged . parseRecord opts
+    {-# INLINE parseFromTaggedObject'' #-}
+
+instance (GFromJSON f) => FromTaggedObject'' f False where
+    parseFromTaggedObject'' opts contentsFieldName = Tagged .
+      (gParseJSON opts <=< (.: pack contentsFieldName))
+    {-# INLINE parseFromTaggedObject'' #-}
+
+--------------------------------------------------------------------------------
+
+class ConsFromJSON f where
+    consParseJSON  :: Options -> Value -> Parser (f a)
+
+class ConsFromJSON' f isRecord where
+    consParseJSON' :: Options -> Value -> Tagged isRecord (Parser (f a))
+
+instance ( IsRecord        f isRecord
+         , ConsFromJSON'   f isRecord
+         ) => ConsFromJSON f where
+    consParseJSON opts = (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
+                       . consParseJSON' opts
+    {-# INLINE consParseJSON #-}
+
+instance (FromRecord f) => ConsFromJSON' f True where
+    consParseJSON' opts = Tagged . (withObject "record (:*:)" $ parseRecord opts)
     {-# INLINE consParseJSON' #-}
 
-instance (GFromJSON f) => ConsFromJSON' False f where
-    consParseJSON' = Tagged gParseJSON
+instance (GFromJSON f) => ConsFromJSON' f False where
+    consParseJSON' opts = Tagged . gParseJSON opts
     {-# INLINE consParseJSON' #-}
 
 --------------------------------------------------------------------------------
 
-class GFromRecord f where
-    gParseRecord :: Object -> Parser (f a)
+class FromRecord f where
+    parseRecord :: Options -> Object -> Parser (f a)
 
-instance (GFromRecord a, GFromRecord b) => GFromRecord (a :*: b) where
-    gParseRecord obj = (:*:) <$> gParseRecord obj <*> gParseRecord obj
-    {-# INLINE gParseRecord #-}
+instance (FromRecord a, FromRecord b) => FromRecord (a :*: b) where
+    parseRecord opts obj = (:*:) <$> parseRecord opts obj
+                                 <*> parseRecord opts obj
+    {-# INLINE parseRecord #-}
 
-instance (Selector s, GFromJSON a) => GFromRecord (S1 s a) where
-    gParseRecord = maybe (notFound key) gParseJSON . H.lookup (T.pack key)
+instance (Selector s, GFromJSON a) => FromRecord (S1 s a) where
+    parseRecord opts = maybe (notFound label) (gParseJSON opts)
+                      . H.lookup (pack label)
         where
-          key = selName (undefined :: t s a p)
-    {-# INLINE gParseRecord #-}
+          label = fieldLabelModifier opts $ selName (undefined :: t s a p)
+    {-# INLINE parseRecord #-}
 
+instance (Selector s, FromJSON a) => FromRecord (S1 s (K1 i (Maybe a))) where
+    parseRecord opts obj = (M1 . K1) <$> obj .:? pack label
+        where
+          label = fieldLabelModifier opts $
+                    selName (undefined :: t s (K1 i (Maybe a)) p)
+    {-# INLINE parseRecord #-}
+
 --------------------------------------------------------------------------------
 
 class ProductSize f where
     productSize :: Tagged2 f Int
 
-newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}
-
 instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where
     productSize = Tagged2 $ unTagged2 (productSize :: Tagged2 a Int) +
                             unTagged2 (productSize :: Tagged2 b Int)
+    {-# INLINE productSize #-}
 
 instance ProductSize (S1 s a) where
     productSize = Tagged2 1
+    {-# INLINE productSize #-}
 
 --------------------------------------------------------------------------------
 
-class GFromProduct f where
-    gParseProduct :: Array -> Int -> Int -> Parser (f a)
+class FromProduct f where
+    parseProduct :: Options -> Array -> Int -> Int -> Parser (f a)
 
-instance (GFromProduct a, GFromProduct b) => GFromProduct (a :*: b) where
-    gParseProduct arr ix len = (:*:) <$> gParseProduct arr ix  lenL
-                                     <*> gParseProduct arr ixR lenR
+instance (FromProduct a, FromProduct b) => FromProduct (a :*: b) where
+    parseProduct opts arr ix len =
+        (:*:) <$> parseProduct opts arr ix  lenL
+              <*> parseProduct opts arr ixR lenR
         where
+#if MIN_VERSION_base(4,5,0)
+          lenL = len `unsafeShiftR` 1
+#else
           lenL = len `shiftR` 1
+#endif
           ixR  = ix + lenL
           lenR = len - lenL
-    {-# INLINE gParseProduct #-}
+    {-# INLINE parseProduct #-}
 
-instance (GFromJSON a) => GFromProduct (S1 s a) where
-    gParseProduct arr ix _ = gParseJSON $ V.unsafeIndex arr ix
-    {-# INLINE gParseProduct #-}
+instance (GFromJSON a) => FromProduct (S1 s a) where
+    parseProduct opts arr ix _ = gParseJSON opts $ V.unsafeIndex arr ix
+    {-# INLINE parseProduct #-}
 
 --------------------------------------------------------------------------------
 
-class GFromSum f where
-    gParseSum :: Pair -> Maybe (Parser (f a))
+class FromPair f where
+    parsePair :: Options -> Pair -> Maybe (Parser (f a))
 
-instance (GFromSum a, GFromSum b) => GFromSum (a :+: b) where
-    gParseSum keyVal = (fmap L1 <$> gParseSum keyVal) <|>
-                       (fmap R1 <$> gParseSum keyVal)
-    {-# INLINE gParseSum #-}
+instance (FromPair a, FromPair b) => FromPair (a :+: b) where
+    parsePair opts pair = (fmap L1 <$> parsePair opts pair) <|>
+                          (fmap R1 <$> parsePair opts pair)
+    {-# INLINE parsePair #-}
 
-instance (Constructor c, GFromJSON a, ConsFromJSON a) => GFromSum (C1 c a) where
-    gParseSum (key, value)
-        | key == pack (conName (undefined :: t c a p)) = Just $ gParseJSON value
-        | otherwise = Nothing
-    {-# INLINE gParseSum #-}
+instance (Constructor c, GFromJSON a, ConsFromJSON a) => FromPair (C1 c a) where
+    parsePair opts (tag, value)
+        | tag == tag' = Just $ gParseJSON opts value
+        | otherwise   = Nothing
+        where
+          tag' = pack $ constructorTagModifier opts $
+                          conName (undefined :: t c a p)
+    {-# INLINE parsePair #-}
 
 --------------------------------------------------------------------------------
 
-class IsRecord (f :: * -> *) b | f -> b
-
-data True
-data False
+class IsRecord (f :: * -> *) isRecord | f -> isRecord
 
-instance (IsRecord f b) => IsRecord (f :*: g) b
+instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
 instance IsRecord (M1 S NoSelector f) False
-instance (IsRecord f b) => IsRecord (M1 S c f) b
+instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
 instance IsRecord (K1 i c) True
 instance IsRecord U1 False
 
 --------------------------------------------------------------------------------
+
+class AllNullary (f :: * -> *) allNullary | f -> allNullary
+
+instance ( AllNullary a allNullaryL
+         , AllNullary b allNullaryR
+         , And allNullaryL allNullaryR allNullary
+         ) => AllNullary (a :+: b) allNullary
+instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary
+instance AllNullary (a :*: b) False
+instance AllNullary (K1 i c) False
+instance AllNullary U1 True
+
+--------------------------------------------------------------------------------
+
+data True
+data False
+
+class    And bool1 bool2 bool3 | bool1 bool2 -> bool3
+
+instance And True  True  True
+instance And False False False
+instance And False True  False
+instance And True  False False
+
+--------------------------------------------------------------------------------
+
+newtype Tagged s b = Tagged {unTagged :: b}
+
+newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}
+
+--------------------------------------------------------------------------------
+
+notFound :: String -> Parser a
+notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
+{-# INLINE notFound #-}
diff --git a/Data/Aeson/Types/Internal.hs b/Data/Aeson/Types/Internal.hs
--- a/Data/Aeson/Types/Internal.hs
+++ b/Data/Aeson/Types/Internal.hs
@@ -26,13 +26,20 @@
     , parse
     , parseEither
     , parseMaybe
+    , modifyFailure
     -- * Constructors and accessors
     , object
+
+    -- * Generic and TH encoding configuration
+    , Options(..)
+    , SumEncoding(..)
+    , defaultOptions
+    , defaultTaggedObject
     ) where
 
 import Control.Applicative
+import Control.Monad
 import Control.DeepSeq (NFData(..))
-import Control.Monad.State.Strict
 import Data.Attoparsec.Char8 (Number(..))
 import Data.Hashable (Hashable(..))
 import Data.HashMap.Strict (HashMap)
@@ -215,13 +222,109 @@
 -- | Run a 'Parser' with an 'Either' result type.
 parseEither :: (a -> Parser b) -> a -> Either String b
 parseEither m v = runParser (m v) Left Right
+{-# INLINE parseEither #-}
 
 -- | A key\/value pair for an 'Object'.
 type Pair = (Text, Value)
 
-{-# INLINE parseEither #-}
 -- | Create a 'Value' from a list of name\/value 'Pair's.  If duplicate
 -- keys arise, earlier keys and their associated values win.
 object :: [Pair] -> Value
 object = Object . H.fromList
 {-# INLINE object #-}
+
+-- | If the inner @Parser@ failed, modify the failure message using the
+-- provided function. This allows you to create more descriptive error messages.
+-- For example:
+--
+-- > parseJSON (Object o) = modifyFailure
+-- >     ("Parsing of the Foo value failed: " ++)
+-- >     (Foo <$> o .: "someField")
+--
+-- Since 0.6.2.0
+modifyFailure :: (String -> String) -> Parser a -> Parser a
+modifyFailure f (Parser p) = Parser $ \kf -> p (kf . f)
+
+--------------------------------------------------------------------------------
+-- Generic and TH encoding configuration
+--------------------------------------------------------------------------------
+
+-- | Options that specify how to encode\/decode your datatype to\/from JSON.
+data Options = Options
+    { fieldLabelModifier :: String -> String
+      -- ^ Function applied to field labels.
+      -- Handy for removing common record prefixes for example.
+    , constructorTagModifier :: String -> String
+      -- ^ Function applied to constructor tags which could be handy
+      -- for lower-casing them for example.
+    , allNullaryToStringTag :: Bool
+      -- ^ If 'True' the constructors of a datatype, with /all/
+      -- nullary constructors, will be encoded to just a string with
+      -- the constructor tag. If 'False' the encoding will always
+      -- follow the `sumEncoding`.
+    , omitNothingFields :: Bool
+      -- ^ If 'True' record fields with a 'Nothing' value will be
+      -- omitted from the resulting object. If 'False' the resulting
+      -- object will include those fields mapping to @null@.
+    , sumEncoding :: SumEncoding
+      -- ^ Specifies how to encode constructors of a sum datatype.
+    }
+
+-- | Specifies how to encode constructors of a sum datatype.
+data SumEncoding =
+    TaggedObject { tagFieldName      :: String
+                 , contentsFieldName :: String
+                 }
+    -- ^ A constructor will be encoded to an object with a field
+    -- 'tagFieldName' which specifies the constructor tag (modified by
+    -- the 'constructorTagModifier'). If the constructor is a record
+    -- the encoded record fields will be unpacked into this object. So
+    -- make sure that your record doesn't have a field with the same
+    -- label as the 'tagFieldName'. Otherwise the tag gets overwritten
+    -- by the encoded value of that field! If the constructor is not a
+    -- record the encoded constructor contents will be stored under
+    -- the 'contentsFieldName' field.
+  | ObjectWithSingleField
+    -- ^ A constructor will be encoded to an object with a single
+    -- field named after the constructor tag (modified by the
+    -- 'constructorTagModifier') which maps to the encoded contents of
+    -- the constructor.
+  | TwoElemArray
+    -- ^ A constructor will be encoded to a 2-element array where the
+    -- first element is the tag of the constructor (modified by the
+    -- 'constructorTagModifier') and the second element the encoded
+    -- contents of the constructor.
+
+-- | Default encoding 'Options':
+--
+-- @
+-- 'Options'
+-- { 'fieldLabelModifier'      = id
+-- , 'constructorTagModifier'  = id
+-- , 'allNullaryToStringTag'   = True
+-- , 'omitNothingFields'       = False
+-- , 'sumEncoding'             = 'defaultTaggedObject'
+-- }
+-- @
+defaultOptions :: Options
+defaultOptions = Options
+                 { fieldLabelModifier      = id
+                 , constructorTagModifier  = id
+                 , allNullaryToStringTag   = True
+                 , omitNothingFields       = False
+                 , sumEncoding             = defaultTaggedObject
+                 }
+
+-- | Default 'TaggedObject' 'SumEncoding' options:
+--
+-- @
+-- defaultTaggedObject = 'TaggedObject'
+--                       { 'tagFieldName'      = \"tag\"
+--                       , 'contentsFieldName' = \"contents\"
+--                       }
+-- @
+defaultTaggedObject :: SumEncoding
+defaultTaggedObject = TaggedObject
+                      { tagFieldName      = "tag"
+                      , contentsFieldName = "contents"
+                      }
diff --git a/aeson.cabal b/aeson.cabal
--- a/aeson.cabal
+++ b/aeson.cabal
@@ -1,9 +1,9 @@
 name:            aeson
-version:         0.6.1.0
+version:         0.6.2.0
 license:         BSD3
 license-file:    LICENSE
 category:        Text, Web, JSON
-copyright:       (c) 2011, 2012 Bryan O'Sullivan
+copyright:       (c) 2011, 2012, 2013 Bryan O'Sullivan
                  (c) 2011 MailRank, Inc.
 author:          Bryan O'Sullivan <bos@serpentine.com>
 maintainer:      Bryan O'Sullivan <bos@serpentine.com>
@@ -86,7 +86,6 @@
     benchmarks/json-data/*.json
     examples/*.hs
     release-notes.markdown
-    tests/Properties.hs
 
 flag developer
   description: operate in developer mode
@@ -140,9 +139,19 @@
   type:           exitcode-stdio-1.0
   hs-source-dirs: tests
   main-is:        Properties.hs
+  other-modules:  Functions
+                  Instances
+                  Types
+                  Options
+                  Encoders
+                  Properties.Deprecated
 
   ghc-options:
     -Wall -threaded -rtsopts
+  if impl(ghc < 7.4)
+    ghc-options: -fcontext-stack=40
+  if impl(ghc >= 7.2)
+    cpp-options: -DGHC_GENERICS
 
   build-depends:
     QuickCheck,
@@ -155,7 +164,10 @@
     test-framework,
     test-framework-quickcheck2,
     text,
-    time
+    time,
+    unordered-containers,
+    vector,
+    ghc-prim >= 0.2
 
 source-repository head
   type:     git
diff --git a/benchmarks/AesonCompareAutoInstances.hs b/benchmarks/AesonCompareAutoInstances.hs
--- a/benchmarks/AesonCompareAutoInstances.hs
+++ b/benchmarks/AesonCompareAutoInstances.hs
@@ -4,7 +4,7 @@
 
 --------------------------------------------------------------------------------
 
-import Criterion.Main
+import Criterion.Main hiding (defaultOptions)
 
 import Control.DeepSeq (NFData, rnf, deepseq)
 
@@ -13,20 +13,26 @@
 import GHC.Generics (Generic)
 
 import Data.Aeson.Types
-import Data.Aeson.TH (mkToJSON, mkParseJSON)
+import Data.Aeson.TH
 import qualified Data.Aeson.Generic as G (fromJSON, toJSON)
 
+import Data.Aeson.Encode
+
+import Options
+
 --------------------------------------------------------------------------------
 
--- Taken from the documentation of Data.Aeson.TH:
 data D a = Nullary
          | Unary Int
          | Product String Char a
          | Record { testOne   :: Double
                   , testTwo   :: Bool
                   , testThree :: D a
-                  } deriving (Show, Eq, Generic, Data, Typeable)
+                  }
+           deriving (Show, Eq, Data, Typeable)
 
+deriveJSON opts ''D
+
 instance NFData a => NFData (D a) where
     rnf Nullary         = ()
     rnf (Unary n)       = rnf n
@@ -47,18 +53,43 @@
                     }
     }
 
-instance ToJSON   a => ToJSON   (D a)
-instance FromJSON a => FromJSON (D a)
+--------------------------------------------------------------------------------
 
-thDToJSON :: ToJSON a => D a -> Value
-thDToJSON = $(mkToJSON id ''D)
+data D' a = Nullary'
+          | Unary' Int
+          | Product' String Char a
+          | Record' { testOne'   :: Double
+                    , testTwo'   :: Bool
+                    , testThree' :: D' a
+                    }
+            deriving (Show, Eq, Generic, Data, Typeable)
 
-thDParseJSON :: FromJSON a => Value -> Parser (D a)
-thDParseJSON = $(mkParseJSON id ''D)
+instance ToJSON a => ToJSON (D' a) where
+    toJSON = genericToJSON opts
 
-thDFromJSON :: FromJSON a => Value -> Result (D a)
-thDFromJSON = parse thDParseJSON
+instance FromJSON a => FromJSON (D' a) where
+    parseJSON = genericParseJSON opts
 
+instance NFData a => NFData (D' a) where
+    rnf Nullary'         = ()
+    rnf (Unary' n)       = rnf n
+    rnf (Product' s c x) = s `deepseq` c `deepseq` rnf x
+    rnf (Record' d b y)  = d `deepseq` b `deepseq` rnf y
+
+type T' = D' (D' (D' ()))
+
+d' :: T'
+d' = Record'
+    { testOne' = 1234.56789
+    , testTwo' = True
+    , testThree' = Product' "Hello World!" 'a' $
+                    Record'
+                    { testOne'   = 9876.54321
+                    , testTwo'   = False
+                    , testThree' = Product' "Yeehaa!!!" '\n' Nullary'
+                    }
+    }
+
 --------------------------------------------------------------------------------
 
 data BigRecord = BigRecord
@@ -77,17 +108,17 @@
                       16 17 18 19 20
                       21 22 23 24 25
 
-instance ToJSON   BigRecord
-instance FromJSON BigRecord
+gBigRecordToJSON :: BigRecord -> Value
+gBigRecordToJSON = genericToJSON opts
 
-thBigRecordToJSON :: BigRecord -> Value
-thBigRecordToJSON = $(mkToJSON id ''BigRecord)
+gBigRecordFromJSON :: Value -> Result BigRecord
+gBigRecordFromJSON = parse $ genericParseJSON opts
 
-thBigRecordParseJSON :: Value -> Parser BigRecord
-thBigRecordParseJSON = $(mkParseJSON id ''BigRecord)
+thBigRecordToJSON :: BigRecord -> Value
+thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
 
 thBigRecordFromJSON :: Value -> Result BigRecord
-thBigRecordFromJSON = parse thBigRecordParseJSON
+thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
 
 --------------------------------------------------------------------------------
 
@@ -107,17 +138,17 @@
                         16 17 18 19 20
                         21 22 23 24 25
 
-instance ToJSON   BigProduct
-instance FromJSON BigProduct
+gBigProductToJSON :: BigProduct -> Value
+gBigProductToJSON = genericToJSON opts
 
-thBigProductToJSON :: BigProduct -> Value
-thBigProductToJSON = $(mkToJSON id ''BigProduct)
+gBigProductFromJSON :: Value -> Result BigProduct
+gBigProductFromJSON = parse $ genericParseJSON opts
 
-thBigProductParseJSON :: Value -> Parser BigProduct
-thBigProductParseJSON = $(mkParseJSON id ''BigProduct)
+thBigProductToJSON :: BigProduct -> Value
+thBigProductToJSON = $(mkToJSON opts ''BigProduct)
 
 thBigProductFromJSON :: Value -> Result BigProduct
-thBigProductFromJSON = parse thBigProductParseJSON
+thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
 
 --------------------------------------------------------------------------------
 
@@ -132,17 +163,17 @@
 
 bigSum = F25
 
-instance ToJSON   BigSum
-instance FromJSON BigSum
+gBigSumToJSON :: BigSum -> Value
+gBigSumToJSON = genericToJSON opts
 
-thBigSumToJSON :: BigSum -> Value
-thBigSumToJSON = $(mkToJSON id ''BigSum)
+gBigSumFromJSON :: Value -> Result BigSum
+gBigSumFromJSON = parse $ genericParseJSON opts
 
-thBigSumParseJSON :: Value -> Parser BigSum
-thBigSumParseJSON = $(mkParseJSON id ''BigSum)
+thBigSumToJSON :: BigSum -> Value
+thBigSumToJSON = $(mkToJSON opts ''BigSum)
 
 thBigSumFromJSON :: Value -> Result BigSum
-thBigSumFromJSON = parse thBigSumParseJSON
+thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
 
 --------------------------------------------------------------------------------
 
@@ -150,49 +181,51 @@
 
 main :: IO ()
 main = defaultMain
-  [ let v = thDToJSON d
-    in d `deepseq` v `deepseq`
+  [ let v = toJSON d
+    in (d, d', v) `deepseq`
        bgroup "D"
-       [ group "toJSON"   (nf thDToJSON d)
-                          (nf G.toJSON  d)
-                          (nf toJSON    d)
-       , group "fromJSON" (nf (thDFromJSON :: FJ T) v)
-                          (nf (G.fromJSON  :: FJ T) v)
-                          (nf (fromJSON    :: FJ T) v)
+       [ group "toJSON"   (nf   toJSON d)
+                          (nf G.toJSON d)
+                          (nf   toJSON d')
+       , group "fromJSON" (nf (  fromJSON :: FJ T ) v)
+                          (nf (G.fromJSON :: FJ T ) v)
+                          (nf (  fromJSON :: FJ T') v)
        ]
   , let v = thBigRecordToJSON bigRecord
     in bigRecord `deepseq` v `deepseq`
        bgroup "BigRecord"
        [ group "toJSON"   (nf thBigRecordToJSON bigRecord)
                           (nf G.toJSON          bigRecord)
-                          (nf toJSON            bigRecord)
+                          (nf gBigRecordToJSON  bigRecord)
        , group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
                           (nf (G.fromJSON          :: FJ BigRecord) v)
-                          (nf (fromJSON            :: FJ BigRecord) v)
+                          (nf (gBigRecordFromJSON  :: FJ BigRecord) v)
        ]
   , let v = thBigProductToJSON bigProduct
     in bigProduct `deepseq` v `deepseq`
        bgroup "BigProduct"
        [ group "toJSON"   (nf thBigProductToJSON bigProduct)
                           (nf G.toJSON           bigProduct)
-                          (nf toJSON             bigProduct)
+                          (nf gBigProductToJSON  bigProduct)
        , group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
                           (nf (G.fromJSON           :: FJ BigProduct) v)
-                          (nf (fromJSON             :: FJ BigProduct) v)
+                          (nf (gBigProductFromJSON  :: FJ BigProduct) v)
        ]
   , let v = thBigSumToJSON bigSum
     in bigSum `deepseq` v `deepseq`
        bgroup "BigSum"
        [ group "toJSON"   (nf thBigSumToJSON bigSum)
                           (nf G.toJSON       bigSum)
-                          (nf toJSON         bigSum)
+                          (nf gBigSumToJSON  bigSum)
        , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
                           (nf (G.fromJSON       :: FJ BigSum) v)
-                          (nf (fromJSON         :: FJ BigSum) v)
+                          (nf (gBigSumFromJSON  :: FJ BigSum) v)
        ]
   ]
 
-group n th syb gen = bgroup n [ bench "th"      th
-                              , bench "syb"     syb
-                              , bench "generic" gen
-                              ]
+group n th syb gen = bcompare
+                     [ bgroup n [ bench "th"      th
+                                , bench "syb"     syb
+                                , bench "generic" gen
+                                ]
+                     ]
diff --git a/benchmarks/AesonEncode.hs b/benchmarks/AesonEncode.hs
--- a/benchmarks/AesonEncode.hs
+++ b/benchmarks/AesonEncode.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, OverloadedStrings #-}
+{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}
 
 import Control.Exception
 import Control.Monad
@@ -8,35 +8,36 @@
 import System.Environment (getArgs)
 import System.IO
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Lazy.Internal as L
 import Control.DeepSeq
 
+#if !MIN_VERSION_bytestring(0,10,0)
+import qualified Data.ByteString.Lazy.Internal as L
+
 instance NFData L.ByteString where
     rnf = go
       where go (L.Chunk _ cs) = go cs
             go L.Empty        = ()
     {-# INLINE rnf #-}
+#endif
 
+main :: IO ()
 main = do
   (cnt:args) <- getArgs
   let count = read cnt :: Int
   forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
     putStrLn $ arg ++ ":"
     let refill = B.hGet h 16384
-    result <- parseWith refill json =<< refill
-    r <- case result of
-           Done _ r -> return r
-           _        -> fail $ "failed to read " ++ show arg
+    result0 <- parseWith refill json =<< refill
+    r0 <- case result0 of
+            Done _ r -> return r
+            _        -> fail $ "failed to read " ++ show arg
     start <- getCurrentTime
     let loop !n r
             | n >= count = return ()
             | otherwise = {-# SCC "loop" #-} do
-          case result of
-            Done _ r -> rnf (encode r) `seq` loop (n+1) r
-            _        -> error $ "failed to read " ++ show arg
-    loop 0 r
+          rnf (encode r) `seq` loop (n+1) r
+    loop 0 r0
     delta <- flip diffUTCTime start `fmap` getCurrentTime
     let rate = fromIntegral count / realToFrac delta :: Double
     putStrLn $ "  " ++ show delta
-    putStrLn $ "  " ++ show (round rate) ++ " per second"
+    putStrLn $ "  " ++ show (round rate :: Int) ++ " per second"
diff --git a/benchmarks/AesonParse.hs b/benchmarks/AesonParse.hs
--- a/benchmarks/AesonParse.hs
+++ b/benchmarks/AesonParse.hs
@@ -10,8 +10,9 @@
 import qualified Data.ByteString as B
 
 main = do
-  (cnt:args) <- getArgs
+  (bs:cnt:args) <- getArgs
   let count = read cnt :: Int
+      blkSize = read bs
   forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
     putStrLn $ arg ++ ":"
     start <- getCurrentTime
@@ -19,7 +20,7 @@
             | good+bad >= count = return (good, bad)
             | otherwise = do
           hSeek h AbsoluteSeek 0
-          let refill = B.hGet h 16384
+          let refill = B.hGet h blkSize
           result <- parseWith refill json =<< refill
           case result of
             Done _ r -> loop (good+1) bad
diff --git a/benchmarks/CompareWithJSON.hs b/benchmarks/CompareWithJSON.hs
--- a/benchmarks/CompareWithJSON.hs
+++ b/benchmarks/CompareWithJSON.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 import Blaze.ByteString.Builder (toLazyByteString)
@@ -6,9 +7,16 @@
 import Criterion.Main
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Lazy.Internal as BL
 import qualified Text.JSON as J
 
+#if !MIN_VERSION_bytestring(0,10,0)
+import qualified Data.ByteString.Lazy.Internal as BL
+
+instance NFData BL.ByteString where
+  rnf (BL.Chunk _ bs) = rnf bs
+  rnf BL.Empty        = ()
+#endif
+
 instance (NFData v) => NFData (J.JSObject v) where
   rnf o = rnf (J.fromJSObject o)
 
@@ -19,10 +27,6 @@
   rnf (J.JSString s) = rnf (J.fromJSString s)
   rnf (J.JSArray lst) = rnf lst
   rnf (J.JSObject o) = rnf o
-
-instance NFData BL.ByteString where
-  rnf (BL.Chunk _ bs) = rnf bs
-  rnf BL.Empty        = ()
 
 decodeJ :: String -> J.JSValue
 decodeJ s =
diff --git a/benchmarks/Options.hs b/benchmarks/Options.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/Options.hs
@@ -0,0 +1,8 @@
+module Options where
+
+import Data.Aeson.Types
+
+opts :: Options
+opts = defaultOptions
+       { sumEncoding = ObjectWithSingleField
+       }
diff --git a/tests/Encoders.hs b/tests/Encoders.hs
new file mode 100644
--- /dev/null
+++ b/tests/Encoders.hs
@@ -0,0 +1,118 @@
+{-# Language CPP, TemplateHaskell #-}
+
+module Encoders where
+
+import Data.Aeson.TH
+import Data.Aeson.Types
+import Options
+import Types
+
+--------------------------------------------------------------------------------
+-- Nullary encoders/decoders
+--------------------------------------------------------------------------------
+
+thNullaryToJSONString :: Nullary -> Value
+thNullaryToJSONString = $(mkToJSON defaultOptions ''Nullary)
+
+thNullaryParseJSONString :: Value -> Parser Nullary
+thNullaryParseJSONString = $(mkParseJSON defaultOptions ''Nullary)
+
+
+thNullaryToJSON2ElemArray :: Nullary -> Value
+thNullaryToJSON2ElemArray = $(mkToJSON opts2ElemArray ''Nullary)
+
+thNullaryParseJSON2ElemArray :: Value -> Parser Nullary
+thNullaryParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''Nullary)
+
+
+thNullaryToJSONTaggedObject :: Nullary -> Value
+thNullaryToJSONTaggedObject = $(mkToJSON optsTaggedObject ''Nullary)
+
+thNullaryParseJSONTaggedObject :: Value -> Parser Nullary
+thNullaryParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''Nullary)
+
+
+thNullaryToJSONObjectWithSingleField :: Nullary -> Value
+thNullaryToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''Nullary)
+
+thNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
+thNullaryParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''Nullary)
+
+#ifdef GHC_GENERICS
+gNullaryToJSONString :: Nullary -> Value
+gNullaryToJSONString = genericToJSON defaultOptions
+
+gNullaryParseJSONString :: Value -> Parser Nullary
+gNullaryParseJSONString = genericParseJSON defaultOptions
+
+
+gNullaryToJSON2ElemArray :: Nullary -> Value
+gNullaryToJSON2ElemArray = genericToJSON opts2ElemArray
+
+gNullaryParseJSON2ElemArray :: Value -> Parser Nullary
+gNullaryParseJSON2ElemArray = genericParseJSON opts2ElemArray
+
+
+gNullaryToJSONTaggedObject :: Nullary -> Value
+gNullaryToJSONTaggedObject = genericToJSON optsTaggedObject
+
+gNullaryParseJSONTaggedObject :: Value -> Parser Nullary
+gNullaryParseJSONTaggedObject = genericParseJSON optsTaggedObject
+
+
+gNullaryToJSONObjectWithSingleField :: Nullary -> Value
+gNullaryToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField
+
+gNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
+gNullaryParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
+#endif
+
+
+--------------------------------------------------------------------------------
+-- SomeType encoders/decoders
+--------------------------------------------------------------------------------
+
+type SomeTypeToJSON = SomeType Int -> Value
+
+thSomeTypeToJSON2ElemArray :: ToJSON a => SomeType a -> Value
+thSomeTypeToJSON2ElemArray = $(mkToJSON opts2ElemArray ''SomeType)
+
+thSomeTypeParseJSON2ElemArray :: FromJSON a => Value -> Parser (SomeType a)
+thSomeTypeParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''SomeType)
+
+
+thSomeTypeToJSONTaggedObject :: ToJSON a => SomeType a -> Value
+thSomeTypeToJSONTaggedObject = $(mkToJSON optsTaggedObject ''SomeType)
+
+thSomeTypeParseJSONTaggedObject :: FromJSON a => Value -> Parser (SomeType a)
+thSomeTypeParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''SomeType)
+
+
+thSomeTypeToJSONObjectWithSingleField :: ToJSON a => SomeType a -> Value
+thSomeTypeToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''SomeType)
+
+thSomeTypeParseJSONObjectWithSingleField :: FromJSON a => Value -> Parser (SomeType a)
+thSomeTypeParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''SomeType)
+
+
+#ifdef GHC_GENERICS
+gSomeTypeToJSON2ElemArray :: ToJSON a => SomeType a -> Value
+gSomeTypeToJSON2ElemArray = genericToJSON opts2ElemArray
+
+gSomeTypeParseJSON2ElemArray :: FromJSON a => Value -> Parser (SomeType a)
+gSomeTypeParseJSON2ElemArray = genericParseJSON opts2ElemArray
+
+
+gSomeTypeToJSONTaggedObject :: ToJSON a => SomeType a -> Value
+gSomeTypeToJSONTaggedObject = genericToJSON optsTaggedObject
+
+gSomeTypeParseJSONTaggedObject :: FromJSON a => Value -> Parser (SomeType a)
+gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject
+
+
+gSomeTypeToJSONObjectWithSingleField :: ToJSON a => SomeType a -> Value
+gSomeTypeToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField
+
+gSomeTypeParseJSONObjectWithSingleField :: FromJSON a => Value -> Parser (SomeType a)
+gSomeTypeParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleField
+#endif
diff --git a/tests/Functions.hs b/tests/Functions.hs
new file mode 100644
--- /dev/null
+++ b/tests/Functions.hs
@@ -0,0 +1,10 @@
+module Functions where
+
+approxEq :: (Fractional a, Ord a) => a -> a -> Bool
+approxEq = approxEqWith 1e-15 1e-15
+
+approxEqWith :: (Fractional a, Ord a) => a -> a -> a -> a -> Bool
+approxEqWith maxAbsoluteError maxRelativeError a b =
+    a == b || d < maxAbsoluteError ||
+    d / max (abs b) (abs a) <= maxRelativeError
+  where d = abs (a - b)
diff --git a/tests/Instances.hs b/tests/Instances.hs
new file mode 100644
--- /dev/null
+++ b/tests/Instances.hs
@@ -0,0 +1,146 @@
+{-# Language CPP, OverloadedStrings, RecordWildCards, StandaloneDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+#if __GLASGOW_HASKELL__ < 702
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
+#endif
+
+module Instances where
+
+import Types
+import Data.Function (on)
+import Control.Monad
+import Test.QuickCheck (Arbitrary(..), Gen, choose, oneof, elements)
+import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)
+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),
+                  hoursToTimeZone, Day(..), TimeOfDay(..))
+import qualified Data.Text as T
+import qualified Data.Map as Map
+import Data.Text (Text)
+import Data.Aeson.Types
+import Control.Applicative
+import Functions
+
+-- "System" types.
+
+instance Arbitrary Text where
+    arbitrary = T.pack <$> arbitrary
+
+instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
+    arbitrary = Map.fromList <$> arbitrary
+
+instance Arbitrary LocalTime where
+    arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
+
+instance Arbitrary TimeZone where
+    arbitrary = do
+      offset <- choose (0,2) :: Gen Int
+      return $ hoursToTimeZone offset
+
+instance Arbitrary Day where
+    arbitrary = ModifiedJulianDay `liftM` arbitrary
+
+instance Arbitrary DiffTime where
+    arbitrary = picosecondsToDiffTime `liftM` choose (0, 86400000000000000)
+
+instance Arbitrary UTCTime where
+    arbitrary = liftM2 UTCTime arbitrary arbitrary
+
+instance Arbitrary DotNetTime where
+    arbitrary = DotNetTime `liftM` arbitrary
+
+instance Arbitrary ZonedTime where
+    arbitrary = liftM2 ZonedTime arbitrary arbitrary
+
+deriving instance Eq ZonedTime
+
+-- Compare equality to within a millisecond, allowing for rounding
+-- error (ECMA 262 requires milliseconds to rounded to zero, not
+-- rounded to nearest).
+instance ApproxEq UTCTime where
+    a =~ b = ((==) `on` utctDay) a b &&
+             (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
+
+instance ApproxEq DotNetTime where
+    (=~) = (=~) `on` fromDotNetTime
+
+instance ApproxEq Double where
+    (=~) = approxEq
+
+-- Test-related types.
+
+instance Arbitrary Foo where
+    arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
+
+instance Eq Foo where
+    a == b = fooInt a == fooInt b &&
+             fooDouble a `approxEq` fooDouble b &&
+             fooTuple a == fooTuple b
+
+instance ToJSON Foo where
+    toJSON Foo{..} = object [ "fooInt" .= fooInt
+                            , "fooDouble" .= fooDouble
+                            , "fooTuple" .= fooTuple
+                            , "fooMap" .= fooMap
+                            ]
+
+instance FromJSON Foo where
+    parseJSON (Object v) = Foo <$>
+                           v .: "fooInt" <*>
+                           v .: "fooDouble" <*>
+                           v .: "fooTuple" <*>
+                           v .: "fooMap"
+    parseJSON _ = empty
+
+instance Arbitrary UFoo where
+    arbitrary = UFoo <$> arbitrary <*> arbitrary
+        where _ = uFooInt
+
+instance Arbitrary OneConstructor where
+    arbitrary = return OneConstructor
+
+instance FromJSON OneConstructor
+instance ToJSON OneConstructor
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
+    arbitrary = liftM2 Product2 arbitrary arbitrary
+
+instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
+instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
+          Arbitrary f) => Arbitrary (Product6 a b c d e f) where
+    arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
+                             arbitrary <*> arbitrary <*> arbitrary
+
+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
+          FromJSON f) => FromJSON (Product6 a b c d e f)
+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
+          ToJSON f) => ToJSON (Product6 a b c d e f)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
+    => Arbitrary (Sum4 a b c d) where
+    arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
+                       Alt3 <$> arbitrary, Alt4 <$> arbitrary]
+
+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
+    => FromJSON (Sum4 a b c d)
+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
+
+instance (Arbitrary a) => Arbitrary (Approx a) where
+    arbitrary = Approx <$> arbitrary
+
+instance (FromJSON a) => FromJSON (Approx a) where
+    parseJSON a = Approx <$> parseJSON a
+
+instance (ToJSON a) => ToJSON (Approx a) where
+    toJSON = toJSON . fromApprox
+
+instance Arbitrary Nullary where
+    arbitrary = elements [C1, C2, C3]
+
+instance Arbitrary a => Arbitrary (SomeType a) where
+    arbitrary = oneof [ pure Nullary
+                      , Unary   <$> arbitrary
+                      , Product <$> arbitrary <*> arbitrary <*> arbitrary
+                      , Record  <$> arbitrary <*> arbitrary <*> arbitrary
+                      ]
diff --git a/tests/Options.hs b/tests/Options.hs
new file mode 100644
--- /dev/null
+++ b/tests/Options.hs
@@ -0,0 +1,26 @@
+module Options where
+
+import Data.Aeson.Types
+import Data.Char
+
+optsDefault :: Options
+optsDefault = defaultOptions
+              { fieldLabelModifier     = map toLower
+              , constructorTagModifier = map toLower
+              }
+
+opts2ElemArray :: Options
+opts2ElemArray = optsDefault
+                 { allNullaryToStringTag = False
+                 , sumEncoding     = TwoElemArray
+                 }
+
+optsTaggedObject :: Options
+optsTaggedObject = optsDefault
+                   { allNullaryToStringTag = False }
+
+optsObjectWithSingleField :: Options
+optsObjectWithSingleField = optsDefault
+                            { allNullaryToStringTag = False
+                            , sumEncoding           = ObjectWithSingleField
+                            }
diff --git a/tests/Properties.hs b/tests/Properties.hs
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -1,25 +1,29 @@
-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards,
-    ScopedTypeVariables, StandaloneDeriving #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE CPP, OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
 
-import Control.Monad
-import Control.Applicative
 import Data.Aeson.Encode
 import Data.Aeson.Parser (value)
 import Data.Aeson.Types
 import Data.Attoparsec.Number
-import Data.Data (Typeable, Data)
-import Data.Text (Text)
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.QuickCheck (Arbitrary(..), choose, Gen)
-import qualified Data.Aeson.Generic as G
+import Test.QuickCheck (Arbitrary(..))
+import qualified Data.Vector as V
 import qualified Data.Attoparsec.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Text as T
+import qualified Data.HashMap.Strict as H
+import Data.Time.Clock (UTCTime(..))
+import Data.Time (ZonedTime(..))
+import Instances ()
+import Types
+import Encoders
+import Properties.Deprecated (deprecatedTests)
+#ifdef GHC_GENERICS
+import Data.Int
 import qualified Data.Map as Map
-import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), hoursToTimeZone, Day(..), TimeOfDay(..))
+#endif
 
+
 encodeDouble :: Double -> Double -> Bool
 encodeDouble num denom
     | isInfinite d || isNaN d = encode (Number (D d)) == "null"
@@ -29,6 +33,12 @@
 encodeInteger :: Integer -> Bool
 encodeInteger i = encode (Number (I i)) == L.pack (show i)
 
+toParseJSON :: (Arbitrary a, Eq a) => (Value -> Parser a) -> (a -> Value) -> a -> Bool
+toParseJSON parsejson tojson x =
+    case parse parsejson . tojson $ x of
+      Error _ -> False
+      Success x' -> x == x'
+
 roundTrip :: (FromJSON a, ToJSON a) => (a -> a -> Bool) -> a -> a -> Bool
 roundTrip eq _ i =
     case fmap fromJSON . L.parse value . encode . toJSON $ i of
@@ -38,127 +48,79 @@
 roundTripEq :: (Eq a, FromJSON a, ToJSON a) => a -> a -> Bool
 roundTripEq x y = roundTrip (==) x y
 
-genericTo :: (Data a, ToJSON a) => a -> a -> Bool
-genericTo _ v = G.toJSON v == toJSON v
-
-genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool
-genericFrom _ v = G.fromJSON (toJSON v) == Success v
-
-approxEq :: Double -> Double -> Bool
-approxEq a b = a == b ||
-               d < maxAbsoluteError ||
-                 d / max (abs b) (abs a) <= maxRelativeError
-    where d = abs (a - b)
-          maxAbsoluteError = 1e-15
-          maxRelativeError = 1e-15
-
 toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a) => a -> Bool
 toFromJSON x = case fromJSON . toJSON $ x of
                 Error _ -> False
                 Success x' -> x == x'
 
-genericToFromJSON :: (Arbitrary a, Eq a, Data a) => a -> Bool
-genericToFromJSON x = case G.fromJSON . G.toJSON $ x of
-                Error _ -> False
-                Success x' -> x == x'
-
-regress_gh72 :: [(String, Maybe String)] -> Bool
-regress_gh72 ys = G.decode (G.encode m) == Just m
-    where m = Map.fromList ys
-
-data Foo = Foo {
-      fooInt :: Int
-    , fooDouble :: Double
-    , fooTuple :: (String, Text, Int)
-    -- This definition causes an infinite loop in genericTo and genericFrom!
-    -- , fooMap :: Map.Map String Foo
-    , fooMap :: Map.Map String (Text,Int)
-    } deriving (Show, Typeable, Data)
-
-instance Eq Foo where
-    a == b = fooInt a == fooInt b &&
-             fooDouble a `approxEq` fooDouble b &&
-             fooTuple a == fooTuple b
-
-instance ToJSON Foo where
-    toJSON Foo{..} = object [ "fooInt" .= fooInt
-                            , "fooDouble" .= fooDouble
-                            , "fooTuple" .= fooTuple
-                            , "fooMap" .= fooMap
-                            ]
-
-instance FromJSON Foo where
-    parseJSON (Object v) = Foo <$>
-                           v .: "fooInt" <*>
-                           v .: "fooDouble" <*>
-                           v .: "fooTuple" <*>
-                           v .: "fooMap"
-    parseJSON _ = empty
-
-instance Arbitrary Text where
-    arbitrary = T.pack <$> arbitrary
+modifyFailureProp :: String -> String -> Bool
+modifyFailureProp orig added =
+    result == Error (added ++ orig)
+  where
+    parser = const $ modifyFailure (added ++) $ fail orig
+    result :: Result ()
+    result = parse parser ()
 
-instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
-    arbitrary = Map.fromList <$> arbitrary
+main :: IO ()
+main = defaultMain tests
 
-instance Arbitrary Foo where
-    arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
+#ifdef GHC_GENERICS
+type P6 = Product6 Int Bool String (Approx Double) (Int, Approx Double) ()
+type S4 = Sum4 Int8 ZonedTime T.Text (Map.Map String Int)
+#endif
 
-instance Arbitrary LocalTime where
-    arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
+--------------------------------------------------------------------------------
+-- Value properties
+--------------------------------------------------------------------------------
 
-instance Arbitrary TimeZone where
-    arbitrary = do
-      offset <- choose (0,2) :: Gen Int
-      return $ hoursToTimeZone offset
+isString :: Value -> Bool
+isString (String _) = True
+isString _          = False
 
-instance Arbitrary ZonedTime where
-    arbitrary = liftM2 ZonedTime arbitrary arbitrary
+is2ElemArray :: Value -> Bool
+is2ElemArray (Array v) = V.length v == 2 && isString (V.head v)
+is2ElemArray _         = False
 
-data UFoo = UFoo {
-      _UFooInt :: Int
-    , uFooInt :: Int
-    } deriving (Show, Eq, Data, Typeable)
+isTaggedObjectValue :: Value -> Bool
+isTaggedObjectValue (Object obj) = "tag"      `H.member` obj &&
+                                   "contents" `H.member` obj
+isTaggedObjectValue _            = False
 
-instance Arbitrary UFoo where
-    arbitrary = UFoo <$> arbitrary <*> arbitrary
-        where _ = uFooInt
+isTaggedObject :: Value -> Bool
+isTaggedObject (Object obj) = "tag" `H.member` obj
+isTaggedObject _            = False
 
-main :: IO ()
-main = defaultMain tests
+isObjectWithSingleField :: Value -> Bool
+isObjectWithSingleField (Object obj) = H.size obj == 1
+isObjectWithSingleField _            = False
 
-deriving instance Eq ZonedTime
+--------------------------------------------------------------------------------
 
 tests :: [Test]
 tests = [
-  testGroup "regression" [
-      testProperty "gh-72" regress_gh72
-  ],
   testGroup "encode" [
       testProperty "encodeDouble" encodeDouble
     , testProperty "encodeInteger" encodeInteger
     ],
-  testGroup "genericFrom" [
-      testProperty "Bool" $ genericFrom True
-    , testProperty "Double" $ genericFrom (1::Double)
-    , testProperty "Int" $ genericFrom (1::Int)
-    , testProperty "Foo" $ genericFrom (undefined::Foo)
-    ],
-  testGroup "genericTo" [
-      testProperty "Bool" $ genericTo True
-    , testProperty "Double" $ genericTo (1::Double)
-    , testProperty "Int" $ genericTo (1::Int)
-    , testProperty "Foo" $ genericTo (undefined::Foo)
-    ],
   testGroup "roundTrip" [
       testProperty "Bool" $ roundTripEq True
-    , testProperty "Double" $ roundTrip approxEq (1::Double)
+    , testProperty "Double" $ roundTripEq (1 :: Approx Double)
     , testProperty "Int" $ roundTripEq (1::Int)
     , testProperty "Integer" $ roundTripEq (1::Integer)
     , testProperty "String" $ roundTripEq (""::String)
     , testProperty "Text" $ roundTripEq T.empty
     , testProperty "Foo" $ roundTripEq (undefined::Foo)
+    , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)
+    , testProperty "UTCTime" $ roundTripEq (undefined :: Approx UTCTime)
     , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)
+#ifdef GHC_GENERICS
+    , testGroup "ghcGenerics" [
+        testProperty "OneConstructor" $ roundTripEq OneConstructor
+      , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)
+      , testProperty "Product6" $ roundTripEq (undefined :: P6)
+      , testProperty "Sum4" $ roundTripEq (undefined :: S4)
+      ]
+#endif
     ],
   testGroup "toFromJSON" [
       testProperty "Integer" (toFromJSON :: Integer -> Bool)
@@ -167,7 +129,72 @@
     , testProperty "Either Integer Double" (toFromJSON :: Either Integer Double -> Bool)
     , testProperty "Either Integer Integer" (toFromJSON :: Either Integer Integer -> Bool)
     ],
-  testGroup "genericToFromJSON" [
-      testProperty "_UFoo" (genericToFromJSON :: UFoo -> Bool)
+  testGroup "deprecated" deprecatedTests,
+  testGroup "failure messages" [
+      testProperty "modify failure" modifyFailureProp
+    ],
+  testGroup "template-haskell" [
+      testGroup "Nullary" [
+          testProperty "string"                (isString                . thNullaryToJSONString)
+        , testProperty "2ElemArray"            (is2ElemArray            . thNullaryToJSON2ElemArray)
+        , testProperty "TaggedObject"          (isTaggedObjectValue     . thNullaryToJSONTaggedObject)
+        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField)
+
+        , testGroup "roundTrip" [
+              testProperty "string"                (toParseJSON thNullaryParseJSONString                thNullaryToJSONString)
+            , testProperty "2ElemArray"            (toParseJSON thNullaryParseJSON2ElemArray            thNullaryToJSON2ElemArray)
+            , testProperty "TaggedObject"          (toParseJSON thNullaryParseJSONTaggedObject          thNullaryToJSONTaggedObject)
+            , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField)
+          ]
+        ]
+    , testGroup "SomeType" [
+          testProperty "2ElemArray"            (is2ElemArray            . (thSomeTypeToJSON2ElemArray            :: SomeTypeToJSON))
+        , testProperty "TaggedObject"          (isTaggedObject          . (thSomeTypeToJSONTaggedObject          :: SomeTypeToJSON))
+        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . (thSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
+
+        , testGroup "roundTrip" [
+              testProperty "2ElemArray"            (toParseJSON thSomeTypeParseJSON2ElemArray            (thSomeTypeToJSON2ElemArray            :: SomeTypeToJSON))
+            , testProperty "TaggedObject"          (toParseJSON thSomeTypeParseJSONTaggedObject          (thSomeTypeToJSONTaggedObject          :: SomeTypeToJSON))
+            , testProperty "ObjectWithSingleField" (toParseJSON thSomeTypeParseJSONObjectWithSingleField (thSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
+          ]
+      ]
     ]
+#ifdef GHC_GENERICS
+  , testGroup "GHC-generics" [
+        testGroup "Nullary" [
+            testProperty "string"                (isString                . gNullaryToJSONString)
+          , testProperty "2ElemArray"            (is2ElemArray            . gNullaryToJSON2ElemArray)
+          , testProperty "TaggedObject"          (isTaggedObjectValue     . gNullaryToJSONTaggedObject)
+          , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gNullaryToJSONObjectWithSingleField)
+          , testGroup "eq" [
+                testProperty "string"                (\n -> gNullaryToJSONString                n == thNullaryToJSONString                n)
+              , testProperty "2ElemArray"            (\n -> gNullaryToJSON2ElemArray            n == thNullaryToJSON2ElemArray            n)
+              , testProperty "TaggedObject"          (\n -> gNullaryToJSONTaggedObject          n == thNullaryToJSONTaggedObject          n)
+              , testProperty "ObjectWithSingleField" (\n -> gNullaryToJSONObjectWithSingleField n == thNullaryToJSONObjectWithSingleField n)
+            ]
+          , testGroup "roundTrip" [
+              testProperty "string"                (toParseJSON gNullaryParseJSONString                gNullaryToJSONString)
+            , testProperty "2ElemArray"            (toParseJSON gNullaryParseJSON2ElemArray            gNullaryToJSON2ElemArray)
+            , testProperty "TaggedObject"          (toParseJSON gNullaryParseJSONTaggedObject          gNullaryToJSONTaggedObject)
+            , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField)
+            ]
+          ]
+    , testGroup "SomeType" [
+          testProperty "2ElemArray"            (is2ElemArray            . (gSomeTypeToJSON2ElemArray            :: SomeTypeToJSON))
+        , testProperty "TaggedObject"          (isTaggedObject          . (gSomeTypeToJSONTaggedObject          :: SomeTypeToJSON))
+        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . (gSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
+
+        , testGroup "eq" [
+              testProperty "2ElemArray"            (\n -> (gSomeTypeToJSON2ElemArray            :: SomeTypeToJSON) n == thSomeTypeToJSON2ElemArray            n)
+            , testProperty "TaggedObject"          (\n -> (gSomeTypeToJSONTaggedObject          :: SomeTypeToJSON) n == thSomeTypeToJSONTaggedObject          n)
+            , testProperty "ObjectWithSingleField" (\n -> (gSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON) n == thSomeTypeToJSONObjectWithSingleField n)
+          ]
+        , testGroup "roundTrip" [
+            testProperty "2ElemArray"            (toParseJSON gSomeTypeParseJSON2ElemArray            (gSomeTypeToJSON2ElemArray            :: SomeTypeToJSON))
+          , testProperty "TaggedObject"          (toParseJSON gSomeTypeParseJSONTaggedObject          (gSomeTypeToJSONTaggedObject          :: SomeTypeToJSON))
+          , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField (gSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
+          ]
+      ]
+    ]
+#endif
   ]
diff --git a/tests/Properties/Deprecated.hs b/tests/Properties/Deprecated.hs
new file mode 100644
--- /dev/null
+++ b/tests/Properties/Deprecated.hs
@@ -0,0 +1,57 @@
+-- This module is only for testing deprecated features, so we can
+-- silence compiler warnings selectively.
+
+{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
+
+module Properties.Deprecated (deprecatedTests) where
+
+import Data.Aeson.Types
+import Data.Data (Data)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck (Arbitrary(..))
+import qualified Data.Aeson.Generic as G
+import qualified Data.Map as Map
+import Types (Foo(..), UFoo(..))
+import Instances ()
+
+
+genericTo :: (Data a, ToJSON a) => a -> a -> Bool
+genericTo _ v = G.toJSON v == toJSON v
+
+genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool
+genericFrom _ v = G.fromJSON (toJSON v) == Success v
+
+genericToFromJSON :: (Arbitrary a, Eq a, Data a) => a -> Bool
+genericToFromJSON x = case G.fromJSON . G.toJSON $ x of
+                Error _ -> False
+                Success x' -> x == x'
+
+regress_gh72 :: [(String, Maybe String)] -> Bool
+regress_gh72 ys = G.decode (G.encode m) == Just m
+    where m = Map.fromList ys
+
+deprecatedTests :: [Test]
+deprecatedTests = [
+  testGroup "regression" [
+    testProperty "gh-72" regress_gh72
+  ],
+  testGroup "genericFrom" [
+      testProperty "Bool" $ genericFrom True
+    , testProperty "Double" $ genericFrom (1::Double)
+    , testProperty "Int" $ genericFrom (1::Int)
+    , testProperty "Foo" $ genericFrom (undefined::Foo)
+    , testProperty "Maybe" $ genericFrom (Just 1 :: Maybe Int)
+    ],
+  testGroup "genericTo" [
+      testProperty "Bool" $ genericTo True
+    , testProperty "Double" $ genericTo (1::Double)
+    , testProperty "Int" $ genericTo (1::Int)
+    , testProperty "Foo" $ genericTo (undefined::Foo)
+    , testProperty "Maybe" $ genericTo (Just 1 :: Maybe Int)
+    ],
+  testGroup "genericToFromJSON" [
+      testProperty "_UFoo" (genericToFromJSON :: UFoo -> Bool)
+    ]
+  ]
diff --git a/tests/Types.hs b/tests/Types.hs
new file mode 100644
--- /dev/null
+++ b/tests/Types.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+#ifdef GHC_GENERICS
+{-# LANGUAGE DeriveGeneric, StandaloneDeriving #-}
+#endif
+
+module Types where
+
+import qualified Data.Map as Map
+import Data.Data
+import Data.Text
+#ifdef GHC_GENERICS
+import GHC.Generics
+#endif
+
+data Foo = Foo {
+      fooInt :: Int
+    , fooDouble :: Double
+    , fooTuple :: (String, Text, Int)
+    -- This definition causes an infinite loop in genericTo and genericFrom!
+    -- , fooMap :: Map.Map String Foo
+    , fooMap :: Map.Map String (Text,Int)
+    } deriving (Show, Typeable, Data)
+
+data UFoo = UFoo {
+      _UFooInt :: Int
+    , uFooInt :: Int
+    } deriving (Show, Eq, Data, Typeable)
+
+data OneConstructor = OneConstructor
+                      deriving (Show, Eq, Typeable, Data)
+
+data Product2 a b = Product2 a b
+                    deriving (Show, Eq, Typeable, Data)
+
+data Product6 a b c d e f = Product6 a b c d e f
+                    deriving (Show, Eq, Typeable, Data)
+
+data Sum4 a b c d = Alt1 a | Alt2 b | Alt3 c | Alt4 d
+                    deriving (Show, Eq, Typeable, Data)
+
+class ApproxEq a where
+    (=~) :: a -> a -> Bool
+
+newtype Approx a = Approx { fromApprox :: a }
+    deriving (Show, Data, Typeable, ApproxEq, Num)
+
+instance (ApproxEq a) => Eq (Approx a) where
+    Approx a == Approx b = a =~ b
+
+data Nullary = C1 | C2 | C3 deriving (Eq, Show)
+
+data SomeType a = Nullary
+                | Unary Int
+                | Product String (Maybe Char) a
+                | Record { testOne   :: Double
+                         , testTwo   :: Maybe Bool
+                         , testThree :: Maybe a
+                         } deriving (Eq, Show)
+
+#ifdef GHC_GENERICS
+deriving instance Generic Foo
+deriving instance Generic UFoo
+deriving instance Generic OneConstructor
+deriving instance Generic (Product2 a b)
+deriving instance Generic (Product6 a b c d e f)
+deriving instance Generic (Sum4 a b c d)
+deriving instance Generic (Approx a)
+deriving instance Generic Nullary
+deriving instance Generic (SomeType a)
+#endif